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