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