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