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