[backend] fix reference generation in updateinfo.xml files and extend test case for it
[opensuse:build-service.git] / src / backend / bs_sched
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 Scheduler. One big chunk of code for now.
23 #
24
25 BEGIN {
26   my ($wd) = $0 =~ m-(.*)/- ;
27   $wd ||= '.';
28   unshift @INC,  "$wd/build";
29   unshift @INC,  "$wd";
30 }
31
32 use Digest::MD5 ();
33 use Data::Dumper;
34 use Storable ();
35 use XML::Structured ':bytes';
36 use POSIX;
37 use Fcntl qw(:DEFAULT :flock);
38
39 use BSConfig;
40 use BSRPC ':https';
41 use BSUtil;
42 use BSFileDB;
43 use BSXML;
44 use BSDBIndex;
45 use BSBuild;
46 use BSVerify;
47 use Build;
48 use BSDB;
49 use Meta;
50 use BSSolv;
51
52 use strict;
53
54 my $testprojid;
55 my $testmode;
56
57 my $bsdir = $BSConfig::bsdir || "/srv/obs";
58
59 BSUtil::mkdir_p_chown($bsdir, $BSConfig::bsuser, $BSConfig::bsgroup);
60 BSUtil::drop_privs_to($BSConfig::bsuser, $BSConfig::bsgroup);
61
62 my $sign;
63 $sign = $BSConfig::sign if defined($BSConfig::sign);
64
65 my $proxy;
66 $proxy = $BSConfig::proxy if defined($BSConfig::proxy);
67
68 my $reporoot = "$bsdir/build";
69 my $jobsdir = "$bsdir/jobs";
70 my $eventdir = "$bsdir/events";
71 my $extrepodir = "$bsdir/repos";
72 my $extrepodir_sync = "$bsdir/repos_sync";
73 my $extrepodb = "$bsdir/db/published";
74 my $uploaddir = "$bsdir/upload";
75 my $rundir = $BSConfig::rundir || "$bsdir/run";
76 my $infodir = "$bsdir/info";
77
78 if (@ARGV && $ARGV[0] eq '--testmode') {
79   $testmode = 1;
80   shift @ARGV;
81 }
82 if (@ARGV && ($ARGV[0] eq '--exit' || $ARGV[0] eq '--stop')) {
83   $testmode = 'exit';
84   shift @ARGV;
85 } elsif (@ARGV && $ARGV[0] eq '--restart') {
86   $testmode = 'restart';
87   shift @ARGV;
88 }
89
90 my $myarch = $ARGV[0] || 'i586';
91
92 my $myjobsdir = "$jobsdir/$myarch";
93 my $myeventdir = "$eventdir/$myarch";
94
95 my $historylay = [qw{versrel bcnt srcmd5 rev time}];
96
97 my %remoteprojs;        # remote project cache
98
99 # Create directory on first start
100 mkdir_p($infodir) || die ("Failed to create ".$infodir);
101
102 my $buildavg = 1200; # start not at 0, but with 20min for the average ounter
103
104
105 sub unify {
106   my %h = map {$_ => 1} @_;
107   return grep(delete($h{$_}), @_);
108 }
109
110 sub sendevent {
111   my ($ev, $arch, $evname) = @_;
112
113   mkdir_p("$eventdir/$arch");
114   writexml("$eventdir/$arch/.$evname$$", "$eventdir/$arch/$evname", $ev, $BSXML::event);
115   local *F;
116   if (sysopen(F, "$eventdir/$arch/.ping", POSIX::O_WRONLY|POSIX::O_NONBLOCK)) {
117     syswrite(F, 'x');
118     close(F);
119   }
120 }
121
122 #
123 # input: depsp  -> hash of arrays
124 #        mapp   -> hash of strings
125 #
126
127 sub sortpacks {
128   my ($depsp, $mapp, $cycp, @packs) = @_;
129
130   return @packs if @packs < 2;
131   my @cycs;
132   @packs = BSSolv::depsort($depsp, $mapp, \@cycs, @packs);
133   if (@cycs) {
134     @$cycp = @cycs if $cycp;
135     print "cycle: ".join(' -> ', @$_)."\n" for @cycs;
136   }
137   return @packs;
138 }
139
140 sub sortedmd5toreason {
141   my @res;
142   for my $line (@_) {
143     my $tag = substr($line, 0, 1); # just the first char
144     $tag = 'md5sum' if $tag eq '!';
145     $tag = 'added' if $tag eq '+';
146     $tag = 'removed' if $tag eq '-';
147     push @res, { 'change' => $tag, 'key' => substr($line, 1) };
148   }
149   return \@res;
150 }
151
152 sub diffsortedmd5 {
153   my $md5off = shift;
154   my $fromp = shift;
155   my $top = shift;
156
157   my @ret = ();
158   my @from = map {[$_, substr($_, 0, $md5off).substr($_, $md5off+($md5off ? 33 : 34))]} @$fromp;
159   my @to   = map {[$_, substr($_, 0, $md5off).substr($_, $md5off+($md5off ? 33 : 34))]} @$top;
160   @from = sort {$a->[1] cmp $b->[1] || $a->[0] cmp $b->[0]} @from;
161   @to   = sort {$a->[1] cmp $b->[1] || $a->[0] cmp $b->[0]} @to;
162
163   for my $f (@from) {
164     if (@to && $f->[1] eq $to[0]->[1]) {
165       push @ret, "!$f->[1]" if $f->[0] ne $to[0]->[0];
166       shift @to;
167       next;   
168     }
169     if (!@to || $f->[1] lt $to[0]->[1]) {
170       push @ret, "-$f->[1]";
171       next;   
172     }
173     while (@to && $f->[1] gt $to[0]->[1]) {
174       push @ret, "+$to[0]->[1]";
175       shift @to;
176     }
177     redo;   
178   }
179   push @ret, "+$_->[1]" for @to;
180   return @ret;
181 }
182
183 sub findbins_dir {
184   my ($dir, $cache) = @_;
185   my @bins;
186   if (ref($dir)) {
187     @bins = grep {/\.(?:rpm|deb|iso)$/} @$dir;
188   } else {
189     @bins = ls($dir);
190     @bins = map {"$dir/$_"} grep {/\.(?:rpm|deb|iso|raw|raw\.install)$/} sort @bins;
191   }
192   my $repobins = {};
193   for my $bin (@bins) {
194     my @s = stat($bin);
195     next unless @s;
196     my $id = "$s[9]/$s[7]/$s[1]";
197     my $data;
198     if ($cache && $cache->{$id}) {
199       $data = { %{$cache->{$id}} };
200     } else {
201       $data = Build::query($bin, 'evra' => 1);  # need arch
202       next unless $data;
203     }
204     eval {
205       BSVerify::verify_nevraquery($data);
206     };
207     next if $@;
208     delete $data->{'disttag'};
209     $data->{'id'} = $id;
210     $repobins->{$bin} = $data;
211   }
212   return $repobins;
213 }
214
215 my $projpacks;          # global project/package data
216
217 #  'lastscan'   last time we scanned
218 #  'meta'       meta cache
219 #  'solv'       solv data cache (for remote repos)
220 my %repodatas;          # our repository knowledge
221
222 # add :full repo to pool
223 sub addrepo {
224   my ($pool, $prp) = @_;
225
226   my $now = time();
227   if ($repodatas{$prp} && $repodatas{$prp}->{'lastscan'} && $repodatas{$prp}->{'lastscan'} > $now - 8*3600) {
228     if (exists $repodatas{$prp}->{'solv'}) {
229       my $r;
230       eval {$r = $pool->repofromstr($prp, $repodatas{$prp}->{'solv'});};
231       return $r if $r;
232       delete $repodatas{$prp}->{'solv'};
233     }
234     my $dir = "$reporoot/$prp/$myarch/:full";
235     if (-s "$dir.solv") {
236       my $r;
237       eval {$r = $pool->repofromfile($prp, "$dir.solv");};
238       return $r if $r;
239     }
240   }
241   delete $repodatas{$prp}->{'solv'};
242   delete $repodatas{$prp}->{'lastscan'};
243   my ($projid, $repoid) = split('/', $prp, 2);
244   if ($remoteprojs{$projid}) {
245     return addrepo_remote($pool, $prp, $remoteprojs{$projid});
246   }
247   return addrepo_scan($pool, $prp);
248 }
249
250 # add :full repo to pool, make sure repo is up-to-data by
251 # scanning the directory
252 sub addrepo_scan {
253   my ($pool, $prp) = @_;
254
255   print "    scanning repo $prp...\n";
256   my $dir = "$reporoot/$prp/$myarch/:full";
257   my $cache;
258   my $dirty;
259   if (-s "$dir.solv") {
260     eval {$cache = $pool->repofromfile($prp, "$dir.solv");};
261     warn($@) if $@;
262     if ($cache && $cache->isexternal()) {
263       $repodatas{$prp}->{'lastscan'} = time();
264       return $cache;
265     }
266   } elsif ($BSConfig::enable_download_on_demand) {
267     my ($projid) = split('/', $prp, 2);
268     my @doddata = grep {$_->{'arch'} && $_->{'arch'} eq $myarch} @{$projpacks->{$projid}->{'download'} || []};
269     if (@doddata) {
270       my $doddata = $doddata[0];
271       eval {$cache = Meta::parse("$dir/$doddata->{'metafile'}", $doddata->{'mtype'}, { 'arch' => [ $myarch ] })};
272       if ($@) {
273         print "    download on demand: cannot read metadata: $@\n";
274         return undef;
275       } elsif (!$cache) {
276         print "    download on demand: cannot read metadata: unknown mtype attribute\n";
277         return undef;
278       }
279       for (values %$cache) {
280         $_->{'id'} = 'dod';
281         $_->{'hdrmd5'} = 'd0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0';
282       }
283       $cache->{'/url'} = $doddata->{'baseurl'};
284       $cache = $pool->repofromdata($prp, $cache);
285       $dirty = 1;
286     }
287   }
288   my @bins;
289   local *D;
290   if (opendir(D, $dir)) {
291     @bins = grep {/\.(?:rpm|deb)$/} readdir(D);
292     closedir D;
293     if (!@bins && -s "$dir.subdirs") {
294       for my $subdir (split(' ', readstr("$dir.subdirs"))) {
295         push @bins, map {"$subdir/$_"} grep {/\.(?:rpm|deb)$/} ls("$dir/$subdir");
296       }
297     }
298   } else {
299     if (!$cache) {
300       # return in-core empty repo
301       my $r = $pool->repofrombins($prp, $dir);
302       $repodatas{$prp}->{'solv'} = $r->tostr();
303       $repodatas{$prp}->{'lastscan'} = time();
304       return $r;
305     }
306   }
307   for (splice @bins) {
308     my @s = stat("$dir/$_");
309     next unless @s;
310     push @bins, $_, "$s[9]/$s[7]/$s[1]";
311   }
312   if ($cache) {
313     my $updated = $cache->updatefrombins($dir, @bins);
314     print "    (dirty: $updated)\n" if $updated;
315     $dirty = 1 if $updated;
316   } else {
317     $cache = $pool->repofrombins($prp, $dir, @bins);
318     $dirty = 1;
319   }
320   if ($dirty && $cache && !$repodatas{$prp}->{'dontwrite'}) {
321     $cache->tofile("$dir.solv.new");
322     rename("$dir.solv.new", "$dir.solv") || die("rename $dir.solv.new $dir.solv: $!\n");
323   }
324   $repodatas{$prp}->{'lastscan'} = time();
325   return $cache;
326 }
327
328
329 sub enabled {
330   my ($repoid, $disen, $default) = @_;
331   return BSUtil::enabled($repoid, $disen, $default, $myarch);
332 }
333
334
335
336 # this is basically getconfig from the source server
337 # we do not need any macros, just the config
338 sub getconfig {
339   my ($arch, $path) = @_;
340   my $config = '';
341   if (@$path) {
342     my ($p, $r) = split('/', $path->[0], 2);
343     $config .= "%define _project $p\n";
344   }
345   for my $prp (reverse @$path) {
346     my ($p, $r) = split('/', $prp, 2);
347     my $c;
348     if ($remoteprojs{$p}) {
349       $c = fetchremoteconfig($p); 
350       return undef unless defined $c;
351     } elsif ($projpacks->{$p}) {
352       $c = $projpacks->{$p}->{'config'};
353     }
354     next unless defined $c;
355     $config .= "\n### from $p\n";
356     $config .= "%define _repository $r\n";
357     $c = defined($1) ? $1 : '' if $c =~ /^(.*\n)?\s*macros:[^\n]*\n/si;
358     $config .= $c;
359   }
360   # it's an error if we have no config at all
361   return undef unless $config ne '';
362   # now we got the combined config, parse it
363   my @c = split("\n", $config);
364   my $c = Build::read_config($arch, \@c);
365   $c->{'repotype'} = [ 'rpm-md' ] unless @{$c->{'repotype'}};
366   return $c;
367 }
368
369
370 #######################################################################
371 #######################################################################
372 ##
373 ## Job management functions
374 ##
375
376 # scheduled jobs (does not need to be exact)
377 my %ourjobs = map {$_ => 1} grep {!/(?::dir|:status)$/} ls($myjobsdir);
378
379 #
380 # killjob - kill a single build job
381 #
382 # input: $job - job identificator
383 #
384 sub killjob {
385   my ($job) = @_;
386
387   local *F;
388   if (! -e "$myjobsdir/$job:status") {
389     # create locked status
390     my $js = {'code' => 'deleting'};
391     if (BSUtil::lockcreatexml(\*F, "$myjobsdir/.sched.$$", "$myjobsdir/$job:status", $js, $BSXML::jobstatus)) {
392       print "        (job was not building)\n";
393       unlink("$myjobsdir/$job");
394       unlink("$myjobsdir/$job:status");
395       close F;
396       delete $ourjobs{$job};
397       return;
398     }
399     # lock failed, dispatcher was faster!
400     die("$myjobsdir/$job:status: $!\n") unless -e "$myjobsdir/$job:status";
401   }
402   my $js = BSUtil::lockopenxml(\*F, '<', "$myjobsdir/$job:status", $BSXML::jobstatus, 1);
403   if (!$js) {
404     # can't happen actually
405     print "        (job was not building)\n";
406     unlink("$myjobsdir/$job");
407     delete $ourjobs{$job};
408     return;
409   }
410   if ($js->{'code'} eq 'building') {
411     print "        (job was building on $js->{'workerid'})\n";
412     my $req = {
413       'uri' => "$js->{'uri'}/discard",
414       'timeout' => 60,
415     };
416     eval {
417       BSRPC::rpc($req, undef, "jobid=$js->{'jobid'}");
418     };
419     warn("kill $job: $@") if $@;
420   }
421   if (-d "$myjobsdir/$job:dir") {
422     unlink("$myjobsdir/$job:dir/$_") for ls("$myjobsdir/$job:dir");
423     rmdir("$myjobsdir/$job:dir");
424   }
425   unlink("$myjobsdir/$job");
426   unlink("$myjobsdir/$job:status");
427   close(F);
428   delete $ourjobs{$job};
429 }
430
431 #
432 # killjob - kill a single build job if it is scheduled but not building
433 #
434 # input: $job - job identificator
435 #
436 sub killscheduled {
437   my ($job) = @_;
438
439   return if -e "$myjobsdir/$job:status";
440   local *F;
441   my $js = {'code' => 'deleting'};
442   if (BSUtil::lockcreatexml(\*F, "$myjobsdir/.sched.$$", "$myjobsdir/$job:status", $js, $BSXML::jobstatus)) {
443     unlink("$myjobsdir/$job");
444     unlink("$myjobsdir/$job:status");
445     close F;
446     delete $ourjobs{$job};
447   }
448 }
449
450 #
451 # jobname - create first part job job identifcation
452 #
453 # input:  $prp    - prp the job belongs to
454 #         $packid - package we are building
455 # output: first part of job identification
456 #
457 # append srcmd5 for full identification
458 #
459 sub jobname {
460   my ($prp, $packid) = @_;
461   my $job = "$prp/$packid";
462   $job =~ s/\//::/g;
463   return $job;
464 }
465
466 #
467 # killbuilding - kill build jobs 
468 #
469 # - used if a project/package got deleted to kill all running
470 #   jobs
471
472 # input: $prp    - prp we are working on
473 #        $packid - just kill the builds of the package
474 #           
475 sub killbuilding {
476   my ($prp, $packid) = @_;
477   my @jobs;
478   if (defined $packid) {
479     my $f = jobname($prp, $packid);
480     @jobs = grep {$_ eq $f || /^\Q$f\E-[0-9a-f]{32}$/} ls($myjobsdir);
481   } else {
482     my $f = jobname($prp, '');
483     @jobs = grep {/^\Q$f\E/} ls($myjobsdir);
484     @jobs = grep {!/(?::dir|:status)$/} @jobs;
485   }
486   for my $job (@jobs) {
487     print "        killing obsolete job $job\n";
488     killjob($job);
489   }
490 }
491
492 #
493 # set_building  - create a new build job
494 #
495 # input:  $projid        - project this package belongs to
496 #         $repoid        - repository we are building for
497 #         $packid        - package to be built
498 #         $pdata         - package data
499 #         $info          - file and dependency information
500 #         $bconf         - project configuration
501 #         $subpacks      - all subpackages of this package we know of
502 #         $edeps         - expanded build dependencies
503 #         $prpsearchpath - build repository search path
504 #         $reason        - what triggered the build
505 #         $relsyncmax    - bcnt sync data
506 #         $needed        - packages blocked by this job
507 #
508 # output: $job           - the job identifier
509 #         $error         - in case we could not start the job
510 #
511 # check if this job is already building, if yes, do nothing.
512 # otherwise calculate and expand build dependencies, kill all
513 # other jobs of the same prp/package, write status and job info.
514 # not that hard, was it?
515 #
516 sub set_building {
517   my ($projid, $repoid, $packid, $pdata, $info, $bconf, $subpacks, $edeps, $prpsearchpath, $reason, $relsyncmax, $needed) = @_;
518
519   my $prp = "$projid/$repoid";
520   my $srcmd5 = $pdata->{'srcmd5'};
521   my $job = jobname($prp, $packid);
522   return "$job-$srcmd5" if -s "$myjobsdir/$job-$srcmd5";
523   return $job if -s "$myjobsdir/$job";
524   my @otherjobs = grep {/^\Q$job\E-[0-9a-f]{32}$/} ls($myjobsdir);
525   $job = "$job-$srcmd5";
526
527   # a new one. expand usedforbuild. write info file.
528   my $prptype = $bconf->{'type'};
529   $info->{'file'} =~ /\.(spec|dsc|kiwi)$/;
530   my $packtype = $1 || 'spec';
531
532   my $searchpath = [];
533   my $syspath;
534   if ($packtype eq 'kiwi') {
535     if ($prpsearchpath) {
536       $syspath = [];
537       for (@$prpsearchpath) {
538         my @pr = split('/', $_, 2);
539         if ($remoteprojs{$pr[0]}) {
540           push @$syspath, {'project' => $pr[0], 'repository' => $pr[1], 'server' => $BSConfig::srcserver};
541         } else {
542           push @$syspath, {'project' => $pr[0], 'repository' => $pr[1], 'server' => $BSConfig::reposerver};
543         }
544       }
545     }
546     $prpsearchpath = [ map {"$_->{'project'}/$_->{'repository'}"} @{$info->{'path'} || []} ];
547   }
548   for (@$prpsearchpath) {
549     my @pr = split('/', $_, 2);
550     if ($remoteprojs{$pr[0]}) {
551       push @$searchpath, {'project' => $pr[0], 'repository' => $pr[1], 'server' => $BSConfig::srcserver};
552     } else {
553       push @$searchpath, {'project' => $pr[0], 'repository' => $pr[1], 'server' => $BSConfig::reposerver};
554     }
555   }
556
557   # calculate packages needed for building
558   my @bdeps = ( @{$info->{'dep'} || []}, @{$info->{'prereq'} || []} );
559
560   if ($packtype eq 'kiwi') {
561     # packages used for build environment, this should go to project config ...
562     @bdeps = ('kiwi', 'createrepo', 'tar');
563     push @bdeps, grep {/^kiwi-/} @{$info->{'dep'} || []};
564   }
565
566   my $eok;
567   ($eok, @bdeps) = Build::get_build($bconf, $subpacks, @bdeps);
568   if (!$eok) {
569     print "        unresolvables:\n";
570     print "          $_\n" for @bdeps;
571     return (undef, "unresolvable: ".join(', ', @bdeps));
572   }
573
574   # find the last build count we used for this version/release
575   mkdir_p("$reporoot/$prp/$myarch/$packid");
576   my $h;
577   if (-e "$reporoot/$prp/$myarch/$packid/history") {
578     $h = BSFileDB::fdb_getmatch("$reporoot/$prp/$myarch/$packid/history", $historylay, 'versrel', $pdata->{'versrel'}, 1);
579   }
580   $h = {'bcnt' => 0} unless $h;
581
582   # max with sync data
583   my $tag = $pdata->{'bcntsynctag'} || $packid;
584   if ($relsyncmax->{"$tag/$pdata->{'versrel'}"}) {
585     if ($h->{'bcnt'} + 1 < $relsyncmax->{"$tag/$pdata->{'versrel'}"}) {
586       $h->{'bcnt'} = $relsyncmax->{"$tag/$pdata->{'versrel'}"} - 1;
587     }
588   }
589
590   # kill those ancient other jobs
591   for my $otherjob (@otherjobs) {
592     print "        killing old job $otherjob\n";
593     killjob($otherjob);
594   }
595
596   # jay! ready for building, write status and job info
597   my $now = time();
598   writexml("$reporoot/$prp/$myarch/$packid/.status", "$reporoot/$prp/$myarch/$packid/status", { 'status' => 'scheduled', 'readytime' => $now, 'job' => $job}, $BSXML::buildstatus);
599   # And store reason and time
600   $reason->{'time'} = $now;
601   writexml("$reporoot/$prp/$myarch/$packid/.reason", "$reporoot/$prp/$myarch/$packid/reason", $reason, $BSXML::buildreason);
602
603   my @pdeps = Build::get_preinstalls($bconf);
604   my @vmdeps = Build::get_vminstalls($bconf);
605   my @cbpdeps = Build::get_cbpreinstalls($bconf); # crossbuild preinstall
606   my @cbdeps = Build::get_cbinstalls($bconf);  # crossbuild install
607   my %runscripts = map {$_ => 1} Build::get_runscripts($bconf);
608   my %bdeps = map {$_ => 1} @bdeps;
609   my %pdeps = map {$_ => 1} @pdeps;
610   my %vmdeps = map {$_ => 1} @vmdeps;
611   my %cbpdeps = map {$_ => 1} @cbpdeps;
612   my %cbdeps = map {$_ => 1} @cbdeps;
613   my %edeps = map {$_ => 1} @$edeps;
614   @bdeps = unify(@pdeps, @vmdeps, @$edeps, @bdeps, @cbpdeps, @cbdeps);
615   for (@bdeps) {
616     $_ = {'name' => $_};
617     $_->{'preinstall'} = 1 if $pdeps{$_->{'name'}};
618     $_->{'vminstall'} = 1 if $vmdeps{$_->{'name'}};
619     $_->{'cbpreinstall'} = 1 if $cbpdeps{$_->{'name'}};
620     $_->{'cbinstall'} = 1 if $cbdeps{$_->{'name'}};
621     $_->{'runscripts'} = 1 if $runscripts{$_->{'name'}};
622     $_->{'notmeta'} = 1 unless $edeps{$_->{'name'}};
623     $_->{'noinstall'} = 1 if $packtype eq 'kiwi' && $edeps{$_->{'name'}} && !($bdeps{$_->{'name'}} || $vmdeps{$_->{'name'}} || $pdeps{$_->{'name'}});
624   }
625   if ($info->{'extrasource'}) {
626     push @bdeps, map {{
627       'name' => $_->{'file'}, 'version' => '', 'repoarch' => 'src',
628       'project' => $_->{'project'}, 'package' => $_->{'package'}, 'srcmd5' => $_->{'srcmd5'},
629     }} @{$info->{'extrasource'}};
630   }
631
632   my $vmd5 = $pdata->{'verifymd5'} || $pdata->{'srcmd5'};
633   my $binfo = {
634     'project' => $projid,
635     'repository' => $repoid,
636     'package' => $packid,
637     'srcserver' => $BSConfig::srcserver,
638     'reposerver' => $BSConfig::reposerver,
639     'job' => $job,
640     'arch' => $myarch,
641     'reason' => $reason->{'explain'},
642     'readytime' => $now,
643     'srcmd5' => $pdata->{'srcmd5'},
644     'verifymd5' => $vmd5,
645     'rev' => $pdata->{'rev'},
646     'file' => $info->{'file'},
647     'versrel' => $pdata->{'versrel'},
648     'bcnt' => $h->{'bcnt'} + 1,
649     'subpack' => ($subpacks || []),
650     'bdep' => \@bdeps,
651     'path' => $searchpath,
652     'needed' => $needed,
653   };
654   $binfo->{'syspath'} = $syspath if $syspath;
655   if ($pdata->{'revtime'}) {
656     $binfo->{'revtime'} = $pdata->{'revtime'};
657     # use max of revtime for interproject links
658     for (@{$pdata->{'linked'} || []}) {
659       last if $_->{'project'} ne $projid || !$projpacks->{$projid}->{'package'};
660       my $lpdata = $projpacks->{$projid}->{'package'}->{$_->{'package'}} || {};
661       $binfo->{'revtime'} = $lpdata->{'revtime'} if ($lpdata->{'revtime'} || 0) > $binfo->{'revtime'};
662     }
663   }
664   $binfo->{'imagetype'} = $info->{'imagetype'} if $info->{'imagetype'};
665   my $release = $pdata->{'versrel'};
666   $release = '0' unless defined $release;
667   $release =~ s/.*-//;
668   my $bcnt = $h->{'bcnt'} + 1;
669   if (defined($bconf->{'release'})) {
670     $binfo->{'release'} = $bconf->{'release'};
671     $binfo->{'release'} =~ s/\<CI_CNT\>/$release/g;
672     $binfo->{'release'} =~ s/\<B_CNT\>/$bcnt/g;
673   }
674   my $debuginfo = $bconf->{'debuginfo'};
675   $debuginfo = enabled($repoid, $projpacks->{$projid}->{'debuginfo'}, $debuginfo);
676   $debuginfo = enabled($repoid, $pdata->{'debuginfo'}, $debuginfo);
677   $binfo->{'debuginfo'} = 1 if $debuginfo;
678
679   writexml("$myjobsdir/.$job", "$myjobsdir/$job", $binfo, $BSXML::buildinfo);
680   # all done. the dispatcher will now pick up the job and send it
681   # to a worker.
682   $ourjobs{$job} = 1;
683   return $job;
684 }
685
686
687 #######################################################################
688 #######################################################################
689 ##
690 ## Repository management functions
691 ##
692
693 sub checkaccess {
694   my ($type, $projid, $packid, $repoid) = @_;
695   my $access = 1;
696   if ($projpacks->{$projid}) {
697     my $pdata;
698     $pdata = ($projpacks->{$projid}->{'package'} || {})->{$packid} if defined $packid;
699     $access = enabled($repoid, $projpacks->{$projid}->{$type}, $access);
700     $access = enabled($repoid, $pdata->{$type}, $access) if $pdata;
701   } else {
702     # remote project access checks are handled by the remote server
703     $access = 0 unless $remoteprojs{$projid};
704   }
705   return $access;
706 }
707
708 # check if every user from oprojid may access projid
709 sub checkroles {
710   my ($type, $projid, $packid, $oprojid, $opackid) = @_;
711   my $proj = $projpacks->{$projid};
712   my $oproj = $projpacks->{$oprojid};
713   return 0 unless $proj && $oproj;
714   if ($projid eq $oprojid) {
715     return 1 if !defined $opackid;
716     return 1 if ($packid || '') eq ($opackid || '');
717   }
718   my @roles;
719   if (defined($packid)) {
720     my $pdata = ($proj->{'package'} || {})->{$packid} || {};
721     push @roles, @{$pdata->{'person'} || []}, @{$pdata->{'group'} || []};
722   }
723   push @roles, @{$proj->{'person'} || []}, @{$proj->{'group'} || []};
724   while ($projid =~ /^(.+):/) {
725     $projid = $1;
726     $proj = $projpacks->{$projid} || {};
727     push @roles, @{$proj->{'person'} || []}, @{$proj->{'group'} || []};
728   }
729   my @oroles;
730   if (defined($opackid)) {
731     my $pdata = ($oproj->{'package'} || {})->{$opackid} || {};
732     push @roles, @{$pdata->{'person'} || []}, @{$pdata->{'group'} || []};
733   }
734   push @roles, @{$oproj->{'person'} || []}, @{$oproj->{'group'} || []};
735   while ($oprojid =~ /^(.+):/) {
736     $oprojid = $1;
737     $oproj = $projpacks->{$oprojid} || {};
738     push @roles, @{$oproj->{'person'} || []}, @{$oproj->{'group'} || []};
739   }
740   # make sure every user from oprojid can also access projid
741   # XXX: check type and roles
742   for my $r (@oroles) {
743     next if $r->{'role'} eq 'bugowner';
744     my @rx; 
745     if (exists $r->{'userid'}) {
746       push @rx, grep {exists($_->{'userid'}) && $_->{'userid'} eq $r->{'userid'}} @roles;
747     }    
748     if (exists $r->{'groupid'}) {
749       push @rx, grep {exists($_->{'groupid'}) && $_->{'groupid'} eq $r->{'groupid'}} @roles;
750     }    
751     return 0  unless grep {$_->{'role'} eq $r->{'role'} || $_->{'role'} eq 'maintainer'} @rx;
752   }
753   return 1;
754 }
755
756 # check if we may access repo $aprp from repo $prp
757 sub checkprpaccess {
758   my ($aprp, $prp) = @_;
759   return 1 if $aprp eq $prp;
760   my ($aprojid, $arepoid) = split('/', $aprp, 2);
761   return 1 if checkaccess('access', $aprojid, undef, $arepoid);
762   my ($projid, $repoid) = split('/', $prp, 2);
763   return 0 unless checkaccess('access', $projid, undef, $repoid);
764   return checkroles('access', $aprojid, undef, $projid, undef);
765 }
766
767 #
768 # sendpublishevent - send a publish event to the publisher
769 #
770 # input: $prp - prp to be published
771 #
772 sub sendpublishevent {
773   my ($prp) = @_;
774
775   my ($projid, $repoid) = split('/', $prp, 2);
776   my $ev = {
777     'type' => 'publish',
778     'project' => $projid,
779     'repository' => $repoid,
780   };
781   sendevent($ev, 'publish', "${projid}::$repoid");
782 }
783
784 sub sendrepochangeevent {
785   my ($prp) = @_;
786
787   my ($projid, $repoid) = split('/', $prp, 2);
788   my $ev = {
789     'type' => 'repository',
790     'project' => $projid,
791     'repository' => $repoid,
792     'arch' => $myarch,
793   };
794   sendevent($ev, 'repository', "${projid}::${repoid}::${myarch}");
795 }
796
797 sub set_repo_state {
798   my ($prp, $state) = @_;
799
800   unlink("$reporoot/$prp/$myarch/:schedulerstate.dirty") if $state eq "scheduling";
801   
802   writestr("$reporoot/$prp/$myarch/:schedulerstate.new", "$reporoot/$prp/$myarch/:schedulerstate", $state) if -e "$reporoot/$prp/$myarch";
803 }
804
805
806 # make sure that we have all of the deltas we need
807 # create a deltajob if some are missing
808 # note that we must have the repo lock so that $extrep does not change!
809 sub makedeltas {
810   my ($prp, $packs, $pubenabled, $bconf, $prpsearchpath) = @_;
811
812   my ($projid, $repoid) = split('/', $prp, 2);
813   my $rdir = "$reporoot/$prp/$myarch/:repo";
814   my $ddir = "$reporoot/$prp/$myarch/_deltas";
815
816   my %oldbins;
817
818   my %havedelta;
819   my @needdelta;
820   my %deltaids;
821
822   my $partial_job;
823   my $jobsize = 0;
824
825   for my $packid (@{$packs || []}) {
826     next if $pubenabled && !$pubenabled->{$packid};
827     my $pdir = "$reporoot/$prp/$myarch/$packid";
828     my @all = sort(ls($pdir));
829     my $nosourceaccess = grep {$_ eq '.nosourceaccess'} @all;
830     @all = grep {/\.rpm$/} @all;
831     next unless @all;
832     for my $bin (@all) {
833       next if $bin =~ /\.(?:no)?src\.rpm$/;     # no source deltas
834       if ($nosourceaccess) {
835         next if $bin =~ /-debug(:?info|source).*\.rpm$/;
836       }
837       next unless $bin =~ /^(.+)-[^-]+-[^-]+\.([a-zA-Z][^\/\.\-]*)\.rpm$/;
838       my $binname = $1;
839       my $binarch = $2;
840       my @binstat = stat("$pdir/$bin");
841       next unless @binstat;
842
843       # find all delta candidates for this package. we currently just
844       # use the searchpath, this may be configurable in a later version
845       my @aprp = @$prpsearchpath;
846       for my $aprp (@aprp) {
847         # look in the *published* repos. this does not work for
848         # projects that have publishing disabled, like "openSUSE:*"
849         my $aextrep = $aprp;
850         $aextrep =~ s/:/:\//g;
851         $aextrep = "$extrepodir/$aextrep";
852         if (!$oldbins{"$aprp/$binarch"}) {
853           $oldbins{"$aprp/$binarch"} = {};
854           for my $obin (sort(ls("$aextrep/$binarch"))) {
855             next unless $obin =~ /^(.+)-[^-]+-[^-]+\.(?:[a-zA-Z][^\/\.\-]*)\.rpm$/;
856             push @{$oldbins{"$aprp/$binarch"}->{$1}}, $obin;
857           }
858         }
859         my @cand = grep {$_ ne $bin} @{$oldbins{"$aprp/$binarch"}->{$binname}};
860         next unless @cand;
861         if (@cand > 1) {
862           # sort version/release  FIXME: epoch? use file mtime instead?
863           @cand = sort { Build::Rpm::verscmp($b, $a) } @cand;
864         }
865         # make this configurable
866         @cand = splice(@cand, 0, 1);
867         for my $obin (@cand) {
868           my @s = stat("$aextrep/$binarch/$obin");
869           next unless @s;
870           my $deltaid = Digest::MD5::md5_hex("$packid/$bin/$aprp/$obin/$s[9]/$s[7]/$s[1]");
871           $deltaids{$deltaid} = 1;
872           if (-e "$ddir/$deltaid" && (-e "$ddir/$deltaid.dseq" || ! -s "$ddir/$deltaid")) {
873             # make sure we don't already have this one
874             if (!grep {$_->[1] eq $obin} @{$havedelta{"$packid/$bin"} || []}) {
875               push @{$havedelta{"$packid/$bin"}}, [ $deltaid, $obin ];
876             }
877           } else {
878             push @needdelta, [ "$aextrep/$binarch/$obin", "$pdir/$bin", $deltaid ];
879             $jobsize += $s[7] + $binstat[7];
880             if ($jobsize > 500000000) {
881               $partial_job = 1;
882               print "    partial delta job\n";
883               last;
884             }
885           }
886         }
887       }
888     }
889     last if $partial_job;
890   }
891
892   # ddir maintenance
893   if (!$partial_job) {
894     my @ddir = sort(ls($ddir));
895     for my $deltaid (grep {!$deltaids{$_} && !/\.dseq$/} @ddir) {
896       next if $deltaid eq 'logfile';
897       unlink("$ddir/$deltaid");         # no longer need this one
898       unlink("$ddir/$deltaid.dseq");    # no longer need this one
899     }
900   }
901
902   if (@needdelta) {
903     # create a delta job
904     my $packid = '_deltas';
905     my $job = jobname($prp, $packid);
906     if (-e "$myjobsdir/$job") {
907       # delta creation already in progress. wait...
908       print "    delta creation already in progress...\n";
909       return undef, "in progress";
910     }
911     my $srcmd5 = '';
912     $srcmd5 .= $_->[2] for @needdelta;
913     $srcmd5 = Digest::MD5::md5_hex($srcmd5);
914     my $jobdatadir = "$myjobsdir/$job:dir";
915     mkdir_p($jobdatadir);
916     BSUtil::cleandir($jobdatadir);
917     return undef unless -d $jobdatadir;
918     for my $delta (@needdelta) {
919       #print Dumper($delta);
920       my $deltaid = $delta->[2];
921       link($delta->[0], "$jobdatadir/$deltaid.old") || return undef;
922       link($delta->[1], "$jobdatadir/$deltaid.new") || return undef;
923       my $qold = Build::Rpm::query("$jobdatadir/$deltaid.old", 'evra' => 1);
924       my $qnew = Build::Rpm::query("$jobdatadir/$deltaid.new", 'evra' => 1);
925       return undef unless $qold && $qnew;
926       return undef if $qold->{'name'} ne $qnew->{'name'} || $qold->{'arch'} ne $qnew->{'arch'};
927       $qold->{'epoch'} = '' unless defined $qold->{'epoch'};
928       $qnew->{'epoch'} = '' unless defined $qnew->{'epoch'};
929       my $info = '';
930       $info .= ucfirst($_).": $qnew->{$_}\n" for qw{name epoch version release arch};
931       $info .= "Old".ucfirst($_).": $qold->{$_}\n" for qw{name epoch version release arch};
932       writestr("$jobdatadir/$deltaid.info", undef, $info);
933     }
934     # create job
935     my $prptype = $bconf->{'type'};
936     my ($eok, @bdeps) = Build::get_build($bconf, [], "deltarpm");
937     if (!$eok) {
938       print "        unresolvables:\n";
939       print "          $_\n" for @bdeps;
940       return (undef, "unresolvable: ".join(', ', @bdeps));
941     }
942     my $now = time();
943     my @pdeps = Build::get_preinstalls($bconf);
944     my @vmdeps = Build::get_vminstalls($bconf);
945     my %runscripts = map {$_ => 1} Build::get_runscripts($bconf);
946     my %bdeps = map {$_ => 1} @bdeps;
947     my %pdeps = map {$_ => 1} @pdeps;
948     my %vmdeps = map {$_ => 1} @vmdeps;
949     @bdeps = unify(@pdeps, @vmdeps, @bdeps);
950     for (@bdeps) {
951       $_ = {'name' => $_}; 
952       $_->{'preinstall'} = 1 if $pdeps{$_->{'name'}};
953       $_->{'vminstall'} = 1 if $vmdeps{$_->{'name'}};
954       $_->{'runscripts'} = 1 if $runscripts{$_->{'name'}};
955       $_->{'notmeta'} = 1;
956     }
957     my $searchpath = [];
958     for (@$prpsearchpath) {
959       my @pr = split('/', $_, 2);
960       if ($remoteprojs{$pr[0]}) {
961         push @$searchpath, {'project' => $pr[0], 'repository' => $pr[1], 'server' => $BSConfig::srcserver};
962       } else {
963         push @$searchpath, {'project' => $pr[0], 'repository' => $pr[1], 'server' => $BSConfig::reposerver};
964       }
965     }
966
967     my $binfo = {
968       'project' => $projid,
969       'repository' => $repoid,
970       'package' => $packid,
971       'file' => '_delta',
972       'srcmd5' => $srcmd5,
973       'reason' => 'source change',
974       'srcserver' => $BSConfig::srcserver,
975       'reposerver' => $BSConfig::reposerver,
976       'job' => $job,
977       'arch' => $myarch,
978       'readytime' => $now,
979       'bdep' => \@bdeps,
980       'path' => $searchpath,
981       'needed' => 0,
982     };
983
984     writexml("$myjobsdir/.$job", "$myjobsdir/$job", $binfo, $BSXML::buildinfo);
985     print "    creating deltas...\n";
986     return (undef, 'building');
987   }
988   return \%havedelta;
989 }
990
991 sub mkdeltaname {
992   my ($old, $new) = @_;
993   # name-version-release.arch.rpm
994   my $newtail = '';
995   if ($old =~ /^(.*)(\.[^\.]+\.rpm$)/) {
996     $old = $1;
997   }
998   if ($new =~ /^(.*)(\.[^\.]+\.rpm$)/) {
999     $new = $1;
1000     $newtail = $2;
1001   }
1002   my @old = split('-', $old);
1003   my @new = split('-', $new);
1004   my @out;
1005   while (@old || @new) {
1006     $old = shift @old;
1007     $new = shift @new;
1008     $old = '' unless defined $old;
1009     $new = '' unless defined $new;
1010     if ($old eq $new) {
1011       push @out, $old;
1012     } else {
1013       push @out, "${old}_${new}";
1014     }
1015   }
1016   my $ret = join('-', @out).$newtail;
1017   $ret =~ s/\.rpm$//;
1018   return "$ret.drpm";
1019 }
1020
1021 #
1022 # prpfinished  - publish a prp
1023 #
1024 # updates :repo and sends an event to the publisher
1025 #
1026 # input:  $prp        - the finished prp
1027 #         $packs      - packages in project
1028 #
1029 # prpfinished  - publish a prp
1030 #
1031 # updates :repo and sends an event to the publisher
1032 #
1033 # input:  $prp        - the finished prp
1034 #         $packs      - packages in project
1035 #                       undef -> arch no longer builds this repository
1036 #         $pubenabled - only publish those packages
1037 #                       undef -> publish all packages
1038 #         $bconf      - the config for this prp
1039 #
1040
1041 sub compile_publishfilter {
1042   my ($filter) = @_;
1043   return undef unless $filter;
1044   my @res;
1045   for (@$filter) {
1046     eval {
1047       push @res, qr/$_/;
1048     };
1049   }
1050   return \@res;
1051 }
1052
1053 #my $default_publishfilter = [
1054 #  '-debuginfo-.*\.rpm$',
1055 #  '-debugsource-.*\.rpm$',
1056 #];
1057
1058 my $default_publishfilter;
1059
1060 sub publishdelta {
1061   my ($prp, $delta, $bin, $rdir, $rbin, $origin, $packid) = @_;
1062
1063   my @s = stat("$reporoot/$prp/$myarch/_deltas/$delta->[0]");
1064   return 0 unless @s && $s[7];          # zero size means skip it
1065   return 0 unless -s "$reporoot/$prp/$myarch/_deltas/$delta->[0].dseq"; # need dseq file
1066   my $deltaname = mkdeltaname($delta->[1], $bin);
1067   my $deltaseqname = $deltaname;
1068   $deltaseqname =~ s/\.drpm$//;
1069   $deltaseqname .= '.dseq';
1070   my @sr = stat("$rdir/${rbin}::$deltaname");
1071   my $changed;
1072   if (!@sr || "$s[9]/$s[7]/$s[1]" ne "$sr[9]/$sr[7]/$sr[1]") {
1073     print @sr ? "      ! :repo/${rbin}::$deltaname\n" : "      + :repo/${rbin}::$deltaname\n";
1074     unlink("$rdir/${rbin}::$deltaname");
1075     unlink("$rdir/${rbin}::$deltaseqname");
1076     link("$reporoot/$prp/$myarch/_deltas/$delta->[0]", "$rdir/${rbin}::$deltaname") || die("link $reporoot/$prp/$myarch/_deltas/$delta->[0] $rdir/${rbin}::$deltaname: $!");
1077     link("$reporoot/$prp/$myarch/_deltas/$delta->[0].dseq", "$rdir/${rbin}::$deltaseqname") || die("link $reporoot/$prp/$myarch/_deltas/$delta->[0].dseq $rdir/${rbin}::$deltaseqname: $!");
1078     $changed = 1;
1079   }
1080   $origin->{"${rbin}::$deltaname"} = $packid;
1081   $origin->{"${rbin}::$deltaseqname"} = $packid;
1082   return $changed;
1083 }
1084
1085 sub prpfinished {
1086   my ($prp, $packs, $pubenabled, $bconf, $prpsearchpath) = @_;
1087
1088   print "    prp $prp is finished...\n";
1089
1090   my ($projid, $repoid) = split('/', $prp, 2);
1091   local *F;
1092   open(F, '>', "$reporoot/$prp/.finishedlock") || die("$reporoot/$prp/.finishedlock: $!\n");
1093   if (!flock(F, LOCK_EX | LOCK_NB)) {
1094     print "    waiting for lock...\n";
1095     flock(F, LOCK_EX) || die("flock: $!\n");
1096     print "    got the lock...\n";
1097   }
1098   if (!$packs) {
1099     # delete all in :repo
1100     my $r = "$reporoot/$prp/$myarch/:repo";
1101     unlink("${r}info");
1102     if (-d $r) {
1103       BSUtil::cleandir($r);
1104       rmdir($r) || die("rmdir $r: $!\n");
1105     } else {
1106       print "    nothing to delete...\n";
1107       close(F);
1108       return '';
1109     }
1110     # release lock
1111     close(F);
1112     sendpublishevent($prp);
1113     return '';
1114   }
1115
1116   # make all the deltas we need
1117   my $needdeltas;
1118   $needdeltas = 1 if grep {"$_:" =~ /:(?:deltainfo|prestodelta):/} @{$bconf->{'repotype'} || []};
1119   my ($deltas, $err) = makedeltas($prp, $needdeltas ? $packs : undef, $pubenabled, $bconf, $prpsearchpath);
1120   if (!$deltas) {
1121       close(F);
1122       return $err || 'error';
1123   }
1124
1125   my $rdir = "$reporoot/$prp/$myarch/:repo";
1126
1127   my $rinfo;
1128
1129   # link all packages into :repo
1130   my %origin;
1131   my $changed;
1132   my $filter;
1133   $filter = $bconf->{'publishfilter'} if $bconf;
1134   undef $filter if $filter && !@$filter;
1135   $filter ||= $default_publishfilter;
1136   $filter = compile_publishfilter($filter);
1137
1138   for my $packid (@$packs) {
1139     if ($pubenabled && !$pubenabled->{$packid}) {
1140       # publishing of this package is disabled
1141       if (!$rinfo) {
1142         $rinfo = {};
1143         $rinfo = BSUtil::retrieve("${rdir}info") if -s "${rdir}info";
1144         $rinfo->{'binaryorigins'} ||= {};
1145       }
1146       print "        $packid: publishing disabled\n";
1147       my @all = grep {$rinfo->{'binaryorigins'}->{$_} eq $packid} keys %{$rinfo->{'binaryorigins'}};
1148       for my $bin (@all) {
1149         next if exists $origin{$bin};   # first one wins
1150         $origin{$bin} = $packid;
1151       }
1152       next;
1153     }
1154     my $pdir = "$reporoot/$prp/$myarch/$packid";
1155     my @all = sort(ls($pdir));
1156     my $debian = grep {/\.dsc$/} @all;
1157     my $nosourceaccess = grep {$_ eq '.nosourceaccess'} @all;
1158     @all = grep {$_ ne 'history' && $_ ne 'logfile' && $_ ne 'meta' && $_ ne 'status' && $_ ne '.bininfo' && $_ ne 'reason' && $_ ne '.nosourceaccess'} @all;
1159     for my $bin (@all) {
1160      next if $bin eq '.updateinfodata';
1161       my $rbin = $bin;
1162       # XXX: should be source name instead?
1163       $rbin = "${packid}::$bin" if $debian || $bin eq 'updateinfo.xml';
1164       next if exists $origin{$rbin};    # first one wins
1165       if ($nosourceaccess) {
1166         next if $bin =~ /\.(?:no)?src\.rpm$/;
1167         next if $bin =~ /-debug(:?info|source).*\.rpm$/;
1168         next if $debian && ($bin !~ /\.deb$/);
1169       }
1170       if ($filter) {
1171         my $bad;
1172         for (@$filter) {
1173           next unless $bin =~ /$_/;
1174           $bad = 1;
1175           last;
1176         }
1177         next if $bad;
1178       }
1179       $origin{$rbin} = $packid;
1180       # link from package dir (pdir) to repo dir (rdir)
1181       my @sr = lstat("$rdir/$rbin");
1182       if (@sr) {
1183         my $risdir = -d _ ? 1 : 0;
1184         my @s = lstat("$pdir/$bin");
1185         my $pisdir = -d _ ? 1 : 0;
1186         next unless @s;
1187         if ("$s[9]/$s[7]/$s[1]" eq "$sr[9]/$sr[7]/$sr[1]") {
1188           # unchanged file, check deltas
1189           if ($deltas->{"$packid/$bin"}) {
1190             for my $delta (@{$deltas->{"$packid/$bin"}}) {
1191               $changed = 1 if publishdelta($prp, $delta, $bin, $rdir, $rbin, \%origin, $packid);
1192             }
1193           }
1194           next;
1195         }
1196         if ($risdir && $pisdir) {
1197           my $rinfo = BSUtil::treeinfo("$rdir/$rbin");
1198           my $pinfo = BSUtil::treeinfo("$pdir/$bin");
1199           next if join(',', @$rinfo) eq join(',', @$pinfo);
1200         }
1201         print "      ! :repo/$rbin ($packid)\n";
1202         if ($risdir) {
1203           BSUtil::cleandir("$rdir/$rbin");
1204           rmdir("$rdir/$rbin");
1205         } else {
1206           unlink("$rdir/$rbin");
1207         }
1208       } else {
1209         print "      + :repo/$rbin ($packid)\n";
1210         mkdir_p($rdir) unless -d $rdir;
1211       }
1212       if (! -l "$pdir/$bin" && -d _) {
1213         BSUtil::linktree("$pdir/$bin", "$rdir/$rbin");
1214       } else {
1215         link("$pdir/$bin", "$rdir/$rbin") || die("link $pdir/$bin $rdir/$rbin: $!\n");
1216         if ($deltas->{"$packid/$bin"}) {
1217           for my $delta (@{$deltas->{"$packid/$bin"}}) {
1218             publishdelta($prp, $delta, $bin, $rdir, $rbin, \%origin, $packid);
1219           }
1220         }
1221       }
1222       $changed = 1;
1223     }
1224   }
1225   for my $rbin (sort(ls($rdir))) {
1226     next if exists $origin{$rbin};
1227     if (0) {
1228       if (!$rinfo) {
1229         $rinfo = {};
1230         $rinfo = BSUtil::retrieve("${rdir}info") if -s "${rdir}info";
1231         $rinfo->{'binaryorigins'} ||= {};
1232       }
1233       $origin{$rbin} = $rinfo->{'binaryorigins'}->{$rbin} if $rinfo->{'binaryorigins'}->{$rbin};
1234       next;
1235     }
1236     print "      - :repo/$rbin\n";
1237     if (! -l "$rdir/$rbin" && -d _) {
1238       BSUtil::cleandir("$rdir/$rbin");
1239       rmdir("$rdir/$rbin") || die("rmdir $rdir/$rbin: $!\n");
1240     } else {
1241       if (-f "$rdir/$rbin") {
1242        unlink("$rdir/$rbin") || die("unlink $rdir/$rbin: $!\n");
1243       }
1244     }
1245     $changed = 1;
1246   }
1247
1248   # write new rpminfo
1249   $rinfo = {'binaryorigins' => \%origin};
1250   BSUtil::store("${rdir}info.new", "${rdir}info", $rinfo);
1251
1252   # release lock and ping publisher
1253   close(F);
1254   sendpublishevent($prp);
1255   return '';
1256 }
1257
1258 my $exportcnt = 0;
1259
1260 sub createexportjob {
1261   my ($prp, $arch, $jobrepo, $dst, $oldrepo, $meta, @exports) = @_;
1262
1263   # create unique id
1264   my $job = "import-".Digest::MD5::md5_hex("$exportcnt.$$.$myarch.".time());
1265   $exportcnt++;
1266
1267   local *F;
1268   my $jobstatus = {
1269     'code' => 'finished',
1270   };
1271   mkdir_p("$jobsdir/$arch") unless -d "$jobsdir/$arch";
1272   if (!BSUtil::lockcreatexml(\*F, "$jobsdir/$arch/.$job", "$jobsdir/$arch/$job:status", $jobstatus, $BSXML::jobstatus)) {
1273     print "job lock failed!\n";
1274     return;
1275   }
1276
1277   my ($projid, $repoid) = split('/', $prp, 2);
1278   my $info = {
1279     'project' => $projid,
1280     'repository' => $repoid,
1281     'package' => ':import',
1282     'arch' => $arch,
1283     'job' => $job,
1284   };
1285   writexml("$jobsdir/$arch/.$job", "$jobsdir/$arch/$job", $info, $BSXML::buildinfo);
1286   my $dir = "$jobsdir/$arch/$job:dir";
1287   mkdir_p($dir);
1288   if ($meta) {
1289     link($meta, "$meta.dup");
1290     rename("$meta.dup", "$dir/meta");
1291     unlink("$meta.dup");
1292   }
1293   my %seen;
1294   while (@exports) {
1295     my ($rp, $r) = splice(@exports, 0, 2);
1296     next unless $r->{'source'};
1297     link("$dst/$rp", "$dir/$rp") || warn("link $dst/$rp $dir/$rp: $!\n");
1298     $seen{$r->{'id'}} = 1;
1299   }
1300   my @replaced;
1301   for my $rp (sort keys %$oldrepo) {
1302     my $r = $oldrepo->{$rp};
1303     next unless $r->{'source'}; # no src rpms in full tree
1304     next if $seen{$r->{'id'}};
1305     my $suf = $rp;
1306     $suf =~ s/.*\.//;
1307     push @replaced, {'name' => "$r->{'name'}.$suf", 'id' => $r->{'id'}};
1308   }
1309   if (@replaced) {
1310     writexml("$dir/replaced.xml", undef, {'name' => 'replaced', 'entry' => \@replaced}, $BSXML::dir);
1311   }
1312   close F;
1313   my $ev = {
1314     'type' => 'import',
1315     'job' => $job,
1316   };
1317   sendevent($ev, $arch, "import.$job");
1318 }
1319
1320
1321 my %default_exportfilters = (
1322   'i586' => {
1323     '\.x86_64\.rpm$'   => [ 'x86_64' ],
1324     '\.ia64\.rpm$'     => [ 'ia64' ],
1325     '-debuginfo-.*\.rpm$' => [],
1326     '-debugsource-.*\.rpm$' => [],
1327   },
1328   'x86_64' => {
1329     '-debuginfo-.*\.rpm$' => [],
1330     '-debugsource-.*\.rpm$' => [],
1331   },
1332   'ppc' => {
1333     '\.ppc64\.rpm$'   => [ 'ppc64' ],
1334     '-debuginfo-.*\.rpm$' => [],
1335     '-debugsource-.*\.rpm$' => [],
1336   },
1337   'ppc64' => {
1338     '\.ppc\.rpm$'   => [ 'ppc' ],
1339     '-debuginfo-.*\.rpm$' => [],
1340     '-debugsource-.*\.rpm$' => [],
1341   },
1342   'sparc' => {
1343     # discard is intended - sparcv9 target is better suited for 64-bit baselibs
1344     '\.sparc64\.rpm$' => [],
1345     '-debuginfo-.*\.rpm$' => [],
1346     '-debugsource-.*\.rpm$' => [],
1347   },
1348   'sparcv8' => {
1349     # discard is intended - sparcv9 target is better suited for 64-bit baselibs
1350     '\.sparc64\.rpm$' => [],
1351     '-debuginfo-.*\.rpm$' => [],
1352     '-debugsource-.*\.rpm$' => [],
1353   },
1354   'sparcv9' => {
1355     '\.sparc64\.rpm$' => [ 'sparc64' ],
1356     '-debuginfo-.*\.rpm$' => [],
1357     '-debugsource-.*\.rpm$' => [],
1358   },
1359   'sparcv9v' => {
1360     '\.sparc64v\.rpm$' => [ 'sparc64v' ],
1361     '-debuginfo-.*\.rpm$' => [],
1362     '-debugsource-.*\.rpm$' => [],
1363   },
1364   'sparc64' => {
1365     '\.sparcv9\.rpm$' => [ 'sparcv9' ],
1366     '-debuginfo-.*\.rpm$' => [],
1367     '-debugsource-.*\.rpm$' => [],
1368   },
1369   'sparc64v' => {
1370     '\.sparcv9v\.rpm$' => [ 'sparcv9v' ],
1371     '-debuginfo-.*\.rpm$' => [],
1372     '-debugsource-.*\.rpm$' => [],
1373   },
1374 );
1375
1376 sub compile_exportfilter {
1377   my ($filter) = @_;
1378   return undef unless $filter;
1379   my @res;
1380   for (@$filter) {
1381     eval {
1382       push @res, [ qr/$_->[0]/, $_->[1] ];
1383     };
1384   }
1385   return \@res;
1386 }
1387
1388 #
1389 # moves binary packages from jobrepo to dst and updates full repository
1390 #
1391
1392 sub update_dst_full {
1393   my ($prp, $packid, $dst, $jobdir, $meta, $useforbuildenabled, $prpsearchpath) = @_;
1394
1395   my ($projid, $repoid) = split('/', $prp, 2);
1396
1397   # check for lock
1398   if ($projpacks->{$projid} && $projpacks->{$projid}->{'package'} && $projpacks->{$projid}->{'package'}->{$packid}) {
1399     my $locked = 0;
1400     $locked = enabled($repoid, $projpacks->{$projid}->{'lock'}, $locked) if $projpacks->{$projid}->{'lock'};
1401     my $pdata = $projpacks->{$projid}->{'package'}->{$packid};
1402     $locked = enabled($repoid, $pdata->{'lock'}, $locked) if $pdata->{'lock'};
1403     if ($locked) {
1404       print "    package is locked\n";
1405       return;
1406     }
1407   }
1408
1409   my $jobrepo;
1410   my @jobfiles;
1411   if (defined($jobdir)) {
1412     @jobfiles = sort(ls($jobdir));
1413     @jobfiles = grep {$_ ne 'history' && $_ ne 'logfile' && $_ ne 'meta' && $_ ne 'status' && $_ ne 'reason' && $_ ne '.bininfo'} @jobfiles;
1414     my $cache;
1415     if (-e "$jobdir/.bininfo") {
1416       $cache = BSUtil::retrieve("$jobdir/.bininfo", 1);
1417       unlink("$jobdir/.bininfo");
1418     }
1419     $jobrepo = findbins_dir([ map {"$jobdir/$_"} grep {/\.(?:rpm|deb)$/ && !/\.delta\.rpm$/} @jobfiles ], $cache);
1420   } else {
1421     $jobrepo = {};
1422   }
1423
1424   ##################################################################
1425   # part 1: move files into package directory ($dst)
1426
1427   my $gdst = "$reporoot/$prp/$myarch";
1428
1429   my $oldrepo;
1430   my $isimport;
1431
1432   if ($dst && $jobdir && $dst eq $jobdir) {
1433     # a "refresh" operation, nothing to do here
1434     $oldrepo = $jobrepo;
1435   } elsif ($dst) {
1436     # get old state
1437     my @oldfiles = sort(ls($dst));
1438     @oldfiles = grep {$_ ne 'history' && $_ ne 'logfile' && $_ ne 'meta' && $_ ne 'status' && $_ ne 'reason' && $_ ne '.bininfo'} @oldfiles;
1439     $oldrepo = findbins_dir([ map {"$dst/$_"} grep {/\.(?:rpm|deb)$/ && !/\.delta\.rpm$/} @oldfiles ]);
1440
1441     # move files over
1442     mkdir_p($dst);
1443     my %new;
1444     for my $f (@jobfiles) {
1445       if (! -l "$dst/$f" && -d _) {
1446         BSUtil::cleandir("$dst/$f");
1447         rmdir("$dst/$f");
1448       }
1449       rename("$jobdir/$f", "$dst/$f") || die("rename $jobdir/$f $dst/$f: $!\n");
1450       $new{$f} = 1;
1451     }
1452     for my $f (grep {!$new{$_}} @oldfiles) {
1453       if (! -l "$dst/$f" && -d _) {
1454         BSUtil::cleandir("$dst/$f");
1455         rmdir("$dst/$f");
1456       } else {
1457         unlink("$dst/$f") ;
1458       }
1459     }
1460     # we only check 'sourceaccess', not 'access' here. 'access' has
1461     # to be handled anyway, so we don't gain anything by limiting
1462     # source access.
1463     BSUtil::touch("$dst/.nosourceaccess") unless checkaccess('sourceaccess', $projid, $packid, $repoid);
1464   } else {
1465     # dst = undef is true for importevents
1466     $isimport = 1;
1467     my $replaced = (readxml("$jobdir/replaced.xml", $BSXML::dir, 1) || {})->{'entry'};
1468     $oldrepo = {};
1469     for (@{$replaced || []}) {
1470       my $rp = $_->{'name'};
1471       $_->{'name'} =~ s/\.[^\.]*$//;
1472       $_->{'source'} = 1;
1473       $oldrepo->{$rp} = $_;
1474     }
1475     $dst = $jobdir;     # get em from the jobdir
1476   }
1477
1478   if (!$isimport) {
1479     # write .bininfo file
1480     my $bininfo = '';
1481     for my $rp (sort keys %$jobrepo) {
1482       my $nn = $rp;
1483       $nn =~ s/.*\///;
1484       $bininfo .= "$jobrepo->{$rp}->{'hdrmd5'}  $nn\n";
1485     }
1486     writestr("$dst/.bininfo.new", "$dst/.bininfo", $bininfo);
1487   }
1488
1489   ##################################################################
1490   # part 2: link needed binaries into :full tree
1491
1492   my $filter;
1493   # argh, this slows us down a bit
1494   my $bconf;
1495   $bconf = getconfig($myarch, $prpsearchpath) if $prpsearchpath;
1496   $filter = $bconf->{'exportfilter'} if $bconf;
1497   undef $filter if $filter && !%$filter;
1498   $filter ||= $default_exportfilters{$myarch};
1499   $filter = [ map {[$_, $filter->{$_}]} reverse sort keys %$filter ] if $filter;
1500   $filter = compile_exportfilter($filter);
1501
1502   # link new ones into full, delete old ones no longer in use
1503   my %exports;
1504
1505   my %new;
1506   for my $rp (sort keys %$jobrepo) {
1507     my $nn = $rp;
1508     $nn =~ s/.*\///;
1509     $new{$nn} = $jobrepo->{$rp};
1510   }
1511
1512   # find destination for all new binaries
1513   my @movetofull;
1514   for my $rp (sort keys %new) {
1515     my $r = $new{$rp};
1516     next unless $r->{'source'}; # no src in full tree
1517
1518     if ($filter) {
1519       my $skip;
1520       for (@$filter) {
1521         if ($rp =~ /$_->[0]/) {
1522           $skip = $_->[1];
1523           last;
1524         }
1525       }
1526       if ($skip) {
1527         my $myself;
1528         for my $exportarch (@$skip) {
1529           if ($exportarch eq '.' || $exportarch eq $myarch) {
1530             $myself = 1;
1531             next;
1532           }
1533           next if $isimport;    # no re-exports
1534           push @{$exports{$exportarch}}, $rp, $r;
1535         }
1536         next unless $myself;
1537       }
1538     }
1539     push @movetofull, $rp;
1540   }
1541   if ($filter && !$isimport) {
1542     # need also to check old entries
1543     for my $rp (sort keys %$oldrepo) {
1544       my $r = $oldrepo->{$rp};
1545       next unless $r->{'source'};       # no src rpms in full tree
1546       my $rn = $rp;
1547       $rn =~ s/.*\///;
1548       my $skip;
1549       for (@$filter) {
1550         if ($rn =~ /$_->[0]/) {
1551           $skip = $_->[1];
1552           last;
1553         }
1554       }
1555       if ($skip) {
1556         for my $exportarch (@$skip) {
1557           $exports{$exportarch} ||= [] if $exportarch ne '.' && $exportarch ne $myarch;
1558         }
1559       }
1560     }
1561   }
1562
1563   if ($filter && !$isimport) {
1564     # we always export, the other schedulers are free to reject the job
1565     # if move to full is also disabled for them
1566     for my $exportarch (sort keys %exports) {
1567       # check if this prp supports the arch
1568       next unless $projpacks->{$projid};
1569       my $repo = (grep {$_->{'name'} eq $repoid} @{$projpacks->{$projid}->{'repository'} || []})[0];
1570       if ($repo && grep {$_ eq $exportarch} @{$repo->{'arch'} || []}) {
1571         print "    sending filtered packages to $exportarch\n";
1572         createexportjob($prp, $exportarch, $jobrepo, $dst, $oldrepo, $meta, @{$exports{$exportarch}});
1573       }
1574     }
1575   }
1576
1577   if (!$useforbuildenabled) {
1578     print "    move to :full is disabled\n";
1579     return;
1580   }
1581
1582   my $pool = BSSolv::pool->new();
1583   my $satrepo;
1584   eval { $satrepo = $pool->repofromfile($prp, "$gdst/:full.solv"); };
1585   my %old;
1586   %old = $satrepo->getpathid() if $satrepo;
1587
1588   # move em over into :full
1589   mkdir_p("$gdst/:full") if @movetofull && ! -d "$gdst/:full";
1590   my %fnew;
1591   my $dep2meta;
1592   $dep2meta = $repodatas{$prp}->{'meta'} if $repodatas{$prp} && $repodatas{$prp}->{'meta'};
1593   for my $rp (@movetofull) {
1594     my $r = $new{$rp};
1595     my $suf = $rp;
1596     $suf =~ s/.*\.//;
1597     my $n = $r->{'name'};
1598     my @s = stat("$dst/$rp");
1599     next unless @s;
1600     print "      + :full/$n.$suf ($rp)\n";
1601     # link gives an error if the dest exists, so we dup
1602     # and rename instead.
1603     # when the dest is the same file, rename doesn't do
1604     # anything, so we need the unlink after the rename
1605     unlink("$dst/$rp.dup");
1606     link("$dst/$rp", "$dst/$rp.dup");
1607     rename("$dst/$rp.dup", "$gdst/:full/$n.$suf") || die("rename $dst/$rp.dup $gdst/:full/$n.$suf: $!\n");
1608     unlink("$dst/$rp.dup");
1609     $old{"$n.$suf"} = "$s[9]/$s[7]/$s[1]";
1610     if ($suf eq 'rpm') {
1611       unlink("$gdst/:full/$n.deb");
1612       delete $old{"$n.deb"};
1613     } else {
1614       unlink("$gdst/:full/$n.rpm");
1615       delete $old{"$n.rpm"};
1616     }
1617     if ($meta) {
1618       link($meta, "$meta.dup");
1619       rename("$meta.dup", "$gdst/:full/$n.meta");
1620       unlink("$meta.dup");
1621     } else {
1622       unlink("$gdst/:full/$n.meta");
1623     }
1624     delete $dep2meta->{$n} if $dep2meta;
1625
1626     $fnew{$n} = 1;
1627   }
1628
1629   for my $rp (sort keys %$oldrepo) {
1630     my $r = $oldrepo->{$rp};
1631     next unless $r->{'source'}; # no src rpms in full tree
1632     my $suf = $rp;
1633     $suf =~ s/.*\.//;
1634     my $n = $r->{'name'};
1635     next if $fnew{$n};          # got new version, already deleted old
1636
1637     my @s = stat("$gdst/:full/$n.$suf");
1638
1639     # don't delete package if not ours
1640     next unless @s && $r->{'id'} eq "$s[9]/$s[7]/$s[1]";
1641     # package no longer built, kill full entry
1642     print "      - :full/$n.$suf\n";
1643     unlink("$gdst/:full/$n.rpm");
1644     unlink("$gdst/:full/$n.deb");
1645     unlink("$gdst/:full/$n.iso");
1646     unlink("$gdst/:full/$n.meta");
1647     unlink("$gdst/:full/$n-MD5SUMS.meta");
1648     delete $old{"$n.rpm"};
1649     delete $old{"$n.deb"};
1650     delete $dep2meta->{$n} if $dep2meta;
1651   }
1652   
1653   mkdir_p($gdst) unless -d $gdst;
1654   if ($satrepo) {
1655     $satrepo->updatefrombins("$gdst/:full", %old);
1656   } else {
1657     $satrepo = $pool->repofrombins($prp, "$gdst/:full", %old);
1658   }
1659   $satrepo->tofile("$gdst/:full.solv.new");
1660   rename("$gdst/:full.solv.new", "$gdst/:full.solv") || die("rename $gdst/:full.solv.new $gdst/:full.solv: $!\n");
1661   delete $repodatas{$prp}->{'solv'};
1662 }
1663
1664 sub addjobhist {
1665   my ($prp, $info, $status, $js, $code) = @_;
1666   my $jobhist = {};
1667   $jobhist->{'code'} = $code;
1668   $jobhist->{$_} = $js->{$_} for qw{readytime starttime endtime uri workerid hostarch};
1669   $jobhist->{$_} = $info->{$_} for qw{package rev srcmd5 versrel bcnt reason};
1670   $jobhist->{'readytime'} ||= $status->{'readytime'};   # backward compat
1671   mkdir_p("$reporoot/$prp/$myarch");
1672   BSFileDB::fdb_add("$reporoot/$prp/$myarch/:jobhistory", $BSXML::jobhistlay, $jobhist);
1673 }
1674
1675
1676 ####################################################################
1677 ####################################################################
1678 ##
1679 ##  project/package data collection functions
1680 ##
1681
1682 my @prps;               # all prps(project-repositories-sorted) we have to schedule, sorted
1683 my %prpsearchpath;      # maps prp => [ prp, prp, ...]
1684                         # build packages with the packages of the prps
1685 my %prpdeps;            # searchpath plus aggregate deps plus kiwi deps
1686                         # maps prp => [ prp, prp ... ]
1687                         # used for sorting
1688 my %prpnoleaf;          # is this prp referenced by another prp?
1689 my @projpacks_linked;   # data of all linked sources
1690
1691 my %watchremote;        # remote_url => { eventdescr => projid }
1692 my %watchremote_start;  # remote_url => lasteventno
1693
1694 my %repounchanged;
1695 my %prpnotready;
1696
1697 my %watchremoteprojs;   # tmp, only set in addwatchremote
1698
1699 my @retryevents;
1700
1701
1702 #
1703 # get_projpacks:  get/update project/package information
1704 #
1705 # input:  $projid: update just this project
1706 #         $packid: update just this package
1707 # output: $projpacks (global)
1708 #
1709
1710 sub get_projpacks {
1711   my ($projid, @packids) = @_;
1712
1713   undef $projid unless $projpacks;
1714   @packids = () unless defined $projid;
1715   @packids = grep {defined $_} @packids;
1716
1717   if (!@packids) {
1718     if (defined($projid)) {
1719       delete $remoteprojs{$projid};
1720     } else {
1721       %remoteprojs = ();
1722     }
1723   }
1724
1725   $projid ||= $testprojid;
1726
1727   my @args;
1728   if (@packids) {
1729     print "getting data for project '$projid' package '".join("', '", @packids)."' from $BSConfig::srcserver\n";
1730     push @args, "project=$projid";
1731     for my $packid (@packids) {
1732       delete $projpacks->{$projid}->{'package'}->{$packid} if $projpacks->{$projid} && $projpacks->{$projid}->{'package'};
1733       push @args, "package=$packid";
1734     }
1735   } elsif (defined($projid)) {
1736     print "getting data for project '$projid' from $BSConfig::srcserver\n";
1737     push @args, "project=$projid";
1738     delete $projpacks->{$projid};
1739   } else {
1740     print "getting data for all projects from $BSConfig::srcserver\n";
1741     $projpacks = {};
1742   }
1743   my $projpacksin;
1744   while (1) {
1745     push @args, 'nopackages' if $testprojid && $projid ne $testprojid;
1746     for my $tries (4, 3, 2, 1, 0) {
1747       eval {
1748         $projpacksin = BSRPC::rpc("$BSConfig::srcserver/getprojpack", $BSXML::projpack, 'withsrcmd5', 'withdeps', 'withrepos', 'withconfig', "arch=$myarch", @args);
1749       };
1750       last unless $@ || !$projpacksin;
1751       last unless $tries && defined($projid);
1752       print $@ if $@;
1753       print "retrying...\n";
1754       sleep(60);
1755     }
1756     if ($@ || !$projpacksin) {
1757       print $@ if $@;
1758       if (@args) {
1759         print "retrying...\n";
1760         get_projpacks();
1761         get_projpacks_postprocess();    # just in case...
1762         return;
1763       }
1764       die("could not get project/package information, aborting due to testmode\n") if $testmode;
1765       printf("could not get project/package information, sleeping 1 minute\n");
1766       sleep(60);
1767       print "retrying...\n";
1768       next;
1769     }
1770     last;
1771   }
1772
1773   # Be sure that this is the right source server for my binary packages
1774   die("ERROR: source server did not report a repoid") unless $projpacksin->{'repoid'};
1775   if (! -e "$reporoot/_repoid") {
1776     mkdir_p("$reporoot") unless -d "$reporoot";
1777     writestr("$reporoot/._repoid", "$reporoot/_repoid", $projpacksin->{'repoid'});
1778   }
1779   my $buildrepoid = readstr("$reporoot/_repoid");
1780   die("ERROR: My repository id($buildrepoid) has wrong length(".length($buildrepoid).")") unless length($buildrepoid) == 9;
1781   die("ERROR: source server repository id($projpacksin->{'repoid'}) does not match my repository id($buildrepoid)") unless $buildrepoid eq $projpacksin->{'repoid'};
1782
1783   for my $proj (@{$projpacksin->{'project'} || []}) {
1784     if (@packids) {
1785       die("bad projpack answer\n") unless $proj->{'name'} eq $projid;
1786       if ($projpacks->{$projid}) {
1787         # use all packages/configs from old projpacks
1788         my $opackage = $projpacks->{$projid}->{'package'} || {};
1789         for (keys %$opackage) {
1790           $opackage->{$_}->{'name'} = $_;
1791           push @{$proj->{'package'}}, $opackage->{$_};
1792         }
1793         if (!$proj->{'patternmd5'} && $projpacks->{$projid}->{'patternmd5'}) {
1794           $proj->{'patternmd5'} = $projpacks->{$projid}->{'patternmd5'} unless grep {$_ eq '_pattern'} @packids;
1795         }
1796       }
1797     }
1798     $projpacks->{$proj->{'name'}} = $proj;
1799     delete $proj->{'name'};
1800     my $packages = {};
1801     for my $pack (@{$proj->{'package'} || []}) {
1802       $packages->{$pack->{'name'}} = $pack;
1803       delete $pack->{'name'};
1804     }
1805     if (%$packages) {
1806       $proj->{'package'} = $packages;
1807     } else {
1808       delete $proj->{'package'};
1809     }
1810   }
1811   if ($testprojid) {
1812     my $proj = $projpacks->{$projid};
1813     for my $repo (@{$proj->{'repository'} || []}) {
1814       for my $path (@{$repo->{'path'} || []}) {
1815         next if $path->{'project'} eq $testprojid;
1816         next if $projid ne $testprojid && $projpacks->{$path->{'project'}};
1817         get_projpacks($path->{'project'});
1818       }
1819     }
1820   }
1821 }
1822
1823 # -> BSUtil
1824 sub identical {
1825   my ($d1, $d2, $except) = @_;
1826
1827   if (!defined($d1)) {
1828     return defined($d2) ? 0 : 1;
1829   }
1830   return 0 unless defined($d2);
1831   my $r = ref($d1);
1832   return 0 if $r ne ref($d2);
1833   if ($r eq '') {
1834     return 0 if $d1 ne $d2; 
1835   } elsif ($r eq 'HASH') {
1836     my %k = (%$d1, %$d2);
1837     for my $k (keys %k) {
1838       next if $except && $except->{$k};
1839       return 0 unless identical($d1->{$k}, $d2->{$k}, $except);
1840     }    
1841   } elsif ($r eq 'ARRAY') {
1842     return 0 unless @$d1 == @$d2;
1843     for (my $i = 0; $i < @$d1; $i++) {
1844       return 0 unless identical($d1->[$i], $d2->[$i], $except);
1845     }    
1846   } else {
1847     return 0;
1848   }
1849   return 1;
1850 }
1851
1852 # just update the meta information, do not touch package data unless
1853 # the project was deleted
1854 sub update_project_meta {
1855   my ($projid) = @_;
1856   print "updating meta for project '$projid' from $BSConfig::srcserver\n";
1857
1858   my $projpacksin;
1859   eval {
1860     # withsrcmd5 is needed for the patterns md5sum
1861     $projpacksin = BSRPC::rpc("$BSConfig::srcserver/getprojpack", $BSXML::projpack, "project=$projid", 'nopackages', 'withrepos', 'withconfig', 'withsrcmd5', "arch=$myarch");
1862   };
1863   if ($@ || !$projpacksin) {
1864     print $@ if $@;
1865     return undef;
1866   }
1867   my $proj = $projpacksin->{'project'}->[0];
1868   if (!$proj) {
1869     # project is gone!
1870     delete $projpacks->{$projid};
1871     return 1;
1872   }
1873   return undef unless $proj->{'name'} eq $projid;
1874   delete $proj->{'name'};
1875   delete $proj->{'package'};
1876   my $oldproj = $projpacks->{$projid};
1877   $proj->{'package'} = $oldproj->{'package'} if $oldproj->{'package'};
1878   # check if the project meta has critical change
1879   return 0 unless identical($proj->{'build'}, $oldproj->{'build'});
1880   # XXX: could be more clever here
1881   return 0 unless identical($proj->{'repository'}, $oldproj->{'repository'});
1882
1883   # check macro definitions
1884   my $cold = Build::read_config($myarch, split("\n", $oldproj->{'config'} || ''));
1885   my $cnew = Build::read_config($myarch, split("\n", $proj->{'config'} || ''));
1886   return 0 unless identical($cold->{'macros'}, $cnew->{'macros'});
1887
1888   # XXX: should really also compare build type
1889   $projpacks->{$projid} = $proj;
1890   return 1;
1891 }
1892
1893
1894 #
1895 # post-process projpack information
1896 #  calculate package link information
1897 #  calculate ordered prp list
1898 #  calculate remote info
1899
1900 sub get_projpacks_postprocess {
1901   %watchremote = ();
1902   %watchremoteprojs = ();
1903
1904   #print Dumper($projpacks);
1905   calc_projpacks_linked();      # modifies watchremote/watchremoteprojs
1906   calc_prps();                  # modifies watchremote/watchremoteprojs
1907
1908   updateremoteprojs();
1909   %watchremoteprojs = ();
1910 }
1911
1912 #
1913 # addwatchremote:  register for a possibly remote resource
1914 #
1915 # input:  $type: type of resource (project/package/repository)
1916 #         $projid: local name of the project
1917 #         $watch: extra data to match
1918 #
1919 sub addwatchremote {
1920   my ($type, $projid, $watch) = @_;
1921
1922   return undef if $projpacks->{$projid} && !$projpacks->{$projid}->{'remoteurl'};
1923   my $proj = remoteprojid($projid);
1924   $watchremoteprojs{$projid} = $proj;
1925   return undef unless $proj;
1926   $watchremote{$proj->{'remoteurl'}}->{"$type/$proj->{'remoteproject'}$watch"} = $projid;
1927   return $proj;
1928 }
1929
1930 sub addretryevent {
1931   my ($ev) = @_;
1932   for my $oev (@retryevents) {
1933     next if $ev->{'type'} ne $oev->{'type'} || $ev->{'project'} ne $oev->{'project'};
1934     if ($ev->{'type'} eq 'repository') {
1935       next if $ev->{'repository'} ne $oev->{'repository'};
1936     } elsif ($ev->{'type'} eq 'package') {
1937       next if $ev->{'package'} ne $oev->{'package'};
1938     }
1939     return;
1940   }
1941   $ev->{'retry'} = time() + 60;
1942   push @retryevents, $ev;
1943 }
1944
1945 #
1946 # calc_projpacks_linked  - generate projpacks_linked helper array
1947 #
1948 # input:  $projpacks (global)
1949 # output: @projpacks_linked (global)
1950 #
1951 sub calc_projpacks_linked {
1952   @projpacks_linked = ();
1953   for my $projid (sort keys %$projpacks) {
1954     my ($mypackid, $pack);
1955     while (($mypackid, $pack) = each %{$projpacks->{$projid}->{'package'} || {}}) {
1956       next unless $pack->{'linked'};
1957       my @li = @{$pack->{'linked'}};
1958       for my $li (@li) {
1959         $li = { %$li };         # clone so that we don't change projpack
1960         addwatchremote('package', $li->{'project'}, "/$li->{'package'}");
1961         $li->{'myproject'} = $projid;
1962         $li->{'mypackage'} = $mypackid;
1963       }
1964       push @projpacks_linked, @li;
1965     }
1966     if ($projpacks->{$projid}->{'link'}) {
1967       my @li = expandprojlink($projid);
1968       for my $li (@li) {
1969         addwatchremote('package', $li->{'project'}, '');        # watch all packages
1970         $li->{'package'} = ':*';
1971         $li->{'myproject'} = $projid;
1972       }
1973       push @projpacks_linked, @li;
1974     }
1975   }
1976   #print Dumper(\@projpacks_linked);
1977 }
1978
1979 #
1980 # expandsearchpath  - recursively expand the last component
1981 #                     of a repository's path
1982 #
1983 # input:  $projid     - the project the repository belongs to
1984 #         $repository - the repository data
1985 # output: expanded path array
1986 #
1987 sub expandsearchpath {
1988   my ($projid, $repository) = @_;
1989   my %done;
1990   my @ret;
1991   my @path = @{$repository->{'path'} || []};
1992   # our own repository is not included in the path,
1993   # so put it infront of everything
1994   unshift @path, {'project' => $projid, 'repository' => $repository->{'name'}};
1995   while (@path) {
1996     my $t = shift @path;
1997     my $prp = "$t->{'project'}/$t->{'repository'}";
1998     push @ret, $t unless $done{$prp};
1999     $done{$prp} = 1;
2000     addwatchremote('repository', $t->{'project'}, "/$t->{'repository'}/$myarch") unless $t->{'repository'} eq '_unavailable';
2001     if (!@path) {
2002       last if $done{"/$prp"};
2003       my ($pid, $rid) = ($t->{'project'}, $t->{'repository'});
2004       my $proj = addwatchremote('project', $pid, '');
2005       if ($proj) {
2006         $proj = fetchremoteproj($proj, $pid);
2007       } else {
2008         $proj = $projpacks->{$pid};
2009       }
2010       next unless $proj;
2011       $done{"/$prp"} = 1;       # mark expanded
2012       my @repo = grep {$_->{'name'} eq $rid} @{$proj->{'repository'} || []};
2013       push @path, @{$repo[0]->{'path'}} if @repo && $repo[0]->{'path'};
2014     }
2015   }
2016   return @ret;
2017 }
2018
2019 sub expandprojlink {
2020   my ($projid) = @_;
2021
2022   my @ret;
2023   my $proj = $projpacks->{$projid};
2024   my @todo = map {$_->{'project'}} @{$proj->{'link'} || []};
2025   my %seen = ($projid => 1);
2026   while (@todo) {
2027     my $lprojid = shift @todo;
2028     next if $seen{$lprojid};
2029     push @ret, {'project' => $lprojid};
2030     $seen{$lprojid} = 1;
2031     my $lproj = addwatchremote('project', $lprojid, '');
2032     if ($lproj) {
2033       $lproj = fetchremoteproj($lproj, $lprojid);
2034     } else {
2035       $lproj = $projpacks->{$lprojid};
2036     }
2037     unshift @todo, map {$_->{'project'}} @{$lproj->{'link'} || []};
2038   }
2039   return @ret;
2040 }
2041
2042 #
2043 # calc_prps
2044 #
2045 # find all prps we have to schedule, expand search path for every prp,
2046 # set up inter-prp dependency graph, sort prps using this graph.
2047 #
2048 # input:  $projpacks     (global)
2049 # output: @prps          (global)
2050 #         %prpsearchpath (global)
2051 #         %prpdeps       (global)
2052 #         %prpnoleaf     (global)
2053 #
2054
2055 sub calc_prps {
2056   print "calculating project dependencies...\n";
2057   # calculate prpdeps dependency hash
2058   @prps = ();
2059   %prpsearchpath = ();
2060   %prpdeps = ();
2061   %prpnoleaf = ();
2062   for my $projid (sort keys %$projpacks) {
2063     my $repos = $projpacks->{$projid}->{'repository'} || [];
2064     my @aggs = grep {$_->{'aggregatelist'}} values(%{$projpacks->{$projid}->{'package'} || {}});
2065     my @kiwiinfos = grep {$_->{'path'}} map {@{$_->{'info'} || []}} values(%{$projpacks->{$projid}->{'package'} || {}});
2066     for my $repo (@$repos) {
2067       next unless grep {$_ eq $myarch} @{$repo->{'arch'} || []};
2068       my $repoid = $repo->{'name'};
2069       my $prp = "$projid/$repoid";
2070       push @prps, $prp;
2071       my @searchpath = expandsearchpath($projid, $repo);
2072       # map searchpath to internal prp representation
2073       my @sp = map {"$_->{'project'}/$_->{'repository'}"} @searchpath;
2074       $prpsearchpath{$prp} = \@sp;
2075       $prpdeps{"$projid/$repo->{'name'}"} = \@sp;
2076
2077       # Find extra dependencies due to aggregate/kiwi description files
2078       my @xsp;
2079       if (@aggs) {
2080         # push source repositories used in this aggregate onto xsp, obey target mapping
2081         for my $agg (map {@{$_->{'aggregatelist'}->{'aggregate'} || []}} @aggs) {
2082           my $aprojid = $agg->{'project'};
2083           my @arepoids = grep {!exists($_->{'target'}) || $_->{'target'} eq $repoid} @{$agg->{'repository'} || []}; 
2084           if (@arepoids) {
2085             # got some mappings for our target, use source as repoid
2086             push @xsp, map {"$aprojid/$_->{'source'}"} grep {exists($_->{'source'})} @arepoids;
2087           } else {
2088             # no repository mapping, just use own repoid
2089             push @xsp, "$aprojid/$repoid";
2090           }
2091         }
2092       }
2093       if (@kiwiinfos) {
2094         # push repositories used in all kiwi files
2095         push @xsp, map {"$_->{'project'}/$_->{'repository'}"} map {@{$_->{'path'}}} grep {$_->{'repository'} eq $repoid} @kiwiinfos;
2096       }
2097
2098       if (@xsp) {
2099         # found some repos, join extra deps with project deps
2100         for my $xsp (@xsp) {
2101           next if $xsp eq $prp;
2102           my ($mprojid, $mrepoid) = split('/', $xsp, 2);
2103           # we just watch the repository as it costs too much to
2104           # watch every single package
2105           addwatchremote('repository', $mprojid, "/$mrepoid/$myarch");
2106         }
2107         my %xsp = map {$_ => 1} (@sp, @xsp);
2108         delete $xsp{$prp};
2109         $prpdeps{$prp} = [ sort keys %xsp ];
2110       }
2111       # set noleaf info
2112       for (@{$prpdeps{$prp}}) {
2113         $prpnoleaf{$_} = 1 if $_ ne $prp;
2114       }
2115     }
2116   }
2117
2118   # do the real sorting
2119   print "sorting projects and repositories...\n";
2120   @prps = sortpacks(\%prpdeps, undef, undef, @prps);
2121 }
2122
2123 ####################################################################
2124
2125 sub updateremoteprojs {
2126   for my $projid (keys %remoteprojs) {
2127     my $r = $watchremoteprojs{$projid};
2128     if (!$r) {
2129       delete $remoteprojs{$projid};
2130       next;
2131     }
2132     my $or = $remoteprojs{$projid};
2133     next if $or && $or->{'remoteurl'} eq $r->{'remoteurl'} && $or->{'remoteproject'} eq $r->{'remoteproject'};
2134     delete $remoteprojs{$projid};
2135   }
2136   for my $projid (sort keys %watchremoteprojs) {
2137     fetchremoteproj($watchremoteprojs{$projid}, $projid);
2138   }
2139 }
2140
2141 sub remoteprojid {
2142   my ($projid) = @_;
2143   my $rsuf = '';
2144   my $origprojid = $projid;
2145
2146   my $proj = $projpacks->{$projid};
2147   if ($proj) {
2148     return undef unless $proj->{'remoteurl'};
2149     return undef unless $proj->{'remoteproject'};
2150     return {
2151       'name' => $projid,
2152       'root' => $projid,
2153       'remoteroot' => $proj->{'remoteproject'},
2154       'remoteurl' => $proj->{'remoteurl'},
2155       'remoteproject' => $proj->{'remoteproject'},
2156     };
2157   }
2158   while ($projid =~ /^(.*)(:.*?)$/) {
2159     $projid = $1;
2160     $rsuf = "$2$rsuf";
2161     $proj = $projpacks->{$projid};
2162     if ($proj) {
2163       return undef unless $proj->{'remoteurl'};
2164       if ($proj->{'remoteproject'}) {
2165         $rsuf = "$proj->{'remoteproject'}$rsuf";
2166       } else {
2167         $rsuf =~ s/^://;
2168       }
2169       return {
2170         'name' => $origprojid,
2171         'root' => $projid,
2172         'remoteroot' => $proj->{'remoteproject'},
2173         'remoteurl' => $proj->{'remoteurl'},
2174         'remoteproject' => $rsuf,
2175       };
2176     }
2177   }
2178   return undef;
2179 }
2180
2181 sub maptoremote {
2182   my ($proj, $projid) = @_;
2183   return "$proj->{'root'}:$projid" unless $proj->{'remoteroot'};
2184   return $proj->{'root'} if $projid eq $proj->{'remoteroot'};
2185   return '_unavailable' if $projid !~ /^\Q$proj->{'remoteroot'}\E:(.*)$/;
2186   return "$proj->{'root'}:$1";
2187 }
2188
2189 sub fetchremoteproj {
2190   my ($proj, $projid) = @_;
2191   return undef unless $proj && $proj->{'remoteurl'} && $proj->{'remoteproject'};
2192   $projid ||= $proj->{'name'};
2193   return $remoteprojs{$projid} if exists $remoteprojs{$projid};
2194   print "fetching remote project data for $projid\n";
2195   my $rproj;
2196   my $param = {
2197     'uri' => "$proj->{'remoteurl'}/source/$proj->{'remoteproject'}/_meta",
2198     'timeout' => 30,
2199     'proxy' => $proxy,
2200   };
2201   eval {
2202     $rproj = BSRPC::rpc($param, $BSXML::proj);
2203   };
2204   if ($@) {
2205     warn($@);
2206     my $error = $@;
2207     $error =~ s/\n$//s;
2208     $rproj = {'error' => $error};
2209     addretryevent({'type' => 'project', 'project' => $projid}) if $error !~ /remote error:/;
2210   }
2211   return undef unless $rproj;
2212   for (qw{name root remoteroot remoteurl remoteproject}) {
2213     $rproj->{$_} = $proj->{$_};
2214   }
2215   # map remote project names to local names
2216   for my $repo (@{$rproj->{'repository'} || []}) {
2217     for my $pathel (@{$repo->{'path'} || []}) {
2218       $pathel->{'project'} = maptoremote($proj, $pathel->{'project'});
2219     }    
2220   }
2221   for my $link (@{$rproj->{'link'} || []}) {
2222     $link->{'project'} = maptoremote($proj, $link->{'project'});
2223   }
2224   $remoteprojs{$projid} = $rproj;
2225   return $rproj;
2226 }
2227
2228 sub fetchremoteconfig {
2229   my ($projid) = @_;
2230
2231   my $proj = $remoteprojs{$projid};
2232   return undef if !$proj || $proj->{'error'};
2233   return $proj->{'config'} if exists $proj->{'config'};
2234   print "fetching remote project config for $projid\n";
2235   my $c;
2236   my $param = {
2237     'uri' => "$proj->{'remoteurl'}/source/$proj->{'remoteproject'}/_config",
2238     'timeout' => 30,
2239     'proxy' => $proxy,
2240   };
2241   eval {
2242     $c = BSRPC::rpc($param);
2243   };
2244   if ($@) {
2245     warn($@);
2246     $proj->{'error'} = $@;
2247     $proj->{'error'} =~ s/\n$//s;
2248     addretryevent({'type' => 'project', 'project' => $projid}) if $proj->{'error'} !~ /remote error:/;
2249     return undef;
2250   }
2251   $proj->{'config'} = $c;
2252   return $c;
2253 }
2254
2255 sub addrepo_remote {
2256   my ($pool, $prp, $remoteproj) = @_;
2257
2258   my ($projid, $repoid) = split('/', $prp, 2);
2259   return undef if !$remoteproj || $remoteproj->{'error'};
2260   print "    fetching remote repository state for $prp\n";
2261   my $param = {
2262     'uri' => "$remoteproj->{'remoteurl'}/build/$remoteproj->{'remoteproject'}/$repoid/$myarch/_repository",
2263     'timeout' => 200,
2264     'receiver' => \&BSHTTP::cpio_receiver,
2265     'proxy' => $proxy,
2266   };
2267   my $cpio;
2268   eval {
2269     die('unsupported view\n') unless $BSConfig::usesolvstate;
2270     $cpio = BSRPC::rpc($param, undef, 'view=solvstate');
2271   };
2272   if ($@ && $@ =~ /unsupported view/) {
2273     eval {
2274       $cpio = BSRPC::rpc($param, undef, 'view=cache');
2275     };
2276   }
2277   if ($@) {
2278     warn($@);
2279     my $error = $@;
2280     $error =~ s/\n$//s;
2281     addretryevent({'type' => 'repository', 'project' => $projid, 'repository' => $repoid, 'arch' => $myarch}) if $error !~ /remote error:/;
2282     return undef;
2283   }
2284   my %cpio = map {$_->{'name'} => $_->{'data'}} @{$cpio || []};
2285   my $repostate = $cpio{'repositorystate'};
2286   $repostate = XMLin($BSXML::repositorystate, $repostate) if $repostate;
2287   delete $prpnotready{$prp};
2288   if ($repostate && $repostate->{'blocked'}) {
2289     $prpnotready{$prp} = { map {$_ => 1} @{$repostate->{'blocked'}} };
2290   }
2291   if (exists $cpio{'repositorysolv'} && $BSConfig::usesolvstate) {
2292     my $r;
2293     eval {$r = $pool->repofromstr($prp, $cpio{'repositorysolv'}); };
2294     warn($@) if $@;
2295     if ($r) {
2296       $repodatas{$prp}->{'solv'} = $cpio{'repositorysolv'};
2297       $repodatas{$prp}->{'lastscan'} = time();
2298     }
2299     return $r;
2300   } elsif (exists $cpio{'repositorycache'}) {
2301     my $cache;
2302     eval { $cache = Storable::thaw(substr($cpio{'repositorycache'}, 4)); };
2303     delete $cpio{'repositorycache'};    # free mem
2304     warn($@) if $@;
2305     return undef unless $cache;
2306     # free some unused entries to save mem
2307     for (values %$cache) {
2308       delete $_->{'path'};
2309       delete $_->{'id'};
2310     }
2311     my $r = $pool->repofromdata($prp, $cache);
2312     $repodatas{$prp}->{'solv'} = $r->tostr();
2313     $repodatas{$prp}->{'lastscan'} = time();
2314     return $r;
2315   } else {
2316     # return empty repo
2317     my $r = $pool->repofrombins($prp, '');
2318     $repodatas{$prp}->{'solv'} = $r->tostr();
2319     $repodatas{$prp}->{'lastscan'} = time();
2320     return $r;
2321   }
2322 }
2323
2324 #
2325 # jobfinished - called when a build job is finished
2326 #
2327 # - move built packages into :full tree
2328 # - set changed flag
2329 #
2330 # input: $job       - job identification
2331 #        $js        - job status information (BSXML::jobstatus)
2332 #        $changed   - reference to changed hash, mark prp if
2333 #                     we changed the repository
2334 #        $pdata     - package data
2335 #
2336 sub jobfinished {
2337   my ($job, $js, $changed) = @_;
2338
2339   my $info = readxml("$myjobsdir/$job", $BSXML::buildinfo, 1);
2340   my $jobdatadir = "$myjobsdir/$job:dir";
2341   if (!$info || ! -d $jobdatadir) {
2342     print "  - $job is bad\n";
2343     return;
2344   }
2345   if ($info->{'file'} eq '_aggregate') {
2346     aggregatefinished($job, $js, $changed);
2347     return ;
2348   }
2349   if ($info->{'file'} eq '_delta') {
2350     deltafinished($job, $js, $changed);
2351     return ;
2352   }
2353   my $projid = $info->{'project'};
2354   my $repoid = $info->{'repository'};
2355   my $packid = $info->{'package'};
2356   my $prp = "$projid/$repoid";
2357   my $now = time(); # ensure that we use the same time in all logs
2358   if ($info->{'arch'} ne $myarch) {
2359     print "  - $job has bad arch\n";
2360     return;
2361   }
2362   if (!$projpacks->{$projid}) {
2363     print "  - $job belongs to an unknown project\n";
2364     return;
2365   }
2366   my $pdata = ($projpacks->{$projid}->{'package'} || {})->{$packid};
2367   if (!$pdata) {
2368     print "  - $job belongs to an unknown package, discard\n";
2369     return;
2370   }
2371   my $statusdir = "$reporoot/$prp/$myarch/$packid";
2372   my $status = readxml("$statusdir/status", $BSXML::buildstatus, 1);
2373   if ($status && (!$status->{'job'} || $status->{'job'} ne $job)) {
2374     print "  - $job is outdated\n";
2375     return;
2376   }
2377   $status ||= {'readytime' => $info->{'readytime'} || $info->{'starttime'}};
2378   # calculate exponential weighted average
2379   my $myjobtime = time() - $status->{'readytime'};
2380   my $weight = 0.1; 
2381   $buildavg = ($weight * $myjobtime) + ((1 - $weight) * $buildavg);
2382   
2383   delete $status->{'job'};      # no longer building
2384
2385   delete $status->{'arch'};     # obsolete
2386   delete $status->{'uri'};      # obsolete
2387
2388   my $code = $js->{'result'};
2389   $code = 'failed' unless $code eq 'succeeded' || $code eq 'unchanged';
2390
2391   my @all = ls($jobdatadir);
2392   my %all = map {$_ => 1} @all;
2393   @all = map {"$jobdatadir/$_"} @all;
2394
2395   my $gdst = "$reporoot/$prp/$myarch";
2396   my $dst = "$gdst/$packid";
2397   mkdir_p($dst);
2398   mkdir_p("$gdst/:meta");
2399   mkdir_p("$gdst/:logfiles.fail");
2400   mkdir_p("$gdst/:logfiles.success");
2401   unlink("$reporoot/$prp/$myarch/:repodone");
2402   if (!$all{'meta'}) {
2403     if ($code eq 'succeeded') {
2404       print "  - $job claims success but there is no meta\n";
2405       return;
2406     }
2407     # severe failure, create src change fake...
2408     writestr("$jobdatadir/meta", undef, "$info->{'srcmd5'}  $packid\nfake to detect source changes...  fake\n");
2409     push @all, "$jobdatadir/meta";
2410     $all{'meta'} = 1;
2411   }
2412
2413   # update packstatus so that it doesn't fall back to scheduled
2414   my $ps = BSUtil::retrieve("$reporoot/$prp/$myarch/:packstatus", 1);
2415   if ($ps) {
2416     if (exists($ps->{'packstatus'}->{$packid})) {
2417       $ps->{'packstatus'}->{$packid} = 'finished';
2418       $ps->{'packerror'}->{$packid} = $code;
2419       BSUtil::store("$reporoot/$prp/$myarch/.:packstatus", "$reporoot/$prp/$myarch/:packstatus", $ps);
2420     }
2421   } else {
2422     # compatibility: read and convert old xml data
2423     $ps = readxml("$reporoot/$prp/$myarch/:packstatus", $BSXML::packstatuslist, 1);
2424     if ($ps) {
2425       my %packstatus;
2426       my %packerror;
2427       for (@{$ps->{'packstatus'} || []}) {
2428         $packstatus{$_->{'name'}} = $_->{'status'};
2429         $packerror{$_->{'name'}} = $_->{'error'} if $_->{'error'};
2430       }
2431       if (exists($packstatus{$packid})) {
2432         $packstatus{$packid} = 'finished';
2433         $packerror{$packid} = $code;
2434       }
2435       $ps = {'packstatus' => \%packstatus, 'packerror' => \%packerror};
2436       BSUtil::store("$reporoot/$prp/$myarch/.:packstatus", "$reporoot/$prp/$myarch/:packstatus", $ps);
2437     }
2438   }
2439
2440   my $meta = $all{'meta'} ? "$jobdatadir/meta" : undef;
2441   if ($code eq 'unchanged') {
2442     print "  - $job: build result is unchanged\n";
2443     if ( -e "$gdst/:logfiles.success/$packid" ){
2444       # make sure to use the last succeeded logfile matching to these binaries
2445       link("$gdst/:logfiles.success/$packid", "$dst/logfile.dup");
2446       rename("$dst/logfile.dup", "$dst/logfile");
2447       unlink("$dst/logfile.dup");
2448     }
2449     if (open(F, '+>>', "$dst/logfile")) {
2450       # Add a comment to logfile from last real build
2451       print F "\nRetried build at ".localtime(time())." returned same result, skipped";
2452       close(F);
2453     }
2454     unlink("$gdst/:logfiles.fail/$packid");
2455     rename($meta, "$gdst/:meta/$packid") if $meta;
2456     unlink($_) for @all;
2457     rmdir($jobdatadir);
2458     addjobhist($prp, $info, $status, $js, 'unchanged');
2459     $status->{'status'} = 'succeeded';
2460     writexml("$statusdir/.status", "$statusdir/status", $status, $BSXML::buildstatus);
2461     $changed->{$prp} ||= 1;     # package is no longer blocking
2462     return;
2463   }
2464   if ($code eq 'failed') {
2465     print "  - $job: build failed\n";
2466     link("$jobdatadir/logfile", "$jobdatadir/logfile.dup");
2467     rename("$jobdatadir/logfile", "$dst/logfile");
2468     rename("$jobdatadir/logfile.dup", "$gdst/:logfiles.fail/$packid");
2469     rename($meta, "$gdst/:meta/$packid") if $meta;
2470     unlink($_) for @all;
2471     rmdir($jobdatadir);
2472     $status->{'status'} = 'failed';
2473     addjobhist($prp, $info, $status, $js, 'failed');
2474     writexml("$statusdir/.status", "$statusdir/status", $status, $BSXML::buildstatus);
2475     $changed->{$prp} ||= 1;     # package is no longer blocking
2476     return;
2477   }
2478   print "  - $prp: $packid built: ".(@all). " files\n";
2479   mkdir_p("$gdst/:logfiles.success");
2480   mkdir_p("$gdst/:logfiles.fail");
2481
2482   my $useforbuildenabled = 1;
2483   $useforbuildenabled = enabled($repoid, $projpacks->{$projid}->{'useforbuild'}, $useforbuildenabled);
2484   $useforbuildenabled = enabled($repoid, $pdata->{'useforbuild'}, $useforbuildenabled);
2485   update_dst_full($prp, $packid, $dst, $jobdatadir, $meta, $useforbuildenabled, $prpsearchpath{$prp});
2486   $changed->{$prp} = 2 if $useforbuildenabled;
2487   delete $repounchanged{$prp} if $useforbuildenabled;
2488   $changed->{$prp} ||= 1;
2489
2490   # save meta file
2491   rename($meta, "$gdst/:meta/$packid") if $meta;
2492
2493   # write new status
2494   $status->{'status'} = 'succeeded';
2495   addjobhist($prp, $info, $status, $js, 'succeeded');
2496   writexml("$statusdir/.status", "$statusdir/status", $status, $BSXML::buildstatus);
2497
2498   # write history file
2499   my $h = {'versrel' => $info->{'versrel'}, 'bcnt' => $info->{'bcnt'}, 'time' => $now, 'srcmd5' => $info->{'srcmd5'}, 'rev' => $info->{'rev'}, 'reason' => $info->{'reason'}};
2500   BSFileDB::fdb_add("$reporoot/$prp/$myarch/$packid/history", $historylay, $h);
2501
2502   # update relsync file
2503   my $relsync = BSUtil::retrieve("$reporoot/$prp/$myarch/:relsync", 1) || {};
2504   $relsync->{$packid} = "$info->{'versrel'}.$info->{'bcnt'}";
2505   BSUtil::store("$reporoot/$prp/$myarch/:relsync.new", "$reporoot/$prp/$myarch/:relsync", $relsync);
2506   
2507   # save logfile
2508   link("$jobdatadir/logfile", "$jobdatadir/logfile.dup");
2509   rename("$jobdatadir/logfile", "$dst/logfile");
2510   rename("$jobdatadir/logfile.dup", "$gdst/:logfiles.success/$packid");
2511   unlink("$gdst/:logfiles.fail/$packid");
2512   unlink($_) for @all;
2513   rmdir($jobdatadir);
2514 }
2515
2516 sub aggregatefinished {
2517   my ($job, $js, $changed) = @_;
2518
2519   my $info = readxml("$myjobsdir/$job", $BSXML::buildinfo, 1);
2520   my $jobdatadir = "$myjobsdir/$job:dir";
2521   if (!$info || ! -d $jobdatadir) {
2522     print "  - $job is bad\n";
2523     return;
2524   }
2525   my $projid = $info->{'project'};
2526   my $repoid = $info->{'repository'};
2527   my $packid = $info->{'package'};
2528   if ($info->{'arch'} ne $myarch) {
2529     print "  - $job has bad arch\n";
2530     return;
2531   }
2532   if (!$projpacks->{$projid}) {
2533     print "  - $job belongs to an unknown project\n";
2534     return;
2535   }
2536   my $pdata = ($projpacks->{$projid}->{'package'} || {})->{$packid};
2537   if (!$pdata) {
2538     print "  - $job belongs to an unknown package, discard\n";
2539     return;
2540   }
2541   my $prp = "$projid/$repoid";
2542   my $gdst = "$reporoot/$prp/$myarch";
2543   my $dst = "$gdst/$packid";
2544   mkdir_p($dst);
2545   my $useforbuildenabled = 1;
2546   $useforbuildenabled = enabled($repoid, $projpacks->{$projid}->{'useforbuild'}, $useforbuildenabled);
2547   $useforbuildenabled = enabled($repoid, $pdata->{'useforbuild'}, $useforbuildenabled);
2548   update_dst_full($prp, $packid, $dst, $jobdatadir, undef, $useforbuildenabled, $prpsearchpath{$prp});
2549   $changed->{$prp} = 2 if $useforbuildenabled;
2550   delete $repounchanged{$prp} if $useforbuildenabled;
2551   $changed->{$prp} ||= 1;
2552   unlink("$reporoot/$prp/$myarch/:repodone");
2553   unlink("$gdst/:logfiles.fail/$packid");
2554   unlink("$gdst/:logfiles.success/$packid");
2555   unlink("$dst/logfile");
2556   unlink("$dst/status");
2557   mkdir_p("$gdst/:meta");
2558   rename("$jobdatadir/meta", "$gdst/:meta/$packid") || die("rename $jobdatadir/meta $gdst/:meta/$packid: $!\n");
2559 }
2560
2561 sub deltafinished {
2562   my ($job, $js, $changed) = @_;
2563
2564   my $info = readxml("$myjobsdir/$job", $BSXML::buildinfo, 1);
2565   my $jobdatadir = "$myjobsdir/$job:dir";
2566   if (!$info || ! -d $jobdatadir) {
2567     print "  - $job is bad\n";
2568     return;
2569   }
2570   my $projid = $info->{'project'};
2571   my $repoid = $info->{'repository'};
2572   my $packid = $info->{'package'};
2573   if ($info->{'arch'} ne $myarch) {
2574     print "  - $job has bad arch\n";
2575     return;
2576   }
2577   if (!$projpacks->{$projid}) {
2578     print "  - $job belongs to an unknown project\n";
2579     return;
2580   }
2581   my $prp = "$projid/$repoid";
2582   my $gdst = "$reporoot/$prp/$myarch";
2583   my $dst = "$gdst/$packid";
2584   mkdir_p($dst);
2585   my $code = $js->{'result'} || 'failed';
2586   if ($code ne 'succeeded') {
2587     print "  - $job: build failed\n";
2588     unlink("$dst/logfile");
2589     rename("$jobdatadir/logfile", "$dst/logfile");
2590     unlink("$reporoot/$prp/$myarch/:repodone");
2591     return;
2592   }
2593   my @all = sort(ls($jobdatadir));
2594   print "  - $prp: $packid built: ".(@all). " files\n";
2595   for my $f (@all) {
2596     next unless $f =~ /^(.*)\.(drpm|out|dseq)$/s;
2597     my $deltaid = $1;
2598     if ($2 ne 'dseq') {
2599       rename("$jobdatadir/$f", "$dst/$deltaid");
2600     } else {
2601       rename("$jobdatadir/$f", "$dst/$deltaid.dseq");
2602     }
2603   }
2604   $changed->{$prp} ||= 1;
2605   unlink("$reporoot/$prp/$myarch/:repodone");
2606   unlink("$dst/logfile");
2607   rename("$jobdatadir/logfile", "$dst/logfile");
2608 }
2609
2610 sub uploadbuildevent {
2611   my ($job, $js, $changed) = @_;
2612   my $info = readxml("$myjobsdir/$job", $BSXML::buildinfo, 1);
2613   my $jobdatadir = "$myjobsdir/$job:dir";
2614   if (!$info || ! -d $jobdatadir) {
2615     print "  - $job is bad\n";
2616     return;
2617   }
2618   my $projid = $info->{'project'};
2619   my $repoid = $info->{'repository'};
2620   my $packid = $info->{'package'};
2621   if ($info->{'arch'} ne $myarch) {
2622     print "  - $job has bad arch\n";
2623     return;
2624   }
2625   if (!$projpacks->{$projid}) {
2626     print "  - $job belongs to an unknown project\n";
2627     return;
2628   }
2629   my $pdata = ($projpacks->{$projid}->{'package'} || {})->{$packid};
2630   if (!$pdata) {
2631     print "  - $job belongs to an unknown package, discard\n";
2632     return;
2633   }
2634   my $prp = "$projid/$repoid";
2635   my $gdst = "$reporoot/$prp/$myarch";
2636   my $dst = "$gdst/$packid";
2637   mkdir_p($dst);
2638   my $useforbuildenabled = 1;
2639   $useforbuildenabled = enabled($repoid, $projpacks->{$projid}->{'useforbuild'}, $useforbuildenabled);
2640   $useforbuildenabled = enabled($repoid, $pdata->{'useforbuild'}, $useforbuildenabled);
2641   update_dst_full($prp, $packid, $dst, $jobdatadir, undef, $useforbuildenabled, $prpsearchpath{$prp});
2642   $changed->{$prp} = 2 if $useforbuildenabled;
2643   delete $repounchanged{$prp} if $useforbuildenabled;
2644   $changed->{$prp} ||= 1;
2645   unlink("$reporoot/$prp/$myarch/:repodone");
2646 }
2647
2648 sub importevent {
2649   my ($job, $js, $changed) = @_;
2650
2651   my $info = readxml("$myjobsdir/$job", $BSXML::buildinfo, 1);
2652   my $jobdatadir = "$myjobsdir/$job:dir";
2653   if (!$info || ! -d $jobdatadir) {
2654     print "  - $job is bad\n";
2655     return;
2656   }
2657   my $projid = $info->{'project'};
2658   my $repoid = $info->{'repository'};
2659   my $packid = $info->{'package'};
2660   my $prp = "$projid/$repoid";
2661   my @all = ls($jobdatadir);
2662   my %all = map {$_ => 1} @all;
2663   my $meta = $all{'meta'} ? "$jobdatadir/meta" : undef;
2664   @all = map {"$jobdatadir/$_"} @all;
2665   my $pdata = (($projpacks->{$projid} || {})->{'package'} || {})->{$packid};
2666   my $useforbuildenabled = 1;
2667   $useforbuildenabled = enabled($repoid, $projpacks->{$projid}->{'useforbuild'}, $useforbuildenabled) if $projpacks->{$projid};
2668   $useforbuildenabled = enabled($repoid, $pdata->{'useforbuild'}, $useforbuildenabled);
2669   update_dst_full($prp, $packid, undef, $jobdatadir, $meta, $useforbuildenabled, $prpsearchpath{$prp});
2670   $changed->{$prp} = 2 if $useforbuildenabled;
2671   unlink($_) for @all;
2672   rmdir($jobdatadir);
2673 }
2674
2675 ##########################################################################
2676 ##########################################################################
2677 ##
2678 ##  kiwi-image package type handling
2679 ##
2680 sub checkkiwiimage {
2681   my ($projid, $repoid, $packid, $pdata, $info, $notready, $relsynctrigger) = @_;
2682
2683   my $prp = "$projid/$repoid";
2684   my @aprps = map {"$_->{'project'}/$_->{'repository'}"} @{$info->{'path'} || []};
2685   my $repo = (grep {$_->{'name'} eq $repoid} @{$projpacks->{$projid}->{'repository'} || []})[0];
2686   return ('broken', 'missing repo') unless $repo;       # can't happen
2687
2688   # get config from path
2689   my $bconf = getconfig($myarch, \@aprps);
2690   if (!$bconf) {
2691     print "      - $packid (kiwi-image)\n";
2692     print "        no config\n";
2693     return ('broken', 'no config');
2694   }
2695
2696   my $pool = BSSolv::pool->new();
2697   $pool->settype('deb') if $bconf->{'type'} eq 'dsc';
2698
2699   for my $aprp (@aprps) {
2700     if (!checkprpaccess($aprp, $prp)) {
2701       print "      - $packid (kiwi-image)\n";
2702       print "        repository $aprp is unavailable";
2703       return ('broken', "repository $aprp is unavailable");
2704     }
2705     my $r = addrepo($pool, $aprp);
2706     if (!$r) {
2707       print "      - $packid (kiwi-image)\n";
2708       print "        repository $aprp is unavailable";
2709       return ('broken', "repository $aprp is unavailable");
2710     }
2711   }
2712   $pool->createwhatprovides();
2713   my $bconfignore = $bconf->{'ignore'};
2714   my $bconfignoreh = $bconf->{'ignoreh'};
2715   delete $bconf->{'ignore'};
2716   delete $bconf->{'ignoreh'};
2717   my @deps = @{$info->{'dep'} || []};
2718   my $xp = BSSolv::expander->new($pool, $bconf);
2719   my $ownexpand = sub {
2720     $_[0] = $xp; 
2721     goto &BSSolv::expander::expand;
2722   };   
2723   no warnings 'redefine';
2724   local *Build::expand = $ownexpand;
2725   use warnings 'redefine';
2726   my ($eok, @edeps) = Build::get_deps($bconf, [], @deps);
2727   if (!$eok) {
2728     print "      - $packid (kiwi-image)\n";
2729     print "        unresolvables:\n";
2730     print "            $_\n" for @edeps;
2731     return ('unresolvable', join(', ', @edeps));
2732   }
2733   $bconf->{'ignore'} = $bconfignore if $bconfignore;
2734   $bconf->{'ignoreh'} = $bconfignoreh if $bconfignoreh;
2735
2736   my @new_meta;
2737   push @new_meta, "$pdata->{'srcmd5'}  $packid";
2738   for (@{$info->{'extrasource'} || []}) {
2739     push @new_meta, "$_->{'srcmd5'}  $_->{'project'}/$_->{'package'}";
2740   }
2741
2742   if (!$repo->{'block'} || $repo->{'block'} ne 'never') {
2743     my @blocked;
2744     for my $repo ($pool->repos()) {
2745       my $aprp = $repo->name();
2746       my $nr = ($prp eq $aprp ? $notready : $prpnotready{$aprp}) || {};
2747       my @b = grep {$nr->{$_}} @edeps;
2748       if (@b) {
2749         @b = map {"$aprp/$_"} @b if $prp ne $aprp;
2750         push @blocked, @b;
2751       }
2752       next if @blocked;
2753       my %names = $repo->pkgnames();
2754       for my $dep (sort(@edeps)) {
2755         my $p = $names{$dep};
2756         next unless $p;
2757         push @new_meta, $pool->pkg2pkgid($p)."  $aprp/$dep";
2758       }
2759     }
2760     if (@blocked) {
2761       print "      - $packid (kiwi-image)\n";
2762       print "        blocked (@blocked)\n";
2763       return ('blocked', join(', ', @blocked));
2764     }
2765   }
2766   my @meta = split("\n", (readstr("$reporoot/$prp/$myarch/:meta/$packid", 1) || ''));
2767   if (!@meta || !$meta[0]) {
2768     print "      - $packid (kiwi-image)\n";
2769     print "        start build\n";
2770     return ('scheduled', [ $bconf, \@edeps, {'explain' => 'new build'} ]);
2771   }
2772   if ($meta[0] ne $new_meta[0]) {
2773     print "      - $packid (kiwi-image)\n";
2774     print "        src change, start build\n";
2775     return ('scheduled', [ $bconf, \@edeps, {'explain' => 'source change', 'oldsource' => substr($meta[0], 0, 32)} ]);
2776   }
2777   if (join('\n', @meta) eq join('\n', @new_meta)) {
2778     if ($relsynctrigger) {
2779       print "      - $packid (kiwi-image)\n";
2780       print "        rebuild counter sync\n";
2781       return ('scheduled', [ $bconf, \@edeps, {'explain' => 'rebuild counter sync'} ]);
2782     }
2783     print "      - $packid (kiwi-image)\n";
2784     print "        nothing changed\n";
2785     return ('done');
2786   }
2787   if ($repo->{'rebuild'} && $repo->{'rebuild'} eq 'local') {
2788     print "      - $packid (kiwi-image)\n";
2789     print "        nothing changed\n";
2790     return ('done');
2791   }
2792   my @diff = diffsortedmd5(0, \@meta, \@new_meta);
2793   print "      - $packid (kiwi-image)\n";
2794   print "        $_\n" for @diff;
2795   print "        meta change, start build\n";
2796   return ('scheduled', [ $bconf, \@edeps, {'explain' => 'meta change', 'packagechange' => sortedmd5toreason(@diff)} ]);
2797 }
2798
2799 sub rebuildkiwiimage {
2800   my ($projid, $repoid, $packid, $pdata, $info, $data, $relsyncmax) = @_;
2801   my $bconf = $data->[0];
2802   my $edeps = $data->[1];
2803   my $reason = $data->[2];
2804
2805   my $repo = (grep {$_->{'name'} eq $repoid} @{$projpacks->{$projid}->{'repository'} || []})[0];
2806   return ('broken', 'missing repo') unless $repo;       # can't happen
2807
2808   my ($job, $joberror);
2809   if (!@{$repo->{'path'} || []}) {
2810     # repo has no path, use kiwi repositories also for kiwi system setup
2811     my $prp = "$projid/$repoid";
2812     my @aprps = map {"$_->{'project'}/$_->{'repository'}"} @{$info->{'path'} || []};
2813     # setup pool again for kiwi system expansion
2814     my $pool = BSSolv::pool->new();
2815     $pool->settype('deb') if $bconf->{'type'} eq 'dsc';
2816     for my $aprp (@aprps) {
2817       if (!checkprpaccess($aprp, $prp)) {
2818         print "      - $packid (kiwi-image)\n";
2819         print "        repository $aprp is unavailable";
2820         return ('broken', "repository $aprp is unavailable");
2821       }
2822       my $r = addrepo($pool, $aprp);
2823       if (!$r) {
2824         print "      - $packid (kiwi-image)\n";
2825         print "        repository $aprp is unavailable";
2826         return ('broken', "repository $aprp is unavailable");
2827       }
2828     }
2829     $pool->createwhatprovides();
2830     my $xp = BSSolv::expander->new($pool, $bconf);
2831     my $ownexpand = sub {
2832       $_[0] = $xp; 
2833       goto &BSSolv::expander::expand;
2834     };   
2835     no warnings 'redefine';
2836     local *Build::expand = $ownexpand;
2837     use warnings 'redefine';
2838     ($job, $joberror) = set_building($projid, $repoid, $packid, $pdata, $info, $bconf, [], $edeps, undef, $reason, $relsyncmax, 0);
2839   } else {
2840     # repo has a configured path, expand kiwi system with it
2841     my $prp = "$projid/$repoid";
2842     $bconf = getconfig($myarch, $prpsearchpath{$prp});
2843     return ('broken', 'no config') unless $bconf;       # should not happen
2844     ($job, $joberror) = set_building($projid, $repoid, $packid, $pdata, $info, $bconf, [], $edeps, $prpsearchpath{$prp} || [], $reason, $relsyncmax, 0);
2845   }
2846   if ($job) {
2847     return ('scheduled', $job);
2848   } else {
2849     return ('broken', $joberror);
2850   }
2851 }
2852
2853 ##########################################################################
2854 ##########################################################################
2855 ##
2856 ##  kiwi-product package type handling
2857 ##
2858 my %bininfo_cache;
2859
2860 sub checkkiwiproduct {
2861   my ($projid, $repoid, $packid, $pdata, $info, $notready, $relsynctrigger) = @_;
2862
2863   # hmm, should get the arch from the kiwi info
2864   # but how can we map it to the buildarchs?
2865   my $repo = (grep {$_->{'name'} eq $repoid} @{$projpacks->{$projid}->{'repository'} || []})[0];
2866   return ('broken', 'missing repo') unless $repo;       # can't happen
2867   my $prp = "$projid/$repoid";
2868
2869   # calculate all involved architectures
2870   my %imagearch = map {$_ => 1} @{$info->{'imagearch'} || []};
2871   return ('broken', 'no architectures for packages') unless grep {$imagearch{$_}} @{$repo->{'arch'} || []};
2872   $imagearch{'local'} = 1 if $BSConfig::localarch;
2873   my @archs = grep {$imagearch{$_}} @{$repo->{'arch'} || []};
2874   
2875   if (!grep {$_ eq $myarch} @archs) {
2876     print "      - $packid (kiwi-product)\n";
2877     print "        not mine\n";
2878     return ('excluded');
2879   }
2880
2881   my @deps = @{$info->{'dep'} || []};   # expanded?
2882   my %deps = map {$_ => 1} @deps;
2883   delete $deps{''};
2884
2885   my @aprps = map {"$_->{'project'}/$_->{'repository'}"} @{$info->{'path'} || []};
2886   my @bprps = @{$repo->{'path'} || []} ? @{$prpsearchpath{$prp} || []} : @aprps;
2887
2888   # get config from path
2889   my $bconf = getconfig($myarch, \@bprps);
2890   if (!$bconf) {
2891     print "      - $packid (kiwi-product)\n";
2892     print "        no config\n";
2893     return ('broken', 'no confi