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