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