- serialize source downloads to keep the remote server happy
[opensuse:build-service.git] / src / backend / bs_srcserver
1 #!/usr/bin/perl -w
2 #
3 # Copyright (c) 2006, 2007 Michael Schroeder, Novell Inc.
4 # Copyright (c) 2008 Adrian Schroeter, Novell Inc.
5 #
6 # This program is free software; you can redistribute it and/or modify
7 # it under the terms of the GNU General Public License version 2 as
8 # published by the Free Software Foundation.
9 #
10 # This program is distributed in the hope that it will be useful,
11 # but WITHOUT ANY WARRANTY; without even the implied warranty of
12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
13 # GNU General Public License for more details.
14 #
15 # You should have received a copy of the GNU General Public License
16 # along with this program (see the file COPYING); if not, write to the
17 # Free Software Foundation, Inc.,
18 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
19 #
20 ################################################################
21 #
22 # The Source Server
23 #
24
25 BEGIN {
26   my ($wd) = $0 =~ m-(.*)/- ;
27   $wd ||= '.';
28   chdir($wd);
29   unshift @INC,  "$wd/build";
30   unshift @INC,  "$wd";
31 }
32
33 use XML::Structured ':bytes';
34 use POSIX;
35 use Digest::MD5 ();
36 use Data::Dumper;
37 use Storable ();
38 use Symbol;
39
40 use BSConfig;
41 use BSRPC ':https';
42 use BSServer;
43 use BSUtil;
44 use BSFileDB;
45 use BSXML;
46 use BSVerify;
47 use BSHandoff;
48 use BSWatcher ':https';
49 use BSXPath;
50 use BSStdServer;
51 use BSSrcdiff;
52 use Build;
53 use BSHermes;
54
55 use BSXPath;
56 use BSXPathKeys;
57 use BSDB;
58 use BSDBIndex;
59
60 use strict;
61
62 my $port = 5352;        #'SR'
63 $port = $1 if $BSConfig::srcserver =~ /:(\d+)$/;
64
65 my $projectsdir = "$BSConfig::bsdir/projects";
66 my $eventdir = "$BSConfig::bsdir/events";
67 my $srcrep = "$BSConfig::bsdir/sources";
68 my $requestsdir = "$BSConfig::bsdir/requests";
69 my $rundir = $BSConfig::rundir || "$BSConfig::bsdir/run";
70 my $diffcache = "$BSConfig::bsdir/diffcache";
71
72 my $reqindexdb = "$BSConfig::bsdir/db/request";
73 my $extrepodb = "$BSConfig::bsdir/db/published";
74
75 my $remotecache = "$BSConfig::bsdir/remotecache";
76
77 my $srcrevlay = [qw{rev vrev srcmd5 version time user comment requestid}];
78 my $eventlay = [qw{number time type project package repository arch}];
79
80 my $ajaxsocket = "$rundir/bs_srcserver.ajax";
81 my $uploaddir = "$srcrep/:upload";
82
83 my %packagequota;
84
85 sub notify_repservers {
86   my ($type, $projid, $packid) = @_;
87
88   my $ev = {'type' => $type, 'project' => $projid};
89   $ev->{'package'} = $packid if defined $packid;
90   addevent($ev);
91
92   my @args = ("type=$type", "project=$projid");
93   push @args, "package=$packid" if defined $packid;
94   for my $rrserver ($BSConfig::reposerver) {
95     my $param = {
96       'uri' => "$rrserver/event",
97       'background' => 1,
98     };
99     eval {
100       BSWatcher::rpc($param, undef, @args);
101     };
102     print "warning: $rrserver: $@" if $@;
103   }
104 }
105
106 sub sourceupdate {
107   my ($projid, $packid, $lockfile) = @_;
108
109   return unless $BSConfig::serviceserver;
110   die("No project defined for source update!") if !defined $projid;
111   die("No package defined for source update!") if !defined $packid;
112   # collect current sources to POST them
113   my $rev = getrev($projid, $packid);
114   my $files = lsrev($rev);
115   my @send = map {{'name' => $_, 'filename' => "$srcrep/$packid/$files->{$_}-$_"}} sort(keys %$files);
116   # Run the source update in own process (do not wait for it)
117   my $pid;
118   if (!($pid = xfork())) {
119     my $odir = "$srcrep/:service/$$";
120     BSUtil::cleandir($odir) if -d $odir;
121     mkdir_p($odir);
122     my $receive = BSRPC::rpc({
123       'uri'       => "$BSConfig::serviceserver/sourceupdate/$projid/$packid",
124       'request'   => 'POST',
125       'headers'   => [ 'Content-Type: application/x-cpio' ],
126       'chunked'   => 1,
127       'data'      => \&BSHTTP::cpio_sender,
128       'cpiofiles' => \@send,
129       'directory' => $odir,
130       'timeout'   => 60,
131       'withmd5'   => 1,
132       'receiver' => \&BSHTTP::cpio_receiver,
133     }, undef);
134
135     # and update source repository with the result
136     if ($receive) {
137       my $files = lsrev($rev);
138       # drop all existing service files
139       for my $pfile (keys %$files) {
140         delete $files->{$pfile} if $pfile =~ /^_service[_:]/;
141       }
142       # add new service files
143 #      for my $pfile (map {$_->{'name'} => 1} @$receive) {    # }
144       for my $pfile (ls($odir)) {
145         die("ERROR: bs_service returned a non-_service file\n") unless $pfile =~ /^_service[_:]/;
146         $files->{$pfile} = addfile($projid, $packid, "$odir/$pfile", $pfile);
147       }
148       addrev($projid, $packid, $files, "_service", "generated via source service", undef);
149       rmdir($odir);
150       unlink($lockfile);
151       notify_repservers('package', $projid, $packid);
152     } else {
153       rmdir($odir);
154       unlink($lockfile);
155       die("ERROR: empty source result from service, not even a _service_error\n");
156     }
157   }
158 }
159
160
161 #
162 # run the productconverter on _product to create/update/delete
163 # all _product:xxx packages
164 #
165 sub expandproduct {
166   my ($projid, $packid, $files, $user, $fail) = @_;
167
168   if (!$files) {
169     # gone!
170     # {} argument makes findpackages ignore packages from project links
171     my @packages = grep {/^\Q${packid}:\E/} findpackages($projid, {});
172     for my $opid (@packages) {
173       unlink("$projectsdir/$projid.pkg/$opid.upload-MD5SUMS");
174       unlink("$projectsdir/$projid.pkg/$opid.rev");
175       unlink("$projectsdir/$projid.pkg/$opid.xml");
176       notify_repservers('package', $projid, $opid);
177     }
178     return 1;
179   }
180   my $dir = "$uploaddir/expandproduct_$$";
181   BSUtil::cleandir($dir);
182   mkdir_p($dir);
183   for my $file (sort keys %$files) {
184     link("$srcrep/$packid/$files->{$file}-$file", "$dir/$file") || die("link $srcrep/$packid/$files->{$file}-$file $dir/$file: $!\n");
185   }
186   my @prods = grep {/.product$/}  sort keys %$files;
187   my %pids;
188   for my $prod (@prods) {
189     print "converting product $prod\n";
190     my $odir = "$dir/$prod.out";
191     my $olog = "$dir/$prod.logfile";
192     system('rm', '-rf', $odir) if -d $odir;
193     unlink($olog) if -e $olog;
194     mkdir_p($odir);
195     # run product converter and read stdout
196     my $pid;
197     if (!($pid = xfork())) {
198       delete $SIG{'__DIE__'};
199       open(STDOUT, '>>', $olog) || die("$olog: $!\n");
200       open(STDERR, '>&STDOUT');
201       $| = 1;
202       exec("./bs_productconvert", "$dir/$prod", $odir, $projid);
203       die("500 bs_productconvert: $!\n");
204     }
205     waitpid($pid, 0) == $pid || die("500 waitpid $pid: $!\n");
206     if ($?) {
207       my $s = readstr($olog);
208       warn("bs_productconvert failed: $?\n");
209       BSUtil::cleandir($dir);
210       rmdir($dir);
211       die($s) if $fail;
212       return undef;
213     }
214     my @out = sort(ls($odir));
215     if (!@out) {
216       warn("bs_productconvert produced nothing\n");
217       BSUtil::cleandir($dir);
218       rmdir($dir);
219       return undef;
220     }
221     for my $p (@out) {
222       my $pdir = "$odir/$p";
223       my $pid = $p;
224       $pid =~ s/^_product[_:]//;
225       $pid =~ s/[:\000-\037]/_/sg;
226       $pid = "$packid:$pid";
227       $pids{$pid} = 1;
228       my %pfiles;
229       for my $pfile (sort(ls($pdir))) {
230         next if $pfile eq '_meta';
231         $pfiles{$pfile} = addfile($projid, $pid, "$pdir/$pfile", $pfile);
232       }
233       my $srcmd5 = addmeta($projid, $pid, \%pfiles);
234       my @oldrevs = BSFileDB::fdb_getall("$projectsdir/$projid.pkg/$pid.rev", $srcrevlay);
235       if (@oldrevs == 1 && $oldrevs[0]->{'srcmd5'} eq $srcmd5 && $oldrevs[0]->{'rev'}) {
236         # we're lucky, no change
237         next;
238       }
239       mkdir_p("$projectsdir/$projid.pkg");
240       my $prev = {'srcmd5' => $srcmd5, 'time' => time(), 'user' => $user, 'comment' => 'autogenerated', 'version' => '1', 'vrev' => '1'};
241       unlink("$projectsdir/$projid.pkg/$pid.rev");
242       BSFileDB::fdb_add_i("$projectsdir/$projid.pkg/$pid.rev", $srcrevlay, $prev);
243       if (! -e "$projectsdir/$projid.pkg/$pid.xml") {
244         my $pidpack = {
245          'name' => $pid,
246          'title' => $pid,
247          'description' => "autogenerated from $packid by source server",
248         };
249         $pidpack = readxml("$pdir/_meta", $BSXML::pack, 0) if ( -e "$pdir/_meta" );
250         writexml("$projectsdir/$projid.pkg/.$pid.xml", "$projectsdir/$projid.pkg/$pid.xml", $pidpack, $BSXML::pack);
251       }
252       rmdir($pdir);
253       notify_repservers('package', $projid, $pid);
254     }
255     rmdir($odir);
256   }
257   BSUtil::cleandir($dir);
258   rmdir($dir);
259   # now do away with the old packages
260   my @packages = grep {/^\Q${packid}:\E/} findpackages($projid, {});
261   @packages = grep {!$pids{$_}} @packages;
262   for my $opid (@packages) {
263     unlink("$projectsdir/$projid.pkg/$opid.upload-MD5SUMS");
264     unlink("$projectsdir/$projid.pkg/$opid.rev");
265     unlink("$projectsdir/$projid.pkg/$opid.xml");
266     notify_repservers('package', $projid, $opid);
267   }
268   return 1;
269 }
270
271 #
272 # return version and release of commit
273 #
274 sub getcommitinfo {
275   my ($projid, $packid, $srcmd5, $files) = @_;
276
277   # get version/release from rpm spec/deb dsc/kiwi xml file
278   my $version = 'unknown';
279   my $release;
280   if ($files->{'_link'}) {
281     # can't know the version/release of a link as it is
282     # a moving target
283     return ('unknown', '0');
284   }
285   my $bconf = Build::read_config('noarch');
286   for my $type ('spec', 'dsc', 'kiwi') {
287     my $rev = {'project' => $projid, 'package' => $packid, 'srcmd5' => $srcmd5};
288     my $file = findfile($rev, undef, $type, $files);
289     next unless defined $file;
290     my $d = Build::parse($bconf, "$srcrep/$packid/$files->{$file}-$file");
291     next unless defined $d->{'version'};
292     $version = $d->{'version'};
293     $release = $d->{'release'} if defined $d->{'release'};
294     last;
295   }
296   if (defined($release)) {
297     if ($release =~ /(\d+)\.<B_CNT>/) {
298       $release = $1;
299     } elsif ($release =~ /<RELEASE(\d+)>/) {
300       $release = $1;
301     } elsif ($release =~ /^(\d+)/) {
302       $release = $1;
303     } else {
304       $release = '0';
305     }
306   }
307   $release ||= '0';
308   return ($version, $release);
309 }
310
311
312 ###########################################################################
313 ###
314 ###  low level source handling: tree and revision management
315 ###
316
317 sub repgitdir {
318   my ($rev) = @_;
319   my $projid = $rev->{'project'};
320   my $packid = $rev->{'package'};
321   my $gitdir = "$projectsdir/$projid.pkg/$packid.git";
322   die("$projid/$packid is not a git repository\n") unless -d $gitdir;
323   return $gitdir;
324 }
325
326 sub repstat_git {
327   my ($rev, $filename, $id) = @_;
328   my $gitdir = repgitdir($rev);
329   open(F, '-|', 'git', "--git-dir=$gitdir", 'cat-file', '-s', $id) || return ();
330   my $size= '';
331   1 while sysread(F, $size, 4096, length($size));
332   if (!close(F)) {
333     $! = POSIX::ENOENT;
334     return ();
335   }
336   my @s = (0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
337   $s[7] = 0 + $size;
338   return @s;
339 }
340
341 sub repstat {
342   my ($rev, $filename, $md5) = @_;
343   if (length($md5) == 40) {
344     return repstat_git($rev, $filename, $md5);
345   }
346   return stat("$srcrep/$rev->{'package'}/$md5-$filename");
347 }
348
349 sub repopen_git {
350   my ($rev, $filename, $id, $fd) = @_;
351   my $gitdir = repgitdir($rev);
352   return open($fd, '-|', 'git', "--git-dir=$gitdir", 'cat-file', 'blob', $id);
353 }
354
355 sub repopen {
356   my ($rev, $filename, $md5, $fd) = @_;
357   if (length($md5) == 40) {
358     return repopen_git($rev, $filename, $md5, $fd);
359   }
360   return open($fd, '<', "$srcrep/$rev->{'package'}/$md5-$filename");
361 }
362
363 sub repreadxml {
364   my ($rev, $filename, $md5, $dtd, $nonfatal) = @_;
365   my $packid = $rev->{'package'};
366   return readxml("$srcrep/$packid/$md5-$filename", $dtd, $nonfatal);
367 }
368
369 #
370 # add a file to the repository
371 #
372 sub addfile {
373   my ($projid, $packid, $tmpfile, $filename, $md5) = @_;
374
375   if (!$md5) {
376     open(F, '<', $tmpfile) || die("$tmpfile: $!\n");
377     my $ctx = Digest::MD5->new;
378     $ctx->addfile(*F);
379     close F;
380     $md5 = $ctx->hexdigest();
381   }
382   if (! -e "$srcrep/$packid/$md5-$filename") {
383     if (!rename($tmpfile, "$srcrep/$packid/$md5-$filename")) {
384       mkdir_p("$srcrep/$packid");
385       rename($tmpfile, "$srcrep/$packid/$md5-$filename") || die("rename $tmpfile $srcrep/$packid/$md5-$filename: $!\n");
386     }
387   } else {
388     unlink($tmpfile);
389   }
390   return $md5;
391 }
392
393 #
394 # make files available in oprojid/opackid available from projid/packid
395 #
396 sub copyfiles {
397   my ($projid, $packid, $oprojid, $opackid, $files, $except) = @_;
398
399   return if $packid eq $opackid;
400   return unless %$files;
401   mkdir_p("$srcrep/$packid");
402   for my $f (sort keys %$files) {
403     next if $except && $except->{$f};
404     next if -e "$srcrep/$packid/$files->{$f}-$f";
405     link("$srcrep/$opackid/$files->{$f}-$f", "$srcrep/$packid/$files->{$f}-$f");
406     die("link error $srcrep/$opackid/$files->{$f}-$f\n") unless -e "$srcrep/$packid/$files->{$f}-$f";
407   }
408 }
409
410 sub getrev_git {
411   my ($projid, $packid, $rev) = @_;
412   my $gitdir = "$projectsdir/$projid.pkg/$packid.git";
413   die("$projid/$packid is not a git repository") unless -d $gitdir;
414   if (!$rev) {
415     my $master = readstr("$gitdir/refs/heads/master");
416     chomp $master;
417     $rev = $master;
418   }
419   die("revision is not a valid git id\n") unless $rev =~ /^[0-9a-f]{40}/s;
420   open(F, '-|', 'git', "--git-dir=$gitdir", 'cat-file', 'commit', $rev) || return undef;
421   my $commit = '';
422   1 while sysread(F, $commit, 4096, length($commit));
423   close F;
424   $commit =~ s/.*?\n\n//;
425   $rev = {'project' => $projid, 'package' => $packid, 'rev' => $rev, 'srcmd5' => $rev};
426   $rev->{'comment'} = $commit if $commit ne '';
427   return $rev;
428 }
429
430 #
431 # get a revision object from a revision identifier
432 #
433 sub getrev {
434   my ($projid, $packid, $rev, $linked, $missingok) = @_;
435   die("bad projid\n") if $projid =~ /\// || $projid =~ /^\./;
436   return {'project' => $projid, 'package' => $packid, 'srcmd5' => 'pattern', 'rev' => 'pattern'} if $packid eq '_pattern';
437   die("bad packid\n") if $packid =~ /\// || $packid =~ /^\./;
438   if (! -e "$projectsdir/$projid.pkg/$packid.xml") {
439     my $proj = readproj($projid, 1);
440     if ($proj && $proj->{'link'}) {
441       $linked ||= [];
442       for my $lprojid (map {$_->{'project'}} @{$proj->{'link'}}) {
443         next if $lprojid eq $projid;
444         next if grep {$_->{'project'} eq $lprojid && $_->{'package'} eq $packid} @$linked;
445         push @$linked, {'project' => $lprojid, 'package' => $packid};
446         my $lrev;
447         eval {
448           $lrev = getrev($lprojid, $packid, $rev, $linked, $missingok);
449         };
450         die($@) if $@ && $@ !~ /^404/;
451         if ($lrev) {
452           my $files = lsrev($lrev);
453           copyfiles($projid, $packid, $lprojid, $packid, $files);
454           $lrev->{'originproject'} = $lprojid;
455           return $lrev;
456         }
457       }
458     }
459     return remote_getrev($projid, $packid, $rev, $linked, $missingok);
460   }
461   undef $rev if $rev && ($rev eq 'latest' || $rev eq 'build');
462   undef $rev if $rev && $rev eq 'upload' && ! -e "$projectsdir/$projid.pkg/$packid.upload-MD5SUMS";
463   if (!defined($rev)) {
464     $rev = BSFileDB::fdb_getlast("$projectsdir/$projid.pkg/$packid.rev", $srcrevlay);
465     if (!$rev && -d "$projectsdir/$projid.pkg/$packid.git") {
466       return getrev_git($projid, $packid);
467     }
468     $rev = {'srcmd5' => 'empty'} unless $rev;
469   } elsif ($rev =~ /^[0-9a-f]{32}$/) {
470     return undef unless -e "$projectsdir/$projid.pkg/$packid.rev";
471     $rev = {'srcmd5' => $rev, 'rev' => $rev};
472   } elsif ($rev =~ /^[0-9a-f]{40}$/) {
473     return getrev_git($projid, $packid, $rev);
474   } elsif ($rev eq 'upload') {
475     $rev = {'srcmd5' => 'upload', 'rev' => 'upload'}
476   } elsif ($rev eq 'repository') {
477     $rev = {'srcmd5' => 'empty', 'rev' => 'repository'}
478   } else {
479     $rev = BSFileDB::fdb_getmatch("$projectsdir/$projid.pkg/$packid.rev", $srcrevlay, 'rev', $rev);
480   }
481   $rev->{'project'} = $projid;
482   $rev->{'package'} = $packid;
483   return $rev;
484 }
485
486 sub addmeta {
487   my ($projid, $packid, $files, $rev) = @_;
488
489   # calculate new meta sum
490   my $meta = '';
491   $meta .= "$files->{$_}  $_\n" for sort keys %$files;
492   my $srcmd5 = Digest::MD5::md5_hex($meta);
493   if ($rev && $rev eq 'upload') {
494     mkdir_p($uploaddir);
495     mkdir_p("$projectsdir/$projid.pkg");
496     writestr("$uploaddir/$$", "$projectsdir/$projid.pkg/$packid.upload-MD5SUMS", $meta);
497   } elsif ($rev && $rev eq 'pattern') {
498     if ($meta ne '') {
499       mkdir_p($uploaddir);
500       mkdir_p("$projectsdir/$projid.pkg");
501       writestr("$uploaddir/$$", "$projectsdir/$projid.pkg/pattern-MD5SUMS", $meta);
502     } else {
503       unlink("$projectsdir/$projid.pkg/pattern-MD5SUMS");
504     }
505   } elsif (! -e "$srcrep/$packid/$srcmd5-MD5SUMS") {
506     mkdir_p($uploaddir);
507     mkdir_p("$srcrep/$packid");
508     writestr("$uploaddir/$$", "$srcrep/$packid/$srcmd5-MD5SUMS", $meta);
509   }
510   return $srcmd5;
511 }
512
513 # like addmeta, but adds link information. also stores
514 # under the "wrong" md5sum.
515 sub addmeta_link {
516   my ($projid, $packid, $files, $srcmd5, $linkinfo) = @_;
517
518   if (! -e "$srcrep/$packid/$srcmd5-MD5SUMS") {
519     my $meta = '';
520     $meta .= "$files->{$_}  $_\n" for sort keys %$files;
521     $meta .= "$linkinfo->{'srcmd5'}  /LINK\n";
522     $meta .= "$linkinfo->{'lsrcmd5'}  /LOCAL\n";
523     mkdir_p($uploaddir);
524     mkdir_p("$srcrep/$packid");
525     writestr("$uploaddir/$$", "$srcrep/$packid/$srcmd5-MD5SUMS", $meta);
526   }
527 }
528
529
530 #
531 # create a new revision from a file list, returns revision object
532 #
533 sub addrev {
534   my ($projid, $packid, $files, $user, $comment, $target, $requestid) = @_;
535   die("404 project '$projid' does not exist\n") unless -e "$projectsdir/$projid.xml";
536   if ($packid eq '_pattern') {
537     my $srcmd5 = addmeta($projid, $packid, $files, 'pattern');
538     notify_repservers('project', $projid);
539     return {'project' => $projid, 'package' => $packid, 'rev' => 'pattern', 'srcmd5' => $srcmd5};
540   }
541   die("403 package '$packid' is read-only\n") if $packid =~ /^_product:/;
542   die("404 package '$packid' does not exist\n") unless -e "$projectsdir/$projid.pkg/$packid.xml";
543   if ($target && $target eq 'upload') {
544     my $srcmd5 = addmeta($projid, $packid, $files, 'upload');
545     my $filename = (keys %$files)[0];
546     BSHermes::notify("SRCSRV_UPLOAD", {project => $projid, package => $packid, filename => $filename, user => $user});
547     return {'project' => $projid, 'package' => $packid, 'rev' => 'upload', 'srcmd5' => $srcmd5};
548   } elsif ($target && $target eq 'repository') {
549     # repository only upload.
550     return {'project' => $projid, 'package' => $packid, 'rev' => 'repository', 'srcmd5' => 'empty'};
551   } elsif (defined($target)) {
552     # internal version only upload.
553     my $srcmd5 = addmeta($projid, $packid, $files);
554     return {'project' => $projid, 'package' => $packid, 'rev' => $srcmd5, 'srcmd5' => $srcmd5};
555   }
556   die("bad projid\n") if $projid =~ /\// || $projid =~ /^\./;
557   die("bad packid\n") if $packid =~ /\// || $packid =~ /^\./;
558   die("bad files\n") if grep {/\//} keys %$files;
559   die("bad files\n") if grep {!/^[0-9a-f]{32}$/} values %$files;
560
561   if ($packid eq '_product') {
562     expandproduct($projid, $packid, $files, $user, 1);
563   } elsif ($packid =~ /^_patchinfo:/) {
564     # FIXME: we may should allow source links (with diff) here
565     die("bad files in patchinfo container\n") if grep {$_ ne '_patchinfo'} keys %$files;
566     if ($files->{'_patchinfo'}) {
567       my $p = repreadxml({'project' => $projid, 'package' => $packid}, '_patchinfo', $files->{'_patchinfo'}, $BSXML::patchinfo);
568       BSVerify::verify_patchinfo($p);
569     }
570   }
571
572   my $srcmd5 = addmeta($projid, $packid, $files);
573   my ($version, $release) = getcommitinfo($projid, $packid, $srcmd5, $files);
574   $user = str2utf8xml($user) if $user;
575   $comment = str2utf8xml($comment) if $comment;
576   my $rev = {'srcmd5' => $srcmd5, 'time' => time(), 'user' => $user, 'comment' => $comment, 'version' => $version, 'vrev' => $release, 'requestid' => $requestid};
577   
578   my $rev_old = getrev($projid, $packid);
579   my $files_old = lsrev($rev_old);
580   my $filestr = BSHermes::generate_commit_flist($files_old, $files);
581
582   $rev = BSFileDB::fdb_add_i2("$projectsdir/$projid.pkg/$packid.rev", $srcrevlay, $rev, 'vrev', 'version', $version);
583
584   # send out hermes notification
585   BSHermes::notify("SRCSRV_COMMIT", {project => $projid, package => $packid, files => $filestr, rev => $rev->{'rev'}, user => $user, comment => $comment});
586   $rev_old->{'version'} = "unknown" unless defined($rev_old->{'version'});
587   BSHermes::notify("SRCSRV_VERSION_CHANGE", {project => $projid, package => $packid, files => $filestr, rev => $rev->{'rev'},
588                                              oldversion => $rev_old->{'version'}, newversion => $version, user => $user, comment => $comment})
589     if $version ne $rev_old->{'version'};
590
591   # add missing data to complete the revision object
592   $rev->{'project'} = $projid;
593   $rev->{'package'} = $packid;
594
595   # kill upload revision as we did a real commit
596   unlink("$projectsdir/$projid.pkg/$packid.upload-MD5SUMS");
597
598   notify_repservers('package', $projid, $packid);
599   return $rev;
600 }
601
602 sub lsrev_git {
603   my ($rev, $linkinfo) = @_;
604   my $id = $rev->{'srcmd5'};
605   local *F;
606   my $gitdir = repgitdir($rev);
607   open(F, '-|', 'git', "--git-dir=$gitdir", 'cat-file', 'tree', $id) || die("git: $!\n");
608   my $tree = '';
609   1 while sysread(F, $tree, 4096, length($tree));
610   close(F) || die("bad id\n");
611   my $files = {};
612   while ($tree =~ /(\d+) ([^\000]*)\000(.{20})/sg) {
613     next if $1 eq '40000';              # ignore dirs for now
614     next if substr($2, 0, 1) eq '.';    # ignore files starting with . for now
615     $files->{$2} = unpack('H*', $3);
616   }
617   return $files;
618 }
619
620 #
621 # retrieve the file list of a revision object or tree object
622 # store merge info in linkinfo if available
623 #
624 sub lsrev {
625   my ($rev, $linkinfo) = @_;
626
627   die("nothing known\n") unless $rev;
628   my $projid = $rev->{'project'};
629   my $packid = $rev->{'package'};
630   my $srcmd5 = $rev->{'srcmd5'};
631   die("revision project missing\n") unless defined $projid;
632   die("revision package missing\n") unless defined $packid;
633   die("no such revision\n") unless defined $srcmd5;
634   local *F;
635   die("bad packid\n") if $packid =~ /\// || $packid =~ /^\./;
636   if ($srcmd5 eq 'upload') {
637     open(F, '<', "$projectsdir/$projid.pkg/$packid.upload-MD5SUMS") || die("$packid/$srcmd5-$packid: not in repository\n");
638   } elsif ($srcmd5 eq 'pattern') {
639     open(F, '<', "$projectsdir/$projid.pkg/pattern-MD5SUMS") || return {};
640   } elsif ($srcmd5 eq 'empty' || $srcmd5 eq 'd41d8cd98f00b204e9800998ecf8427e') {
641     return {};
642   } elsif (length($srcmd5) == 40) {
643      return lsrev_git($rev, $linkinfo);
644   } else {
645     die("bad srcmd5 '$srcmd5'\n") if $srcmd5 !~ /^[0-9a-f]{32}$/;
646     if (!open(F, '<', "$srcrep/$packid/$srcmd5-MD5SUMS")) {
647       return {'_linkerror' => $srcmd5} if -e "$srcrep/$packid/$srcmd5-_linkerror";
648       die("$packid/$srcmd5-$packid: not in repository\n");
649     }
650   }
651   my @files = <F>;
652   close F;
653   chomp @files;
654   my $files = {map {substr($_, 34) => substr($_, 0, 32)} @files};
655   if ($linkinfo) {
656     $linkinfo->{'lsrcmd5'} = $files->{'/LOCAL'} if $files->{'/LOCAL'};
657     $linkinfo->{'srcmd5'} = $files->{'/LINK'} if $files->{'/LINK'};
658   }
659   delete $files->{'/LINK'};
660   delete $files->{'/LOCAL'};
661   return $files;
662 }
663
664
665 # find last revision that consisted of the tree object
666 sub findlastrev {
667   my ($tree) = @_;
668   my $rev = BSFileDB::fdb_getmatch("$projectsdir/$tree->{'project'}.pkg/$tree->{'package'}.rev", $srcrevlay, 'srcmd5', $tree->{'srcmd5'});
669   return undef unless $rev;
670   $rev->{'project'} = $tree->{'project'};
671   $rev->{'package'} = $tree->{'package'};
672   return $rev;
673 }
674
675
676
677 ###########################################################################
678 ###
679 ###  source link handling
680 ###
681
682 sub patchspec {
683   my ($p, $dir, $spec) = @_;
684   local *F;
685   open(F, '<', "$dir/$spec") || die("$dir/$spec: $!\n");
686   my @preamble;
687   while(<F>) {
688     chomp;
689     push @preamble, $_;
690     last if /^\s*%(package|prep|build|install|check|clean|preun|postun|pretrans|posttrans|pre|post|files|changelog|description|triggerpostun|triggerun|triggerin|trigger|verifyscript)(\s|$)/;
691   }
692   my %patches;
693   for (@preamble) {
694     next unless /^patch(\d*)\s*:/i;  
695     $patches{0 + ($1 eq '' ? 0 : $1)} = $_;
696   }
697   my @patches = sort {$a <=> $b} keys %patches;
698   my $nr = 0;
699   if (exists $p->{'after'}) {
700     $nr = 0 + $p->{'after'};
701     $nr++ while $patches{$nr};
702   } else {
703     $nr = $patches[-1] + 1 if @patches;
704   }
705   my @after;
706   @after = map {$patches{$_}} grep {$_ < $nr} @patches if @patches;
707   @after = grep {/^source(\d*)\s*:/i} @preamble if !@after;
708   @after = grep {/^name(\d*)\s*:/i} @preamble if !@after;
709   @after = $preamble[-2] if @preamble > 1 && !@after;
710   return "could not find a place to insert the patch" if !@after;
711   my $nrx = $nr;
712   $nrx = '' if $nrx == 0;
713   local *O;
714   open(O, '>', "$dir/.patchspec$$") || die("$dir/.patchspec$$: $!\n");
715   for (@preamble) {
716     print O "$_\n";
717     next unless @after && $_ eq $after[-1];
718     print O "Patch$nrx: $p->{'name'}\n";
719     @after = ();
720   }
721   if ($preamble[-1] !~ /^\s*%prep(\s|$)/) {
722     while (1) {
723       my $l = <F>;
724       return "specfile has no %prep section" if !defined $l;
725       chomp $l;
726       print O "$l\n";
727       last if $l =~ /^\s*%prep(\s|$)/;
728     }
729   }
730   my @prep;
731   while(<F>) {
732     chomp;
733     push @prep, $_;
734     last if /^\s*%(package|prep|build|install|check|clean|preun|postun|pretrans|posttrans|pre|post|files|changelog|description|triggerpostun|triggerun|triggerin|trigger|verifyscript)(\s|$)/;
735   }
736   %patches = ();
737   my $ln = -1;
738   # find outmost pushd/popd calls and insert new patches after a pushd/popd block
739   # $blevel == 0 indicates the outmost block
740   my %bend = ();
741   my $bln = undef;
742   $$bln = $ln;
743   my $blevel = -1;
744   for (@prep) {
745     $ln++;
746     $blevel++ if /^pushd/;
747     if (/^popd/) {
748       unless ($blevel) {
749         $$bln = $ln;
750         undef $bln;
751         $$bln = $ln;
752       }
753       $blevel--;
754     }
755     next unless /%patch(\d*)(.*)/;
756     if ($1 ne '') {
757       $patches{0 + $1} = $ln;
758       $bend{0 + $1} = $bln if $blevel >= 0;
759       next;
760     }
761     my $pnum = 0;
762     my @a = split(' ', $2);
763     if (! grep {$_ eq '-P'} @a) {
764       $patches{$pnum} = $ln;
765     } else {
766       while (@a) {
767         next if shift(@a) ne '-P';
768         next if !@a || $a[0] !~ /^\d+$/;
769         $pnum = 0 + shift(@a);
770         $patches{$pnum} = $ln;
771       }
772     }
773     $bend{$pnum} = $bln if $blevel >= 0;
774   }
775   return "specfile has broken %prep section" unless $blevel == -1;
776   @patches = sort {$a <=> $b} keys %patches;
777   $nr = 1 + $p->{'after'} if exists $p->{'after'};
778   %patches = map { $_ => exists $bend{$_} ? ${$bend{$_}} : $patches{$_} } @patches;
779   @after = map {$patches{$_}} grep {$_ < $nr} @patches if @patches;
780   @after = ($patches[0] - 1) if !@after && @patches;
781   @after = (@prep - 2) if !@after;
782   my $after = $after[-1];
783   $after = -1 if $after < -1;
784   $ln = -1;
785   push @prep, '' if $after >= @prep;
786   #print "insert %patch after line $after\n";
787   for (@prep) {
788     if (defined($after) && $ln == $after) {
789       print O "pushd $p->{'dir'}\n" if exists $p->{'dir'};
790       if ($p->{'popt'}) {
791         print O "%patch$nrx -p$p->{'popt'}\n";
792       } else {
793         print O "%patch$nrx\n";
794       }
795       print O "popd\n" if exists $p->{'dir'};
796       undef $after;
797     }
798     print O "$_\n";
799     $ln++;
800   }
801   while(<F>) {
802     chomp;
803     print O "$_\n";
804   }
805   close(O) || die("close: $!\n");
806   rename("$dir/.patchspec$$", "$dir/$spec") || die("rename $dir/.patchspec$$ $dir/$spec: $!\n");
807   return '';
808 }
809 # " Make emacs wired syntax highlighting happy
810
811 sub topaddspec {
812   my ($p, $dir, $spec) = @_;
813   local (*F, *O);
814   open(F, '<', "$dir/$spec") || die("$dir/$spec: $!\n");
815   open(O, '>', "$dir/.topaddspec$$") || die("$dir/.topaddspec$$: $!\n");
816   my $text = $p->{'text'};
817   $text = '' if !defined $text;
818   $text .= "\n" if $text ne '' && substr($text, -1, 1) ne "\n";
819   print O $text;
820   while(<F>) {
821     chomp;
822     print O "$_\n";
823   }
824   close(O) || die("close: $!\n");
825   rename("$dir/.topaddspec$$", "$dir/$spec") || die("rename $dir/.topaddspec$$ $dir/$spec: $!\n");
826 }
827
828 #
829 # apply a single link step
830 # store the result under the identifier "$md5"
831 #
832 # if "$md5" is not set, store the result in "$uploaddir/applylink$$"
833 #
834 sub applylink {
835   my ($md5, $lsrc, $llnk) = @_;
836   if ($md5 && -e "$srcrep/$llnk->{'package'}/$md5-_linkerror") {
837     # no need to do all the work again...
838     my $log = readstr("$srcrep/$llnk->{'package'}/$md5-_linkerror", 1);
839     $log ||= "unknown error";
840     chomp $log;
841     $log =~ s/.*\n//s;
842     $log ||= "unknown error";
843     return $log;
844   }
845   my $flnk = lsrev($llnk);
846   my $fsrc = lsrev($lsrc);
847   my $l = $llnk->{'link'};
848   my $patches = $l->{'patches'} || {};
849   my @patches = ();
850   my $simple = 1;
851   my @simple_delete;
852   my $isbranch;
853   if ($l->{'patches'}) {
854     for (@{$l->{'patches'}->{''} || []}) {
855       my $type = (keys %$_)[0];
856       if (!$type) {
857         $simple = 0;
858         next;
859       }
860       if ($type eq 'topadd') {
861         push @patches, { 'type' => $type, 'text' => $_->{$type}};
862         $simple = 0;
863       } elsif ($type eq 'delete') {
864         push @patches, { 'type' => $type, %{$_->{$type} || {}}};
865         push @simple_delete, $patches[-1]->{'name'};
866       } else {
867         push @patches, { 'type' => $type, %{$_->{$type} || {}}};
868         $simple = 0;
869         $isbranch = 1 if $type eq 'branch';
870       }
871     }
872   }
873   $simple = 0 unless $md5;
874   if ($simple) {
875     # simple source link with no patching
876     # copy all files but the ones we have locally
877     copyfiles($llnk->{'project'}, $llnk->{'package'}, $lsrc->{'project'}, $lsrc->{'package'}, $fsrc, $flnk);
878     # calculate meta
879     my $newf = { %$fsrc };
880     for my $f (sort keys %$flnk) {
881       $newf->{$f} = $flnk->{$f} unless $f eq '_link';
882     }
883     delete $newf->{$_} for @simple_delete;
884     # store filelist in md5
885     my $linkinfo = {
886       'srcmd5'  => $lsrc->{'srcmd5'},
887       'lsrcmd5' => $llnk->{'srcmd5'},
888     };
889     addmeta_link($llnk->{'project'}, $llnk->{'package'}, $newf, $md5, $linkinfo);
890     return '';
891   }
892
893   # sanity checking...
894   for my $p (@patches) {
895     return "patch has no type" unless exists $p->{'type'};
896     return "patch has illegal type \'$p->{'type'}\'" unless $p->{'type'} eq 'apply' || $p->{'type'} eq 'add' || $p->{'type'} eq 'topadd' || $p->{'type'} eq 'delete' || $p->{'type'} eq 'branch';
897     if ($p->{'type'} ne 'topadd' && $p->{'type'} ne 'delete' && $p->{'type'} ne 'branch') {
898       return "patch has no patchfile" unless exists $p->{'name'};
899       return "patch \'$p->{'name'}\' does not exist" unless $flnk->{$p->{'name'}};
900     }
901   }
902   my $tmpdir = "$uploaddir/applylink$$";
903   mkdir_p($tmpdir);
904   die("$tmpdir: $!\n") unless -d $tmpdir;
905   unlink("$tmpdir/$_") for ls($tmpdir); # remove old stuff
906   my %apply = map {$_->{'name'} => 1} grep {$_->{'type'} eq 'apply'} @patches;
907   $apply{$_} = 1 for keys %{$llnk->{'ignore'} || {}};   # also ignore those files, used in keeplink
908   my %fl;
909   if (!$isbranch) {
910     for my $f (sort keys %$fsrc) {
911       next if $flnk->{$f} && !$apply{$f};
912       link("$srcrep/$lsrc->{'package'}/$fsrc->{$f}-$f", "$tmpdir/$f") || die("$f: $!\n");
913       $fl{$f} = "$lsrc->{'package'}/$fsrc->{$f}-$f";
914     }
915     for my $f (sort keys %$flnk) {
916       next if $apply{$f} || $f eq '_link';
917       link("$srcrep/$llnk->{'package'}/$flnk->{$f}-$f", "$tmpdir/$f") || die("$f: $!\n");
918       $fl{$f} = "$llnk->{'package'}/$flnk->{$f}-$f";
919     }
920   }
921   my $failed;
922   for my $p (@patches) {
923     my $pn = $p->{'name'};
924     if ($p->{'type'} eq 'delete') {
925       unlink("$tmpdir/$pn");
926       next;
927     }
928     if ($p->{'type'} eq 'branch') {
929       # flnk: mine
930       # fbas: old
931       # fsrc: new
932       my $baserev = $l->{'baserev'};
933       return "no baserev in branch patch" unless $baserev;
934       return "baserev is not srcmd5" unless $baserev =~ /^[0-9a-f]{32}$/s;
935       my %brev = (%$lsrc, 'srcmd5' => $baserev);
936       my $fbas;
937       eval {
938         $fbas = lsrev(\%brev);
939       };
940       return "baserev $baserev does not exist" unless $fbas;
941       return "baserev is link" if $fbas->{'link'};
942       # do 3-way merge
943       my %destnames = (%$fsrc, %$flnk);
944       delete $destnames{'_link'};
945       for my $f (sort {length($a) <=> length($b) || $a cmp $b} keys %destnames) {
946         my $mbas = $fbas->{$f} || '';
947         my $msrc = $fsrc->{$f} || '';
948         my $mlnk = $flnk->{$f} || '';
949         if ($mbas eq $mlnk) {
950           next if $msrc eq '';
951           link("$srcrep/$lsrc->{'package'}/$fsrc->{$f}-$f", "$tmpdir/$f") || die("$fsrc->{$f}-$f: $!\n");
952           $fl{$f} = "$lsrc->{'package'}/$fsrc->{$f}-$f";
953           next;
954         }
955         if ($mbas eq $msrc || $mlnk eq $msrc) {
956           next if $mlnk eq '';
957           link("$srcrep/$llnk->{'package'}/$flnk->{$f}-$f", "$tmpdir/$f") || die("$flnk->{$f}-$f: $!\n");
958           $fl{$f} = "$llnk->{'package'}/$flnk->{$f}-$f";
959           next;
960         }
961         if ($mbas eq '' || $msrc eq '' || $mlnk eq '') {
962           $failed = "conflict in file $f";
963           last;
964         }
965         # run diff3
966         link("$srcrep/$lsrc->{'package'}/$fsrc->{$f}-$f", "$tmpdir/$f.new") || die("link $fsrc->{$f}-$f: $!\n");
967         link("$srcrep/$lsrc->{'package'}/$fbas->{$f}-$f", "$tmpdir/$f.old") || die("link $fbas->{$f}-$f: $!\n");
968         link("$srcrep/$llnk->{'package'}/$flnk->{$f}-$f", "$tmpdir/$f.mine") || die("link $flnk->{$f}-$f: $!\n");
969         if (!isascii("$tmpdir/$f.new") || !isascii("$tmpdir/$f.old") || !isascii("$tmpdir/$f.mine")) {
970           $failed = "conflict in file $f";
971           last;
972         }
973         my $pid;
974         if (!($pid = xfork())) {
975           delete $SIG{'__DIE__'};
976           chdir($tmpdir) || die("$tmpdir: $!\n");
977           open(STDERR, '>>', ".log") || die(".log: $!\n");
978           open(STDOUT, '>', $f) || die("$f: $!\n");
979           print STDERR "running diff3 on $f\n";
980           exec('/usr/bin/diff3', '-m', '-E', "$f.mine", "$f.old", "$f.new");
981           die("/usr/bin/diff3: $!\n");
982         }
983         waitpid($pid, 0) == $pid || die("waitpid $pid: $!\n");
984         if ($?) {
985           $failed = "conflict in file $f";
986           last;
987         }
988         unlink("$tmpdir/$f.old");
989         unlink("$tmpdir/$f.new");
990         unlink("$tmpdir/$f.mine");
991       }
992       last if $failed;
993       next;
994     }
995     if ($p->{'type'} eq 'add') {
996       for my $spec (grep {/\.spec$/} ls($tmpdir)) {
997         local *F;
998         open(F, '>>', "$tmpdir/.log") || die("$tmpdir/.log: $!\n");
999         print F "adding patch $pn to $spec\n";
1000         close F;
1001         my $err = patchspec($p, $tmpdir, $spec);
1002         if ($err) {
1003           open(F, '>>', "$tmpdir/.log") || die("$tmpdir/.log: $!\n");
1004           print F "error: $err\n";
1005           close F;
1006           $failed = "could not add patch '$pn'";
1007           last;
1008           unlink("$tmpdir/$_") for ls($tmpdir);
1009           rmdir($tmpdir);
1010           return "could not add patch '$pn'";
1011         }
1012         delete $fl{$spec};
1013       }
1014       last if $failed;
1015       next;
1016     }
1017     if ($p->{'type'} eq 'topadd') {
1018       for my $spec (grep {/\.spec$/} ls($tmpdir)) {
1019         local *F;
1020         open(F, '>>', "$tmpdir/.log") || die("$tmpdir/.log: $!\n");
1021         print F "adding text at top of $spec\n";
1022         close F;
1023         topaddspec($p, $tmpdir, $spec);
1024         delete $fl{$spec};
1025       }
1026       next;
1027     }
1028     next unless $p->{'type'} eq 'apply';
1029     my $pid;
1030     if (!($pid = xfork())) {
1031       delete $SIG{'__DIE__'};
1032       chdir($tmpdir) || die("$tmpdir: $!\n");
1033       open(STDIN, '<', "$srcrep/$llnk->{'package'}/$flnk->{$pn}-$pn") || die("$srcrep/$llnk->{'package'}/$flnk->{$pn}-$pn: $!\n");
1034       open(STDOUT, '>>', ".log") || die(".log: $!\n");
1035       open(STDERR, '>&STDOUT');
1036       $| = 1;
1037       print "applying patch $pn\n";
1038       $::ENV{'TMPDIR'} = '.';
1039       # FIXME: new patch is not supporting --unified-reject-files anymore
1040       exec('/usr/bin/patch', '--no-backup-if-mismatch', '--unified-reject-files', '--global-reject-file=.rejects', '-g', '0', '-f');
1041       die("/usr/bin/patch: $!\n");
1042     }
1043     waitpid($pid, 0) == $pid || die("waitpid $pid: $!\n");
1044     if ($?) {
1045       $failed = "could not apply patch '$pn'";
1046       last;
1047     }
1048   }
1049   if ($failed) {
1050     local *F;
1051     # add result as last line
1052     open(F, '>>', "$tmpdir/.log") || die("$tmpdir/.log: $!\n");
1053     print F "\n$failed\n";
1054     close F;
1055     # link error marker
1056     if ($md5 && !link("$tmpdir/.log", "$srcrep/$llnk->{'package'}/$md5-_linkerror")) {
1057       my $err = "link $tmpdir/.log $srcrep/$llnk->{'package'}/$md5-_linkerror: $!\n";
1058       die($err) unless -e "$srcrep/$llnk->{'package'}/$md5-_linkerror";
1059     }
1060     unlink("$tmpdir/$_") for ls($tmpdir);
1061     rmdir($tmpdir);
1062     return $failed;
1063   }
1064   my @newf = grep {!/^\./} ls($tmpdir);
1065   my $newf = {};
1066   local *F;
1067   for my $f (@newf) {
1068     my @s = stat "$tmpdir/$f";
1069     die("$tmpdir/$f: $!\n") unless @s;
1070     if ($s[3] > 1 && $fl{$f}) {
1071       my @s2 = stat "$srcrep/$fl{$f}";
1072       die("$srcrep/$fl{$f}: $!\n") unless @s2;
1073       if ("$s[0]/$s[1]" eq "$s2[0]/$s2[1]") {
1074         $newf->{$f} = $fl{$f};
1075         $newf->{$f} =~ s/.*\///;
1076         $newf->{$f} = substr($newf->{$f}, 0, 32);
1077         next;
1078       }
1079     }
1080     open(F, '<', "$tmpdir/$f") || die("$tmpdir/$f: $!\n");
1081     my $ctx = Digest::MD5->new;
1082     $ctx->addfile(*F);
1083     close F;
1084     $newf->{$f} = $ctx->hexdigest();
1085   }
1086
1087   # if we just want the patched files we're finished
1088   if (!$md5) {
1089     # rename into md5 form, sort so that there's no collision
1090     for my $f (sort {length($b) <=> length($a) || $a cmp $b} @newf) {
1091       rename("$tmpdir/$f", "$tmpdir/$newf->{$f}-$f");
1092     }
1093     return $newf;
1094   }
1095
1096   # otherwise link everything over
1097   for my $f (@newf) {
1098     addfile($llnk->{'project'}, $llnk->{'package'}, "$tmpdir/$f", $f, $newf->{$f});
1099   }
1100   # clean up tmpdir
1101   unlink("$tmpdir/$_") for ls($tmpdir);
1102   rmdir($tmpdir);
1103   # store filelist
1104   my $linkinfo = {
1105     'srcmd5'  => $lsrc->{'srcmd5'},
1106     'lsrcmd5' => $llnk->{'srcmd5'},
1107   };
1108   addmeta_link($llnk->{'project'}, $llnk->{'package'}, $newf, $md5, $linkinfo);
1109   return '';
1110 }
1111
1112 #
1113 # expand a source link
1114 # - returns expanded file list
1115 # - side effects:
1116 #   modifies $rev->{'srcmd5'}, $rev->{'vrev'}, $rev->{'linkrev'}
1117 #   modifies $li->{'srcmd5'}, $li->{'lsrcmd5'}
1118 #   modifies $li->{'linked'} if exists
1119 #
1120 sub handlelinks {
1121   my ($rev, $files, $li) = @_;
1122
1123   my @linkinfo;
1124   my %seen;
1125   my $projid = $rev->{'project'};
1126   my $packid = $rev->{'package'};
1127   my $linkrev = $rev->{'linkrev'};
1128   push @linkinfo, {'project' => $projid, 'package' => $packid, 'srcmd5' => $rev->{'srcmd5'}, 'rev' => $rev->{'rev'}};
1129   delete $rev->{'srcmd5'};
1130   delete $rev->{'linkrev'};
1131   my $vrev = $rev->{'vrev'};
1132   my $vrevdone;
1133   my $lrev = $rev;
1134   while ($files->{'_link'}) {
1135     my $l = repreadxml($lrev, '_link', $files->{'_link'}, $BSXML::link, 1);
1136     return '_link is bad' unless $l;
1137     eval {
1138       BSVerify::verify_link($l);
1139     };
1140     if ($@) {
1141       my $err = $@;
1142       $err =~ s/\n$//s;
1143       return "_link is bad: $err";
1144     }
1145     $l->{'project'} = $linkinfo[-1]->{'project'} unless exists $l->{'project'};
1146     $l->{'package'} = $linkinfo[-1]->{'package'} unless exists $l->{'package'};
1147     $linkrev = $l->{'baserev'} if $linkrev && $linkrev eq 'base';
1148     ($l->{'rev'}, $linkrev) = ($linkrev, undef) if $linkrev;
1149     $linkinfo[-1]->{'link'} = $l;
1150     $projid = $l->{'project'};
1151     $packid = $l->{'package'};
1152     $lrev = $l->{'rev'} || '';
1153     return 'circular package link' if $seen{"$projid/$packid/$lrev"};
1154     $seen{"$projid/$packid/$lrev"} = 1;
1155     # record link target for projpack
1156     push @{$li->{'linked'}}, {'project' => $projid, 'package' => $packid} if $li && $li->{'linked'}; 
1157     eval {
1158       $lrev = getrev($projid, $packid, $l->{'rev'}, $li ? $li->{'linked'} : undef);
1159     };
1160     if ($@) {
1161       my $error = $@;
1162       $error =~ s/\n$//s;
1163       return "$projid $packid: $error";
1164     }
1165     return "linked package '$packid' does not exist in project '$projid'" unless $lrev;
1166     return "linked package '$packid' is empty" if $lrev->{'srcmd5'} eq 'empty';
1167     return "linked package '$packid' is strange" unless $lrev->{'srcmd5'} =~ /^[0-9a-f]{32}$/;
1168     undef $files;
1169     eval {
1170       $files = lsrev($lrev);
1171     };
1172     return 'linked package is not in repository' unless $files;
1173     my $cicount = $l->{'cicount'} || 'add';
1174     if ($cicount eq 'copy') {
1175       $rev->{'vrev'} -= $vrev unless $vrevdone;
1176     } elsif ($cicount eq 'local') {
1177       $vrevdone = 1;
1178     } elsif ($cicount ne 'add') {
1179       return '_link is bad: illegal cicount';
1180     }
1181     $vrev = $lrev->{'vrev'};
1182     $rev->{'vrev'} += $lrev->{'vrev'} unless $vrevdone;
1183     push @linkinfo, {'project' => $projid, 'package' => $packid, 'srcmd5' => $lrev->{'srcmd5'}, 'rev' => $lrev->{'rev'}};
1184   }
1185   my $md5;
1186   my $oldl;
1187   for my $l (reverse @linkinfo) {
1188     if (!$md5) {
1189       $md5 = $l->{'srcmd5'};
1190       $oldl = $l;
1191       next;
1192     }
1193     my $md5c = "$md5  /LINK\n$l->{'srcmd5'}  /LOCAL\n";
1194     $md5 = Digest::MD5::md5_hex($md5c);
1195     if (! -e "$srcrep/$l->{'package'}/$md5-MD5SUMS") {
1196       my $error = applylink($md5, $oldl, $l);
1197       if ($error) {
1198         $rev->{'srcmd5'} = $md5 if $l == $linkinfo[0];
1199         return $error;
1200       }
1201     }
1202     $l->{'srcmd5'} = $md5;
1203     $oldl = $l;
1204   }
1205   $rev->{'srcmd5'} = $md5;
1206   $files = lsrev($rev, $li);
1207   return $files;
1208 }
1209
1210 # returns expanded filelist
1211 # modifies $rev->{'srcmd5'}, $rev->{'vrev'}
1212 sub lsrev_expanded {
1213   my ($rev, $linkinfo) = @_;
1214   my $files = lsrev($rev, $linkinfo);
1215   return $files unless $files->{'_link'};
1216   $files = handlelinks($rev, $files, $linkinfo);
1217   die("$files\n") unless ref $files;
1218   return $files;
1219 }
1220
1221 # add missing target information to linkinfo
1222 sub linkinfo_addtarget {
1223   my ($rev, $linkinfo) = @_;
1224   my %lrev = %$rev;
1225   $lrev{'srcmd5'} = $linkinfo->{'lsrcmd5'} if $linkinfo->{'lsrcmd5'};
1226   my $files = lsrev(\%lrev);
1227   die("linkinfo_addtarget: not a link?\n") unless $files->{'_link'};
1228   my $l = repreadxml(\%lrev, '_link', $files->{'_link'}, $BSXML::link, 1);
1229   if ($l) {
1230     $linkinfo->{'project'} = defined($l->{'project'}) ? $l->{'project'} : $lrev{'project'};
1231     $linkinfo->{'package'} = defined($l->{'package'}) ? $l->{'package'} : $lrev{'package'};
1232     $linkinfo->{'rev'} = $l->{'rev'} if $l->{'rev'};
1233     $linkinfo->{'baserev'} = $l->{'baserev'} if $l->{'baserev'};
1234   }
1235 }
1236
1237 sub findlastworkinglink {
1238   my ($rev) = @_;
1239
1240   my $projid = $rev->{'project'};
1241   my $packid = $rev->{'package'};
1242   my @cand = grep {s/-MD5SUMS$//} ls("$srcrep/$packid");
1243   my %cand;
1244   for my $cand (@cand) {
1245     my $candrev = {'project' => $projid, 'package' => $packid, 'srcmd5' => $cand};
1246     my %li;
1247     my $files = lsrev($candrev, \%li);
1248     next unless $li{'lsrcmd5'} && $li{'lsrcmd5'} eq $rev->{'srcmd5'};
1249     $cand{$cand} = $li{'srcmd5'};
1250   }
1251   return undef unless %cand;
1252   @cand = sort keys %cand;
1253   return $cand[0] if @cand == 1;
1254
1255   while (1) {
1256     my $lrev = {'project' => $projid, 'package' => $packid, 'srcmd5' => $rev->{'srcmd5'}};
1257     my $lfiles = lsrev($lrev);
1258     return undef unless $lfiles;
1259     my $l = repreadxml($lrev, '_link', $lfiles->{'_link'}, $BSXML::link, 1);
1260     return undef unless $l;
1261     $projid = $l->{'project'} if exists $l->{'project'};
1262     $packid = $l->{'package'} if exists $l->{'package'};
1263     my $lastcand;
1264     for my $cand (splice @cand) {
1265       next unless $cand{$cand};
1266       my %li;
1267       my $candrev = {'project' => $projid, 'package' => $packid, 'srcmd5' => $cand{$cand}};
1268       lsrev($candrev, \%li);
1269       $candrev->{'srcmd5'} = $li{'lsrcmd5'} if $li{'lsrcmd5'};
1270       $candrev = findlastrev($candrev);
1271       next unless $candrev;
1272       next if $lastcand && $lastcand->{'rev'} > $candrev->{'rev'};
1273       $cand{$cand} = $li{'srcmd5'} ? $li{'srcmd5'} : undef;
1274       if ($lastcand && $lastcand->{'rev'} == $candrev->{'rev'}) {
1275         push @cand, $cand;
1276         next;
1277       }
1278       @cand = ($cand);
1279       $lastcand = $candrev;
1280     }
1281     return undef unless @cand;
1282     return $cand[0] if @cand == 1;
1283     $rev = $lastcand;
1284   }
1285 }
1286
1287
1288 ###########################################################################
1289 ###
1290 ###  project/package management
1291 ###
1292
1293 sub identical {
1294   my ($d1, $d2, @except) = @_;
1295
1296   return 0 unless defined($d1) && defined($d2);
1297   my $r = ref($d1);
1298   return 0 if $r ne ref($d2);
1299   if ($r eq '') {
1300     return 0 if $d1 ne $d2;
1301   } elsif ($r eq 'HASH') {
1302     my %k = (%$d1, %$d2);
1303     my %except = map {$_ => 1} @except;
1304     for my $k (keys %k) {
1305       next if $except{$k};
1306       return 0 unless identical($d1->{$k}, $d2->{$k});
1307     }
1308   } elsif ($r eq 'ARRAY') {
1309     return 0 unless @$d1 == @$d2;
1310     for (my $i = 0; $i < @$d1; $i++) {
1311       return 0 unless identical($d1->[$i], $d2->[$i], @except);
1312     }
1313   } else {
1314     return 0;
1315   }
1316   return 1;
1317 }
1318
1319 sub findprojects {
1320   local *D;
1321   opendir(D, $projectsdir) || die("$projectsdir: $!\n");
1322   my @projids = grep {s/\.xml$//} readdir(D);
1323   closedir(D);
1324   return sort @projids;
1325 }
1326
1327 sub findpackages {
1328   my ($projid, $proj, $nonfatal, $seen) = @_;
1329   $proj ||= readproj($projid, 1) || {};
1330   my @packids;
1331   if (opendir(D, "$projectsdir/$projid.pkg")) {
1332     @packids = grep {s/\.xml$//} readdir(D);
1333     closedir(D);
1334   }
1335   if ($proj->{'link'}) {
1336     $seen ||= {};
1337     for my $lprojid (map {$_->{'project'}} @{$proj->{'link'}}) {
1338       next if $seen->{$lprojid};
1339       $seen->{$lprojid} = 1;
1340       my @lpackids;
1341       my $lproj = readproj($lprojid, 1);
1342       if (!$lproj || $lproj->{'remoteurl'}) {
1343         $lproj = remoteprojid($lprojid);
1344         my $r;
1345         eval {
1346           $r = BSRPC::rpc("$lproj->{'remoteurl'}/source/$lproj->{'remoteproject'}", $BSXML::dir);
1347         };
1348         if ($@ && $@ !~ /^404/) {
1349           die($@) unless $nonfatal;
1350           warn($@);
1351         }
1352         @lpackids = map {$_->{'name'}} @{($r || {})->{'entry'} || []};
1353       } else {
1354         @lpackids = findpackages($lprojid, undef, $nonfatal, $seen);
1355       }
1356       if (grep {$_ eq '_product'} @packids) {
1357         @lpackids = grep {$_ ne '_product' && !/^_product:/} @lpackids;
1358       }
1359       push @packids, @lpackids;
1360     }
1361     @packids = unify(@packids);
1362   }
1363   return sort @packids;
1364 }
1365
1366 sub readproj {
1367   my ($projid, $nonfatal) = @_;
1368   my $proj = readxml("$projectsdir/$projid.xml", $BSXML::proj, 1);
1369   die("404 project '$projid' does not exist\n") if !$proj && !$nonfatal;
1370   return $proj;
1371 }
1372
1373 sub readpack {
1374   my ($projid, $packid, $nonfatal) = @_;
1375   my $pack = readxml("$projectsdir/$projid.pkg/$packid.xml", $BSXML::pack, 1);
1376   if (!$pack && !$nonfatal) {
1377     readproj($projid);
1378     die("404 package '$packid' does not exist in project '$projid'\n");
1379   }
1380   return $pack;
1381 }
1382
1383 # find matching .spec/.dsc/.kiwi file depending on packid and/or repoid
1384 sub findfile {
1385   my ($rev, $repoid, $ext, $files) = @_;
1386
1387   $files = lsrev($rev) unless $files;
1388   return (undef, undef) unless $files;
1389   my $packid = $rev->{'package'};
1390   return ($files->{"$packid-$repoid.$ext"}, "$packid-$repoid.$ext") if defined($repoid) && $files->{"$packid-$repoid.$ext"};
1391   # 28.4.2009 mls: deleted "&& defined($repoid)"
1392   return ($files->{"$packid.$ext"}, "$packid.$ext") if $files->{"$packid.$ext"};
1393   # try again without last components
1394   if ($packid =~ /^(.*?)\./) {
1395     return ($files->{"$1.$ext"}, "$1.$ext") if $files->{"$1.$ext"};
1396   }
1397   my @files = grep {/\.$ext$/} keys %$files;
1398   @files = grep {/^\Q$packid\E/i} @files if @files > 1;
1399   return ($files->{$files[0]}, $files[0]) if @files == 1;
1400   if (@files > 1) {
1401     if (!defined($repoid)) {
1402       # return (undef, undef);
1403       @files = sort @files;
1404       return ($files->{$files[0]}, $files[0]);
1405     }
1406     @files = grep {/^\Q$packid-$repoid\E/i} @files if @files > 1;
1407     return ($files->{$files[0]}, $files[0]) if @files == 1;
1408   }
1409   return (undef, undef);
1410 }
1411
1412 sub unify {
1413   my %h = map {$_ => 1} @_;
1414   return grep(delete($h{$_}), @_);
1415 }
1416
1417 #########################################################################
1418
1419 # set up kiwi project callback
1420
1421 sub kiwibootcallback {
1422   my ($projid, $packid) = @_;
1423   BSVerify::verify_projid($projid);
1424   BSVerify::verify_packid($packid);
1425   my $rev = getrev($projid, $packid);
1426   my $files = lsrev($rev);
1427   my ($md5, $file) = findfile($rev, undef, 'kiwi', $files);
1428   die("no kiwi file found\n") unless $md5 && $file;
1429   my $xml = readstr("$srcrep/$packid/$md5-$file");
1430   return ($xml, {'project' => $projid, 'package' => $packid, 'srcmd5' => $rev->{'srcmd5'}, 'file' => $file});
1431 }
1432 $Build::Kiwi::bootcallback = \&kiwibootcallback;
1433
1434 #########################################################################
1435
1436 sub getprojquotapackage {
1437   my ($projid) = @_;
1438   if (!exists($packagequota{':packages'})) {
1439     my $quotaxml = readxml($BSConfig::bsquotafile, $BSXML::quota, 1);
1440     for my $p (@{$quotaxml->{'project'} || []}) {
1441       $packagequota{$p->{'name'}} = $p->{'packages'};
1442     }
1443     $packagequota{':packages'} = $quotaxml->{'packages'};
1444   }
1445   while ($projid) {
1446     return $packagequota{$projid} if exists $packagequota{$projid};
1447     last unless $projid =~ s/:[^:]*$//;
1448   }
1449   return $packagequota{':packages'};
1450 }
1451
1452 sub getprojpack {
1453   my ($cgi, $projids, $repoids, $packids, $arch) = @_;
1454   $arch ||= 'noarch';
1455   $projids = [ findprojects() ] unless $projids;
1456   if ($BSConfig::limit_projects && $BSConfig::limit_projects->{$arch}) {
1457     $projids ||= $BSConfig::limit_projects->{$arch};
1458     my %limit_projids = map {$_ => 1} @{$BSConfig::limit_projects->{$arch}};
1459     $projids = [ grep {$limit_projids{$_}} @$projids ];
1460   }
1461   $repoids = { map {$_ => 1} @$repoids } if $repoids;
1462   $packids = { map {$_ => 1} @$packids } if $packids;
1463   my $bconf = Build::read_config($arch);
1464
1465   my %remotemap;
1466   my $withremotemap = $cgi->{'withremotemap'};
1467   my @res;
1468   for my $projid (@$projids) {
1469     my $jinfo = { 'name' => $projid };
1470     if ($withremotemap && !exists($remotemap{$projid})) {
1471       $remotemap{$projid} = remoteprojid($projid);
1472     }
1473     my $proj = readproj($projid, 1);
1474     next unless $proj;
1475     if ($cgi->{'withconfig'}) {
1476       my $config = readstr("$projectsdir/$projid.conf", 1);
1477       if ($config) {
1478         # strip away macro blocks
1479         while ($config =~ /^(.*?\n)?\s*(macros:[^\n]*\n.*)/si) {
1480           my ($c1, $c2) = ($1, $2);
1481           $c1 = '' unless defined $c1;
1482           if ($c2 =~ /^(?:.*?\n)?\s*:macros\s*\n(.*)$/si) {
1483             $config = "$c1$c2";
1484           } else {
1485             $config = $c1;
1486             last;
1487           }
1488         }
1489         $jinfo->{'config'} = $config unless $config =~ /^\s*$/s;
1490       }
1491     }
1492     if ($cgi->{'withsrcmd5'} && -s "$projectsdir/$projid.pkg/pattern-MD5SUMS") {
1493       my $patterns = readstr("$projectsdir/$projid.pkg/pattern-MD5SUMS", 1);
1494       $jinfo->{'patternmd5'} = Digest::MD5::md5_hex($patterns) if $patterns;
1495     }
1496     my @packages;
1497     @packages = findpackages($projid, $proj, 1) unless $cgi->{'nopackages'} || $proj->{'remoteurl'};
1498     next if $repoids && !grep {$repoids->{$_->{'name'}}} @{$proj->{'repository'} || []};
1499     next if $packids && !grep {$packids->{$_}} @packages;
1500     for (qw{title description build publish debuginfo useforbuild remoteurl remoteproject download}) {
1501       $jinfo->{$_} = $proj->{$_} if exists $proj->{$_};
1502     }
1503     # Check build flags in project meta data
1504     # packages inherit the project wide settings and may override them
1505     my $pdisabled;
1506     my $pdisable = {};
1507     my $penable = {};
1508     undef($penable) if $cgi->{'ignoredisable'};
1509     if ($jinfo->{'build'} && $penable) {
1510       for (@{$proj->{'repository'} || []}) {
1511         my $disen = BSUtil::enabled($_->{'name'}, $jinfo->{'build'}, 1, $arch);
1512         if ($disen) {
1513           $penable->{$_->{'name'}} = 1;
1514         } else {
1515           $pdisable->{$_->{'name'}} = 1;
1516         }
1517       }
1518       $pdisabled = 1 if !keys(%$penable);
1519     } else {
1520       # build is enabled
1521       undef($penable);
1522     }
1523
1524     # Check package number quota
1525     my $quota_exceeded;
1526     if ($BSConfig::bsquotafile) {
1527       my $pquota = getprojquotapackage($projid);
1528       $quota_exceeded = 1 if defined($pquota) && @packages > $pquota;
1529     }
1530
1531     if ($cgi->{'withrepos'}) {
1532       if ($repoids) {
1533         $jinfo->{'repository'} = [ grep {$repoids->{$_->{'name'}}} @{$proj->{'repository'} || []} ];
1534       } else {
1535         $jinfo->{'repository'} = $proj->{'repository'} || [];
1536       }
1537       if ($cgi->{'expandedrepos'}) {
1538         for my $repo (@{$jinfo->{'repository'}}) {
1539           my @prps = expandsearchpath($projid, $repo->{'name'});
1540           for my $prp (@prps) {
1541             my @s = split('/', $prp, 2);
1542             if ($withremotemap && !exists($remotemap{$s[0]})) {
1543               $remotemap{$s[0]} = remoteprojid($s[0]);
1544             }
1545             $prp = {'project' => $s[0], 'repository' => $s[1]};
1546           }
1547           $repo->{'path'} = \@prps;
1548         }
1549       }
1550     }
1551     if (!$cgi->{'ignoredisable'} && !grep {!$_->{'status'} || $_->{'status'} ne 'disabled'} @{$proj->{'repository'} || []}) {
1552       # either no repositories or all disabled. No need to check packages
1553       @packages = ();
1554     }
1555     @packages = () if $cgi->{'nopackages'};
1556     my @pinfo;
1557     my %bconfs;
1558
1559     for my $packid (@packages) {
1560
1561       next if $packids && !$packids->{$packid};
1562       my $pinfo = {'name' => $packid};
1563       push @pinfo, $pinfo;
1564       my $pack = readpack($projid, $packid, 1);
1565       $pack ||= {} if $proj->{'link'};
1566       if (!$pack) {
1567         $pinfo->{'error'} = 'no metadata';
1568         next;
1569       }
1570       for (qw{build publish debuginfo useforbuild bcntsynctag}) {
1571         $pinfo->{$_} = $pack->{$_} if $pack->{$_};
1572       }
1573       if (!$pinfo->{'build'}) {
1574         $pinfo->{'build'}->{'enable'} = $pack->{'enable'} if $pack->{'enable'};
1575         $pinfo->{'build'}->{'disable'} = $pack->{'disable'} if $pack->{'disable'};
1576       }
1577       my $enable = defined($penable) ? {%$penable} : undef;
1578       my $disable = {%$pdisable};
1579       if (!$cgi->{'ignoredisable'} && $pinfo->{'build'}) {
1580         for (@{$proj->{'repository'} || []}) {
1581           my $default = exists($disable->{$_->{'name'}}) ? 0 : 1;
1582           my $disen = BSUtil::enabled($_->{'name'}, $pinfo->{'build'}, $default, $arch);
1583           if ($disen) {
1584             $enable->{$_->{'name'}} = 1;
1585             delete $disable->{$_->{'name'}};
1586           } else {
1587             $disable->{$_->{'name'}} = 1;
1588             delete $enable->{$_->{'name'}};
1589           }
1590         }
1591       }
1592       undef($disable) if $enable && !keys(%$enable);
1593       undef($enable) if $disable && !keys(%$disable);
1594       if ((!$disable || $pdisabled) && $enable && !%$enable) {
1595         $pinfo->{'error'} = 'disabled';
1596         next;
1597       }
1598       if ($quota_exceeded) {
1599         $pinfo->{'error'} = 'quota exceeded';
1600         next;
1601       }
1602       if ($cgi->{'withsrcmd5'} || $cgi->{'withdeps'}) {
1603         my $rev;
1604         my $linked = [];
1605         eval {
1606           $rev = getrev($projid, $packid, 'build', $linked);
1607         };
1608         $pinfo->{'originproject'} = $rev->{'originproject'} if $rev && $rev->{'originproject'};
1609         $pinfo->{'linked'} = $linked if @$linked;
1610         if ($@) {
1611           $pinfo->{'error'} = $@;
1612           $pinfo->{'error'} =~ s/\n$//s;
1613           next;
1614         }
1615         if (!$rev || $rev->{'srcmd5'} eq 'empty' || $rev->{'srcmd5'} eq 'd41d8cd98f00b204e9800998ecf8427e') {
1616           $pinfo->{'error'} = 'no source uploaded';
1617           next;
1618         }
1619         $pinfo->{'srcmd5'} = $rev->{'srcmd5'};
1620         $pinfo->{'rev'} = $rev->{'rev'};
1621         my $files;
1622         eval {
1623           $files = lsrev($rev);
1624         };
1625         if ($@) {
1626           $pinfo->{'error'} = $@;
1627           $pinfo->{'error'} =~ s/\n$//s;
1628           next;
1629         }
1630         if ($files->{'_service_error'}) {
1631           $pinfo->{'error'} = 'source service failed';
1632           next;
1633         }
1634         if ($files->{'_link'}) {
1635           my %li = ('linked' => $linked);
1636           eval {
1637             $files = handlelinks($rev, $files, \%li);
1638           };
1639           if ($@) {
1640             $files = "$@";
1641             $files =~ s/\n$//;
1642           }
1643           $pinfo->{'linked'} = $linked if @$linked;
1644           if (!ref $files) {
1645             $pinfo->{'error'} = defined($files) ? $files : "could not get file list";
1646             next;
1647           }
1648           $pinfo->{'srcmd5'} = $rev->{'srcmd5'};
1649           my $meta = '';
1650           $meta .= "$files->{$_}  $_\n" for sort keys %$files;
1651           $pinfo->{'verifymd5'} = Digest::MD5::md5_hex($meta);
1652         }
1653
1654         if ($files->{'_aggregate'}) {
1655           my $aggregatelist = repreadxml($rev, '_aggregate', $files->{'_aggregate'}, $BSXML::aggregatelist, 1);
1656           if (!$aggregatelist) {
1657             $pinfo->{'error'} = "bad aggregatelist data";
1658             next;
1659           }
1660           eval {
1661             BSVerify::verify_aggregatelist($aggregatelist);
1662           };
1663           if ($@) {
1664             my $err = $@;
1665             $err =~ s/\n$//s;
1666             $pinfo->{'error'} = "bad aggregatelist: $err";
1667             next;
1668           }
1669           $pinfo->{'aggregatelist'} = $aggregatelist;
1670           if (($enable && %$enable) || ($disable && %$disable)) {
1671             my @dinfo = ();
1672             for my $repo (@{$proj->{'repository'} || []}) {
1673               my $repoid = $repo->{'name'};
1674               next if $repoids && !$repoids->{$repoid};
1675               if ((!$disable || $disable->{$repoid}) && !(!$enable || $enable->{$repoid})) {
1676                 push @dinfo, {'repository' => $repoid, 'error' => 'disabled'};
1677                 next;
1678               }
1679             }
1680             $pinfo->{'info'} = \@dinfo if @dinfo;
1681           }
1682         } elsif ($cgi->{'withdeps'}) {
1683           my @dinfo;
1684
1685           # Build config cache for all repositories
1686           for my $repo (@{$proj->{'repository'} || []}) {
1687             my $repoid = $repo->{'name'};
1688             next if $repoids && !$repoids->{$repoid};
1689
1690             my $rinfo = {'repository' => $repoid};
1691             push @dinfo, $rinfo;
1692             if ((!$disable || $disable->{$repoid}) && !(!$enable || $enable->{$repoid})) {
1693               $rinfo->{'error'} = 'disabled';
1694               next;
1695             }
1696             if (!$bconfs{$repoid}) {
1697               print "reading config for $projid/$repoid $arch\n";
1698               my $c;
1699               eval {
1700                 ($c) = getconfig($cgi, $projid, $repoid);
1701               };
1702               if ($@) {
1703                 my $err = $@;
1704                 $err =~ s/\n$//;
1705                 $rinfo->{'error'} = $err;
1706                 next;
1707               }
1708               $c = [ split("\n", $c) ];
1709               $bconfs{$repoid} = Build::read_config($arch, $c);
1710             };
1711             my $conf = $bconfs{$repoid};
1712             my $type = $conf->{'type'};
1713             if (!$type || $type eq 'UNDEFINED') {
1714               $rinfo->{'error'} = 'bad build configuration';
1715               next;
1716             }
1717             my ($md5, $file) = findfile($rev, $repoid, $type, $files);
1718             if (!$md5) {
1719               # no spec/dsc/kiwi file found
1720               if (grep {/\.(?:spec|dsc|kiwi)$/} keys %$files) {
1721                 # only different types available
1722                 $rinfo->{'error'} = 'excluded';
1723               }
1724               next;
1725             }
1726             if ($type eq 'kiwi' && $BSConfig::kiwiprojects) {
1727               my %kiwiprojects = map {$_ => 1} @$BSConfig::kiwiprojects;
1728               if (!$kiwiprojects{$projid}) {
1729                 $rinfo->{'error'} = 'kiwi image building is not enabled for this project';
1730                 next;
1731               }
1732             }
1733             $rinfo->{'file'} = $file;
1734             # get build dependency info
1735             my $d = Build::parse($conf, "$srcrep/$packid/$md5-$file");
1736             data2utf8xml($d);
1737             if (defined($d->{'name'})) {
1738               my $version = defined($d->{'version'}) ? $d->{'version'} : 'unknown';
1739               $pinfo->{'versrel'} ||= "$version-$rev->{'vrev'}";
1740               $rinfo->{'name'} = $d->{'name'};
1741               $rinfo->{'dep'} = $d->{'deps'};
1742               if ($d->{'prereqs'}) {
1743                 my %deps = map {$_ => 1} (@{$d->{'deps'} || []}, @{$d->{'subpacks'} || []});
1744                 my @prereqs = grep {!$deps{$_} && !/^%/} @{$d->{'prereqs'}};
1745                 $rinfo->{'prereq'} = \@prereqs if @prereqs;
1746               }
1747               # KIWI Products need local arch added, if we have it defined on this server
1748               push @{$d->{'exclarch'}}, 'local' if (defined($d->{'exclarch'}) && $type eq 'kiwi' && $d->{'imagetype'}[0] eq 'product' && defined($BSConfig::localarch));
1749               $rinfo->{'error'} = 'excluded' if $d->{'exclarch'} && !grep {$_ eq $arch} @{$d->{'exclarch'}};
1750               $rinfo->{'error'} = 'excluded' if $d->{'badarch'} && grep {$_ eq $arch} @{$d->{'badarch'}};
1751               for ('imagetype', 'path', 'extrasource') {
1752                 $rinfo->{$_} = $d->{$_} if exists $d->{$_};
1753               }
1754             } else {
1755               $rinfo->{'error'} = "can not parse package name from $file";
1756               $rinfo->{'error'} .= " because: ".$d->{'error'} if $d->{'error'};
1757             }
1758           }
1759           $pinfo->{'info'} = \@dinfo if @dinfo;
1760         }
1761       }
1762     }
1763     $jinfo->{'package'} = \@pinfo;
1764     push @res, $jinfo;
1765   }
1766   my $ret = {'project' => \@res};
1767   if ($withremotemap && %remotemap) {
1768     for (sort keys %remotemap) {
1769       next unless $remotemap{$_};
1770       my $r = {'project' => $_, 'remoteurl' => $remotemap{$_}->{'remoteurl'}, 'remoteproject' => $remotemap{$_}->{'remoteproject'}};
1771       push @{$ret->{'remotemap'}}, $r;
1772     }
1773   }
1774   return ($ret, $BSXML::projpack);
1775 }
1776
1777 sub getprojectlist {
1778   my ($cgi) = @_;
1779   my @projects = findprojects();
1780   @projects = map {{'name' => $_}} @projects;
1781   return ({'entry' => \@projects}, $BSXML::dir);
1782 }
1783
1784 sub getproject {
1785   my ($cgi, $projid) = @_;
1786   # Read the project xml file
1787   my $proj = checkprojrepoarch($projid, undef, undef, 1);
1788   $proj = BSRPC::rpc("$proj->{'remoteurl'}/source/$proj->{'remoteproject'}/_meta", $BSXML::proj) if $proj->{'remoteurl'};
1789   return ($proj, $BSXML::proj);
1790 }
1791
1792 sub createkey {
1793   my ($cgi, $projid) = @_;
1794   die("don't know how to create a key\n") unless $BSConfig::sign;
1795   die("404 project $projid does not exist\n") unless -s "$projectsdir/$projid.xml";
1796   mkdir_p($uploaddir);
1797   local *F;
1798   my $pubkey = '';
1799   my @keyargs = ('dsa@1024', '800');
1800   my @signargs;
1801   push @signargs, '--project', $projid if $BSConfig::sign_project;
1802   my $obsname = $BSConfig::obsname || 'build.opensuse.org';
1803   open(F, '-|', $BSConfig::sign, @signargs, '-P', "$uploaddir/signkey.$$", '-g', @keyargs , "$projid OBS Project", "$projid\@$obsname") || die("$BSConfig::sign: $!\n");
1804   1 while sysread(F, $pubkey, 4096, length($pubkey));
1805   close(F) || die("$BSConfig::sign: $?\n");
1806   die("sign did not create signkey\n") unless -s "$uploaddir/signkey.$$";
1807   mkdir_p("$projectsdir/$projid.pkg");
1808   writestr("$uploaddir/pubkey.$$", "$projectsdir/$projid.pkg/_pubkey", $pubkey);
1809   if (!rename("$uploaddir/signkey.$$", "$projectsdir/$projid.pkg/_signkey")) {
1810     unlink("$projectsdir/$projid/_pubkey");
1811     die("rename $uploaddir/signkey.$$ $projectsdir/$projid.pkg/_signkey: $!\n");
1812   }
1813   return $BSStdServer::return_ok;
1814 }
1815
1816 sub deletekey {
1817   my ($cgi, $projid) = @_;
1818   if ($BSConfig::forceprojectkeys) {
1819     my $pprojid = $projid;
1820     $pprojid =~ s/:[^:]*$//;
1821     my $sk;
1822     ($sk) = getsignkey({}, $pprojid) if $projid ne $pprojid;
1823     die("must have a key for signing\n") unless $sk;
1824   }
1825   unlink("$projectsdir/$projid.pkg/_signkey");
1826   unlink("$projectsdir/$projid.pkg/_pubkey");
1827   rmdir("$projectsdir/$projid.pkg");
1828   return $BSStdServer::return_ok;
1829 }
1830
1831 sub getpubkey {
1832   my ($cgi, $projid) = @_;
1833   my $pubkey = readstr("$projectsdir/$projid.pkg/_pubkey", 1);
1834   die("$projid: no pubkey available\n") unless $pubkey;
1835   return ($pubkey, 'Content-Type: text/plain');
1836 }
1837
1838 sub projectcmd {
1839   my ($cgi, $projid) = @_;
1840   my $cmd = $cgi->{'cmd'};
1841   return createkey($cgi, $projid) if $cmd eq 'createkey';
1842   die("unknown command '$cmd'\n");
1843 }
1844
1845 sub putproject {
1846   my ($cgi, $projid) = @_;
1847   mkdir_p($uploaddir);
1848   my $uploaded = BSServer::read_file("$uploaddir/$$");
1849   die("upload failed\n") unless $uploaded;
1850   my $proj = readxml("$uploaddir/$$", $BSXML::proj);
1851   $proj->{'name'} = $projid unless defined $proj->{'name'};
1852   BSVerify::verify_proj($proj, $projid);
1853   writexml("$uploaddir/$$.2", undef, $proj, $BSXML::proj);
1854   unlink("$uploaddir/$$");
1855   my $oldproj = readxml("$projectsdir/$projid.xml", $BSXML::proj, 1);
1856   BSHermes::notify($oldproj ? "SRCSRV_UPDATE_PROJECT" : "SRCSRV_CREATE_PROJECT", { "project" => $projid, "sender" => ($cgi->{'user'} || "unknown") });
1857   mkdir_p("$projectsdir") || die("creating $projectsdir: $!\n");
1858   rename("$uploaddir/$$.2", "$projectsdir/$projid.xml") || die("rename to $projectsdir/$projid.xml: $!\n");
1859   if ($BSConfig::forceprojectkeys) {
1860     my ($sk) = getsignkey({}, $projid);
1861     createkey({}, $projid) if $sk eq '';
1862   }
1863
1864   if (!identical($oldproj, $proj, 'title', 'description', 'person', 'group', 'url', 'attributes')) {
1865     notify_repservers('project', $projid);
1866   }
1867
1868   $proj = readproj($projid);
1869   return ($proj, $BSXML::proj);
1870 }
1871
1872 sub delproject {
1873   my ($cgi, $projid) = @_;
1874
1875   die("404 project '$projid' does not exist\n") unless -e "$projectsdir/$projid.xml";
1876   if (-d "$projectsdir/$projid.pkg") {
1877     # delete those packages and keys
1878     for my $f (ls("$projectsdir/$projid.pkg")) {
1879       unlink("$projectsdir/$projid.pkg/$f");
1880     }
1881     rmdir("$projectsdir/$projid.pkg") || die("rmdir $projectsdir/$projid.pkg: $!\n");
1882   }
1883   unlink("$projectsdir/$projid.conf");
1884   unlink("$projectsdir/$projid.xml");
1885   notify_repservers('project', $projid);
1886
1887   BSHermes::notify("SRCSRV_DELETE_PROJECT", { "project" => $projid, "sender" => ($cgi->{'user'} || "unknown") });
1888
1889   return $BSStdServer::return_ok;
1890 }
1891
1892 ##########################################################################
1893
1894 sub getpackagelist {
1895   my ($cgi, $projid, $repoid, $arch) = @_;
1896   my $proj = checkprojrepoarch($projid, $repoid, $arch, 1);
1897   if ($proj->{'remoteurl'}) {
1898     return BSRPC::rpc("$proj->{'remoteurl'}/source/$proj->{'remoteproject'}", $BSXML::dir), $BSXML::dir;
1899   }
1900   my @packages = findpackages($projid, $proj);
1901   my @plist = map {{'name' => $_}} @packages;
1902   return ({'entry' => \@plist}, $BSXML::dir);
1903 }
1904
1905 sub getpackage {
1906   my ($cgi, $projid, $packid) = @_;
1907   my $proj = checkprojrepoarch($projid, undef, undef, 1);
1908   if ($proj->{'remoteurl'}) {
1909     my $pack = BSRPC::rpc("$proj->{'remoteurl'}/source/$proj->{'remoteproject'}/$packid/_meta", $BSXML::pack);
1910     return ($pack, $BSXML::pack);
1911   }
1912   my $pack = readpack($projid, $packid, 1);
1913   if (!$pack && $proj->{'link'}) {
1914     my %checked = ($projid => 1);
1915     my @todo = map {$_->{'project'}} @{$proj->{'link'}};
1916     while (@todo) {
1917       my $lprojid = shift @todo;
1918       next if $checked{$lprojid};
1919       $checked{$lprojid} = 1;
1920       my $lproj = readproj($lprojid, 1);
1921       $lproj = remoteprojid($lprojid) if !$lproj || $lproj->{'remoteurl'};
1922       if ($lproj->{'remoteurl'}) {
1923         eval {
1924           $pack = BSRPC::rpc("$lproj->{'remoteurl'}/source/$lproj->{'remoteproject'}/$packid/_meta", $BSXML::pack);
1925         };
1926         die($@) if $@ && $@ !~ /^404/;
1927       } else {
1928         $pack = readpack($lprojid, $packid, 1);
1929         unshift @todo, map {$_->{'project'}} @{$lproj->{'link'}} if !$pack && $lproj->{'link'};
1930       }
1931       last if $pack;
1932     }
1933   }
1934   die("404 package '$packid' does not exist in project '$projid'\n") unless $pack;
1935   return ($pack, $BSXML::pack);
1936 }
1937
1938 sub putpackage {
1939   my ($cgi, $projid, $packid) = @_;
1940   mkdir_p($uploaddir);
1941   my $uploaded = BSServer::read_file("$uploaddir/$$");
1942   die("upload failed\n") unless $uploaded;
1943   my $pack = readxml("$uploaddir/$$", $BSXML::pack);
1944   $pack->{'name'} = $packid unless defined $pack->{'name'};
1945   BSVerify::verify_pack($pack, $packid);
1946   die("package contains revision data\n") if grep {exists $pack->{$_}} @$srcrevlay;
1947   # XXX
1948   # delete rev stuff, just in case...
1949   # delete $pack->{$_} for @$srcrevlay;
1950   # $pack->{'name'} = $packid;
1951   writexml("$uploaddir/$$.2", undef, $pack, $BSXML::pack);
1952   unlink("$uploaddir/$$");
1953   my $proj = readproj($projid);
1954   die("package '$packid' is read-only\n") if ($packid =~ /^_product:/) && ! -e "$projectsdir/$projid.pkg/$packid.xml";
1955   mkdir_p("$projectsdir/$projid.pkg");
1956
1957   my $oldpack = readxml("$projectsdir/$projid.pkg/$packid.xml", $BSXML::pack, 1);
1958   BSHermes::notify($oldpack ? "SRCSRV_UPDATE_PACKAGE" : "SRCSRV_CREATE_PACKAGE", { "project" => $projid, "package" => $packid, "sender" => ($cgi->{'user'} || "unknown")});
1959   rename("$uploaddir/$$.2", "$projectsdir/$projid.pkg/$packid.xml") || die("rename to $projectsdir/$projid.pkg/$packid.xml: $!\n");
1960
1961   if (!identical($oldpack, $pack, 'title', 'description', 'devel', 'person', 'group', 'url')) {
1962     notify_repservers('package', $projid, $packid);
1963   }
1964
1965   $pack = readpack($projid, $packid);
1966   return ($pack, $BSXML::pack);
1967 }
1968
1969 sub delpackage {
1970   my ($cgi, $projid, $packid) = @_;
1971   die("404 project '$projid' does not exist\n") unless -e "$projectsdir/$projid.xml";
1972   die("404 package '$packid' does not exist in project '$projid'\n") unless -e "$projectsdir/$projid.pkg/$packid.xml";
1973   die("403 package '$packid' is read-only\n") if $packid =~ /^_product:/;
1974   unlink("$projectsdir/$projid.pkg/$packid.upload-MD5SUMS");
1975   unlink("$projectsdir/$projid.pkg/$packid.rev");
1976   unlink("$projectsdir/$projid.pkg/$packid.xml");
1977   if ($packid eq '_product') {
1978     expandproduct($projid, $packid, undef);
1979   }
1980   notify_repservers('package', $projid, $packid);
1981   BSHermes::notify("SRCSRV_DELETE_PACKAGE", { "project" => $projid, "package" => $packid, "sender" => ($cgi->{'user'} || "unknown") });
1982
1983   return $BSStdServer::return_ok;
1984 }
1985
1986 sub getpackagehistory {
1987   my ($cgi, $projid, $packid) = @_;
1988   my @res;
1989   for (BSFileDB::fdb_getall("$projectsdir/$projid.pkg/$packid.rev", $srcrevlay)) {
1990     next if $cgi->{'rev'} && $cgi->{'rev'} ne $_->{'rev'} && $cgi->{'rev'} ne $_->{'srcmd5'};
1991     $_->{'comment'} = str2utf8xml($_->{'comment'}) if $_->{'comment'};
1992     push @res, $_;
1993   }
1994   return ({'revision' => \@res}, $BSXML::revisionlist);
1995 }
1996
1997 ##########################################################################
1998
1999 ##########################################################################
2000
2001 # XXX -> library
2002
2003 sub remoteprojid {
2004   my ($projid) = @_;
2005   my $rsuf = '';
2006   my $origprojid = $projid;
2007
2008   my $proj = readproj($projid, 1);
2009   if ($proj) {
2010     return undef unless $proj->{'remoteurl'};
2011     return undef unless $proj->{'remoteproject'};
2012     return {
2013       'name' => $projid,
2014       'root' => $projid,
2015       'remoteroot' => $proj->{'remoteproject'},
2016       'remoteurl' => $proj->{'remoteurl'},
2017       'remoteproject' => $proj->{'remoteproject'},
2018     };
2019   }
2020   while ($projid =~ /^(.*)(:.*?)$/) {
2021     $projid = $1;
2022     $rsuf = "$2$rsuf";
2023     $proj = readproj($projid, 1);
2024     if ($proj) {
2025       return undef unless $proj->{'remoteurl'};
2026       if ($proj->{'remoteproject'}) {
2027         $rsuf = "$proj->{'remoteproject'}$rsuf";
2028       } else {
2029         $rsuf =~ s/^://;
2030       }
2031       return {
2032         'name' => $origprojid,
2033         'root' => $projid,
2034         'remoteroot' => $proj->{'remoteproject'},
2035         'remoteurl' => $proj->{'remoteurl'},
2036         'remoteproject' => $rsuf,
2037       };
2038     }
2039   }
2040   return undef;
2041 }
2042
2043 sub maptoremote {
2044   my ($proj, $projid) = @_;
2045   return "$proj->{'root'}:$projid" unless $proj->{'remoteroot'};
2046   return $proj->{'root'} if $projid eq $proj->{'remoteroot'};
2047   return '_unavailable' if $projid !~ /^\Q$proj->{'remoteroot'}\E:(.*)$/;
2048   return "$proj->{'root'}:$1";
2049 }
2050
2051 sub fetchremoteproj {
2052   my ($proj, $projid) = @_;
2053   return undef unless $proj && $proj->{'remoteurl'} && $proj->{'remoteproject'};
2054   $projid ||= $proj->{'name'};
2055   print "fetching remote project data for $projid\n";
2056   my $param = {
2057     'uri' => "$proj->{'remoteurl'}/source/$proj->{'remoteproject'}/_meta",
2058     'timeout' => 60,
2059   };
2060   my $rproj = BSRPC::rpc($param, $BSXML::proj);
2061   return undef unless $rproj;
2062   for (qw{name root remoteroot remoteurl remoteproject}) {
2063     $rproj->{$_} = $proj->{$_};
2064   }
2065   for my $repo (@{$rproj->{'repository'} || []}) {
2066     for my $pathel (@{$repo->{'path'} || []}) {
2067       $pathel->{'project'} = maptoremote($proj, $pathel->{'project'});
2068     }
2069   }
2070   for my $link (@{$rproj->{'link'} || []}) {
2071     $link->{'project'} = maptoremote($proj, $link->{'project'});
2072   }
2073   return $rproj;
2074 }
2075
2076 sub fetchremoteconfig {
2077   my ($proj, $projid) = @_;
2078   return undef unless $proj && $proj->{'remoteurl'} && $proj->{'remoteproject'};
2079   $projid ||= $proj->{'name'};
2080   print "fetching remote project config for $projid\n";
2081   my $param = {
2082     'uri' => "$proj->{'remoteurl'}/source/$proj->{'remoteproject'}/_config",
2083     'timeout' => 60,
2084   };
2085   return BSRPC::rpc($param, undef);
2086 }
2087
2088 sub remote_getrev {
2089   my ($projid, $packid, $rev, $linked, $missingok) = @_;
2090   my $proj = remoteprojid($projid);
2091   if (!$proj) {
2092     return {'project' => $projid, 'package' => $packid, 'srcmd5' => 'empty'} if $missingok;
2093     die("404 package '$packid' does not exist\n") if -e "$projectsdir/$projid.xml";
2094     die("404 project '$projid' does not exist\n");
2095   }
2096   my @args;
2097   push @args, 'expand';
2098   push @args, "rev=$rev" if defined $rev;
2099   my $dir;
2100   eval {
2101     $dir = BSRPC::rpc("$proj->{'remoteurl'}/source/$proj->{'remoteproject'}/$packid", $BSXML::dir, @args, 'withlinked') if $linked;
2102   };
2103   if (!$dir || $@) {
2104     eval {
2105       $dir = BSRPC::rpc("$proj->{'remoteurl'}/source/$proj->{'remoteproject'}/$packid", $BSXML::dir, @args);
2106     };
2107     if ($@) {
2108       return {'project' => $projid, 'package' => $packid, 'srcmd5' => 'empty'} if $missingok && $@ =~ /^404[^\d]/;
2109       die($@);
2110     }
2111   }
2112   die("$dir->{'error'}\n") if $dir->{'error'};
2113   $rev = {};
2114   $rev->{'rev'} = $dir->{'rev'} || $dir->{'srcmd5'};
2115   $rev->{'srcmd5'} = $dir->{'srcmd5'};
2116   $rev->{'vrev'} = $dir->{'vrev'};
2117   $rev->{'vrev'} ||= '0';
2118   # now put everything in local srcrep
2119   my $files = {};
2120   for my $entry (@{$dir->{'entry'} || []}) {
2121     $files->{$entry->{'name'}} = $entry->{'md5'};
2122     next if -e "$srcrep/$packid/$entry->{'md5'}-$entry->{'name'}";
2123     if ($linked && $entry->{'size'} > 8192) {
2124       # getprojpack request, hand over to AJAX
2125       BSHandoff::rpc($ajaxsocket, "/source/$projid/$packid", undef, "rev=$dir->{'srcmd5'}");
2126       die("download in progress\n");
2127     }
2128     mkdir_p($uploaddir);
2129     my $param = {
2130       'uri' => "$proj->{'remoteurl'}/source/$proj->{'remoteproject'}/$packid/$entry->{'name'}",
2131       'filename' => "$uploaddir/$$",
2132       'withmd5' => 1,
2133       'receiver' => \&BSHTTP::file_receiver,
2134     };
2135     my $res = BSRPC::rpc($param, undef, "rev=$rev->{'srcmd5'}");
2136     die("file download failed\n") unless $res && $res->{'md5'} eq $entry->{'md5'};
2137     addfile($projid, $packid, "$uploaddir/$$", $entry->{'name'}, $entry->{'md5'});
2138   }
2139   my $srcmd5 = addmeta($projid, $packid, $files);
2140   if ($dir->{'linkinfo'}) {
2141     $dir->{'srcmd5'} = $rev->{'srcmd5'} = $srcmd5;
2142     $rev->{'rev'} = $rev->{'srcmd5'} unless $dir->{'rev'};
2143     if ($linked) {
2144       # add linked info for getprojpack
2145       my $li = $dir->{'linkinfo'};
2146       if ($li->{'linked'}) {
2147         for my $l (@{$li->{'linked'}}) {
2148           $l->{'project'} = maptoremote($proj, $l->{'project'});
2149           push @$linked, $l if defined($l->{'project'}) && $l->{'project'} ne '_unavailable';
2150         }
2151         undef $li;
2152       }
2153       while ($li) {
2154         my $lprojid = $li->{'project'};
2155         my $lpackid = $li->{'package'};
2156         last unless defined($lprojid) && defined($lpackid);
2157         my $mlprojid = maptoremote($proj, $lprojid);
2158         last unless defined($mlprojid) && $mlprojid ne '_unavailable';
2159         push @$linked, {'project' => $mlprojid, 'package' => $lpackid};
2160         last unless $li->{'srcmd5'} && !$li->{'error'};
2161         my $ldir;
2162         eval {
2163           $ldir = BSRPC::rpc("$proj->{'remoteurl'}/source/$lprojid/$lpackid", $BSXML::dir, "rev=$li->{'srcmd5'}");
2164         };
2165         last if $@ || !$ldir;
2166         $li = $ldir->{'linkinfo'};
2167       }
2168     }
2169   }
2170   die("srcmd5 mismatch\n") if $dir->{'srcmd5'} ne $srcmd5;
2171   $rev->{'project'} = $projid;
2172   $rev->{'package'} = $packid;
2173   return $rev;
2174 }
2175
2176 sub expandsearchpath {
2177   my ($projid, $repoid) = @_;
2178   my %done;
2179   my @ret;
2180   my @path = {project => $projid, repository => $repoid};
2181   while (@path) {
2182     my $t = shift @path;
2183     my $prp = "$t->{'project'}/$t->{'repository'}";
2184     push @ret, $prp unless $done{$prp};
2185     $done{$prp} = 1;
2186     if (!@path) {
2187       last if $done{"/$prp"};
2188       my ($pid, $tid) = ($t->{'project'}, $t->{'repository'});
2189       my $proj = readproj($pid, 1);
2190       if (!$proj || $proj->{'remoteurl'}) {
2191         $proj = remoteprojid($pid);
2192         $proj = fetchremoteproj($proj, $pid);
2193         die("404 project '$pid' does not exist\n") unless $proj;
2194       }
2195       $done{"/$prp"} = 1;       # mark expanded
2196       my @repo = grep {$_->{'name'} eq $tid} @{$proj->{'repository'} || []};
2197       push @path, @{$repo[0]->{'path'}} if @repo && $repo[0]->{'path'};
2198     }
2199   }
2200   return @ret;
2201 }
2202
2203 sub getconfig {
2204   my ($cgi, $projid, $repoid) = @_;
2205   my @path = expandsearchpath($projid, $repoid);
2206   if ($cgi->{'path'}) {
2207     @path = @{$cgi->{'path'}};
2208     # XXX: commented out to make it consistent to the scheduler
2209     # unshift @path, "$projid/$repoid" unless @path && $path[0] eq "$projid/$repoid";
2210   }
2211   my $config = "%define _project $projid\n";
2212   my $macros = '';
2213
2214   #$macros .= "%vendor openSUSE Build Service\n";
2215
2216   # find the sign project, this is what we use as vendor
2217   my $vprojid = $projid;
2218   while ($vprojid ne '') {
2219     last if -s "$projectsdir/$vprojid.pkg/_signkey";
2220     $vprojid =~ s/[^:]*$//;
2221     $vprojid =~ s/:$//;
2222   }
2223   $vprojid = $projid if $vprojid eq '';
2224   my $obsname = $BSConfig::obsname || 'build.opensuse.org';
2225   $macros .= "%vendor obs://$obsname/$vprojid\n";
2226
2227   $macros .= "%_project $projid\n";
2228   my $lastr = '';
2229
2230   my $distinfo = "$projid / $repoid";
2231   if ($repoid eq 'standard') {
2232     $distinfo = $projid;
2233   } 
2234
2235   for my $prp (reverse @path) {
2236     if ($prp eq "$projid/$repoid") {
2237       $macros .= "\n%distribution $distinfo\n";
2238       $macros .= "%_project $projid\n";
2239     }
2240     my ($p, $r) = split('/', $prp, 2);
2241     my $c;
2242     if (-s "$projectsdir/$p.conf") {
2243       $c = readstr("$projectsdir/$p.conf");
2244     } elsif (!-e "$projectsdir/$p.xml") {
2245       my $proj = remoteprojid($p);
2246       $c = fetchremoteconfig($proj, $p);
2247     }
2248     next unless defined $c;
2249     $config .= "\n### from $p\n";
2250     $config .= "%define _repository $r\n";
2251     if ($c =~ /^(.*\n)?\s*macros:[^\n]*\n(.*)/si) {
2252       $c = defined($1) ? $1 : '';
2253       $macros .= "\n### from $p\n";
2254       $macros .= "%_repository $r\n";
2255       $macros .= $2;
2256       $lastr = $r;
2257     }
2258     $config .= $c;
2259   }
2260   if ($lastr ne $repoid) {
2261     $macros .= "\n### from $projid\n";
2262     $macros .= "%_repository $repoid\n";
2263   }
2264   if (!@path || $path[0] ne "$projid/$repoid") {
2265     $macros .= "\n%distribution $distinfo\n";
2266     $macros .= "%_project $projid\n";
2267   }
2268   if ($BSConfig::extramacros) {
2269     for (sort keys %{$BSConfig::extramacros}) {
2270       $macros .= $BSConfig::extramacros->{$_} if $projid =~ /$_/;
2271     }
2272   }
2273   $config .= "\nMacros:\n$macros" if $macros ne '';
2274   return ($config, 'Content-Type: text/plain');
2275 }
2276
2277 sub getprojectconfig {
2278   my ($cgi, $projid) = @_;
2279   my $proj = readproj($projid);
2280   my $config = readstr("$projectsdir/$projid.conf", 1);
2281   $config = '' unless defined $config;
2282   return ($config, 'Content-Type: text/plain');
2283 }
2284
2285 sub putprojectconfig {
2286   my ($cgi, $projid) = @_;
2287   my $proj = readproj($projid);
2288   mkdir_p($uploaddir);
2289   my $uploaded = BSServer::read_file("$uploaddir/$$");
2290   die("upload failed\n") unless $uploaded;
2291   if (-s "$uploaddir/$$") {
2292     rename("$uploaddir/$$", "$projectsdir/$projid.conf") || die("rename $uploaddir/$$ $projectsdir/$projid.conf: $!\n");
2293   } else {
2294     unlink("$projectsdir/$projid.conf");
2295   }
2296   notify_repservers('project', $projid);
2297   BSHermes::notify("SRCSRV_UPDATE_PROJECT_CONFIG", { "project" => $projid, "sender" => ($cgi->{'user'} || "unknown") });
2298
2299   return $BSStdServer::return_ok;
2300 }
2301
2302 ##########################################################################
2303
2304 sub getsources {
2305   my ($cgi, $projid, $packid, $srcmd5) = @_;
2306   my $rev = {'project' => $projid, 'package' => $packid, 'srcmd5' => $srcmd5};
2307   my $files = lsrev($rev);
2308   my @send = map {{'name' => $_, 'filename' => "$srcrep/$packid/$files->{$_}-$_"}} keys %$files;
2309   BSServer::reply_cpio(\@send);
2310   return undef;
2311 }
2312
2313 sub detach {
2314   my $jev = $BSServerEvents::gev;
2315   return unless exists $jev->{'fd'};
2316   my $ev = BSEvents::new('never');
2317   for (keys %$jev) {
2318     $ev->{$_} = $jev->{$_} unless $_ eq 'id' || $_ eq 'handler' || $_ eq 'fd';
2319   }
2320   $jev->{'conf'}->{'stdreply'}->(@_) if $jev->{'conf'}->{'stdreply'};
2321   $BSServerEvents::gev = $ev;
2322   return $ev;
2323 }
2324
2325 my %getfilelist_ajax_inprogress;
2326
2327 sub getfilelist_ajax {
2328   my ($cgi, $projid, $packid) = @_;
2329
2330   my $jev = $BSServerEvents::gev;
2331   if (!$jev->{'remoteurl'}) {
2332     die unless $cgi->{'rev'};
2333     my $proj = remoteprojid($projid);
2334     die("missing project/package\n") unless $proj;
2335     $jev->{'remoteurl'} = $proj->{'remoteurl'};
2336     $jev->{'remoteproject'} = $proj->{'remoteproject'};
2337   }
2338   if (!$jev->{'filelist'}) {
2339     my $rev = $cgi->{'rev'};
2340     return $BSStdServer::return_ok if $getfilelist_ajax_inprogress{"$projid/$packid/$rev"};
2341     my $param = {
2342       'uri' => "$jev->{'remoteurl'}/source/$jev->{'remoteproject'}/$packid",
2343     };
2344     $jev->{'filelist'} = BSWatcher::rpc($param, $BSXML::dir, "rev=$rev");
2345     return undef unless $jev->{'filelist'};
2346     $jev = detach($BSStdServer::return_ok);
2347     $jev->{'idstring'} = "$projid/$packid/$rev";
2348     $getfilelist_ajax_inprogress{"$projid/$packid/$rev"} = $jev;
2349     $jev->{'handler'} = sub {delete $getfilelist_ajax_inprogress{"$projid/$packid/$rev"}};
2350   }
2351   my $serial;
2352   my $dir = $jev->{'filelist'};
2353   for my $entry (@{$dir->{'entry'} || []}) {
2354     next if -e "$srcrep/$packid/$entry->{'md5'}-$entry->{'name'}";
2355     $serial ||= BSWatcher::serialize("$jev->{'remoteurl'}/source");
2356     mkdir_p($uploaddir);
2357     my $param = {
2358       'uri' => "$jev->{'remoteurl'}/source/$jev->{'remoteproject'}/$packid/$entry->{'name'}",
2359       'filename' => "$uploaddir/$$-$jev->{'id'}",
2360       'withmd5' => 1,
2361       'receiver' => \&BSHTTP::file_receiver,
2362     };
2363     my $res = BSWatcher::rpc($param, undef, "rev=$cgi->{'rev'}");
2364     return undef unless $res;
2365     die("file download failed\n") unless $res && $res->{'md5'} eq $entry->{'md5'};
2366     die unless -e "$uploaddir/$$-$jev->{'id'}";
2367     addfile($projid, $packid, "$uploaddir/$$-$jev->{'id'}", $entry->{'name'}, $entry->{'md5'});
2368   }
2369   BSWatcher::serialize_end($serial) if $serial;
2370   notify_repservers('package', $projid, $packid);
2371   return undef;
2372 }
2373
2374 sub getfilelist {
2375   my ($cgi, $projid, $packid) = @_;
2376
2377   my $view = $cgi->{'view'};
2378   my $rev = getrev($projid, $packid, defined($cgi->{'rev'}) ? $cgi->{'rev'} : 'upload');
2379   my $li = {};
2380   my $files = lsrev($rev, $li);
2381
2382   if ($files->{'_link'}) {
2383     if ($cgi->{'emptylink'}) {
2384       my $l = repreadxml($rev, '_link', $files->{'_link'}, $BSXML::link);
2385       delete $l->{'patches'};
2386       mkdir_p($uploaddir);
2387       writexml("$uploaddir/$$", undef, $l, $BSXML::link);
2388       $files = {};
2389       $files->{'_link'} = addfile($projid, $packid, "$uploaddir/$$", '_link');
2390       $rev = addrev($projid, $packid, $files, undef, undef, '');
2391     }
2392     my %lrev = %$rev;
2393     $lrev{'linkrev'} = $cgi->{'linkrev'} if $cgi->{'linkrev'};
2394     $li->{'linked'} = [] if $cgi->{'withlinked'};
2395     my $lfiles = handlelinks(\%lrev, $files, $li);
2396     if ($cgi->{'expand'}) {
2397       die("$lfiles\n") if !ref $lfiles;
2398       $files = $lfiles;
2399       %$rev = %lrev;
2400       $rev->{'rev'} = $rev->{'srcmd5'};
2401     } else {
2402       if (ref $lfiles) {
2403         $li->{'xsrcmd5'} = $lrev{'srcmd5'};
2404       } else {
2405         # link is broken
2406         $li->{'error'} = $lfiles;
2407         # set xsrcmd5 if we have a link error file
2408         $li->{'xsrcmd5'} = $lrev{'srcmd5'} if $lrev{'srcmd5'} && -e "$srcrep/$packid/$lrev{'srcmd5'}-_linkerror";
2409         if ($cgi->{'lastworking'}) {
2410           my $lastworking = findlastworkinglink($rev);
2411           $li->{'lastworking'} = $lastworking if $lastworking;
2412         }
2413       }
2414     }
2415   }
2416
2417   if ($cgi->{'extension'}) {
2418     for (keys %$files) {
2419       delete $files->{$_} unless /\.\Q$cgi->{'extension'}\E$/;
2420     }
2421   }
2422
2423   if ($view && $view eq 'cpio') {
2424     my @files = map {{'name' => $_, 'filename' => "$srcrep/$packid/$files->{$_}-$_"}} sort keys %$files;
2425     BSServer::reply_cpio(\@files);
2426     return undef;
2427   }
2428
2429   my $ret = {};
2430   $ret->{'name'} = $packid;
2431   $ret->{'srcmd5'} = $rev->{'srcmd5'} if $rev->{'srcmd5'} ne 'empty';
2432   $ret->{'rev'} = $rev->{'rev'} if exists $rev->{'rev'};
2433   $ret->{'vrev'} = $rev->{'vrev'} if exists $rev->{'vrev'};
2434   my @res;
2435   for my $filename (sort keys %$files) {
2436     my @s = repstat($rev, $filename, $files->{$filename});
2437     if (@s) {
2438       push @res, {'name' => $filename, 'md5' => $files->{$filename}, 'size' => $s[7], 'mtime' => $s[9]};
2439     } else {
2440       push @res, {'name' => $filename, 'md5' => $files->{$filename}, 'error' => "$!"};
2441     }
2442   }
2443   if (%$li) {
2444     linkinfo_addtarget($rev, $li);
2445     $ret->{'linkinfo'} = $li;
2446   }
2447   $ret->{'entry'} = \@res;
2448   return ($ret, $BSXML::dir);
2449 }
2450
2451 sub getfile {
2452   my ($cgi, $projid, $packid, $filename) = @_;
2453   die("no filename\n") unless defined($filename) && $filename ne '';
2454   die("bad filename\n") if $filename =~ /\// || $filename =~ /^\./;
2455   my $rev = getrev($projid, $packid, defined($cgi->{'rev'}) ? $cgi->{'rev'} : 'upload');
2456   my $files = lsrev($rev);
2457   die("404 $filename: no such file\n") unless $files->{$filename};
2458   my @s = repstat($rev, $filename, $files->{$filename});
2459   die("$projid/$packid/$files->{$filename}-$filename: $!\n") unless @s;
2460   local *F;
2461   repopen($rev, $filename, $files->{$filename}, \*F) || die("$projid/$packid/$files->{$filename}-$filename: $!\n");
2462   BSServer::reply_file(\*F);
2463   return undef;
2464 }
2465
2466 sub putfile {
2467   my ($cgi, $projid, $packid, $filename) = @_;
2468   die("no filename\n") unless defined($filename) && $filename ne '';
2469   die("bad filename\n") if $filename =~ /\// || $filename =~ /^\./;
2470   my $rev = getrev($projid, $packid, defined($cgi->{'rev'}) ? $cgi->{'rev'} : 'upload');
2471   die("file '$filename' is read-only\n") if ($filename =~ /^_service:/) && !$cgi->{'force'};
2472   mkdir_p($uploaddir);
2473   my $uploaded = BSServer::read_file("$uploaddir/$$", 'withmd5' => 1);
2474   die("upload failed\n") unless $uploaded;
2475   addfile($projid, $packid, "$uploaddir/$$", $filename, $uploaded->{'md5'});
2476   # create new meta file
2477   my $files = lsrev($rev);
2478   $files->{$filename} = $uploaded->{'md5'};
2479   $files = keeplink($cgi, $projid, $packid, $files) if $cgi->{'keeplink'};
2480   my $user = defined($cgi->{'user'}) ? $cgi->{'user'} : 'unknown';
2481   my $comment = defined($cgi->{'comment'}) ? $cgi->{'comment'} : '';
2482   $rev = addrev($projid, $packid, $files, $user, $comment, $cgi->{'rev'});
2483 # update happens only on commit atm, or we would modify on file upload time ...
2484 # sourceupdate($projid, $packid) if $files->{'_service'} && not ($rev eq 'upload');
2485   delete $rev->{'project'};
2486   delete $rev->{'package'};
2487   return ($rev, $BSXML::revision);
2488 }
2489
2490 sub sourcediff {
2491   my ($cgi, $projid, $packid) = @_;
2492
2493   my $oprojid = exists($cgi->{'oproject'}) ? $cgi->{'oproject'} : $projid;
2494   my $opackid = exists($cgi->{'opackage'}) ? $cgi->{'opackage'} : $packid;
2495   my $fmax = 200;
2496   my $tmax = 16000;
2497
2498   my $rev = getrev($projid, $packid, defined($cgi->{'rev'}) ? $cgi->{'rev'} : 'upload', undef, $cgi->{'missingok'});
2499   my $files = lsrev($rev);
2500   my $orev = $cgi->{'orev'};
2501   if (!defined($cgi->{'oproject'}) && !defined($cgi->{'opackage'}) && !defined($cgi->{'orev'}) && $rev->{'rev'}) {
2502     $orev = $rev->{'rev'} - 1;
2503   }
2504   $orev = getrev($oprojid, $opackid, defined($orev) ? $orev : 'latest', undef, $cgi->{'missingok'});
2505   my $ofiles = lsrev($orev);
2506   if ($cgi->{'expand'} || ($files->{'_link'} && !$ofiles->{'_link'}) || ($ofiles->{'_link'} && !$files->{'_link'})) {
2507     # expand links
2508     if ($files->{'_link'}) {
2509       $rev->{'linkrev'} = $cgi->{'linkrev'} if $cgi->{'linkrev'};
2510       my %li;
2511       my $l = repreadxml($rev, '_link', $files->{'_link'}, $BSXML::link, 1);
2512       $l->{'project'} = $rev->{'project'} unless defined $l->{'project'};
2513       $l->{'package'} = $rev->{'package'} unless defined $l->{'package'};
2514       $files = handlelinks($rev, $files, \%li);
2515       die("bad link: $files\n") unless ref $files;
2516       if ($l && $cgi->{'linkrev'} && $l->{'project'} eq $oprojid && $l->{'package'} eq $opackid && !$l->{'rev'} && !$cgi->{'orev'}) {
2517         # we're diffing against the link target. As the user specified a baserev, we should use it
2518         # instead of the latest source
2519         $orev = getrev($oprojid, $opackid, $li{'srcmd5'});
2520         $ofiles = lsrev($orev);
2521       }
2522     }
2523     if ($ofiles->{'_link'}) {
2524       $orev->{'linkrev'} = $cgi->{'olinkrev'} if $cgi->{'olinkrev'};
2525       $ofiles = handlelinks($orev, $ofiles);
2526       die("bad link: $ofiles\n") unless ref $ofiles;
2527     }
2528   }
2529   my $cacheid = "$orev->{'srcmd5'}/$rev->{'srcmd5'}";
2530   $cacheid .= "/unified:$cgi->{'unified'}" if $cgi->{'unified'};
2531   $cacheid .= "/fmax:$fmax" if defined $fmax;
2532   $cacheid .= "/tmax:$tmax" if defined $tmax;
2533   $cacheid = Digest::MD5::md5_hex($cacheid);
2534   local *F;
2535   my $cn = "$diffcache/".substr($cacheid, 0, 2)."/$cacheid";
2536   if (open(F, '<', $cn)) {
2537     utime(time, time, $cn);
2538     BSServer::reply_file(\*F, 'Content-Type: text/plain');
2539     return undef;
2540   }
2541   my $tmpdir = "$uploaddir/srcdiff$$";
2542   my $d = BSSrcdiff::diff("$srcrep/$opackid", $ofiles, $orev->{'rev'}, "$srcrep/$packid", $files, $rev->{'rev'}, $fmax, $tmax, $tmpdir, $cgi->{'unified'});
2543   mkdir_p("$diffcache/".substr($cacheid, 0, 2));
2544   writestr("$diffcache/.new$$", $cn, $d);
2545   return ($d, 'Content-Type: text/plain');
2546 }
2547
2548 sub linkdiff {
2549   my ($cgi, $projid, $packid) = @_;
2550   my $rev = getrev($projid, $packid, defined($cgi->{'rev'}) ? $cgi->{'rev'} : 'upload');
2551   $rev->{'linkrev'} = $cgi->{'linkrev'} if $cgi->{'linkrev'};
2552   my $linkinfo = {};
2553   my $files = lsrev_expanded($rev, $linkinfo);
2554   die("not a link\n") unless $linkinfo->{'srcmd5'};
2555   linkinfo_addtarget($rev, $linkinfo);
2556   return sourcediff({
2557     'oproject' => $linkinfo->{'project'},
2558     'opackage' => $linkinfo->{'package'},
2559     'orev' => $linkinfo->{'srcmd5'},
2560     'rev' => $rev->{'srcmd5'},
2561   }, $projid, $packid);
2562 }
2563
2564 sub isascii {
2565   my ($file) = @_;
2566   local *F;
2567   open(F, '<', $file) || die("$file: $!\n");
2568   my $buf = '';
2569   sysread(F, $buf, 4096);
2570   close F;
2571   return 1 unless $buf =~ /[\000-\010\016-\037]/s;
2572   return 0;
2573 }
2574
2575 sub rundiff {
2576   my ($file1, $file2, $label, $outfile) = @_;
2577   my $pid;
2578   if (!($pid = xfork())) {
2579     if (!open(STDOUT, '>>', $outfile)) {
2580       print STDERR "$outfile: $!\n";
2581       exit(2);
2582     }
2583     exec('diff', '-up', '--label', "$label.orig", '--label', $label, $file1, $file2);
2584     exit(2);
2585   }
2586   waitpid($pid, 0) == $pid || die("waitpid $pid: $!\n");
2587   my $status = $?;
2588   return 1 if $status == 0 || $status == 0x100;
2589   return undef;
2590 }
2591
2592 sub findprojectpatchname {
2593   my ($files) = @_;
2594
2595   my $i = "";
2596   while ($files->{"project$i.diff"}) {
2597     $i = '0' unless $i;
2598     $i++;
2599   }
2600   return "project$i.diff";
2601 }
2602
2603 #
2604 # we are going to commit files to projid/packid, all data is already present
2605 # in the src repository.
2606 # if it was a link before, try to keep this link
2607 # files: expanded file set
2608 #
2609 sub keeplink {
2610   my ($cgi, $projid, $packid, $files, $orev) = @_;
2611
2612   my $repair = $cgi->{'repairlink'};
2613   return $files if !defined($files) || !%$files;
2614   return $files if $files->{'_link'};
2615   $orev ||= getrev($projid, $packid, 'latest');
2616   my $ofilesl = lsrev($orev);
2617   return $files unless $ofilesl && $ofilesl->{'_link'};
2618   my $l = repreadxml($orev, '_link', $ofilesl->{'_link'}, $BSXML::link);
2619   my $changedlink = 0;
2620   my %lignore;
2621   my $isbranch;
2622
2623   if (@{$l->{'patches'}->{''} || []} == 1) {
2624     my $type = (keys %{$l->{'patches'}->{''}->[0]})[0];
2625     if ($type eq 'branch') {
2626       $isbranch = 1;
2627     }
2628   }
2629   undef $isbranch if $cgi->{'convertbranchtopatch'};
2630
2631   if (!$isbranch && $l->{'patches'}) {
2632     if ($repair) {
2633       for (@{$l->{'patches'}->{''} || []}) {
2634         my $type = (keys %$_)[0];
2635         if ($type eq 'apply' || $type eq 'delete' || $changedlink) {
2636           $lignore{$_->{$type}->{'name'}} = 1 if $type ne 'topadd' && $type ne 'delete';
2637           $_ = undef;
2638           $changedlink = 1;
2639         }
2640       }
2641     } else {
2642       for (reverse @{$l->{'patches'}->{''} || []}) {
2643         my $type = (keys %$_)[0];
2644         if ($type eq 'apply' || $type eq 'delete' || $type eq 'branch') {
2645           $lignore{$_->{$type}->{'name'}} = 1 if $type eq 'apply';
2646           $_ = undef;
2647           $changedlink = 1;
2648           next;
2649         }
2650         last;
2651       }
2652     }
2653     $l->{'patches'}->{''} = [ grep {defined($_)} @{$l->{'patches'}->{''}} ];
2654   }
2655
2656   my $linkrev = $cgi->{'linkrev'};
2657   $linkrev = $l->{'baserev'} if $linkrev && $linkrev eq 'base';
2658
2659   my $ltgtsrcmd5;
2660   my $ofiles;
2661   my $ofilesdir;
2662   if (!$repair) {
2663     # expand old link
2664     my %olrev = %$orev;
2665     my %li;
2666     $olrev{'linkrev'} = $linkrev if $linkrev;
2667     $ofiles = handlelinks(\%olrev, $ofilesl, \%li);
2668     die("bad link: $ofiles\n") unless ref $ofiles;
2669     $ltgtsrcmd5 = $li{'srcmd5'};
2670     $ofilesdir = "$srcrep/$packid";
2671   }
2672
2673   # get link target file list
2674   my $ltgtprojid = defined($l->{'project'}) ? $l->{'project'} : $projid;
2675   my $ltgtpackid = defined($l->{'package'}) ? $l->{'package'} : $packid;
2676   my $ltgtfiles;
2677   if ($ltgtsrcmd5) {
2678     my $ltgtrev = {'project' => $ltgtprojid, 'package' => $ltgtpackid, 'srcmd5' => $ltgtsrcmd5};
2679     $ltgtfiles = lsrev($ltgtrev);
2680   } else {
2681     my $ltgtrev = getrev($ltgtprojid, $ltgtpackid, $linkrev || $l->{'rev'});
2682     $ltgtfiles = lsrev_expanded($ltgtrev);
2683     $ltgtsrcmd5 = $ltgtrev->{'srcmd5'};
2684   }
2685
2686   # easy for branches: just copy file list and update baserev
2687   if ($isbranch) {
2688     my $nfiles = { %$files };
2689     my $baserev = $linkrev || $ltgtsrcmd5;
2690     if (($l->{'baserev'} || '') ne $baserev) {
2691       $l->{'baserev'} = $baserev;
2692       $l->{'patches'}->{''} = [ { 'branch' => undef} ]; # work around xml problem
2693       mkdir_p($uploaddir);
2694       writexml("$uploaddir/$$", undef, $l, $BSXML::link);
2695       $nfiles->{'_link'} = addfile($projid, $packid, "$uploaddir/$$", '_link')
2696     } else {
2697       $nfiles->{'_link'} = $ofilesl->{'_link'};
2698     }
2699     return $nfiles;
2700   }
2701
2702   if ($cgi->{'convertbranchtopatch'}) {
2703     $ofilesl = {};
2704     $ofiles = $ltgtfiles;
2705     $ofilesdir = "$srcrep/$ltgtpackid";
2706   } elsif ($repair || $changedlink) {
2707     # apply changed link
2708     my $frominfo = {'project' => $ltgtprojid, 'package' => $ltgtpackid, 'srcmd5' => $ltgtsrcmd5};
2709     my $linkinfo = {'project' => $projid, 'package' => $packid, 'srcmd5' => $orev->{'srcmd5'}, 'link' => $l};
2710     $linkinfo->{'ignore'} = \%lignore;
2711     $ofiles = applylink(undef, $frominfo, $linkinfo);
2712     die("bad link: $ofiles\n") unless ref $ofiles;
2713     $ofilesdir = "$uploaddir/applylink$$";
2714   }
2715
2716   #print "-- ofilesl:\n";
2717   #print "  $ofilesl->{$_}  $_\n" for sort keys %$ofilesl;
2718   #print "-- ofiles:\n";
2719   #print "  $ofiles->{$_}  $_\n" for sort keys %$ofiles;
2720   #print "-- files:\n";
2721   #print "  $files->{$_}  $_\n" for sort keys %$files;
2722
2723   # now create diff between old $ofiles and $files
2724   my $nfiles = { %$ofilesl };
2725   delete $nfiles->{$_} for keys %lignore;       # no longer used in link
2726   mkdir_p($uploaddir);
2727   unlink("$uploaddir/$$");
2728   my @dfiles;
2729   for my $file (sort keys %{{%$files, %$ofiles}}) {
2730     if ($ofiles->{$file}) {
2731       if (!$files->{$file}) {
2732         if (!$ltgtfiles->{$file} && $ofilesl->{$file} && $ofilesl->{$file} eq ($ofiles->{$file} || '')) {
2733           # local file no longer needed
2734           delete $nfiles->{$file};
2735         }
2736         push @dfiles, $file;
2737         delete $nfiles->{$file};
2738         next;
2739       }
2740       if ($ofiles->{$file} eq $files->{$file}) {
2741         next;
2742       }
2743       if (!isascii("$srcrep/$packid/$files->{$file}-$file") || !isascii("$ofilesdir/$ofiles->{$file}-$file")) {
2744         $nfiles->{$file} = $files->{$file};
2745         next;
2746       }
2747     } else {
2748       if (!isascii("$srcrep/$packid/$files->{$file}-$file")) {
2749         $nfiles->{$file} = $files->{$file};
2750         next;
2751       }
2752     }
2753     if (($ofilesl->{$file} || '') eq ($ofiles->{$file} || '')) {
2754       # link did not change file, just record new content
2755       if ($files->{$file} eq ($ltgtfiles->{$file} || '')) {
2756         # local overwrite already in link target
2757         delete $nfiles->{$file};
2758         next;
2759       }
2760       $nfiles->{$file} = $files->{$file};
2761       next;
2762     }
2763     # both are ascii, create diff
2764     mkdir_p($uploaddir);
2765     if (!rundiff($ofiles->{$file} ? "$ofilesdir/$ofiles->{$file}-$file" : '/dev/null', "$srcrep/$packid/$files->{$file}-$file", $file, "$uploaddir/$$")) {
2766       $nfiles->{$file} = $files->{$file};
2767     }
2768   }
2769   my $lchanged;
2770   $lchanged = 1 if $changedlink;
2771   for (@dfiles) {
2772     push @{$l->{'patches'}->{''}}, {'delete' => {'name' => $_}};
2773     $lchanged = 1;
2774   }
2775   if (-s "$uploaddir/$$") {
2776     my $ppatch = findprojectpatchname($nfiles);
2777     $nfiles->{$ppatch} = addfile($projid, $packid, "$uploaddir/$$", $ppatch);
2778     push @{$l->{'patches'}->{''}}, {'apply' => {'name' => $ppatch}};
2779     $lchanged = 1;
2780   } else {
2781     unlink("$uploaddir/$$");
2782   }
2783   my $baserev = $linkrev || $ltgtsrcmd5;
2784   if (($l->{'baserev'} || '') ne $baserev) {
2785     $l->{'baserev'} = $baserev;
2786     $lchanged = 1;
2787   }
2788   if ($lchanged) {
2789     writexml("$uploaddir/$$", undef, $l, $BSXML::link);
2790     $nfiles->{'_link'} = addfile($projid, $packid, "$uploaddir/$$", '_link')
2791   }
2792   if ($ofilesdir eq "$uploaddir/applylink$$") {
2793     BSUtil::cleandir("$uploaddir/applylink$$");
2794     rmdir("$uploaddir/applylink$$");
2795   }
2796   return $nfiles;
2797 }
2798
2799 # integrate link from opackid to packid into packid
2800 sub integratelink {
2801   my ($files, $projid, $packid, $rev, $ofiles, $oprojid, $opackid, $l, $orev) = @_;
2802
2803   # append patches from link l to link nl
2804   my $nl = repreadxml($rev, '_link', $files->{'_link'}, $BSXML::link);
2805
2806   # FIXME: remove hunks from patches that deal with replaced/deleted files
2807   my $nlchanged;
2808   my %dontcopy;
2809   $dontcopy{'_link'} = 1;
2810   my $nlisbranch;
2811   if ($nl->{'patches'}) {
2812     for (@{$nl->{'patches'}->{''} || []}) {
2813       my $type = (keys %$_)[0];
2814       if ($type eq 'add' || $type eq 'apply') {
2815         $dontcopy{$_->{$type}->{'name'}} = 1;
2816       }
2817       $nlisbranch = 1 if $type eq 'branch';
2818     }
2819   }
2820   my $lisbranch;
2821   if ($l->{'patches'}) {
2822     for (@{$l->{'patches'}->{''} || []}) {
2823       my $type = (keys %$_)[0];
2824       $lisbranch = 1 if $type eq 'branch';
2825     }
2826   }
2827
2828   if ($nlisbranch) {
2829     # we linked/branched a branch. expand.
2830     #my %xrev = (%$rev, 'linkrev' => 'base');
2831     my %xrev = %$rev;
2832     my $linkinfo = {};
2833     lsrev_expanded(\%xrev, $linkinfo);
2834     my %oxrev = (%$orev, 'linkrev' => $xrev{'srcmd5'});
2835     $ofiles = lsrev_expanded(\%oxrev);
2836     copyfiles($projid, $packid, $oprojid, $opackid, $ofiles);
2837     # find new base
2838     if ($linkinfo->{'srcmd5'} ne $nl->{'baserev'}) {
2839       # update base rev
2840       $nl->{'baserev'} = $linkinfo->{'srcmd5'};
2841       $nlchanged = 1;
2842     }
2843     # delete everything but the link
2844     delete $files->{$_} for grep {$_ ne '_link'} keys %$files;
2845   }
2846
2847   if ($lisbranch && !$nlisbranch) {
2848     # we branched a link. convert branch to link
2849     # and integrate
2850     delete $ofiles->{'_link'};
2851     $ofiles = keeplink({'convertbranchtopatch' => 1, 'linkrev' => 'base'}, $oprojid, $opackid, $ofiles, $orev);
2852     $l = repreadxml($orev, '_link', $ofiles->{'_link'}, $BSXML::link);
2853   }
2854
2855   if (!$nlisbranch && $l->{'patches'}) {
2856     for (@{$l->{'patches'}->{''} || []}) {
2857       my $type = (keys %$_)[0];
2858       if ($type eq 'delete' && $files->{$_->{'delete'}->{'name'}}) {
2859         delete $files->{$_->{'delete'}->{'name'}};
2860       } else {
2861         $nlchanged = 1;
2862         $nl->{'patches'} ||= {};
2863         if ($type eq 'apply') {
2864           my $oppatch = $_->{'apply'}->{'name'};
2865           if ($files->{$oppatch}) {
2866             $dontcopy{$oppatch} = 1;
2867             # argh, patch file already exists, rename...
2868             my $ppatch = findprojectpatchname($files);
2869             mkdir_p($uploaddir);
2870             unlink("$uploaddir/$$");
2871             link("$srcrep/$opackid/$ofiles->{$oppatch}-$oppatch", "$uploaddir/$$") || die("link $srcrep/$opackid/$ofiles->{$oppatch}-$oppatch $uploaddir/$$: $!\n");
2872             $files->{$ppatch} = addfile($projid, $packid, "$uploaddir/$$", $ppatch);
2873             push @{$nl->{'patches'}->{''}}, {'apply' => {'name' => $ppatch}};
2874             next;
2875           }
2876         }
2877         if ($type eq 'add') {
2878           my $oppatch = $_->{'add'}->{'name'};
2879           die("cannot apply patch $oppatch twice\n") if $dontcopy{$oppatch};
2880         }
2881         push @{$nl->{'patches'}->{''}}, $_;
2882       }
2883     }
2884   }
2885   if ($nlchanged) {
2886     mkdir_p($uploaddir);
2887     writexml("$uploaddir/$$", undef, $nl, $BSXML::link);
2888     $files->{'_link'} = addfile($projid, $packid, "$uploaddir/$$", '_link');
2889   }
2890   for (sort keys %$ofiles) {
2891     next if $dontcopy{$_};
2892     $files->{$_} = $ofiles->{$_};
2893   }
2894   return $files;
2895 }
2896
2897 sub sourcecommit {
2898   my ($cgi, $projid, $packid) = @_;
2899   my $rev = getrev($projid, $packid, defined($cgi->{'rev'}) ? $cgi->{'rev'} : 'upload');
2900   my $files = lsrev($rev);
2901   $files = keeplink($cgi, $projid, $packid, $files) if $cgi->{'keeplink'};
2902   my $user = defined($cgi->{'user'}) ? $cgi->{'user'} : 'unknown';
2903   my $comment = defined($cgi->{'comment'}) ? $cgi->{'comment'} : '';
2904   $rev = addrev($projid, $packid, $files, $user, $comment);
2905   if ($files->{'_service'} && !$cgi->{'noservice'}) {
2906     my $sslockfile = "$eventdir/service/${projid}::$packid";
2907     mkdir_p("$eventdir/service");
2908     BSUtil::touch($sslockfile);
2909     sourceupdate($projid, $packid, $sslockfile);
2910   }
2911   delete $rev->{'project'};
2912   delete $rev->{'package'};
2913   return ($rev, $BSXML::revision);
2914 }
2915
2916 sub sourcecommitfilelist {
2917   my ($cgi, $projid, $packid) = @_;
2918   mkdir_p($uploaddir);
2919   my $uploaded = BSServer::read_file("$uploaddir/$$");
2920   die("upload failed\n") unless $uploaded;
2921   my $fl = readxml("$uploaddir/$$", $BSXML::dir);
2922   unlink("$srcrep/:upload/$$");
2923   # make sure we know every file
2924   my @missing;
2925   my $files = {};
2926   for my $entry (@{$fl->{'entry'} || []}) {
2927     BSVerify::verify_filename($entry->{'name'});
2928     BSVerify::verify_md5($entry->{'md5'});
2929     if (! -e "$srcrep/$packid/$entry->{'md5'}-$entry->{'name'}") {
2930       push @missing, $entry;
2931     } else {
2932       die("duplicate file: $entry->{'name'}\n") if exists $files->{$entry->{'name'}};
2933       $files->{$entry->{'name'}} = $entry->{'md5'};
2934     }
2935   }
2936   if (@missing) {
2937     my $res = {'name' => $packid, 'error' => 'missing', 'entry' => \@missing};
2938     return ($res, $BSXML::dir);
2939   }
2940
2941   $files = keeplink($cgi, $projid, $packid, $files) if $cgi->{'keeplink'};
2942   my $user = defined($cgi->{'user'}) ? $cgi->{'user'} : 'unknown';
2943   my $comment = defined($cgi->{'comment'}) ? $cgi->{'comment'} : '';
2944   if (-e "$projectsdir/$projid.pkg/$packid.upload-MD5SUMS") {
2945     # autocommit old update revision so that it doesn't get lost
2946     my $uploadrev = {'project' => $projid, 'package' => $packid, 'srcmd5' => 'upload'};
2947     my $uploadfiles = lsrev($uploadrev);
2948     addrev($projid, $packid, $uploadfiles, $user, 'autocommit', undef, $cgi->{'requestid'});
2949   }
2950   my $rev = addrev($projid, $packid, $files, $user, $comment, undef, $cgi->{'requestid'});
2951
2952   $cgi->{'rev'} = $rev->{'rev'};
2953   return getfilelist($cgi, $projid, $packid);
2954 }
2955
2956 sub sourcecopy {
2957   my ($cgi, $projid, $packid) = @_;
2958   die("illegal rev parameter\n") if $cgi->{'rev'} && $cgi->{'rev'} ne 'upload';
2959   my $oprojid = exists($cgi->{'oproject'}) ? $cgi->{'oproject'} : $projid;
2960   my $opackid = exists($cgi->{'opackage'}) ? $cgi->{'opackage'} : $packid;
2961   my $orev = $cgi->{'orev'};
2962   $orev = getrev($oprojid, $opackid, defined($orev) ? $orev : 'latest');
2963   $orev->{'linkrev'} = $cgi->{'olinkrev'} if $cgi->{'olinkrev'};
2964   my $files = lsrev($orev);
2965   die("need a revision to copy\n") if !$cgi->{'rev'} && !$cgi->{'orev'} && $oprojid eq $projid && $opackid eq $packid && !($files->{'_link'} && $cgi->{'expand'});
2966
2967   my $autosimplifylink;
2968
2969   if ($files->{'_link'} && !$cgi->{'dontupdatesource'} && !$cgi->{'rev'}) {
2970     # fix me: do this in a more generic way
2971     my $ol = repreadxml($orev, '_link', $files->{'_link'}, $BSXML::link, 1);
2972     if ($ol) {
2973       my $lprojid = $oprojid;
2974       my $lpackid = $opackid;
2975       my $lrev = $ol->{'rev'};
2976       $lprojid = $ol->{'project'} if exists $ol->{'project'};
2977       $lpackid = $ol->{'package'} if exists $ol->{'package'};
2978       if ($lprojid eq $projid && $lpackid eq $packid) {
2979         # copy destination is target of link
2980         # we're integrating this link
2981         $lrev = getrev($lprojid, $lpackid, $lrev);
2982         my $lfiles = lsrev($lrev);
2983         if ($lfiles->{'_link'} && !$cgi->{'expand'}) {
2984           # link to a link, join
2985           $files = integratelink($lfiles, $lprojid, $lpackid, $lrev, $files, $oprojid, $opackid, $ol, $orev);
2986         } else {
2987           # auto expand
2988           $cgi->{'expand'} = 1;
2989         }
2990         $autosimplifylink = $ol;
2991       }
2992     }
2993   }
2994
2995   if ($files->{'_link'} && $cgi->{'expand'}) {
2996     my %olrev = %$orev;         # copy so that orev still points to unexpanded sources
2997     $files = handlelinks(\%olrev, $files);
2998     die("broken link: $files\n") unless ref $files;
2999   }
3000
3001   copyfiles($projid, $packid, $oprojid, $opackid, $files);
3002
3003   $files = keeplink($cgi, $projid, $packid, $files) if $cgi->{'keeplink'};
3004   my $user = defined($cgi->{'user'}) ? $cgi->{'user'} : 'unknown';
3005   my $comment = defined($cgi->{'comment'}) ? $cgi->{'comment'} : '';
3006   my $rev = addrev($projid, $packid, $files, $user, $comment, $cgi->{'rev'}, $cgi->{'requestid'});
3007
3008   if ($autosimplifylink && !$autosimplifylink->{'rev'}) {
3009     my $isbranch = grep {(keys %$_)[0] eq 'branch'} @{$autosimplifylink->{'patches'}->{''} || []};
3010     if ($isbranch) {
3011       # update base rev so that there are no changes
3012       # FIXME: this is a gross hack...
3013       # we should not need to update the baserev, instead we should change
3014       # the way branches get applied
3015       my $ofiles = lsrev($orev);
3016       delete $ofiles->{'_link'};
3017       copyfiles($projid, $packid, $oprojid, $opackid, $ofiles);
3018       my $newbase = addmeta($projid, $packid, $ofiles);
3019       if ($autosimplifylink->{'baserev'} ne $newbase) {
3020         eval {
3021           my $latestorev = getrev($oprojid, $opackid);
3022           my $latestfiles = lsrev($latestorev);
3023           if ($latestfiles->{'_link'}) {
3024             my $latestl = repreadxml($latestorev, '_link', $latestfiles->{'_link'}, $BSXML::link, 1);
3025             my $latestisbranch = grep {(keys %$_)[0] eq 'branch'} @{$latestl->{'patches'}->{''} || []};
3026             if ($latestisbranch && $latestl->{'baserev'} eq $autosimplifylink->{'baserev'}) {
3027               $latestl->{'baserev'} = $newbase;
3028               $latestl->{'patches'}->{''} = [ { 'branch' => undef} ]; # work around xml problem
3029               mkdir_p($uploaddir);
3030               writexml("$uploaddir/$$", undef, $latestl, $BSXML::link);
3031               $latestfiles->{'_link'} = addfile($oprojid, $opackid, "$uploaddir/$$", '_link');
3032               addrev($oprojid, $opackid, $latestfiles, 'buildservice-autocommit', "baserev update by copy to link target\n", undef, $cgi->{'requestid'});
3033             }
3034           }
3035         };
3036         warn($@) if $@;
3037       }
3038     } else {
3039       eval {
3040         my $latestorev = getrev($oprojid, $opackid);
3041         if ($latestorev->{'srcmd5'} eq $orev->{'srcmd5'}) {
3042           # simplify link
3043           my $nl = {};
3044           $nl->{'project'} = $autosimplifylink->{'project'} if $autosimplifylink->{'project'};
3045           $nl->{'package'} = $autosimplifylink->{'package'} if $autosimplifylink->{'package'};
3046           $nl->{'cicount'} = $autosimplifylink->{'cicount'} if $autosimplifylink->{'cicount'};
3047           mkdir_p($uploaddir);
3048           writexml("$uploaddir/$$", undef, $nl, $BSXML::link);
3049           my $ofiles = {};
3050           $ofiles->{'_link'} = addfile($oprojid, $opackid, "$uploaddir/$$", '_link');
3051           addrev($oprojid, $opackid, $ofiles, 'buildservice-autocommit', "auto commit by copy to link target\n", undef, $cgi->{'requestid'});
3052         }
3053       };
3054       warn($@) if $@;
3055     }
3056   }
3057
3058   delete $rev->{'project'};
3059   delete $rev->{'package'};
3060   return ($rev, $BSXML::revision);
3061 }
3062
3063 sub sourcebranch {
3064   my ($cgi, $projid, $packid) = @_;
3065
3066   my $usebranch = 1;
3067   my $oprojid = exists($cgi->{'oproject'}) ? $cgi->{'oproject'} : $projid;
3068   my $opackid = exists($cgi->{'opackage'}) ? $cgi->{'opackage'} : $packid;
3069   my $orev = $cgi->{'orev'};
3070   die("cannot branch myself\n") if $oprojid eq $projid && $opackid eq $packid;
3071   $orev = getrev($oprojid, $opackid);
3072   $orev->{'linkrev'} = $cgi->{'olinkrev'} if $cgi->{'olinkrev'};
3073   my $files = lsrev_expanded($orev);
3074   my $l = {};
3075   $l->{'project'} = $oprojid if $oprojid ne $projid;
3076   $l->{'package'} = $opackid if $opackid ne $projid;
3077   $l->{'rev'} = $cgi->{'orev'} if defined $cgi->{'orev'};
3078   $l->{'baserev'} = $orev->{'srcmd5'};
3079   my $lfiles = {};
3080   mkdir_p("$srcrep/$packid");
3081   if ($usebranch) {
3082     $l->{'patches'}->{''} = [ { 'branch' => undef} ];
3083     copyfiles($projid, $packid, $oprojid, $opackid, $files);
3084     $lfiles->{$_} = $files->{$_} for keys %$files;
3085   }
3086   mkdir_p($uploaddir);
3087   writexml("$uploaddir/$$", undef, $l, $BSXML::link);
3088   $lfiles->{'_link'} = addfile($projid, $packid, "$uploaddir/$$", '_link');
3089   my $user = defined($cgi->{'user'}) ? $cgi->{'user'} : 'unknown';
3090   my $comment = defined($cgi->{'comment'}) ? $cgi->{'comment'} : '';
3091   my $rev = addrev($projid, $packid, $lfiles, $user, $comment);
3092   delete $rev->{'project'};
3093   delete $rev->{'package'};
3094   BSHermes::notify("SRCSRV_BRANCH_COMMAND", {project => $projid, package => $packid, targetproject => $oprojid, targetpackage => $opackid,
3095                                              user => $cgi->{'user'}});
3096   return ($rev, $BSXML::revision);
3097 }
3098
3099 sub linktobranch {
3100   my ($cgi, $projid, $packid) = @_;
3101   my $rev = getrev($projid, $packid);
3102   $rev->{'linkrev'} = $cgi->{'linkrev'} if $cgi->{'linkrev'};
3103   my $files = lsrev($rev);
3104   die("package is not a link\n") unless $files->{'_link'};
3105   my $l = repreadxml($rev, '_link', $files->{'_link'}, $BSXML::link);
3106   die("package is already a branch\n") if $l->{'patches'} && grep {(keys %$_)[0] eq 'branch'} @{$l->{'patches'}->{''} || []};
3107   my $linkinfo = {};
3108   $files = lsrev_expanded($rev, $linkinfo);
3109   $l->{'baserev'} = $linkinfo->{'srcmd5'};
3110   $l->{'patches'}->{''} = [ { 'branch' => undef} ];
3111   mkdir_p($uploaddir);
3112   writexml("$uploaddir/$$", undef, $l, $BSXML::link);
3113   $files->{'_link'} = addfile($projid, $packid, "$uploaddir/$$", '_link');
3114   my $user = defined($cgi->{'user'}) ? $cgi->{'user'} : 'unknown';
3115   my $comment = defined($cgi->{'comment'}) ? $cgi->{'comment'} : '';
3116   $comment ||= "converted link to branch";
3117   $rev = addrev($projid, $packid, $files, $user, $comment);
3118   delete $rev->{'project'};
3119   delete $rev->{'package'};
3120   return ($rev, $BSXML::revision);
3121 }
3122
3123 sub deleteuploadrev {
3124   my ($cgi, $projid, $packid) = @_;
3125   unlink("$projectsdir/$projid.pkg/$packid.upload-MD5SUMS");
3126   return $BSStdServer::return_ok;
3127 }
3128
3129 sub unknowncmd {
3130   my ($cgi, $projid, $packid) = @_;
3131   die("unknown command \"$cgi->{'cmd'}\"\n");
3132 }
3133
3134 sub delfile {
3135   my ($cgi, $projid, $packid, $filename) = @_;
3136   die("no filename\n") unless defined($filename) && $filename ne '';
3137   die("bad filename\n") if $filename =~ /\// || $filename =~ /^\./;
3138   die("file '$filename' is read-only\n") if ($filename =~ /^_service:/) && not $cgi->{'force'};
3139   my $rev = getrev($projid, $packid, defined($cgi->{'rev'}) ? $cgi->{'rev'} : 'upload');
3140   my $files = lsrev($rev);
3141   die("404 file '$filename' does not exist\n") unless $files->{$filename};
3142   delete $files->{$filename};
3143   $files = keeplink($projid, $packid, $files) if $cgi->{'keeplink'};
3144   my $user = defined($cgi->{'user'}) ? $cgi->{'user'} : 'unknown';
3145   my $comment = defined($cgi->{'comment'}) ? $cgi->{'comment'} : '';
3146   $rev = addrev($projid, $packid, $files, $user, $comment, $cgi->{'rev'});
3147   delete $rev->{'project'};
3148   delete $rev->{'package'};
3149   return ($rev, $BSXML::revision);
3150 }
3151
3152 sub getrepositorylist {
3153   my ($cgi, $projid) = @_;
3154   my $proj = readproj($projid);
3155   my @res = map {{'name' => $_->{'name'}}} @{$proj->{'repository'} || []};
3156   return ({'entry' => \@res}, $BSXML::dir);
3157 }
3158
3159 sub getrepository {
3160   my ($cgi, $projid, $repoid) = @_;
3161   my $proj = readproj($projid);
3162   my $repo = (grep {$_->{'name'} eq $repoid} @{$proj->{'repository'} || []})[0];
3163   die("404 $repoid: no such repository\n") unless $repo;
3164   return ($repo, $BSXML::repo);
3165 }
3166
3167 sub getarchlist {
3168   my ($cgi, $projid, $repoid) = @_;
3169   my $proj = readproj($projid);
3170   my @repo = grep {$_->{'name'} eq $repoid} @{$proj->{'repository'} || []};
3171   die("404 $repoid: no such repository\n") unless @repo;
3172   my @res = map {{'name' => $_}} @{$repo[0]->{'arch'} || []};
3173   return ({'entry' => \@res}, $BSXML::dir);
3174 }
3175
3176 sub getresult {
3177   my ($cgi, $projid) = @_;
3178
3179   if ($cgi->{'oldstate'} && !$BSStdServer::isajax) {
3180     my @args = "oldstate=$cgi->{'oldstate'}";
3181     push @args, "lastbuild" if $cgi->{'lastbuild'};
3182     push @args, map {"view=$_"} @{$cgi->{'view'} || []};
3183     push @args, map {"repository=$_"} @{$cgi->{'repository'} || []};
3184     push @args, map {"arch=$_"} @{$cgi->{'arch'} || []};
3185     push @args, map {"package=$_"} @{$cgi->{'package'} || []};
3186     push @args, map