- make sourcediff orev logic more predictable
[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);
1913   return ($pack, $BSXML::pack);
1914 }
1915
1916 sub putpackage {
1917   my ($cgi, $projid, $packid) = @_;
1918   mkdir_p($uploaddir);
1919   my $uploaded = BSServer::read_file("$uploaddir/$$");
1920   die("upload failed\n") unless $uploaded;
1921   my $pack = readxml("$uploaddir/$$", $BSXML::pack);
1922   $pack->{'name'} = $packid unless defined $pack->{'name'};
1923   BSVerify::verify_pack($pack, $packid);
1924   die("package contains revision data\n") if grep {exists $pack->{$_}} @$srcrevlay;
1925   # XXX
1926   # delete rev stuff, just in case...
1927   # delete $pack->{$_} for @$srcrevlay;
1928   # $pack->{'name'} = $packid;
1929   writexml("$uploaddir/$$.2", undef, $pack, $BSXML::pack);
1930   unlink("$uploaddir/$$");
1931   my $proj = readproj($projid);
1932   die("package '$packid' is read-only\n") if ($packid =~ /^_product:/) && ! -e "$projectsdir/$projid.pkg/$packid.xml";
1933   mkdir_p("$projectsdir/$projid.pkg");
1934
1935   my $oldpack = readxml("$projectsdir/$projid.pkg/$packid.xml", $BSXML::pack, 1);
1936   BSHermes::notify($oldpack ? "SRCSRV_UPDATE_PACKAGE" : "SRCSRV_CREATE_PACKAGE", { "project" => $projid, "package" => $packid, "sender" => ($cgi->{'user'} || "unknown")});
1937   rename("$uploaddir/$$.2", "$projectsdir/$projid.pkg/$packid.xml") || die("rename to $projectsdir/$projid.pkg/$packid.xml: $!\n");
1938
1939   if (!identical($oldpack, $pack, 'title', 'description', 'devel', 'person', 'group', 'url')) {
1940     notify_repservers('package', $projid, $packid);
1941   }
1942
1943   $pack = readpack($projid, $packid);
1944   return ($pack, $BSXML::pack);
1945 }
1946
1947 sub delpackage {
1948   my ($cgi, $projid, $packid) = @_;
1949   die("404 project '$projid' does not exist\n") unless -e "$projectsdir/$projid.xml";
1950   die("404 package '$packid' does not exist in project '$projid'\n") unless -e "$projectsdir/$projid.pkg/$packid.xml";
1951   die("403 package '$packid' is read-only\n") if $packid =~ /^_product:/;
1952   unlink("$projectsdir/$projid.pkg/$packid.upload-MD5SUMS");
1953   unlink("$projectsdir/$projid.pkg/$packid.rev");
1954   unlink("$projectsdir/$projid.pkg/$packid.xml");
1955   if ($packid eq '_product') {
1956     expandproduct($projid, $packid, undef);
1957   }
1958   notify_repservers('package', $projid, $packid);
1959   BSHermes::notify("SRCSRV_DELETE_PACKAGE", { "project" => $projid, "package" => $packid, "sender" => ($cgi->{'user'} || "unknown") });
1960
1961   return $BSStdServer::return_ok;
1962 }
1963
1964 sub getpackagehistory {
1965   my ($cgi, $projid, $packid) = @_;
1966   my @res;
1967   for (BSFileDB::fdb_getall("$projectsdir/$projid.pkg/$packid.rev", $srcrevlay)) {
1968     next if $cgi->{'rev'} && $cgi->{'rev'} ne $_->{'rev'} && $cgi->{'rev'} ne $_->{'srcmd5'};
1969     $_->{'comment'} = str2utf8xml($_->{'comment'}) if $_->{'comment'};
1970     push @res, $_;
1971   }
1972   return ({'revision' => \@res}, $BSXML::revisionlist);
1973 }
1974
1975 ##########################################################################
1976
1977 ##########################################################################
1978
1979 # XXX -> library
1980
1981 sub remoteprojid {
1982   my ($projid) = @_;
1983   my $rsuf = '';
1984   my $origprojid = $projid;
1985
1986   my $proj = readproj($projid, 1);
1987   if ($proj) {
1988     return undef unless $proj->{'remoteurl'};
1989     return undef unless $proj->{'remoteproject'};
1990     return {
1991       'name' => $projid,
1992       'root' => $projid,
1993       'remoteroot' => $proj->{'remoteproject'},
1994       'remoteurl' => $proj->{'remoteurl'},
1995       'remoteproject' => $proj->{'remoteproject'},
1996     };
1997   }
1998   while ($projid =~ /^(.*)(:.*?)$/) {
1999     $projid = $1;
2000     $rsuf = "$2$rsuf";
2001     $proj = readproj($projid, 1);
2002     if ($proj) {
2003       return undef unless $proj->{'remoteurl'};
2004       if ($proj->{'remoteproject'}) {
2005         $rsuf = "$proj->{'remoteproject'}$rsuf";
2006       } else {
2007         $rsuf =~ s/^://;
2008       }
2009       return {
2010         'name' => $origprojid,
2011         'root' => $projid,
2012         'remoteroot' => $proj->{'remoteproject'},
2013         'remoteurl' => $proj->{'remoteurl'},
2014         'remoteproject' => $rsuf,
2015       };
2016     }
2017   }
2018   return undef;
2019 }
2020
2021 sub maptoremote {
2022   my ($proj, $projid) = @_;
2023   return "$proj->{'root'}:$projid" unless $proj->{'remoteroot'};
2024   return $proj->{'root'} if $projid eq $proj->{'remoteroot'};
2025   return '_unavailable' if $projid !~ /^\Q$proj->{'remoteroot'}\E:(.*)$/;
2026   return "$proj->{'root'}:$1";
2027 }
2028
2029 sub fetchremoteproj {
2030   my ($proj, $projid) = @_;
2031   return undef unless $proj && $proj->{'remoteurl'} && $proj->{'remoteproject'};
2032   $projid ||= $proj->{'name'};
2033   print "fetching remote project data for $projid\n";
2034   my $param = {
2035     'uri' => "$proj->{'remoteurl'}/source/$proj->{'remoteproject'}/_meta",
2036     'timeout' => 60,
2037   };
2038   my $rproj = BSRPC::rpc($param, $BSXML::proj);
2039   return undef unless $rproj;
2040   for (qw{name root remoteroot remoteurl remoteproject}) {
2041     $rproj->{$_} = $proj->{$_};
2042   }
2043   for my $repo (@{$rproj->{'repository'} || []}) {
2044     for my $pathel (@{$repo->{'path'} || []}) {
2045       $pathel->{'project'} = maptoremote($proj, $pathel->{'project'});
2046     }
2047   }
2048   for my $link (@{$rproj->{'link'} || []}) {
2049     $link->{'project'} = maptoremote($proj, $link->{'project'});
2050   }
2051   return $rproj;
2052 }
2053
2054 sub fetchremoteconfig {
2055   my ($proj, $projid) = @_;
2056   return undef unless $proj && $proj->{'remoteurl'} && $proj->{'remoteproject'};
2057   $projid ||= $proj->{'name'};
2058   print "fetching remote project config for $projid\n";
2059   my $param = {
2060     'uri' => "$proj->{'remoteurl'}/source/$proj->{'remoteproject'}/_config",
2061     'timeout' => 60,
2062   };
2063   return BSRPC::rpc($param, undef);
2064 }
2065
2066 sub remote_getrev {
2067   my ($projid, $packid, $rev, $linked, $missingok) = @_;
2068   my $proj = remoteprojid($projid);
2069   if (!$proj) {
2070     return {'project' => $projid, 'package' => $packid, 'srcmd5' => 'empty'} if $missingok;
2071     die("404 package '$packid' does not exist\n") if -e "$projectsdir/$projid.xml";
2072     die("404 project '$projid' does not exist\n");
2073   }
2074   my @args;
2075   push @args, 'expand';
2076   push @args, "rev=$rev" if defined $rev;
2077   my $dir;
2078   eval {
2079     $dir = BSRPC::rpc("$proj->{'remoteurl'}/source/$proj->{'remoteproject'}/$packid", $BSXML::dir, @args, 'withlinked') if $linked;
2080   };
2081   if (!$dir || $@) {
2082     eval {
2083       $dir = BSRPC::rpc("$proj->{'remoteurl'}/source/$proj->{'remoteproject'}/$packid", $BSXML::dir, @args);
2084     };
2085     if ($@) {
2086       return {'project' => $projid, 'package' => $packid, 'srcmd5' => 'empty'} if $missingok && $@ =~ /^404[^\d]/;
2087       die($@);
2088     }
2089   }
2090   die("$dir->{'error'}\n") if $dir->{'error'};
2091   $rev = {};
2092   $rev->{'rev'} = $dir->{'rev'} || $dir->{'srcmd5'};
2093   $rev->{'srcmd5'} = $dir->{'srcmd5'};
2094   $rev->{'vrev'} = $dir->{'vrev'};
2095   $rev->{'vrev'} ||= '0';
2096   # now put everything in local srcrep
2097   my $files = {};
2098   for my $entry (@{$dir->{'entry'} || []}) {
2099     $files->{$entry->{'name'}} = $entry->{'md5'};
2100     next if -e "$srcrep/$packid/$entry->{'md5'}-$entry->{'name'}";
2101     if ($linked && $entry->{'size'} > 8192) {
2102       # getprojpack request, hand over to AJAX
2103       BSHandoff::rpc($ajaxsocket, "/source/$projid/$packid", undef, "rev=$dir->{'srcmd5'}");
2104       die("download in progress\n");
2105     }
2106     mkdir_p($uploaddir);
2107     my $param = {
2108       'uri' => "$proj->{'remoteurl'}/source/$proj->{'remoteproject'}/$packid/$entry->{'name'}",
2109       'filename' => "$uploaddir/$$",
2110       'withmd5' => 1,
2111       'receiver' => \&BSHTTP::file_receiver,
2112     };
2113     my $res = BSRPC::rpc($param, undef, "rev=$rev->{'srcmd5'}");
2114     die("file download failed\n") unless $res && $res->{'md5'} eq $entry->{'md5'};
2115     addfile($projid, $packid, "$uploaddir/$$", $entry->{'name'}, $entry->{'md5'});
2116   }
2117   my $srcmd5 = addmeta($projid, $packid, $files);
2118   if ($dir->{'linkinfo'}) {
2119     $dir->{'srcmd5'} = $rev->{'srcmd5'} = $srcmd5;
2120     $rev->{'rev'} = $rev->{'srcmd5'} unless $dir->{'rev'};
2121     if ($linked) {
2122       # add linked info for getprojpack
2123       my $li = $dir->{'linkinfo'};
2124       if ($li->{'linked'}) {
2125         for my $l (@{$li->{'linked'}}) {
2126           $l->{'project'} = maptoremote($proj, $l->{'project'});
2127           push @$linked, $l if defined($l->{'project'}) && $l->{'project'} ne '_unavailable';
2128         }
2129         undef $li;
2130       }
2131       while ($li) {
2132         my $lprojid = $li->{'project'};
2133         my $lpackid = $li->{'package'};
2134         last unless defined($lprojid) && defined($lpackid);
2135         my $mlprojid = maptoremote($proj, $lprojid);
2136         last unless defined($mlprojid) && $mlprojid ne '_unavailable';
2137         push @$linked, {'project' => $mlprojid, 'package' => $lpackid};
2138         last unless $li->{'srcmd5'} && !$li->{'error'};
2139         my $ldir;
2140         eval {
2141           $ldir = BSRPC::rpc("$proj->{'remoteurl'}/source/$lprojid/$lpackid", $BSXML::dir, "rev=$li->{'srcmd5'}");
2142         };
2143         last if $@ || !$ldir;
2144         $li = $ldir->{'linkinfo'};
2145       }
2146     }
2147   }
2148   die("srcmd5 mismatch\n") if $dir->{'srcmd5'} ne $srcmd5;
2149   $rev->{'project'} = $projid;
2150   $rev->{'package'} = $packid;
2151   return $rev;
2152 }
2153
2154 sub expandsearchpath {
2155   my ($projid, $repoid) = @_;
2156   my %done;
2157   my @ret;
2158   my @path = {project => $projid, repository => $repoid};
2159   while (@path) {
2160     my $t = shift @path;
2161     my $prp = "$t->{'project'}/$t->{'repository'}";
2162     push @ret, $prp unless $done{$prp};
2163     $done{$prp} = 1;
2164     if (!@path) {
2165       last if $done{"/$prp"};
2166       my ($pid, $tid) = ($t->{'project'}, $t->{'repository'});
2167       my $proj = readproj($pid, 1);
2168       if (!$proj || $proj->{'remoteurl'}) {
2169         $proj = remoteprojid($pid);
2170         $proj = fetchremoteproj($proj, $pid);
2171         die("404 project '$pid' does not exist\n") unless $proj;
2172       }
2173       $done{"/$prp"} = 1;       # mark expanded
2174       my @repo = grep {$_->{'name'} eq $tid} @{$proj->{'repository'} || []};
2175       push @path, @{$repo[0]->{'path'}} if @repo && $repo[0]->{'path'};
2176     }
2177   }
2178   return @ret;
2179 }
2180
2181 sub getconfig {
2182   my ($cgi, $projid, $repoid) = @_;
2183   my @path = expandsearchpath($projid, $repoid);
2184   if ($cgi->{'path'}) {
2185     @path = @{$cgi->{'path'}};
2186     # XXX: commented out to make it consistent to the scheduler
2187     # unshift @path, "$projid/$repoid" unless @path && $path[0] eq "$projid/$repoid";
2188   }
2189   my $config = "%define _project $projid\n";
2190   my $macros = '';
2191
2192   #$macros .= "%vendor openSUSE Build Service\n";
2193
2194   # find the sign project, this is what we use as vendor
2195   my $vprojid = $projid;
2196   while ($vprojid ne '') {
2197     last if -s "$projectsdir/$vprojid.pkg/_signkey";
2198     $vprojid =~ s/[^:]*$//;
2199     $vprojid =~ s/:$//;
2200   }
2201   $vprojid = $projid if $vprojid eq '';
2202   my $obsname = $BSConfig::obsname || 'build.opensuse.org';
2203   $macros .= "%vendor obs://$obsname/$vprojid\n";
2204
2205   $macros .= "%_project $projid\n";
2206   my $lastr = '';
2207
2208   my $distinfo = "$projid / $repoid";
2209   if ($repoid eq 'standard') {
2210     $distinfo = $projid;
2211   } 
2212
2213   for my $prp (reverse @path) {
2214     if ($prp eq "$projid/$repoid") {
2215       $macros .= "\n%distribution $distinfo\n";
2216       $macros .= "%_project $projid\n";
2217     }
2218     my ($p, $r) = split('/', $prp, 2);
2219     my $c;
2220     if (-s "$projectsdir/$p.conf") {
2221       $c = readstr("$projectsdir/$p.conf");
2222     } elsif (!-e "$projectsdir/$p.xml") {
2223       my $proj = remoteprojid($p);
2224       $c = fetchremoteconfig($proj, $p);
2225     }
2226     next unless defined $c;
2227     $config .= "\n### from $p\n";
2228     $config .= "%define _repository $r\n";
2229     if ($c =~ /^(.*\n)?\s*macros:[^\n]*\n(.*)/si) {
2230       $c = defined($1) ? $1 : '';
2231       $macros .= "\n### from $p\n";
2232       $macros .= "%_repository $r\n";
2233       $macros .= $2;
2234       $lastr = $r;
2235     }
2236     $config .= $c;
2237   }
2238   if ($lastr ne $repoid) {
2239     $macros .= "\n### from $projid\n";
2240     $macros .= "%_repository $repoid\n";
2241   }
2242   if (!@path || $path[0] ne "$projid/$repoid") {
2243     $macros .= "\n%distribution $distinfo\n";
2244     $macros .= "%_project $projid\n";
2245   }
2246   if ($BSConfig::extramacros) {
2247     for (sort keys %{$BSConfig::extramacros}) {
2248       $macros .= $BSConfig::extramacros->{$_} if $projid =~ /$_/;
2249     }
2250   }
2251   $config .= "\nMacros:\n$macros" if $macros ne '';
2252   return ($config, 'Content-Type: text/plain');
2253 }
2254
2255 sub getprojectconfig {
2256   my ($cgi, $projid) = @_;
2257   my $proj = readproj($projid);
2258   my $config = readstr("$projectsdir/$projid.conf", 1);
2259   $config = '' unless defined $config;
2260   return ($config, 'Content-Type: text/plain');
2261 }
2262
2263 sub putprojectconfig {
2264   my ($cgi, $projid) = @_;
2265   my $proj = readproj($projid);
2266   mkdir_p($uploaddir);
2267   my $uploaded = BSServer::read_file("$uploaddir/$$");
2268   die("upload failed\n") unless $uploaded;
2269   if (-s "$uploaddir/$$") {
2270     rename("$uploaddir/$$", "$projectsdir/$projid.conf") || die("rename $uploaddir/$$ $projectsdir/$projid.conf: $!\n");
2271   } else {
2272     unlink("$projectsdir/$projid.conf");
2273   }
2274   notify_repservers('project', $projid);
2275   BSHermes::notify("SRCSRV_UPDATE_PROJECT_CONFIG", { "project" => $projid, "sender" => ($cgi->{'user'} || "unknown") });
2276
2277   return $BSStdServer::return_ok;
2278 }
2279
2280 ##########################################################################
2281
2282 sub getsources {
2283   my ($cgi, $projid, $packid, $srcmd5) = @_;
2284   my $rev = {'project' => $projid, 'package' => $packid, 'srcmd5' => $srcmd5};
2285   my $files = lsrev($rev);
2286   my @send = map {{'name' => $_, 'filename' => "$srcrep/$packid/$files->{$_}-$_"}} keys %$files;
2287   BSServer::reply_cpio(\@send);
2288   return undef;
2289 }
2290
2291 sub detach {
2292   my $jev = $BSServerEvents::gev;
2293   return unless exists $jev->{'fd'};
2294   my $ev = BSEvents::new('never');
2295   for (keys %$jev) {
2296     $ev->{$_} = $jev->{$_} unless $_ eq 'id' || $_ eq 'handler' || $_ eq 'fd';
2297   }
2298   $jev->{'conf'}->{'stdreply'}->(@_) if $jev->{'conf'}->{'stdreply'};
2299   $BSServerEvents::gev = $ev;
2300   return $ev;
2301 }
2302
2303 my %getfilelist_ajax_inprogress;
2304
2305 sub getfilelist_ajax {
2306   my ($cgi, $projid, $packid) = @_;
2307
2308   my $jev = $BSServerEvents::gev;
2309   if (!$jev->{'remoteurl'}) {
2310     die unless $cgi->{'rev'};
2311     my $proj = remoteprojid($projid);
2312     die("missing project/package\n") unless $proj;
2313     $jev->{'remoteurl'} = "$proj->{'remoteurl'}/source/$proj->{'remoteproject'}/$packid";
2314   }
2315   if (!$jev->{'filelist'}) {
2316     my $rev = $cgi->{'rev'};
2317     return $BSStdServer::return_ok if $getfilelist_ajax_inprogress{"$projid/$packid/$rev"};
2318     my $param = {
2319       'uri' => $jev->{'remoteurl'},
2320     };
2321     $jev->{'filelist'} = BSWatcher::rpc($param, $BSXML::dir, "rev=$rev");
2322     return undef unless $jev->{'filelist'};
2323     $jev = detach($BSStdServer::return_ok);
2324     $jev->{'idstring'} = "$projid/$packid/$rev";
2325     $getfilelist_ajax_inprogress{"$projid/$packid/$rev"} = $jev;
2326     $jev->{'handler'} = sub {delete $getfilelist_ajax_inprogress{"$projid/$packid/$rev"}};
2327   }
2328   my $dir = $jev->{'filelist'};
2329   for my $entry (@{$dir->{'entry'} || []}) {
2330     next if -e "$srcrep/$packid/$entry->{'md5'}-$entry->{'name'}";
2331     mkdir_p($uploaddir);
2332     my $param = {
2333       'uri' => "$jev->{'remoteurl'}/$entry->{'name'}",
2334       'filename' => "$uploaddir/$$-$jev->{'id'}",
2335       'withmd5' => 1,
2336       'receiver' => \&BSHTTP::file_receiver,
2337     };
2338     my $res = BSWatcher::rpc($param, undef, "rev=$cgi->{'rev'}");
2339     return undef unless $res;
2340     die("file download failed\n") unless $res && $res->{'md5'} eq $entry->{'md5'};
2341     die unless -e "$uploaddir/$$-$jev->{'id'}";
2342     addfile($projid, $packid, "$uploaddir/$$-$jev->{'id'}", $entry->{'name'}, $entry->{'md5'});
2343   }
2344   notify_repservers('package', $projid, $packid);
2345   return undef;
2346 }
2347
2348 sub getfilelist {
2349   my ($cgi, $projid, $packid) = @_;
2350
2351   my $view = $cgi->{'view'};
2352   my $rev = getrev($projid, $packid, defined($cgi->{'rev'}) ? $cgi->{'rev'} : 'upload');
2353   my $li = {};
2354   my $files = lsrev($rev, $li);
2355
2356   if ($files->{'_link'}) {
2357     if ($cgi->{'emptylink'}) {
2358       my $l = repreadxml($rev, '_link', $files->{'_link'}, $BSXML::link);
2359       delete $l->{'patches'};
2360       mkdir_p($uploaddir);
2361       writexml("$uploaddir/$$", undef, $l, $BSXML::link);
2362       $files = {};
2363       $files->{'_link'} = addfile($projid, $packid, "$uploaddir/$$", '_link');
2364       $rev = addrev($projid, $packid, $files, undef, undef, '');
2365     }
2366     my %lrev = %$rev;
2367     $lrev{'linkrev'} = $cgi->{'linkrev'} if $cgi->{'linkrev'};
2368     $li->{'linked'} = [] if $cgi->{'withlinked'};
2369     my $lfiles = handlelinks(\%lrev, $files, $li);
2370     if ($cgi->{'expand'}) {
2371       die("$lfiles\n") if !ref $lfiles;
2372       $files = $lfiles;
2373       %$rev = %lrev;
2374       $rev->{'rev'} = $rev->{'srcmd5'};
2375     } else {
2376       if (ref $lfiles) {
2377         $li->{'xsrcmd5'} = $lrev{'srcmd5'};
2378       } else {
2379         # link is broken
2380         $li->{'error'} = $lfiles;
2381         # set xsrcmd5 if we have a link error file
2382         $li->{'xsrcmd5'} = $lrev{'srcmd5'} if $lrev{'srcmd5'} && -e "$srcrep/$packid/$lrev{'srcmd5'}-_linkerror";
2383         if ($cgi->{'lastworking'}) {
2384           my $lastworking = findlastworkinglink($rev);
2385           $li->{'lastworking'} = $lastworking if $lastworking;
2386         }
2387       }
2388     }
2389   }
2390
2391   if ($cgi->{'extension'}) {
2392     for (keys %$files) {
2393       delete $files->{$_} unless /\.\Q$cgi->{'extension'}\E$/;
2394     }
2395   }
2396
2397   if ($view && $view eq 'cpio') {
2398     my @files = map {{'name' => $_, 'filename' => "$srcrep/$packid/$files->{$_}-$_"}} sort keys %$files;
2399     BSServer::reply_cpio(\@files);
2400     return undef;
2401   }
2402
2403   my $ret = {};
2404   $ret->{'name'} = $packid;
2405   $ret->{'srcmd5'} = $rev->{'srcmd5'} if $rev->{'srcmd5'} ne 'empty';
2406   $ret->{'rev'} = $rev->{'rev'} if exists $rev->{'rev'};
2407   $ret->{'vrev'} = $rev->{'vrev'} if exists $rev->{'vrev'};
2408   my @res;
2409   for my $filename (sort keys %$files) {
2410     my @s = repstat($rev, $filename, $files->{$filename});
2411     if (@s) {
2412       push @res, {'name' => $filename, 'md5' => $files->{$filename}, 'size' => $s[7], 'mtime' => $s[9]};
2413     } else {
2414       push @res, {'name' => $filename, 'md5' => $files->{$filename}, 'error' => "$!"};
2415     }
2416   }
2417   if (%$li) {
2418     linkinfo_addtarget($rev, $li);
2419     $ret->{'linkinfo'} = $li;
2420   }
2421   $ret->{'entry'} = \@res;
2422   return ($ret, $BSXML::dir);
2423 }
2424
2425 sub getfile {
2426   my ($cgi, $projid, $packid, $filename) = @_;
2427   die("no filename\n") unless defined($filename) && $filename ne '';
2428   die("bad filename\n") if $filename =~ /\// || $filename =~ /^\./;
2429   my $rev = getrev($projid, $packid, defined($cgi->{'rev'}) ? $cgi->{'rev'} : 'upload');
2430   my $files = lsrev($rev);
2431   die("404 $filename: no such file\n") unless $files->{$filename};
2432   my @s = repstat($rev, $filename, $files->{$filename});
2433   die("$projid/$packid/$files->{$filename}-$filename: $!\n") unless @s;
2434   local *F;
2435   repopen($rev, $filename, $files->{$filename}, \*F) || die("$projid/$packid/$files->{$filename}-$filename: $!\n");
2436   BSServer::reply_file(\*F);
2437   return undef;
2438 }
2439
2440 sub putfile {
2441   my ($cgi, $projid, $packid, $filename) = @_;
2442   die("no filename\n") unless defined($filename) && $filename ne '';
2443   die("bad filename\n") if $filename =~ /\// || $filename =~ /^\./;
2444   my $rev = getrev($projid, $packid, defined($cgi->{'rev'}) ? $cgi->{'rev'} : 'upload');
2445   die("file '$filename' is read-only\n") if ($filename =~ /^_service:/) && !$cgi->{'force'};
2446   mkdir_p($uploaddir);
2447   my $uploaded = BSServer::read_file("$uploaddir/$$", 'withmd5' => 1);
2448   die("upload failed\n") unless $uploaded;
2449   addfile($projid, $packid, "$uploaddir/$$", $filename, $uploaded->{'md5'});
2450   # create new meta file
2451   my $files = lsrev($rev);
2452   $files->{$filename} = $uploaded->{'md5'};
2453   $files = keeplink($cgi, $projid, $packid, $files) if $cgi->{'keeplink'};
2454   my $user = defined($cgi->{'user'}) ? $cgi->{'user'} : 'unknown';
2455   my $comment = defined($cgi->{'comment'}) ? $cgi->{'comment'} : '';
2456   $rev = addrev($projid, $packid, $files, $user, $comment, $cgi->{'rev'});
2457 # update happens only on commit atm, or we would modify on file upload time ...
2458 # sourceupdate($projid, $packid) if $files->{'_service'} && not ($rev eq 'upload');
2459   delete $rev->{'project'};
2460   delete $rev->{'package'};
2461   return ($rev, $BSXML::revision);
2462 }
2463
2464 sub sourcediff {
2465   my ($cgi, $projid, $packid) = @_;
2466
2467   my $oprojid = exists($cgi->{'oproject'}) ? $cgi->{'oproject'} : $projid;
2468   my $opackid = exists($cgi->{'opackage'}) ? $cgi->{'opackage'} : $packid;
2469   my $fmax = 200;
2470   my $tmax = 16000;
2471
2472   my $rev = getrev($projid, $packid, defined($cgi->{'rev'}) ? $cgi->{'rev'} : 'upload', undef, $cgi->{'missingok'});
2473   my $files = lsrev($rev);
2474   my $orev = $cgi->{'orev'};
2475   if (!defined($cgi->{'oproject'}) && !defined($cgi->{'opackage'}) && !defined($cgi->{'orev'}) && $rev->{'rev'}) {
2476     $orev = $rev->{'rev'} - 1;
2477   }
2478   $orev = getrev($oprojid, $opackid, defined($orev) ? $orev : 'latest', undef, $cgi->{'missingok'});
2479   my $ofiles = lsrev($orev);
2480   if ($cgi->{'expand'} || ($files->{'_link'} && !$ofiles->{'_link'}) || ($ofiles->{'_link'} && !$files->{'_link'})) {
2481     # expand links
2482     if ($files->{'_link'}) {
2483       $rev->{'linkrev'} = $cgi->{'linkrev'} if $cgi->{'linkrev'};
2484       my %li;
2485       my $l = repreadxml($rev, '_link', $files->{'_link'}, $BSXML::link, 1);
2486       $l->{'project'} = $rev->{'project'} unless defined $l->{'project'};
2487       $l->{'package'} = $rev->{'package'} unless defined $l->{'package'};
2488       $files = handlelinks($rev, $files, \%li);
2489       die("bad link: $files\n") unless ref $files;
2490       if ($l && $cgi->{'linkrev'} && $l->{'project'} eq $oprojid && $l->{'package'} eq $opackid && !$l->{'rev'} && !$cgi->{'orev'}) {
2491         # we're diffing against the link target. As the user specified a baserev, we should use it
2492         # instead of the latest source
2493         $orev = getrev($oprojid, $opackid, $li{'srcmd5'});
2494         $ofiles = lsrev($orev);
2495       }
2496     }
2497     if ($ofiles->{'_link'}) {
2498       $orev->{'linkrev'} = $cgi->{'olinkrev'} if $cgi->{'olinkrev'};
2499       $ofiles = handlelinks($orev, $ofiles);
2500       die("bad link: $ofiles\n") unless ref $ofiles;
2501     }
2502   }
2503   my $cacheid = "$orev->{'srcmd5'}/$rev->{'srcmd5'}";
2504   $cacheid .= "/unified:$cgi->{'unified'}" if $cgi->{'unified'};
2505   $cacheid .= "/fmax:$fmax" if defined $fmax;
2506   $cacheid .= "/tmax:$tmax" if defined $tmax;
2507   $cacheid = Digest::MD5::md5_hex($cacheid);
2508   local *F;
2509   my $cn = "$diffcache/".substr($cacheid, 0, 2)."/$cacheid";
2510   if (open(F, '<', $cn)) {
2511     utime(time, time, $cn);
2512     BSServer::reply_file(\*F, 'Content-Type: text/plain');
2513     return undef;
2514   }
2515   my $tmpdir = "$uploaddir/srcdiff$$";
2516   my $d = BSSrcdiff::diff("$srcrep/$opackid", $ofiles, $orev->{'rev'}, "$srcrep/$packid", $files, $rev->{'rev'}, $fmax, $tmax, $tmpdir, $cgi->{'unified'});
2517   mkdir_p("$diffcache/".substr($cacheid, 0, 2));
2518   writestr("$diffcache/.new$$", $cn, $d);
2519   return ($d, 'Content-Type: text/plain');
2520 }
2521
2522 sub linkdiff {
2523   my ($cgi, $projid, $packid) = @_;
2524   my $rev = getrev($projid, $packid, defined($cgi->{'rev'}) ? $cgi->{'rev'} : 'upload');
2525   $rev->{'linkrev'} = $cgi->{'linkrev'} if $cgi->{'linkrev'};
2526   my $linkinfo = {};
2527   my $files = lsrev_expanded($rev, $linkinfo);
2528   die("not a link\n") unless $linkinfo->{'srcmd5'};
2529   linkinfo_addtarget($rev, $linkinfo);
2530   return sourcediff({
2531     'oproject' => $linkinfo->{'project'},
2532     'opackage' => $linkinfo->{'package'},
2533     'orev' => $linkinfo->{'srcmd5'},
2534     'rev' => $rev->{'srcmd5'},
2535   }, $projid, $packid);
2536 }
2537
2538 sub isascii {
2539   my ($file) = @_;
2540   local *F;
2541   open(F, '<', $file) || die("$file: $!\n");
2542   my $buf = '';
2543   sysread(F, $buf, 4096);
2544   close F;
2545   return 1 unless $buf =~ /[\000-\010\016-\037]/s;
2546   return 0;
2547 }
2548
2549 sub rundiff {
2550   my ($file1, $file2, $label, $outfile) = @_;
2551   my $pid;
2552   if (!($pid = xfork())) {
2553     if (!open(STDOUT, '>>', $outfile)) {
2554       print STDERR "$outfile: $!\n";
2555       exit(2);
2556     }
2557     exec('diff', '-up', '--label', "$label.orig", '--label', $label, $file1, $file2);
2558     exit(2);
2559   }
2560   waitpid($pid, 0) == $pid || die("waitpid $pid: $!\n");
2561   my $status = $?;
2562   return 1 if $status == 0 || $status == 0x100;
2563   return undef;
2564 }
2565
2566 sub findprojectpatchname {
2567   my ($files) = @_;
2568
2569   my $i = "";
2570   while ($files->{"project$i.diff"}) {
2571     $i = '0' unless $i;
2572     $i++;
2573   }
2574   return "project$i.diff";
2575 }
2576
2577 #
2578 # we are going to commit files to projid/packid, all data is already present
2579 # in the src repository.
2580 # if it was a link before, try to keep this link
2581 # files: expanded file set
2582 #
2583 sub keeplink {
2584   my ($cgi, $projid, $packid, $files, $orev) = @_;
2585
2586   my $repair = $cgi->{'repairlink'};
2587   return $files if !defined($files) || !%$files;
2588   return $files if $files->{'_link'};
2589   $orev ||= getrev($projid, $packid, 'latest');
2590   my $ofilesl = lsrev($orev);
2591   return $files unless $ofilesl && $ofilesl->{'_link'};
2592   my $l = repreadxml($orev, '_link', $ofilesl->{'_link'}, $BSXML::link);
2593   my $changedlink = 0;
2594   my %lignore;
2595   my $isbranch;
2596
2597   if (@{$l->{'patches'}->{''} || []} == 1) {
2598     my $type = (keys %{$l->{'patches'}->{''}->[0]})[0];
2599     if ($type eq 'branch') {
2600       $isbranch = 1;
2601     }
2602   }
2603   undef $isbranch if $cgi->{'convertbranchtopatch'};
2604
2605   if (!$isbranch && $l->{'patches'}) {
2606     if ($repair) {
2607       for (@{$l->{'patches'}->{''} || []}) {
2608         my $type = (keys %$_)[0];
2609         if ($type eq 'apply' || $type eq 'delete' || $changedlink) {
2610           $lignore{$_->{$type}->{'name'}} = 1 if $type ne 'topadd' && $type ne 'delete';
2611           $_ = undef;
2612           $changedlink = 1;
2613         }
2614       }
2615     } else {
2616       for (reverse @{$l->{'patches'}->{''} || []}) {
2617         my $type = (keys %$_)[0];
2618         if ($type eq 'apply' || $type eq 'delete' || $type eq 'branch') {
2619           $lignore{$_->{$type}->{'name'}} = 1 if $type eq 'apply';
2620           $_ = undef;
2621           $changedlink = 1;
2622           next;
2623         }
2624         last;
2625       }
2626     }
2627     $l->{'patches'}->{''} = [ grep {defined($_)} @{$l->{'patches'}->{''}} ];
2628   }
2629
2630   my $linkrev = $cgi->{'linkrev'};
2631   $linkrev = $l->{'baserev'} if $linkrev && $linkrev eq 'base';
2632
2633   my $ltgtsrcmd5;
2634   my $ofiles;
2635   my $ofilesdir;
2636   if (!$repair) {
2637     # expand old link
2638     my %olrev = %$orev;
2639     my %li;
2640     $olrev{'linkrev'} = $linkrev if $linkrev;
2641     $ofiles = handlelinks(\%olrev, $ofilesl, \%li);
2642     die("bad link: $ofiles\n") unless ref $ofiles;
2643     $ltgtsrcmd5 = $li{'srcmd5'};
2644     $ofilesdir = "$srcrep/$packid";
2645   }
2646
2647   # get link target file list
2648   my $ltgtprojid = defined($l->{'project'}) ? $l->{'project'} : $projid;
2649   my $ltgtpackid = defined($l->{'package'}) ? $l->{'package'} : $packid;
2650   my $ltgtfiles;
2651   if ($ltgtsrcmd5) {
2652     my $ltgtrev = {'project' => $ltgtprojid, 'package' => $ltgtpackid, 'srcmd5' => $ltgtsrcmd5};
2653     $ltgtfiles = lsrev($ltgtrev);
2654   } else {
2655     my $ltgtrev = getrev($ltgtprojid, $ltgtpackid, $linkrev || $l->{'rev'});
2656     $ltgtfiles = lsrev_expanded($ltgtrev);
2657     $ltgtsrcmd5 = $ltgtrev->{'srcmd5'};
2658   }
2659
2660   # easy for branches: just copy file list and update baserev
2661   if ($isbranch) {
2662     my $nfiles = { %$files };
2663     my $baserev = $linkrev || $ltgtsrcmd5;
2664     if (($l->{'baserev'} || '') ne $baserev) {
2665       $l->{'baserev'} = $baserev;
2666       $l->{'patches'}->{''} = [ { 'branch' => undef} ]; # work around xml problem
2667       mkdir_p($uploaddir);
2668       writexml("$uploaddir/$$", undef, $l, $BSXML::link);
2669       $nfiles->{'_link'} = addfile($projid, $packid, "$uploaddir/$$", '_link')
2670     } else {
2671       $nfiles->{'_link'} = $ofilesl->{'_link'};
2672     }
2673     return $nfiles;
2674   }
2675
2676   if ($cgi->{'convertbranchtopatch'}) {
2677     $ofilesl = {};
2678     $ofiles = $ltgtfiles;
2679     $ofilesdir = "$srcrep/$ltgtpackid";
2680   } elsif ($repair || $changedlink) {
2681     # apply changed link
2682     my $frominfo = {'project' => $ltgtprojid, 'package' => $ltgtpackid, 'srcmd5' => $ltgtsrcmd5};
2683     my $linkinfo = {'project' => $projid, 'package' => $packid, 'srcmd5' => $orev->{'srcmd5'}, 'link' => $l};
2684     $linkinfo->{'ignore'} = \%lignore;
2685     $ofiles = applylink(undef, $frominfo, $linkinfo);
2686     die("bad link: $ofiles\n") unless ref $ofiles;
2687     $ofilesdir = "$uploaddir/applylink$$";
2688   }
2689
2690   #print "-- ofilesl:\n";
2691   #print "  $ofilesl->{$_}  $_\n" for sort keys %$ofilesl;
2692   #print "-- ofiles:\n";
2693   #print "  $ofiles->{$_}  $_\n" for sort keys %$ofiles;
2694   #print "-- files:\n";
2695   #print "  $files->{$_}  $_\n" for sort keys %$files;
2696
2697   # now create diff between old $ofiles and $files
2698   my $nfiles = { %$ofilesl };
2699   delete $nfiles->{$_} for keys %lignore;       # no longer used in link
2700   mkdir_p($uploaddir);
2701   unlink("$uploaddir/$$");
2702   my @dfiles;
2703   for my $file (sort keys %{{%$files, %$ofiles}}) {
2704     if ($ofiles->{$file}) {
2705       if (!$files->{$file}) {
2706         if (!$ltgtfiles->{$file} && $ofilesl->{$file} && $ofilesl->{$file} eq ($ofiles->{$file} || '')) {
2707           # local file no longer needed
2708           delete $nfiles->{$file};
2709         }
2710         push @dfiles, $file;
2711         delete $nfiles->{$file};
2712         next;
2713       }
2714       if ($ofiles->{$file} eq $files->{$file}) {
2715         next;
2716       }
2717       if (!isascii("$srcrep/$packid/$files->{$file}-$file") || !isascii("$ofilesdir/$ofiles->{$file}-$file")) {
2718         $nfiles->{$file} = $files->{$file};
2719         next;
2720       }
2721     } else {
2722       if (!isascii("$srcrep/$packid/$files->{$file}-$file")) {
2723         $nfiles->{$file} = $files->{$file};
2724         next;
2725       }
2726     }
2727     if (($ofilesl->{$file} || '') eq ($ofiles->{$file} || '')) {
2728       # link did not change file, just record new content
2729       if ($files->{$file} eq ($ltgtfiles->{$file} || '')) {
2730         # local overwrite already in link target
2731         delete $nfiles->{$file};
2732         next;
2733       }
2734       $nfiles->{$file} = $files->{$file};
2735       next;
2736     }
2737     # both are ascii, create diff
2738     mkdir_p($uploaddir);
2739     if (!rundiff($ofiles->{$file} ? "$ofilesdir/$ofiles->{$file}-$file" : '/dev/null', "$srcrep/$packid/$files->{$file}-$file", $file, "$uploaddir/$$")) {
2740       $nfiles->{$file} = $files->{$file};
2741     }
2742   }
2743   my $lchanged;
2744   $lchanged = 1 if $changedlink;
2745   for (@dfiles) {
2746     push @{$l->{'patches'}->{''}}, {'delete' => {'name' => $_}};
2747     $lchanged = 1;
2748   }
2749   if (-s "$uploaddir/$$") {
2750     my $ppatch = findprojectpatchname($nfiles);
2751     $nfiles->{$ppatch} = addfile($projid, $packid, "$uploaddir/$$", $ppatch);
2752     push @{$l->{'patches'}->{''}}, {'apply' => {'name' => $ppatch}};
2753     $lchanged = 1;
2754   } else {
2755     unlink("$uploaddir/$$");
2756   }
2757   my $baserev = $linkrev || $ltgtsrcmd5;
2758   if (($l->{'baserev'} || '') ne $baserev) {
2759     $l->{'baserev'} = $baserev;
2760     $lchanged = 1;
2761   }
2762   if ($lchanged) {
2763     writexml("$uploaddir/$$", undef, $l, $BSXML::link);
2764     $nfiles->{'_link'} = addfile($projid, $packid, "$uploaddir/$$", '_link')
2765   }
2766   if ($ofilesdir eq "$uploaddir/applylink$$") {
2767     BSUtil::cleandir("$uploaddir/applylink$$");
2768     rmdir("$uploaddir/applylink$$");
2769   }
2770   return $nfiles;
2771 }
2772
2773 # integrate link from opackid to packid into packid
2774 sub integratelink {
2775   my ($files, $projid, $packid, $rev, $ofiles, $oprojid, $opackid, $l, $orev) = @_;
2776
2777   # append patches from link l to link nl
2778   my $nl = repreadxml($rev, '_link', $files->{'_link'}, $BSXML::link);
2779
2780   # FIXME: remove hunks from patches that deal with replaced/deleted files
2781   my $nlchanged;
2782   my %dontcopy;
2783   $dontcopy{'_link'} = 1;
2784   my $nlisbranch;
2785   if ($nl->{'patches'}) {
2786     for (@{$nl->{'patches'}->{''} || []}) {
2787       my $type = (keys %$_)[0];
2788       if ($type eq 'add' || $type eq 'apply') {
2789         $dontcopy{$_->{$type}->{'name'}} = 1;
2790       }
2791       $nlisbranch = 1 if $type eq 'branch';
2792     }
2793   }
2794   my $lisbranch;
2795   if ($l->{'patches'}) {
2796     for (@{$l->{'patches'}->{''} || []}) {
2797       my $type = (keys %$_)[0];
2798       $lisbranch = 1 if $type eq 'branch';
2799     }
2800   }
2801
2802   if ($nlisbranch) {
2803     # we linked/branched a branch. expand.
2804     #my %xrev = (%$rev, 'linkrev' => 'base');
2805     my %xrev = %$rev;
2806     my $linkinfo = {};
2807     lsrev_expanded(\%xrev, $linkinfo);
2808     my %oxrev = (%$orev, 'linkrev' => $xrev{'srcmd5'});
2809     $ofiles = lsrev_expanded(\%oxrev);
2810     copyfiles($projid, $packid, $oprojid, $opackid, $ofiles);
2811     # find new base
2812     if ($linkinfo->{'srcmd5'} ne $nl->{'baserev'}) {
2813       # update base rev
2814       $nl->{'baserev'} = $linkinfo->{'srcmd5'};
2815       $nlchanged = 1;
2816     }
2817     # delete everything but the link
2818     delete $files->{$_} for grep {$_ ne '_link'} keys %$files;
2819   }
2820
2821   if ($lisbranch && !$nlisbranch) {
2822     # we branched a link. convert branch to link
2823     # and integrate
2824     delete $ofiles->{'_link'};
2825     $ofiles = keeplink({'convertbranchtopatch' => 1, 'linkrev' => 'base'}, $oprojid, $opackid, $ofiles, $orev);
2826     $l = repreadxml($orev, '_link', $ofiles->{'_link'}, $BSXML::link);
2827   }
2828
2829   if (!$nlisbranch && $l->{'patches'}) {
2830     for (@{$l->{'patches'}->{''} || []}) {
2831       my $type = (keys %$_)[0];
2832       if ($type eq 'delete' && $files->{$_->{'delete'}->{'name'}}) {
2833         delete $files->{$_->{'delete'}->{'name'}};
2834       } else {
2835         $nlchanged = 1;
2836         $nl->{'patches'} ||= {};
2837         if ($type eq 'apply') {
2838           my $oppatch = $_->{'apply'}->{'name'};
2839           if ($files->{$oppatch}) {
2840             $dontcopy{$oppatch} = 1;
2841             # argh, patch file already exists, rename...
2842             my $ppatch = findprojectpatchname($files);
2843             mkdir_p($uploaddir);
2844             unlink("$uploaddir/$$");
2845             link("$srcrep/$opackid/$ofiles->{$oppatch}-$oppatch", "$uploaddir/$$") || die("link $srcrep/$opackid/$ofiles->{$oppatch}-$oppatch $uploaddir/$$: $!\n");
2846             $files->{$ppatch} = addfile($projid, $packid, "$uploaddir/$$", $ppatch);
2847             push @{$nl->{'patches'}->{''}}, {'apply' => {'name' => $ppatch}};
2848             next;
2849           }
2850         }
2851         if ($type eq 'add') {
2852           my $oppatch = $_->{'add'}->{'name'};
2853           die("cannot apply patch $oppatch twice\n") if $dontcopy{$oppatch};
2854         }
2855         push @{$nl->{'patches'}->{''}}, $_;
2856       }
2857     }
2858   }
2859   if ($nlchanged) {
2860     mkdir_p($uploaddir);
2861     writexml("$uploaddir/$$", undef, $nl, $BSXML::link);
2862     $files->{'_link'} = addfile($projid, $packid, "$uploaddir/$$", '_link');
2863   }
2864   for (sort keys %$ofiles) {
2865     next if $dontcopy{$_};
2866     $files->{$_} = $ofiles->{$_};
2867   }
2868   return $files;
2869 }
2870
2871 sub sourcecommit {
2872   my ($cgi, $projid, $packid) = @_;
2873   my $rev = getrev($projid, $packid, defined($cgi->{'rev'}) ? $cgi->{'rev'} : 'upload');
2874   my $files = lsrev($rev);
2875   $files = keeplink($cgi, $projid, $packid, $files) if $cgi->{'keeplink'};
2876   my $user = defined($cgi->{'user'}) ? $cgi->{'user'} : 'unknown';
2877   my $comment = defined($cgi->{'comment'}) ? $cgi->{'comment'} : '';
2878   $rev = addrev($projid, $packid, $files, $user, $comment);
2879   if ($files->{'_service'} && !$cgi->{'noservice'}) {
2880     my $sslockfile = "$eventdir/service/${projid}::$packid";
2881     mkdir_p("$eventdir/service");
2882     BSUtil::touch($sslockfile);
2883     sourceupdate($projid, $packid, $sslockfile);
2884   }
2885   delete $rev->{'project'};
2886   delete $rev->{'package'};
2887   return ($rev, $BSXML::revision);
2888 }
2889
2890 sub sourcecommitfilelist {
2891   my ($cgi, $projid, $packid) = @_;
2892   mkdir_p($uploaddir);
2893   my $uploaded = BSServer::read_file("$uploaddir/$$");
2894   die("upload failed\n") unless $uploaded;
2895   my $fl = readxml("$uploaddir/$$", $BSXML::dir);
2896   unlink("$srcrep/:upload/$$");
2897   # make sure we know every file
2898   my @missing;
2899   my $files = {};
2900   for my $entry (@{$fl->{'entry'} || []}) {
2901     BSVerify::verify_filename($entry->{'name'});
2902     BSVerify::verify_md5($entry->{'md5'});
2903     if (! -e "$srcrep/$packid/$entry->{'md5'}-$entry->{'name'}") {
2904       push @missing, $entry;
2905     } else {
2906       die("duplicate file: $entry->{'name'}\n") if exists $files->{$entry->{'name'}};
2907       $files->{$entry->{'name'}} = $entry->{'md5'};
2908     }
2909   }
2910   if (@missing) {
2911     my $res = {'name' => $packid, 'error' => 'missing', 'entry' => \@missing};
2912     return ($res, $BSXML::dir);
2913   }
2914
2915   $files = keeplink($cgi, $projid, $packid, $files) if $cgi->{'keeplink'};
2916   my $user = defined($cgi->{'user'}) ? $cgi->{'user'} : 'unknown';
2917   my $comment = defined($cgi->{'comment'}) ? $cgi->{'comment'} : '';
2918   if (-e "$projectsdir/$projid.pkg/$packid.upload-MD5SUMS") {
2919     # autocommit old update revision so that it doesn't get lost
2920     my $uploadrev = {'project' => $projid, 'package' => $packid, 'srcmd5' => 'upload'};
2921     my $uploadfiles = lsrev($uploadrev);
2922     addrev($projid, $packid, $uploadfiles, $user, 'autocommit', undef, $cgi->{'requestid'});
2923   }
2924   my $rev = addrev($projid, $packid, $files, $user, $comment, undef, $cgi->{'requestid'});
2925
2926   $cgi->{'rev'} = $rev->{'rev'};
2927   return getfilelist($cgi, $projid, $packid);
2928 }
2929
2930 sub sourcecopy {
2931   my ($cgi, $projid, $packid) = @_;
2932   die("illegal rev parameter\n") if $cgi->{'rev'} && $cgi->{'rev'} ne 'upload';
2933   my $oprojid = exists($cgi->{'oproject'}) ? $cgi->{'oproject'} : $projid;
2934   my $opackid = exists($cgi->{'opackage'}) ? $cgi->{'opackage'} : $packid;
2935   my $orev = $cgi->{'orev'};
2936   $orev = getrev($oprojid, $opackid, defined($orev) ? $orev : 'latest');
2937   $orev->{'linkrev'} = $cgi->{'olinkrev'} if $cgi->{'olinkrev'};
2938   my $files = lsrev($orev);
2939   die("need a revision to copy\n") if !$cgi->{'rev'} && !$cgi->{'orev'} && $oprojid eq $projid && $opackid eq $packid && !($files->{'_link'} && $cgi->{'expand'});
2940
2941   my $autosimplifylink;
2942
2943   if ($files->{'_link'} && !$cgi->{'dontupdatesource'} && !$cgi->{'rev'}) {
2944     # fix me: do this in a more generic way
2945     my $ol = repreadxml($orev, '_link', $files->{'_link'}, $BSXML::link, 1);
2946     if ($ol) {
2947       my $lprojid = $oprojid;
2948       my $lpackid = $opackid;
2949       my $lrev = $ol->{'rev'};
2950       $lprojid = $ol->{'project'} if exists $ol->{'project'};
2951       $lpackid = $ol->{'package'} if exists $ol->{'package'};
2952       if ($lprojid eq $projid && $lpackid eq $packid) {
2953         # copy destination is target of link
2954         # we're integrating this link
2955         $lrev = getrev($lprojid, $lpackid, $lrev);
2956         my $lfiles = lsrev($lrev);
2957         if ($lfiles->{'_link'} && !$cgi->{'expand'}) {
2958           # link to a link, join
2959           $files = integratelink($lfiles, $lprojid, $lpackid, $lrev, $files, $oprojid, $opackid, $ol, $orev);
2960         } else {
2961           # auto expand
2962           $cgi->{'expand'} = 1;
2963         }
2964         $autosimplifylink = $ol;
2965       }
2966     }
2967   }
2968
2969   if ($files->{'_link'} && $cgi->{'expand'}) {
2970     my %olrev = %$orev;         # copy so that orev still points to unexpanded sources
2971     $files = handlelinks(\%olrev, $files);
2972     die("broken link: $files\n") unless ref $files;
2973   }
2974
2975   copyfiles($projid, $packid, $oprojid, $opackid, $files);
2976
2977   $files = keeplink($cgi, $projid, $packid, $files) if $cgi->{'keeplink'};
2978   my $user = defined($cgi->{'user'}) ? $cgi->{'user'} : 'unknown';
2979   my $comment = defined($cgi->{'comment'}) ? $cgi->{'comment'} : '';
2980   my $rev = addrev($projid, $packid, $files, $user, $comment, $cgi->{'rev'}, $cgi->{'requestid'});
2981
2982   if ($autosimplifylink && !$autosimplifylink->{'rev'}) {
2983     my $isbranch = grep {(keys %$_)[0] eq 'branch'} @{$autosimplifylink->{'patches'}->{''} || []};
2984     if ($isbranch) {
2985       # update base rev so that there are no changes
2986       # FIXME: this is a gross hack...
2987       # we should not need to update the baserev, instead we should change
2988       # the way branches get applied
2989       my $ofiles = lsrev($orev);
2990       delete $ofiles->{'_link'};
2991       copyfiles($projid, $packid, $oprojid, $opackid, $ofiles);
2992       my $newbase = addmeta($projid, $packid, $ofiles);
2993       if ($autosimplifylink->{'baserev'} ne $newbase) {
2994         eval {
2995           my $latestorev = getrev($oprojid, $opackid);
2996           my $latestfiles = lsrev($latestorev);
2997           if ($latestfiles->{'_link'}) {
2998             my $latestl = repreadxml($latestorev, '_link', $latestfiles->{'_link'}, $BSXML::link, 1);
2999             my $latestisbranch = grep {(keys %$_)[0] eq 'branch'} @{$latestl->{'patches'}->{''} || []};
3000             if ($latestisbranch && $latestl->{'baserev'} eq $autosimplifylink->{'baserev'}) {
3001               $latestl->{'baserev'} = $newbase;
3002               $latestl->{'patches'}->{''} = [ { 'branch' => undef} ]; # work around xml problem
3003               mkdir_p($uploaddir);
3004               writexml("$uploaddir/$$", undef, $latestl, $BSXML::link);
3005               $latestfiles->{'_link'} = addfile($oprojid, $opackid, "$uploaddir/$$", '_link');
3006               addrev($oprojid, $opackid, $latestfiles, 'buildservice-autocommit', "baserev update by copy to link target\n", undef, $cgi->{'requestid'});
3007             }
3008           }
3009         };
3010         warn($@) if $@;
3011       }
3012     } else {
3013       eval {
3014         my $latestorev = getrev($oprojid, $opackid);
3015         if ($latestorev->{'srcmd5'} eq $orev->{'srcmd5'}) {
3016           # simplify link
3017           my $nl = {};
3018           $nl->{'project'} = $autosimplifylink->{'project'} if $autosimplifylink->{'project'};
3019           $nl->{'package'} = $autosimplifylink->{'package'} if $autosimplifylink->{'package'};
3020           $nl->{'cicount'} = $autosimplifylink->{'cicount'} if $autosimplifylink->{'cicount'};
3021           mkdir_p($uploaddir);
3022           writexml("$uploaddir/$$", undef, $nl, $BSXML::link);
3023           my $ofiles = {};
3024           $ofiles->{'_link'} = addfile($oprojid, $opackid, "$uploaddir/$$", '_link');
3025           addrev($oprojid, $opackid, $ofiles, 'buildservice-autocommit', "auto commit by copy to link target\n", undef, $cgi->{'requestid'});
3026         }
3027       };
3028       warn($@) if $@;
3029     }
3030   }
3031
3032   delete $rev->{'project'};
3033   delete $rev->{'package'};
3034   return ($rev, $BSXML::revision);
3035 }
3036
3037 sub sourcebranch {
3038   my ($cgi, $projid, $packid) = @_;
3039
3040   my $usebranch = 1;
3041   my $oprojid = exists($cgi->{'oproject'}) ? $cgi->{'oproject'} : $projid;
3042   my $opackid = exists($cgi->{'opackage'}) ? $cgi->{'opackage'} : $packid;
3043   my $orev = $cgi->{'orev'};
3044   die("cannot branch myself\n") if $oprojid eq $projid && $opackid eq $packid;
3045   $orev = getrev($oprojid, $opackid);
3046   $orev->{'linkrev'} = $cgi->{'olinkrev'} if $cgi->{'olinkrev'};
3047   my $files = lsrev_expanded($orev);
3048   my $l = {};
3049   $l->{'project'} = $oprojid if $oprojid ne $projid;
3050   $l->{'package'} = $opackid if $opackid ne $projid;
3051   $l->{'rev'} = $cgi->{'orev'} if defined $cgi->{'orev'};
3052   $l->{'baserev'} = $orev->{'srcmd5'};
3053   my $lfiles = {};
3054   mkdir_p("$srcrep/$packid");
3055   if ($usebranch) {
3056     $l->{'patches'}->{''} = [ { 'branch' => undef} ];
3057     copyfiles($projid, $packid, $oprojid, $opackid, $files);
3058     $lfiles->{$_} = $files->{$_} for keys %$files;
3059   }
3060   mkdir_p($uploaddir);
3061   writexml("$uploaddir/$$", undef, $l, $BSXML::link);
3062   $lfiles->{'_link'} = addfile($projid, $packid, "$uploaddir/$$", '_link');
3063   my $user = defined($cgi->{'user'}) ? $cgi->{'user'} : 'unknown';
3064   my $comment = defined($cgi->{'comment'}) ? $cgi->{'comment'} : '';
3065   my $rev = addrev($projid, $packid, $lfiles, $user, $comment);
3066   delete $rev->{'project'};
3067   delete $rev->{'package'};
3068   BSHermes::notify("SRCSRV_BRANCH_COMMAND", {project => $projid, package => $packid, targetproject => $oprojid, targetpackage => $opackid,
3069                                              user => $cgi->{'user'}});
3070   return ($rev, $BSXML::revision);
3071 }
3072
3073 sub linktobranch {
3074   my ($cgi, $projid, $packid) = @_;
3075   my $rev = getrev($projid, $packid);
3076   $rev->{'linkrev'} = $cgi->{'linkrev'} if $cgi->{'linkrev'};
3077   my $files = lsrev($rev);
3078   die("package is not a link\n") unless $files->{'_link'};
3079   my $l = repreadxml($rev, '_link', $files->{'_link'}, $BSXML::link);
3080   die("package is already a branch\n") if $l->{'patches'} && grep {(keys %$_)[0] eq 'branch'} @{$l->{'patches'}->{''} || []};
3081   my $linkinfo = {};
3082   $files = lsrev_expanded($rev, $linkinfo);
3083   $l->{'baserev'} = $linkinfo->{'srcmd5'};
3084   $l->{'patches'}->{''} = [ { 'branch' => undef} ];
3085   mkdir_p($uploaddir);
3086   writexml("$uploaddir/$$", undef, $l, $BSXML::link);
3087   $files->{'_link'} = addfile($projid, $packid, "$uploaddir/$$", '_link');
3088   my $user = defined($cgi->{'user'}) ? $cgi->{'user'} : 'unknown';
3089   my $comment = defined($cgi->{'comment'}) ? $cgi->{'comment'} : '';
3090   $comment ||= "converted link to branch";
3091   $rev = addrev($projid, $packid, $files, $user, $comment);
3092   delete $rev->{'project'};
3093   delete $rev->{'package'};
3094   return ($rev, $BSXML::revision);
3095 }
3096
3097 sub deleteuploadrev {
3098   my ($cgi, $projid, $packid) = @_;
3099   unlink("$projectsdir/$projid.pkg/$packid.upload-MD5SUMS");
3100   return $BSStdServer::return_ok;
3101 }
3102
3103 sub unknowncmd {
3104   my ($cgi, $projid, $packid) = @_;
3105   die("unknown command \"$cgi->{'cmd'}\"\n");
3106 }
3107
3108 sub delfile {
3109   my ($cgi, $projid, $packid, $filename) = @_;
3110   die("no filename\n") unless defined($filename) && $filename ne '';
3111   die("bad filename\n") if $filename =~ /\// || $filename =~ /^\./;
3112   die("file '$filename' is read-only\n") if ($filename =~ /^_service:/) && not $cgi->{'force'};
3113   my $rev = getrev($projid, $packid, defined($cgi->{'rev'}) ? $cgi->{'rev'} : 'upload');
3114   my $files = lsrev($rev);
3115   die("404 file '$filename' does not exist\n") unless $files->{$filename};
3116   delete $files->{$filename};
3117   $files = keeplink($projid, $packid, $files) if $cgi->{'keeplink'};
3118   my $user = defined($cgi->{'user'}) ? $cgi->{'user'} : 'unknown';
3119   my $comment = defined($cgi->{'comment'}) ? $cgi->{'comment'} : '';
3120   $rev = addrev($projid, $packid, $files, $user, $comment, $cgi->{'rev'});
3121   delete $rev->{'project'};
3122   delete $rev->{'package'};
3123   return ($rev, $BSXML::revision);
3124 }
3125
3126 sub getrepositorylist {
3127   my ($cgi, $projid) = @_;
3128   my $proj = readproj($projid);
3129   my @res = map {{'name' => $_->{'name'}}} @{$proj->{'repository'} || []};
3130   return ({'entry' => \@res}, $BSXML::dir);
3131 }
3132
3133 sub getrepository {
3134   my ($cgi, $projid, $repoid) = @_;
3135   my $proj = readproj($projid);
3136   my $repo = (grep {$_->{'name'} eq $repoid} @{$proj->{'repository'} || []})[0];
3137   die("404 $repoid: no such repository\n") unless $repo;
3138   return ($repo, $BSXML::repo);
3139 }
3140
3141 sub getarchlist {
3142   my ($cgi, $projid, $repoid) = @_;
3143   my $proj = readproj($projid);
3144   my @repo = grep {$_->{'name'} eq $repoid} @{$proj->{'repository'} || []};
3145   die("404 $repoid: no such repository\n") unless @repo;
3146   my @res = map {{'name' => $_}} @{$repo[0]->{'arch'} || []};
3147   return ({'entry' => \@res}, $BSXML::dir);
3148 }
3149
3150 sub getresult {
3151   my ($cgi, $projid) = @_;
3152
3153   if ($cgi->{'oldstate'} && !$BSStdServer::isajax) {
3154     my @args = "oldstate=$cgi->{'oldstate'}";
3155     push @args, "lastbuild" if $cgi->{'lastbuild'};
3156     push @args, map {"view=$_"} @{$cgi->{'view'} || []};
3157     push @args, map {"repository=$_"} @{$cgi->{'repository'} || []};
3158     push @args, map {"arch=$_"} @{$cgi->{'arch'} || []};
3159     push @args, map {"package=$_"} @{$cgi->{'package'} || []};
3160     push @args, map {"code=$_"} @{$cgi->{'code'} || []};
3161     BSHandoff::handoff($ajaxsocket, "/build/$projid/_result", undef, @args);
3162     exit(0);
3163   }
3164
3165   my %repoidfilter = map {$_ => 1} @{$cgi->{'repository'} || []};
3166   my %archfilter = map {$_ => 1} @{$cgi->{'arch'} || []};
3167   my %view = map {$_ => 1} @{$cgi->{'view'} || ['status']};
3168   my %code = map {$_ => 1} @{$cgi->{'code'} || []};
3169
3170   my $proj = readproj($projid);
3171   if ($cgi->{'repository'}) {
3172     my %knownrepoids = map {$_->{'name'} => 1} @{$proj->{'repository'} || []};
3173     for (@{$cgi->{'repository'}}) {
3174       die("404 unknown repository '$_'\n") if !$knownrepoids{$_};
3175     }
3176   }
3177   if ($cgi->{'package'}) {
3178     my %knownpackids = map {$_ => 1} findpackages($projid, $proj, 1);
3179     for (@{$cgi->{'package'}}) {
3180       die("404 unknown package '$_'\n") if !$knownpackids{$_};
3181     }
3182   }
3183   my @prpas;
3184   for my $repo (@{$proj->{'repository'} || []}) {
3185     next if %repoidfilter && !$repoidfilter{$repo->{'name'}};
3186     my @archs = @{$repo->{'arch'} || []};
3187     @archs = grep {$archfilt