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