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