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