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