#!/usr/bin/perl -w
#
# Copyright (c) 2006, 2007 Michael Schroeder, Novell Inc.
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License version 2 as
# published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program (see the file COPYING); if not, write to the
# Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
#
################################################################
#
# The Repository Server
#

BEGIN {
  my ($wd) = $0 =~ m-(.*)/- ;
  $wd ||= '.';
  # FIXME: currently the bs_srcserver makes assumptions on being in a
  # properly set up working dir, e.g. with subdirs 'worker' and
  # 'build'.  Either that is cleaned up or this stays in, for the sake
  # of startproc and others being able to start a bs_srcserver without
  # knowing that it has to be started in the right directory....

  chdir "$wd";
  unshift @INC,  "build";
}

use POSIX;
use Fcntl qw(:DEFAULT :flock);
use XML::Structured ':bytes';
use Storable ();
use Data::Dumper;
use Digest::MD5 ();
use List::Util;
use Symbol;

use BSConfig;
use BSRPC ':https';
use BSServer;
use BSUtil;
use BSHTTP;
use BSFileDB;
use BSXML;
use BSVerify;
use BSHandoff;
use Build;
use BSWatcher;
use BSStdServer;
use BSXPath;
use BSXPathKeys;
use BSDB;
use BSDBIndex;
use BSHermes;

use strict;

my $port = 5252;	#'RR'
$port = $1 if $BSConfig::reposerver =~ /:(\d+)$/;
my $ajaxsocket = "$BSConfig::bsdir/run/bs_repserver.ajax";

my $historylay = [qw{versrel bcnt srcmd5 rev time}];

my %cando = (
  'i586'   => ['i586'],
  'i686'   => ['i586', 'i686'],
  'x86_64' => ['x86_64', 'i586', 'i686'],
  'ppc'    => ['ppc'],
  'ppc64'  => ['ppc64', 'ppc'],
  'sh4'    => ['sh4'],
);

my $reporoot = "$BSConfig::bsdir/build";
my $workersdir = "$BSConfig::bsdir/workers";
my $jobsdir = "$BSConfig::bsdir/jobs";
my $eventdir = "$BSConfig::bsdir/events";
my $infodir = "$BSConfig::bsdir/info";
my $uploaddir = "$BSConfig::bsdir/upload";
my $rundir = "$BSConfig::bsdir/run";
my $extrepodir = "$BSConfig::bsdir/repos";
my $extrepodb = "$BSConfig::bsdir/db/published";

# XXX read jobs instead?

sub jobname {
  my ($prp, $packid) = @_;
  my $job = "$prp/$packid";
  $job =~ s/\//::/g;
  return $job;
}

sub findbinaries {
  my ($prp, $arch, @qbins) = @_;
  local *D;
  my %bins = map {$_ => '_gone'} @qbins;
  my $dir = "$reporoot/$prp/$arch/:full";
  opendir(D, $dir) || return \%bins;
  my @bins = grep {/\.(?:rpm|deb)$/} readdir(D);
  closedir(D);
  if (!@bins && -s "$dir.subdirs") {
    for my $subdir (split(' ', readstr("$dir.subdirs"))) {
      push @bins, map {"$subdir/$_"} grep {/\.(?:rpm|deb)$/} ls("$dir/$subdir");
    }
  }
  for (sort @bins) {
    if (/(?:^|\/)([^\/]+)-[^-]+-[^-]+\.[a-zA-Z][^\/\.\-]*\.rpm$/) {
      next unless $bins{$1};
      $bins{$1} = "$prp/$arch/:full/$_";
    } elsif (/(?:^|\/)([^\/]+)_([^\/]*)_[^\/]*\.deb$/) {
      next unless $bins{$1};
      $bins{$1} = "$prp/$arch/:full/$_";
    } elsif (/(?:^|\/)([^\/]+)\.(?:rpm|deb)$/) {
      next unless $bins{$1};
      $bins{$1} = "$prp/$arch/:full/$_";
    }
  }
  return \%bins;
}

sub getbinarydata {
  my @bins = @_;

  my @res;
  for my $bin (@bins) {
    my $filename = $bin;
    $filename =~ s/.*\///;
    local *F;
    if (!open(F, '<', $bin)) {
      push @res, {'filename' => $filename, 'error' => "$bin: $!"};
      next;
    }
    my @s = stat(F);
    my $data = Build::query([$bin, \*F], 'evra' => 1);
    close(F);
    if (!$data) {
      push @res, {'filename' => $filename, 'error' => 'bad binary package'};
      next;
    }
    $data->{'filename'} = $filename;
    $data->{'mtime'} = $s[9];
    delete $data->{'hdrmd5'};
    delete $data->{'provides'};
    delete $data->{'requires'};
    delete $data->{'source'};
    data2utf8($data);
    push @res, $data;
  }
  return @res;
}

sub getbinaryversions {
  my ($cgi, $projid, $repoid, $arch) = @_;
  my $prp = "$projid/$repoid";
  my @qbins = split(',', $cgi->{'binaries'} || '');
  my $bins = findbinaries($prp, $arch, @qbins);
  my @res;
  for my $n (@qbins) {
    if ($bins->{$n} eq '_gone') {
      push @res, "$n _gone";
      next;
    }
    my @r = getbinarydata("$reporoot/$bins->{$n}");
    my $r = $r[0];
    if ($r->{'error'}) {
      push @res, "$n _bad";
    } else {
      push @res, "$n $r->{'name'}-$r->{'version'}-$r->{'release'}-$r->{'buildtime'} $r->{'buildhost'}";
    }
  }
  return ({ 'binary' => \@res }, $BSXML::binaryversionlist);
}

sub getbinaries {
  my ($cgi, $projid, $repoid, $arch) = @_;
  my $prp = "$projid/$repoid";
  my @qbins = split(',', $cgi->{'binaries'} || '');
  my $bins = findbinaries($prp, $arch, @qbins);
  my @send;
  for my $n (@qbins) {
    if ($bins->{$n} eq '_gone') {
      push @send, {'name' => $n, 'error' => 'not available'};
      next;
    }
    my $r = "$reporoot/$bins->{$n}";
    if ($r =~ /\.rpm$/) {
      push @send, {'name' => "$n.rpm", 'filename' => $r};
    } else {
      push @send, {'name' => "$n.deb", 'filename' => $r};
    }
    next if $cgi->{'nometa'};
    if ($r =~ s/\.(?:rpm|deb)$//) {
      if (-e "$r.meta" || ! -e "$r-MD5SUMS.meta") {
        push @send, {'name' => "$n.meta", 'filename' => "$r.meta"};
      } else {
        push @send, {'name' => "$n.meta", 'filename' => "$r-MD5SUMS.meta"};
      }
    }
  }
  BSServer::reply_cpio(\@send);
  return undef;
}

sub getbinarylist_repository {
  my ($cgi, $projid, $repoid, $arch) = @_;

  my $prp = "$projid/$repoid";
  my $view = $cgi->{'view'} || '';

  if (($view eq 'cache' || $view eq 'cpio') && !$BSStdServer::isajax) {
    my @args;
    push @args, "view=$view";
    push @args, map {"binary=$_"} @{$cgi->{'binary'} || []};
    BSHandoff::handoff($ajaxsocket, "/build/$projid/$repoid/$arch/_repository", undef, @args);
    exit(0);
  }

  if ($view eq 'cache') {
    my $repostate = readxml("$reporoot/$prp/$arch/:repostate", $BSXML::repositorystate, 1) || {};
    my @files;
    push @files, {
      'name' => 'repositorystate',
      'data' => XMLout($BSXML::repositorystate, $repostate),
    };
    my $fd = gensym;
    if (open($fd, '<', "$reporoot/$prp/$arch/:full.cache")) {
      push @files, {
        'name' => 'repositorycache',
        'filename' => $fd,
      }
    }
    BSWatcher::reply_cpio(\@files);
    return undef;
  }

  if ($view eq 'cpio') {
    my $cache = Storable::retrieve("$reporoot/$prp/$arch/:full.cache") || {};
    my @bins = $cgi->{'binary'} ? @{$cgi->{'binary'}} : sort keys %$cache;
    my @files;
    for my $bin (@bins) {
      my $c = $cache->{$bin};
      if (!$c) {
        push @files, {'name' => $bin, 'error' => 'not available'};
        next;
      }
      my $fd = gensym;
      if (!open($fd, '<', "$reporoot/$prp/$arch/:full/$c->{'path'}")) {
        push @files, {'name' => $bin, 'error' => 'not available'};
        next;
      }
      my $n = $bin;
      $n .= $1 if $c->{'path'} =~ /(\.rpm|\.deb)$/;
      push @files, {'name' => $n, 'filename' => $fd},
    }
    BSWatcher::reply_cpio(\@files);
    return undef;
  }

  die("unsupported view '$view'\n") if $view && $view ne 'names';

  my $cache = Storable::retrieve("$reporoot/$prp/$arch/:full.cache") || {};
  my @res;
  my @bins = $cgi->{'binary'} ? @{$cgi->{'binary'}} : sort keys %$cache;
  for my $bin (@bins) {
    my $c = $cache->{$bin};
    if (!$c) {
      push @res, {'filename' => $bin, 'size' => 0};
      next;
    }
    my $n = $bin;
    $n .= $1 if $c->{'path'} =~ /(\.rpm|\.deb)$/;
    my $r = {'filename' => $view eq 'names' ? $n : $c->{'path'}};
    if ($c->{'id'}) {
      my @s = split('/', $c->{'id'}, 3);
      $r->{'mtime'} = $s[0];
      $r->{'size'} = $s[1];
    }
    push @res, $r;
  }
  return ({'binary' => \@res}, $BSXML::binarylist);
}

sub getbinarylist {
  my ($cgi, $projid, $repoid, $arch, $packid) = @_;
  return getbinarylist_repository($cgi, $projid, $repoid, $arch) if $packid eq '_repository';
  my $prp = "$projid/$repoid";
  my $view = $cgi->{'view'} || '';
  if ($view eq 'cpio' && !$BSStdServer::isajax) {
    my @args;
    push @args, "view=$view";
    push @args, map {"binary=$_"} @{$cgi->{'binary'} || []};
    BSHandoff::handoff($ajaxsocket, "/build/$projid/$repoid/$arch/$packid", undef, @args);
    exit(0);
  }
  if ($view eq 'cpio') {
    my @files = ();
    my @bins = grep {/\.(?:rpm|deb)$/} ls("$reporoot/$prp/$arch/$packid");
    for (sort @bins) {
      my $fd = gensym;
      next unless open($fd, '<', "$reporoot/$prp/$arch/$packid/$_");
      push @files, {'name' => $_, 'filename' => $fd},
    }
    BSWatcher::reply_cpio(\@files);
    return undef;
  }
  die("unsupported view '$view'\n") if $view;
  my @res;
  my @bins = grep {/\.(?:rpm|deb)$/} ls("$reporoot/$prp/$arch/$packid");
  for (sort @bins) {
    my @s = stat("$reporoot/$prp/$arch/$packid/$_");
    next unless @s;
    push @res, {'filename' => $_, 'size' => $s[7], 'mtime' => $s[9]};
  }
  return ({'binary' => \@res}, $BSXML::binarylist);
}

sub gethistory {
  my ($cgi, $projid, $repoid, $arch, $packid) = @_;
  my @history;
  local *F;
  if (open(F, '<', "$reporoot/$projid/$repoid/$arch/$packid/history")) {
    while(<F>) {
      chomp;
      push @history, BSFileDB::decode_line($_, $historylay);
    }
  }
  return ({'entry' => \@history}, $BSXML::buildhist);
}

sub getbuildstatus {
  my ($cgi, $projid, $repoid, $arch, $packid) = @_;

  my $res = {'package' => $packid};
  my $ps = readxml("$reporoot/$projid/$repoid/$arch/:packstatus", $BSXML::packstatuslist, 1) || {};
  $ps = (grep {$_->{'name'} eq $packid} @{$ps->{'packstatus'} || []})[0];
  if ($ps && $ps->{'status'} ne 'failed' && $ps->{'status'} ne 'done' && $ps->{'status'} ne 'scheduled') {
    $res->{'code'} = $ps->{'status'};
    $res->{'details'} = $ps->{'error'} if exists $ps->{'error'};
  } else {
    my $status = readxml("$reporoot/$projid/$repoid/$arch/$packid/status", $BSXML::buildstatus, 1);
    if (!$status->{'code'}) {
      $res->{'code'} = $status->{'status'} || 'unknown';
      $res->{'details'} = $status->{'error'} if $status->{'error'};
    } else {
      $res->{'code'} = $status->{'code'};
      $res->{'details'} = $status->{'details'} if $status->{'details'};
    }
    if ($status->{'job'}) {
      my $jobstatus = readxml("$jobsdir/$arch/$status->{'job'}:status", $BSXML::jobstatus, 1); 
      if ($jobstatus) {
        delete $res->{'details'};
        $res->{'code'} = $jobstatus->{'code'};
        $res->{'details'} = $jobstatus->{'details'} if $jobstatus->{'details'};
	if ($jobstatus->{'code'} eq 'building' && $jobstatus->{'workerid'}) {
	  $res->{'details'} = "building on $jobstatus->{'workerid'}";
	}
      }
    }
  }
  return ($res, $BSXML::buildstatus);
}

sub getlogfile {
  my ($cgi, $projid, $repoid, $arch, $packid) = @_;

  if ($cgi->{'handoff'} && !$BSStdServer::isajax) {
    my @args = ();
    push @args, 'nostream' if $cgi->{'nostream'};
    push @args, "start=$cgi->{'start'}" if defined $cgi->{'start'};
    push @args, "end=$cgi->{'end'}" if defined $cgi->{'end'};
    my $url = "/build/$projid/$repoid/$arch/$packid/_log";
    BSHandoff::handoff($ajaxsocket, $url, undef, @args);
    exit(0);
  }
  my $status = readxml("$reporoot/$projid/$repoid/$arch/$packid/status", $BSXML::buildstatus, 1);
  my $jobstatus;

  if ($status && $status->{'status'} eq 'scheduled') {
    $jobstatus = readxml("$jobsdir/$arch/$status->{'job'}:status", $BSXML::jobstatus, 1);
  }

  #if ($BSStdServer::isajax) {
  #  $status->{'status'} = 'building';
  #  $status->{'uri'} = 'http://192.168.1.102:4711';
  #}
  if ($jobstatus && $jobstatus->{'code'} && $jobstatus->{'code'} eq 'building' && $jobstatus->{'uri'}) {
    my @args = ();
    push @args, 'nostream' if $cgi->{'nostream'};
    push @args, "start=$cgi->{'start'}" if defined $cgi->{'start'};
    push @args, "end=$cgi->{'end'}" if defined $cgi->{'end'};
    if (!$BSStdServer::isajax) {
      my $url = "/build/$projid/$repoid/$arch/$packid/_log";
      BSHandoff::handoff($ajaxsocket, $url, undef, @args);
      exit(0);
    }
    my $param = {
      'uri' => "$jobstatus->{'uri'}/logfile",
      'joinable' => 1,
      'receiver:application/octet-stream' => \&BSServer::reply_receiver,
    };
    eval {
      BSWatcher::rpc($param, undef, @args);
    };
    return undef unless $@;
    my $err = $@;
    die($err) if $param->{'reply_receiver_called'} || $BSStdServer::isajax;
    $jobstatus = readxml("$jobsdir/$arch/$status->{'job'}:status", $BSXML::jobstatus, 1);
    die($err) if $jobstatus && $jobstatus->{'code'} && $jobstatus->{'code'} eq 'building' && $jobstatus->{'uri'};
    # no longer building, use local logfile
  }
  die("$packid: no logfile\n") unless -e "$reporoot/$projid/$repoid/$arch/$packid/logfile";
  my $start = $cgi->{'start'} || 0;
  my $fd = gensym;
  open($fd, '<', "$reporoot/$projid/$repoid/$arch/$packid/logfile") || die("$reporoot/$projid/$repoid/$arch/$packid/logfile: $!\n");
  defined(sysseek($fd, $start, 0)) || die("sysseek: $!\n");
  BSWatcher::reply_file($fd, 'Content-Type: text/plain');
  close $fd unless $BSStdServer::isajax;
  return undef;
}

sub getbinary {
  my ($cgi, $projid, $repoid, $arch, $packid, $bin) = @_;
  if ($packid eq '_repository' && $bin eq '_buildconfig') {
    my $cfg = BSRPC::rpc("$BSConfig::srcserver/getconfig", undef, "project=$projid", "repository=$repoid");
    return ($cfg, 'Content-Type: text/plain');
  }
  $packid = ':full' if $packid eq '_repository';
  my $path = "$reporoot/$projid/$repoid/$arch/$packid/$bin";
  if ($packid eq ':full' && ! -f $path) {
    my $bins = findbinaries("$projid/$repoid", $arch, $bin);
    die("no such binary '$bin'\n") if $bins->{$bin} eq '_gone';
    $path = $bin = "$reporoot/$bins->{$bin}";
    $bin =~ s/.*\///;
  }
  die("$bin: $!\n") unless -f $path;
  my $type = 'application/x-rpm';
  $type = 'application/x-debian-package' if $bin =~ /\.deb$/;
  BSServer::reply_file($path, "Content-Type: $type");
  return undef;
}

sub isolder {
  my ($old, $new) = @_;
  return 0 if $old !~ /\.rpm$/;
  return 0 unless -e $old;
  my %qold = Build::Rpm::rpmq($old, qw{VERSION RELEASE EPOCH});
  return 0 unless %qold;
  my %qnew = Build::Rpm::rpmq($new, qw{VERSION RELEASE EPOCH});
  return 0 unless %qnew;
  my $vold = $qold{'VERSION'}->[0];
  $vold .= "-$qold{'RELEASE'}->[0]" if $qold{'RELEASE'};
  $vold = "$qold{'EPOCH'}->[0]:$vold" if $qold{'EPOCH'};
  my $vnew = $qnew{'VERSION'}->[0];
  $vnew .= "-$qnew{'RELEASE'}->[0]" if $qnew{'RELEASE'};
  $vnew = "$qnew{'EPOCH'}->[0]:$vnew" if $qnew{'EPOCH'};
  my $r = Build::Rpm::verscmp($vold, $vnew);
  # print "isolder $vold $vnew: $r\n";
  return $r > 0 ? 1 : 0;
}

sub putbinary {
  my ($cgi, $projid, $repoid, $arch, $bin) = @_;
  die("file name must end in .deb, .rpm, or .cpio\n") unless $bin =~ /\.(?:rpm|deb|cpio)$/;
  mkdir_p("$uploaddir");
  my $tdir = "$reporoot/$projid/$repoid/$arch/:full";
  if ($bin =~ /\.cpio$/) {
    my $fdir = "$uploaddir/$$.dir";
    if (-d $fdir) {
      unlink("$fdir/$_") for ls($fdir);
      rmdir($fdir);
    }
    mkdir_p($fdir);
    my $uploaded = BSServer::read_cpio($fdir, 'accept' => '^.+\.(?:rpm|deb|iso|meta)$');
    die("upload error\n") unless $uploaded;
    if ($cgi->{'wipe'}) {
      for (ls($tdir)) {
        unlink("$tdir/$_") || die("unlink $tdir/$_: $!\n");
      }
    }
    my %upfiles = map {$_->{'name'} => 1} @$uploaded;
    mkdir_p($tdir);
    for my $file (@$uploaded) {
      my $fn = $file->{'name'};
      next if $cgi->{'ignoreolder'} && isolder("$tdir/$fn", "$fdir/$fn");
      rename("$fdir/$fn", "$tdir/$fn") || die("rename $fdir/$fn $tdir/$fn: $!\n");
      $fn =~ s/\.(?:rpm|deb|meta)$//;
      unlink("$tdir/$fn.meta") unless $upfiles{"$fn.meta"};
    }
    unlink("$fdir/$_") for ls($fdir);
    rmdir($fdir);
  } else {
    my $fn = "$uploaddir/$$";
    my $tn = "$tdir/$bin";
    die("upload failed\n") unless BSServer::read_file($fn);
    if ($cgi->{'wipe'}) {
      for (ls($tdir)) {
        unlink("$tdir/$_") || die("unlink $tdir/$_: $!\n");
      }
    }
    if ($cgi->{'ignoreolder'} && isolder($tn, $fn)) {
      unlink($fn);
      return $BSStdServer::return_ok;
    }
    mkdir_p($tdir);
    rename($fn, $tn) || die("rename $fn $tn: $!\n");
    if ($tn =~ s/\.(?:rpm|deb)$//) {
      unlink("$tn.meta");
    }
  }
  my $ev = { type => 'scanrepo', 'project' => $projid, 'repository' => $repoid };
  my $evname = "scanrepo:${projid}::$repoid";
  if (-d "$eventdir/$arch") {
    writexml("$eventdir/$arch/.$evname", "$eventdir/$arch/$evname", $ev, $BSXML::event);
    ping($arch);
  }
  return $BSStdServer::return_ok;
}

sub workerstate {
  my ($cgi, $harch, $peerport, $state) = @_;
  die("unsupported architecture '$harch'\n") unless $cando{$harch};
  my $peerip = BSServer::getpeerdata();
  die("cannot get your ip address\n") unless $peerip;
  my $workerid = defined($cgi->{'workerid'}) ? $cgi->{'workerid'} : "$peerip:$peerport";
  my $idlename = "$harch:$workerid";
  $idlename =~ s/\//_/g;
  if ($state eq 'building') {
    unlink("$workersdir/idle/$idlename");
  } elsif ($state eq 'idle') {
    if (-e "$workersdir/building/$idlename") {
      # worker must have crashed, discard old job...
      my $worker = readxml("$workersdir/building/$idlename", $BSXML::worker, 1);
      if ($worker && $worker->{'arch'} && $worker->{'job'}) {
	print "restarting build of job $worker->{'arch'}/$worker->{'job'}\n";
	local *F;
        my $js = BSUtil::lockopenxml(\*F, '<', "$jobsdir/$worker->{'arch'}/$worker->{'job'}:status", $BSXML::jobstatus, 1);
	if ($js) {
          unlink("$jobsdir/$worker->{'arch'}/$worker->{'job'}:status") if $js->{'code'} eq 'building';
	  close F;
        }
      }
    }
    unlink("$workersdir/building/$idlename");
    my $worker = {
      'hostarch' => $harch,
      'ip' => $peerip,
      'port' => $peerport,
      'workerid' => $workerid,
    };
    if (-d "$workersdir/disable") {
      my @dis = ls("$workersdir/disable");
      for (@dis) {
        next unless $workerid =~ /^\Q$_\E/;
        print "worker ip $peerip id $workerid is disabled\n";
        return $BSStdServer::return_ok;
      }
    }
    mkdir_p("$workersdir/idle");
    writexml("$workersdir/idle/.$idlename", "$workersdir/idle/$idlename", $worker, $BSXML::worker);
  } else {
    die("unknown state: $state\n");
  }
  return $BSStdServer::return_ok;
}

sub ping {
  my ($arch) = @_;
  local *F;
  if (sysopen(F, "$eventdir/$arch/.ping", POSIX::O_WRONLY|POSIX::O_NONBLOCK)) {
    syswrite(F, 'x');
    close(F);
  }
}

sub workerstatus {
  my ($cgi) = @_;
  local *D;
  my @idle;
  if (!$cgi->{'scheduleronly'}) {
    for my $w (ls("$workersdir/idle")) {
      my $worker = readxml("$workersdir/idle/$w", $BSXML::worker, 1);
      next unless $worker;
      push @idle, {'hostarch' => $worker->{'hostarch'}, 'uri' => "http://$worker->{'ip'}:$worker->{'port'}", 'workerid' => $worker->{'workerid'}};
    }
  }
  my @building;
  my @a;
  @a = ls($jobsdir) unless $cgi->{'scheduleronly'};
  my @waiting;
  for my $a (@a) {
    my @d = grep {!/^\./ && !/:(?:dir|new)$/} ls("$jobsdir/$a");
    my %d = map {$_ => 1} @d;
    for my $d (grep {/:status$/} @d) {
      delete $d{$d};
      $d =~ s/:status$//;
      my $i = readxml("$jobsdir/$a/$d", $BSXML::buildinfo, 1);
      my $s = readxml("$jobsdir/$a/$d:status", $BSXML::jobstatus, 1);
      print "bad job, no status: $d\n" if !$s;
      print "bad job, no info: $d\n" if !$i;
      next unless $s && $i;
      if ($s->{'code'} ne 'building') {
        delete $d{$d};
        next;
      }
      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'}};
      delete $d{$d};
    }
    push @waiting, {'arch' => $a, 'jobs' => scalar(keys %d)};
  }
  @idle = sort {$a->{'workerid'} cmp $b->{'workerid'} || $a->{'uri'} cmp $b->{'uri'} || $a cmp $b} @idle;
  @building = sort {$a->{'workerid'} cmp $b->{'workerid'} || $a->{'uri'} cmp $b->{'uri'} || $a cmp $b} @building;
  @waiting = sort {$a->{'arch'} cmp $b->{'arch'} || $a cmp $b} @waiting;

  my @scheddata;
  my @schedarchs = grep {s/^bs_sched\.(.*)\.lock$/$1/} sort(ls($rundir));
  push @schedarchs, 'dispatcher' if -e "$rundir/bs_dispatch.lock";
  push @schedarchs, 'publisher' if -e "$rundir/bs_publish.lock";
  @schedarchs = (@{$cgi->{'arch'}}) if $cgi->{'arch'};
  for my $schedarch (@schedarchs) {
    local *F;
    my $scheddata = {'arch' => $schedarch, 'state' => 'dead'};
    my $lock = "bs_sched.$schedarch.lock";
    $lock = 'bs_dispatch.lock' if $schedarch eq 'dispatcher';
    $lock = 'bs_publish.lock' if $schedarch eq 'publisher';
    if (open(F, '<', "$rundir/$lock")) {
      if (!flock(F, LOCK_EX | LOCK_NB)) {
        my @s = stat(F);
        $scheddata->{'state'} = 'running';
        $scheddata->{'starttime'} = $s[9] if @s;
      }
      close F;
    }
    push @scheddata, $scheddata;
  }

  my $ret = {};
  if (!$cgi->{'scheduleronly'}) {
    $ret->{'clients'} = @building + @idle;
    $ret->{'building'} = \@building;
    $ret->{'waiting'} = \@waiting;
    $ret->{'idle'} = \@idle;
  }
  $ret->{'scheduler'} = \@scheddata;
  return ($ret, $BSXML::workerstatus);
}

sub putjob {
  my ($cgi, $arch, $job, $jobid) = @_;

  local *F;
  die("no such job\n") unless -e "$jobsdir/$arch/$job";
  die("job is not building\n") unless -e "$jobsdir/$arch/$job:status";
  my $jobstatus = BSUtil::lockopenxml(\*F, '<', "$jobsdir/$arch/$job:status", $BSXML::jobstatus);
  die("different jobid\n") if $jobstatus->{'jobid'} ne $jobid;
  die("job is not building\n") if $jobstatus->{'code'} ne 'building';
  
  my $infoxml = readstr("$jobsdir/$arch/$job");
  my $infoxmlmd5 = Digest::MD5::md5_hex($infoxml);
  die("job info does not match\n") if $infoxmlmd5 ne $jobid;

  my $info = readxml("$jobsdir/$arch/$job", $BSXML::buildinfo);
  my $projid = $info->{'path'}->[0]->{'project'};

  $jobstatus->{'code'} = 'built';
  $jobstatus->{'endtime'} = time();

  my $idlename = "$jobstatus->{'hostarch'}:$jobstatus->{'workerid'}";
  $idlename =~ s/\//_/g;
  print "oops, we are not building ($idlename)?\n" unless -e "$workersdir/building/$idlename";
  unlink("$workersdir/building/$idlename");

  # right job, fetch everything!
  my $dir = "$jobsdir/$arch/$job:dir";
  mkdir_p($dir);
  my $uploaded = BSServer::read_cpio($dir, 'accept' => '^(meta|.*\.rpm|.*\.deb|.*\.iso|logfile)$');
  die("upload error\n") unless $uploaded;
  if ($BSConfig::sign) {
    my $signargs = [];
    my $signkey = BSRPC::rpc("$BSConfig::srcserver/getsignkey", undef, "project=$projid");
    if ($signkey) {
      mkdir_p("$uploaddir");
      writestr("$uploaddir/repserver.$$", undef, $signkey);
      $signargs = [ '-P', "$uploaddir/repserver.$$" ];
    }
    # get us the sign key
    for my $file (@$uploaded) {
      next unless $file->{'name'} =~ /\.rpm$/;
      if (system($BSConfig::sign, @$signargs, '-r', "$dir/$file->{'name'}")) {
	print "sign $dir/$file->{'name'} failed: $?\n";
      }
    }
    unlink("$uploaddir/repserver.$$") if $signkey;
  }

  # write now jobstatus and free lock
  $jobstatus->{'code'} = 'finished';
  writexml("$jobsdir/$arch/.$job:status", "$jobsdir/$arch/$job:status", $jobstatus, $BSXML::jobstatus);
  close F;

  mkdir_p("$eventdir/$arch");
  my $ev = {'type' => 'built', 'job' => $job};
  writexml("$eventdir/$arch/.finished:$job$$", "$eventdir/$arch/finished:$job", $ev, $BSXML::event);
  ping($arch);

  my $success = 0;
  for my $file (@$uploaded) {
    next unless $file->{'name'} =~ /\.(?:rpm|deb|iso)$/;
    $success = 1;
    last;
  }
  BSHermes::notify($success ? "BUILD_SUCCESS" :  "BUILD_FAIL", $info);

  return $BSStdServer::return_ok;
}

sub forwardevent {
  my ($cgi, $type, $projid, $packid, $repoid, $arch) = @_;
  my $ev = { type => $type, 'project' => $projid };
  my $evname = "$type:$projid";
  $ev->{'package'} = $packid if defined $packid;
  $evname .= "::$packid" if defined $packid;
  $ev->{'repository'} = $repoid if defined $repoid;
  $evname .= "::$repoid" if defined $repoid;
  mkdir_p("$eventdir/$arch") if $arch;
  # XXX: there should be a better way than to just write in all
  # directories... maybe a architecture list in BSConfig?
  my @archs = $arch ? ($arch) : ls($eventdir);
  for my $a (@archs) {
    next if $a =~ /^\./;
    next unless -d "$eventdir/$a";
    next if $a eq 'publish' || $a eq 'repository' || $a eq 'watch';
    writexml("$eventdir/$a/.$evname", "$eventdir/$a/$evname", $ev, $BSXML::event);
    ping($a);
  }
  return $BSStdServer::return_ok;
}

sub fixpackstatus {
  my ($prpa, $ps, $buildingjobs) = @_;
  return unless $ps && $ps->{'packstatus'};
  $buildingjobs ||= {};
  my ($prp, $arch) = $prpa =~ /(.*)\/([^\/]*)$/;
  for my $p (@{$ps->{'packstatus'}}) {
    $p->{'status'} = 'unknown' unless $p->{'status'};
    if ($p->{'status'} eq 'done') {
      if (-e "$reporoot/$prpa/:logfiles.fail/$p->{'name'}") {
	$p->{'status'} = 'failed';
      } else {
	$p->{'status'} = 'succeeded';
      }
    } elsif ($p->{'status'} eq 'scheduled') {
      if (!$buildingjobs->{$arch}) {
	my $ba = {};
        for (grep {s/\:status$//} ls("$jobsdir/$arch")) {
	  if (/^(.*)-[0-9a-f]{32}$/s) {
	    $ba->{$1} = $_;
	  } else {
	    $ba->{$_} = $_;
          }
	}
	$buildingjobs->{$arch} = $ba;
      }
      my $job = jobname($prp, $p->{'name'});
      $job = $buildingjobs->{$arch}->{$job};
      if ($job) {
        my $js = readxml("$jobsdir/$arch/$job:status", $BSXML::jobstatus, 1);
	$p->{'status'} = $js->{'code'};
        $p->{'error'} = $js->{'details'} if $js->{'details'};
        $p->{'error'} = "building on $js->{'workerid'}" if $js->{'code'} eq 'building';
      }
    }
  }
}

sub getresult {
  my ($cgi, $prpas) = @_;

  if ($cgi->{'oldstate'} && $BSStdServer::isajax) {
    for my $prpa (@$prpas) {
      BSWatcher::addfilewatcher("$reporoot/$prpa/:packstatus");
    }
  }
  my $r = [];
  my $state = '';
  my %packfilter = map {$_ => 1} @{$cgi->{'package'} || []};
  my %code = map {$_ => 1} @{$cgi->{'code'} || []};
  my %buildingjobs;
  for my $prpa (@$prpas) {
    $state .= "$prpa\0\0";
    my $ps = readxml("$reporoot/$prpa/:packstatus", $BSXML::packstatuslist, 1);
    next unless $ps;
    if (%packfilter && $ps->{'packstatus'}) {
      $ps->{'packstatus'} = [ grep {$packfilter{$_->{'name'}}} @{$ps->{'packstatus'}} ];
    }
    my $sl = {'project' => $ps->{'project'}, 'repository' => $ps->{'repository'}, 'arch' => $ps->{'arch'}};
    fixpackstatus($prpa, $ps, \%buildingjobs);
    for my $p (@{$ps->{'packstatus'} || []}) {
      next if %code && !$code{$p->{'status'}};
      my $packid = $p->{'name'};
      my $s = {'package' => $packid, 'code' => $p->{'status'}};
      $s->{'details'} = $p->{'error'} if $p->{'error'};
      $state .= "$p->{'name'}\0$p->{'status'}\0";
      push @{$sl->{'status'}}, $s;
      if ($cgi->{'withbinarylist'}) {
	my @b;
	if (opendir(D, "$reporoot/$prpa/$packid")) {
	  @b = grep {/\.(?:rpm|deb)$/} readdir(D);
	  closedir D;
	}
	for (@b) {
	  my @s = stat("$reporoot/$prpa/$packid/$_");
	  $_ = {'filename' => $_};
	  $_->{'mtime'} = $s[9] if @s;
	}
	my $bl = {'package' => $packid, 'binary' => \@b};
	push @{$sl->{'binarylist'}}, $bl;
      }
    }
    push @$r, $sl;
  }
  $state = Digest::MD5::md5_hex($state);
  if ($cgi->{'oldstate'} && $state eq $cgi->{'oldstate'}) {
    return if $BSStdServer::isajax;	# watcher will call us back...
    my @args = map {"prpa=$_"} @{$prpas || []};
    push @args, "oldstate=$cgi->{'oldstate'}";
    push @args, map {"package=$_"} @{$cgi->{'package'} || []};
    push @args, map {"code=$_"} @{$cgi->{'code'} || []};
    push @args, "withbinarylist=1" if $cgi->{'withbinarylist'};
    BSHandoff::handoff($ajaxsocket, '/_result', undef, @args);
    exit(0);
  }
  return ({'result' => $r, 'state' => $state}, $BSXML::resultlist);
}

sub docommand {
  my ($cgi, $cmd, $prpas) = @_;
  my %code = map {$_ => 1} @{$cgi->{'code'} || []};
  my %buildingjobs;
  for my $prpa (@$prpas) {
    my ($projid, $repoid, $arch) = split('/', $prpa);
    my @packids = @{$cgi->{'package'} || []};
    if (%code) {
      my $ps = readxml("$reporoot/$prpa/:packstatus", $BSXML::packstatuslist, 1) || {};
      fixpackstatus($prpa, $ps, \%buildingjobs);
      my %c = map {$_->{'name'} => $_->{'status'}} @{$ps->{'packstatus'} || []};
      @packids = grep {$code{$c{$_} || 'unknown'}} @packids;
    }
    if ($cmd eq 'rebuild') {
      for my $packid (@packids) {
	unlink("$reporoot/$projid/$repoid/$arch/:meta/$packid");
	my $ev = { type => 'rebuild', 'project' => $projid, 'package' => $packid };
	my $evname = "rebuild:${projid}::$packid";
	if (-d "$eventdir/$arch") {
	  writexml("$eventdir/$arch/.$evname", "$eventdir/$arch/$evname", $ev, $BSXML::event);
	}
      }
      ping($arch);
    } elsif ($cmd eq 'killbuild' || $cmd eq 'abortbuild') {
      for my $packid (@packids) {
	eval {
	  abortbuild($cgi, $projid, $repoid, $arch, $packid);
	};
	warn("$@") if $@;
      }
    } elsif ($cmd eq 'restartbuild') {
      for my $packid (@packids) {
	eval {
	  restartbuild($cgi, $projid, $repoid, $arch, $packid);
	};
	warn("$@") if $@;
      }
    } elsif ($cmd eq 'wipe') {
      for my $packid (@packids) {
	forwardevent($cgi, 'wipe', $projid, $packid, $repoid, $arch);
      }
    }
  }
  return $BSStdServer::return_ok;
}

sub getjobhistory {
  my ($cgi, $arch) = @_;
  my $ret;
  $ret->{'jobhist'} = [ BSFileDB::fdb_getall("$infodir/$arch/jobhistory", $BSXML::jobhistlay) ];
  return ($ret, $BSXML::jobhistlist);
}

sub getbuildinfo {
  my ($cgi, $projid, $repoid, $arch, $packid, $pdata) = @_;
  my $projpack;

  my $uploaded;
  if (!$pdata) {
    $projpack = BSRPC::rpc("$BSConfig::srcserver/getprojpack", $BSXML::projpack, 'withsrcmd5', 'withdeps', 'withrepos', 'expandedrepos', 'withremotemap', 'ignoredisable', "project=$projid", "repository=$repoid", "arch=$arch", "package=$packid");
    die("no such project/package/repository\n") unless $projpack->{'project'};
  } else {
    $projpack = BSRPC::rpc("$BSConfig::srcserver/getprojpack", $BSXML::projpack, 'withrepos', 'expandedrepos', 'withremotemap', "project=$projid", "repository=$repoid", "arch=$arch");
    die("no such project/repository\n") unless $projpack->{'project'};
    $uploaded = 1;
  }
  my %remotemap = map {$_->{'project'} => $_} @{$projpack->{'remotemap'} || []};
  my $proj = $projpack->{'project'}->[0];
  die("no such project\n") unless $proj && $proj->{'name'} eq $projid;
  my $repo = $proj->{'repository'}->[0];
  die("no such repository\n") unless $repo && $repo->{'name'} eq $repoid;
  if (!$pdata) {
    $pdata = $proj->{'package'}->[0];
    die("no such package\n") unless $pdata && $pdata->{'name'} eq $packid;
  }

  my @prp = map {"$_->{'project'}/$_->{'repository'}"} @{$repo->{'path'} || []};
  my $config = BSRPC::rpc("$BSConfig::srcserver/getconfig", undef, "project=$projid", "repository=$repoid");
  my $bconf = Build::read_config($arch, [split("\n", $config)]);

  my $ret;
  $ret->{'project'} = $projid;
  $ret->{'repository'} = $repoid;
  $ret->{'package'} = $packid if defined $packid;
  $ret->{'arch'} = $arch;
  $ret->{'path'} = $repo->{'path'} || [];
  $ret->{'srcmd5'} = $pdata->{'srcmd5'} if $pdata->{'srcmd5'};
  $ret->{'verifymd5'} = $pdata->{'verifymd5'} || $pdata->{'srcmd5'} if $pdata->{'verifymd5'} || $pdata->{'srcmd5'};
  $ret->{'rev'} = $pdata->{'rev'} if $pdata->{'rev'};
  if ($pdata->{'error'}) {
    $ret->{'error'} = $pdata->{'error'};
    return ($ret, $BSXML::buildinfo);
  }

  if (defined($packid) && exists($pdata->{'versrel'})) {
    $ret->{'versrel'} = $pdata->{'versrel'};
    my $h = BSFileDB::fdb_getmatch("$reporoot/$projid/$repoid/$arch/$packid/history", $historylay, 'versrel', $pdata->{'versrel'}, 1);
    $h = {'bcnt' => 0} unless $h;
    $ret->{'bcnt'} = $h->{'bcnt'} + 1;
    my $release = $ret->{'versrel'};
    $release =~ s/.*-//;
    if (exists($bconf->{'release'})) {
      if (defined($bconf->{'release'})) {
	$ret->{'release'} = $bconf->{'release'};
	$ret->{'release'} =~ s/\<CI_CNT\>/$release/g;
	$ret->{'release'} =~ s/\<B_CNT\>/$ret->{'bcnt'}/g;
      }
    } else {
      $ret->{'release'} = "$release.".$ret->{'bcnt'};
    }
  }

  my $info = $pdata->{'info'}->[0];
  die("bad info\n") unless $info && ( $info->{'repository'} eq $repoid || $info->{'repository'} eq "images" );
  if ($info->{'error'}) {
    $ret->{'error'} = $info->{'error'};
    return ($ret, $BSXML::buildinfo);
  }
  $ret->{'specfile'} = $info->{'file'} unless $uploaded;
  $ret->{'file'} = $info->{'file'} unless $uploaded;
  $info->{'file'} =~ /\.(spec|dsc|kiwi)$/;
  if ($1 && 'kiwi' eq $1) {
    # Dependency breaking shall be ignored for real usage
    $bconf->{'ignore'} = '';
    # Collect kiwi image types
    my @types = @{$info->{'imagetype'} || []};
    $ret->{'imagetype'} = \@types unless $uploaded;
  }

  # read repository data from cache
  my %repodata;
  for my $prp (@prp) {
    my ($rprojid, $rrepoid) = split('/', $prp, 2);
    my $cache;
    if ($remotemap{$rprojid}) {
      my $remote = $remotemap{$rprojid};
      print "fetching remote repository state for $rprojid\n";
      my $param = {
        'uri' => "$remote->{'remoteurl'}/build/$remote->{'remoteproject'}/$rrepoid/$arch/_repository",
        'timeout' => 300,
        'receiver' => \&BSHTTP::cpio_receiver,
      };
      my $cpio = BSRPC::rpc($param, undef, "view=cache");
      my %cpio = map {$_->{'name'} => $_->{'data'}} @{$cpio || []};
      my $cachedata = $cpio{'repositorycache'};
      next unless $cachedata;
      eval { $cache = Storable::thaw(substr($cachedata, 4)); };
      undef $cachedata;
      warn($@) if $@;
    } else {
      next unless -e "$reporoot/$prp/$arch/:full.cache";
      $cache = Storable::retrieve("$reporoot/$prp/$arch/:full.cache");
    }
    next unless ref($cache) eq 'HASH';
    $repodata{$prp} = $cache;
  }
  my @repos = map {$repodata{$_} || {}} @prp;
  my %dep2src;
  my %dep2rpm;
  my %dep2prp;
  for my $prp (reverse @prp) {
    my $r = $repodata{$prp};
    for (keys %$r) {
      if (!defined($r->{$_}->{'source'})) {
	print "Warning: $_ in $prp has no source\n";
      }
      $dep2src{$_} = $r->{$_}->{'source'};
      $dep2rpm{$_} = $r->{$_};
      $dep2prp{$_} = $prp;
    }
  }
  my $pname = $info->{'name'};
  my @subpacks = grep {$dep2src{$_} eq $pname} keys %dep2src;
  #$ret->{'subpack'} = \@subpacks;
  Build::readdeps($bconf, undef, reverse @repos);
  my @deps = @{$info->{'dep'} || []};
  $info->{'file'} =~ /\.(spec|dsc|kiwi)$/;
  if ($1 && $1 ne $bconf->{'type'}) {
    if ( $1 eq 'spec' ) {
      push @deps, 'rpm';
    } elsif ( $1 eq 'dsc' ) {
      push @deps, 'dpkg';
    } elsif ( $1 eq 'kiwi' ) {
      push @deps, 'kiwi';
    } else {
      die( "unknown depency type!" );
    };
  }
  $Build::expand_dbg = 1 if $cgi->{'debug'};
  my @edeps = Build::get_deps($bconf, \@subpacks, @deps);
  undef $Build::expand_dbg if $cgi->{'debug'};
  if (! shift @edeps) {
    $ret->{'error'} = "expansion error: ".join(', ', @edeps);
    return ($ret, $BSXML::buildinfo);
  }
  $Build::expand_dbg = 1 if $cgi->{'debug'};
  my @bdeps;
  if (!$cgi->{'deps'}) {
    @bdeps = Build::get_build($bconf, \@subpacks, @deps, @{$cgi->{'add'} || []});
  } else {
    @bdeps = Build::get_deps($bconf, \@subpacks, @deps, @{$cgi->{'add'} || []});
  }
  undef $Build::expand_dbg if $cgi->{'debug'};
  if (! shift @bdeps) {
    $ret->{'error'} = "expansion error: ".join(', ', @bdeps);
    return ($ret, $BSXML::buildinfo);
  }
  if ($cgi->{'internal'}) {
    $ret->{'dep'} = \@edeps;
    @bdeps = map {{'name' => $_}} @bdeps;
    $ret->{'bdep'} = \@bdeps;
    $ret->{'pdep'} = [ Build::get_preinstalls($bconf) ];
    return ($ret, $BSXML::buildinfo);
  }

  my @pdeps = Build::get_preinstalls($bconf);
  my @vmdeps = Build::get_vminstalls($bconf);
  my %runscripts = map {$_ => 1} Build::get_runscripts($bconf);
  my %pdeps = map {$_ => 1} @pdeps;
  my %vmdeps = map {$_ => 1} @vmdeps;
  my %edeps = map {$_ => 1} @edeps;

  @bdeps = (@pdeps, @vmdeps, @edeps, @bdeps);
  my %ddeps;
  for (splice(@bdeps)) {
    next if $ddeps{$_};
    push @bdeps, $_;
    $ddeps{$_} = 1; 
  }
  my @bdepsp = ();
  for (@bdeps) {
    my $p = $dep2rpm{$_}->{'path'};
    $p =~ s/.*\///;
    push @bdepsp, "$reporoot/$dep2prp{$_}/$arch/:full/$p";
  }
  @bdepsp = getbinarydata(@bdepsp);
  my %bdepsp = map {$_->{'name'} => $_} grep {exists($_->{'name'})} @bdepsp;
  for (@bdeps) {
    $_ = {'name' => $_};
    if ($dep2prp{$_->{'name'}}) {
      ($_->{'project'}, $_->{'repository'}) = split('/', $dep2prp{$_->{'name'}}, 2);
    }
    my $r = $bdepsp{$_->{'name'}};
    if ($r) {
      $_->{'version'} = $r->{'version'};
      $_->{'release'} = $r->{'release'} if exists $r->{'release'};
      $_->{'arch'} = $r->{'arch'};
    }
    $_->{'preinstall'} = 1 if $pdeps{$_->{'name'}};
    $_->{'vminstall'} = 1 if $vmdeps{$_->{'name'}};
    $_->{'runscripts'} = 1 if $runscripts{$_->{'name'}};
    $_->{'notmeta'} = 1 unless $edeps{$_->{'name'}};
  }
  $ret->{'dep'} = \@edeps;
  $ret->{'bdep'} = \@bdeps;
  $ret->{'pdep'} = \@pdeps;

  return ($ret, $BSXML::buildinfo);
}

sub looks_like_dsc {
  my ($fn) = @_;
  local *F;
  if (!open(F, '<', $fn)) {
    return 0;
  }
  my $l = <F>;
  if ($l =~ /^-----BEGIN/) {
    $l = <F>;
    $l = <F>;
    $l = <F>;
  }
  if ($l =~ /^format:/i) {
    close F;
    return 1;
  }
  close F;
  return 0;
}

sub getbuildinfo_post {
  my ($cgi, $projid, $repoid, $arch, $packid) = @_;

  undef $packid if $packid eq '_repository';
  my $config = BSRPC::rpc("$BSConfig::srcserver/getconfig", undef, "project=$projid", "repository=$repoid");
  my $bconf = Build::read_config($arch, [split("\n", $config)]);

  mkdir_p("$uploaddir");
  my $fn = "$uploaddir/$$";
  die("upload failed\n") unless BSServer::read_file($fn);
  my $d;
  my $info = {'repository' => $repoid};
  if (looks_like_dsc($fn)) {
    $d = Build::Deb::parse($bconf, $fn);
    $info->{'file'} = 'upload.dsc';
  } else {
    $d = Build::Rpm::parse($bconf, $fn);
    $info->{'file'} = 'upload.spec';
  }
  unlink($fn);
  die("parse error\n") unless defined $d->{'name'};
  $info->{'name'} = $d->{'name'};
  $info->{'dep'} = $d->{'deps'};
  my $pdata = {'info' => [ $info ]};
  return getbuildinfo($cgi, $projid, $repoid, $arch, $packid, $pdata);
}

### FIXME: read status instead!
sub findjob {
  my ($projid, $repoid, $arch, $packid) = @_;

  my $prp = "$projid/$repoid";
  my $job = jobname($prp, $packid);
  my @jobdatadirs = grep {$_ eq "$job:status" || /^\Q$job\E-[0-9a-f]{32}:status$/} ls("$jobsdir/$arch");
  return undef unless @jobdatadirs;
  $job = $jobdatadirs[0];
  $job =~ s/:status$//;
  return $job;
}

sub restartbuild {
  my ($cgi, $projid, $repoid, $arch, $packid) = @_;

  my $job = findjob($projid, $repoid, $arch, $packid);
  die("not building\n") unless $job;

  local *F;
  my $js = BSUtil::lockopenxml(\*F, '<', "$jobsdir/$arch/$job:status", $BSXML::jobstatus);
  die("not building\n") if $js->{'code'} ne 'building';
  my $req = {
    'uri' => "$js->{'uri'}/discard",
    'timeout' => 30,
  };
  eval {
    BSRPC::rpc($req, undef, "jobid=$js->{'jobid'}");
  };
  warn($@) if $@;
  unlink("$jobsdir/$arch/$job:status");
  close F;
  return $BSStdServer::return_ok;
}

sub abortbuild {
  my ($cgi, $projid, $repoid, $arch, $packid) = @_;

  my $job = findjob($projid, $repoid, $arch, $packid);
  die("not building\n") unless $job;
  local *F;
  my $js = BSUtil::lockopenxml(\*F, '<', "$jobsdir/$arch/$job:status", $BSXML::jobstatus);
  die("not building\n") if $js->{'code'} ne 'building';
  my $req = {
    'uri' => "$js->{'uri'}/kill",
    'timeout' => 30,
  };
  BSRPC::rpc($req, undef, "jobid=$js->{'jobid'}");
  return $BSStdServer::return_ok;
}

sub getcode {
  my ($cgi, $dir) = @_;
  my @send;
  for my $file (grep {!/^\./} ls($dir)) {
    if ($file eq 'Build' && -d "$dir/$file") {
      for my $file2 (grep {!/^\./} ls("$dir/Build")) {
	push @send, {'name' => "$file2", 'filename' => "$dir/Build/$file2"};
      }
    }
    next unless -f "$dir/$file";
    push @send, {'name' => "$file", 'filename' => "$dir/$file"};
  }
  die("$dir is empty\n") unless @send;
  BSServer::reply_cpio(\@send);
  return undef;
}

sub getbuildcode {
  my ($cgi) = @_;
  return getcode($cgi, 'build');
}

sub getworkercode {
  my ($cgi) = @_;
  return getcode($cgi, 'worker');
}

sub postrepo {
  my ($cgi, $projid, $repoid, $arch) = @_;

  my $projpack = BSRPC::rpc("$BSConfig::srcserver/getprojpack", $BSXML::projpack, 'withrepos', 'expandedrepos', "project=$projid", "repository=$repoid", "arch=$arch");
  my $proj = $projpack->{'project'}->[0];
  die("no such project\n") unless $proj && $proj->{'name'} eq $projid;
  my $repo = $proj->{'repository'}->[0];
  die("no such repository\n") unless $repo && $repo->{'name'} eq $repoid;
  my @prp = map {"$_->{'project'}/$_->{'repository'}"} @{$repo->{'path'} || []};
  my %data;
  for my $prp (reverse @prp) {
    next unless -e "$reporoot/$prp/$arch/:full.cache";
    my $cache;
    $cache = Storable::retrieve("$reporoot/$prp/$arch/:full.cache");
    next unless ref($cache) eq 'HASH';
    %data = (%data, %$cache);
  }
  my @data;
  for (sort keys %data) {
    push @data, $data{$_};
    $data[-1]->{'_content'} = $data[-1]->{'name'};
  }
  my $match = $cgi->{'match'};
  $match = "[$match]" unless $match =~ /^[\.\/]?\[/;
  $match = ".$match" if $match =~ /^\[/;
  my $v = BSXPath::valuematch(\@data, $match);
  return {'value' => $v}, $BSXML::collection;
}

my %prp_to_repoinfo;

sub prp_to_repoinfo {
  my ($prp) = @_;

  my $repoinfo = $prp_to_repoinfo{$prp};
  if (!$repoinfo) {
    if (-s "$reporoot/$prp/:repoinfo") {
      $repoinfo = Storable::retrieve("$reporoot/$prp/:repoinfo");
      for (@{$repoinfo->{'prpsearchpath'} || []}) {
	next if ref($_);	# legacy
	my ($p, $r) = split('/', $_, 2);
	$_ = {'project' => $p, 'repository' => $r};
      }
    } else {
      $repoinfo = {'binaryorigins' => {}};
    }
    $prp_to_repoinfo{$prp} = $repoinfo;
  }
  return $repoinfo;
}

sub binary_key_to_data {
  my ($db, $key) = @_; 
  my @p = split('/', $key);
  my $binary = pop(@p);
  my $name = $binary;
  my $version = '';
  if ($name =~ s/-([^-]+-[^-]+)\.[^\.]+\.rpm$//) {
    $version = $1;
  } elsif ($name =~ s/_([^_]+)_[^_]+\.deb$//) {
    $version = $1;
  }
  my $arch = pop(@p);
  while (@p > 1 && $p[0] =~ /:$/) {
    splice(@p, 0, 2, "$p[0]$p[1]");
  }
  my $project = shift(@p);
  while (@p > 1 && $p[0] =~ /:$/) {
    splice(@p, 0, 2, "$p[0]$p[1]");
  }
  my $repository = shift(@p);
  my $prp = "$project/$repository";
  my $repoinfo = $prp_to_repoinfo{$prp} || prp_to_repoinfo($prp);
  my $type;
  $type = 'rpm' if $binary =~ /\.rpm$/;
  $type = 'deb' if $binary =~ /\.deb$/;
  my $res = {
    'name' => $name,
    'version' => $version,
    'arch' => $arch,
    'type' => $type,
    'project' => $project,
    'repository' => $repository,
    'filename' => $binary,
    'filepath' => $key,
  };
  $res->{'path'} = $repoinfo->{'prpsearchpath'} if $repoinfo->{'prpsearchpath'};
  $res->{'package'} = $repoinfo->{'binaryorigins'}->{"$arch/$binary"} if defined $repoinfo->{'binaryorigins'}->{"$arch/$binary"};
  $res->{'baseproject'} = $res->{'path'}->[-1]->{'project'} if $res->{'path'};
  return $res;
}

sub pattern_key_to_data {
  my ($db, $key) = @_; 
  my @p = split('/', $key);
  my $filename = pop(@p);
  while (@p > 1 && $p[0] =~ /:$/) {
    splice(@p, 0, 2, "$p[0]$p[1]");
  }
  my $project = shift(@p);
  while (@p > 1 && $p[0] =~ /:$/) {
    splice(@p, 0, 2, "$p[0]$p[1]");
  }
  my $repository = shift(@p);
  my @v = BSDBIndex::getvalues($db, $db->{'table'}, $key);
  return {} unless @v;
  my $res = $v[0];
  $res->{'baseproject'} = $res->{'path'}->[-1]->{'project'} if $res->{'path'};
  $res->{'project'} = $project;
  $res->{'repository'} = $repository;
  $res->{'filename'} = $filename;
  $res->{'filepath'} = $key;
  return $res;
}

sub search_published_binary_id {
  my ($cgi, $match) = @_;
  my $binarydb = BSDB::opendb($extrepodb, 'binary');
  $binarydb->{'allkeyspath'} = 'name';
  $binarydb->{'noindex'} = {'arch' => 1, 'project' => 1, 'repository' => 1, 'package' => 1, 'type' => 1, 'path/project' => 1, 'path/repository' => 1};
  $binarydb->{'fetch'} = \&binary_key_to_data;
  $binarydb->{'cheapfetch'} = 1;
  my $rootnode = BSXPathKeys::node($binarydb, '');
  my $data = BSXPath::match($rootnode, $match) || [];
  # epoch?
  @$data = sort {Build::Rpm::verscmp($b->{'version'}, $a->{'version'}) || $a->{'name'} cmp $b->{'name'} || $a->{'arch'} cmp $b->{'arch'}} @$data;
  delete $_->{'path'} for @$data;
  my $res = {'binary' => $data};
  return ($res, $BSXML::collection);
}

sub search_published_pattern_id {
  my ($cgi, $match) = @_;
  my $patterndb = BSDB::opendb($extrepodb, 'pattern');
  $patterndb->{'noindex'} = {'project' => 1, 'repository' => 1};
  $patterndb->{'fetch'} = \&pattern_key_to_data;
  my $rootnode = BSXPathKeys::node($patterndb, '');
  my $data = BSXPath::match($rootnode, $match) || [];
  for (@$data) {
    delete $_->{'path'};
    delete $_->{'description'};
    delete $_->{'summary'};
  }
  my $res = {'pattern' => $data};
  return ($res, $BSXML::collection);
}

sub listpublished {
  my ($dir, $fileok) = @_;
  my @r;
  for my $d (ls($dir)) {
    if ($fileok && -f "$dir/$d") {
      push @r, $d;
      next;
    }
    next unless -d "$dir/$d";
    if ($d =~ /:$/) {
      my $dd = $d;
      chop $dd;
      push @r, map {"$dd:$_"} listpublished("$dir/$d");
    } else {
      push @r, $d;
    }
  }
  return @r;
}

sub findympbinary {
  my ($binarydir, $binaryname) = @_;
  for my $b (ls($binarydir)) {
    next unless $b =~ /\.(?:rpm|deb)$/;
    next unless $b =~ /^\Q$binaryname\E/;
    my $data = Build::query("$binarydir/$b", 'evra' => 1);
    if ($data->{'name'} eq $binaryname || "$data->{'name'}-$data->{'version'}" eq $binaryname) {
      return "$binarydir/$b";
    }
  }
  return undef;
}

sub publisheddir {
  my ($cgi, $projid, $repoid, $arch) = @_;
  my @res = ();
  if (!defined($projid)) {
    @res = listpublished($extrepodir);
  } elsif (!defined($repoid)) {
    my $prp_ext = $projid;
    $prp_ext =~ s/:/:\//g;
    @res = listpublished("$extrepodir/$prp_ext");
  } elsif (!defined($arch)) {
    my $prp_ext = "$projid/$repoid";
    $prp_ext =~ s/:/:\//g;
    @res = listpublished("$extrepodir/$prp_ext", 1);
  } else {
    my $prp_ext = "$projid/$repoid";
    $prp_ext =~ s/:/:\//g;
    if ($cgi->{'view'} eq 'ymp') {
      my $binaryname = $arch;
      my $binary;
      my @archs = ls("$extrepodir/$prp_ext");
      for my $a (@archs) {
	next unless -d "$extrepodir/$prp_ext/$a";
	$binary = findympbinary("$extrepodir/$prp_ext/$a", $binaryname);
	last if $binary;
      }
      $binary ||= "$extrepodir/$prp_ext/$binaryname";
      return makeymp($projid, $repoid, $binary);
    }
    return publishedfile($cgi, $projid, $repoid, undef, $arch) if -f "$extrepodir/$prp_ext/$arch";
    @res = ls("$extrepodir/$prp_ext/$arch");
  }
  @res = sort @res;
  @res = map {{'name' => $_}} @res;
  return ({'entry' => \@res}, $BSXML::dir);
}

sub makeymp {
  my ($projid, $repoid, $binary) = @_;

  my $binaryname;
  my $data;
  if ($binary =~ /(?:^|\/)([^\/]+)-[^-]+-[^-]+\.[a-zA-Z][^\/\.\-]*\.rpm$/) {
    $binaryname = $1;
  } elsif ($binary =~ /(?:^|\/)([^\/]+)_([^\/]*)_[^\/]*\.deb$/) {
    $binaryname = $1;
  } elsif ($binary =~ /(?:^|\/)([^\/]+)\.(?:rpm|deb)$/) {
    $binaryname = $1;
  } else {
    my $binarydir;
    ($binarydir, $binaryname) = $binary =~ /^(.*)\/([^\/]*)$/;
    $binary = findympbinary($binarydir, $binaryname) || $binary;
  }
  $data = Build::query($binary, 'description' => 1);
  #die("no such binary\n") unless $data;
  my $projpack = BSRPC::rpc("$BSConfig::srcserver/getprojpack", $BSXML::projpack, 'withrepos', 'expandedrepos', 'nopackages', "project=$projid", "repository=$repoid");
  my $proj = $projpack->{'project'}->[0];
  die("no such project\n") unless $proj && $proj->{'name'} eq $projid;
  my $repo = $proj->{'repository'}->[0];
  die("no such repository\n") unless $repo && $repo->{'name'} eq $repoid;
  my @nprojids = grep {$_ ne $projid} map {$_->{'project'}} @{$repo->{'path'} || []};
  my %nprojpack;
  if (@nprojids) {
    my @args = map {"project=$_"} @nprojids;
    my $nprojpack = BSRPC::rpc("$BSConfig::srcserver/getprojpack", $BSXML::projpack, 'nopackages', @args);
    %nprojpack = map {$_->{'name'} => $_} @{$nprojpack->{'project'} || []};
  }
  my $ymp = {};
  $ymp->{'xmlns:os'} = 'http://opensuse.org/Standards/One_Click_Install';
  $ymp->{'xmlns'} = 'http://opensuse.org/Standards/One_Click_Install';
  my @group;
  $ymp->{'group'} = \@group;
  my @repos;
  my @pa = @{$repo->{'path'} || []};
  while (@pa) {
    my $pa = shift @pa;
    my $r = {};
    $r->{'recommended'} = @pa || !@repos ? 'true' : 'false';
    $r->{'name'} = $pa->{'project'};
    if ($pa->{'project'} eq $projid) {
      $r->{'summary'} = $proj->{'title'};
      $r->{'description'} = $proj->{'description'};
    } elsif ($nprojpack{$pa->{'project'}}) {
      $r->{'summary'} = $nprojpack{$pa->{'project'}}->{'title'};
      $r->{'description'} = $nprojpack{$pa->{'project'}}->{'description'};
    }
    my $prp_ext = "$pa->{'project'}/$pa->{'repository'}";
    $prp_ext =~ s/:/:\//g;
    $r->{'url'} = "$BSConfig::repodownload/$prp_ext/";
    push @repos, $r;
  }
  my $pkg = {};
  if ($data) {
    $pkg->{'name'} = str2utf8($data->{'name'});
    $pkg->{'description'} = str2utf8($data->{'description'});
  } else {
    $pkg->{'name'} = str2utf8($binaryname);
    $pkg->{'description'} = "The $pkg->{'name'} package";
  }
  if (defined $data->{'summary'}) {
    $pkg->{'summary'} = str2utf8($data->{'summary'});
  } else {
    $pkg->{'summary'} = "The $pkg->{'name'} package";
  }
  my $inner_group = {};
  $inner_group->{'repositories'} = {'repository' => \@repos };
  $inner_group->{'software'} = {'item' => [$pkg]};
  push @group, $inner_group;
  my $ympxml = XMLout($BSXML::ymp, $ymp);
  return ($ympxml, "Content-Type: text/x-suse-ymp");
}

sub fileinfo {
  my ($cgi, $filepath, $filename) = @_;
  my $res = {'filename' => $filename};
  my $q = {};
  die("filename: $!\n") unless -f $filepath;
  if ($filename =~ /\.(?:rpm|deb)$/) {
    $q = Build::query($filepath, 'evra' => 1, 'description' => 1, 'alldeps' => 1);
    data2utf8($q);
  } elsif ($filename =~ /\.ymp$/) {
    my $ymp = readxml($filepath, $BSXML::ymp, 1);

    if ($ymp) {
      my $g0 = $ymp->{'group'}[0];
      $q->{'name'} = $g0->{'name'} if defined $g0->{'name'};
      $q->{'summary'} = $g0->{'summary'} if defined $g0->{'summary'};
      $q->{'description'} = $g0->{'description'} if defined $g0->{'description'};
      if ($g0->{'repositories'}) {
	$q->{'recommends'} = [ map {$_->{'name'}} grep {$_->{'recommended'} && $_->{'recommended'} eq 'true'} @{$g0->{'packages'}->{'package'} || []} ];
	$q->{'suggests'} = [ map {$_->{'name'}} grep {!($_->{'recommended'} && $_->{'recommended'} eq 'true')} @{$g0->{'packages'}->{'package'} || []} ];
	delete $q->{'recommends'} unless @{$q->{'recommends'}};
	delete $q->{'suggests'} unless @{$q->{'suggests'}};
      }
    }
  }
  for (qw{name epoch version release arch summary description provides requires recommends suggests}) {
    $res->{$_} = $q->{$_} if defined $q->{$_};
  }
  return ($res, $BSXML::fileinfo);
}

sub publishedfile {
  my ($cgi, $projid, $repoid, $arch, $filename) = @_;
  my $prp_ext = "$projid/$repoid";
  $prp_ext .= "/$arch" if defined $arch;
  $prp_ext =~ s/:/:\//g;
  if ($cgi->{'view'} && $cgi->{'view'} eq 'ymp') {
    return makeymp($projid, $repoid, "$extrepodir/$prp_ext/$filename");
  }
  die("no such file\n") unless -f "$extrepodir/$prp_ext/$filename";
  if ($cgi->{'view'} && $cgi->{'view'} eq 'fileinfo') {
    return fileinfo($cgi, "$extrepodir/$prp_ext/$filename", $filename);
  }
  my $type = 'application/x-rpm';
  $type = 'application/x-debian-package' if $filename=~ /\.deb$/;
  BSServer::reply_file("$extrepodir/$prp_ext/$filename", "Content-Type: $type");
  return undef;
}

sub getajaxstatus {
  my ($cgi) = @_;
  if (!$BSStdServer::isajax) {
    BSHandoff::handoff($ajaxsocket, '/ajaxstatus');
    exit(0);
  }
  my $r = BSWatcher::getstatus();
  return ($r, $BSXML::ajaxstatus);
}

sub hello {
  my ($cgi) = @_;
  return "<hello name=\"Package Repository Ajax Server\" />\n" if $BSStdServer::isajax;
  return "<hello name=\"Package Repository Server\" />\n";
}

my $dispatches = [
  '/' => \&hello,

  'POST:/build/$project/$repository/$arch/_repository match:' => \&postrepo,
  '/build/$project/$repository/$arch/$package:package_repository view:? binary:filename*' => \&getbinarylist,
  'POST:/build/$project/$repository/$arch/$package_repository/_buildinfo add:* internal:bool? deps:bool?' => \&getbuildinfo_post,
  '/build/$project/$repository/$arch/$package/_buildinfo add:* internal:bool? debug:bool? deps:bool?' => \&getbuildinfo,
  '/build/$project/$repository/$arch/$package/_status' => \&getbuildstatus,
  '/build/$project/$repository/$arch/$package/_history' => \&gethistory,
  '/build/$project/$repository/$arch/$package/_log nostream:bool? start:num? end:num? handoff:bool?' => \&getlogfile,
  '/build/$project/$repository/$arch/$package:package_repository/$filename' => \&getbinary,
  'PUT:/build/$project/$repository/$arch/_repository/$filename ignoreolder:bool? wipe:bool?' => \&putbinary,
  '/search/published/binary/id $match:' => \&search_published_binary_id,
  '/search/published/pattern/id $match:' => \&search_published_pattern_id,

  # src server calls
  '/event $type: $project $package?' => \&forwardevent,

  # worker calls
  '/worker $arch $port $state: workerid:? working:bool?' => \&workerstate,
  '/getbuildcode' => \&getbuildcode,
  '/getworkercode' => \&getworkercode,
  '/putjob $arch $job $jobid:md5' => \&putjob,
  '/getbinaries $project $repository $arch binaries: nometa:bool?' => \&getbinaries,
  '/getbinaryversions $project $repository $arch binaries:' => \&getbinaryversions,

  # published files
  '/published' => \&publisheddir,
  '/published/$project' => \&publisheddir,
  '/published/$project/$repository' => \&publisheddir,
  '/published/$project/$repository/$arch:filename view:?' => \&publisheddir,
  '/published/$project/$repository/$arch:filename/$filename view:?' => \&publishedfile,

  # info
  '/workerstatus scheduleronly:bool? arch*' => \&workerstatus,
  '/info/$arch/jobhistory' => \&getjobhistory,

  '/_result $prpa+ oldstate:md5? package* code:* withbinarylist:bool?' => \&getresult,
  '/_command $cmd: $prpa+ package* code:*' => \&docommand,
  '/ajaxstatus' => \&getajaxstatus,
];

my $dispatches_ajax = [
  '/' => \&hello,
  '/ajaxstatus' => \&getajaxstatus,
  '/build/$project/$repository/$arch/$package/_log nostream:bool? start:num? end:num?' => \&getlogfile,
  '/build/$project/$repository/$arch/$package:package_repository view:? binary:filename*' => \&getbinarylist,
  '/_result $prpa+ oldstate:md5? package* code:* withbinarylist:bool?' => \&getresult,
];

my $conf = {
  'port' => $port,
  'dispatches' => $dispatches,
  'setkeepalive' => 1, 
  'maxchild' => 20,
};

my $aconf = {
  'socketpath' => $ajaxsocket,
  'dispatches' => $dispatches_ajax,
  'getrequest_timeout' => 10,
  'replrequest_timeout' => 10, 
  'getrequest_recvfd' => \&BSHandoff::receive,
  'setkeepalive' => 1,
};

BSStdServer::server('bs_repserver', \@ARGV, $conf, $aconf);
