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