- also use _reverse function for normal jobhistory queries
[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_reverse("$reporoot/$projid/$repoid/$arch/:jobhistory", $BSXML::jobhistlay, $cgi->{'limit'} || 10000, $filter);
1306   @hist = reverse @hist;
1307   my $ret = {jobhist => \@hist};
1308   return ($ret, $BSXML::jobhistlist);
1309 }
1310
1311 sub getkiwiproductpackages {
1312   my ($projid, $packid, $repoid, $proj, $repo, $pdata, $info, $deps) = @_;
1313
1314   my @got;
1315   my @archs;
1316   my $pd = BSRPC::rpc("$BSConfig::srcserver/getprojpack", $BSXML::projpack, "project=$projid", "package=$packid");
1317   for my $arch (@{$repo->{'arch'} || []}) {
1318     my $enabled = 1; 
1319     $enabled = BSUtil::enabled($repoid, $proj->{'build'}, $enabled, $arch);
1320     $enabled = BSUtil::enabled($repoid, $pd->{'project'}[0]->{'package'}[0]->{'build'}, $enabled, $arch) if $pd->{'project'};
1321     push @archs, $arch if $enabled;
1322   }
1323   my @deps = @{$deps || []};
1324   my %deps = map {$_ => 1} @deps;
1325   delete $deps{''};
1326   my @aprps = map {"$_->{'project'}/$_->{'repository'}"} @{$info->{'path'} || []}; 
1327   my $allpacks = $deps{'*'} ? 1 : 0; 
1328   for my $aprp (@aprps) {
1329     my %known;
1330     my ($aprojid, $arepoid) = split('/', $aprp, 2);
1331     for my $arch (@archs) {
1332       my $depends;
1333       eval {
1334         $depends = Storable::retrieve("$reporoot/$aprp/$arch/:depends");
1335       };
1336       next unless $depends && $depends->{'subpacks'};
1337       my @apackids = sort keys %{$depends->{'subpacks'}};
1338       for my $apackid (@apackids) {
1339         next unless grep {$deps{$_}} @{$depends->{'subpacks'}->{$apackid} || []};
1340         # need package, scan content
1341         my @bins;
1342         if (-s "$reporoot/$aprp/$arch/$apackid/.bininfo") {
1343           @bins = map {substr($_, 34)} split("\n", readstr("$reporoot/$aprp/$arch/$apackid/.bininfo"));
1344         } else {
1345           @bins = grep {/\.rpm$/} ls ("$reporoot/$aprp/$arch/$apackid");
1346         }
1347         for my $b (@bins) {
1348           next unless $b =~ /^(.+)-[^-]+-[^-]+\.([a-zA-Z][^\.\-]*)\.rpm$/;
1349           push @got, "$aprp/$arch/$apackid/$b";
1350         }
1351       }
1352     }
1353   }
1354   return @got;
1355 }
1356
1357 sub getbuildinfo {
1358   my ($cgi, $projid, $repoid, $arch, $packid, $pdata) = @_;
1359   my $projpack;
1360   my $uploaded;
1361   if (!$pdata) {
1362     $projpack = BSRPC::rpc("$BSConfig::srcserver/getprojpack", $BSXML::projpack, 'withsrcmd5', 'withdeps', 'withrepos', 'expandedrepos', 'withremotemap', 'ignoredisable', "project=$projid", "repository=$repoid", "arch=$arch", "package=$packid");
1363     die("no such project/package/repository\n") unless $projpack->{'project'};
1364   } else {
1365     $projpack = BSRPC::rpc("$BSConfig::srcserver/getprojpack", $BSXML::projpack, 'withrepos', 'expandedrepos', 'withremotemap', "project=$projid", "repository=$repoid", "arch=$arch", defined($packid) ? "package=$packid" : ());
1366     die("no such project/repository\n") unless $projpack->{'project'};
1367     $uploaded = 1;
1368   }
1369   my %remotemap = map {$_->{'project'} => $_} @{$projpack->{'remotemap'} || []};
1370   my $proj = $projpack->{'project'}->[0];
1371   die("no such project\n") unless $proj && $proj->{'name'} eq $projid;
1372   my $repo = $proj->{'repository'}->[0];
1373   die("no such repository\n") unless $repo && $repo->{'name'} eq $repoid;
1374   if (!$pdata) {
1375     $pdata = $proj->{'package'}->[0];
1376     die("no such package\n") unless $pdata && $pdata->{'name'} eq $packid;
1377   }
1378
1379   my $info = $pdata->{'info'}->[0];
1380   die("bad info\n") unless $info && $info->{'repository'} eq $repoid;
1381
1382   my $packtype = 'spec';
1383   $packtype = $1 if $info->{'file'} && $info->{'file'} =~ /\.(spec|dsc|kiwi)$/;
1384
1385   my @configpath;
1386   my $kiwitype;
1387   if ($packtype eq 'kiwi') {
1388     if (@{$info->{'path'} || []}) {
1389       my $pp = BSRPC::rpc("$BSConfig::srcserver/getprojpack", $BSXML::projpack, 'withremotemap', 'nopackages', map {"project=$_->{'project'}"} @{$info->{'path'}});
1390       %remotemap = (%remotemap, map {$_->{'project'} => $_} @{$pp->{'remotemap'} || []});
1391     }
1392     @configpath = map {"path=$_->{'project'}/$_->{'repository'}"} @{$info->{'path'} || []};
1393     unshift @configpath, "path=$projid/$repoid" unless @configpath;
1394     if ($info->{'imagetype'} && $info->{'imagetype'}->[0] eq 'product') {
1395       $kiwitype = 'product';
1396     } else {
1397       $kiwitype = 'image';
1398     }
1399   }
1400   my $config = BSRPC::rpc("$BSConfig::srcserver/getconfig", undef, "project=$projid", "repository=$repoid", @configpath);
1401   my $bconf = Build::read_config($arch, [split("\n", $config)]);
1402
1403   my $ret;
1404   $ret->{'project'} = $projid;
1405   $ret->{'repository'} = $repoid;
1406   $ret->{'package'} = $packid if defined $packid;
1407   $ret->{'downloadurl'} = $BSConfig::repodownload if defined $BSConfig::repodownload;;
1408   $ret->{'arch'} = $arch;
1409   $ret->{'path'} = $repo->{'path'} || [];
1410   $ret->{'path'} = $info->{'path'} if $packtype eq 'kiwi' && $info->{'path'};
1411   if ($cgi->{'internal'}) {
1412     for (@{$ret->{'path'}}) {
1413       $_->{'server'} = $BSConfig::reposerver;
1414     }
1415   }
1416   $ret->{'srcmd5'} = $pdata->{'srcmd5'} if $pdata->{'srcmd5'};
1417   $ret->{'verifymd5'} = $pdata->{'verifymd5'} || $pdata->{'srcmd5'} if $pdata->{'verifymd5'} || $pdata->{'srcmd5'};
1418   $ret->{'rev'} = $pdata->{'rev'} if $pdata->{'rev'};
1419   if ($pdata->{'error'}) {
1420     $ret->{'error'} = $pdata->{'error'};
1421     return ($ret, $BSXML::buildinfo);
1422   }
1423   my $debuginfo = BSUtil::enabled($repoid, $proj->{'debuginfo'}, undef, $arch);
1424   $debuginfo = BSUtil::enabled($repoid, $proj->{'package'}->[0]->{'debuginfo'}, $debuginfo, $arch) if defined($packid);
1425   $ret->{'debuginfo'} = $debuginfo ? 1 : 0;
1426
1427   if (defined($packid) && exists($pdata->{'versrel'})) {
1428     $ret->{'versrel'} = $pdata->{'versrel'};
1429     my $h = BSFileDB::fdb_getmatch("$reporoot/$projid/$repoid/$arch/$packid/history", $historylay, 'versrel', $pdata->{'versrel'}, 1);
1430     $h = {'bcnt' => 0} unless $h;
1431     $ret->{'bcnt'} = $h->{'bcnt'} + 1;
1432     my $release = $ret->{'versrel'};
1433     $release =~ s/.*-//;
1434     if (exists($bconf->{'release'})) {
1435       if (defined($bconf->{'release'})) {
1436         $ret->{'release'} = $bconf->{'release'};
1437         $ret->{'release'} =~ s/\<CI_CNT\>/$release/g;
1438         $ret->{'release'} =~ s/\<B_CNT\>/$ret->{'bcnt'}/g;
1439       }
1440     } else {
1441       $ret->{'release'} = "$release.".$ret->{'bcnt'};
1442     }
1443   }
1444
1445   my @prp = map {"$_->{'project'}/$_->{'repository'}"} @{$repo->{'path'} || []};
1446   if ($info->{'error'}) {
1447     $ret->{'error'} = $info->{'error'};
1448     return ($ret, $BSXML::buildinfo);
1449   }
1450   $ret->{'specfile'} = $info->{'file'} unless $uploaded;
1451   $ret->{'file'} = $info->{'file'} unless $uploaded;
1452
1453   if ($packtype eq 'kiwi') {
1454     # Collect kiwi image types
1455     my @itypes = @{$info->{'imagetype'} || []};
1456     $ret->{'imagetype'} = \@itypes;
1457     # use repositories defined in the kiwi config
1458     @prp = map {"$_->{'project'}/$_->{'repository'}"} @{$info->{'path'} || []};
1459   }
1460
1461   my $pool = BSSolv::pool->new();
1462   $pool->settype('deb') if $bconf->{'type'} eq 'dsc';
1463
1464   if ($pdata->{'ldepfile'}) {
1465     # have local deps, add them to pool
1466     my $data = {};
1467     Build::readdeps(undef, $data, $pdata->{'ldepfile'});
1468     my $r = $pool->repofromdata('', $data);
1469     die("ldepfile repo add failed\n") unless $r;
1470   }
1471
1472   for my $prp (@prp) {
1473     my ($rprojid, $rrepoid) = split('/', $prp, 2);
1474     my $r;
1475     if ($remotemap{$rprojid}) {
1476       $r = addrepo_remote($pool, $prp, $arch, $remotemap{$rprojid});
1477     } else {
1478       $r = addrepo_scan($pool, $prp, $arch);
1479     }
1480     die("repository $prp not available\n") unless $r;
1481   }
1482
1483   $pool->createwhatprovides();
1484   my %dep2pkg;
1485   my %dep2src;
1486   for my $p ($pool->consideredpackages()) {
1487     my $n = $pool->pkg2name($p);
1488     $dep2pkg{$n} = $p;
1489     $dep2src{$n} = $pool->pkg2srcname($p);
1490   }
1491   my $pname = $info->{'name'};
1492   my @subpacks = grep {defined($dep2src{$_}) && $dep2src{$_} eq $pname} keys %dep2src;
1493   #$ret->{'subpack'} = \@subpacks;
1494   my @deps = ( @{$info->{'dep'} || []}, @{$info->{'prereq'} || []} );
1495
1496   # expand deps
1497   $Build::expand_dbg = 1 if $cgi->{'debug'};
1498   @subpacks = () if $packtype eq 'kiwi';
1499   my @edeps;
1500   if ($packtype eq 'kiwi' && $kiwitype eq 'product') {
1501     @edeps = (1, @deps);
1502   } elsif ($packtype eq 'kiwi') {
1503     my $bconfignore = $bconf->{'ignore'};
1504     my $bconfignoreh = $bconf->{'ignoreh'};
1505     delete $bconf->{'ignore'};
1506     delete $bconf->{'ignoreh'};
1507     my $xp = BSSolv::expander->new($pool, $bconf);
1508     my $ownexpand = sub {
1509       $_[0] = $xp;
1510       goto &BSSolv::expander::expand;
1511     };
1512     no warnings 'redefine';
1513     local *Build::expand = $ownexpand;
1514     use warnings 'redefine';
1515     @edeps = Build::get_deps($bconf, \@subpacks, @deps);
1516     $bconf->{'ignore'} = $bconfignore if $bconfignore;
1517     $bconf->{'ignoreh'} = $bconfignoreh if $bconfignoreh;
1518   } else {
1519     my $xp = BSSolv::expander->new($pool, $bconf);
1520     my $ownexpand = sub {
1521       $_[0] = $xp;
1522       goto &BSSolv::expander::expand;
1523     };
1524     no warnings 'redefine';
1525     local *Build::expand = $ownexpand;
1526     use warnings 'redefine';
1527     @edeps = Build::get_deps($bconf, \@subpacks, @deps);
1528   }
1529   undef $Build::expand_dbg if $cgi->{'debug'};
1530   if (! shift @edeps) {
1531     $ret->{'error'} = "expansion error: ".join(', ', @edeps);
1532     return ($ret, $BSXML::buildinfo);
1533   }
1534   if ($packtype eq 'kiwi') {
1535     # packages used for build environment
1536     @deps = ('kiwi');
1537     push @deps, 'createrepo', 'tar' if $kiwitype ne 'product';
1538     push @deps, grep {/^kiwi-/} @{$info->{'dep'} || []};
1539   }
1540
1541   my @bdeps;
1542   $Build::expand_dbg = 1 if $cgi->{'debug'};
1543   my $xp = BSSolv::expander->new($pool, $bconf);
1544   my $ownexpand = sub {
1545     $_[0] = $xp;
1546     goto &BSSolv::expander::expand;
1547   };
1548   no warnings 'redefine';
1549   local *Build::expand = $ownexpand;
1550   use warnings 'redefine';
1551   if (!$cgi->{'deps'}) {
1552     @bdeps = Build::get_build($bconf, \@subpacks, @deps, @{$cgi->{'add'} || []});
1553   } else {
1554     @bdeps = Build::get_deps($bconf, \@subpacks, @deps, @{$cgi->{'add'} || []});
1555   }
1556   undef $xp;
1557   undef $Build::expand_dbg if $cgi->{'debug'};
1558   if (! shift @bdeps) {
1559     $ret->{'error'} = "expansion error: ".join(', ', @bdeps);
1560     return ($ret, $BSXML::buildinfo);
1561   }
1562
1563   my @pdeps = Build::get_preinstalls($bconf);
1564   my @vmdeps = Build::get_vminstalls($bconf);
1565   my %runscripts = map {$_ => 1} Build::get_runscripts($bconf);
1566   my %bdeps = map {$_ => 1} @bdeps;
1567   my %pdeps = map {$_ => 1} @pdeps;
1568   my %vmdeps = map {$_ => 1} @vmdeps;
1569   my %edeps = map {$_ => 1} @edeps;
1570
1571   @bdeps = unify(@pdeps, @vmdeps, @edeps, @bdeps);
1572   if ($packtype eq 'kiwi' && $kiwitype eq 'product') {
1573     # things are very different here, we get the binaries from the packages
1574     my @bins = getkiwiproductpackages($projid, $packid, $repoid, $proj, $repo, $pdata, $info, \@bdeps);
1575     my %kdeps = (%bdeps, %pdeps, %vmdeps);
1576     @bdeps = ();
1577     for my $b (@bins) {
1578       my @bn = split('/', $b);
1579       next unless $bn[-1] =~ /^(.+)-([^-]+)-([^-]+)\.([a-zA-Z][^\.\-]*)\.rpm$/;
1580       my $d = {'name' => $1, 'version' => $2, 'release' => $3, 'arch' => $4, 'project' => $bn[0], 'repository' => $bn[1], 'package' => $bn[3]};
1581       $d->{'repoarch'} = $bn[2] if $bn[2] ne $arch;
1582       $d->{'noinstall'} = 1 if $4 eq 'src' || $4 eq 'nosrc';
1583       $d->{'noinstall'} = 1 unless $kdeps{$1};
1584       if (!$d->{'noinstall'}) {
1585         $d->{'preinstall'} = 1 if $pdeps{$1};
1586         $d->{'vminstall'} = 1 if $vmdeps{$1};
1587         $d->{'runscripts'} = 1 if $runscripts{$1};
1588       }
1589       $d->{'notmeta'} = 1 unless $edeps{$1};
1590       delete $kdeps{$1} unless $d->{'noinstall'};
1591       push @bdeps, $d;
1592     }
1593     if ($info->{'extrasource'}) {
1594       push @bdeps, map {{
1595         'name' => $_->{'file'}, 'version' => '', 'repoarch' => $_->{'arch'}, 'arch' => 'src',
1596         'project' => $_->{'project'}, 'package' => $_->{'package'}, 'srcmd5' => $_->{'srcmd5'},
1597       }} @{$info->{'extrasource'}};
1598     }
1599     $ret->{'bdep'} = \@bdeps;
1600     return ($ret, $BSXML::buildinfo);
1601   }
1602
1603   if ($packtype eq 'kiwi' && $kiwitype eq 'image') {
1604     # kiwi images take the binaries from all repos
1605     my %allnames;
1606     for my $repo ($pool->repos()) {
1607       my %names = $repo->pkgnames();
1608       for (keys %names) {
1609         push @{$allnames{$_}}, $names{$_};
1610       }
1611     }
1612     for (splice @bdeps) {
1613       for my $p (@{$allnames{$_} || []}) {
1614         my $b = {'name' => $_};
1615         if (!$cgi->{'internal'}) {
1616           my $prp = $pool->pkg2reponame($p);
1617           ($b->{'project'}, $b->{'repository'}) = split('/', $prp) if $prp ne '';
1618         }
1619         my $d = $pool->pkg2data($p);
1620         $b->{'epoch'} = $d->{'epoch'} if $d->{'epoch'};
1621         $b->{'version'} = $d->{'version'};
1622         $b->{'release'} = $d->{'release'} if exists $d->{'release'};
1623         $b->{'arch'} = $d->{'arch'} if $d->{'arch'};
1624         $b->{'notmeta'} = 1 unless $edeps{$_};
1625         if ($p != $dep2pkg{$_}) {
1626           $b->{'noinstall'} = 1;
1627           push @bdeps, $b;
1628           next;
1629         }
1630         $b->{'preinstall'} = 1 if $pdeps{$_};
1631         $b->{'vminstall'} = 1 if $vmdeps{$_};
1632         $b->{'runscripts'} = 1 if $runscripts{$_};
1633         $b->{'noinstall'} = 1 if $edeps{$_} && !($bdeps{$_} || $vmdeps{$_} || $pdeps{$_});
1634         push @bdeps, $b;
1635       }
1636     }
1637     $ret->{'bdep'} = \@bdeps;
1638     return ($ret, $BSXML::buildinfo);
1639   }
1640
1641   for (@bdeps) {
1642     my $b = {'name' => $_};
1643     my $p = $dep2pkg{$_};
1644     if (!$cgi->{'internal'}) {
1645       my $prp = $pool->pkg2reponame($p);
1646       ($b->{'project'}, $b->{'repository'}) = split('/', $prp) if $prp ne '';
1647     }
1648     my $d = $pool->pkg2data($p);
1649     $b->{'epoch'} = $d->{'epoch'} if $d->{'epoch'};
1650     $b->{'version'} = $d->{'version'};
1651     $b->{'release'} = $d->{'release'} if exists $d->{'release'};
1652     $b->{'arch'} = $d->{'arch'} if $d->{'arch'};
1653     $b->{'preinstall'} = 1 if $pdeps{$_};
1654     $b->{'vminstall'} = 1 if $vmdeps{$_};
1655     $b->{'runscripts'} = 1 if $runscripts{$_};
1656     $b->{'notmeta'} = 1 unless $edeps{$_};
1657     $b->{'noinstall'} = 1 if $packtype eq 'kiwi' && $edeps{$_} && !($bdeps{$_} || $vmdeps{$_} || $pdeps{$_});
1658     $_ = $b;
1659   }
1660
1661   # add extra source (needed for kiwi)
1662   # ADRIAN: is it not enough to do this for product only above ?
1663   if ($info->{'extrasource'}) {
1664     push @bdeps, map {{
1665       'name' => $_->{'file'}, 'version' => '', 'repoarch' => $_->{'arch'}, 'arch' => 'src',
1666       'project' => $_->{'project'}, 'package' => $_->{'package'}, 'srcmd5' => $_->{'srcmd5'},
1667     }} @{$info->{'extrasource'}};
1668   }
1669
1670   $ret->{'bdep'} = \@bdeps;
1671   return ($ret, $BSXML::buildinfo);
1672 }
1673
1674 sub looks_like_dsc {
1675   my ($fn) = @_;
1676   local *F;
1677   if (!open(F, '<', $fn)) {
1678     return 0;
1679   }
1680   my $l = <F>;
1681   if ($l =~ /^-----BEGIN/) {
1682     $l = <F>;
1683     $l = <F>;
1684     $l = <F>;
1685   }
1686   if ($l =~ /^format:/i) {
1687     close F;
1688     return 1;
1689   }
1690   close F;
1691   return 0;
1692 }
1693
1694 sub looks_like_kiwi {
1695   my ($fn) = @_;
1696   local *F;
1697   if (!open(F, '<', $fn)) {
1698     return 0;
1699   }
1700   my $l = <F>;
1701   if ($l =~ /^\<\?xml/) {
1702     $l = <F>;
1703   }
1704   if ($l =~ /^\s*\<image/) {
1705     close F;
1706     return 1;
1707   }
1708   close F;
1709   return 0;
1710 }
1711
1712 sub getbuildinfo_post {
1713   my ($cgi, $projid, $repoid, $arch, $packid) = @_;
1714
1715   undef $packid if $packid eq '_repository';
1716   my $config = BSRPC::rpc("$BSConfig::srcserver/getconfig", undef, "project=$projid", "repository=$repoid");
1717   my $bconf = Build::read_config($arch, [split("\n", $config)]);
1718
1719   my $fn = "$uploaddir/$$";
1720   my $descr = $fn;
1721   my $dir = "$uploaddir/$$.dir";
1722   my $depfile;
1723   mkdir_p("$uploaddir");
1724   die("upload failed\n") unless BSServer::read_file($fn);
1725
1726   local *F;
1727   open(F, '<', "$fn") || die("$fn: $!\n");
1728   my $magic;
1729   sysread(F, $magic, 6);
1730   if ($magic eq "070701") {
1731     sysseek(F, 0, 0);
1732     mkdir_p($dir);
1733     my $uploaded = BSHTTP::cpio_receiver(BSHTTP::fd2hdr(\*F), {'directory' => $dir});
1734     # should we check if the cpio archive contains <= 2 files?
1735     ($depfile) = map { $_->{'name'} =~ /(deps)/ } @$uploaded;
1736     $depfile = "$dir/$depfile" if defined $depfile;
1737     $descr = (grep { $_->{'name'} ne "deps" } @$uploaded)[0];
1738     die("no spec/dsc/kiwi file found\n") unless $descr;
1739     $descr = "$dir/$descr->{'name'}";
1740   }
1741   close(F);
1742   my $d;
1743   my $info = {'repository' => $repoid};
1744   if (looks_like_dsc($descr)) {
1745     $d = Build::Deb::parse($bconf, $descr);
1746     $info->{'file'} = 'upload.dsc';
1747   } elsif (looks_like_kiwi($descr)) {
1748     $d = Build::Kiwi::parse($bconf, $descr);
1749     $info->{'imagetype'} = $d->{'imagetype'};
1750     $info->{'path'} = $d->{'path'};
1751     $info->{'file'} = 'upload.kiwi';
1752   } else {
1753     $d = Build::Rpm::parse($bconf, $descr);
1754     $info->{'file'} = 'upload.spec';
1755   }
1756   unlink($fn);
1757   unless (defined $d->{'name'}) {
1758     unlink("$dir/$_") for ls($dir);
1759     rmdir($dir) if -d $dir;
1760     die("parse error\n");
1761   }
1762   $info->{'name'} = $d->{'name'};
1763   $info->{'dep'} = $d->{'deps'};
1764   if ($d->{'prereqs'}) {
1765     my %deps = map {$_ => 1} (@{$d->{'deps'} || []}, @{$d->{'subpacks'} || []});
1766     my @prereqs = grep {!$deps{$_} && !/^%/} @{$d->{'prereqs'}};
1767     $info->{'prereq'} = \@prereqs if @prereqs;
1768   }
1769   my $pdata = {'info' => [ $info ]};
1770   $pdata->{'ldepfile'} = $depfile if defined $depfile;
1771
1772   my @r;
1773   eval {
1774     @r = getbuildinfo($cgi, $projid, $repoid, $arch, $packid, $pdata);
1775   };
1776   unlink("$dir/$_") for ls($dir);
1777   rmdir($dir) if -d $dir;
1778   die("$@\n") if $@;
1779   return @r;
1780 }
1781
1782 sub getbuilddepinfo {
1783   my ($cgi, $projid, $repoid, $arch) = @_;
1784   my %packids = map {$_ => 1} @{$cgi->{'package'} || []};
1785   my $depends;
1786   eval {
1787     $depends = Storable::retrieve("$reporoot/$projid/$repoid/$arch/:depends");
1788   };
1789   return ({'package' => []}, $BSXML::builddepinfo) unless $depends;
1790   my $subpacks = $depends->{'subpacks'} || {};
1791   my $pkgdeps = $depends->{'pkgdeps'} || {};
1792   my $pkg2src = $depends->{'pkg2src'} || {};
1793   my @res;
1794   for my $packid (sort keys %$pkg2src) {
1795     next if %packids && !$packids{$packid};
1796     my $n = $pkg2src->{$packid};
1797     my @sp = sort @{$subpacks->{$n} || []};
1798     push @sp, $n unless @sp;
1799     if ($n ne $sp[0] && (grep {$_ eq $n} @sp)) {
1800       @sp = grep {$_ ne $n} @sp;
1801       unshift @sp, $n;
1802     }
1803     push @res, {'name' => $packid, 
1804         'source' => $n,
1805         'pkgdep' => ($pkgdeps->{$packid} || []),
1806         'subpkg' => \@sp,
1807     };
1808   }
1809   return ({'package' => \@res}, $BSXML::builddepinfo);
1810 }
1811
1812 ### FIXME: read status instead!
1813 sub findjob {
1814   my ($projid, $repoid, $arch, $packid) = @_;
1815
1816   my $prp = "$projid/$repoid";
1817   my $job = jobname($prp, $packid);
1818   my @jobdatadirs = grep {$_ eq "$job:status" || /^\Q$job\E-[0-9a-f]{32}:status$/} ls("$jobsdir/$arch");
1819   return undef unless @jobdatadirs;
1820   $job = $jobdatadirs[0];
1821   $job =~ s/:status$//;
1822   return $job;
1823 }
1824
1825 sub restartbuild {
1826   my ($cgi, $projid, $repoid, $arch, $packid) = @_;
1827
1828   my $job = findjob($projid, $repoid, $arch, $packid);
1829   die("not building\n") unless $job;
1830
1831   local *F;
1832   my $js = BSUtil::lockopenxml(\*F, '<', "$jobsdir/$arch/$job:status", $BSXML::jobstatus);
1833   die("not building\n") if $js->{'code'} ne 'building';
1834   my $req = {
1835     'uri' => "$js->{'uri'}/discard",
1836     'timeout' => 30,
1837   };
1838   eval {
1839     BSRPC::rpc($req, undef, "jobid=$js->{'jobid'}");
1840   };
1841   warn($@) if $@;
1842   unlink("$jobsdir/$arch/$job:status");
1843   close F;
1844   return $BSStdServer::return_ok;
1845 }
1846
1847 sub abortbuild {
1848   my ($cgi, $projid, $repoid, $arch, $packid) = @_;
1849
1850   my $job = findjob($projid, $repoid, $arch, $packid);
1851   die("not building\n") unless $job;
1852   local *F;
1853   my $js = BSUtil::lockopenxml(\*F, '<', "$jobsdir/$arch/$job:status", $BSXML::jobstatus);
1854   die("not building\n") if $js->{'code'} ne 'building';
1855   my $req = {
1856     'uri' => "$js->{'uri'}/kill",
1857     'timeout' => 30,
1858   };
1859   BSRPC::rpc($req, undef, "jobid=$js->{'jobid'}");
1860   return $BSStdServer::return_ok;
1861 }
1862
1863 sub getcode {
1864   my ($cgi, $dir) = @_;
1865   my @send;
1866   for my $file (grep {!/^\./} ls($dir)) {
1867     if ($file eq 'Build' && -d "$dir/$file") {
1868       for my $file2 (grep {!/^\./} ls("$dir/Build")) {
1869         push @send, {'name' => "$file2", 'filename' => "$dir/Build/$file2"};
1870       }
1871     }
1872     next unless -f "$dir/$file";
1873     push @send, {'name' => "$file", 'filename' => "$dir/$file"};
1874   }
1875   die("$dir is empty\n") unless @send;
1876   BSServer::reply_cpio(\@send);
1877   return undef;
1878 }
1879
1880 sub getbuildcode {
1881   my ($cgi) = @_;
1882   return getcode($cgi, 'build');
1883 }
1884
1885 sub getworkercode {
1886   my ($cgi) = @_;
1887   return getcode($cgi, 'worker');
1888 }
1889
1890 sub postrepo {
1891   my ($cgi, $projid, $repoid, $arch) = @_;
1892
1893   my $projpack = BSRPC::rpc("$BSConfig::srcserver/getprojpack", $BSXML::projpack, 'withrepos', 'expandedrepos', "project=$projid", "repository=$repoid", "arch=$arch");
1894   my $proj = $projpack->{'project'}->[0];
1895   die("no such project\n") unless $proj && $proj->{'name'} eq $projid;
1896   my $repo = $proj->{'repository'}->[0];
1897   die("no such repository\n") unless $repo && $repo->{'name'} eq $repoid;
1898   my @prp = map {"$_->{'project'}/$_->{'repository'}"} @{$repo->{'path'} || []};
1899   my $pool = BSSolv::pool->new();
1900   for my $prp (@prp) {
1901     addrepo_scan($pool, $prp, $arch);
1902   }
1903   $pool->createwhatprovides();
1904   my %data;
1905   for my $p ($pool->consideredpackages()) {
1906     my $d = $pool->pkg2data($p);
1907     $data{$d->{'name'}} = $d;
1908   }
1909   undef $pool;
1910   my @data;
1911   for (sort keys %data) {
1912     push @data, $data{$_};
1913     $data[-1]->{'_content'} = $data[-1]->{'name'};
1914   }
1915   my $match = $cgi->{'match'};
1916   $match = "[$match]" unless $match =~ /^[\.\/]?\[/;
1917   $match = ".$match" if $match =~ /^\[/;
1918   my $v = BSXPath::valuematch(\@data, $match);
1919   return {'value' => $v}, $BSXML::collection;
1920 }
1921
1922 my %prp_to_repoinfo;
1923
1924 sub prp_to_repoinfo {
1925   my ($prp) = @_;
1926
1927   my $repoinfo = $prp_to_repoinfo{$prp};
1928   if (!$repoinfo) {
1929     if (-s "$reporoot/$prp/:repoinfo") {
1930       $repoinfo = Storable::retrieve("$reporoot/$prp/:repoinfo");
1931       for (@{$repoinfo->{'prpsearchpath'} || []}) {
1932         next if ref($_);        # legacy
1933         my ($p, $r) = split('/', $_, 2);
1934         $_ = {'project' => $p, 'repository' => $r};
1935       }
1936     } else {
1937       $repoinfo = {'binaryorigins' => {}};
1938     }
1939     $prp_to_repoinfo{$prp} = $repoinfo;
1940   }
1941   return $repoinfo;
1942 }
1943
1944 sub binary_key_to_data {
1945   my ($db, $key) = @_; 
1946   my @p = split('/', $key);
1947   my $binary = pop(@p);
1948   my $name = $binary;
1949   my $version = '';
1950   if ($name =~ s/-([^-]+-[^-]+)\.[^\.]+\.rpm$//) {
1951     $version = $1;
1952   } elsif ($name =~ s/_([^_]+)_[^_]+\.deb$//) {
1953     $version = $1;
1954   }
1955   my $arch = pop(@p);
1956   while (@p > 1 && $p[0] =~ /:$/) {
1957     splice(@p, 0, 2, "$p[0]$p[1]");
1958   }
1959   my $project = shift(@p);
1960   while (@p > 1 && $p[0] =~ /:$/) {
1961     splice(@p, 0, 2, "$p[0]$p[1]");
1962   }
1963   my $repository = shift(@p);
1964   my $prp = "$project/$repository";
1965   my $repoinfo = $prp_to_repoinfo{$prp} || prp_to_repoinfo($prp);
1966   my $type;
1967   $type = 'rpm' if $binary =~ /\.rpm$/;
1968   $type = 'deb' if $binary =~ /\.deb$/;
1969   my $res = {
1970     'name' => $name,
1971     'version' => $version,
1972     'arch' => $arch,
1973     'type' => $type,
1974     'project' => $project,
1975     'repository' => $repository,
1976     'filename' => $binary,
1977     'filepath' => $key,
1978   };
1979   $res->{'path'} = $repoinfo->{'prpsearchpath'} if $repoinfo->{'prpsearchpath'};
1980   $res->{'package'} = $repoinfo->{'binaryorigins'}->{"$arch/$binary"} if defined $repoinfo->{'binaryorigins'}->{"$arch/$binary"};
1981   $res->{'baseproject'} = $res->{'path'}->[-1]->{'project'} if $res->{'path'};
1982   return $res;
1983 }
1984
1985 sub pattern_key_to_data {
1986   my ($db, $key) = @_; 
1987   my @p = split('/', $key);
1988   my $filename = pop(@p);
1989   while (@p > 1 && $p[0] =~ /:$/) {
1990     splice(@p, 0, 2, "$p[0]$p[1]");
1991   }
1992   my $project = shift(@p);
1993   while (@p > 1 && $p[0] =~ /:$/) {
1994     splice(@p, 0, 2, "$p[0]$p[1]");
1995   }
1996   my $repository = shift(@p);
1997   my @v = BSDBIndex::getvalues($db, $db->{'table'}, $key);
1998   return {} unless @v;
1999   my $res = $v[0];
2000   $res->{'baseproject'} = $res->{'path'}->[-1]->{'project'} if $res->{'path'};
2001   $res->{'project'} = $project;
2002   $res->{'repository'} = $repository;
2003   $res->{'filename'} = $filename;
2004   $res->{'filepath'} = $key;
2005   return $res;
2006 }
2007
2008 sub search_published_binary_id {
2009   my ($cgi, $match) = @_;
2010   my $binarydb = BSDB::opendb($extrepodb, 'binary');
2011   $binarydb->{'allkeyspath'} = 'name';
2012   $binarydb->{'noindex'} = {'arch' => 1, 'project' => 1, 'repository' => 1, 'package' => 1, 'type' => 1, 'path/project' => 1, 'path/repository' => 1};
2013   $binarydb->{'fetch'} = \&binary_key_to_data;
2014   $binarydb->{'cheapfetch'} = 1;
2015   my $rootnode = BSXPathKeys::node($binarydb, '');
2016   my $data = BSXPath::match($rootnode, $match) || [];
2017   # epoch?
2018   @$data = sort {Build::Rpm::verscmp($b->{'version'}, $a->{'version'}) || $a->{'name'} cmp $b->{'name'} || $a->{'arch'} cmp $b->{'arch'}} @$data;
2019   delete $_->{'path'} for @$data;
2020   my $res = {'binary' => $data};
2021   return ($res, $BSXML::collection);
2022 }
2023
2024 sub search_published_pattern_id {
2025   my ($cgi, $match) = @_;
2026   my $patterndb = BSDB::opendb($extrepodb, 'pattern');
2027   $patterndb->{'noindex'} = {'project' => 1, 'repository' => 1};
2028   $patterndb->{'fetch'} = \&pattern_key_to_data;
2029   my $rootnode = BSXPathKeys::node($patterndb, '');
2030   my $data = BSXPath::match($rootnode, $match) || [];
2031   for (@$data) {
2032     delete $_->{'path'};
2033     delete $_->{'description'};
2034     delete $_->{'summary'};
2035   }
2036   my $res = {'pattern' => $data};
2037   return ($res, $BSXML::collection);
2038 }
2039
2040 sub listpublished {
2041   my ($dir, $fileok) = @_;
2042   my @r;
2043   for my $d (ls($dir)) {
2044     if ($fileok && -f "$dir/$d") {
2045       push @r, $d;
2046       next;
2047     }
2048     next unless -d "$dir/$d";
2049     if ($d =~ /:$/) {
2050       my $dd = $d;
2051       chop $dd;
2052       push @r, map {"$dd:$_"} listpublished("$dir/$d");
2053     } else {
2054       push @r, $d;
2055     }
2056   }
2057   return @r;
2058 }
2059
2060 sub findympbinary {
2061   my ($binarydir, $binaryname) = @_;
2062   for my $b (ls($binarydir)) {
2063     next unless $b =~ /\.(?:rpm|deb)$/;
2064     next unless $b =~ /^\Q$binaryname\E/;
2065     my $data = Build::query("$binarydir/$b", 'evra' => 1);
2066     if ($data->{'name'} eq $binaryname || "$data->{'name'}-$data->{'version'}" eq $binaryname) {
2067       return "$binarydir/$b";
2068     }
2069   }
2070   return undef;
2071 }
2072
2073 sub publisheddir {
2074   my ($cgi, $projid, $repoid, $arch) = @_;
2075   my @res = ();
2076   if (!defined($projid)) {
2077     @res = listpublished($extrepodir);
2078   } elsif (!defined($repoid)) {
2079     my $prp_ext = $projid;
2080     $prp_ext =~ s/:/:\//g;
2081     @res = listpublished("$extrepodir/$prp_ext");
2082   } elsif (!defined($arch)) {
2083     my $prp_ext = "$projid/$repoid";
2084     $prp_ext =~ s/:/:\//g;
2085     @res = listpublished("$extrepodir/$prp_ext", 1);
2086   } else {
2087     my $prp_ext = "$projid/$repoid";
2088     $prp_ext =~ s/:/:\//g;
2089     if ($cgi->{'view'} eq 'ymp') {
2090       my $binaryname = $arch;
2091       my $binary;
2092       my @archs = ls("$extrepodir/$prp_ext");
2093       for my $a (@archs) {
2094         next unless -d "$extrepodir/$prp_ext/$a";
2095         $binary = findympbinary("$extrepodir/$prp_ext/$a", $binaryname);
2096         last if $binary;
2097       }
2098       $binary ||= "$extrepodir/$prp_ext/$binaryname";
2099       return makeymp($projid, $repoid, $binary);
2100     }
2101     return publishedfile($cgi, $projid, $repoid, undef, $arch) if -f "$extrepodir/$prp_ext/$arch";
2102     @res = ls("$extrepodir/$prp_ext/$arch");
2103   }
2104   @res = sort @res;
2105   @res = map {{'name' => $_}} @res;
2106   return ({'entry' => \@res}, $BSXML::dir);
2107 }
2108
2109 sub makeymp {
2110   my ($projid, $repoid, $binary) = @_;
2111
2112   my $binaryname;
2113   my $data;
2114   if ($binary =~ /(?:^|\/)([^\/]+)-[^-]+-[^-]+\.[a-zA-Z][^\/\.\-]*\.rpm$/) {
2115     $binaryname = $1;
2116   } elsif ($binary =~ /(?:^|\/)([^\/]+)_([^\/]*)_[^\/]*\.deb$/) {
2117     $binaryname = $1;
2118   } elsif ($binary =~ /(?:^|\/)([^\/]+)\.(?:rpm|deb)$/) {
2119     $binaryname = $1;
2120   } else {
2121     my $binarydir;
2122     ($binarydir, $binaryname) = $binary =~ /^(.*)\/([^\/]*)$/;
2123     $binary = findympbinary($binarydir, $binaryname) || $binary;
2124   }
2125   $data = Build::query($binary, 'description' => 1);
2126   #die("no such binary\n") unless $data;
2127   my $projpack = BSRPC::rpc("$BSConfig::srcserver/getprojpack", $BSXML::projpack, 'withrepos', 'expandedrepos', 'nopackages', "project=$projid", "repository=$repoid");
2128   my $proj = $projpack->{'project'}->[0];
2129   die("no such project\n") unless $proj && $proj->{'name'} eq $projid;
2130   my $repo = $proj->{'repository'}->[0];
2131   die("no such repository\n") unless $repo && $repo->{'name'} eq $repoid;
2132   my @nprojids = grep {$_ ne $projid} map {$_->{'project'}} @{$repo->{'path'} || []};
2133   my %nprojpack;
2134   if (@nprojids) {
2135     my @args = map {"project=$_"} @nprojids;
2136     my $nprojpack = BSRPC::rpc("$BSConfig::srcserver/getprojpack", $BSXML::projpack, 'nopackages', @args);
2137     %nprojpack = map {$_->{'name'} => $_} @{$nprojpack->{'project'} || []};
2138   }
2139   my $ymp = {};
2140   $ymp->{'xmlns:os'} = 'http://opensuse.org/Standards/One_Click_Install';
2141   $ymp->{'xmlns'} = 'http://opensuse.org/Standards/One_Click_Install';
2142   my @group;
2143   $ymp->{'group'} = \@group;
2144   my @repos;
2145   my @pa = @{$repo->{'path'} || []};
2146   while (@pa) {
2147     my $pa = shift @pa;
2148     my $r = {};
2149     $r->{'recommended'} = @pa || !@repos ? 'true' : 'false';
2150     $r->{'name'} = $pa->{'project'};
2151     if ($pa->{'project'} eq $projid) {
2152       $r->{'summary'} = $proj->{'title'};
2153       $r->{'description'} = $proj->{'description'};
2154     } elsif ($nprojpack{$pa->{'project'}}) {
2155       $r->{'summary'} = $nprojpack{$pa->{'project'}}->{'title'};
2156       $r->{'description'} = $nprojpack{$pa->{'project'}}->{'description'};
2157     }
2158     my $prp_ext = "$pa->{'project'}/$pa->{'repository'}";
2159     if ($BSConfig::prp_ext_map && $BSConfig::prp_ext_map->{$prp_ext}) {
2160       $r->{'url'} = $BSConfig::prp_ext_map->{$prp_ext};
2161     } else {
2162       $prp_ext =~ s/:/:\//g;
2163       $r->{'url'} = "$BSConfig::repodownload/$prp_ext/";
2164     }
2165     push @repos, $r;
2166   }
2167   my $pkg = {};
2168   if ($data) {
2169     $pkg->{'name'} = str2utf8($data->{'name'});
2170     $pkg->{'description'} = str2utf8($data->{'description'});
2171   } else {
2172     $pkg->{'name'} = str2utf8($binaryname);
2173     $pkg->{'description'} = "The $pkg->{'name'} package";
2174   }
2175   if (defined $data->{'summary'}) {
2176     $pkg->{'summary'} = str2utf8($data->{'summary'});
2177   } else {
2178     $pkg->{'summary'} = "The $pkg->{'name'} package";
2179   }
2180   my $inner_group = {};
2181   $inner_group->{'repositories'} = {'repository' => \@repos };
2182   $inner_group->{'software'} = {'item' => [$pkg]};
2183   push @group, $inner_group;
2184   my $ympxml = XMLout($BSXML::ymp, $ymp);
2185   return ($ympxml, "Content-Type: text/x-suse-ymp");
2186 }
2187
2188 sub fileinfo {
2189   my ($cgi, $filepath, $filename) = @_;
2190   my $res = {'filename' => $filename};
2191   my $q = {};
2192   die("filename: $!\n") unless -f $filepath;
2193   if ($filename =~ /\.(?:rpm|deb)$/) {
2194     $q = Build::query($filepath, 'evra' => 1, 'description' => 1, 'alldeps' => 1);
2195     data2utf8($q);
2196   } elsif ($filename =~ /\.ymp$/) {
2197     my $ymp = readxml($filepath, $BSXML::ymp, 1);
2198
2199     if ($ymp) {
2200       my $g0 = $ymp->{'group'}[0];
2201       $q->{'name'} = $g0->{'name'} if defined $g0->{'name'};
2202       $q->{'summary'} = $g0->{'summary'} if defined $g0->{'summary'};
2203       $q->{'description'} = $g0->{'description'} if defined $g0->{'description'};
2204       if ($g0->{'repositories'}) {
2205         $q->{'recommends'} = [ map {$_->{'name'}} grep {$_->{'recommended'} && $_->{'recommended'} eq 'true'} @{$g0->{'packages'}->{'package'} || []} ];
2206         $q->{'suggests'} = [ map {$_->{'name'}} grep {!($_->{'recommended'} && $_->{'recommended'} eq 'true')} @{$g0->{'packages'}->{'package'} || []} ];
2207         delete $q->{'recommends'} unless @{$q->{'recommends'}};
2208         delete $q->{'suggests'} unless @{$q->{'suggests'}};
2209       }
2210     }
2211   }
2212   for (qw{name epoch version release arch summary description provides requires recommends suggests}) {
2213     $res->{$_} = $q->{$_} if defined $q->{$_};
2214   }
2215   return ($res, $BSXML::fileinfo);
2216 }
2217
2218 sub publishedfile {
2219   my ($cgi, $projid, $repoid, $arch, $filename) = @_;
2220   my $prp_ext = "$projid/$repoid";
2221   $prp_ext .= "/$arch" if defined $arch;
2222   $prp_ext =~ s/:/:\//g;
2223   if ($cgi->{'view'} && $cgi->{'view'} eq 'ymp') {
2224     return makeymp($projid, $repoid, "$extrepodir/$prp_ext/$filename");
2225   }
2226   die("no such file\n") unless -f "$extrepodir/$prp_ext/$filename";
2227   if ($cgi->{'view'} && $cgi->{'view'} eq 'fileinfo') {
2228     return fileinfo($cgi, "$extrepodir/$prp_ext/$filename", $filename);
2229   }
2230   my $type = 'application/x-rpm';
2231   $type = 'application/x-debian-package' if $filename=~ /\.deb$/;
2232   BSServer::reply_file("$extrepodir/$prp_ext/$filename", "Content-Type: $type");
2233   return undef;
2234 }
2235
2236 sub getrelsync {
2237   my ($cgi, $projid, $repoid, $arch) = @_;
2238   my $prp = "$projid/$repoid";
2239   my $relsyncdata = readstr("$reporoot/$prp/$arch/:relsync");
2240   return ($relsyncdata, 'Content-Type: application/octet-stream');
2241 }
2242
2243 sub postrelsync {
2244   my ($cgi, $projid, $repoid, $arch) = @_;
2245   my $prp = "$projid/$repoid";
2246
2247   my $newdata = BSServer::read_data(10000000);
2248   my $new = Storable::thaw(substr($newdata, 4));
2249   die("no data\n") unless $new;
2250
2251   local *F;
2252   BSUtil::lockopen(\*F, '+>>', "$reporoot/$prp/$arch/:relsync.max");
2253   my $relsyncmax;
2254   if (-s "$reporoot/$prp/$arch/:relsync.max") {
2255     eval { $relsyncmax = Storable::retrieve("$reporoot/$prp/$arch/:relsync.max"); };
2256     warn($@) if $@;
2257   }
2258   $relsyncmax ||= {};
2259   my $changed;
2260   for my $packid (keys %$new) {
2261     if ($packid =~ /\//) {
2262       next if defined($relsyncmax->{$packid}) && $relsyncmax->{$packid} >= $new->{$packid};
2263       $relsyncmax->{$packid} = $new->{$packid};
2264     } else {
2265       next unless $new->{$packid} =~ /^(.*)\.([^-]*)$/;
2266       next if defined($relsyncmax->{"$packid/$1"}) && $relsyncmax->{"$packid/$1"} >= $2;
2267       $relsyncmax->{"$packid/$1"} = $2;
2268     }
2269     $changed = 1;
2270   }
2271   if ($changed) {
2272     Storable::nstore($relsyncmax, "$reporoot/$prp/$arch/:relsync.max.new");
2273     rename("$reporoot/$prp/$arch/:relsync.max.new", "$reporoot/$prp/$arch/:relsync.max");
2274   }
2275   close(F);
2276
2277   if ($changed) {
2278     forwardevent($cgi, 'relsync', $projid, undef, $repoid, $arch);
2279   }
2280   return $BSStdServer::return_ok;
2281 }
2282
2283
2284 sub getajaxstatus {
2285   my ($cgi) = @_;
2286   if (!$BSStdServer::isajax) {
2287     BSHandoff::handoff($ajaxsocket, '/ajaxstatus');
2288     exit(0);
2289   }
2290   my $r = BSWatcher::getstatus();
2291   return ($r, $BSXML::ajaxstatus);
2292 }
2293
2294 sub hello {
2295   my ($cgi) = @_;
2296   return "<hello name=\"Package Repository Ajax Server\" />\n" if $BSStdServer::isajax;
2297   return "<hello name=\"Package Repository Server\" />\n";
2298 }
2299
2300 my $dispatches = [
2301   '/' => \&hello,
2302
2303   '!rw :' => undef,
2304
2305   'POST:/build/$project/$repository/$arch/_repository match:' => \&postrepo,
2306   '/build/$project/$repository/$arch/_builddepinfo package*' => \&getbuilddepinfo,
2307   '/build/$project/$repository/$arch/_jobhistory package* code:* limit:num?' => \&getjobhistory,
2308   'POST:/build/$project/$repository/$arch/_relsync' => \&postrelsync,
2309   '/build/$project/$repository/$arch/_relsync' => \&getrelsync,
2310   'POST:/build/$project/$repository/$arch/$package' => \&uploadbuild,
2311   '/build/$project/$repository/$arch/$package:package_repository view:? binary:filename* nometa:bool?' => \&getbinarylist,
2312   'POST:/build/$project/$repository/$arch/$package_repository/_buildinfo add:* internal:bool? deps:bool?' => \&getbuildinfo_post,
2313   '/build/$project/$repository/$arch/$package/_buildinfo add:* internal:bool? debug:bool? deps:bool?' => \&getbuildinfo,
2314   '/build/$project/$repository/$arch/$package/_reason' => \&getbuildreason,
2315   '/build/$project/$repository/$arch/$package/_status' => \&getbuildstatus,
2316   '/build/$project/$repository/$arch/$package/_history limit:num?' => \&getbuildhistory,
2317   '/build/$project/$repository/$arch/$package/_log nostream:bool? start:intnum? end:num? handoff:bool? view:?' => \&getlogfile,
2318   '/build/$project/$repository/$arch/$package:package_repository/$filename' => \&getbinary,
2319   'PUT:/build/$project/$repository/$arch/_repository/$filename ignoreolder:bool? wipe:bool?' => \&putbinary,
2320   '/search/published/binary/id $match:' => \&search_published_binary_id,
2321   '/search/published/pattern/id $match:' => \&search_published_pattern_id,
2322
2323   # src server calls
2324   '/event $type: $project $package?' => \&forwardevent,
2325
2326   # worker calls
2327   '!worker /worker $arch $port $state: workerid:? working:bool? memory:num? disk:num? buildarch:arch* tellnojob:bool?' => \&workerstate,
2328   '!worker /getbuildcode' => \&getbuildcode,
2329   '!worker /getworkercode' => \&getworkercode,
2330   '!worker /putjob $arch $job $jobid:md5 $code:?' => \&putjob,
2331   '!worker /getbinaries $project $repository $arch binaries: nometa:bool?' => \&getbinaries,
2332   '!worker /getbinaryversions $project $repository $arch binaries: nometa:bool?' => \&getbinaryversions,
2333
2334   # published files
2335   '/published' => \&publisheddir,
2336   '/published/$project' => \&publisheddir,
2337   '/published/$project/$repository' => \&publisheddir,
2338   '/published/$project/$repository/$arch:filename view:?' => \&publisheddir,
2339   '/published/$project/$repository/$arch:filename/$filename view:?' => \&publishedfile,
2340
2341   # info
2342   '/workerstatus scheduleronly:bool? arch*' => \&workerstatus,
2343
2344   '/_result $prpa+ oldstate:md5? package* code:* lastbuild:bool? withbinarylist:bool?' => \&getresult,
2345   '/_command $cmd: $prpa+ package* code:*' => \&docommand,
2346   '/ajaxstatus' => \&getajaxstatus,
2347 ];
2348
2349 my $dispatches_ajax = [
2350   '/' => \&hello,
2351   '/ajaxstatus' => \&getajaxstatus,
2352   '/build/$project/$repository/$arch/$package/_log nostream:bool? start:intnum? end:num? view:?' => \&getlogfile,
2353   '/build/$project/$repository/$arch/$package:package_repository view:? binary:filename*' => \&getbinarylist,
2354   '/_result $prpa+ oldstate:md5? package* code:* withbinarylist:bool?' => \&getresult,
2355 ];
2356
2357 my $conf = {
2358   'port' => $port,
2359   'dispatches' => $dispatches,
2360   'setkeepalive' => 1, 
2361   'maxchild' => 20,
2362 };
2363
2364 my $aconf = {
2365   'socketpath' => $ajaxsocket,
2366   'dispatches' => $dispatches_ajax,
2367   'getrequest_timeout' => 10,
2368   'replrequest_timeout' => 10, 
2369   'getrequest_recvfd' => \&BSHandoff::receive,
2370   'setkeepalive' => 1,
2371 };
2372
2373 BSStdServer::server('bs_repserver', \@ARGV, $conf, $aconf);