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