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