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