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