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