backend: grep for kiwi-.*: instead of just kiwi-, so that only substitutes get picked up
[opensuse:build-service.git] / src / backend / bs_repserver
1 #!/usr/bin/perl -w
2 #
3 # Copyright (c) 2006, 2007 Michael Schroeder, Novell Inc.
4 #
5 # This program is free software; you can redistribute it and/or modify
6 # it under the terms of the GNU General Public License version 2 as
7 # published by the Free Software Foundation.
8 #
9 # This program is distributed in the hope that it will be useful,
10 # but WITHOUT ANY WARRANTY; without even the implied warranty of
11 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
12 # GNU General Public License for more details.
13 #
14 # You should have received a copy of the GNU General Public License
15 # along with this program (see the file COPYING); if not, write to the
16 # Free Software Foundation, Inc.,
17 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
18 #
19 ################################################################
20 #
21 # The Repository Server
22 #
23
24 BEGIN {
25   my ($wd) = $0 =~ m-(.*)/- ;
26   $wd ||= '.';
27   # FIXME: currently the bs_srcserver makes assumptions on being in a
28   # properly set up working dir, e.g. with subdirs 'worker' and
29   # 'build'.  Either that is cleaned up or this stays in, for the sake
30   # of startproc and others being able to start a bs_srcserver without
31   # knowing that it has to be started in the right directory....
32
33   chdir "$wd";
34   unshift @INC,  "build";
35   unshift @INC,  ".";
36 }
37
38 use POSIX;
39 use Fcntl qw(:DEFAULT :flock);
40 BEGIN { Fcntl->import(':seek') unless defined &SEEK_SET; }
41 use XML::Structured ':bytes';
42 use Storable ();
43 use Data::Dumper;
44 use Digest::MD5 ();
45 use List::Util;
46 use Symbol;
47
48 use BSConfig;
49 use BSRPC ':https';
50 use BSServer;
51 use BSUtil;
52 use BSHTTP;
53 use BSFileDB;
54 use BSXML;
55 use BSVerify;
56 use BSHandoff;
57 use Build;
58 use BSWatcher;
59 use BSStdServer;
60 use BSXPath;
61 use BSXPathKeys;
62 use BSDB;
63 use BSDBIndex;
64 use BSNotify;
65
66 use BSSolv;
67
68 use strict;
69
70 my $port = 5252;        #'RR'
71 $port = $1 if $BSConfig::reposerver =~ /:(\d+)$/;
72 my $proxy;
73 $proxy = $BSConfig::proxy if defined($BSConfig::proxy);
74
75 my $historylay = [qw{versrel bcnt srcmd5 rev time}];
76
77 my $reporoot = "$BSConfig::bsdir/build";
78 my $workersdir = "$BSConfig::bsdir/workers";
79 my $jobsdir = "$BSConfig::bsdir/jobs";
80 my $eventdir = "$BSConfig::bsdir/events";
81 my $infodir = "$BSConfig::bsdir/info";
82 my $uploaddir = "$BSConfig::bsdir/upload";
83 my $rundir = $BSConfig::rundir || "$BSConfig::bsdir/run";
84 my $extrepodir = "$BSConfig::bsdir/repos";
85 my $extrepodb = "$BSConfig::bsdir/db/published";
86
87 my $ajaxsocket = "$rundir/bs_repserver.ajax";
88
89 sub unify {
90   my %h = map {$_ => 1} @_;
91   return grep(delete($h{$_}), @_); 
92 }
93
94 # XXX read jobs instead?
95
96 sub jobname {
97   my ($prp, $packid) = @_;
98   my $job = "$prp/$packid";
99   $job =~ s/\//::/g;
100   return $job;
101 }
102
103
104 # add :full repo to pool, make sure repo is up-to-data by
105 # scanning the directory
106 sub addrepo_scan {
107   my ($pool, $prp, $arch) = @_;
108   my $dir = "$reporoot/$prp/$arch/:full";
109   my $repobins = {};
110   my $cnt = 0; 
111
112   my $cache;
113   if (-s "$dir.solv") {
114     eval {$cache = $pool->repofromfile($prp, "$dir.solv");};
115     warn($@) if $@;
116     return $cache if $cache && $cache->isexternal();
117     ### speed up test...
118     return $cache if $cache;
119     print "local repo $prp\n";
120   }
121   my @bins;
122   local *D;
123   if (opendir(D, $dir)) {
124     @bins = grep {/\.(?:rpm|deb)$/} readdir(D);
125     closedir D;
126     if (!@bins && -s "$dir.subdirs") {
127       for my $subdir (split(' ', readstr("$dir.subdirs"))) {
128         push @bins, map {"$subdir/$_"} grep {/\.(?:rpm|deb)$/} ls("$dir/$subdir");    }
129     }
130   }
131   for (splice @bins) {
132     my @s = stat("$dir/$_");
133     next unless @s;
134     push @bins, $_, "$s[9]/$s[7]/$s[1]";
135   }
136   if ($cache) {
137     $cache->updatefrombins($dir, @bins);
138   } else {
139     $cache = $pool->repofrombins($prp, $dir, @bins);
140   }
141   return $cache;
142 }
143
144 sub addrepo_remote {
145   my ($pool, $prp, $arch, $remoteproj) = @_;
146   my ($projid, $repoid) = split('/', $prp, 2);
147   return undef unless $remoteproj;
148   print "fetching remote repository state for $prp\n";
149   my $param = {
150     'uri' => "$remoteproj->{'remoteurl'}/build/$remoteproj->{'remoteproject'}/$repoid/$arch/_repository",
151     'timeout' => 200, 
152     'receiver' => \&BSHTTP::cpio_receiver,
153     'proxy' => $proxy,
154   };
155   my $cpio = BSRPC::rpc($param, undef, "view=cache");
156   my %cpio = map {$_->{'name'} => $_->{'data'}} @{$cpio || []}; 
157   if (exists $cpio{'repositorycache'}) {
158     my $cache;
159     eval { $cache = Storable::thaw(substr($cpio{'repositorycache'}, 4)); };
160     delete $cpio{'repositorycache'};    # free mem
161     warn($@) if $@;
162     return undef unless $cache;
163     # free some unused entries to save mem
164     for (values %$cache) {
165       delete $_->{'path'};
166       delete $_->{'id'};
167     }
168     return $pool->repofromdata($prp, $cache);
169   } else {
170     # return empty repo
171     return $pool->repofrombins($prp, '');
172   }
173 }
174
175 sub fetchdodbinary {
176   my ($pool, $repo, $p, $arch, $maxredirects, $handoff) = @_;
177
178   my $reponame = $repo->name();
179   die("$reponame is no dod repo\n") unless $repo->dodurl();
180   my $path = $pool->pkg2path($p);
181   my $suf = $path;
182   $suf =~ s/.*\.//;
183   my $localname = "$reporoot/$reponame/$arch/:full/".$pool->pkg2name($p).".$suf";
184   return $localname if -e $localname;
185   # we really need to download, handoff to ajax if not already done
186   if ($handoff && !$BSStdServer::isajax) {
187     BSHandoff::handoff($ajaxsocket, @$handoff);
188     exit(0);
189   }
190   my $url = $repo->dodurl();
191   $url .= '/' unless $url =~ /\/$/;
192   $url .= $pool->pkg2path($p);
193   my $tmp = "$localname.$$";
194   #print "fetching: $url\n";
195   my $param = {'uri' => $url, 'filename' => $tmp, 'receiver' => \&BSHTTP::file_receiver, 'proxy' => $proxy};
196   $param->{'maxredirects'} = $maxredirects if defined $maxredirects;
197   my $r = BSWatcher::rpc($param);
198   return unless defined $r;
199   rename($tmp, $localname) || die("rename $tmp $localname: $!\n");
200   return $localname;
201 }
202
203 sub getbinaryversions {
204   my ($cgi, $projid, $repoid, $arch) = @_;
205   my $prp = "$projid/$repoid";
206   my @qbins = split(',', $cgi->{'binaries'} || '');
207
208   my $serial;
209   $serial = BSWatcher::serialize("$reporoot/$projid/$repoid/$arch") if $BSStdServer::isajax;
210   return if $BSStdServer::isajax && !defined $serial;
211   my $pool = BSSolv::pool->new();
212   my $repo = addrepo_scan($pool, $prp, $arch);
213   my %rnames = $repo ? $repo->pkgnames() : ();
214   my @res;
215   my $needscan;
216   my $dodurl = $repo->dodurl();
217   for my $n (@qbins) {
218     my $p = $rnames{$n};
219     if (!$p) {
220       push @res, {'name' => $n, 'error' => 'not available'};
221       next;
222     }
223     my $path = "$reporoot/".$pool->pkg2fullpath($p, $arch);
224     my $sizek = $pool->pkg2sizek($p);
225     my $hdrmd5 = $pool->pkg2pkgid($p);
226     if ($dodurl && $hdrmd5 eq 'd0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0') {
227       my @handoff = ('/getbinaryversions', undef, "project=$projid", "repository=$repoid", "arch=$arch", "binaries=$cgi->{'binaries'}");
228       $path = fetchdodbinary($pool, $repo, $p, $arch, 3, \@handoff);
229       return unless defined $path;
230       # TODO: move it out of the loop otherwise the same files might be queried multiple times
231       my @s = stat($path);
232       $sizek = ($s[7] + 1023) >> 10;
233       $hdrmd5 = Build::queryhdrmd5($path);
234       $needscan = 1;
235     }
236     my $r;
237     if ($path =~ /\.rpm$/) {
238       $r = {'name' => "$n.rpm"};
239     } else {
240       $r = {'name' => "$n.deb"};
241     }
242     $r->{'hdrmd5'} = $hdrmd5;
243     $r->{'sizek'} = $sizek;
244     push @res, $r;
245     next if $cgi->{'nometa'};
246     next unless $path =~ s/\.(?:rpm|deb)$//;
247     local *F;
248     if (!open(F, '<', "$path.meta")) {
249       next unless open(F, '<', "$path-MD5SUMS.meta");
250     }
251     my $ctx = Digest::MD5->new;
252     $ctx->addfile(*F);
253     $r->{'metamd5'} = $ctx->hexdigest();
254     close F;
255   }
256   undef $repo;
257   undef $pool;
258   BSWatcher::serialize_end($serial) if defined $serial;
259   forwardevent($cgi, 'scanrepo', $projid, undef, $repoid, $arch) if $needscan;
260   return ({ 'binary' => \@res }, $BSXML::binaryversionlist);
261 }
262
263 sub getbinaries {
264   my ($cgi, $projid, $repoid, $arch) = @_;
265   my $prp = "$projid/$repoid";
266   my @qbins = split(',', $cgi->{'binaries'} || '');
267
268   my $serial;
269   $serial = BSWatcher::serialize("$reporoot/$projid/$repoid/$arch") if $BSStdServer::isajax;
270   return if $BSStdServer::isajax && !defined $serial;
271   my $pool = BSSolv::pool->new();
272   my $repo = addrepo_scan($pool, $prp, $arch);
273   my %rnames = $repo ? $repo->pkgnames() : ();
274   my @send;
275   my $needscan;
276   my $dodurl = $repo->dodurl();
277   for my $n (@qbins) {
278     my $p = $rnames{$n};
279     if (!$p) {
280       push @send, {'name' => $n, 'error' => 'not available'};
281       next;
282     }
283     my $path = "$reporoot/".$pool->pkg2fullpath($p, $arch);
284     if ($dodurl && $pool->pkg2pkgid($p) eq 'd0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0') {
285       my @handoff = ('/getbinaries', undef, "project=$projid", "repository=$repoid", "arch=$arch", "binaries=$cgi->{'binaries'}");
286       $path = fetchdodbinary($pool, $repo, $p, $arch, 3, \@handoff);
287       return unless defined $path;
288       $needscan = 1;
289     }
290     if ($path =~ /\.rpm$/) {
291       push @send, {'name' => "$n.rpm", 'filename' => $path};
292     } else {
293       push @send, {'name' => "$n.deb", 'filename' => $path};
294     }
295     next if $cgi->{'nometa'};
296     next unless $path =~ s/\.(?:rpm|deb)$//;
297     if (-e "$path.meta" || ! -e "$path-MD5SUMS.meta") {
298       push @send, {'name' => "$n.meta", 'filename' => "$path.meta"};
299     } else {
300       push @send, {'name' => "$n.meta", 'filename' => "$path-MD5SUMS.meta"};
301     }
302   }
303   undef $repo;
304   undef $pool;
305   BSWatcher::serialize_end($serial) if defined $serial;
306   forwardevent($cgi, 'scanrepo', $projid, undef, $repoid, $arch) if $needscan;
307   BSWatcher::reply_cpio(\@send);
308   return undef;
309 }
310   
311 sub getbinarylist_repository {
312   my ($cgi, $projid, $repoid, $arch) = @_;
313
314   my $prp = "$projid/$repoid";
315   my $view = $cgi->{'view'} || '';
316
317   if (($view eq 'cache' || $view eq 'cpio' || $view eq 'solvstate') && !$BSStdServer::isajax) {
318     my @args;
319     push @args, "view=$view";
320     push @args, map {"binary=$_"} @{$cgi->{'binary'} || []};
321     BSHandoff::handoff($ajaxsocket, "/build/$projid/$repoid/$arch/_repository", undef, @args);
322     exit(0);
323   }
324
325   if ($view eq 'solv') {
326     my $fd = gensym;
327     if (!open($fd, '<', "$reporoot/$prp/$arch/:full.solv")) {
328       my $pool = BSSolv::pool->new();
329       my $repo = addrepo_scan($pool, $prp, $arch);
330       if ($repo) {
331         $repo->tofile("$reporoot/$prp/$arch/:full.solv.$$");
332         if (!open($fd, '<', "$reporoot/$prp/$arch/:full.cache.$$")) {
333           undef $fd;
334         }
335         unlink("$reporoot/$prp/$arch/:full.solv.$$");
336       } else {
337         undef $fd;
338       }
339       undef $repo;
340       undef $pool;
341     }
342     die("no solv file available") unless defined $fd;
343     BSWatcher::reply_file($fd);
344     return undef;
345   }
346
347   if ($view eq 'solvstate') {
348     my $repostate = readxml("$reporoot/$prp/$arch/:repostate", $BSXML::repositorystate, 1) || {};
349     my @files;
350     push @files, {
351       'name' => 'repositorystate',
352       'data' => XMLout($BSXML::repositorystate, $repostate),
353     };
354     my $fd = gensym;
355     if (open($fd, '<', "$reporoot/$prp/$arch/:full.solv")) {
356       push @files, { 'name' => 'repositorysolv', 'filename' => $fd };
357     } else {
358       my $pool = BSSolv::pool->new();
359       my $repo = addrepo_scan($pool, $prp, $arch);
360       if ($repo) {
361         $repo->tofile("$reporoot/$prp/$arch/:full.solv.$$");
362         if (open($fd, '<', "$reporoot/$prp/$arch/:full.cache.$$")) {
363           push @files, { 'name' => 'repositorysolv', 'filename' => $fd };
364         }
365         unlink("$reporoot/$prp/$arch/:full.solv.$$");
366       }
367       undef $repo;
368       undef $pool;
369     }
370     BSWatcher::reply_cpio(\@files);
371     return undef;
372   }
373
374   if ($view eq 'cache') {
375     my $repostate = readxml("$reporoot/$prp/$arch/:repostate", $BSXML::repositorystate, 1) || {};
376     my @files;
377     push @files, {
378       'name' => 'repositorystate',
379       'data' => XMLout($BSXML::repositorystate, $repostate),
380     };
381     my $fd = gensym;
382     if (-s "$reporoot/$prp/$arch/:full.solv") {
383       my $pool = BSSolv::pool->new();
384       my $repo = addrepo_scan($pool, $prp, $arch);
385       if ($repo) {
386         my %data = $repo->pkgnames();
387         for my $p (values %data) {
388           $p = $pool->pkg2data($p);
389         }
390         # the streaming code can't handle big chunks of data, so we write
391         # the result to a tmp file and stream from it
392         BSUtil::store("$reporoot/$prp/$arch/:full.cache.$$", undef, \%data);
393         if (open($fd, '<', "$reporoot/$prp/$arch/:full.cache.$$")) {
394           push @files, { 'name' => 'repositorycache', 'filename' => $fd };
395         }
396         unlink("$reporoot/$prp/$arch/:full.cache.$$");
397       }
398       undef $repo;
399       undef $pool;
400     } elsif (-s "$reporoot/$prp/$arch/:full.cache") {
401       # compatibility code, to be removed...
402       if (open($fd, '<', "$reporoot/$prp/$arch/:full.cache")) {
403         push @files, { 'name' => 'repositorycache', 'filename' => $fd };
404       }
405     }
406     BSWatcher::reply_cpio(\@files);
407     return undef;
408   }
409
410   if ($view eq 'cpio') {
411     my $serial;
412     $serial = BSWatcher::serialize("$reporoot/$projid/$repoid/$arch") if $BSStdServer::isajax;
413     return if $BSStdServer::isajax && !defined $serial;
414     my @files;
415     my $pool = BSSolv::pool->new();
416     my $repo = addrepo_scan($pool, $prp, $arch);
417     my %names = $repo ? $repo->pkgnames() : ();
418     my @bins = $cgi->{'binary'} ? @{$cgi->{'binary'}} : sort keys %names;
419     my $dodurl = $repo->dodurl();
420     my $needscan;
421     for my $bin (@bins) {
422       my $p = $names{$bin};
423       if (!$p) {
424         push @files, {'name' => $bin, 'error' => 'not available'};
425         next;
426       }
427       my $path = "$reporoot/".$pool->pkg2fullpath($p, $arch);
428       if ($dodurl && $pool->pkg2pkgid($p) eq 'd0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0') {
429         my @handoff = ("/build/$projid/$repoid/$arch/_repository", undef, "view=$view", map {"binary=$_"} @{$cgi->{'binary'} || []});
430         $path = fetchdodbinary($pool, $repo, $p, $arch, 3, \@handoff);
431         return unless defined $path;
432         $needscan = 1;
433       }
434       my $fd = gensym;
435       if (!open($fd, '<', $path)) {
436         push @files, {'name' => $bin, 'error' => 'not available'};
437         next;
438       }
439       my $n = $bin;
440       $n .= $1 if $path =~ /(\.rpm|\.deb)$/;
441       push @files, {'name' => $n, 'filename' => $fd},
442     }
443     undef $repo;
444     undef $pool;
445     BSWatcher::serialize_end($serial) if defined $serial;
446     forwardevent($cgi, 'scanrepo', $projid, undef, $repoid, $arch) if $needscan;
447     BSWatcher::reply_cpio(\@files);
448     return undef;
449   }
450
451   # FIXME: nearly a duplicate of getbinaryversions()
452   if ($view eq 'binaryversions') {
453     my $serial;
454     $serial = BSWatcher::serialize("$reporoot/$projid/$repoid/$arch") if $BSStdServer::isajax;
455     return if $BSStdServer::isajax && !defined($serial);
456     my $pool = BSSolv::pool->new();
457     my $repo = addrepo_scan($pool, $prp, $arch);
458     my %names = $repo ? $repo->pkgnames() : ();
459     my @bins = $cgi->{'binary'} ? @{$cgi->{'binary'}} : sort keys %names;
460     my @res;
461     my $needscan;
462     my $dodurl = $repo->dodurl();
463     for my $bin (@bins) {
464       my $p = $names{$bin};
465       if (!$p) {
466         push @res, {'name' => $bin, 'error' => 'not available'};
467         next;
468       }
469       my $path = "$reporoot/".$pool->pkg2fullpath($p, $arch);
470       my $sizek = $pool->pkg2sizek($p);
471       my $hdrmd5 = $pool->pkg2pkgid($p);
472       if ($dodurl && $hdrmd5 eq 'd0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0') {
473         my @handoff = ("/build/$projid/$repoid/$arch/_repository", undef, "view=$view", map {"binary=$_"} @{$cgi->{'binary'} || []});
474         $path = fetchdodbinary($pool, $repo, $p, $arch, 3, \@handoff);
475         return unless defined $path;
476         # TODO: move it out of the loop otherwise the same files might be queried multiple times
477         my @s = stat($path);
478         $sizek = ($s[7] + 1023) >> 10;
479         $hdrmd5 = Build::queryhdrmd5($path);
480         $needscan = 1;
481       }
482       my $r;
483       if ($path =~ /\.rpm$/) {
484         $r = {'name' => "$bin.rpm"};
485       } else {
486         $r = {'name' => "$bin.deb"};
487       }    
488       $r->{'hdrmd5'} = $hdrmd5;
489       $r->{'sizek'} = $sizek;
490       push @res, $r;
491       next if $cgi->{'nometa'};
492       next unless $path =~ s/\.(?:rpm|deb)$//;
493       local *F;
494       if (!open(F, '<', "$path.meta")) {
495         next unless open(F, '<', "$path-MD5SUMS.meta");
496       }    
497       my $ctx = Digest::MD5->new;
498       $ctx->addfile(*F);
499       $r->{'metamd5'} = $ctx->hexdigest();
500       close F;
501     }
502     undef $repo;
503     undef $pool;
504     BSWatcher::serialize_end($serial) if defined $serial;
505     forwardevent($cgi, 'scanrepo', $projid, undef, $repoid, $arch) if $needscan;
506     return ({ 'binary' => \@res }, $BSXML::binaryversionlist);
507   }
508
509   die("unsupported view '$view'\n") if $view && $view ne 'names';
510
511   my $pool = BSSolv::pool->new();
512   my $repo = addrepo_scan($pool, $prp, $arch);
513   my %names = $repo ? $repo->pkgnames() : ();
514   my @bins = $cgi->{'binary'} ? @{$cgi->{'binary'}} : sort keys %names;
515   my @res;
516   for my $bin (@bins) {
517     my $p = $names{$bin};
518     if (!$p) {
519       push @res, {'filename' => $bin, 'size' => 0};
520       next;
521     }
522     my $path = $pool->pkg2path($p);
523     my $n = $bin;
524     $n .= $1 if $path =~ /(\.rpm|\.deb)$/;
525     my $r = {'filename' => $view eq 'names' ? $n : $path };
526     my $id = $pool->pkg2bsid($p);
527     if ($id) {
528       if ($id eq 'dod') {
529         $r->{'mtime'} = '';
530         $r->{'size'} = '';
531       } else {
532         my @s = split('/', $id, 3);
533         $r->{'mtime'} = $s[0];
534         $r->{'size'} = $s[1];
535       }
536     } else {
537       my @s = stat("$reporoot/$prp/$arch/:full/$path");
538       if (@s) {
539         $r->{'mtime'} = $s[9];
540         $r->{'size'} = $s[7];
541       }
542     }
543     push @res, $r;
544   }
545   undef $repo;
546   undef $pool;
547   return ({'binary' => \@res}, $BSXML::binarylist);
548 }
549
550 sub filtersources {
551   my (@bins) = @_;
552   my $debian = grep {/\.dsc$/} @bins;
553   for my $bin (splice @bins) {
554     next if $bin =~ /\.(?:no)?src\.rpm$/;
555     next if $bin =~ /-debug(:?info|source).*\.rpm$/;
556     next if $debian && ($bin !~ /\.deb$/);
557     push @bins, $bin;
558   }
559   return @bins;
560 }
561
562 sub getbinarylist {
563   my ($cgi, $projid, $repoid, $arch, $packid) = @_;
564   return getbinarylist_repository($cgi, $projid, $repoid, $arch) if $packid eq '_repository';
565   my $prp = "$projid/$repoid";
566   my $view = $cgi->{'view'} || '';
567   if ($view eq 'cpio' && !$BSStdServer::isajax && !$cgi->{'noajax'}) {
568     my @args;
569     push @args, "view=$view";
570     push @args, map {"binary=$_"} @{$cgi->{'binary'} || []};
571     BSHandoff::handoff($ajaxsocket, "/build/$projid/$repoid/$arch/$packid", undef, @args);
572     exit(0);
573   }
574   my %binaries = map {$_ => 1} @{$cgi->{'binary'} || []};
575   if ($view eq 'cpio') {
576     my @files;
577     my @bins = grep {/\.(?:rpm|deb)$/} ls("$reporoot/$prp/$arch/$packid");
578     @bins = filtersources(@bins) if -e "$reporoot/$prp/$arch/$packid/.nosourceaccess";
579     for (sort @bins) {
580       next if %binaries && !$binaries{$_};
581       my $fd = gensym;
582       next unless open($fd, '<', "$reporoot/$prp/$arch/$packid/$_");
583       push @files, {'name' => $_, 'filename' => $fd},
584     }
585     BSWatcher::reply_cpio(\@files);
586     return undef;
587   }
588   if ($view eq 'binaryversions') {
589     my @bins = grep {/\.(?:rpm|deb)$/} ls("$reporoot/$prp/$arch/$packid");
590     @bins = filtersources(@bins) if -e "$reporoot/$prp/$arch/$packid/.nosourceaccess";
591     my @res;
592     # should use bininfo instead, but we need the leadsigmd5
593     for my $bin (sort @bins) {
594       next if %binaries && !$binaries{$bin};
595       my @s = stat("$reporoot/$prp/$arch/$packid/$bin");
596       next unless @s;
597       my $leadsigmd5;
598       my $hdrmd5 = Build::queryhdrmd5("$reporoot/$prp/$arch/$packid/$bin", \$leadsigmd5);
599       next unless $hdrmd5;
600       my $r = {'name' => $bin, 'hdrmd5' => $hdrmd5, 'sizek' => ($s[7] + 512) >> 10};
601       $r->{'leadsigmd5'} = $leadsigmd5 if $leadsigmd5;
602       push @res, $r;
603     }
604     return ({ 'binary' => \@res }, $BSXML::binaryversionlist);
605   }
606   die("unsupported view '$view'\n") if $view;
607   my @res;
608   my @bins = grep {$_ ne 'logfile' && $_ ne 'status' && $_ ne 'reason' && $_ ne 'history' && !/^\./} ls("$reporoot/$prp/$arch/$packid");
609   @bins = filtersources(@bins) if -e "$reporoot/$prp/$arch/$packid/.nosourceaccess";
610   for (sort @bins) {
611     next if %binaries && !$binaries{$_};
612     my @s = stat("$reporoot/$prp/$arch/$packid/$_");
613     next unless @s;
614     next if -d _;
615     push @res, {'filename' => $_, 'size' => $s[7], 'mtime' => $s[9]};
616   }
617   return ({'binary' => \@res}, $BSXML::binarylist);
618 }
619
620 sub getbuildhistory {
621   my ($cgi, $projid, $repoid, $arch, $packid) = @_;
622   my @history = BSFileDB::fdb_getall_reverse("$reporoot/$projid/$repoid/$arch/$packid/history", $historylay, $cgi->{'limit'} || 100);
623   @history = reverse @history;
624   return ({'entry' => \@history}, $BSXML::buildhist);
625 }
626
627 sub getbuildreason {
628   my ($cgi, $projid, $repoid, $arch, $packid) = @_;
629
630   my $reason = readxml("$reporoot/$projid/$repoid/$arch/$packid/reason", $BSXML::buildreason, 1) || {};
631   $reason ||= {'explain' => 'no reason known'};
632   return ($reason, $BSXML::buildreason);
633 }
634
635 sub getbuildstatus {
636   my ($cgi, $projid, $repoid, $arch, $packid) = @_;
637
638   my $res = {'package' => $packid};
639   my $ps = BSUtil::retrieve("$reporoot/$projid/$repoid/$arch/:packstatus", 1);;
640   $ps ||= convertoldpackstatus("$projid/$repoid/$arch");
641   if ($ps) {
642     $ps = {
643       'status' => $ps->{'packstatus'}->{$packid},
644       'error' => $ps->{'packerror'}->{$packid},
645     };
646     undef $ps unless $ps->{'status'};
647   }
648   if ($ps && $ps->{'status'} ne 'failed' && $ps->{'status'} ne 'done' && $ps->{'status'} ne 'scheduled') {
649     $res->{'code'} = $ps->{'status'};
650     $res->{'details'} = $ps->{'error'} if exists $ps->{'error'};
651   } else {
652     my $status = readxml("$reporoot/$projid/$repoid/$arch/$packid/status", $BSXML::buildstatus, 1);
653     if (!$status->{'code'}) {
654       $res->{'code'} = $status->{'status'} || 'unknown';
655       $res->{'details'} = $status->{'error'} if $status->{'error'};
656     } else {
657       $res->{'code'} = $status->{'code'};
658       $res->{'details'} = $status->{'details'} if $status->{'details'};
659     }
660     if ($status->{'job'}) {
661       my $jobstatus = readxml("$jobsdir/$arch/$status->{'job'}:status", $BSXML::jobstatus, 1); 
662       if ($jobstatus) {
663         delete $res->{'details'};
664         $res->{'code'} = $jobstatus->{'code'};
665         $res->{'details'} = $jobstatus->{'details'} if $jobstatus->{'details'};
666         if ($jobstatus->{'code'} eq 'building' && $jobstatus->{'workerid'}) {
667           $res->{'details'} = "building on $jobstatus->{'workerid'}";
668         }
669       }
670     }
671   }
672   return ($res, $BSXML::buildstatus);
673 }
674
675 sub getlogfile {
676   my ($cgi, $projid, $repoid, $arch, $packid) = @_;
677
678   die("unknown view '$cgi->{'view'}'\n") if $cgi->{'view'} && $cgi->{'view'} ne 'entry';
679   if ($cgi->{'handoff'} && !$BSStdServer::isajax) {
680     my @args = ();
681     push @args, 'nostream' if $cgi->{'nostream'};
682     push @args, "start=$cgi->{'start'}" if defined $cgi->{'start'};
683     push @args, "end=$cgi->{'end'}" if defined $cgi->{'end'};
684     push @args, "view=$cgi->{'view'}" if $cgi->{'view'};
685     my $url = "/build/$projid/$repoid/$arch/$packid/_log";
686     BSHandoff::handoff($ajaxsocket, $url, undef, @args);
687     exit(0);
688   }
689   my $status = readxml("$reporoot/$projid/$repoid/$arch/$packid/status", $BSXML::buildstatus, 1);
690   my $jobstatus;
691
692   if ($status && $status->{'status'} eq 'scheduled') {
693     $jobstatus = readxml("$jobsdir/$arch/$status->{'job'}:status", $BSXML::jobstatus, 1);
694   }
695
696   #if ($BSStdServer::isajax) {
697   #  $status->{'status'} = 'building';
698   #  $status->{'uri'} = 'http://192.168.1.102:4711';
699   #}
700   if ($jobstatus && $jobstatus->{'code'} && $jobstatus->{'code'} eq 'building' && $jobstatus->{'uri'}) {
701     my @args;
702     push @args, 'nostream' if $cgi->{'nostream'};
703     push @args, "start=$cgi->{'start'}" if defined $cgi->{'start'};
704     push @args, "end=$cgi->{'end'}" if defined $cgi->{'end'};
705     push @args, "view=$cgi->{'view'}" if $cgi->{'view'};
706     if (!$BSStdServer::isajax && !$cgi->{'view'}) {
707       my $url = "/build/$projid/$repoid/$arch/$packid/_log";
708       BSHandoff::handoff($ajaxsocket, $url, undef, @args);
709       exit(0);
710     }
711     my $param = {
712       'uri' => "$jobstatus->{'uri'}/logfile",
713       'joinable' => 1,
714       'receiver' => \&BSServer::reply_receiver,
715     };
716     eval {
717       BSWatcher::rpc($param, undef, @args);
718     };
719     return undef unless $@;
720     my $err = $@;
721     die($err) if $param->{'reply_receiver_called'} || $BSStdServer::isajax;
722     $jobstatus = readxml("$jobsdir/$arch/$status->{'job'}:status", $BSXML::jobstatus, 1);
723     die($err) if $jobstatus && $jobstatus->{'code'} && $jobstatus->{'code'} eq 'building' && $jobstatus->{'uri'};
724     # no longer building, use local logfile
725   }
726   my $logfile = "$reporoot/$projid/$repoid/$arch/$packid/logfile";
727   if ($jobstatus && $jobstatus->{'code'} && ($jobstatus->{'code'} eq 'finished'||$jobstatus->{'code'} eq 'signing')) {
728     $logfile = "$jobsdir/$arch/$status->{'job'}:dir/logfile";
729   }
730   my @s = stat($logfile);
731   die("$packid: no logfile\n") unless @s;
732   if ($cgi->{'view'} && $cgi->{'view'} eq 'entry') {
733     my $entry = {'name' => '_log', 'size' => $s[7], 'mtime' => $s[9]};
734     return ({'entry' => [ $entry ]}, $BSXML::dir);
735   }
736   my $start = $cgi->{'start'} || 0;
737   my $end = $cgi->{'end'};
738   $start = $s[7] + $start if $start < 0;
739   $start = 0 if $start < 0;
740   die("start out of range: $start\n") if $start > $s[7];
741   $end = $s[7] if !defined($end) || $end > $s[7];
742   $end = $start if defined($end) && $end < $start;
743   my $fd = gensym;
744   open($fd, '<', $logfile) || die("$logfile: $!\n");
745   defined(sysseek($fd, $start, Fcntl::SEEK_SET)) || die("sysseek: $!\n");
746   BSWatcher::reply_file($fd, 'Content-Type: text/plain', 'Content-Length: '.($end - $start));
747   close $fd unless $BSStdServer::isajax;
748   return undef;
749 }
750
751 sub getbinary_info {
752   my ($cgi, $projid, $repoid, $arch, $path) = @_;
753   my @s = stat($path);
754   die("404 $path: $!\n") unless @s;
755   my $res = Build::query($path, 'evra' => 1, 'description' => 1);
756   delete $res->{'source'};
757   delete $res->{'hdrmd5'};
758   $res->{'mtime'} = $s[9];
759   $res->{'size'} = $s[7];
760   $res->{'filename'} = $path;
761   $res->{'filename'} =~ s/.*\///;
762   if ($cgi->{'view'} && $cgi->{'view'} eq 'fileinfo_ext') {
763     my $config = BSRPC::rpc("$BSConfig::srcserver/getconfig", undef, "project=$projid", "repository=$repoid");
764     my $bconf = Build::read_config($arch, [split("\n", $config)]);
765     my $projpack = BSRPC::rpc("$BSConfig::srcserver/getprojpack", $BSXML::projpack, 'withrepos', 'expandedrepos', 'withremotemap', "project=$projid", "repository=$repoid", "arch=$arch", "nopackages");
766     die("404 no such project/repository\n") unless $projpack->{'project'};
767     my $proj = $projpack->{'project'}->[0];
768     die("404 no such project\n") unless $proj && $proj->{'name'} eq $projid;
769     my $repo = $proj->{'repository'}->[0];
770     die("404 no such repository\n") unless $repo && $repo->{'name'} eq $repoid;
771     my %remotemap = map {$_->{'project'} => $_} @{$projpack->{'remotemap'} || []};
772     my @prp = map {"$_->{'project'}/$_->{'repository'}"} @{$repo->{'path'} || []};
773     my $pool = BSSolv::pool->new();
774     $pool->settype('deb') if $bconf->{'type'} eq 'dsc';
775     for my $prp (@prp) {
776       my ($rprojid, $rrepoid) = split('/', $prp, 2);
777       my $r;
778       if ($remotemap{$rprojid}) {
779         $r = addrepo_remote($pool, $prp, $arch, $remotemap{$rprojid});
780       } else {
781         $r = addrepo_scan($pool, $prp, $arch);
782       }
783       die("repository $prp not available\n") unless $r;
784     }
785     $pool->createwhatprovides();
786     for my $prov (@{$res->{'provides'}}) {
787       my $n = {'dep' => $prov};
788       push @{$res->{'provides_ext'}}, $n;
789       for my $p ($pool->whatrequires($prov)) {
790         my $rd = $pool->pkg2data($p);
791         delete $rd->{$_} for qw{provides requires source path hdrmd5 id};
792         ($rd->{'project'}, $rd->{'repository'}) = split('/', $pool->pkg2reponame($p), 2);
793         push @{$n->{'requiredby'}}, $rd;
794       }
795     }
796     for my $req (@{$res->{'requires'}}) {
797       my $n = {'dep' => $req};
798       push @{$res->{'requires_ext'}}, $n;
799       for my $p ($pool->whatprovides($req)) {
800         my $rd = $pool->pkg2data($p);
801         delete $rd->{$_} for qw{provides requires source path hdrmd5 id};
802         ($rd->{'project'}, $rd->{'repository'}) = split('/', $pool->pkg2reponame($p), 2);
803         push @{$n->{'providedby'}}, $rd;
804       }
805     }
806   }
807   data2utf8xml($res);
808   return ($res, $BSXML::fileinfo);
809 }
810
811 sub getbinary_repository {
812   my ($cgi, $projid, $repoid, $arch, $bin) = @_;
813
814   if ($bin eq '_buildconfig') {
815     my $cfg = BSRPC::rpc("$BSConfig::srcserver/getconfig", undef, "project=$projid", "repository=$repoid");
816     return ($cfg, 'Content-Type: text/plain');
817   }
818   my $serial;
819   $serial = BSWatcher::serialize("$reporoot/$projid/$repoid/$arch") if $BSStdServer::isajax;
820   return if $BSStdServer::isajax && !defined $serial;
821   my $view = $cgi->{'view'} || '';
822   my $path = "$reporoot/$projid/$repoid/$arch/:full/$bin";
823   my $needscan;
824   if (! -f $path) {
825     # return by name
826     my $pool = BSSolv::pool->new();
827     my $repo = addrepo_scan($pool, "$projid/$repoid", $arch);
828     my $dodurl = $repo->dodurl();
829     my %rnames = $repo ? $repo->pkgnames() : ();
830     my $p = $rnames{$bin};
831     die("404 no such binary '$bin'\n") unless $p;
832     $path = "$reporoot/".$pool->pkg2fullpath($p, $arch);
833     if ($dodurl && $pool->pkg2pkgid($p) eq 'd0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0') {
834       my @handoff = ("/build/$projid/$repoid/$arch/_repository/$bin", undef, $view ? ("view=$view") : ());
835       $path = fetchdodbinary($pool, $repo, $p, $arch, 3, \@handoff);
836       return unless defined $path;
837       $needscan = 1;
838     }
839     undef $repo;
840     undef $pool;
841     die("404 $bin: $!\n") unless -f $path;
842   }
843   BSWatcher::serialize_end($serial) if defined $serial;
844   forwardevent($cgi, 'scanrepo', $projid, undef, $repoid, $arch) if $needscan;
845   return getbinary_info($cgi, $projid, $repoid, $arch, $path) if $view eq 'fileinfo' || $view eq 'fileinfo_ext';
846   die("unknown view '$view'\n") if $view;
847   my $type = 'application/octet-stream';
848   $type = 'application/x-rpm' if $path=~ /\.rpm$/;
849   $type = 'application/x-debian-package' if $path=~ /\.deb$/;
850   BSWatcher::reply_file($path, "Content-Type: $type");
851   return undef;
852 }
853
854 sub getbinary {
855   my ($cgi, $projid, $repoid, $arch, $packid, $bin) = @_;
856   return getbinary_repository($cgi, $projid, $repoid, $arch, $bin) if $packid eq '_repository';
857   my $path = "$reporoot/$projid/$repoid/$arch/$packid/$bin";
858   if (-e "$reporoot/$projid/$repoid/$arch/$packid/.nosourceaccess") {
859     my @bins = ls("$reporoot/$projid/$repoid/$arch/$packid");
860     @bins = filtersources(@bins);
861     die("404 $bin: No such file or directory\n") unless grep {$_ eq $bin} @bins;
862   }
863   die("404 $bin: $!\n") unless -f $path;
864   my $view = $cgi->{'view'} || '';
865   return getbinary_info($cgi, $projid, $repoid, $arch, $path) if $view eq 'fileinfo' || $view eq 'fileinfo_ext';
866   die("unknown view '$view'\n") if $view;
867   my $type = 'application/octet-stream';
868   $type = 'application/x-rpm' if $path=~ /\.rpm$/;
869   $type = 'application/x-debian-package' if $path=~ /\.deb$/;
870   BSServer::reply_file($path, "Content-Type: $type");
871   return undef;
872 }
873
874 sub isolder {
875   my ($old, $new) = @_;
876   return 0 if $old !~ /\.rpm$/;
877   return 0 unless -e $old;
878   my %qold = Build::Rpm::rpmq($old, qw{VERSION RELEASE EPOCH});
879   return 0 unless %qold;
880   my %qnew = Build::Rpm::rpmq($new, qw{VERSION RELEASE EPOCH});
881   return 0 unless %qnew;
882   my $vold = $qold{'VERSION'}->[0];
883   $vold .= "-$qold{'RELEASE'}->[0]" if $qold{'RELEASE'};
884   $vold = "$qold{'EPOCH'}->[0]:$vold" if $qold{'EPOCH'};
885   my $vnew = $qnew{'VERSION'}->[0];
886   $vnew .= "-$qnew{'RELEASE'}->[0]" if $qnew{'RELEASE'};
887   $vnew = "$qnew{'EPOCH'}->[0]:$vnew" if $qnew{'EPOCH'};
888   my $r = Build::Rpm::verscmp($vold, $vnew);
889   # print "isolder $vold $vnew: $r\n";
890   return $r > 0 ? 1 : 0;
891 }
892
893 sub putbinary {
894   my ($cgi, $projid, $repoid, $arch, $bin) = @_;
895   die("file name must end in .deb, .rpm, or .cpio\n") unless $bin =~ /\.(?:rpm|deb|cpio)$/;
896   mkdir_p($uploaddir);
897   my $tdir = "$reporoot/$projid/$repoid/$arch/:full";
898   if ($bin =~ /\.cpio$/) {
899     my $fdir = "$uploaddir/$$.dir";
900     if (-d $fdir) {
901       unlink("$fdir/$_") for ls($fdir);
902       rmdir($fdir);
903     }
904     mkdir_p($fdir);
905     my $uploaded = BSServer::read_cpio($fdir, 'accept' => '^.+\.(?:rpm|deb|iso|meta)$');
906     die("upload error\n") unless $uploaded;
907     if ($cgi->{'wipe'}) {
908       for (ls($tdir)) {
909         unlink("$tdir/$_") || die("unlink $tdir/$_: $!\n");
910       }
911     }
912     my %upfiles = map {$_->{'name'} => 1} @$uploaded;
913     mkdir_p($tdir);
914     for my $file (@$uploaded) {
915       my $fn = $file->{'name'};
916       next if $cgi->{'ignoreolder'} && isolder("$tdir/$fn", "$fdir/$fn");
917       rename("$fdir/$fn", "$tdir/$fn") || die("rename $fdir/$fn $tdir/$fn: $!\n");
918       $fn =~ s/\.(?:rpm|deb|meta)$//;
919       unlink("$tdir/$fn.meta") unless $upfiles{"$fn.meta"};
920     }
921     unlink("$fdir/$_") for ls($fdir);
922     rmdir($fdir);
923   } else {
924     my $fn = "$uploaddir/$$";
925     my $tn = "$tdir/$bin";
926     die("upload failed\n") unless BSServer::read_file($fn);
927     if ($cgi->{'wipe'}) {
928       for (ls($tdir)) {
929         unlink("$tdir/$_") || die("unlink $tdir/$_: $!\n");
930       }
931     }
932     if ($cgi->{'ignoreolder'} && isolder($tn, $fn)) {
933       unlink($fn);
934       return $BSStdServer::return_ok;
935     }
936     mkdir_p($tdir);
937     rename($fn, $tn) || die("rename $fn $tn: $!\n");
938     if ($tn =~ s/\.(?:rpm|deb)$//) {
939       unlink("$tn.meta");
940     }
941   }
942   dirty($projid, $repoid, $arch);
943   if (-d "$eventdir/$arch") {
944     my $ev = { type => 'scanrepo', 'project' => $projid, 'repository' => $repoid };
945     my $evname = "scanrepo:${projid}::$repoid";
946     writexml("$eventdir/$arch/.$evname", "$eventdir/$arch/$evname", $ev, $BSXML::event);
947     ping($arch);
948   }
949   return $BSStdServer::return_ok;
950 }
951
952 sub delbinary {
953   my ($cgi, $projid, $repoid, $arch, $bin) = @_;
954
955   my $tdir = "$reporoot/$projid/$repoid/$arch/:full";
956   unlink("$tdir/$bin") || die("404 $projid/$repoid/$arch/$bin: $!\n");
957   if ($bin =~ s/\.(?:rpm|deb)$//) {
958     unlink("$tdir/$bin.meta");
959   }
960   dirty($projid, $repoid, $arch);
961   if (-d "$eventdir/$arch") {
962     my $ev = { type => 'scanrepo', 'project' => $projid, 'repository' => $repoid };
963     my $evname = "scanrepo:${projid}::$repoid";
964     writexml("$eventdir/$arch/.$evname", "$eventdir/$arch/$evname", $ev, $BSXML::event);
965     ping($arch);
966   }
967   return $BSStdServer::return_ok;
968 }
969
970 sub workerstate {
971   my ($cgi, $harch, $peerport, $state) = @_;
972   my $peerip = BSServer::getpeerdata();
973   die("cannot get your ip address\n") unless $peerip;
974   my $workerid = defined($cgi->{'workerid'}) ? $cgi->{'workerid'} : "$peerip:$peerport";
975   my $idlename = "$harch:$workerid";
976   $idlename =~ s/\//_/g;
977   if ($state eq 'building' || $state eq 'exit') {
978     unlink("$workersdir/idle/$idlename");
979   } elsif ($state eq 'idle') {
980     if (-e "$workersdir/building/$idlename") {
981       # worker must have crashed, discard old job...
982       my $worker = readxml("$workersdir/building/$idlename", $BSXML::worker, 1);
983       if ($worker && $worker->{'arch'} && $worker->{'job'}) {
984         print "restarting build of job $worker->{'arch'}/$worker->{'job'}\n";
985         local *F;
986         my $js = BSUtil::lockopenxml(\*F, '<', "$jobsdir/$worker->{'arch'}/$worker->{'job'}:status", $BSXML::jobstatus, 1);
987         if ($js) {
988           unlink("$jobsdir/$worker->{'arch'}/$worker->{'job'}:status") if $js->{'code'} eq 'building';
989           close F;
990         }
991       }
992     }
993     unlink("$workersdir/building/$idlename");
994
995     # make sure that we can connect to the client
996     if ($BSConfig::checkclientconnectivity) {
997       my $param = {
998         'uri' => "http://$peerip:$peerport/status",
999         'async' => 1,
1000         'timeout' => 1,
1001         'sender' => sub {},
1002       };
1003       eval {
1004         my $ret = BSRPC::rpc($param);
1005         close($ret->{'socket'});
1006       };
1007       if ($@) {
1008         warn($@);
1009         die("cannot reach you!\n");
1010       }
1011     }
1012     
1013     my $worker = {
1014       'hostarch' => $harch,
1015       'ip' => $peerip,
1016       'port' => $peerport,
1017       'workerid' => $workerid,
1018     };
1019     $worker->{'buildarch'} = $cgi->{'buildarch'} if $cgi->{'buildarch'};
1020     $worker->{'memory'} = $cgi->{'memory'} if $cgi->{'memory'};
1021     $worker->{'tellnojob'} = $cgi->{'tellnojob'} if $cgi->{'tellnojob'};
1022     if (-d "$workersdir/disable") {
1023       my @dis = ls("$workersdir/disable");
1024       for (@dis) {
1025         next unless $workerid =~ /^\Q$_\E/;
1026         print "worker ip $peerip id $workerid is disabled\n";
1027         return $BSStdServer::return_ok;
1028       }
1029     }
1030     mkdir_p("$workersdir/idle");
1031     writexml("$workersdir/idle/.$idlename", "$workersdir/idle/$idlename", $worker, $BSXML::worker);
1032   } else {
1033     die("unknown state: $state\n");
1034   }
1035   return $BSStdServer::return_ok;
1036 }
1037
1038 sub dirty {
1039   my ($projid, $repoid, $arch) = @_;
1040
1041   die("dirty: need project id\n") unless defined $projid;
1042   die("dirty: need arch\n") unless defined $arch;
1043   my @repos;
1044   if (defined($repoid)) {
1045     @repos=($repoid);
1046   } else {
1047     @repos = ls("$reporoot/$projid");
1048   }
1049   for my $r (@repos) {
1050     BSUtil::touch("$reporoot/$projid/$r/$arch/:schedulerstate.dirty") if -d "$reporoot/$projid/$r/$arch";
1051   }
1052 }
1053
1054 sub ping {
1055   my ($arch) = @_;
1056   local *F;
1057   if (sysopen(F, "$eventdir/$arch/.ping", POSIX::O_WRONLY|POSIX::O_NONBLOCK)) {
1058     syswrite(F, 'x');
1059     close(F);
1060   }
1061 }
1062
1063 sub getschedulerstate {
1064   my ($projid, $repoid, $arch) = @_;
1065   local *F;
1066
1067   open(F, '<', "$reporoot/$projid/$repoid/$arch/:schedulerstate") || return 'unknown';
1068   my $schedulerstate = readline(*F);
1069   close(F);
1070
1071   if ($schedulerstate eq 'finished') {
1072     return 'finished'     if -e "$eventdir/publish/${projid}::$repoid";
1073     return 'publishing'   if -e "$eventdir/publish/${projid}::${repoid}::inprogress";
1074     return 'unpublished'  if (readstr("$reporoot/$projid/$repoid/$arch/:repodone",1) || '') eq 'disabled';
1075     return 'published';
1076   }
1077   return $schedulerstate;
1078 }
1079
1080 sub workerstatus {
1081   my ($cgi) = @_;
1082   local *D;
1083   my @idle;
1084   if (!$cgi->{'scheduleronly'}) {
1085     for my $w (ls("$workersdir/idle")) {
1086       my $worker = readxml("$workersdir/idle/$w", $BSXML::worker, 1);
1087       next unless $worker;
1088       push @idle, {'hostarch' => $worker->{'hostarch'}, 'uri' => "http://$worker->{'ip'}:$worker->{'port'}", 'workerid' => $worker->{'workerid'}};
1089     }
1090   }
1091   my @building;
1092   my @waiting;
1093   my @blocked;
1094   my @buildaverage;
1095   my @a;
1096   @a = ls($jobsdir) unless $cgi->{'scheduleronly'};
1097   for my $a (@a) {
1098     next unless -d "$jobsdir/$a";
1099     my @d = grep {!/^\./ && !/:(?:dir|new)$/} ls("$jobsdir/$a");
1100     my %d = map {$_ => 1} @d;
1101     for my $d (grep {/:status$/} @d) {
1102       delete $d{$d};
1103       $d =~ s/:status$//;
1104       my $s = readxml("$jobsdir/$a/$d:status", $BSXML::jobstatus, 1);
1105       print "bad job, no status: $d\n" if !$s;
1106       next unless $s;
1107       my $i;
1108       if (0) {
1109         $i = readxml("$jobsdir/$a/$d", $BSXML::buildinfo, 1);
1110       } else {
1111         # fake info from job name
1112         next unless $d{$d};     # no buildinfo
1113         my $jn = $d;
1114         $jn =~ s/-[0-9a-f]{32}$//s;
1115         my ($projid, $repoid, $packid) = split('::', $jn);
1116         $i = {'project' => $projid, 'repository' => $repoid, 'package' => $packid, 'arch' => $a};
1117       }
1118       print "bad job, no info: $d\n" if !$i;
1119       next unless $i;
1120       if ($s->{'code'} ne 'building') {
1121         delete $d{$d};
1122         next;
1123       }
1124       push @building, {'workerid' => $s->{'workerid'}, 'uri' => $s->{'uri'}, 'hostarch' => $s->{'hostarch'}, 'project' => $i->{'project'}, 'repository' => $i->{'repository'}, 'package' => $i->{'package'}, 'arch' => $i->{'arch'}, 'starttime' => $s->{'starttime'}};
1125       delete $d{$d};
1126     }
1127     push @waiting, {'arch' => $a, 'jobs' => scalar(keys %d)};
1128     my $si = readxml("$infodir/schedulerinfo.$a", $BSXML::schedulerinfo, 1);
1129     if ($si && defined($si->{'notready'})) {
1130       push @blocked, {'arch' => $a, 'jobs' => $si->{'notready'}};
1131     }
1132     if ($si && defined($si->{'buildavg'})) {
1133       push @buildaverage, {'arch' => $a, 'buildavg' => $si->{'buildavg'}};
1134     }
1135   }
1136   @idle = sort {$a->{'workerid'} cmp $b->{'workerid'} || $a->{'uri'} cmp $b->{'uri'} || $a cmp $b} @idle;
1137   @building = sort {$a->{'workerid'} cmp $b->{'workerid'} || $a->{'uri'} cmp $b->{'uri'} || $a cmp $b} @building;
1138   @waiting = sort {$a->{'arch'} cmp $b->{'arch'} || $a cmp $b} @waiting;
1139   @blocked = sort {$a->{'arch'} cmp $b->{'arch'} || $a cmp $b} @blocked;
1140   @buildaverage = sort {$a->{'arch'} cmp $b->{'arch'} || $a cmp $b} @buildaverage; 
1141
1142   my @scheddata;
1143   my @schedarchs = grep {s/^bs_sched\.(.*)\.lock$/$1/} sort(ls($rundir));
1144   push @schedarchs, 'dispatcher' if -e "$rundir/bs_dispatch.lock";
1145   push @schedarchs, 'publisher' if -e "$rundir/bs_publish.lock";
1146   push @schedarchs, 'signer' if -e "$rundir/bs_signer.lock";
1147   push @schedarchs, 'warden' if -e "$rundir/bs_warden.lock";
1148   @schedarchs = (@{$cgi->{'arch'}}) if $cgi->{'arch'};
1149   for my $schedarch (@schedarchs) {
1150     local *F;
1151     my $scheddata = {'arch' => $schedarch, 'state' => 'dead'};
1152     my $lock = "bs_sched.$schedarch.lock";
1153     $lock = 'bs_dispatch.lock' if $schedarch eq 'dispatcher';
1154     $lock = 'bs_publish.lock' if $schedarch eq 'publisher';
1155     $lock = 'bs_signer.lock' if $schedarch eq 'signer';
1156     $lock = 'bs_warden.lock' if $schedarch eq 'warden';
1157     if (open(F, '<', "$rundir/$lock")) {
1158       if (!flock(F, LOCK_EX | LOCK_NB)) {
1159         my @s = stat(F);
1160         $scheddata->{'state'} = 'running';
1161         $scheddata->{'starttime'} = $s[9] if @s;
1162       }
1163       close F;
1164     }
1165     my $si = readxml("$infodir/schedulerinfo.$schedarch", $BSXML::schedulerinfo, 1);
1166     if ($si) {
1167       $scheddata->{'queue'} = $si->{'queue'} if $si->{'queue'};
1168     }
1169     push @scheddata, $scheddata;
1170   }
1171
1172   my $ret = {};
1173   if (!$cgi->{'scheduleronly'}) {
1174     $ret->{'clients'} = @building + @idle;
1175     $ret->{'building'} = \@building;
1176     $ret->{'waiting'} = \@waiting;
1177     $ret->{'blocked'} = \@blocked;
1178     $ret->{'buildavg'} = \@buildaverage;
1179     $ret->{'idle'} = \@idle;
1180   }
1181   $ret->{'scheduler'} = \@scheddata;
1182   return ($ret, $BSXML::workerstatus);
1183 }
1184
1185 sub sendbadhostevent {
1186   my ($info, $idlename) = @_;
1187   my $ev = {
1188     'type' => 'badhost',
1189     'project' => $info->{'project'},
1190     'package' => $info->{'package'},
1191     'repository' => $info->{'repository'},
1192     'arch' => $info->{'arch'},
1193     'job' => $idlename,
1194   };
1195   my $evname = "badhost::$info->{'project'}::$info->{'package'}::$info->{'arch'}::$idlename";
1196   mkdir_p("$eventdir/dispatch");
1197   writexml("$eventdir/dispatch/.$evname", "$eventdir/dispatch/$evname", $ev, $BSXML::event);
1198 }
1199
1200 sub putjob {
1201   my ($cgi, $arch, $job, $jobid) = @_;
1202
1203   local *F;
1204   die("no such job\n") unless -e "$jobsdir/$arch/$job";
1205   die("job is not building\n") unless -e "$jobsdir/$arch/$job:status";
1206   my $jobstatus = BSUtil::lockopenxml(\*F, '<', "$jobsdir/$arch/$job:status", $BSXML::jobstatus);
1207   die("different jobid\n") if $jobstatus->{'jobid'} ne $jobid;
1208   die("job is not building\n") if $jobstatus->{'code'} ne 'building';
1209
1210   my $infoxml = readstr("$jobsdir/$arch/$job");
1211   my $infoxmlmd5 = Digest::MD5::md5_hex($infoxml);
1212   die("job info does not match\n") if $infoxmlmd5 ne $jobid;
1213
1214   my $info = readxml("$jobsdir/$arch/$job", $BSXML::buildinfo);
1215   my $projid = $info->{'project'} || $info->{'path'}->[0]->{'project'};
1216   my $repoid = $info->{'repository'} || $info->{'path'}->[0]->{'repository'};
1217
1218   my $now = time();
1219
1220   $jobstatus->{'code'} = 'built';
1221   $jobstatus->{'endtime'} = $now;
1222
1223   my $idlename = "$jobstatus->{'hostarch'}:$jobstatus->{'workerid'}";
1224   $idlename =~ s/\//_/g;
1225   print "oops, we are not building ($idlename)?\n" unless -e "$workersdir/building/$idlename";
1226   unlink("$workersdir/building/$idlename");
1227
1228   if ($cgi->{'code'} && $cgi->{'code'} eq 'badhost') {
1229     # turned out that this host couldn't build the job
1230     # rebuild on some other
1231     sendbadhostevent($info, $idlename);
1232     unlink("$jobsdir/$arch/$job:status");
1233     close(F);
1234     return $BSStdServer::return_ok;
1235   }
1236
1237   # check if worker time is "good enough"
1238   if ($cgi->{'now'} && ($cgi->{'now'} > $now + 3600 || $cgi->{'now'} < $now - 3600)) {
1239     sendbadhostevent($info, $idlename);
1240     unlink("$jobsdir/$arch/$job:status");
1241     close(F);
1242     die("time mismatch\n");
1243   }
1244
1245   # right job, fetch everything!
1246   my $dir = "$jobsdir/$arch/$job:dir";
1247   mkdir_p($dir);
1248   # uploaded is empty for local image building
1249   my $uploaded = BSServer::read_cpio($dir);
1250   $jobstatus->{'result'} = 'failed';
1251   # upload is empty for local image building
1252   if (!@$uploaded) {
1253     $jobstatus->{'result'} = $cgi->{'code'} || 'succeeded';
1254   }
1255   # usual build should have uploaded content.
1256   for my $file (@$uploaded) {
1257     next if $file->{'name'} eq 'meta' || $file->{'name'} eq 'logfile';
1258     $jobstatus->{'result'} = 'succeeded';
1259     last;
1260   }
1261
1262   if ($cgi->{'code'} && $cgi->{'code'} eq 'unchanged') {
1263     $jobstatus->{'result'} = 'unchanged';
1264     BSNotify::notify('BUILD_UNCHANGED', $info);
1265   } else {
1266     BSNotify::notify($jobstatus->{'result'} eq 'succeeded' ? 'BUILD_SUCCESS' :  'BUILD_FAIL', $info);
1267   }
1268
1269   # calculate binary info to speed up scheduler
1270   my $bininfo = {};
1271   for my $file (@$uploaded) {
1272     next unless $file->{'name'} =~ /\.(?:rpm|deb)$/;
1273     my @s = stat("$dir/$file->{'name'}");
1274     next unless @s;
1275     my $id = "$s[9]/$s[7]/$s[1]";
1276     my $data;
1277     eval {
1278       die("has no hdrmd5\n") unless Build::queryhdrmd5("$dir/$file->{'name'}");
1279       $data = Build::query("$dir/$file->{'name'}", 'evra' => 1);
1280       BSVerify::verify_nevraquery($data);
1281     };
1282     if ($@) {
1283       BSUtil::appendstr("$dir/logfile", "$file->{'name'}: $@");
1284       unlink("$dir/$file->{'name'}");
1285       $uploaded = [ grep {$_->{'name'} ne $file->{'name'}} @$uploaded ];
1286       $jobstatus->{'result'} = 'failed';
1287       next;
1288     }
1289     $bininfo->{$id} = $data;
1290   }
1291   BSUtil::store("$dir/.bininfo", undef, $bininfo) if %$bininfo;
1292
1293   # write build stats for dispatcher
1294   my @l = ($projid, $repoid, $arch, $info->{'package'}, $jobstatus->{'starttime'},  $jobstatus->{'endtime'}, $jobstatus->{'result'}, $jobstatus->{'workerid'}, $jobstatus->{'hostarch'});
1295   s/([\000-\037%|=\177-\237])/sprintf("%%%02X", ord($1))/ge for @l;
1296   BSUtil::appendstr("$jobsdir/finished", join('|', @l)."\n");
1297
1298   my $ev = {'type' => 'built', 'arch' => $arch, 'job' => $job};
1299
1300   if ($BSConfig::sign && grep {$_->{'name'} =~ /\.(?:d?rpm|sha256|iso)$/} (@$uploaded)) {
1301     # write jobstatus and free lock
1302     $jobstatus->{'code'} = 'signing';
1303     writexml("$jobsdir/$arch/.$job:status", "$jobsdir/$arch/$job:status", $jobstatus, $BSXML::jobstatus);
1304     close F;
1305
1306     mkdir_p("$eventdir/signer");
1307     writexml("$eventdir/signer/.finished:$arch:$job$$", "$eventdir/signer/finished:$arch:$job", $ev, $BSXML::event);
1308     ping('signer');
1309   } else {
1310     # write jobstatus and free lock
1311     $jobstatus->{'code'} = 'finished';
1312     writexml("$jobsdir/$arch/.$job:status", "$jobsdir/$arch/$job:status", $jobstatus, $BSXML::jobstatus);
1313     close F;
1314
1315     dirty($projid, $repoid, $arch);
1316     mkdir_p("$eventdir/$arch");
1317     writexml("$eventdir/$arch/.finished:$job$$", "$eventdir/$arch/finished:$job", $ev, $BSXML::event);
1318     ping($arch);
1319   }
1320
1321   return $BSStdServer::return_ok;
1322 }
1323
1324 sub getjobdata {
1325   my ($cgi, $arch, $job, $jobid) = @_;
1326   local *F;
1327   die("no such job\n") unless -e "$jobsdir/$arch/$job";
1328   die("job is not building\n") unless -e "$jobsdir/$arch/$job:status";
1329   my $jobstatus = BSUtil::lockopenxml(\*F, '<', "$jobsdir/$arch/$job:status", $BSXML::jobstatus);
1330   die("different jobid\n") if $jobstatus->{'jobid'} ne $jobid;
1331   die("job is not building\n") if $jobstatus->{'code'} ne 'building';
1332   my $dir = "$jobsdir/$arch/$job:dir";
1333   die("job has no jobdata\n") unless -d $dir;
1334   my @send;
1335   for my $file (grep {!/^\./} ls($dir)) {
1336     next unless -f "$dir/$file";
1337     push @send, {'name' => "$file", 'filename' => "$dir/$file"};
1338   }
1339   close F;      # XXX: too early?
1340   BSServer::reply_cpio(\@send);
1341   return undef;
1342 }
1343
1344 sub copybuild {
1345   my ($cgi, $projid, $repoid, $arch, $packid) = @_;
1346   my $oprojid = defined($cgi->{'oproject'}) ? $cgi->{'oproject'} : $projid;
1347   my $orepoid = defined($cgi->{'orepository'}) ? $cgi->{'orepository'} : $repoid;
1348   my $opackid = defined($cgi->{'opackage'}) ? $cgi->{'opackage'} : $packid;
1349   return $BSStdServer::return_ok if $oprojid eq $projid && $orepoid eq $repoid && $opackid eq $packid;
1350   my $job = "copy-".Digest::MD5::md5_hex("$$/$projid/$repoid/$arch/$packid".time());
1351   local *F;
1352   my $jobstatus = {
1353     'code' => 'finished',
1354   };
1355   mkdir_p("$jobsdir/$arch") unless -d "$jobsdir/$arch";
1356   if (!BSUtil::lockcreatexml(\*F, "$jobsdir/$arch/.$job", "$jobsdir/$arch/$job:status", $jobstatus, $BSXML::jobstatus)) {
1357     die("job lock failed\n");
1358   }
1359   my $dir = "$jobsdir/$arch/$job:dir";
1360   my $odir = "$reporoot/$oprojid/$orepoid/$arch/$opackid";
1361   mkdir_p($dir);
1362   for my $bin (grep {$_ ne 'status' && $_ ne 'reason' && $_ ne 'history' && !/^\./} ls($odir)) {
1363     if ($bin eq "updateinfo.xml" && $cgi->{'setupdateinfoid'}) {
1364       my $updateinfo = readxml("$odir/$bin", $BSXML::updateinfo);
1365       for (@{$updateinfo->{'update'} || []}) {
1366         $_->{'id'} = $cgi->{'setupdateinfoid'};
1367       }
1368       writexml("$dir/$bin", undef, $updateinfo, $BSXML::updateinfo);
1369     } else {
1370       link("$odir/$bin", "$dir/$bin") || die("link $odir/$bin $dir/$bin: $!\n");
1371     }
1372   }
1373   my $info = {
1374     'project' => $projid,
1375     'repository' => $repoid,
1376     'package' => $packid,
1377     'arch' => $arch,
1378     'job' => $job,
1379   };
1380   writexml("$jobsdir/$arch/.$job", "$jobsdir/$arch/$job", $info, $BSXML::buildinfo);
1381   dirty($projid, $repoid, $arch);
1382   mkdir_p("$eventdir/$arch");
1383   my $ev = {'type' => 'uploadbuild', 'job' => $job};
1384   writexml("$eventdir/$arch/.copybuild:$job$$", "$eventdir/$arch/copybuild:$job", $ev, $BSXML::event);
1385   ping($arch);
1386   return $BSStdServer::return_ok;
1387 }
1388
1389 sub uploadbuild {
1390   my ($cgi, $projid, $repoid, $arch, $packid) = @_;
1391   my $job = "upload-".Digest::MD5::md5_hex("$$/$projid/$repoid/$arch/$packid".time());
1392   local *F;
1393   my $jobstatus = {
1394     'code' => 'finished',
1395   };
1396   mkdir_p("$jobsdir/$arch") unless -d "$jobsdir/$arch";
1397   if (!BSUtil::lockcreatexml(\*F, "$jobsdir/$arch/.$job", "$jobsdir/$arch/$job:status", $jobstatus, $BSXML::jobstatus)) {
1398     die("job lock failed\n");
1399   }
1400   my $dir = "$jobsdir/$arch/$job:dir";
1401   mkdir_p($dir);
1402   my $uploaded = BSServer::read_cpio($dir);
1403   if (!$uploaded || !@$uploaded) {
1404     rmdir($dir);
1405     unlink("$jobsdir/$arch/$job:status");
1406     close F;
1407     die("upload failed\n");
1408   }
1409   my $info = {
1410     'project' => $projid,
1411     'repository' => $repoid,
1412     'package' => $packid,
1413     'arch' => $arch,
1414     'job' => $job,
1415   };
1416   writexml("$jobsdir/$arch/.$job", "$jobsdir/$arch/$job", $info, $BSXML::buildinfo);
1417   
1418   dirty($projid, $repoid, $arch);
1419   mkdir_p("$eventdir/$arch");
1420   my $ev = {'type' => 'uploadbuild', 'job' => $job};
1421   writexml("$eventdir/$arch/.uploadbuild:$job$$", "$eventdir/$arch/uploadbuild:$job", $ev, $BSXML::event);
1422   ping($arch);
1423   return $BSStdServer::return_ok;
1424 }
1425
1426 sub forwardevent {
1427   my ($cgi, $type, $projid, $packid, $repoid, $arch) = @_;
1428   my $ev = { type => $type, 'project' => $projid };
1429   my $evname = "$type:$projid";
1430   $ev->{'package'} = $packid if defined $packid;
1431   $evname .= "::$packid" if defined $packid;
1432   $ev->{'repository'} = $repoid if defined $repoid;
1433   $evname .= "::$repoid" if defined $repoid;
1434   mkdir_p("$eventdir/$arch") if $arch;
1435   # XXX: there should be a better way than to just write in all
1436   # directories... maybe a architecture list in BSConfig?
1437   my @archs = $arch ? ($arch) : ls($eventdir);
1438   for my $a (@archs) {
1439     next if $a =~ /^\./;
1440     next unless -d "$eventdir/$a";
1441     next if $a eq 'publish' || $a eq 'repository' || $a eq 'watch' || $a eq 'signer';
1442     dirty($projid, $repoid, $a);
1443     writexml("$eventdir/$a/.$evname", "$eventdir/$a/$evname", $ev, $BSXML::event);
1444     ping($a);
1445   }
1446   return $BSStdServer::return_ok;
1447 }
1448
1449 sub fixpackstatus {
1450   my ($prpa, $ps, $buildingjobs) = @_;
1451   return unless $ps && $ps->{'packstatus'};
1452   my $packstatus = $ps->{'packstatus'};
1453   $buildingjobs ||= {};
1454   my ($prp, $arch) = $prpa =~ /(.*)\/([^\/]*)$/;
1455   my $num = keys %$packstatus;
1456   my $logfiles_fail;
1457   for my $packid (keys %$packstatus) {
1458     $packstatus->{$packid} ||= 'unknown';
1459     # For old :packstatus files (before 2.0)
1460     if ($packstatus->{$packid} eq 'expansion error') {
1461       $packstatus->{$packid} = 'unresolvable';
1462     } elsif ($packstatus->{$packid} eq 'done') {
1463       if ($num > 10) {
1464         $logfiles_fail ||= { map {$_ => 1} ls("$reporoot/$prpa/:logfiles.fail") };
1465         $packstatus->{$packid} = $logfiles_fail->{$packid} ? 'failed' : 'succeeded';
1466       } else {
1467         if (-e "$reporoot/$prpa/:logfiles.fail/$packid") {
1468           $packstatus->{$packid} = 'failed';
1469         } else {
1470           $packstatus->{$packid} = 'succeeded';
1471         }
1472       }
1473     } elsif ($packstatus->{$packid} eq 'scheduled') {
1474       if (!$buildingjobs->{$arch}) {
1475         my $ba = {};
1476         for (grep {s/\:status$//} ls("$jobsdir/$arch")) {
1477           if (/^(.*)-[0-9a-f]{32}$/s) {
1478             $ba->{$1} = $_;
1479           } else {
1480             $ba->{$_} = $_;
1481           }
1482         }
1483         $buildingjobs->{$arch} = $ba;
1484       }
1485       my $job = jobname($prp, $packid);
1486       $job = $buildingjobs->{$arch}->{$job};
1487       if ($job) {
1488         my $js = readxml("$jobsdir/$arch/$job:status", $BSXML::jobstatus, 1);
1489         if ($js) {
1490           $packstatus->{$packid} = $js->{'code'};
1491           $ps->{'packerror'}->{$packid} = $js->{'details'} if $js->{'details'};
1492           $ps->{'packerror'}->{$packid} = "building on $js->{'workerid'}" if $js->{'code'} eq 'building';
1493         }
1494       }
1495     }
1496   }
1497 }
1498
1499 sub convertoldpackstatus {
1500   my ($prpa) = @_;
1501   my $ps = readxml("$reporoot/$prpa/:packstatus", $BSXML::packstatuslist, 1);
1502   return unless $ps;
1503   my %packstatus;
1504   my %packerror;
1505   for (@{$ps->{'packstatus'} || []}) {
1506     $packstatus{$_->{'name'}} = $_->{'status'};
1507     $packerror{$_->{'name'}} = $_->{'error'} if $_->{'error'};
1508   }
1509   return {'packstatus' => \%packstatus, 'packerror' => \%packerror};
1510 }
1511
1512 sub getresult {
1513   my ($cgi, $prpas) = @_;
1514   if ($cgi->{'oldstate'} && $BSStdServer::isajax) {
1515     for my $prpa (@$prpas) {
1516       BSWatcher::addfilewatcher("$reporoot/$prpa/:packstatus");
1517     }
1518   }
1519   my $r = [];
1520   my $state = '';
1521   my %packfilter = map {$_ => 1} @{$cgi->{'package'} || []};
1522   my %code = map {$_ => 1} @{$cgi->{'code'} || []};
1523   my %buildingjobs;
1524   for my $prpa (@$prpas) {
1525     my %sum;
1526     my ($projid, $repoid, $arch) = split('/', $prpa, 3);
1527     $state .= "$prpa\0\0";
1528     my $ps = BSUtil::retrieve("$reporoot/$prpa/:packstatus", 1);
1529     $ps ||= convertoldpackstatus($prpa);
1530     $ps ||= {'packstatus' => {}, 'packerror' => {}};
1531     if (%packfilter) {
1532       for (keys %{$ps->{'packstatus'} || {}}) {
1533         delete $ps->{'packstatus'}->{$_} unless $packfilter{$_};
1534       }
1535       for (keys %packfilter) {
1536         $ps->{'packststus'}->{$_} ||= 'unknown';
1537       }
1538     }
1539     my $schedulerstate = getschedulerstate($projid, $repoid, $arch);
1540     my $sl = {'project' => $projid, 'repository' => $repoid, 'arch' => $arch, 'state' => $schedulerstate };
1541     $sl->{'dirty'} = 'true' if -e "$reporoot/$prpa/:schedulerstate.dirty";
1542     $sl->{'dirty'} = 'true' if $schedulerstate eq 'scheduling'; # flag already removed, but new state not yet written
1543     fixpackstatus($prpa, $ps, \%buildingjobs);
1544     for my $packid (sort(keys %{$ps->{'packstatus'} || {}})) {
1545       my $code = $ps->{'packstatus'}->{$packid};
1546       if ($cgi->{'lastbuild'}) {
1547         if (-e "$reporoot/$prpa/:logfiles.fail/$packid") {
1548           $code = 'failed';
1549         } elsif (-e "$reporoot/$prpa/:logfiles.success/$packid") {
1550           $code = 'succeeded';
1551         } else {
1552           $code = 'unknown';
1553         }
1554       }
1555       next if %code && !$code{$code};
1556       $state .= "$packid\0$code\0";
1557       if ($cgi->{'summary'}) {
1558         $sum{$code} = ($sum{$code} || 0) + 1;
1559       } else {
1560         my $s = {'package' => $packid, 'code' => $code};
1561         $s->{'details'} = $ps->{'packerror'}->{$packid} if !$cgi->{'lastbuild'} && $ps->{'packerror'}->{$packid};
1562         push @{$sl->{'status'}}, $s;
1563       }
1564       if ($cgi->{'withbinarylist'}) {
1565         my @b;
1566         for (sort(ls("$reporoot/$prpa/$packid"))) {
1567           next if $_ eq 'logfile' || $_ eq 'status' || $_ eq 'reason' || $_ eq 'history' || /^\./;
1568           my @s = stat("$reporoot/$prpa/$packid/$_");
1569           next unless @s;
1570           next if -d _;
1571           push @b, {'filename' => $_, 'mtime' => $s[9], 'size' => $s[7]};
1572         }
1573         my $bl = {'package' => $packid, 'binary' => \@b};
1574         push @{$sl->{'binarylist'}}, $bl;
1575       }
1576     }
1577     if ($cgi->{'summary'}) {
1578       my @order = ('succeeded', 'failed', 'unresolvable', 'broken', 'scheduled');
1579       my %order = map {$_ => 1} @order;
1580       my @sum = grep {exists $sum{$_}} @order;
1581       push @sum, grep {!$order{$_}} sort keys %sum;
1582       $sl->{'summary'} = {'statuscount' => [ map {{'code' => $_, 'count' => $sum{$_}}} @sum ] };
1583     }
1584     push @$r, $sl;
1585   }
1586   $state = Digest::MD5::md5_hex($state);
1587   if ($cgi->{'oldstate'} && $state eq $cgi->{'oldstate'}) {
1588     return if $BSStdServer::isajax;     # watcher will call us back...
1589     my @args = map {"prpa=$_"} @{$prpas || []};
1590     push @args, "oldstate=$cgi->{'oldstate'}";
1591     push @args, map {"package=$_"} @{$cgi->{'package'} || []};
1592     push @args, map {"code=$_"} @{$cgi->{'code'} || []};
1593     push @args, "withbinarylist=1" if $cgi->{'withbinarylist'};
1594     BSHandoff::handoff($ajaxsocket, '/_result', undef, @args);
1595     exit(0);
1596   }
1597   return ({'result' => $r, 'state' => $state}, $BSXML::resultlist);
1598 }
1599
1600 sub docommand {
1601   my ($cgi, $cmd, $prpas) = @_;
1602   my %code = map {$_ => 1} @{$cgi->{'code'} || []};
1603   my %buildingjobs;
1604   for my $prpa (@$prpas) {
1605     my ($projid, $repoid, $arch) = split('/', $prpa);
1606     my @packids = @{$cgi->{'package'} || []};
1607     my $allpacks;
1608     if (@packids && $packids[0] eq '*') {
1609       shift @packids;
1610       $allpacks = 1;
1611     }
1612     if (%code) {
1613       my $ps = BSUtil::retrieve("$reporoot/$prpa/:packstatus", 1);
1614       $ps ||= convertoldpackstatus($prpa);
1615       fixpackstatus($prpa, $ps, \%buildingjobs);
1616       @packids = grep {$code{$ps->{'packstatus'}->{$_} || 'unknown'}} @packids;
1617     }
1618     if ($cmd eq 'rebuild') {
1619       for my $packid (@packids) {
1620         unlink("$reporoot/$projid/$repoid/$arch/:meta/$packid");
1621         my $ev = { type => 'rebuild', 'project' => $projid, 'package' => $packid };
1622         my $evname = "rebuild:${projid}::$packid";
1623         if (-d "$eventdir/$arch") {
1624           writexml("$eventdir/$arch/.$evname", "$eventdir/$arch/$evname", $ev, $BSXML::event);
1625         }
1626       }
1627       dirty($projid, $repoid, $arch);
1628       ping($arch);
1629     } elsif ($cmd eq 'killbuild' || $cmd eq 'abortbuild') {
1630       for my $packid (@packids) {
1631         eval {
1632           abortbuild($cgi, $projid, $repoid, $arch, $packid);
1633         };
1634         warn("$@") if $@;
1635       }
1636     } elsif ($cmd eq 'restartbuild') {
1637       for my $packid (@packids) {
1638         eval {
1639           restartbuild($cgi, $projid, $repoid, $arch, $packid);
1640         };
1641         warn("$@") if $@;
1642       }
1643     } elsif ($cmd eq 'wipe') {
1644       undef $allpacks;
1645       if ($allpacks) {
1646         forwardevent($cgi, 'wipe', $projid, undef, $repoid, $arch);
1647       } else {
1648         for my $packid (@packids) {
1649           forwardevent($cgi, 'wipe', $projid, $packid, $repoid, $arch);
1650         }
1651       }
1652     }
1653   }
1654   return $BSStdServer::return_ok;
1655 }
1656
1657 sub getjobhistory {
1658   my ($cgi, $projid, $repoid, $arch) = @_;
1659   my $filter;
1660   if ($cgi->{'code'} && @{$cgi->{'code'}} == 1 && $cgi->{'code'}->[0] eq 'lastfailures') {
1661     # report last success/unchanged and all fails for earch package
1662     my %success;
1663     if ($cgi->{'package'}) {
1664       my %packid = map {$_ => 1} @{$cgi->{'package'}};
1665       $filter = sub {
1666         return 0 unless $packid{$_[0]->{'package'}};
1667         return 1 unless $_[0]->{'code'} eq 'succeeded' || $_[0]->{'code'} eq 'unchanged';
1668         delete $packid{$_[0]->{'package'}};
1669         return %packid ? 1 : -1;
1670       };
1671     } else {
1672       $filter = sub {
1673         return 0 if $success{$_[0]->{'package'}};
1674         $success{$_[0]->{'package'}} = 1 if $_[0]->{'code'} eq 'succeeded' || $_[0]->{'code'} eq 'unchanged';
1675         return 1;
1676       };
1677     }
1678     my @hist = BSFileDB::fdb_getall_reverse("$reporoot/$projid/$repoid/$arch/:jobhistory", $BSXML::jobhistlay, undef, $filter);
1679     @hist = reverse @hist;
1680     my $ret = {jobhist => \@hist};
1681     return ($ret, $BSXML::jobhistlist);
1682   }
1683   if ($cgi->{'package'} && $cgi->{'code'}) {
1684     my %packid = map {$_ => 1} @{$cgi->{'package'}};
1685     my %code = map {$_ => 1} @{$cgi->{'code'}};
1686     $filter = sub {$packid{$_[0]->{'package'}} && $code{$_[0]->{'code'}}};
1687   } elsif ($cgi->{'package'}) {
1688     my %packid = map {$_ => 1} @{$cgi->{'package'}};
1689     $filter = sub {$packid{$_[0]->{'package'}}};
1690   } elsif ($cgi->{'code'}) {
1691     my %code = map {$_ => 1} @{$cgi->{'code'}};
1692     $filter = sub {$code{$_[0]->{'code'}}};
1693   }
1694   my @hist = BSFileDB::fdb_getall_reverse("$reporoot/$projid/$repoid/$arch/:jobhistory", $BSXML::jobhistlay, $cgi->{'limit'} || 100, $filter);
1695   @hist = reverse @hist;
1696   my $ret = {jobhist => \@hist};
1697   return ($ret, $BSXML::jobhistlist);
1698 }
1699
1700 sub getkiwiproductpackages {
1701   my ($proj, $repo, $pdata, $info, $deps) = @_;
1702
1703   my @got;
1704   my %imagearch = map {$_ => 1} @{$info->{'imagearch'} || []};
1705   my @archs = grep {$imagearch{$_}} @{$repo->{'arch'} || []};
1706   die("no architectures to use for packages\n") unless @archs;
1707   my @deps = @{$deps || []};
1708   my %deps = map {$_ => 1} @deps;
1709   delete $deps{''};
1710   my @aprps = map {"$_->{'project'}/$_->{'repository'}"} @{$info->{'path'} || []}; 
1711   my $allpacks = $deps{'*'} ? 1 : 0; 
1712   for my $aprp (@aprps) {
1713     my %known;
1714     my ($aprojid, $arepoid) = split('/', $aprp, 2);
1715     for my $arch (@archs) {
1716       my $depends = BSUtil::retrieve("$reporoot/$aprp/$arch/:depends", 1);
1717       next unless $depends && $depends->{'subpacks'};
1718       my %apackids = (%{$depends->{'subpacks'} || {}}, %{$depends->{'pkgdeps'}});
1719       my @apackids = sort keys %apackids;
1720       for my $apackid (@apackids) {
1721         if (!$allpacks && $depends->{'subpacks'}->{$apackid}) {
1722           next unless grep {$deps{$_}} @{$depends->{'subpacks'}->{$apackid} || []};
1723         }
1724         # need package, scan content
1725         my @bins;
1726         if (-e "$reporoot/$aprp/$arch/$apackid/.bininfo") {
1727           @bins = map {substr($_, 34)} split("\n", readstr("$reporoot/$aprp/$arch/$apackid/.bininfo"));
1728         } else {
1729           @bins = grep {/\.rpm$/} ls ("$reporoot/$aprp/$arch/$apackid");
1730         }
1731         my $needit;
1732         for my $b (@bins) {
1733           next unless $b =~ /^(.+)-[^-]+-[^-]+\.([a-zA-Z][^\.\-]*)\.rpm$/;
1734           next unless $deps{$1} || ($allpacks && !$deps{"-$1"});
1735           $needit = 1;
1736           last;
1737         }
1738         next unless $needit;
1739         for my $b (@bins) {
1740           next unless $b =~ /^(.+)-[^-]+-[^-]+\.([a-zA-Z][^\.\-]*)\.rpm$/;
1741           push @got, "$aprp/$arch/$apackid/$b";
1742         }
1743       }
1744     }
1745   }
1746   return @got;
1747 }
1748
1749 sub getbuildinfo {
1750   my ($cgi, $projid, $repoid, $arch, $packid, $pdata) = @_;
1751   my $projpack;
1752   my $uploaded;
1753   if (!$pdata) {
1754     $projpack = BSRPC::rpc("$BSConfig::srcserver/getprojpack", $BSXML::projpack, 'withsrcmd5', 'withdeps', 'withrepos', 'expandedrepos', 'withremotemap', 'ignoredisable', "project=$projid", "repository=$repoid", "arch=$arch", "package=$packid");
1755     die("404 no such project/package/repository\n") unless $projpack->{'project'};
1756   } else {
1757     $projpack = BSRPC::rpc("$BSConfig::srcserver/getprojpack", $BSXML::projpack, 'withrepos', 'expandedrepos', 'withremotemap', "project=$projid", "repository=$repoid", "arch=$arch", defined($packid) ? "package=$packid" : ());
1758     die("404 no such project/repository\n") unless $projpack->{'project'};
1759     $uploaded = 1;
1760   }
1761   my %remotemap = map {$_->{'project'} => $_} @{$projpack->{'remotemap'} || []};
1762   my $proj = $projpack->{'project'}->[0];
1763   die("no such project\n") unless $proj && $proj->{'name'} eq $projid;
1764   my $repo = $proj->{'repository'}->[0];
1765   die("no such repository\n") unless $repo && $repo->{'name'} eq $repoid;
1766   if (!$pdata) {
1767     $pdata = $proj->{'package'}->[0];
1768     die("no such package\n") unless $pdata && $pdata->{'name'} eq $packid;
1769     die("$pdata->{'error'}\n") if $pdata->{'error'};
1770   }
1771
1772   my $info = $pdata->{'info'}->[0];
1773   die("bad info\n") unless $info && $info->{'repository'} eq $repoid;
1774
1775   my $packtype = 'spec';
1776   $packtype = $1 if $info->{'file'} && $info->{'file'} =~ /\.(spec|dsc|kiwi)$/;
1777
1778   my @configpath;
1779   my $kiwitype;
1780   if ($packtype eq 'kiwi') {
1781     if (@{$info->{'path'} || []}) {
1782       my $pp = BSRPC::rpc("$BSConfig::srcserver/getprojpack", $BSXML::projpack, 'withremotemap', 'nopackages', map {"project=$_->{'project'}"} @{$info->{'path'}});
1783       %remotemap = (%remotemap, map {$_->{'project'} => $_} @{$pp->{'remotemap'} || []});
1784     }
1785     if ($info->{'imagetype'} && $info->{'imagetype'}->[0] eq 'product') {
1786       $kiwitype = 'product';
1787     } else {
1788       $kiwitype = 'image';
1789     }
1790     # a repo with no path will expand to just the prp as the only element
1791     if ($kiwitype eq 'image' || @{$repo->{'path'} || []} < 2) {
1792       @configpath = map {"path=$_->{'project'}/$_->{'repository'}"} @{$info->{'path'} || []};
1793       unshift @configpath, "path=$projid/$repoid" unless @configpath;
1794     }
1795   }
1796   my $config = BSRPC::rpc("$BSConfig::srcserver/getconfig", undef, "project=$projid", "repository=$repoid", @configpath);
1797   my $bconf = Build::read_config($arch, [split("\n", $config)]);
1798
1799   my $ret;
1800   $ret->{'project'} = $projid;
1801   $ret->{'repository'} = $repoid;
1802   $ret->{'package'} = $packid if defined $packid;
1803   $ret->{'downloadurl'} = $BSConfig::repodownload if defined $BSConfig::repodownload;;
1804   $ret->{'arch'} = $arch;
1805   $ret->{'path'} = $repo->{'path'} || [];
1806   my @prp = map {"$_->{'project'}/$_->{'repository'}"} @{$repo->{'path'} || []};
1807   if ($packtype eq 'kiwi') {
1808     $ret->{'imagetype'} = $info->{'imagetype'} || [];
1809     if (@prp < 2) {
1810       $ret->{'path'} = $info->{'path'} || [];
1811     } else {
1812       push @{$ret->{'path'}}, @{$info->{'path'} || []}; # XXX: should unify
1813     }
1814     if ($kiwitype eq 'image' || @{$repo->{'path'} || []} < 2) {
1815       @prp = map {"$_->{'project'}/$_->{'repository'}"} @{$info->{'path'} || []};
1816     }
1817   }
1818   if ($cgi->{'internal'}) {
1819     for (@{$ret->{'path'}}) {
1820       if ($remotemap{$_->{'project'}}) {
1821         $_->{'server'} = $BSConfig::srcserver;
1822       } else {
1823         $_->{'server'} = $BSConfig::reposerver;
1824       }
1825     }
1826   }
1827   $ret->{'srcmd5'} = $pdata->{'srcmd5'} if $pdata->{'srcmd5'};
1828   $ret->{'verifymd5'} = $pdata->{'verifymd5'} || $pdata->{'srcmd5'} if $pdata->{'verifymd5'} || $pdata->{'srcmd5'};
1829   $ret->{'rev'} = $pdata->{'rev'} if $pdata->{'rev'};
1830   if ($pdata->{'error'}) {
1831     $ret->{'error'} = $pdata->{'error'};
1832     return ($ret, $BSXML::buildinfo);
1833   }
1834   my $debuginfo = BSUtil::enabled($repoid, $proj->{'debuginfo'}, undef, $arch);
1835   $debuginfo = BSUtil::enabled($repoid, $proj->{'package'}->[0]->{'debuginfo'}, $debuginfo, $arch) if defined($packid);
1836   $ret->{'debuginfo'} = $debuginfo ? 1 : 0;
1837
1838   if (defined($packid) && exists($pdata->{'versrel'})) {
1839     $ret->{'versrel'} = $pdata->{'versrel'};
1840     my $h = BSFileDB::fdb_getmatch("$reporoot/$projid/$repoid/$arch/$packid/history", $historylay, 'versrel', $pdata->{'versrel'}, 1);
1841     $h = {'bcnt' => 0} unless $h;
1842     $ret->{'bcnt'} = $h->{'bcnt'} + 1;
1843     my $release = $ret->{'versrel'};
1844     $release =~ s/.*-//;
1845     if (exists($bconf->{'release'})) {
1846       if (defined($bconf->{'release'})) {
1847         $ret->{'release'} = $bconf->{'release'};
1848         $ret->{'release'} =~ s/\<CI_CNT\>/$release/g;
1849         $ret->{'release'} =~ s/\<B_CNT\>/$ret->{'bcnt'}/g;
1850       }
1851     } else {
1852       $ret->{'release'} = "$release.".$ret->{'bcnt'};
1853     }
1854   }
1855
1856   if ($info->{'error'}) {
1857     $ret->{'error'} = $info->{'error'};
1858     return ($ret, $BSXML::buildinfo);
1859   }
1860   $ret->{'specfile'} = $info->{'file'} unless $uploaded;
1861   $ret->{'file'} = $info->{'file'} unless $uploaded;
1862
1863   my $pool = BSSolv::pool->new();
1864   $pool->settype('deb') if $bconf->{'type'} eq 'dsc';
1865
1866   if ($pdata->{'ldepfile'}) {
1867     # have local deps, add them to pool
1868     my $data = {};
1869     Build::readdeps({ %$bconf }, $data, $pdata->{'ldepfile'});
1870     my $r = $pool->repofromdata('', $data);
1871     die("ldepfile repo add failed\n") unless $r;
1872   }
1873
1874   for my $prp (@prp) {
1875     my ($rprojid, $rrepoid) = split('/', $prp, 2);
1876     my $r;
1877     if ($remotemap{$rprojid}) {
1878       $r = addrepo_remote($pool, $prp, $arch, $remotemap{$rprojid});
1879     } else {
1880       $r = addrepo_scan($pool, $prp, $arch);
1881     }
1882     die("repository $prp not available\n") unless $r;
1883   }
1884
1885   $pool->createwhatprovides();
1886   my %dep2pkg;
1887   my %dep2src;
1888   for my $p ($pool->consideredpackages()) {
1889     my $n = $pool->pkg2name($p);
1890     $dep2pkg{$n} = $p;
1891     $dep2src{$n} = $pool->pkg2srcname($p);
1892   }
1893   my $pname = $info->{'name'};
1894   my @subpacks = grep {defined($dep2src{$_}) && $dep2src{$_} eq $pname} keys %dep2src;
1895   if ($info->{'subpacks'}) {
1896     $ret->{'subpack'} = $info->{'subpacks'};
1897   } elsif (@subpacks) {
1898     $ret->{'subpack'} = [ @subpacks ];
1899   }
1900   my @deps = ( @{$info->{'dep'} || []}, @{$info->{'prereq'} || []} );
1901
1902   # expand deps
1903   $Build::expand_dbg = 1 if $cgi->{'debug'};
1904   @subpacks = () if $packtype eq 'kiwi';
1905   my @edeps;
1906   if ($packtype eq 'kiwi' && $kiwitype eq 'product') {
1907     @edeps = (1, @deps);
1908   } elsif ($packtype eq 'kiwi') {
1909     my $bconfignore = $bconf->{'ignore'};
1910     my $bconfignoreh = $bconf->{'ignoreh'};
1911     delete $bconf->{'ignore'};
1912     delete $bconf->{'ignoreh'};
1913     my $xp = BSSolv::expander->new($pool, $bconf);
1914     my $ownexpand = sub {
1915       $_[0] = $xp;
1916       goto &BSSolv::expander::expand;
1917     };
1918     no warnings 'redefine';
1919     local *Build::expand = $ownexpand;
1920     use warnings 'redefine';
1921     @edeps = Build::get_deps($bconf, \@subpacks, @deps);
1922     $bconf->{'ignore'} = $bconfignore if $bconfignore;
1923     $bconf->{'ignoreh'} = $bconfignoreh if $bconfignoreh;
1924   } else {
1925     my $xp = BSSolv::expander->new($pool, $bconf);
1926     my $ownexpand = sub {
1927       $_[0] = $xp;
1928       goto &BSSolv::expander::expand;
1929     };
1930     no warnings 'redefine';
1931     local *Build::expand = $ownexpand;
1932     use warnings 'redefine';
1933     @edeps = Build::get_deps($bconf, \@subpacks, @deps);
1934   }
1935   undef $Build::expand_dbg if $cgi->{'debug'};
1936   if (! shift @edeps) {
1937     $ret->{'error'} = "unresolvable: ".join(', ', @edeps);
1938     return ($ret, $BSXML::buildinfo);
1939   }
1940   if ($packtype eq 'kiwi') {
1941     # packages used for build environment
1942     @deps = ('kiwi');
1943     push @deps, 'createrepo', 'tar' if $kiwitype ne 'product';
1944     push @deps, grep {/^kiwi-.*:/} @{$info->{'dep'} || []};
1945   }
1946
1947   my $epool;
1948   if ($packtype eq 'kiwi' && $kiwitype eq 'image' && @{$repo->{'path'} || []} >= 2) {
1949     # use different path for system setup
1950     my $config = BSRPC::rpc("$BSConfig::srcserver/getconfig", undef, "project=$projid", "repository=$repoid");
1951     $bconf = Build::read_config($arch, [split("\n", $config)]);
1952     @prp = map {"$_->{'project'}/$_->{'repository'}"} @{$repo->{'path'} || []};
1953     $epool = $pool;
1954     $pool = BSSolv::pool->new();
1955     $pool->settype('deb') if $bconf->{'type'} eq 'dsc';
1956     for my $prp (@prp) {
1957       my ($rprojid, $rrepoid) = split('/', $prp, 2);
1958       my $r;
1959       if ($remotemap{$rprojid}) {
1960         $r = addrepo_remote($pool, $prp, $arch, $remotemap{$rprojid});
1961       } else {
1962         $r = addrepo_scan($pool, $prp, $arch);
1963       }
1964       die("repository $prp not available\n") unless $r;
1965     }
1966     $pool->createwhatprovides();
1967   }
1968
1969   my @bdeps;
1970   $Build::expand_dbg = 1 if $cgi->{'debug'};
1971   my $xp = BSSolv::expander->new($pool, $bconf);
1972   my $ownexpand = sub {
1973     $_[0] = $xp;
1974     goto &BSSolv::expander::expand;
1975   };
1976   no warnings 'redefine';
1977   local *Build::expand = $ownexpand;
1978   use warnings 'redefine';
1979   if (!$cgi->{'deps'}) {
1980     @bdeps = Build::get_build($bconf, \@subpacks, @deps, @{$cgi->{'add'} || []});
1981   } else {
1982     @bdeps = Build::get_deps($bconf, \@subpacks, @deps, @{$cgi->{'add'} || []});
1983   }
1984   undef $xp;
1985   undef $Build::expand_dbg if $cgi->{'debug'};
1986   if (! shift @bdeps) {
1987     $ret->{'error'} = "unresolvable: ".join(', ', @bdeps);
1988     return ($ret, $BSXML::buildinfo);
1989   }
1990
1991   my @pdeps = Build::get_preinstalls($bconf);
1992   my @vmdeps = Build::get_vminstalls($bconf);
1993   my @cbpdeps = Build::get_cbpreinstalls($bconf); # crossbuild preinstall
1994   my @cbdeps = Build::get_cbinstalls($bconf);  # crossbuild install
1995   my %runscripts = map {$_ => 1} Build::get_runscripts($bconf);
1996   my %bdeps = map {$_ => 1} @bdeps;
1997   my %pdeps = map {$_ => 1} @pdeps;
1998   my %vmdeps = map {$_ => 1} @vmdeps;
1999   my %cbpdeps = map {$_ => 1} @cbpdeps;
2000   my %cbdeps = map {$_ => 1} @cbdeps;
2001   my %edeps = map {$_ => 1} @edeps;
2002
2003   if ($packtype eq 'kiwi' && $kiwitype eq 'product') {
2004     # things are very different here. first we have the packages needed for kiwi
2005     # from the full tree
2006     @bdeps = unify(@pdeps, @vmdeps, @bdeps);
2007     for (splice(@bdeps)) {
2008       my $b = {'name' => $_};
2009       my $p = $dep2pkg{$_};
2010       if (!$cgi->{'internal'}) {
2011         my $prp = $pool->pkg2reponame($p);
2012         ($b->{'project'}, $b->{'repository'}) = split('/', $prp) if $prp ne '';
2013       }
2014       my $d = $pool->pkg2data($p);
2015       $b->{'epoch'} = $d->{'epoch'} if $d->{'epoch'};
2016       $b->{'version'} = $d->{'version'};
2017       $b->{'release'} = $d->{'release'} if exists $d->{'release'};
2018       $b->{'arch'} = $d->{'arch'} if $d->{'arch'};
2019       $b->{'notmeta'} = 1;
2020       $b->{'preinstall'} = 1 if $pdeps{$_};
2021       $b->{'vminstall'} = 1 if $vmdeps{$_};
2022       $b->{'runscripts'} = 1 if $runscripts{$_};
2023       push @bdeps, $b;
2024     }
2025
2026     # now the binaries from the packages
2027     my @bins = getkiwiproductpackages($proj, $repo, $pdata, $info, \@edeps);
2028     for my $b (@bins) {
2029       my @bn = split('/', $b);
2030       next unless $bn[-1] =~ /^(.+)-([^-]+)-([^-]+)\.([a-zA-Z][^\.\-]*)\.rpm$/;
2031       my $d = {'name' => $1, 'version' => $2, 'release' => $3, 'arch' => $4, 'project' => $bn[0], 'repository' => $bn[1], 'package' => $bn[3]};
2032       $d->{'repoarch'} = $bn[2] if $bn[2] ne $arch;
2033       $d->{'noinstall'} = 1;
2034       push @bdeps, $d;
2035     }
2036     if ($info->{'extrasource'}) {
2037       push @bdeps, map {{
2038         'name' => $_->{'file'}, 'version' => '', 'repoarch' => $_->{'arch'}, 'arch' => 'src',
2039         'project' => $_->{'project'}, 'package' => $_->{'package'}, 'srcmd5' => $_->{'srcmd5'},
2040       }} @{$info->{'extrasource'}};
2041     }
2042     $ret->{'bdep'} = \@bdeps;
2043     return ($ret, $BSXML::buildinfo);
2044   }
2045   if ($packtype eq 'kiwi' && $kiwitype eq 'image') {
2046     my @rdeps;
2047     if ($epool) {
2048       my %allnames;
2049       for my $repo ($epool->repos()) {
2050         my %names = $repo->pkgnames();
2051         for (keys %names) {
2052           next unless $edeps{$_};
2053           push @{$allnames{$_}}, $names{$_};
2054         }
2055       }
2056       for (@edeps) {
2057         for my $p (@{$allnames{$_} || []}) {
2058           my $b = {'name' => $_};
2059           if (!$cgi->{'internal'}) {
2060             my $prp = $epool->pkg2reponame($p);
2061             ($b->{'project'}, $b->{'repository'}) = split('/', $prp) if $prp ne '';
2062           }
2063           my $d = $epool->pkg2data($p);
2064           $b->{'epoch'} = $d->{'epoch'} if $d->{'epoch'};
2065           $b->{'version'} = $d->{'version'};
2066           $b->{'release'} = $d->{'release'} if exists $d->{'release'};
2067           $b->{'arch'} = $d->{'arch'} if $d->{'arch'};
2068           $b->{'noinstall'} = 1;
2069           push @rdeps, $b;
2070           next;
2071         }
2072       }
2073       @edeps = ();
2074       %edeps = ();
2075       %dep2pkg = ();
2076     }
2077     # kiwi images take the binaries from all repos
2078     my %allnames;
2079     for my $repo ($pool->repos()) {
2080       my %names = $repo->pkgnames();
2081       for (keys %names) {
2082         next unless $edeps{$_};
2083         push @{$allnames{$_}}, $names{$_};
2084       }
2085     }
2086     for my $p ($pool->consideredpackages()) {
2087       my $n = $pool->pkg2name($p);
2088       next if $edeps{$n};
2089       push @{$allnames{$n}}, $p;
2090       $dep2pkg{$n} = $p;
2091     }
2092     @bdeps = unify(@pdeps, @vmdeps, @edeps, @bdeps, @cbpdeps, @cbdeps);
2093     for (@bdeps) {
2094       for my $p (@{$allnames{$_} || []}) {
2095         my $b = {'name' => $_};
2096         if (!$cgi->{'internal'}) {
2097           my $prp = $pool->pkg2reponame($p);
2098           ($b->{'project'}, $b->{'repository'}) = split('/', $prp) if $prp ne '';
2099         }
2100         my $d = $pool->pkg2data($p);
2101         $b->{'epoch'} = $d->{'epoch'} if $d->{'epoch'};
2102         $b->{'version'} = $d->{'version'};
2103         $b->{'release'} = $d->{'release'} if exists $d->{'release'};
2104         $b->{'arch'} = $d->{'arch'} if $d->{'arch'};
2105         $b->{'notmeta'} = 1 unless $edeps{$_};
2106         if ($p != $dep2pkg{$_}) {
2107           $b->{'noinstall'} = 1;
2108           push @rdeps, $b;
2109           next;
2110         }
2111         $b->{'preinstall'} = 1 if $pdeps{$_};
2112         $b->{'vminstall'} = 1 if $vmdeps{$_};
2113         $b->{'runscripts'} = 1 if $runscripts{$_};
2114         $b->{'noinstall'} = 1 if $edeps{$_} && !($bdeps{$_} || $vmdeps{$_} || $pdeps{$_});
2115         push @rdeps, $b;
2116       }
2117     }
2118     $ret->{'bdep'} = \@rdeps;
2119     return ($ret, $BSXML::buildinfo);
2120   }
2121
2122   @bdeps = unify(@pdeps, @vmdeps, @edeps, @bdeps, @cbpdeps, @cbdeps);
2123   for (@bdeps) {
2124     my $b = {'name' => $_};
2125     my $p = $dep2pkg{$_};
2126     if (!$cgi->{'internal'}) {
2127       my $prp = $pool->pkg2reponame($p);
2128       ($b->{'project'}, $b->{'repository'}) = split('/', $prp) if $prp ne '';
2129     }
2130     my $d = $pool->pkg2data($p);
2131     $b->{'epoch'} = $d->{'epoch'} if $d->{'epoch'};
2132     $b->{'version'} = $d->{'version'};
2133     $b->{'release'} = $d->{'release'} if exists $d->{'release'};
2134     $b->{'arch'} = $d->{'arch'} if $d->{'arch'};
2135     $b->{'preinstall'} = 1 if $pdeps{$_};
2136     $b->{'vminstall'} = 1 if $vmdeps{$_};
2137     $b->{'cbpreinstall'} = 1 if $cbpdeps{$_};
2138     $b->{'cbinstall'} = 1 if $cbdeps{$_};
2139     $b->{'runscripts'} = 1 if $runscripts{$_};
2140     $b->{'notmeta'} = 1 unless $edeps{$_};
2141     $b->{'noinstall'} = 1 if $packtype eq 'kiwi' && $edeps{$_} && !($bdeps{$_} || $vmdeps{$_} || $pdeps{$_});
2142     $_ = $b;
2143   }
2144
2145   # add extra source (needed for kiwi)
2146   # ADRIAN: is it not enough to do this for product only above ?
2147   if ($info->{'extrasource'}) {
2148     push @bdeps, map {{
2149       'name' => $_->{'file'}, 'version' => '', 'repoarch' => $_->{'arch'}, 'arch' => 'src',
2150       'project' => $_->{'project'}, 'package' => $_->{'package'}, 'srcmd5' => $_->{'srcmd5'},
2151     }} @{$info->{'extrasource'}};
2152   }
2153
2154   $ret->{'bdep'} = \@bdeps;
2155   return ($ret, $BSXML::buildinfo);
2156 }
2157
2158 sub getbuildinfo_post {
2159   my ($cgi, $projid, $repoid, $arch, $packid) = @_;
2160
2161   undef $packid if $packid eq '_repository';
2162   my $config = BSRPC::rpc("$BSConfig::srcserver/getconfig", undef, "project=$projid", "repository=$repoid");
2163   my $bconf = Build::read_config($arch, [split("\n", $config)]);
2164
2165   my $fn = "$uploaddir/$$";
2166   my $descr = $fn;
2167   my $dir = "$uploaddir/$$.dir";
2168   my $depfile;
2169   mkdir_p($uploaddir);
2170   die("upload failed\n") unless BSServer::read_file($fn);
2171
2172   local *F;
2173   open(F, '<', "$fn") || die("$fn: $!\n");
2174   my $magic;
2175   sysread(F, $magic, 6);
2176   if ($magic eq "070701") {
2177     sysseek(F, 0, 0);
2178     mkdir_p($dir);
2179     my $uploaded = BSHTTP::cpio_receiver(BSHTTP::fd2hdr(\*F), {'directory' => $dir});
2180     # should we check if the cpio archive contains <= 2 files?
2181     ($depfile) = map { $_->{'name'} =~ /(deps)/ } @$uploaded;
2182     $depfile = "$dir/$depfile" if defined $depfile;
2183     $descr = (grep { $_->{'name'} ne "deps" } @$uploaded)[0];
2184     die("no spec/dsc/kiwi file found\n") unless $descr;
2185     $descr = "$dir/$descr->{'name'}";
2186   }
2187   close(F);
2188   my $d;
2189   my $info = {'repository' => $repoid};
2190   if ($bconf->{'type'} eq 'dsc') {
2191     $d = Build::Deb::parse($bconf, $descr);
2192     $info->{'file'} = 'upload.dsc';
2193   } elsif ($bconf->{'type'} eq 'kiwi') {
2194     $d = Build::Kiwi::parse($bconf, $descr);
2195     $info->{'imagetype'} = $d->{'imagetype'};
2196     $info->{'imagearch'} = $d->{'exclarch'} if $d->{'exclarch'};
2197     $info->{'path'} = $d->{'path'};
2198     $info->{'file'} = 'upload.kiwi';
2199   } elsif ($bconf->{'type'} eq 'spec') {
2200     $d = Build::Rpm::parse($bconf, $descr);
2201     $info->{'file'} = 'upload.spec';
2202   } else {
2203     die("unknown repository type $bconf->{'type'}\n");
2204   }
2205   unlink($fn);
2206   unless (defined $d->{'name'}) {
2207     unlink("$dir/$_") for ls($dir);
2208     rmdir($dir) if -d $dir;
2209     die("could not parse build description (spec/dsc/kiwi)\n");
2210   }
2211   $info->{'name'} = $d->{'name'};
2212   $info->{'dep'} = $d->{'deps'};
2213   $info->{'subpacks'} = $d->{'subpacks'};
2214   if ($d->{'prereqs'}) {
2215     my %deps = map {$_ => 1} (@{$d->{'deps'} || []}, @{$d->{'subpacks'} || []});
2216     my @prereqs = grep {!$deps{$_} && !/^%/} @{$d->{'prereqs'}};
2217     $info->{'prereq'} = \@prereqs if @prereqs;
2218   }
2219   my $pdata = {'info' => [ $info ]};
2220   $pdata->{'ldepfile'} = $depfile if defined $depfile;
2221
2222   my @r;
2223   eval {
2224     @r = getbuildinfo($cgi, $projid, $repoid, $arch, $packid, $pdata);
2225   };
2226   unlink("$dir/$_") for ls($dir);
2227   rmdir($dir) if -d $dir;
2228   die("$@\n") if $@;
2229   return @r;
2230 }
2231
2232 sub getbuilddepinfo {
2233   my ($cgi, $projid, $repoid, $arch) = @_;
2234   my %packids = map {$_ => 1} @{$cgi->{'package'} || []};
2235   my $view = $cgi->{'view'} || '';
2236   my $depends = BSUtil::retrieve("$reporoot/$projid/$repoid/$arch/:depends", 1);
2237   return ({'package' => []}, $BSXML::builddepinfo) unless $depends;
2238   my $subpacks = $depends->{'subpacks'} || {};
2239   my $pkgdeps = $depends->{'pkgdeps'} || {};
2240   my $pkg2src = $depends->{'pkg2src'} || {};
2241   my %subpack2pack;
2242   if ($view eq 'pkgnames' || $view eq 'revpkgnames') {
2243     for my $packid (sort keys %$pkg2src) {
2244       my $n = $pkg2src->{$packid} || $packid;
2245       if ($subpacks->{$n} && @{$subpacks->{$n}}) {
2246         push @{$subpack2pack{$_}}, $packid for @{$subpacks->{$n}};
2247       } else {
2248         push @{$subpack2pack{$n}}, $packid;
2249       }
2250     }
2251     if ($view eq 'revpkgnames') {
2252       my %rdeps;
2253       for my $packid (sort keys %$pkg2src) {
2254         my $deps = $pkgdeps->{$packid} || []; 
2255         $deps = [ map {@{$subpack2pack{$_} || []}} @$deps ];
2256         for (@$deps) {
2257           push @{$rdeps{$_}}, $packid;
2258         }
2259       }
2260       $pkgdeps = \%rdeps;
2261     }
2262   }
2263   my @res;
2264   for my $packid (sort keys %$pkg2src) {
2265     next if %packids && !$packids{$packid};
2266     my $n = $pkg2src->{$packid};
2267     my @sp = sort @{$subpacks->{$n} || []};
2268     push @sp, $n unless @sp;
2269     if ($n ne $sp[0] && (grep {$_ eq $n} @sp)) {
2270       @sp = grep {$_ ne $n} @sp;
2271       unshift @sp, $n;
2272     }
2273     my $deps = $pkgdeps->{$packid} || [];
2274     $deps = [ map {@{$subpack2pack{$_} || []}} @$deps ] if $view eq 'pkgnames';
2275     $deps = [ sort(unify(@$deps)) ] if $view eq 'pkgnames' || $view eq 'revpkgnames';
2276     push @res, {'name' => $packid, 
2277         'source' => $n,
2278         'pkgdep' => $deps,
2279         'subpkg' => \@sp,
2280     };
2281   }
2282   my @cycles = map {{'package' => $_}} @{$depends->{'cycles'} || []};
2283   my $res = { 'package' => \@res, };
2284   $res->{'cycle'} = \@cycles if @cycles;
2285   return ($res, $BSXML::builddepinfo);
2286 }
2287
2288 ### FIXME: read status instead!
2289 sub findjob {
2290   my ($projid, $repoid, $arch, $packid) = @_;
2291
2292   my $prp = "$projid/$repoid";
2293   my $job = jobname($prp, $packid);
2294   my @jobdatadirs = grep {$_ eq "$job:status" || /^\Q$job\E-[0-9a-f]{32}:status$/} ls("$jobsdir/$arch");
2295   return undef unless @jobdatadirs;
2296   $job = $jobdatadirs[0];
2297   $job =~ s/:status$//;
2298   return $job;
2299 }
2300
2301 sub restartbuild {
2302   my ($cgi, $projid, $repoid, $arch, $packid) = @_;
2303
2304   my $job = findjob($projid, $repoid, $arch, $packid);
2305   die("not building\n") unless $job;
2306
2307   local *F;
2308   my $js = BSUtil::lockopenxml(\*F, '<', "$jobsdir/$arch/$job:status", $BSXML::jobstatus);
2309   die("not building\n") if $js->{'code'} ne 'building';
2310   my $req = {
2311     'uri' => "$js->{'uri'}/discard",
2312     'timeout' => 30,
2313   };
2314   eval {
2315     BSRPC::rpc($req, undef, "jobid=$js->{'jobid'}");
2316   };
2317   warn($@) if $@;
2318   unlink("$jobsdir/$arch/$job:status");
2319   close F;
2320   return $BSStdServer::return_ok;
2321 }
2322
2323 sub abortbuild {
2324   my ($cgi, $projid, $repoid, $arch, $packid) = @_;
2325
2326   my $job = findjob($projid, $repoid, $arch, $packid);
2327   die("not building\n") unless $job;
2328   local *F;
2329   my $js = BSUtil::lockopenxml(\*F, '<', "$jobsdir/$arch/$job:status", $BSXML::jobstatus);
2330   die("not building\n") if $js->{'code'} ne 'building';
2331   my $req = {
2332     'uri' => "$js->{'uri'}/kill",
2333     'timeout' => 30,
2334   };
2335   BSRPC::rpc($req, undef, "jobid=$js->{'jobid'}");
2336   return $BSStdServer::return_ok;
2337 }
2338
2339 #
2340 # if there is a qemu dir in OBS backend install dir workers load qemu from OBS backend server
2341 # this is similiar to the rest of build script code
2342 # if that does also not exist, workers copy qemu from worker local installed qemu
2343 #
2344 sub getqemuinterpreters {
2345   my @send;
2346
2347   if (-d "qemu") {
2348       for my $file (grep {!/^\./} ls("qemu")) {
2349           next unless -f "qemu/$file";
2350           push @send, {'name' => "$file", 'filename' => "qemu/$file"};
2351       }
2352   }
2353   return @send;
2354 }
2355
2356 sub getcode {
2357   my ($cgi, $dir) = @_;
2358   my @send;
2359   push @send, getqemuinterpreters() if $dir eq 'build';
2360   for my $file (grep {!/^\./} ls($dir)) {
2361     if ($file eq 'Build' && -d "$dir/$file") {
2362       for my $file2 (grep {!/^\./} ls("$dir/Build")) {
2363         push @send, {'name' => "$file2", 'filename' => "$dir/Build/$file2"};
2364       }
2365     }
2366     next unless -f "$dir/$file";
2367     push @send, {'name' => "$file", 'filename' => "$dir/$file"};
2368   }
2369   die("$dir is empty\n") unless @send;
2370   BSServer::reply_cpio(\@send);
2371   return undef;
2372 }
2373
2374 sub getbuildcode {
2375   my ($cgi) = @_;
2376   return getcode($cgi, 'build');
2377 }
2378
2379 sub getworkercode {
2380   my ($cgi) = @_;
2381   return getcode($cgi, 'worker');
2382 }
2383
2384 sub postrepo {
2385   my ($cgi, $projid, $repoid, $arch) = @_;
2386
2387   my $projpack = BSRPC::rpc("$BSConfig::srcserver/getprojpack", $BSXML::projpack, 'withrepos', 'expandedrepos', "project=$projid", "repository=$repoid", "arch=$arch");
2388   my $proj = $projpack->{'project'}->[0];
2389   die("no such project\n") unless $proj && $proj->{'name'} eq $projid;
2390   my $repo = $proj->{'repository'}->[0];
2391   die("no such repository\n") unless $repo && $repo->{'name'} eq $repoid;
2392   my @prp = map {"$_->{'project'}/$_->{'repository'}"} @{$repo->{'path'} || []};
2393   my $pool = BSSolv::pool->new();
2394   for my $prp (@prp) {
2395     addrepo_scan($pool, $prp, $arch);
2396   }
2397   $pool->createwhatprovides();
2398   my %data;
2399   for my $p ($pool->consideredpackages()) {
2400     my $d = $pool->pkg2data($p);
2401     $data{$d->{'name'}} = $d;
2402   }
2403   undef $pool;
2404   my @data;
2405   for (sort keys %data) {
2406     push @data, $data{$_};
2407     $data[-1]->{'_content'} = $data[-1]->{'name'};
2408   }
2409   my $match = $cgi->{'match'};
2410   $match = "[$match]" unless $match =~ /^[\.\/]?\[/;
2411   $match = ".$match" if $match =~ /^\[/;
2412   my $v = BSXPath::valuematch(\@data, $match);
2413   return {'value' => $v}, $BSXML::collection;
2414 }
2415
2416 my %prp_to_repoinfo;
2417
2418 sub prp_to_repoinfo {
2419   my ($prp) = @_;
2420
2421   my $repoinfo = $prp_to_repoinfo{$prp};
2422   if (!$repoinfo) {
2423     if (-s "$reporoot/$prp/:repoinfo") {
2424       $repoinfo = BSUtil::retrieve("$reporoot/$prp/:repoinfo");
2425       for (@{$repoinfo->{'prpsearchpath'} || []}) {
2426         next if ref($_);        # legacy
2427         my ($p, $r) = split('/', $_, 2);
2428         $_ = {'project' => $p, 'repository' => $r};
2429       }
2430     } else {
2431       $repoinfo = {'binaryorigins' => {}};
2432     }
2433     $prp_to_repoinfo{$prp} = $repoinfo;
2434   }
2435   return $repoinfo;
2436 }
2437
2438 sub binary_key_to_data {
2439   my ($db, $key) = @_; 
2440   my @p = split('/', $key);
2441   my $binary = pop(@p);
2442   my $name = $binary;
2443   my $version = '';
2444   if ($name =~ s/-([^-]+-[^-]+)\.[^\.]+\.rpm$//) {
2445     $version = $1;
2446   } elsif ($name =~ s/_([^_]+)_[^_]+\.deb$//) {
2447     $version = $1;
2448   }
2449   my $arch = pop(@p);
2450   while (@p > 1 && $p[0] =~ /:$/) {
2451     splice(@p, 0, 2, "$p[0]$p[1]");
2452   }
2453   my $project = shift(@p);
2454   while (@p > 1 && $p[0] =~ /:$/) {
2455     splice(@p, 0, 2, "$p[0]$p[1]");
2456   }
2457   my $repository = shift(@p);
2458   my $prp = "$project/$repository";
2459   my $repoinfo = $prp_to_repoinfo{$prp} || prp_to_repoinfo($prp);
2460   my $type;
2461   $type = 'rpm' if $binary =~ /\.rpm$/;
2462   $type = 'deb' if $binary =~ /\.deb$/;
2463   my $res = {
2464     'name' => $name,
2465     'version' => $version,
2466     'arch' => $arch,
2467     'type' => $type,
2468     'project' => $project,
2469     'repository' => $repository,
2470     'filename' => $binary,
2471     'filepath' => $key,
2472   };
2473   $res->{'path'} = $repoinfo->{'prpsearchpath'} if $repoinfo->{'prpsearchpath'};
2474   $res->{'package'} = $repoinfo->{'binaryorigins'}->{"$arch/$binary"} if defined $repoinfo->{'binaryorigins'}->{"$arch/$binary"};
2475   $res->{'baseproject'} = $res->{'path'}->[-1]->{'project'} if $res->{'path'};
2476   return $res;
2477 }
2478
2479 sub pattern_key_to_data {
2480   my ($db, $key) = @_; 
2481   my @p = split('/', $key);
2482   my $filename = pop(@p);
2483   while (@p > 1 && $p[0] =~ /:$/) {
2484     splice(@p, 0, 2, "$p[0]$p[1]");
2485   }
2486   my $project = shift(@p);
2487   while (@p > 1 && $p[0] =~ /:$/) {
2488     splice(@p, 0, 2, "$p[0]$p[1]");
2489   }
2490   my $repository = shift(@p);
2491   my @v = BSDBIndex::getvalues($db, $db->{'table'}, $key);
2492   return {} unless @v;
2493   my $res = $v[0];
2494   $res->{'baseproject'} = $res->{'path'}->[-1]->{'project'} if $res->{'path'};
2495   $res->{'project'} = $project;
2496   $res->{'repository'} = $repository;
2497   $res->{'filename'} = $filename;
2498   $res->{'filepath'} = $key;
2499   return $res;
2500 }
2501
2502 sub search_published_binary_id {
2503   my ($cgi, $match) = @_;
2504   my $binarydb = BSDB::opendb($extrepodb, 'binary');
2505   $binarydb->{'allkeyspath'} = 'name';
2506   $binarydb->{'noindex'} = {'arch' => 1, 'project' => 1, 'repository' => 1, 'package' => 1, 'type' => 1, 'path/project' => 1, 'path/repository' => 1};
2507   $binarydb->{'fetch'} = \&binary_key_to_data;
2508   $binarydb->{'cheapfetch'} = 1;
2509   my $rootnode = BSXPathKeys::node($binarydb, '');
2510   my $data = BSXPath::match($rootnode, $match) || [];
2511   # epoch?
2512   @$data = sort {Build::Rpm::verscmp($b->{'version'}, $a->{'version'}) || $a->{'name'} cmp $b->{'name'} || $a->{'arch'} cmp $b->{'arch'}} @$data;
2513   delete $_->{'path'} for @$data;
2514   my $res = {'binary' => $data};
2515   return ($res, $BSXML::collection);
2516 }
2517
2518 sub search_published_pattern_id {
2519   my ($cgi, $match) = @_;
2520   my $patterndb = BSDB::opendb($extrepodb, 'pattern');
2521   $patterndb->{'noindex'} = {'project' => 1, 'repository' => 1};
2522   $patterndb->{'fetch'} = \&pattern_key_to_data;
2523   my $rootnode = BSXPathKeys::node($patterndb, '');
2524   my $data = BSXPath::match($rootnode, $match) || [];
2525   for (@$data) {
2526     delete $_->{'path'};
2527     delete $_->{'description'};
2528     delete $_->{'summary'};
2529   }
2530   my $res = {'pattern' => $data};
2531   return ($res, $BSXML::collection);
2532 }
2533
2534 sub listpublished {
2535   my ($dir, $fileok) = @_;
2536   my @r;
2537   for my $d (ls($dir)) {
2538     if ($fileok && -f "$dir/$d") {
2539       push @r, $d;
2540       next;
2541     }
2542     next unless -d "$dir/$d";
2543     if ($d =~ /:$/) {
2544       my $dd = $d;
2545       chop $dd;
2546       push @r, map {"$dd:$_"} listpublished("$dir/$d");
2547     } else {
2548       push @r, $d;
2549     }
2550   }
2551   return @r;
2552 }
2553
2554 sub findympbinary {
2555   my ($binarydir, $binaryname) = @_;
2556   for my $b (ls($binarydir)) {
2557     next unless $b =~ /\.(?:rpm|deb)$/;
2558     next unless $b =~ /^\Q$binaryname\E/;
2559     my $data = Build::query("$binarydir/$b", 'evra' => 1);
2560     if ($data->{'name'} eq $binaryname || "$data->{'name'}-$data->{'version'}" eq $binaryname) {
2561       return "$binarydir/$b";
2562     }
2563   }
2564   return undef;
2565 }
2566
2567 sub publisheddir {
2568   my ($cgi, $projid, $repoid, $arch) = @_;
2569   my @res = ();
2570   if (!defined($projid)) {
2571     @res = listpublished($extrepodir);
2572   } elsif (!defined($repoid)) {
2573     my $prp_ext = $projid;
2574     $prp_ext =~ s/:/:\//g;
2575     @res = listpublished("$extrepodir/$prp_ext");
2576   } elsif (!defined($arch)) {
2577     my $prp_ext = "$projid/$repoid";
2578     $prp_ext =~ s/:/:\//g;
2579     @res = listpublished("$extrepodir/$prp_ext", 1);
2580   } else {
2581     my $prp_ext = "$projid/$repoid";
2582     $prp_ext =~ s/:/:\//g;
2583     if ($cgi->{'view'} eq 'ymp') {
2584       my $binaryname = $arch;
2585       my $binary;
2586       my @archs = ls("$extrepodir/$prp_ext");
2587       for my $a (@archs) {
2588         next unless -d "$extrepodir/$prp_ext/$a";
2589         $binary = findympbinary("$extrepodir/$prp_ext/$a", $binaryname);
2590         last if $binary;
2591       }
2592       $binary ||= "$extrepodir/$prp_ext/$binaryname";
2593       return makeymp($projid, $repoid, $binary);
2594     }
2595     return publishedfile($cgi, $projid, $repoid, undef, $arch) if -f "$extrepodir/$prp_ext/$arch";
2596     @res = ls("$extrepodir/$prp_ext/$arch");
2597   }
2598   @res = sort @res;
2599   @res = map {{'name' => $_}} @res;
2600   return ({'entry' => \@res}, $BSXML::dir);
2601 }
2602
2603 sub makeymp {
2604   my ($projid, $repoid, $binary) = @_;
2605
2606   my $binaryname;
2607   my $data;
2608   if ($binary =~ /(?:^|\/)([^\/]+)-[^-]+-[^-]+\.[a-zA-Z][^\/\.\-]*\.rpm$/) {
2609     $binaryname = $1;
2610   } elsif ($binary =~ /(?:^|\/)([^\/]+)_([^\/]*)_[^\/]*\.deb$/) {
2611     $binaryname = $1;
2612   } elsif ($binary =~ /(?:^|\/)([^\/]+)\.(?:rpm|deb)$/) {
2613     $binaryname = $1;
2614   } else {
2615     my $binarydir;
2616     ($binarydir, $binaryname) = $binary =~ /^(.*)\/([^\/]*)$/;
2617     $binary = findympbinary($binarydir, $binaryname) || $binary;
2618   }
2619   $data = Build::query($binary, 'description' => 1);
2620   #die("no such binary\n") unless $data;
2621   my $projpack = BSRPC::rpc("$BSConfig::srcserver/getprojpack", $BSXML::projpack, 'withrepos', 'expandedrepos', 'nopackages', "project=$projid", "repository=$repoid");
2622   my $proj = $projpack->{'project'}->[0];
2623   die("no such project\n") unless $proj && $proj->{'name'} eq $projid;
2624   my $repo = $proj->{'repository'}->[0];
2625   die("no such repository\n") unless $repo && $repo->{'name'} eq $repoid;
2626   my @nprojids = grep {$_ ne $projid} map {$_->{'project'}} @{$repo->{'path'} || []};
2627   my %nprojpack;
2628   if (@nprojids) {
2629     my @args = map {"project=$_"} @nprojids;
2630     my $nprojpack = BSRPC::rpc("$BSConfig::srcserver/getprojpack", $BSXML::projpack, 'nopackages', @args);
2631     %nprojpack = map {$_->{'name'} => $_} @{$nprojpack->{'project'} || []};
2632   }
2633   my $ymp = {};
2634   $ymp->{'xmlns:os'} = 'http://opensuse.org/Standards/One_Click_Install';
2635   $ymp->{'xmlns'} = 'http://opensuse.org/Standards/One_Click_Install';
2636   my @group;
2637   $ymp->{'group'} = \@group;
2638   my @repos;
2639   my @pa = @{$repo->{'path'} || []};
2640   while (@pa) {
2641     my $pa = shift @pa;
2642     my $r = {};
2643     $r->{'recommended'} = @pa || !@repos ? 'true' : 'false';
2644     $r->{'name'} = $pa->{'project'};
2645     if ($pa->{'project'} eq $projid) {
2646       $r->{'summary'} = $proj->{'title'};
2647       $r->{'description'} = $proj->{'description'};
2648     } elsif ($nprojpack{$pa->{'project'}}) {
2649       $r->{'summary'} = $nprojpack{$pa->{'project'}}->{'title'};
2650       $r->{'description'} = $nprojpack{$pa->{'project'}}->{'description'};
2651     }
2652     my $prp_ext = "$pa->{'project'}/$pa->{'repository'}";
2653     if ($BSConfig::prp_ext_map && $BSConfig::prp_ext_map->{$prp_ext}) {
2654       $r->{'url'} = $BSConfig::prp_ext_map->{$prp_ext};
2655     } else {
2656       $prp_ext =~ s/:/:\//g;
2657       $r->{'url'} = "$BSConfig::repodownload/$prp_ext/";
2658     }
2659     push @repos, $r;
2660   }
2661   my $pkg = {};
2662   if ($data) {
2663     $pkg->{'name'} = str2utf8xml($data->{'name'});
2664     $pkg->{'description'} = str2utf8xml($data->{'description'});
2665   } else {
2666     $pkg->{'name'} = str2utf8xml($binaryname);
2667     $pkg->{'description'} = "The $pkg->{'name'} package";
2668   }
2669   if (defined $data->{'summary'}) {
2670     $pkg->{'summary'} = str2utf8xml($data->{'summary'});
2671   } else {
2672     $pkg->{'summary'} = "The $pkg->{'name'} package";
2673   }
2674   my $inner_group = {};
2675   $inner_group->{'repositories'} = {'repository' => \@repos };
2676   $inner_group->{'software'} = {'item' => [$pkg]};
2677   push @group, $inner_group;
2678   my $ympxml = XMLout($BSXML::ymp, $ymp);
2679   return ($ympxml, "Content-Type: text/x-suse-ymp");
2680 }
2681
2682 sub fileinfo {
2683   my ($cgi, $filepath, $filename) = @_;
2684   my $res = {'filename' => $filename};
2685   my $q = {};
2686   die("filename: $!\n") unless -f $filepath;
2687   if ($filename =~ /\.(?:rpm|deb)$/) {
2688     $q = Build::query($filepath, 'evra' => 1, 'description' => 1, 'alldeps' => 1);
2689     data2utf8xml($q);
2690   } elsif ($filename =~ /\.ymp$/) {
2691     my $ymp = readxml($filepath, $BSXML::ymp, 1);
2692
2693     if ($ymp) {
2694       my $g0 = $ymp->{'group'}[0];
2695       $q->{'name'} = $g0->{'name'} if defined $g0->{'name'};
2696       $q->{'summary'} = $g0->{'summary'} if defined $g0->{'summary'};
2697       $q->{'description'} = $g0->{'description'} if defined $g0->{'description'};
2698       if ($g0->{'repositories'}) {
2699         $q->{'recommends'} = [ map {$_->{'name'}} grep {$_->{'recommended'} && $_->{'recommended'} eq 'true'} @{$g0->{'packages'}->{'package'} || []} ];
2700         $q->{'suggests'} = [ map {$_->{'name'}} grep {!($_->{'recommended'} && $_->{'recommended'} eq 'true')} @{$g0->{'packages'}->{'package'} || []} ];
2701         delete $q->{'recommends'} unless @{$q->{'recommends'}};
2702         delete $q->{'suggests'} unless @{$q->{'suggests'}};
2703       }
2704     }
2705   }
2706   for (qw{name epoch version release arch summary description provides requires recommends suggests}) {
2707     $res->{$_} = $q->{$_} if defined $q->{$_};
2708   }
2709   return ($res, $BSXML::fileinfo);
2710 }
2711
2712 sub publishedfile {
2713   my ($cgi, $projid, $repoid, $arch, $filename) = @_;
2714   my $prp_ext = "$projid/$repoid";
2715   $prp_ext .= "/$arch" if defined $arch;
2716   $prp_ext =~ s/:/:\//g;
2717   if ($cgi->{'view'} && $cgi->{'view'} eq 'ymp') {
2718     return makeymp($projid, $repoid, "$extrepodir/$prp_ext/$filename");
2719   }
2720   die("no such file\n") unless -f "$extrepodir/$prp_ext/$filename";
2721   if ($cgi->{'view'} && $cgi->{'view'} eq 'fileinfo') {
2722     return fileinfo($cgi, "$extrepodir/$prp_ext/$filename", $filename);
2723   }
2724   my $type = 'application/octet-stream';
2725   $type = 'application/x-rpm' if $filename=~ /\.rpm$/;
2726   $type = 'application/x-debian-package' if $filename=~ /\.deb$/;
2727   $type = 'text/xml' if $filename=~ /\.xml$/;
2728   BSServer::reply_file("$extrepodir/$prp_ext/$filename", "Content-Type: $type");
2729   return undef;
2730 }
2731
2732 sub getrelsync {
2733   my ($cgi, $projid, $repoid, $arch) = @_;
2734   my $prp = "$projid/$repoid";
2735   my $relsyncdata = readstr("$reporoot/$prp/$arch/:relsync");
2736   return ($relsyncdata, 'Content-Type: application/octet-stream');
2737 }
2738
2739 sub postrelsync {
2740   my ($cgi, $projid, $repoid, $arch) = @_;
2741   my $prp = "$projid/$repoid";
2742
2743   my $newdata = BSServer::read_data(10000000);
2744   my $new = Storable::thaw(substr($newdata, 4));
2745   die("no data\n") unless $new;
2746
2747   local *F;
2748   BSUtil::lockopen(\*F, '+>>', "$reporoot/$prp/$arch/:relsync.max");
2749   my $relsyncmax;
2750   if (-s "$reporoot/$prp/$arch/:relsync.max") {
2751     $relsyncmax = BSUtil::retrieve("$reporoot/$prp/$arch/:relsync.max", 2);
2752   }
2753   $relsyncmax ||= {};
2754   my $changed;
2755   for my $packid (keys %$new) {
2756     if ($packid =~ /\//) {
2757       next if defined($relsyncmax->{$packid}) && $relsyncmax->{$packid} >= $new->{$packid};
2758       $relsyncmax->{$packid} = $new->{$packid};
2759     } else {
2760       next unless $new->{$packid} =~ /^(.*)\.([^-]*)$/;
2761       next if defined($relsyncmax->{"$packid/$1"}) && $relsyncmax->{"$packid/$1"} >= $2;
2762       $relsyncmax->{"$packid/$1"} = $2;
2763     }
2764     $changed = 1;
2765   }
2766   BSUtil::store("$reporoot/$prp/$arch/:relsync.max.new", "$reporoot/$prp/$arch/:relsync.max", $relsyncmax) if $changed;
2767   close(F);
2768
2769   if ($changed) {
2770     forwardevent($cgi, 'relsync', $projid, undef, $repoid, $arch);
2771   }
2772   return $BSStdServer::return_ok;
2773 }
2774
2775 sub putdispatchprios {
2776   my ($cgi) = @_;
2777   mkdir_p($uploaddir);
2778   die("upload failed\n") unless BSServer::read_file("$uploaddir/dispatchprios.$$");
2779   my $prios = readxml("$uploaddir/dispatchprios.$$", $BSXML::dispatchprios);
2780   unlink("$uploaddir/dispatchprios.$$");
2781   mkdir_p($jobsdir);
2782   BSUtil::store("$jobsdir/.dispatchprios", "$jobsdir/dispatchprios", $prios);
2783   return $BSStdServer::return_ok;
2784 }
2785
2786 sub getdispatchprios {
2787   my $prios = BSUtil::retrieve("$jobsdir/dispatchprios", 1) || {};
2788   return ($prios, $BSXML::dispatchprios);
2789 }
2790
2791 sub getajaxstatus {
2792   my ($cgi) = @_;
2793   if (!$BSStdServer::isajax) {
2794     BSHandoff::handoff($ajaxsocket, '/ajaxstatus');
2795     exit(0);
2796   }
2797   my $r = BSWatcher::getstatus();
2798   return ($r, $BSXML::ajaxstatus);
2799 }
2800
2801 sub hello {
2802   my ($cgi) = @_;
2803   return "<hello name=\"Package Repository Ajax Server\" />\n" if $BSStdServer::isajax;
2804   return "<hello name=\"Package Repository Server\" />\n";
2805 }
2806
2807 my $dispatches = [
2808   '/' => \&hello,
2809
2810   '!rw :' => undef,
2811   '!- GET:' => undef,
2812   '!- HEAD:' => undef,
2813
2814   'POST:/build/$project/$repository/$arch/_repository match:' => \&postrepo,
2815   '/build/$project/$repository/$arch/_builddepinfo package* view:?' => \&getbuilddepinfo,
2816   '/build/$project/$repository/$arch/_jobhistory package* code:* limit:num?' => \&getjobhistory,
2817   'POST:/build/$project/$repository/$arch/_relsync' => \&postrelsync,
2818   '/build/$project/$repository/$arch/_relsync' => \&getrelsync,
2819   'POST:/build/$project/$repository/$arch/$package cmd=copy oproject:project? opackage:package? orepository:repository? setupdateinfoid:?' => \&copybuild,
2820   'POST:/build/$project/$repository/$arch/$package' => \&uploadbuild,
2821   '!worker,rw /build/$project/$repository/$arch/$package:package_repository view:? binary:filename* nometa:bool? noajax:bool?' => \&getbinarylist,
2822   'POST:/build/$project/$repository/$arch/$package_repository/_buildinfo add:* internal:bool? debug:bool? deps:bool?' => \&getbuildinfo_post,
2823   '/build/$project/$repository/$arch/$package/_buildinfo add:* internal:bool? debug:bool? deps:bool?' => \&getbuildinfo,
2824   '/build/$project/$repository/$arch/$package/_reason' => \&getbuildreason,
2825   '/build/$project/$repository/$arch/$package/_status' => \&getbuildstatus,
2826   '/build/$project/$repository/$arch/$package/_history limit:num?' => \&getbuildhistory,
2827   '/build/$project/$repository/$arch/$package/_log nostream:bool? start:intnum? end:num? handoff:bool? view:?' => \&getlogfile,
2828   '/build/$project/$repository/$arch/$package:package_repository/$filename view:?' => \&getbinary,
2829   'PUT:/build/$project/$repository/$arch/_repository/$filename ignoreolder:bool? wipe:bool?' => \&putbinary,
2830   'DELETE:/build/$project/$repository/$arch/_repository/$filename' => \&delbinary,
2831   '/search/published/binary/id $match:' => \&search_published_binary_id,
2832   '/search/published/pattern/id $match:' => \&search_published_pattern_id,
2833   'PUT:/build/_dispatchprios' => \&putdispatchprios,
2834   '/build/_dispatchprios' => \&getdispatchprios,
2835
2836   # src server calls
2837   'POST:/event $type: $project $package?' => \&forwardevent,
2838
2839   # worker calls
2840   '!worker /worker $arch $port $state: workerid:? working:bool? memory:num? disk:num? buildarch:arch* tellnojob:bool?' => \&workerstate,
2841   '!worker /getbuildcode' => \&getbuildcode,
2842   '!worker /getworkercode' => \&getworkercode,
2843   '!worker POST:/putjob $arch $job $jobid:md5 $code:? now:num?' => \&putjob,
2844   '!worker /getbinaries $project $repository $arch binaries: nometa:bool?' => \&getbinaries,
2845   '!worker /getbinaryversions $project $repository $arch binaries: nometa:bool?' => \&getbinaryversions,
2846   '!worker /getjobdata $arch $job $jobid:md5' => \&getjobdata,
2847
2848   # published files
2849   '/published' => \&publisheddir,
2850   '/published/$project' => \&publisheddir,
2851   '/published/$project/$repository' => \&publisheddir,
2852   '/published/$project/$repository/$arch:filename view:?' => \&publisheddir,
2853   '/published/$project/$repository/$arch:filename/$filename view:?' => \&publishedfile,
2854
2855   # info
2856   '/workerstatus scheduleronly:bool? arch*' => \&workerstatus,
2857
2858   '/_result $prpa+ oldstate:md5? package* code:* lastbuild:bool? withbinarylist:bool? summary:bool?' => \&getresult,
2859   'POST:/_command $cmd: $prpa+ package* code:*' => \&docommand,
2860
2861   '/serverstatus' => \&BSStdServer::serverstatus,
2862   '/ajaxstatus' => \&getajaxstatus,
2863 ];
2864
2865 my $dispatches_ajax = [
2866   '/' => \&hello,
2867   '/ajaxstatus' => \&getajaxstatus,
2868   '/build/$project/$repository/$arch/$package/_log nostream:bool? start:intnum? end:num? view:?' => \&getlogfile,
2869   '/build/$project/$repository/$arch/$package:package_repository view:? binary:filename*' => \&getbinarylist,
2870   '/build/$project/$repository/$arch/$package:package_repository/$filename view:?' => \&getbinary,
2871   '/_result $prpa+ oldstate:md5? package* code:* withbinarylist:bool? summary:bool?' => \&getresult,
2872   '/getbinaries $project $repository $arch binaries: nometa:bool?' => \&getbinaries,
2873   '/getbinaryversions $project $repository $arch binaries: nometa:bool?' => \&getbinaryversions,
2874 ];
2875
2876 my $conf = {
2877   'port' => $port,
2878   'dispatches' => $dispatches,
2879   'setkeepalive' => 1, 
2880   'maxchild' => 20,
2881 };
2882
2883 my $aconf = {
2884   'socketpath' => $ajaxsocket,
2885   'dispatches' => $dispatches_ajax,
2886   'getrequest_timeout' => 10,
2887   'replrequest_timeout' => 10, 
2888   'getrequest_recvfd' => \&BSHandoff::receive,
2889   'setkeepalive' => 1,
2890 };
2891
2892 BSStdServer::server('bs_repserver', \@ARGV, $conf, $aconf);