Program: CWE-94
Project: CVE-2011-0469
Buggy source:
#!/usr/bin/perl -w
#
# Copyright (c) 2006, 2007 Michael Schroeder, Novell Inc.
# Copyright (c) 2008 Adrian Schroeter, 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 Source Server
#

BEGIN {
  my ($wd) = $0 =~ m-(.*)/- ;
  $wd ||= '.';
  chdir($wd);
  unshift @INC,  "$wd/build";
  unshift @INC,  "$wd";
}

use XML::Structured ':bytes';
use POSIX;
use Digest::MD5 ();
use Data::Dumper;
use Storable ();
use Symbol;

use BSConfig;
use BSRPC ':https';
use BSServer;
use BSUtil;
use BSFileDB;
use BSXML;
use BSVerify;
use BSHandoff;
use BSWatcher ':https';
use BSXPath;
use BSStdServer;
use BSSrcdiff;
use Build;
use BSNotify;

use BSXPath;
use BSXPathKeys;
use BSDB;
use BSDBIndex;

use strict;

my $port = 5352;	#'SR'
$port = $1 if $BSConfig::srcserver =~ /:(\d+)$/;
my $proxy;
$proxy = $BSConfig::proxy if defined($BSConfig::proxy);

my $projectsdir = "$BSConfig::bsdir/projects";
my $eventdir = "$BSConfig::bsdir/events";
my $srcrep = "$BSConfig::bsdir/sources";
my $treesdir = $BSConfig::nosharedtrees ? "$BSConfig::bsdir/trees" : $srcrep;
my $requestsdir = "$BSConfig::bsdir/requests";
my $oldrequestsdir = "$BSConfig::bsdir/requests.old";
my $rundir = $BSConfig::rundir || "$BSConfig::bsdir/run";
my $diffcache = "$BSConfig::bsdir/diffcache";

my $reqindexdb = "$BSConfig::bsdir/db/request";
my $extrepodb = "$BSConfig::bsdir/db/published";
my $sourcedb = "$BSConfig::bsdir/db/source";

my $remotecache = "$BSConfig::bsdir/remotecache";

my $srcrevlay = [qw{rev vrev srcmd5 version time user comment requestid}];
my $eventlay = [qw{number time type project package repository arch}];

my $ajaxsocket = "$rundir/bs_srcserver.ajax";
my $uploaddir = "$srcrep/:upload";

my $repoid;
my %packagequota;

sub notify_repservers {
  my ($type, $projid, $packid) = @_;

  my $ev = {'type' => $type, 'project' => $projid};
  $ev->{'package'} = $packid if defined $packid;
  addevent($ev);

  my @args = ("type=$type", "project=$projid");
  push @args, "package=$packid" if defined $packid;
  for my $rrserver ($BSConfig::reposerver) {
    my $param = {
      'uri' => "$rrserver/event",
      'request'   => 'POST',
      'background' => 1,
    };
    eval {
      BSWatcher::rpc($param, undef, @args);
    };
    print "warning: $rrserver: $@" if $@;
  }
}

sub runservice {
  my ($cgi, $projid, $packid) = @_;

  return if $packid eq "_project";
  return unless $BSConfig::serviceserver;
  die("No project defined for source update!") if !defined $projid;
  die("No package defined for source update!") if !defined $packid;

  # collect current sources to POST them
  my $projectrev = getrev($projid, '_project');
  my $projectfiles = lsrev($projectrev);
  my $rev = getrev($projid, $packid);
  my $files = lsrev($rev);
  unless ($files->{'_service'} || $projectfiles->{'_service'}){
    # drop all existing service files
    my $dirty;
    for my $pfile (keys %$files) {
      if ($pfile =~ /^_service[_:]/) {
        delete $files->{$pfile};
        $dirty = 1;
      }
    }
    if ($dirty){
      addrev($projid, $packid, $files, "_service", "generated via source service", undef);
      notify_repservers('package', $projid, $packid);
    }
    return;
  }

  if ($files->{'_link'}) {
    # make sure it's a branch
    my $l = repreadxml($rev, '_link', $files->{'_link'}, $BSXML::link, 1);
    if (!$l || !$l->{'patches'} || @{$l->{'patches'}->{''} || []} != 1 || (keys %{$l->{'patches'}->{''}->[0]})[0] ne 'branch') {
      mkdir_p($uploaddir);
      writestr("$uploaddir/_service_error$$", undef, "services only work on branches\n");
      $files->{'_service_error'} = addfile($projid, $packid, "$uploaddir/_service_error$$", '_service_error');
      addrev($projid, $packid, $files, "_service", "generated via source service", undef);
      notify_repservers('package', $projid, $packid);
      return;
    }
  }

  my $lockfile = "$eventdir/service/${projid}::$packid";
  mkdir_p("$eventdir/service");
  BSUtil::touch($lockfile);

  # Run the source update in own process (do not wait for it)
  my @send = map {{'name' => $_, 'filename' => "$srcrep/$packid/$files->{$_}-$_"}} sort(keys %$files);
  # add _service file from projects with different name
  my ($projectservices, undef) = getprojectservices($cgi, $projid, $packid);
  if ($projectservices) {
    push @send, {'name' => '_serviceproject', 'data' => XMLout($BSXML::services, $projectservices)};
  };
  # run update as background job
  my $pid = xfork();
  return $BSStdServer::return_ok if $pid;
  my $odir = "$srcrep/:service/$$";
  BSUtil::cleandir($odir) if -d $odir;
  mkdir_p($odir);
  my $receive;
  eval {
    $receive = BSRPC::rpc({
      'uri'       => "$BSConfig::serviceserver/sourceupdate/$projid/$packid",
      'request'   => 'POST',
      'headers'   => [ 'Content-Type: application/x-cpio' ],
      'chunked'   => 1,
      'data'      => \&BSHTTP::cpio_sender,
      'cpiofiles' => \@send,
      'directory' => $odir,
      'timeout'   => 3600,
      'withmd5'   => 1,
      'receiver' => \&BSHTTP::cpio_receiver,
    }, undef);
  };

  my $error = $@;
  
  # make sure that there was no other commit in the meantime
  my $newrev = getrev($projid, $packid);
  exit(1) if $newrev->{'rev'} ne $rev->{'rev'};

  # and update source repository with the result
  if ($receive) {
    # drop all existing service files
    for my $pfile (keys %$files) {
      delete $files->{$pfile} if $pfile =~ /^_service[_:]/;
    }
    # add new service files
    for my $pfile (ls($odir)) {
      unless ($pfile =~ /^_service[_:]/) {
	unlink($lockfile);
	die("ERROR: bs_service returned a non-_service file\n");
      }
      $files->{$pfile} = addfile($projid, $packid, "$odir/$pfile", $pfile);
    }
  } else {
    $error ||= 'error';
    $error =~ s/\n$//s;
    $error = "service daemon error: $error\n";
    writestr("$odir/_service_error", undef, $error);
    $files->{'_service_error'} = addfile($projid, $packid, "$odir/_service_error", '_service_error');
  }
  addrev($projid, $packid, $files, "_service", "generated via source service", undef);
  BSUtil::cleandir($odir);
  rmdir($odir);
  unlink($lockfile);
  notify_repservers('package', $projid, $packid);
  exit(0);
}


#
# run the productconverter on _product to create/update/delete
# all _product:xxx packages
#
sub expandproduct {
  my ($projid, $packid, $files, $user, $fail) = @_;

  if (!$files) {
    # gone!
    # {} argument makes findpackages ignore packages from project links
    my @packages = grep {/^\Q${packid}:\E/} findpackages($projid, {});
    for my $opid (@packages) {
      unlink("$projectsdir/$projid.pkg/$opid.upload-MD5SUMS");
      unlink("$projectsdir/$projid.pkg/$opid.rev");
      unlink("$projectsdir/$projid.pkg/$opid.xml");
      notify_repservers('package', $projid, $opid);
    }
    return 1;
  }
  my $dir = "$uploaddir/expandproduct_$$";
  BSUtil::cleandir($dir);
  mkdir_p($dir);
  for my $file (sort keys %$files) {
    link("$srcrep/$packid/$files->{$file}-$file", "$dir/$file") || die("link $srcrep/$packid/$files->{$file}-$file $dir/$file: $!\n");
  }
  my @prods = grep {/.product$/}  sort keys %$files;
  my %pids;
  for my $prod (@prods) {
    print "converting product $prod\n";
    my $odir = "$dir/$prod.out";
    my $olog = "$dir/$prod.logfile";
    system('rm', '-rf', $odir) if -d $odir;
    unlink($olog) if -e $olog;
    mkdir_p($odir);
    # run product converter and read stdout
    my $pid;
    if (!($pid = xfork())) {
      delete $SIG{'__DIE__'};
      open(STDOUT, '>>', $olog) || die("$olog: $!\n");
      open(STDERR, '>&STDOUT');
      $| = 1;
      exec("./bs_productconvert", "$dir/$prod", $odir, $projid);
      die("500 bs_productconvert: $!\n");
    }
    waitpid($pid, 0) == $pid || die("500 waitpid $pid: $!\n");
    if ($?) {
      my $s = readstr($olog);
      $s =~ s/^\n+//s;
      $s =~ s/\n+$//s;
      warn("bs_productconvert failed: $?\n");
      BSUtil::cleandir($dir);
      rmdir($dir);
      die("$s\n") if $fail;
      return undef;
    }
    my @out = sort(ls($odir));
    if (!@out) {
      warn("bs_productconvert produced nothing\n");
      BSUtil::cleandir($dir);
      rmdir($dir);
      return undef;
    }
    for my $p (@out) {
      my $pdir = "$odir/$p";
      my $pid = $p;
      $pid =~ s/^_product[_:]//;
      $pid =~ s/[:\000-\037]/_/sg;
      $pid = "$packid:$pid";
      $pids{$pid} = 1;
      my %pfiles;
      for my $pfile (sort(ls($pdir))) {
        next if $pfile eq '_meta';
	$pfiles{$pfile} = addfile($projid, $pid, "$pdir/$pfile", $pfile);
      }
      my $srcmd5 = addmeta($projid, $pid, \%pfiles);
      my @oldrevs = BSFileDB::fdb_getall("$projectsdir/$projid.pkg/$pid.rev", $srcrevlay);
      if (@oldrevs == 1 && $oldrevs[0]->{'srcmd5'} eq $srcmd5 && $oldrevs[0]->{'rev'}) {
	# we're lucky, no change
	next;
      }
      mkdir_p("$projectsdir/$projid.pkg");
      my $prev = {'srcmd5' => $srcmd5, 'time' => time(), 'user' => $user, 'comment' => 'autogenerated', 'version' => '1', 'vrev' => '1'};
      #unlink("$projectsdir/$projid.pkg/$pid.rev");
      #BSFileDB::fdb_add_i2("$projectsdir/$projid.pkg/$pid.rev", $srcrevlay, $prev, 'vrev', 'version', $prev->{'version'});
      BSFileDB::fdb_add_i("$projectsdir/$projid.pkg/$pid.rev", $srcrevlay, $prev);
      if (! -e "$projectsdir/$projid.pkg/$pid.xml") {
        my $pidpack = {
         'name' => $pid,
         'title' => $pid,
         'description' => "autogenerated from $packid by source server",
        };
	$pidpack = readxml("$pdir/_meta", $BSXML::pack, 0) if ( -e "$pdir/_meta" );
	writexml("$projectsdir/$projid.pkg/.$pid.xml", "$projectsdir/$projid.pkg/$pid.xml", $pidpack, $BSXML::pack);
      }
      rmdir($pdir);
      notify_repservers('package', $projid, $pid);
    }
    rmdir($odir);
  }
  BSUtil::cleandir($dir);
  rmdir($dir);
  # now do away with the old packages
  my @packages = grep {/^\Q${packid}:\E/} findpackages($projid, {});
  @packages = grep {!$pids{$_}} @packages;
  for my $opid (@packages) {
    unlink("$projectsdir/$projid.pkg/$opid.upload-MD5SUMS");
    unlink("$projectsdir/$projid.pkg/$opid.rev");
    unlink("$projectsdir/$projid.pkg/$opid.xml");
    notify_repservers('package', $projid, $opid);
  }
  return 1;
}

#
# return version and release of commit
#
sub getcommitinfo {
  my ($projid, $packid, $srcmd5, $files) = @_;

  # get version/release from rpm spec/deb dsc/kiwi xml file
  my $version = 'unknown';
  my $release;
  if ($files->{'_link'}) {
    # can't know the version/release of a link as it is
    # a moving target
    return ('unknown', '0');
  }
  my $bconf = Build::read_config('noarch');
  for my $type ('spec', 'dsc', 'kiwi') {
    my $rev = {'project' => $projid, 'package' => $packid, 'srcmd5' => $srcmd5};
    my (undef, $file) = findfile($rev, undef, $type, $files);
    next unless defined $file;
    my $d = Build::parse($bconf, "$srcrep/$packid/$files->{$file}-$file");
    next unless defined $d->{'version'};
    $version = $d->{'version'};
    $release = $d->{'release'} if defined $d->{'release'};
    $version = 'unknown' if $d->{'multiversion'};
    last;
  }
  if (defined($release)) {
    if ($release =~ /(\d+)\.<B_CNT>/) {
      $release = $1;
    } elsif ($release =~ /<RELEASE(\d+)>/) {
      $release = $1;
    } elsif ($release =~ /^(\d+)/) {
      $release = $1;
    } else {
      $release = '0';
    }
  }
  $release ||= '0';
  return ($version, $release);
}

sub checksourceaccess {
  my ($projid, $packid) = @_;

  my $proj = readproj($projid, 1);
  return unless $proj;
  my $pack = readpack($projid, $packid, 1);
  my $sourceaccess = 1;
  $sourceaccess = BSUtil::enabled('', $proj->{'sourceaccess'}, $sourceaccess, '');
  $sourceaccess = BSUtil::enabled('', $pack->{'sourceaccess'}, $sourceaccess, '') if $pack;
  die("403 source access denied\n") unless $sourceaccess;
  my $access = 1;
  $access = BSUtil::enabled('', $proj->{'access'}, $access, '');
  $access = BSUtil::enabled('', $pack->{'access'}, $access, '') if $pack;
  die("404 package '$packid' does not exist\n") unless $access;	# hmm...
  return 1;
}

###########################################################################
###
###  low level source handling: tree and revision management
###

sub repgitdir {
  my ($rev) = @_;
  my $projid = $rev->{'project'};
  my $packid = $rev->{'package'};
  my $gitdir = "$projectsdir/$projid.pkg/$packid.git";
  die("$projid/$packid is not a git repository\n") unless -d $gitdir;
  return $gitdir;
}

sub repstat_git {
  my ($rev, $filename, $id) = @_;
  my $gitdir = repgitdir($rev);
  open(F, '-|', 'git', "--git-dir=$gitdir", 'cat-file', '-s', $id) || return ();
  my $size= '';
  1 while sysread(F, $size, 4096, length($size));
  if (!close(F)) {
    $! = POSIX::ENOENT;
    return ();
  }
  my @s = (0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
  $s[7] = 0 + $size;
  return @s;
}

sub repstat {
  my ($rev, $filename, $md5) = @_;
  if (length($md5) == 40) {
    return repstat_git($rev, $filename, $md5);
  }
  return stat("$srcrep/$rev->{'package'}/$md5-$filename");
}

sub repopen_git {
  my ($rev, $filename, $id, $fd) = @_;
  my $gitdir = repgitdir($rev);
  return open($fd, '-|', 'git', "--git-dir=$gitdir", 'cat-file', 'blob', $id);
}

sub repopen {
  my ($rev, $filename, $md5, $fd) = @_;
  if (length($md5) == 40) {
    return repopen_git($rev, $filename, $md5, $fd);
  }
  return open($fd, '<', "$srcrep/$rev->{'package'}/$md5-$filename");
}

sub repreadstr {
  my ($rev, $filename, $md5, $nonfatal) = @_;
  my $packid = $rev->{'package'};
  return readstr("$srcrep/$packid/$md5-$filename", $nonfatal);
}

sub repreadxml {
  my ($rev, $filename, $md5, $dtd, $nonfatal) = @_;
  my $packid = $rev->{'package'};
  return readxml("$srcrep/$packid/$md5-$filename", $dtd, $nonfatal);
}

#
# add a file to the repository
#
sub addfile {
  my ($projid, $packid, $tmpfile, $filename, $md5) = @_;

  if (!$md5) {
    open(F, '<', $tmpfile) || die("$tmpfile: $!\n");
    my $ctx = Digest::MD5->new;
    $ctx->addfile(*F);
    close F;
    $md5 = $ctx->hexdigest();
  }
  if (! -e "$srcrep/$packid/$md5-$filename") {
    if (!rename($tmpfile, "$srcrep/$packid/$md5-$filename")) {
      mkdir_p("$srcrep/$packid");
      rename($tmpfile, "$srcrep/$packid/$md5-$filename") || die("rename $tmpfile $srcrep/$packid/$md5-$filename: $!\n");
    }
  } else {
    unlink($tmpfile);
  }
  return $md5;
}

#
# make files available in oprojid/opackid available from projid/packid
#
sub copyfiles {
  my ($projid, $packid, $oprojid, $opackid, $files, $except) = @_;

  return if $packid eq $opackid;
  return unless %$files;
  mkdir_p("$srcrep/$packid");
  for my $f (sort keys %$files) {
    next if $except && $except->{$f};
    next if -e "$srcrep/$packid/$files->{$f}-$f";
    link("$srcrep/$opackid/$files->{$f}-$f", "$srcrep/$packid/$files->{$f}-$f");
    die("link error $srcrep/$opackid/$files->{$f}-$f\n") unless -e "$srcrep/$packid/$files->{$f}-$f";
  }
}

sub getrev_git {
  my ($projid, $packid, $rev) = @_;
  my $gitdir = "$projectsdir/$projid.pkg/$packid.git";
  die("$projid/$packid is not a git repository") unless -d $gitdir;
  if (!$rev) {
    my $master = readstr("$gitdir/refs/heads/master");
    chomp $master;
    $rev = $master;
  }
  die("revision is not a valid git id\n") unless $rev =~ /^[0-9a-f]{40}/s;
  open(F, '-|', 'git', "--git-dir=$gitdir", 'cat-file', 'commit', $rev) || return undef;
  my $commit = '';
  1 while sysread(F, $commit, 4096, length($commit));
  close F;
  $commit =~ s/.*?\n\n//;
  $rev = {'project' => $projid, 'package' => $packid, 'rev' => $rev, 'srcmd5' => $rev};
  $rev->{'comment'} = $commit if $commit ne '';
  return $rev;
}

#
# get a revision object from a revision identifier
#
sub getrev {
  my ($projid, $packid, $rev, $linked, $missingok) = @_;
  die("bad projid\n") if $projid =~ /\// || $projid =~ /^\./;
  die("bad packid\n") if $packid =~ /\// || $packid =~ /^\./;
  if ($packid ne '_project' && ! -e "$projectsdir/$projid.pkg/$packid.xml") {
    my $proj = readproj($projid, 1);
    if ($proj && $proj->{'link'}) {
      $linked ||= [];
      for my $lprojid (map {$_->{'project'}} @{$proj->{'link'}}) {
	next if $lprojid eq $projid;
	next if grep {$_->{'project'} eq $lprojid && $_->{'package'} eq $packid} @$linked;
	push @$linked, {'project' => $lprojid, 'package' => $packid};
	my $lrev;
	eval {
	  $lrev = getrev($lprojid, $packid, $rev, $linked, $missingok);
	};
	die($@) if $@ && $@ !~ /^404/;
	if ($lrev) {
	  # make sure that we may access the sources of this package
	  checksourceaccess($lprojid, $packid);
	  my $files = lsrev($lrev);
	  copyfiles($projid, $packid, $lprojid, $packid, $files);
	  addmeta($projid, $packid, $files) if $BSConfig::nosharedtrees;
	  $lrev->{'originproject'} ||= $lprojid;
	  $lrev->{'project'} = $projid;
	  return $lrev;
	}
      }
    }
    return remote_getrev($projid, $packid, $rev, $linked, $missingok);
  }
  undef $rev if $rev && ($rev eq 'latest' || $rev eq 'build');
  undef $rev if $rev && $rev eq 'upload' && ! -e "$projectsdir/$projid.pkg/$packid.upload-MD5SUMS";
  if (!defined($rev)) {
    $rev = BSFileDB::fdb_getlast("$projectsdir/$projid.pkg/$packid.rev", $srcrevlay);
    if (!$rev && -d "$projectsdir/$projid.pkg/$packid.git") {
      return getrev_git($projid, $packid);
    }
    $rev = {'srcmd5' => 'empty'} unless $rev;
  } elsif ($rev =~ /^[0-9a-f]{32}$/) {
    return undef unless -e "$projectsdir/$projid.pkg/$packid.rev" || -e "$projectsdir/$projid.pkg/$packid.mrev";
    $rev = {'srcmd5' => $rev, 'rev' => $rev};
  } elsif ($rev =~ /^[0-9a-f]{40}$/) {
    return getrev_git($projid, $packid, $rev);
  } elsif ($rev eq 'upload') {
    $rev = {'srcmd5' => 'upload', 'rev' => 'upload'}
  } elsif ($rev eq 'repository') {
    $rev = {'srcmd5' => 'empty', 'rev' => 'repository'}
  } else {
    if ($rev eq '0') {
      $rev = {'srcmd5' => 'empty'};
    } else {
      $rev = BSFileDB::fdb_getmatch("$projectsdir/$projid.pkg/$packid.rev", $srcrevlay, 'rev', $rev);
      die("no such revision\n") unless defined $rev;
    }
  }
  $rev->{'project'} = $projid;
  $rev->{'package'} = $packid;
  return $rev;
}

sub addmeta {
  my ($projid, $packid, $files, $rev) = @_;

  # calculate new meta sum
  my $meta = '';
  $meta .= "$files->{$_}  $_\n" for sort keys %$files;
  my $srcmd5 = Digest::MD5::md5_hex($meta);
  if ($rev && $rev eq 'upload') {
    mkdir_p($uploaddir);
    mkdir_p("$projectsdir/$projid.pkg");
    writestr("$uploaddir/addmeta$$", "$projectsdir/$projid.pkg/$packid.upload-MD5SUMS", $meta);
  } else {
    my $treedir = $BSConfig::nosharedtrees ? "$treesdir/$projid/$packid" : "$treesdir/$packid";
    if (! -e "$treedir/$srcmd5-MD5SUMS") {
      mkdir_p($uploaddir);
      mkdir_p($treedir);
      writestr("$uploaddir/addmeta$$", "$treedir/$srcmd5-MD5SUMS", $meta);
    }
  }
  return $srcmd5;
}

# like addmeta, but adds link information. also stores
# under the "wrong" md5sum.
sub addmeta_link {
  my ($projid, $packid, $files, $srcmd5, $linkinfo) = @_;

  my $treedir = $BSConfig::nosharedtrees ? "$treesdir/$projid/$packid" : "$treesdir/$packid";
  if (! -e "$treedir/$srcmd5-MD5SUMS") {
    my $meta = '';
    $meta .= "$files->{$_}  $_\n" for sort keys %$files;
    $meta .= "$linkinfo->{'srcmd5'}  /LINK\n";
    $meta .= "$linkinfo->{'lsrcmd5'}  /LOCAL\n";
    mkdir_p($uploaddir);
    mkdir_p($treedir);
    writestr("$uploaddir/$$", "$treedir/$srcmd5-MD5SUMS", $meta);
  }
}


sub updatelinkinfodb {
  my ($projid, $packid, $rev, $files) = @_;

  mkdir_p($sourcedb) unless -d $sourcedb;
  my $linkdb = BSDB::opendb($sourcedb, 'linkinfo');
  my $linkinfo;
  if ($files && $files->{'_link'}) {
    my $l = repreadxml($rev, '_link', $files->{'_link'}, $BSXML::link, 1);
    if ($l) {
      $linkinfo = {};
      $linkinfo->{'project'} = defined $l->{'project'} ? $l->{'project'} : $projid;
      $linkinfo->{'package'} = defined $l->{'package'} ? $l->{'package'} : $packid;
      $linkinfo->{'rev'} = $l->{'rev'} if defined $l->{'rev'};
    }
  }
  $linkdb->store("$projid/$packid", $linkinfo);
}

#
# create a new revision from a file list, returns revision object
#
sub addrev {
  my ($projid, $packid, $files, $user, $comment, $target, $requestid) = @_;
  die("404 project '$projid' does not exist\n") unless -e "$projectsdir/$projid.xml";
  die("403 package '$packid' is read-only\n") if $packid =~ /^_product:/;
  if ($packid eq '_pattern' || ! -e "$projectsdir/$projid.pkg/$packid.xml") {
    # upgrade pseudo _pattern package to real package
    my $pack = {
      'name' => $packid,
      'project' => $projid,
      'title' => 'pseudo package to store pattern information',
      'description' => "pseudo package to store pattern information\n",
    };
    mkdir_p($uploaddir);
    writexml("$uploaddir/$$.2", undef, $pack, $BSXML::pack);
    mkdir_p("$projectsdir/$projid.pkg");
    addrev_meta({'user' => $user}, $projid, $packid, "$uploaddir/$$.2", "$projectsdir/$projid.pkg/$packid.xml", '_meta');
  }
  die("404 package '$packid' does not exist\n") unless $packid eq '_project' || -e "$projectsdir/$projid.pkg/$packid.xml";
  if ($target && $target eq 'upload') {
    my $srcmd5 = addmeta($projid, $packid, $files, 'upload');
    my $filenames = join( ', ', keys %$files );
    BSNotify::notify("SRCSRV_UPLOAD", {project => $projid, package => $packid, filename => $filenames, comment => $comment, 
                                       target => $target, request_id => $requestid, user => $user});
    return {'project' => $projid, 'package' => $packid, 'rev' => 'upload', 'srcmd5' => $srcmd5};
  } elsif ($target && $target eq 'repository') {
    # repository only upload.
    return {'project' => $projid, 'package' => $packid, 'rev' => 'repository', 'srcmd5' => 'empty'};
  } elsif (defined($target)) {
    # internal version only upload.
    my $srcmd5 = addmeta($projid, $packid, $files);
    return {'project' => $projid, 'package' => $packid, 'rev' => $srcmd5, 'srcmd5' => $srcmd5};
  }
  die("bad projid\n") if $projid =~ /\// || $projid =~ /^\./;
  die("bad packid\n") if $packid =~ /\// || $packid =~ /^\./;
  die("bad files\n") if grep {/\//} keys %$files;
  die("bad files\n") if grep {!/^[0-9a-f]{32}$/} values %$files;

  if ($packid eq '_product') {
    expandproduct($projid, $packid, $files, $user, 1);
  }
  if ($files->{'_patchinfo'}) {
    die("bad files in patchinfo container\n") if grep {$_ ne '_patchinfo'} keys %$files;
    my $p = repreadxml({'project' => $projid, 'package' => $packid}, '_patchinfo', $files->{'_patchinfo'}, $BSXML::patchinfo);
    BSVerify::verify_patchinfo($p);
  }

  my $srcmd5 = addmeta($projid, $packid, $files);
  $user = '' unless defined $user;
  $user = 'unknown' if $user eq '';
  $comment = '' unless defined $comment;
  $user = str2utf8xml($user);
  $comment = str2utf8xml($comment);
  my $rev = {'srcmd5' => $srcmd5, 'time' => time(), 'user' => $user, 'comment' => $comment, 'requestid' => $requestid};
  if ($packid ne '_project' && $packid ne '_pattern') {
    my ($version, $release) = getcommitinfo($projid, $packid, $srcmd5, $files);
    $rev->{'version'} = $version;
    $rev->{'vrev'} = $release;
  }
  
  my $rev_old = getrev($projid, $packid);
  my $files_old = lsrev($rev_old);
  my $filestr = BSNotify::generate_commit_flist($files_old, $files);

  my $acceptinfo;
  if ($requestid) {
    $acceptinfo = {};
    $acceptinfo->{'osrcmd5'} = $rev_old->{'srcmd5'} if $rev_old->{'srcmd5'} ne 'empty';
    if ($files_old->{'_link'}) {
      # see if we can expand it
      eval {
	my %rev = %$rev_old;
	handlelinks(\%rev, $files_old);
	$acceptinfo->{'oxsrcmd5'} = $rev{'srcmd5'};
      };
    }
  }
  if ($packid eq '_project') {
    $rev = BSFileDB::fdb_add_i("$projectsdir/$projid.pkg/$packid.rev", $srcrevlay, $rev);
    $rev->{'project'} = $projid;
    $rev->{'package'} = $packid;
    if ($acceptinfo) {
      $acceptinfo->{'rev'} = $rev->{'rev'};
      $acceptinfo->{'srcmd5'} = $rev->{'srcmd5'};
      addacceptinfo($requestid, $projid, $packid, $acceptinfo);
    }
    extract_old_prjsource($projid, $rev);
    unlink("$projectsdir/$projid.pkg/$packid.upload-MD5SUMS");
    notify_repservers('project', $projid);
    BSNotify::notify("SRCSRV_UPDATE_PROJECT_CONFIG", { "project" => $projid, "files" => $filestr, "comment" => $comment, "sender" => $user });
    return $rev;
  }

  # help a little with link<->nolink and singleversion<->multiversion changes
  if ($rev->{'version'} && $rev_old->{'version'}) {
    # if this is a known -> unknown version change, max with vrev of last commit
    if ($rev->{'version'} eq 'unknown' && $rev_old->{'version'} ne 'unknown') {
      $rev->{'vrev'} = $rev_old->{'vrev'} + 1 if $rev_old->{'vrev'} + 1 > $rev->{'vrev'};
    }
    # same for unknown -> known
    if ($rev->{'version'} ne 'unknown' && $rev_old->{'version'} eq 'unknown') {
      $rev->{'vrev'} = $rev_old->{'vrev'} + 1 if $rev_old->{'vrev'} + 1 > $rev->{'vrev'};
    }
  }

  if (defined($rev->{'version'})) {
    $rev = BSFileDB::fdb_add_i2("$projectsdir/$projid.pkg/$packid.rev", $srcrevlay, $rev, 'vrev', 'version', $rev->{'version'});
  } else {
    $rev = BSFileDB::fdb_add_i("$projectsdir/$projid.pkg/$packid.rev", $srcrevlay, $rev);
  }

  # add missing data to complete the revision object
  $rev->{'project'} = $projid;
  $rev->{'package'} = $packid;

  # update linked package database
  updatelinkinfodb($projid, $packid, $rev, $files);

  # update request acceptinfo
  if ($acceptinfo) {
    $acceptinfo->{'rev'} = $rev->{'rev'};
    $acceptinfo->{'srcmd5'} = $rev->{'srcmd5'};
    if ($files->{'_link'}) {
      # see if we can expand it
      eval {
	my %rev = %$rev;
	handlelinks(\%rev, $files);
	$acceptinfo->{'xsrcmd5'} = $rev{'srcmd5'};
      };
    }
    addacceptinfo($requestid, $projid, $packid, $acceptinfo);
  }

  # send out hermes notification
  BSNotify::notify("SRCSRV_COMMIT", {project => $projid, package => $packid, files => $filestr, rev => $rev->{'rev'}, user => $user, comment => $comment});
  $rev_old->{'version'} = "unknown" unless defined($rev_old->{'version'});
  BSNotify::notify("SRCSRV_VERSION_CHANGE", {project => $projid, package => $packid, files => $filestr, rev => $rev->{'rev'},
                                             oldversion => $rev_old->{'version'}, newversion => $rev->{'version'}, user => $user, comment => $comment})
    if $rev->{'version'} && $rev_old->{'version'} && $rev->{'version'} ne $rev_old->{'version'};

  # kill upload revision as we did a real commit
  unlink("$projectsdir/$projid.pkg/$packid.upload-MD5SUMS");
  # kill obsolete _pattern file
  unlink("$projectsdir/$projid.pkg/pattern-MD5SUMS") if $packid eq '_pattern';

  notify_repservers('package', $projid, $packid);
  return $rev;
}

sub lsrev_git {
  my ($rev, $linkinfo) = @_;
  my $id = $rev->{'srcmd5'};
  local *F;
  my $gitdir = repgitdir($rev);
  open(F, '-|', 'git', "--git-dir=$gitdir", 'cat-file', 'tree', $id) || die("git: $!\n");
  my $tree = '';
  1 while sysread(F, $tree, 4096, length($tree));
  close(F) || die("bad id\n");
  my $files = {};
  while ($tree =~ /(\d+) ([^\000]*)\000(.{20})/sg) {
    next if $1 eq '40000';		# ignore dirs for now
    next if substr($2, 0, 1) eq '.';	# ignore files starting with . for now
    $files->{$2} = unpack('H*', $3);
  }
  return $files;
}

#
# retrieve the file list of a revision object or tree object
# store merge info in linkinfo if available
#
sub lsrev {
  my ($rev, $linkinfo) = @_;

  die("nothing known\n") unless $rev;
  my $projid = $rev->{'project'};
  my $packid = $rev->{'package'};
  my $srcmd5 = $rev->{'srcmd5'};
  die("revision project missing\n") unless defined $projid;
  die("revision package missing\n") unless defined $packid;
  die("no such revision\n") unless defined $srcmd5;
  local *F;
  die("bad packid\n") if $packid =~ /\// || $packid =~ /^\./;
  if ($srcmd5 eq 'upload') {
    open(F, '<', "$projectsdir/$projid.pkg/$packid.upload-MD5SUMS") || die("$packid/$srcmd5-$packid: not in repository\n");
  } elsif ($srcmd5 eq 'pattern') {
    open(F, '<', "$projectsdir/$projid.pkg/pattern-MD5SUMS") || return {};
  } elsif ($srcmd5 eq 'empty' || $srcmd5 eq 'd41d8cd98f00b204e9800998ecf8427e') {
    return {};
  } elsif (length($srcmd5) == 40) {
     return lsrev_git($rev, $linkinfo);
  } else {
    die("bad srcmd5 '$srcmd5'\n") if $srcmd5 !~ /^[0-9a-f]{32}$/;
    my $treedir = $BSConfig::nosharedtrees ? "$treesdir/$projid/$packid" : "$treesdir/$packid";
    if ($BSConfig::nosharedtrees && $BSConfig::nosharedtrees == 2 && ! -e "$treedir/$srcmd5-MD5SUMS") {
      $treedir = "$srcrep/$packid";
    }
    if (!open(F, '<', "$treedir/$srcmd5-MD5SUMS")) {
      return {'_linkerror' => $srcmd5} if -e "$srcrep/$packid/$srcmd5-_linkerror";
      die("$projid/$packid/$srcmd5: not in repository. Either not existing or misconfigured server setting for '\$nosharedtrees' setting in BSConfig.pm\n");
    }
  }
  my @files = <F>;
  close F;
  chomp @files;
  my $files = {map {substr($_, 34) => substr($_, 0, 32)} @files};
  # hack: do not list _signkey in project meta
  delete $files->{'_signkey'} if $packid eq '_project';
  if ($linkinfo) {
    $linkinfo->{'lsrcmd5'} = $files->{'/LOCAL'} if $files->{'/LOCAL'};
    $linkinfo->{'srcmd5'} = $files->{'/LINK'} if $files->{'/LINK'};
  }
  delete $files->{'/LINK'};
  delete $files->{'/LOCAL'};
  return $files;
}


# find last revision that consisted of the tree object
sub findlastrev {
  my ($tree) = @_;
  my $rev = BSFileDB::fdb_getmatch("$projectsdir/$tree->{'project'}.pkg/$tree->{'package'}.rev", $srcrevlay, 'srcmd5', $tree->{'srcmd5'});
  return undef unless $rev;
  $rev->{'project'} = $tree->{'project'};
  $rev->{'package'} = $tree->{'package'};
  return $rev;
}



###########################################################################
###
###  source link handling
###

sub patchspec {
  my ($p, $dir, $spec) = @_;
  local *F;
  open(F, '<', "$dir/$spec") || die("$dir/$spec: $!\n");
  my @preamble;
  while(<F>) {
    chomp;
    push @preamble, $_;
    last if /^\s*%(package|prep|build|install|check|clean|preun|postun|pretrans|posttrans|pre|post|files|changelog|description|triggerpostun|triggerun|triggerin|trigger|verifyscript)(\s|$)/;
  }
  my %patches;
  for (@preamble) {
    next unless /^patch(\d*)\s*:/i;  
    $patches{0 + ($1 eq '' ? 0 : $1)} = $_;
  }
  my @patches = sort {$a <=> $b} keys %patches;
  my $nr = 0;
  if (exists $p->{'after'}) {
    $nr = 0 + $p->{'after'};
    $nr++ while $patches{$nr};
  } else {
    $nr = $patches[-1] + 1 if @patches;
  }
  my @after;
  @after = map {$patches{$_}} grep {$_ < $nr} @patches if @patches;
  @after = grep {/^source(\d*)\s*:/i} @preamble if !@after;
  @after = grep {/^name(\d*)\s*:/i} @preamble if !@after;
  @after = $preamble[-2] if @preamble > 1 && !@after;
  return "could not find a place to insert the patch" if !@after;
  my $nrx = $nr;
  $nrx = '' if $nrx == 0;
  local *O;
  open(O, '>', "$dir/.patchspec$$") || die("$dir/.patchspec$$: $!\n");
  for (@preamble) {
    print O "$_\n";
    next unless @after && $_ eq $after[-1];
    print O "Patch$nrx: $p->{'name'}\n";
    @after = ();
  }
  if ($preamble[-1] !~ /^\s*%prep(\s|$)/) {
    while (1) {
      my $l = <F>;
      return "specfile has no %prep section" if !defined $l;
      chomp $l;
      print O "$l\n";
      last if $l =~ /^\s*%prep(\s|$)/;
    }
  }
  my @prep;
  while(<F>) {
    chomp;
    push @prep, $_;
    last if /^\s*%(package|prep|build|install|check|clean|preun|postun|pretrans|posttrans|pre|post|files|changelog|description|triggerpostun|triggerun|triggerin|trigger|verifyscript)(\s|$)/;
  }
  %patches = ();
  my $ln = -1;
  # find outmost pushd/popd calls and insert new patches after a pushd/popd block
  # $blevel == 0 indicates the outmost block
  my %bend = ();
  my $bln = undef;
  $$bln = $ln;
  my $blevel = -1;
  for (@prep) {
    $ln++;
    $blevel++ if /^pushd/;
    if (/^popd/) {
      unless ($blevel) {
        $$bln = $ln;
        undef $bln;
        $$bln = $ln;
      }
      $blevel--;
    }
    next unless /%patch(\d*)(.*)/;
    if ($1 ne '') {
      $patches{0 + $1} = $ln;
      $bend{0 + $1} = $bln if $blevel >= 0;
      next;
    }
    my $pnum = 0;
    my @a = split(' ', $2);
    if (! grep {$_ eq '-P'} @a) {
      $patches{$pnum} = $ln;
    } else {
      while (@a) {
        next if shift(@a) ne '-P';
        next if !@a || $a[0] !~ /^\d+$/;
        $pnum = 0 + shift(@a);
        $patches{$pnum} = $ln;
      }
    }
    $bend{$pnum} = $bln if $blevel >= 0;
  }
  return "specfile has broken %prep section" unless $blevel == -1;
  @patches = sort {$a <=> $b} keys %patches;
  $nr = 1 + $p->{'after'} if exists $p->{'after'};
  %patches = map { $_ => exists $bend{$_} ? ${$bend{$_}} : $patches{$_} } @patches;
  @after = map {$patches{$_}} grep {$_ < $nr} @patches if @patches;
  @after = ($patches[0] - 1) if !@after && @patches;
  @after = (@prep - 2) if !@after;
  my $after = $after[-1];
  $after = -1 if $after < -1;
  $ln = -1;
  push @prep, '' if $after >= @prep;
  #print "insert %patch after line $after\n";
  for (@prep) {
    if (defined($after) && $ln == $after) {
      print O "pushd $p->{'dir'}\n" if exists $p->{'dir'};
      if ($p->{'popt'}) {
        print O "%patch$nrx -p$p->{'popt'}\n";
      } else {
        print O "%patch$nrx\n";
      }
      print O "popd\n" if exists $p->{'dir'};
      undef $after;
    }
    print O "$_\n";
    $ln++;
  }
  while(<F>) {
    chomp;
    print O "$_\n";
  }
  close(O) || die("close: $!\n");
  rename("$dir/.patchspec$$", "$dir/$spec") || die("rename $dir/.patchspec$$ $dir/$spec: $!\n");
  return '';
}
# " Make emacs wired syntax highlighting happy

sub topaddspec {
  my ($p, $dir, $spec) = @_;
  local (*F, *O);
  open(F, '<', "$dir/$spec") || die("$dir/$spec: $!\n");
  open(O, '>', "$dir/.topaddspec$$") || die("$dir/.topaddspec$$: $!\n");
  my $text = $p->{'text'};
  $text = '' if !defined $text;
  $text .= "\n" if $text ne '' && substr($text, -1, 1) ne "\n";
  print O $text;
  while(<F>) {
    chomp;
    print O "$_\n";
  }
  close(O) || die("close: $!\n");
  rename("$dir/.topaddspec$$", "$dir/$spec") || die("rename $dir/.topaddspec$$ $dir/$spec: $!\n");
}

#
# apply a single link step
# store the result under the identifier "$md5"
#
# if "$md5" is not set, store the result in "$uploaddir/applylink$$"
#
sub applylink {
  my ($md5, $lsrc, $llnk) = @_;
  if ($md5 && -e "$srcrep/$llnk->{'package'}/$md5-_linkerror") {
    # no need to do all the work again...
    my $log = readstr("$srcrep/$llnk->{'package'}/$md5-_linkerror", 1);
    $log ||= "unknown error";
    chomp $log;
    $log =~ s/.*\n//s;
    $log ||= "unknown error";
    return $log;
  }
  my $flnk = lsrev($llnk);
  my $fsrc = lsrev($lsrc);
  my $l = $llnk->{'link'};
  my $patches = $l->{'patches'} || {};
  my @patches = ();
  my $simple = 1;
  my @simple_delete;
  my $isbranch;
  if ($l->{'patches'}) {
    for (@{$l->{'patches'}->{''} || []}) {
      my $type = (keys %$_)[0];
      if (!$type) {
	$simple = 0;
	next;
      }
      if ($type eq 'topadd') {
        push @patches, { 'type' => $type, 'text' => $_->{$type}};
	$simple = 0;
      } elsif ($type eq 'delete') {
        push @patches, { 'type' => $type, %{$_->{$type} || {}}};
	push @simple_delete, $patches[-1]->{'name'};
      } else {
        push @patches, { 'type' => $type, %{$_->{$type} || {}}};
	$simple = 0;
	$isbranch = 1 if $type eq 'branch';
      }
    }
  }
  $simple = 0 unless $md5;
  if ($simple) {
    # simple source link with no patching
    # copy all files but the ones we have locally
    copyfiles($llnk->{'project'}, $llnk->{'package'}, $lsrc->{'project'}, $lsrc->{'package'}, $fsrc, $flnk);
    # calculate meta
    my $newf = { %$fsrc };
    for my $f (sort keys %$flnk) {
      $newf->{$f} = $flnk->{$f} unless $f eq '_link';
    }
    delete $newf->{$_} for @simple_delete;
    # store filelist in md5
    my $linkinfo = {
      'srcmd5'  => $lsrc->{'srcmd5'},
      'lsrcmd5' => $llnk->{'srcmd5'},
    };
    addmeta_link($llnk->{'project'}, $llnk->{'package'}, $newf, $md5, $linkinfo);
    return '';
  }

  # sanity checking...
  for my $p (@patches) {
    return "patch has no type" unless exists $p->{'type'};
    return "patch has illegal type \'$p->{'type'}\'" unless $p->{'type'} eq 'apply' || $p->{'type'} eq 'add' || $p->{'type'} eq 'topadd' || $p->{'type'} eq 'delete' || $p->{'type'} eq 'branch';
    if ($p->{'type'} ne 'topadd' && $p->{'type'} ne 'delete' && $p->{'type'} ne 'branch') {
      return "patch has no patchfile" unless exists $p->{'name'};
      return "patch \'$p->{'name'}\' does not exist" unless $flnk->{$p->{'name'}};
    }
  }
  my $tmpdir = "$uploaddir/applylink$$";
  mkdir_p($tmpdir);
  die("$tmpdir: $!\n") unless -d $tmpdir;
  unlink("$tmpdir/$_") for ls($tmpdir);	# remove old stuff
  my %apply = map {$_->{'name'} => 1} grep {$_->{'type'} eq 'apply'} @patches;
  $apply{$_} = 1 for keys %{$llnk->{'ignore'} || {}};	# also ignore those files, used in keeplink
  my %fl;
  if (!$isbranch) {
    for my $f (sort keys %$fsrc) {
      next if $flnk->{$f} && !$apply{$f};
      link("$srcrep/$lsrc->{'package'}/$fsrc->{$f}-$f", "$tmpdir/$f") || die("$f: $!\n");
      $fl{$f} = "$lsrc->{'package'}/$fsrc->{$f}-$f";
    }
    for my $f (sort keys %$flnk) {
      next if $apply{$f} || $f eq '_link';
      link("$srcrep/$llnk->{'package'}/$flnk->{$f}-$f", "$tmpdir/$f") || die("$f: $!\n");
      $fl{$f} = "$llnk->{'package'}/$flnk->{$f}-$f";
    }
  }
  my $failed;
  for my $p (@patches) {
    my $pn = $p->{'name'};
    if ($p->{'type'} eq 'delete') {
      unlink("$tmpdir/$pn");
      next;
    }
    if ($p->{'type'} eq 'branch') {
      # flnk: mine
      # fbas: old
      # fsrc: new
      my $baserev = $l->{'baserev'};
      return "no baserev in branch patch" unless $baserev;
      return "baserev is not srcmd5" unless $baserev =~ /^[0-9a-f]{32}$/s;
      my %brev = (%$lsrc, 'srcmd5' => $baserev);
      my $fbas;
      eval {
        $fbas = lsrev(\%brev);
      };
      return "baserev $baserev does not exist" unless $fbas;
      return "baserev is link" if $fbas->{'link'};

      # ignore linked generated service files if our link contains a service
      if ($flnk->{'_service'}) {
	delete $fbas->{$_} for grep {/^_service[:_]/} keys %$fbas;
	delete $fsrc->{$_} for grep {/^_service[:_]/} keys %$fsrc;
      }
      # do 3-way merge
      my %destnames = (%$fsrc, %$flnk);
      delete $destnames{'_link'};
      for my $f (sort {length($a) <=> length($b) || $a cmp $b} keys %destnames) {
	my $mbas = $fbas->{$f} || '';
	my $msrc = $fsrc->{$f} || '';
	my $mlnk = $flnk->{$f} || '';
	if ($mbas eq $mlnk) {
	  next if $msrc eq '';
	  link("$srcrep/$lsrc->{'package'}/$fsrc->{$f}-$f", "$tmpdir/$f") || die("$fsrc->{$f}-$f: $!\n");
	  $fl{$f} = "$lsrc->{'package'}/$fsrc->{$f}-$f";
	  next;
	}
	if ($mbas eq $msrc || $mlnk eq $msrc) {
	  next if $mlnk eq '';
	  link("$srcrep/$llnk->{'package'}/$flnk->{$f}-$f", "$tmpdir/$f") || die("$flnk->{$f}-$f: $!\n");
	  $fl{$f} = "$llnk->{'package'}/$flnk->{$f}-$f";
	  next;
	}
	if ($mbas eq '' || $msrc eq '' || $mlnk eq '') {
	  $failed = "conflict in file $f";
	  last;
	}
        # run diff3
	link("$srcrep/$lsrc->{'package'}/$fsrc->{$f}-$f", "$tmpdir/$f.new") || die("link $fsrc->{$f}-$f: $!\n");
	link("$srcrep/$lsrc->{'package'}/$fbas->{$f}-$f", "$tmpdir/$f.old") || die("link $fbas->{$f}-$f: $!\n");
	link("$srcrep/$llnk->{'package'}/$flnk->{$f}-$f", "$tmpdir/$f.mine") || die("link $flnk->{$f}-$f: $!\n");
	if (!isascii("$tmpdir/$f.new") || !isascii("$tmpdir/$f.old") || !isascii("$tmpdir/$f.mine")) {
	  $failed = "conflict in file $f";
	  last;
	}
	my $pid;
	if (!($pid = xfork())) {
	  delete $SIG{'__DIE__'};
	  chdir($tmpdir) || die("$tmpdir: $!\n");
	  open(STDERR, '>>', ".log") || die(".log: $!\n");
	  open(STDOUT, '>', $f) || die("$f: $!\n");
          print STDERR "running diff3 on $f\n";
	  exec('/usr/bin/diff3', '-m', '-E', "$f.mine", "$f.old", "$f.new");
	  die("/usr/bin/diff3: $!\n");
	}
	waitpid($pid, 0) == $pid || die("waitpid $pid: $!\n");
	if ($?) {
	  $failed = "conflict in file $f";
	  last;
	}
	unlink("$tmpdir/$f.old");
	unlink("$tmpdir/$f.new");
	unlink("$tmpdir/$f.mine");
      }
      last if $failed;
      next;
    }
    if ($p->{'type'} eq 'add') {
      for my $spec (grep {/\.spec$/} ls($tmpdir)) {
	local *F;
	open(F, '>>', "$tmpdir/.log") || die("$tmpdir/.log: $!\n");
	print F "adding patch $pn to $spec\n";
	close F;
        my $err = patchspec($p, $tmpdir, $spec);
        if ($err) {
	  open(F, '>>', "$tmpdir/.log") || die("$tmpdir/.log: $!\n");
	  print F "error: $err\n";
	  close F;
	  $failed = "could not add patch '$pn'";
	  last;
	  unlink("$tmpdir/$_") for ls($tmpdir);
	  rmdir($tmpdir);
	  return "could not add patch '$pn'";
	}
        delete $fl{$spec};
      }
      last if $failed;
      next;
    }
    if ($p->{'type'} eq 'topadd') {
      for my $spec (grep {/\.spec$/} ls($tmpdir)) {
	local *F;
	open(F, '>>', "$tmpdir/.log") || die("$tmpdir/.log: $!\n");
	print F "adding text at top of $spec\n";
	close F;
        topaddspec($p, $tmpdir, $spec);
        delete $fl{$spec};
      }
      next;
    }
    next unless $p->{'type'} eq 'apply';
    my $pid;
    if (!($pid = xfork())) {
      delete $SIG{'__DIE__'};
      chdir($tmpdir) || die("$tmpdir: $!\n");
      open(STDIN, '<', "$srcrep/$llnk->{'package'}/$flnk->{$pn}-$pn") || die("$srcrep/$llnk->{'package'}/$flnk->{$pn}-$pn: $!\n");
      open(STDOUT, '>>', ".log") || die(".log: $!\n");
      open(STDERR, '>&STDOUT');
      $| = 1;
      print "applying patch $pn\n";
      $::ENV{'TMPDIR'} = '.';
      # Old patch command still supported --unified-reject-files and --global-reject-file.
      # exec('/usr/bin/patch', '--no-backup-if-mismatch', '--unified-reject-files', '--global-reject-file=.rejects', '-g', '0', '-f');
      exec('/usr/bin/patch', '--no-backup-if-mismatch', '-g', '0', '-f');
      die("/usr/bin/patch: $!\n");
    }
    waitpid($pid, 0) == $pid || die("waitpid $pid: $!\n");
    if ($?) {
      $failed = "could not apply patch '$pn'";
      last;
    }
  }
  if ($failed) {
    local *F;
    # add result as last line
    open(F, '>>', "$tmpdir/.log") || die("$tmpdir/.log: $!\n");
    print F "\n$failed\n";
    close F;
    # link error marker
    if ($md5 && !link("$tmpdir/.log", "$srcrep/$llnk->{'package'}/$md5-_linkerror")) {
      my $err = "link $tmpdir/.log $srcrep/$llnk->{'package'}/$md5-_linkerror: $!\n";
      die($err) unless -e "$srcrep/$llnk->{'package'}/$md5-_linkerror";
    }
    unlink("$tmpdir/$_") for ls($tmpdir);
    rmdir($tmpdir);
    return $failed;
  }
  my @newf = grep {!/^\./} ls($tmpdir);
  my $newf = {};
  local *F;
  for my $f (@newf) {
    my @s = stat "$tmpdir/$f";
    die("$tmpdir/$f: $!\n") unless @s;
    if ($s[3] > 1 && $fl{$f}) {
      my @s2 = stat "$srcrep/$fl{$f}";
      die("$srcrep/$fl{$f}: $!\n") unless @s2;
      if ("$s[0]/$s[1]" eq "$s2[0]/$s2[1]") {
        $newf->{$f} = $fl{$f};
        $newf->{$f} =~ s/.*\///;
        $newf->{$f} = substr($newf->{$f}, 0, 32);
	next;
      }
    }
    open(F, '<', "$tmpdir/$f") || die("$tmpdir/$f: $!\n");
    my $ctx = Digest::MD5->new;
    $ctx->addfile(*F);
    close F;
    $newf->{$f} = $ctx->hexdigest();
  }

  # if we just want the patched files we're finished
  if (!$md5) {
    # rename into md5 form, sort so that there's no collision
    for my $f (sort {length($b) <=> length($a) || $a cmp $b} @newf) {
      rename("$tmpdir/$f", "$tmpdir/$newf->{$f}-$f");
    }
    return $newf;
  }

  # otherwise link everything over
  for my $f (@newf) {
    addfile($llnk->{'project'}, $llnk->{'package'}, "$tmpdir/$f", $f, $newf->{$f});
  }
  # clean up tmpdir
  unlink("$tmpdir/$_") for ls($tmpdir);
  rmdir($tmpdir);
  # store filelist
  my $linkinfo = {
    'srcmd5'  => $lsrc->{'srcmd5'},
    'lsrcmd5' => $llnk->{'srcmd5'},
  };
  addmeta_link($llnk->{'project'}, $llnk->{'package'}, $newf, $md5, $linkinfo);
  return '';
}

#
# expand a source link
# - returns expanded file list
# - side effects:
#   modifies $rev->{'srcmd5'}, $rev->{'vrev'}, $rev->{'linkrev'}
#   modifies $li->{'srcmd5'}, $li->{'lsrcmd5'}
#   modifies $li->{'linked'} if exists
#
sub handlelinks {
  my ($rev, $files, $li) = @_;

  my @linkinfo;
  my %seen;
  my $projid = $rev->{'project'};
  my $packid = $rev->{'package'};
  my $linkrev = $rev->{'linkrev'};
  push @linkinfo, {'project' => $projid, 'package' => $packid, 'srcmd5' => $rev->{'srcmd5'}, 'rev' => $rev->{'rev'}};
  delete $rev->{'srcmd5'};
  delete $rev->{'linkrev'};
  my $vrev = $rev->{'vrev'};
  my $vrevdone;
  my $lrev = $rev;
  while ($files->{'_link'}) {
    my $l = repreadxml($lrev, '_link', $files->{'_link'}, $BSXML::link, 1);
    return '_link is bad' unless $l;
    eval {
      BSVerify::verify_link($l);
    };
    if ($@) {
      my $err = $@;
      $err =~ s/\n$//s;
      return "_link is bad: $err";
    }
    $l->{'project'} = $linkinfo[-1]->{'project'} unless exists $l->{'project'};
    $l->{'package'} = $linkinfo[-1]->{'package'} unless exists $l->{'package'};
    $linkrev = $l->{'baserev'} if $linkrev && $linkrev eq 'base';
    ($l->{'rev'}, $linkrev) = ($linkrev, undef) if $linkrev;
    $linkinfo[-1]->{'link'} = $l;
    $projid = $l->{'project'};
    $packid = $l->{'package'};
    $lrev = $l->{'rev'} || '';
    return 'circular package link' if $seen{"$projid/$packid/$lrev"};
    $seen{"$projid/$packid/$lrev"} = 1;
    # record link target for projpack
    push @{$li->{'linked'}}, {'project' => $projid, 'package' => $packid} if $li && $li->{'linked'}; 
    eval {
      $lrev = getrev($projid, $packid, $l->{'rev'}, $li ? $li->{'linked'} : undef);
    };
    if ($@) {
      my $error = $@;
      $error =~ s/\n$//s;
      $error = $2 if $error =~ /^(\d+) +(.*?)$/s;
      return "$projid $packid: $error";
    }
    return "linked package '$packid' does not exist in project '$projid'" unless $lrev;
    return "linked package '$packid' is empty" if $lrev->{'srcmd5'} eq 'empty';
    return "linked package '$packid' is strange" unless $lrev->{'srcmd5'} =~ /^[0-9a-f]{32}$/;
    undef $files;
    eval {
      $files = lsrev($lrev);
    };
    return 'linked package is not in repository' unless $files;
    my $cicount = $l->{'cicount'} || 'add';
    if ($cicount eq 'copy') {
      $rev->{'vrev'} -= $vrev unless $vrevdone;
    } elsif ($cicount eq 'local') {
      $vrevdone = 1;
    } elsif ($cicount ne 'add') {
      return '_link is bad: illegal cicount';
    }
    $vrev = $lrev->{'vrev'};
    $rev->{'vrev'} += $lrev->{'vrev'} unless $vrevdone;
    push @linkinfo, {'project' => $projid, 'package' => $packid, 'srcmd5' => $lrev->{'srcmd5'}, 'rev' => $lrev->{'rev'}};
  }
  my $md5;
  my $oldl;
  for my $l (reverse @linkinfo) {
    if (!$md5) {
      $md5 = $l->{'srcmd5'};
      $oldl = $l;
      next;
    }
    my $md5c = "$md5  /LINK\n$l->{'srcmd5'}  /LOCAL\n";
    $md5 = Digest::MD5::md5_hex($md5c);
    my $treedir = $BSConfig::nosharedtrees ? "$treesdir/$l->{'project'}/$l->{'package'}" : "$treesdir/$l->{'package'}";
    if (! -e "$treedir/$md5-MD5SUMS") {
      my $error = applylink($md5, $oldl, $l);
      if ($error) {
        $rev->{'srcmd5'} = $md5 if $l == $linkinfo[0];
	$error = "$l->{'project'}/$l->{'package'}: $error" if $l != $linkinfo[0];
        return $error;
      }
    }
    $l->{'srcmd5'} = $md5;
    $oldl = $l;
  }
  $rev->{'srcmd5'} = $md5;
  $files = lsrev($rev, $li);
  return $files;
}

# returns expanded filelist
# modifies $rev->{'srcmd5'}, $rev->{'vrev'}
sub lsrev_expanded {
  my ($rev, $linkinfo) = @_;
  my $files = lsrev($rev, $linkinfo);
  return $files unless $files->{'_link'};
  $files = handlelinks($rev, $files, $linkinfo);
  die("$files\n") unless ref $files;
  return $files;
}

# add missing target information to linkinfo
sub linkinfo_addtarget {
  my ($rev, $linkinfo) = @_;
  my %lrev = %$rev;
  $lrev{'srcmd5'} = $linkinfo->{'lsrcmd5'} if $linkinfo->{'lsrcmd5'};
  my $files = lsrev(\%lrev);
  die("linkinfo_addtarget: not a link?\n") unless $files->{'_link'};
  my $l = repreadxml(\%lrev, '_link', $files->{'_link'}, $BSXML::link, 1);
  if ($l) {
    $linkinfo->{'project'} = defined($l->{'project'}) ? $l->{'project'} : $lrev{'project'};
    $linkinfo->{'package'} = defined($l->{'package'}) ? $l->{'package'} : $lrev{'package'};
    $linkinfo->{'rev'} = $l->{'rev'} if $l->{'rev'};
    $linkinfo->{'baserev'} = $l->{'baserev'} if $l->{'baserev'};
  }
}

sub findlastworkinglink {
  my ($rev) = @_;

  my $projid = $rev->{'project'};
  my $packid = $rev->{'package'};
  my $treedir = $BSConfig::nosharedtrees ? "$treesdir/$projid/$packid" : "$treesdir/$packid";
  my @cand = grep {s/-MD5SUMS$//} ls($treedir);
  if ($BSConfig::nosharedtrees && $BSConfig::nosharedtrees == 2) {
    push @cand, grep {s/-MD5SUMS$//} ls("$srcrep/$packid");
    @cand = unify(@cand);
  }
  my %cand;
  for my $cand (@cand) {
    my $candrev = {'project' => $projid, 'package' => $packid, 'srcmd5' => $cand};
    my %li;
    my $files = lsrev($candrev, \%li);
    next unless $li{'lsrcmd5'} && $li{'lsrcmd5'} eq $rev->{'srcmd5'};
    $cand{$cand} = $li{'srcmd5'};
  }
  return undef unless %cand;
  @cand = sort keys %cand;
  return $cand[0] if @cand == 1;

  while (1) {
    my $lrev = {'project' => $projid, 'package' => $packid, 'srcmd5' => $rev->{'srcmd5'}};
    my $lfiles = lsrev($lrev);
    return undef unless $lfiles;
    my $l = repreadxml($lrev, '_link', $lfiles->{'_link'}, $BSXML::link, 1);
    return undef unless $l;
    $projid = $l->{'project'} if exists $l->{'project'};
    $packid = $l->{'package'} if exists $l->{'package'};
    my $lastcand;
    for my $cand (splice @cand) {
      next unless $cand{$cand};
      my %li;
      my $candrev = {'project' => $projid, 'package' => $packid, 'srcmd5' => $cand{$cand}};
      lsrev($candrev, \%li);
      $candrev->{'srcmd5'} = $li{'lsrcmd5'} if $li{'lsrcmd5'};
      $candrev = findlastrev($candrev);
      next unless $candrev;
      next if $lastcand && $lastcand->{'rev'} > $candrev->{'rev'};
      $cand{$cand} = $li{'srcmd5'} ? $li{'srcmd5'} : undef;
      if ($lastcand && $lastcand->{'rev'} == $candrev->{'rev'}) {
        push @cand, $cand;
	next;
      }
      @cand = ($cand);
      $lastcand = $candrev;
    }
    return undef unless @cand;
    return $cand[0] if @cand == 1;
    $rev = $lastcand;
  }
}


###########################################################################
###
###  project/package management
###

sub identical {
  my ($d1, $d2, @except) = @_;

  return 0 unless defined($d1) && defined($d2);
  my $r = ref($d1);
  return 0 if $r ne ref($d2);
  if ($r eq '') {
    return 0 if $d1 ne $d2;
  } elsif ($r eq 'HASH') {
    my %k = (%$d1, %$d2);
    my %except = map {$_ => 1} @except;
    for my $k (keys %k) {
      next if $except{$k};
      return 0 unless identical($d1->{$k}, $d2->{$k});
    }
  } elsif ($r eq 'ARRAY') {
    return 0 unless @$d1 == @$d2;
    for (my $i = 0; $i < @$d1; $i++) {
      return 0 unless identical($d1->[$i], $d2->[$i], @except);
    }
  } else {
    return 0;
  }
  return 1;
}

sub findprojects {
  local *D;
  mkdir_p("$projectsdir") || die("creating $projectsdir: $!\n");
  opendir(D, $projectsdir) || die("$projectsdir: $!\n");
  my @projids = grep {s/\.xml$//} readdir(D);
  closedir(D);
  return sort @projids;
}

sub findpackages {
  my ($projid, $proj, $nonfatal, $seen) = @_;
  $proj ||= readproj($projid, 1) || {};
  local *D;
  my @packids;
  if (opendir(D, "$projectsdir/$projid.pkg")) {
    @packids = grep {s/\.xml$//} readdir(D);
    closedir(D);
  }
  if ($proj->{'link'}) {
    $seen ||= {};
    for my $lprojid (map {$_->{'project'}} @{$proj->{'link'}}) {
      next if $seen->{$lprojid};
      $seen->{$lprojid} = 1;
      my @lpackids;
      my $lproj = readproj($lprojid, 1);
      if (!$lproj || $lproj->{'remoteurl'}) {
        $lproj = remoteprojid($lprojid);
	my $r;
	eval {
	  $r = BSRPC::rpc({'uri' => "$lproj->{'remoteurl'}/source/$lproj->{'remoteproject'}", 'proxy' => $proxy}, $BSXML::dir);
	};
        if ($@ && $@ !~ /^404/) {
          die($@) unless $nonfatal;
          warn($@);
        }
	@lpackids = map {$_->{'name'}} @{($r || {})->{'entry'} || []};
      } else {
	@lpackids = findpackages($lprojid, undef, $nonfatal, $seen);
      }
      if (grep {$_ eq '_product'} @packids) {
	@lpackids = grep {$_ ne '_product' && !/^_product:/} @lpackids;
      }
      push @packids, @lpackids;
    }
    @packids = unify(@packids);
  }
  return sort @packids;
}

sub getrev_meta {
  my ($projid, $packid, $revid, $nonfatal) = @_;
  my $revfile = defined($packid) ? "$projectsdir/$projid.pkg/$packid.mrev" : "$projectsdir/$projid.pkg/_meta.mrev";
  my $rev;
  if (!defined($revid) || $revid eq 'latest') {
    $rev = BSFileDB::fdb_getlast($revfile, $srcrevlay);
  } elsif ($revid =~ /^[0-9a-f]{32}$/) {
    $rev = { 'srcmd5' => $revid };
  } else {
    $rev = BSFileDB::fdb_getmatch($revfile, $srcrevlay, 'rev', $revid);
  }
  if ($rev) {
    $rev->{'project'} = $projid;
    $rev->{'package'} = defined($packid) ? $packid : '_meta';
  } elsif (!$nonfatal) {
    die("404 revision '$revid' does not exist\n");
  }
  return $rev;
}

sub retrofit_old_prjsource {
  my ($projid) = @_;
  my $files = {};
  my $packid = '_project';
  if (-e "$projectsdir/$projid.conf") {
    BSUtil::cp("$projectsdir/$projid.conf", "$uploaddir/addrev_meta$$");
    $files->{'_config'} = addfile($projid, $packid, "$uploaddir/addrev_meta$$", '_config');
  }
  return $files;
}

sub retrofit_old_meta {
  my ($projid, $packid) = @_;
  my $files = {};
  if (defined($packid) && $packid ne '_project') {
    if (-e "$projectsdir/$projid.pkg/$packid.xml") {
      BSUtil::cp("$projectsdir/$projid.pkg/$packid.xml", "$uploaddir/addrev_meta$$");
      $files->{'_meta'} = addfile($projid, $packid, "$uploaddir/addrev_meta$$", '_meta');
    }
  } else {
    $packid = '_project';
    if (-e "$projectsdir/$projid.xml") {
      BSUtil::cp("$projectsdir/$projid.xml", "$uploaddir/addrev_meta$$");
      $files->{'_meta'} = addfile($projid, $packid, "$uploaddir/addrev_meta$$", '_meta');
    }
    if (-e "$projectsdir/$projid.pkg/_pubkey") {
      BSUtil::cp("$projectsdir/$projid.pkg/_pubkey", "$uploaddir/addrev_meta$$");
      $files->{'_pubkey'} = addfile($projid, $packid, "$uploaddir/addrev_meta$$", '_pubkey');
    }
    if (-e "$projectsdir/$projid.pkg/_signkey") {
      BSUtil::cp("$projectsdir/$projid.pkg/_signkey", "$uploaddir/addrev_meta$$");
      chmod(0600, "$uploaddir/addrev_meta$$");
      $files->{'_signkey'} = addfile($projid, $packid, "$uploaddir/addrev_meta$$", '_signkey');
    }
  }
  return $files;
}

sub extract_old_prjsource {
  my ($projid, $rev) = @_;
  my $files = lsrev($rev);
  my $config;
  $config = repreadstr($rev, '_config', $files->{'_config'}, 1) if $files->{'_config'};
  writestr("$uploaddir/$$.2", "$projectsdir/$projid.conf", $config) if $config;
}

sub extract_old_meta {
  my ($projid, $packid, $rev) = @_;
  my $files = lsrev($rev);
  if (!defined($packid) || $packid eq '_project') {
    $packid = '_project';
    my $pubkey;
    $pubkey = repreadstr($rev, '_pubkey', $files->{'_pubkey'}, 1) if $files->{'_pubkey'};
    writestr("$uploaddir/$$.2", "$projectsdir/$projid.pkg/_pubkey", $pubkey) if $pubkey;
    my $signkey;
    $signkey = repreadstr($rev, '_signkey', $files->{'_signkey'}, 1) if $files->{'_signkey'};
    if ($signkey) {
      writestr("$uploaddir/$$.2", undef, $signkey);
      chmod(0600, "$uploaddir/$$.2");
      rename("$uploaddir/$$.2", "$projectsdir/$projid.pkg/_signkey") || die("rename $uploaddir/$$.2 $projectsdir/$projid.pkg/_signkey: $!\n");
    }
    my $meta;
    $meta = repreadstr($rev, '_meta', $files->{'_meta'}, 1) if $files->{'_meta'};
    writestr("$uploaddir/$$.2", "$projectsdir/$projid.xml", $meta) if $meta;
  } else {
    my $meta;
    $meta = repreadstr($rev, '_meta', $files->{'_meta'}, 1) if $files->{'_meta'};
    writestr("$uploaddir/$$.2", "$projectsdir/$projid.pkg/$packid.xml", $meta) if $meta;
  }
}

sub addrev_meta {
  my ($cgi, $projid, $packid, $tmpfile, $file, $rfile, $suf) = @_;

  $suf ||= 'mrev';
  my $md5;
  my $rpackid = defined($packid) ? $packid : '_project';
  if ($file) {
    mkdir_p($uploaddir);
    BSUtil::cp($tmpfile, "$uploaddir/addrev_meta$$");
    chmod(0600, "$uploaddir/addrev_meta$$") if !defined($packid) && $suf eq 'mrev' && $rfile eq '_signkey';
    $md5 = addfile($projid, $rpackid, "$uploaddir/addrev_meta$$", $rfile);
  }
  mkdir_p("$projectsdir/$projid.pkg");
  my $revfile = "$projectsdir/$projid.pkg/$rpackid.$suf";
  local *FF;
  BSUtil::lockopen(\*FF, '+>>', $revfile);
  my $rev = BSFileDB::fdb_getlast($revfile, $srcrevlay);
  my $files;
  if ($rev) {
    $rev->{'project'} = $projid;
    $rev->{'package'} = $rpackid;
    $files = lsrev($rev);
  } else {
    $files = {};
    if ((defined($packid) && -e "$projectsdir/$projid.pkg/$packid.xml") || (!defined($packid) && -e "$projectsdir/$projid.xml")) {
      if ($suf eq 'mrev') {
        $files = retrofit_old_meta($projid, $packid);
      } elsif (!defined($packid)) {
        $files = retrofit_old_prjsource($projid);
      }
    }
  }
  if ($md5) {
    $files->{$rfile} = $md5;
  } else {
    # if rfile is not defined this is a delete project/package operation.
    # leave files untouched
    delete $files->{$rfile} if defined $rfile;
  }
  my $srcmd5 = addmeta($projid, $rpackid, $files);
  my $user = defined($cgi->{'user'}) ? str2utf8xml($cgi->{'user'}) : 'unknown';
  my $comment = defined($cgi->{'comment'}) ? str2utf8xml($cgi->{'comment'}) : '';
  my $nrev = { 'srcmd5' => $srcmd5, 'time' => time(), 'user' => $user, 'comment' => $comment, 'requestid' => $cgi->{'requestid'} };
  if (!defined($rfile) && defined($packid) && $suf ne 'mrev') {
    $nrev->{'version'} = $rev->{'version'} if $rev && defined $rev->{'version'};
    $nrev->{'vrev'} = $rev->{'vrev'} if $rev && defined $rev->{'vrev'};
  }
  BSFileDB::fdb_add_i(\*FF,  $srcrevlay, $nrev);
  if ($file) {
    rename($tmpfile, $file) || die("rename $tmpfile $file: $!\n");
  }
  close FF;	# free lock
}

sub readproj {
  my ($projid, $nonfatal, $revid) = @_;
  my $proj;
  if ($revid) {
    my $rev = getrev_meta($projid, undef, $revid);
    my $files = $rev ? lsrev($rev) : {};
    $proj = repreadxml($rev, '_meta', $files->{'_meta'}, $BSXML::proj, 1) if $files->{'_meta'};
  } else {
    $proj = readxml("$projectsdir/$projid.xml", $BSXML::proj, 1);
  }
  die("404 project '$projid' does not exist\n") if !$proj && !$nonfatal;
  return $proj;
}

sub readpack {
  my ($projid, $packid, $nonfatal, $revid) = @_;
  my $pack;
  if ($revid) {
    my $rev = getrev_meta($projid, $packid, $revid, $nonfatal);
    my $files = $rev ? lsrev($rev) : {};
    $pack = repreadxml($rev, '_meta', $files->{'_meta'}, $BSXML::pack, 1) if $files->{'_meta'};
  } else {
    $pack = readxml("$projectsdir/$projid.pkg/$packid.xml", $BSXML::pack, 1);
  }
  if (!$pack && !$nonfatal) {
    readproj($projid);
    die("404 package '$packid' does not exist in project '$projid'\n");
  }
  return $pack;
}

# collect all globale source services via all package and project links
sub getprojectservices {
  my ($cgi, $projid, $packid, $projectloop) = @_;
  my $services;

  # protection against loops and double matches
  $projectloop = {} unless $projectloop;
  return ({}, $BSXML::services) if $projectloop->{$projid};
  $projectloop->{$projid}=1;

  # get source services from this project
  my $projectrev = getrev($projid, '_project');
  my $projectfiles = lsrev($projectrev);
  if ($projectfiles->{'_service'}) {
    $services = readxml("$srcrep/_project/$projectfiles->{'_service'}-_service", $BSXML::services, 1);
  }

  # find further projects via project link
  my $proj = readproj($projid, 1);
  for my $lprojid (map {$_->{'project'}} @{$proj->{'link'} || []}) {
    my ($as, undef) = getprojectservices($cgi, $lprojid, $packid, $projectloop);
    if (defined($as) && defined($as->{'service'})) {
      push @{$services->{'service'}}, @{$as->{'service'}};
    }
  }

  # find further projects via package link
  my $packagerev = getrev($projid, $packid);
  my $packagefiles = lsrev($packagerev);
  if ($packagefiles->{'_link'}) {
    my $l = repreadxml($packagerev, '_link', $packagefiles->{'_link'}, $BSXML::link, 1);
    my $lprojid=$projid;
    my $lpackid=$packid;
    $lprojid=$l->{'project'} if $l->{'project'};
    $lpackid=$l->{'package'} if $l->{'package'};

    # honor project links
    my ($lpack, undef) = getpackage($cgi, $lprojid, $lpackid);
    if ($lprojid ne $lpack->{'project'}) {
      my ($as, undef) = getprojectservices($cgi, $lprojid, $packid, $projectloop);
      if (defined($as) && defined($as->{'service'})) {
        push @{$services->{'service'}}, @{$as->{'service'}};
      }
      $lprojid = $lpack->{'project'};
    }

    my ($as, undef) = getprojectservices($cgi, $lprojid, $lpackid, $projectloop);
    if (defined($as) && defined($as->{'service'})) {
      push @{$services->{'service'}}, @{$as->{'service'}};
    }
  }

  $services = {} unless $services;
  return ($services, $BSXML::services);
};

# find matching .spec/.dsc/.kiwi file depending on packid and/or repoid
sub findfile {
  my ($rev, $repoid, $ext, $files) = @_;

  $files = lsrev($rev) unless $files;
  return (undef, undef) unless $files;

  # create filename -> return value hash
  my %files = map {$_ => [$files->{$_}, $_]} keys %$files;

  # map services files to their real name
  if ($files{'_service'}) {
    for (sort keys %files) {
      next unless /^_service:.*:(.*?)$/s;
      next unless $files{$_};
      $files{$1} = $files{$_};
      delete $files{$_};
    }
  }

  my $packid = $rev->{'package'};
  return (@{$files{"$packid-$repoid.$ext"}}) if defined($repoid) && $files{"$packid-$repoid.$ext"};
  # 28.4.2009 mls: deleted "&& defined($repoid)"
  return @{$files{"$packid.$ext"}} if $files{"$packid.$ext"};
  # try again without last components
  if ($packid =~ /^(.*?)\./) {
    return @{$files{"$1.$ext"}} if $files{"$1.$ext"};
  }
  my @files = grep {/\.$ext$/} keys %files;
  @files = grep {/^\Q$packid\E/i} @files if @files > 1;
  return @{$files{$files[0]}} if @files == 1;
  if (@files > 1) {
    if (!defined($repoid)) {
      # return (undef, undef);
      @files = sort @files;
      return @{$files{$files[0]}};
    }
    @files = grep {/^\Q$packid-$repoid\E/i} @files if @files > 1;
    return @{$files{$files[0]}} if @files == 1;
  }
  return (undef, undef);
}

sub unify {
  my %h = map {$_ => 1} @_;
  return grep(delete($h{$_}), @_);
}

#########################################################################

# set up kiwi project callback

sub kiwibootcallback {
  my ($projid, $packid) = @_;
  BSVerify::verify_projid($projid);
  BSVerify::verify_packid($packid);
  checksourceaccess($projid, $packid);
  my $rev = getrev($projid, $packid);
  my $files = lsrev($rev);
  my ($md5, $file) = findfile($rev, undef, 'kiwi', $files);
  die("no kiwi file found\n") unless $md5 && $file;
  my $xml = readstr("$srcrep/$packid/$md5-$file");
  return ($xml, {'project' => $projid, 'package' => $packid, 'srcmd5' => $rev->{'srcmd5'}, 'file' => $file});
}
$Build::Kiwi::bootcallback = \&kiwibootcallback;

#########################################################################

sub getprojquotapackage {
  my ($projid) = @_;
  if (!exists($packagequota{':packages'})) {
    my $quotaxml = readxml($BSConfig::bsquotafile, $BSXML::quota, 1);
    for my $p (@{$quotaxml->{'project'} || []}) {
      $packagequota{$p->{'name'}} = $p->{'packages'};
    }
    $packagequota{':packages'} = $quotaxml->{'packages'};
  }
  while ($projid) {
    return $packagequota{$projid} if exists $packagequota{$projid};
    last unless $projid =~ s/:[^:]*$//;
  }
  return $packagequota{':packages'};
}

sub getprojpack {
  my ($cgi, $projids, $repoids, $packids, $arch) = @_;
  local *oldbsrpc = *BSRPC::rpc;
  local *BSRPC::rpc;
  if ($cgi->{'noremote'}) {
    *BSRPC::rpc = sub {die("500 remote error: noremote option\n");};
  } else {
    *BSRPC::rpc = *oldbsrpc;
  }
  $arch ||= 'noarch';
  $projids = [ findprojects() ] unless $projids;
  if ($BSConfig::limit_projects && $BSConfig::limit_projects->{$arch}) {
    $projids ||= $BSConfig::limit_projects->{$arch};
    my %limit_projids = map {$_ => 1} @{$BSConfig::limit_projects->{$arch}};
    $projids = [ grep {$limit_projids{$_}} @$projids ];
  }
  $repoids = { map {$_ => 1} @$repoids } if $repoids;
  $packids = { map {$_ => 1} @$packids } if $packids;
  my $bconf = Build::read_config($arch);

  my $remotemap = $cgi->{'withremotemap'} ? {} : undef;
  my @res;
  for my $projid (@$projids) {
    my $jinfo = { 'name' => $projid };
    my $proj = readproj($projid, 1);
    if ($remotemap && (!$proj || $proj->{'remoteurl'}) && !exists($remotemap->{$projid})) {
      my $r = remoteprojid($projid);
      $remotemap->{$projid} = {%$r, 'proto' => 1} if $r;
    }
    next unless $proj;

    my %expandedrepos;

    if ($cgi->{'withrepos'}) {
      if ($repoids) {
	$jinfo->{'repository'} = [ grep {$repoids->{$_->{'name'}}} @{$proj->{'repository'} || []} ];
      } else {
        $jinfo->{'repository'} = $proj->{'repository'} || [];
      }
      if ($cgi->{'expandedrepos'}) {
	$jinfo->{'repository'} = Storable::dclone($jinfo->{'repository'});
	for my $repo (@{$jinfo->{'repository'}}) {
	  my @prps = expandsearchpath($projid, $repo->{'name'}, $remotemap);
          $expandedrepos{"$projid/$repo->{'name'}"} = [ @prps ];
	  for my $prp (@prps) {
	    my @s = split('/', $prp, 2);
	    $prp = {'project' => $s[0], 'repository' => $s[1]};
	  }
	  $repo->{'path'} = \@prps;
	}
      } elsif ($remotemap) {
	for my $repo (@{$jinfo->{'repository'}}) {
	  eval {
	    my @prps = expandsearchpath($projid, $repo->{'name'}, $remotemap);
            $expandedrepos{"$projid/$repo->{'name'}"} = [ @prps ];
	  };
	  $expandedrepos{"$projid/$repo->{'name'}"} = $@ if $@;
	}
      }
    }

    if ($remotemap) {
      for my $lprojid (map {$_->{'project'}} @{$proj->{'link'} || []}) {
        my $lproj = remoteprojid($lprojid);
	eval {
	  fetchremoteproj($lproj, $lprojid, $remotemap) if $lproj;
	};
      }
    }

    if ($cgi->{'withconfig'}) {
      my $config = readstr("$projectsdir/$projid.conf", 1);
      if ($config) {
	# strip away macro blocks
	while ($config =~ /^(.*?\n)?\s*(macros:[^\n]*\n.*)/si) {
	  my ($c1, $c2) = ($1, $2);
	  $c1 = '' unless defined $c1;
	  if ($c2 =~ /^(?:.*?\n)?\s*:macros\s*\n(.*)$/si) {
	    $config = "$c1$c2";
	  } else {
	    $config = $c1;
	    last;
	  }
	}
	$jinfo->{'config'} = $config unless $config =~ /^\s*$/s;
      }
    }
    if ($cgi->{'withsrcmd5'} && -s "$projectsdir/$projid.pkg/pattern-MD5SUMS") {
      my $patterns = readstr("$projectsdir/$projid.pkg/pattern-MD5SUMS", 1);
      $jinfo->{'patternmd5'} = Digest::MD5::md5_hex($patterns) if $patterns;
    } elsif ($cgi->{'withsrcmd5'} && $cgi->{'nopackages'}) {
      # used by publisher to get patternmd5
      eval {
	my $rev = getrev($projid, '_pattern');
	my $files = lsrev_expanded($rev);
	$jinfo->{'patternmd5'} = $rev->{'srcmd5'};
      };
    }
    my @packages;
    @packages = findpackages($projid, $proj, 1) unless $cgi->{'nopackages'} || $proj->{'remoteurl'};
    next if $repoids && !grep {$repoids->{$_->{'name'}}} @{$proj->{'repository'} || []};
    next if $packids && !grep {$packids->{$_}} @packages;
    for (qw{title description build publish debuginfo useforbuild remoteurl remoteproject download link sourceaccess privacy access}) {
      $jinfo->{$_} = $proj->{$_} if exists $proj->{$_};
    }
    # Check build flags in project meta data
    # packages inherit the project wide settings and may override them
    my $pdisabled;
    my $pdisable = {};
    my $penable = {};
    undef($penable) if $cgi->{'ignoredisable'};
    if ($jinfo->{'build'} && $penable) {
      for (@{$proj->{'repository'} || []}) {
        my $disen = BSUtil::enabled($_->{'name'}, $jinfo->{'build'}, 1, $arch);
        if ($disen) {
          $penable->{$_->{'name'}} = 1;
        } else {
          $pdisable->{$_->{'name'}} = 1;
        }
      }
      $pdisabled = 1 if !keys(%$penable);
    } else {
      # build is enabled
      undef($penable);
    }

    # Check package number quota
    my $quota_exceeded;
    if ($BSConfig::bsquotafile) {
      my $pquota = getprojquotapackage($projid);
      $quota_exceeded = 1 if defined($pquota) && @packages > $pquota;
    }

    if (!$cgi->{'ignoredisable'} && !grep {!$_->{'status'} || $_->{'status'} ne 'disabled'} @{$proj->{'repository'} || []}) {
      # either no repositories or all disabled. No need to check packages
      @packages = ();
    }
    @packages = () if $cgi->{'nopackages'};
    my @pinfo;
    my %bconfs;

    for my $packid (@packages) {

      next if $packids && !$packids->{$packid};
      my $pinfo = {'name' => $packid};
      push @pinfo, $pinfo;
      my $pack = readpack($projid, $packid, 1);
      $pack ||= {} if $proj->{'link'};
      if (!$pack) {
	$pinfo->{'error'} = 'no metadata';
	next;
      }
      for (qw{build publish debuginfo useforbuild bcntsynctag sourceaccess privacy access}) {
	$pinfo->{$_} = $pack->{$_} if $pack->{$_};
      }
      if (!$pinfo->{'build'}) {
        $pinfo->{'build'}->{'enable'} = $pack->{'enable'} if $pack->{'enable'};
        $pinfo->{'build'}->{'disable'} = $pack->{'disable'} if $pack->{'disable'};
      }
      my $enable = defined($penable) ? {%$penable} : undef;
      my $disable = {%$pdisable};
      if (!$cgi->{'ignoredisable'} && $pinfo->{'build'}) {
        for (@{$proj->{'repository'} || []}) {
          my $default = exists($disable->{$_->{'name'}}) ? 0 : 1;
          my $disen = BSUtil::enabled($_->{'name'}, $pinfo->{'build'}, $default, $arch);
          if ($disen) {
            $enable->{$_->{'name'}} = 1;
            delete $disable->{$_->{'name'}};
          } else {
            $disable->{$_->{'name'}} = 1;
            delete $enable->{$_->{'name'}};
          }
        }
      }
      undef($disable) if $enable && !keys(%$enable);
      undef($enable) if $disable && !keys(%$disable);
      if ((!$disable || $pdisabled) && $enable && !%$enable) {
	$pinfo->{'error'} = 'disabled';
	next;
      }
      if ($quota_exceeded) {
	$pinfo->{'error'} = 'quota exceeded';
	next;
      }
      if ($cgi->{'withsrcmd5'} || $cgi->{'withdeps'}) {
        my $rev;
	my $linked = [];
	eval {
	  $rev = getrev($projid, $packid, 'build', $linked);
	};
        $pinfo->{'originproject'} = $rev->{'originproject'} if $rev && $rev->{'originproject'};
        $pinfo->{'linked'} = $linked if @$linked;
	if ($@) {
	  $pinfo->{'error'} = $@;
	  $pinfo->{'error'} =~ s/\n$//s;
 	  next;
	}
	if (!$rev || $rev->{'srcmd5'} eq 'empty' || $rev->{'srcmd5'} eq 'd41d8cd98f00b204e9800998ecf8427e') {
	  $pinfo->{'error'} = 'no source uploaded';
	  next;
	}
	$pinfo->{'srcmd5'} = $rev->{'srcmd5'};
	$pinfo->{'rev'} = $rev->{'rev'};
	$pinfo->{'revtime'} = $rev->{'time'} if $rev->{'time'};
	my $files;
	eval {
          $files = lsrev($rev);
	};
	if ($@) {
	  $pinfo->{'error'} = $@;
	  $pinfo->{'error'} =~ s/\n$//s;
 	  next;
	}
	if ($files->{'_service'} && -e "$eventdir/service/${projid}::$packid") {
	  $pinfo->{'error'} = 'source update running';
 	  next;
	}
        if ($files->{'_service_error'}) {
	  $pinfo->{'error'} = 'source service failed';
 	  next;
        }
	if ($files->{'_link'}) {
	  my %li = ('linked' => $linked);
	  eval {
	    $files = handlelinks($rev, $files, \%li);
	  };
	  if ($@) {
	    $files = "$@";
	    $files =~ s/\n$//;
	  }
          $pinfo->{'linked'} = $linked if @$linked;
	  if (!ref $files) {
	    $pinfo->{'error'} = defined($files) ? $files : "could not get file list";
	    next;
	  }
	  $pinfo->{'srcmd5'} = $rev->{'srcmd5'};
	  my $meta = '';
	  $meta .= "$files->{$_}  $_\n" for sort keys %$files;
	  $pinfo->{'verifymd5'} = Digest::MD5::md5_hex($meta);
	}
	if ($packid eq '_pattern') {
	  $jinfo->{'patternmd5'} = $pinfo->{'srcmd5'};
	  $pinfo->{'error'} = 'excluded';
	  next;
	}
	if ($files->{'_aggregate'}) {
	  my $aggregatelist = repreadxml($rev, '_aggregate', $files->{'_aggregate'}, $BSXML::aggregatelist, 1);
	  if (!$aggregatelist) {
	    $pinfo->{'error'} = "bad aggregatelist data";
	    next;
	  }
          eval {
	    BSVerify::verify_aggregatelist($aggregatelist);
          };
	  if ($@) {
	    my $err = $@;
	    $err =~ s/\n$//s;
	    $pinfo->{'error'} = "bad aggregatelist: $err";
	    next;
	  }
	  $pinfo->{'aggregatelist'} = $aggregatelist;
	  if (($enable && %$enable) || ($disable && %$disable)) {
	    my @dinfo = ();
	    for my $repo (@{$proj->{'repository'} || []}) {
	      my $repoid = $repo->{'name'};
	      next if $repoids && !$repoids->{$repoid};
	      if ((!$disable || $disable->{$repoid}) && !(!$enable || $enable->{$repoid})) {
	        push @dinfo, {'repository' => $repoid, 'error' => 'disabled'};
		next;
	      }
	    }
	    $pinfo->{'info'} = \@dinfo if @dinfo;
	  }
	} elsif ($files->{'_patchinfo'}) {
	  my $patchinfo = repreadxml($rev, '_patchinfo', $files->{'_patchinfo'}, $BSXML::patchinfo, 1);
          if (!$patchinfo) {
	    $pinfo->{'error'} = "bad patchinfo data";
	    next;
	  }
          eval {
	    BSVerify::verify_patchinfo($patchinfo);
          };
	  if ($@) {
	    my $err = $@;
	    $err =~ s/\n$//s;
	    $pinfo->{'error'} = "bad patchinfo: $err";
	    next;
	  }
	  $pinfo->{'patchinfo'} = $patchinfo;
	  if (($enable && %$enable) || ($disable && %$disable)) {
	    my @dinfo = ();
	    for my $repo (@{$proj->{'repository'} || []}) {
	      my $repoid = $repo->{'name'};
	      next if $repoids && !$repoids->{$repoid};
	      if ((!$disable || $disable->{$repoid}) && !(!$enable || $enable->{$repoid})) {
	        push @dinfo, {'repository' => $repoid, 'error' => 'disabled'};
		next;
	      }
	    }
	    $pinfo->{'info'} = \@dinfo if @dinfo;
	  }
        } elsif ($cgi->{'withdeps'}) {
	  my @dinfo;

	  for my $repo (@{$proj->{'repository'} || []}) {
	    my $repoid = $repo->{'name'};
	    next if $repoids && !$repoids->{$repoid};

	    my $rinfo = {'repository' => $repoid};
	    push @dinfo, $rinfo;
	    if ((!$disable || $disable->{$repoid}) && !(!$enable || $enable->{$repoid})) {
	      $rinfo->{'error'} = 'disabled';
	      next;
	    }
            if (!$bconfs{$repoid}) {
	      print "calculating config for $projid/$repoid $arch\n";
	      my $path = $expandedrepos{"$projid/$repoid"};
	      if (!$path) {
	        eval {
		  my @path = expandsearchpath($projid, $repoid, $remotemap);
		  $expandedrepos{"$projid/$repoid"} = \@path;
		};
		$expandedrepos{"$projid/$repoid"} = $@ if $@;
		$path = $expandedrepos{"$projid/$repoid"};
	      }
	      my $c;
	      eval {
		die($path) unless ref $path;
		$c = concatconfigs($projid, $repoid, $remotemap, @$path);
	      };
	      if ($@) {
	        my $err = $@;
	        $err =~ s/\n$//;
	        $rinfo->{'error'} = $err;
	        next;
	      }
	      $c = [ split("\n", $c) ];
	      $bconfs{$repoid} = Build::read_config($arch, $c);
            }
	    my $conf = $bconfs{$repoid};
	    my $type = $conf->{'type'};
	    if (!$type || $type eq 'UNDEFINED') {
	      $rinfo->{'error'} = 'bad build configuration';
	      next;
	    }
            my ($md5, $file) = findfile($rev, $repoid, $type, $files);
	    if (!$md5) {
	      # no spec/dsc/kiwi file found
	      if (grep {/\.(?:spec|dsc|kiwi)$/} keys %$files) {
		# only different types available
		$rinfo->{'error'} = 'excluded';
	      }
	      next;
	    }
	    if ($type eq 'kiwi' && $BSConfig::kiwiprojects && !$cgi->{'ignoredisable'}) {
	      my %kiwiprojects = map {$_ => 1} @$BSConfig::kiwiprojects;
	      if (!$kiwiprojects{$projid}) {
		$rinfo->{'error'} = 'kiwi image building is not enabled for this project';
	        next;
	      }
	    }
	    $rinfo->{'file'} = $file;
	    # get build dependency info
            my $d = Build::parse($conf, "$srcrep/$packid/$md5-$file");
	    data2utf8xml($d);
            if (defined($d->{'name'})) {
	      my $version = defined($d->{'version'}) ? $d->{'version'} : 'unknown';
	      $pinfo->{'versrel'} ||= "$version-$rev->{'vrev'}";
	      $rinfo->{'name'} = $d->{'name'};
	      $rinfo->{'dep'} = $d->{'deps'};
              if ($d->{'prereqs'}) {
		my %deps = map {$_ => 1} (@{$d->{'deps'} || []}, @{$d->{'subpacks'} || []});
		my @prereqs = grep {!$deps{$_} && !/^%/} @{$d->{'prereqs'}};
		$rinfo->{'prereq'} = \@prereqs if @prereqs;
	      }
	      # KIWI Products need local arch added if we have it defined on this server
	      if ($type eq 'kiwi' && $d->{'imagetype'}[0] eq 'product' && $d->{'exclarch'}) {
		$rinfo->{'imagearch'} = [ @{$d->{'exclarch'}} ];
	        unshift @{$d->{'exclarch'}}, 'local' if defined($BSConfig::localarch);
	      }
	      # KIWI Images don't build with local arch
	      if ($type eq 'kiwi' && $d->{'imagetype'}[0] ne 'product') {
	        $rinfo->{'error'} = 'excluded' if defined($BSConfig::localarch) && $arch eq 'local';
	      }
	      $rinfo->{'error'} = 'excluded' if $d->{'exclarch'} && !grep {$_ eq $arch} @{$d->{'exclarch'}};
	      $rinfo->{'error'} = 'excluded' if $d->{'badarch'} && grep {$_ eq $arch} @{$d->{'badarch'}};
	      for ('imagetype', 'path', 'extrasource') {
	        $rinfo->{$_} = $d->{$_} if exists $d->{$_};
	      }
	      if ($remotemap && $rinfo->{'path'} && !$repo->{'path'}) {
		eval {
		  concatconfigs($projid, $repoid, $remotemap, @{$rinfo->{'path'}});
		};
	      }
	    } else {
	      $rinfo->{'error'} = "can not parse package name from $file";
	      $rinfo->{'error'} .= " because: ".$d->{'error'} if $d->{'error'};
	    }
	  }
	  $pinfo->{'info'} = \@dinfo if @dinfo;
	}
      }
    }
    $jinfo->{'package'} = \@pinfo;
    push @res, $jinfo;
  }
  my $ret = {'repoid' => $repoid, 'project' => \@res};
  #print Dumper($remotemap);
  if ($remotemap && %$remotemap) {
    for my $p (sort keys %$remotemap) {
      next unless $remotemap->{$p};
      my $r = {'project' => $p};
      for (qw{remoteurl remoteproject remoteroot root config repository error proto}) {
        $r->{$_} = $remotemap->{$p}->{$_} if defined($remotemap->{$p}->{$_});
      }
      $r->{'error'} =~ s/\n$// if $r->{'error'};
      push @{$ret->{'remotemap'}}, $r;
    }
  }
  return ($ret, $BSXML::projpack);
}

sub getprojectlist {
  my ($cgi) = @_;
  my @projects;
  if (!$cgi->{'deleted'}) {
    @projects = findprojects();
  } else {
    @projects = grep {s/\.pkg$//} ls("$projectsdir/_deleted");
    @projects = grep {! -e "$projectsdir/$_.xml"} @projects;
    @projects = sort @projects;
  }
  @projects = map {{'name' => $_}} @projects;
  return ({'entry' => \@projects}, $BSXML::dir);
}

sub getproject {
  my ($cgi, $projid) = @_;
  # Read the project xml file
  my $proj = readproj($projid, 1, $cgi->{'rev'});
  $proj = remoteprojid($projid) if !$proj || $proj->{'remoteurl'};
  die("404 project '$projid' does not exist\n") unless $proj;
  if ($proj->{'remoteurl'}) {
    my $p = BSRPC::rpc({'uri' => "$proj->{'remoteurl'}/source/$proj->{'remoteproject'}/_meta", 'proxy' => $proxy}, $BSXML::proj);
    # map remote names to local names
    $p->{'name'} = $projid;
    for my $r (@{$p->{'repository'} || []}) {
      for my $re (@{$r->{'path'} || []}) {
	$re->{'project'} = maptoremote($proj, $re->{'project'});
      }
    }
    for my $pp (@{$p->{'link'} || []}) {
      $pp->{'project'} = maptoremote($proj, $pp->{'project'});
    }
    $p->{'mountproject'} = $proj->{'root'} if defined $proj->{'root'};
    $proj = $p;
  }
  return ($proj, $BSXML::proj);
}

#########################################################################

sub createkey {
  my ($cgi, $projid) = @_;
  $cgi->{'comment'} ||= 'create sign key';
  die("don't know how to create a key\n") unless $BSConfig::sign;
  die("404 project $projid does not exist\n") unless -s "$projectsdir/$projid.xml";
  mkdir_p($uploaddir);
  local *F;
  my $pubkey = '';
  my @keyargs = ('dsa@1024', '800');
  my @signargs;
  push @signargs, '--project', $projid if $BSConfig::sign_project;
  my $obsname = $BSConfig::obsname || 'build.opensuse.org';
  open(F, '-|', $BSConfig::sign, @signargs, '-P', "$uploaddir/signkey.$$", '-g', @keyargs, "$projid OBS Project", "$projid\@$obsname") || die("$BSConfig::sign: $!\n");
  1 while sysread(F, $pubkey, 4096, length($pubkey));
  close(F) || die("$BSConfig::sign: $?\n");
  die("sign did not create signkey\n") unless -s "$uploaddir/signkey.$$";
  mkdir_p("$projectsdir/$projid.pkg");
  writestr("$uploaddir/pubkey.$$", undef, $pubkey);
  # XXX: these are two commits...
  addrev_meta($cgi, $projid, undef, "$uploaddir/pubkey.$$", "$projectsdir/$projid.pkg/_pubkey", '_pubkey');
  addrev_meta($cgi, $projid, undef, "$uploaddir/signkey.$$", "$projectsdir/$projid.pkg/_signkey", '_signkey');
  return $BSStdServer::return_ok;
}

sub extendkey {
  my ($cgi, $projid) = @_;
  $cgi->{'comment'} ||= 'extend public key expiry date';
  die("don't know how to extend a key\n") unless $BSConfig::sign;
  die("project does not have a key\n") unless -s "$projectsdir/$projid.pkg/_pubkey";
  die("project does not have a signkey\n") unless -s "$projectsdir/$projid.pkg/_signkey";
  my @keyargs = ('800');
  my @signargs;
  push @signargs, '--project', $projid if $BSConfig::sign_project;
  my $pubkey = '';
  open(F, '-|', $BSConfig::sign, @signargs, '-P', "$projectsdir/$projid.pkg/_signkey", '-x', @keyargs, "$projectsdir/$projid.pkg/_pubkey") || die("$BSConfig::sign: $!\n");
  1 while sysread(F, $pubkey, 4096, length($pubkey));
  close(F) || die("$BSConfig::sign: $?\n");
  mkdir_p($uploaddir);
  writestr("$uploaddir/pubkey.$$", undef, $pubkey);
  addrev_meta($cgi, $projid, undef, "$uploaddir/pubkey.$$", "$projectsdir/$projid.pkg/_pubkey", '_pubkey');
  return $BSStdServer::return_ok;
}

sub deletekey {
  my ($cgi, $projid) = @_;
  $cgi->{'comment'} ||= 'delete sign key';
  if ($BSConfig::forceprojectkeys) {
    my $pprojid = $projid;
    $pprojid =~ s/:[^:]*$//;
    my $sk;
    ($sk) = getsignkey({}, $pprojid) if $projid ne $pprojid;
    die("must have a key for signing\n") unless $sk;
  }
  # XXX: these are two commits...
  addrev_meta($cgi, $projid, undef, undef, undef, '_pubkey');
  addrev_meta($cgi, $projid, undef, undef, undef, '_signkey');
  unlink("$projectsdir/$projid.pkg/_signkey");
  unlink("$projectsdir/$projid.pkg/_pubkey");
  rmdir("$projectsdir/$projid.pkg");
  return $BSStdServer::return_ok;
}

sub getpubkey {
  my ($cgi, $projid) = @_;
  my $pubkey;

  my $proj = readproj($projid, 1, $cgi->{'rev'});
  $proj = remoteprojid($projid) if !$proj || $proj->{'remoteurl'};
  die("404 project '$projid' does not exist\n") unless $proj;

  if ($proj->{'remoteurl'}) {
    $pubkey = BSRPC::rpc({'uri' => "$proj->{'remoteurl'}/source/$proj->{'remoteproject'}/_pubkey", 'proxy' => $proxy}, undef);
  } else {
    if ($cgi->{'rev'}) {
      my $rev = getrev_meta($projid, undef, $cgi->{'rev'});
      my $files = $rev ? lsrev($rev) : {};
      $pubkey = repreadstr($rev, '_pubkey', $files->{'_pubkey'}, 1) if $files->{'_pubkey'};
    } else {
      $pubkey = readstr("$projectsdir/$projid.pkg/_pubkey", 1);
    }
  }
  die("404 $projid: no pubkey available\n") unless $pubkey;
  return ($pubkey, 'Content-Type: text/plain');
}

#########################################################################

sub putproject {
  my ($cgi, $projid) = @_;
  mkdir_p($uploaddir);
  my $uploaded = BSServer::read_file("$uploaddir/$$");
  die("upload failed\n") unless $uploaded;
  my $proj = readxml("$uploaddir/$$", $BSXML::proj);
  $proj->{'name'} = $projid unless defined $proj->{'name'};
  BSVerify::verify_proj($proj, $projid);
  writexml("$uploaddir/$$.2", undef, $proj, $BSXML::proj);
  unlink("$uploaddir/$$");
  my $oldproj = readxml("$projectsdir/$projid.xml", $BSXML::proj, 1);
  BSNotify::notify($oldproj ? "SRCSRV_UPDATE_PROJECT" : "SRCSRV_CREATE_PROJECT", { "project" => $projid, "sender" => ($cgi->{'user'} || "unknown") });
  mkdir_p("$projectsdir") || die("creating $projectsdir: $!\n");
  addrev_meta($cgi, $projid, undef, "$uploaddir/$$.2", "$projectsdir/$projid.xml", '_meta');
  if ($BSConfig::forceprojectkeys) {
    my ($sk) = getsignkey({}, $projid);
    createkey({ %$cgi, 'comment' => 'autocreate key' }, $projid) if $sk eq '';
  }

  if (!identical($oldproj, $proj, 'title', 'description', 'person', 'group', 'url', 'attributes')) {
    notify_repservers('project', $projid);
  }

  $proj = readproj($projid);
  return ($proj, $BSXML::proj);
}

sub delproject {
  my ($cgi, $projid) = @_;

  $cgi->{'comment'} ||= 'project was deleted';
  die("404 project '$projid' does not exist\n") unless -e "$projectsdir/$projid.xml";
  # add delete commit to both source and meta
  addrev_meta($cgi, $projid, undef, undef, undef, undef, 'rev');
  addrev_meta($cgi, $projid, undef, undef, undef, undef);
  if (-d "$projectsdir/$projid.pkg") {
    # delete packages in sub process to avoid timeout errors
    my $pid;
    if (!($pid = xfork())) {
      # delete those packages and keys
      mkdir_p("$projectsdir/_deleted/$projid.pkg");
      # make room in old delete by deleting all old packages
      for my $f (ls("$projectsdir/_deleted/$projid.pkg")) {
        if ($f =~ /\.m?rev$/) {
          my $oldrev = readstr("$projectsdir/_deleted/$projid.pkg/$f", 1);
          if (defined($oldrev) && $oldrev ne '') {
            BSUtil::lockopen(\*F, '+>>', "$projectsdir/_deleted/$projid.pkg/$f.del");
            BSUtil::appendstr("$projectsdir/_deleted/$projid.pkg/$f.del", $oldrev);
            # XXX: add comment
            close F;
          }
          unlink("$projectsdir/_deleted/$projid.pkg/$f");
        }
      }
      for my $f (ls("$projectsdir/$projid.pkg")) {
        if ($f =~ /^(.*)\.xml$/) {
          my $packid = $1;
          if (! -f "$projectsdir/$projid.pkg/$1.mrev") {
            # create initial meta revision in case it does not exist yet
            addrev_meta($cgi, $projid, $packid, undef, undef, undef);
          }
        }
      }
      for my $f (ls("$projectsdir/$projid.pkg")) {
        if ($f =~ /\.m?rev(?:\.del)?$/) {
          updatelinkinfodb($projid, $1) if $f =~ /^(.*)\.rev$/;
          my $oldrev = readstr("$projectsdir/$projid.pkg/$f", 1);
          if (defined($oldrev) && $oldrev ne '') {
            BSUtil::lockopen(\*F, '+>>', "$projectsdir/_deleted/$projid.pkg/$f");
            BSUtil::appendstr("$projectsdir/_deleted/$projid.pkg/$f", $oldrev);
            close F;
          }
        }
        unlink("$projectsdir/$projid.pkg/$f");
      }
      rmdir("$projectsdir/$projid.pkg") || die("rmdir $projectsdir/$projid.pkg: $!\n");
    }
  }
  unlink("$projectsdir/$projid.conf");
  unlink("$projectsdir/$projid.xml");
  notify_repservers('project', $projid);

  BSNotify::notify("SRCSRV_DELETE_PROJECT", { "project" => $projid, "comment" => $cgi->{'comment'}, "sender" => ($cgi->{'user'} || "unknown") });

  return $BSStdServer::return_ok;
}

sub undeleteproject {
  my ($cgi, $projid) = @_;

  die("404 project '$projid' already exists\n") if -e "$projectsdir/$projid.xml";
  die("404 project '$projid' is not deleted\n") unless -e "$projectsdir/_deleted/$projid.pkg";
  $cgi->{'comment'} ||= 'project was undeleted';
  mkdir_p($uploaddir);
  mkdir_p("$projectsdir/$projid.pkg");
  for my $f (ls("$projectsdir/_deleted/$projid.pkg")) {
    if ($f =~ /\.m?rev\.del$/) {
      BSUtil::cp("$projectsdir/_deleted/$projid.pkg/$f", "$uploaddir/$$.2", "$projectsdir/$projid.pkg/$f");
    } elsif ($f =~ /^(.*)\.(m?rev)$/) {
      my $packid = $1;
      my $suf = $2;
      my $rev = undelete_rev($cgi, "$projectsdir/_deleted/$projid.pkg/$f", "$projectsdir/$projid.pkg/$f");
      $rev->{'project'} = $projid;
      $rev->{'package'} = $packid;
      # extract legacy files
      if ($suf eq 'rev') {
	if ($packid eq '_project') {
          extract_old_prjsource($projid, $rev);
	} else {
	  updatelinkinfodb($projid, $packid, $rev, lsrev($rev));
	}
      } elsif ($suf eq 'mrev') {
        extract_old_meta($projid, $packid, $rev);
      }
    }
  }
  notify_repservers('project', $projid);
  BSNotify::notify("SRCSRV_UNDELETE_PROJECT", { "project" => $projid, "comment" => $cgi->{'comment'}, "sender" => ($cgi->{'user'} || "unknown") });

  return $BSStdServer::return_ok;
}

#########################################################################

sub getpackagelist {
  my ($cgi, $projid, $repoid, $arch) = @_;
  my $proj = checkprojrepoarch($projid, $repoid, $arch, 1);
  if ($proj->{'remoteurl'}) {
    my @args;
    push @args, "deleted" if $cgi->{'deleted'};
    return BSRPC::rpc({'uri' => "$proj->{'remoteurl'}/source/$proj->{'remoteproject'}", 'proxy' => $proxy}, $BSXML::dir, @args), $BSXML::dir;
  }
  my @packages;
  if (!$cgi->{'deleted'}) {
    @packages = findpackages($projid, $proj);
  } else {
    @packages = grep {s/\.mrev\.del$//} ls("$projectsdir/$projid.pkg");
    @packages = grep {! -e "$projectsdir/$projid.pkg/$_.xml"} @packages;
    @packages = sort @packages;
  }
  my @plist = map {{'name' => $_}} @packages;
  return ({'entry' => \@plist}, $BSXML::dir);
}

sub getpackage {
  my ($cgi, $projid, $packid) = @_;
  my $proj = checkprojrepoarch($projid, undef, undef, 1);
  if ($proj->{'remoteurl'}) {
    my @args;
    push @args, "rev=$cgi->{'rev'}" if $cgi->{'rev'};
    my $pack = BSRPC::rpc({'uri' => "$proj->{'remoteurl'}/source/$proj->{'remoteproject'}/$packid/_meta", 'proxy' => $proxy}, $BSXML::pack, @args);
    $pack->{'project'} = $projid;	# local name
    if ($pack->{'devel'} && exists($pack->{'devel'}->{'project'})) {
      $pack->{'devel'}->{'project'} = maptoremote($proj, $pack->{'devel'}->{'project'});
    }
    return ($pack, $BSXML::pack);
  }
  if ($cgi->{'rev'}) {
    # return the exact file here
    # we also do not look at project links
    # we return the data as string so that the md5 sum matches
    my $rev = getrev_meta($projid, $packid, $cgi->{'rev'});
    my $files = lsrev($rev);
    die("404 _meta: no such file\n") unless $files->{'_meta'};
    my $meta = repreadstr($rev, '_meta', $files->{'_meta'});
    return ($meta);
  }
  my $pack = readpack($projid, $packid, 1);
  if (!$pack && $proj->{'link'}) {
    my %checked = ($projid => 1);
    my @todo = map {$_->{'project'}} @{$proj->{'link'}};
    while (@todo) {
      my $lprojid = shift @todo;
      next if $checked{$lprojid};
      $checked{$lprojid} = 1;
      my $lproj = readproj($lprojid, 1);
      $lproj = remoteprojid($lprojid) if !$lproj || $lproj->{'remoteurl'};
      if ($lproj->{'remoteurl'}) {
	eval {
	  $pack = BSRPC::rpc({'uri' => "$lproj->{'remoteurl'}/source/$lproj->{'remoteproject'}/$packid/_meta", 'proxy' => $proxy}, $BSXML::pack);
	};
        die($@) if $@ && $@ !~ /^404/;
	if ($pack) {
	  $pack->{'project'} = $lprojid;	# local name
	  if ($pack->{'devel'} && exists($pack->{'devel'}->{'project'})) {
	    $pack->{'devel'}->{'project'} = maptoremote($lproj, $pack->{'devel'}->{'project'});
	  }
	}
      } else {
        $pack = readpack($lprojid, $packid, 1);
        unshift @todo, map {$_->{'project'}} @{$lproj->{'link'}} if !$pack && $lproj->{'link'};
      }
      last if $pack;
    }
  }
  die("404 package '$packid' does not exist in project '$projid'\n") unless $pack;
  return ($pack, $BSXML::pack);
}

sub putpackage {
  my ($cgi, $projid, $packid) = @_;
  mkdir_p($uploaddir);
  my $uploaded = BSServer::read_file("$uploaddir/$$");
  die("upload failed\n") unless $uploaded;
  my $pack = readxml("$uploaddir/$$", $BSXML::pack);
  $pack->{'name'} = $packid unless defined $pack->{'name'};
  BSVerify::verify_pack($pack, $packid);
  die("package contains revision data\n") if grep {exists $pack->{$_}} @$srcrevlay;
  # XXX
  # delete rev stuff, just in case...
  # delete $pack->{$_} for @$srcrevlay;
  # $pack->{'name'} = $packid;
  writexml("$uploaddir/$$.2", undef, $pack, $BSXML::pack);
  unlink("$uploaddir/$$");
  my $proj = readproj($projid);
  die("package '$packid' is read-only\n") if ($packid =~ /^_product:/) && ! -e "$projectsdir/$projid.pkg/$packid.xml";
  mkdir_p("$projectsdir/$projid.pkg");

  my $oldpack = readxml("$projectsdir/$projid.pkg/$packid.xml", $BSXML::pack, 1);
  BSNotify::notify($oldpack ? "SRCSRV_UPDATE_PACKAGE" : "SRCSRV_CREATE_PACKAGE", { "project" => $projid, "package" => $packid, "sender" => ($cgi->{'user'} || "unknown")});

  addrev_meta($cgi, $projid, $packid, "$uploaddir/$$.2", "$projectsdir/$projid.pkg/$packid.xml", '_meta');
  if (!identical($oldpack, $pack, 'title', 'description', 'devel', 'person', 'group', 'url')) {
    notify_repservers('package', $projid, $packid);
  }
  $pack = readpack($projid, $packid);
  return ($pack, $BSXML::pack);
}

sub delpackage {
  my ($cgi, $projid, $packid) = @_;
  $cgi->{'comment'} ||= 'package was deleted';
  die("404 project '$projid' does not exist\n") unless -e "$projectsdir/$projid.xml";
  die("404 package '$packid' does not exist in project '$projid'\n") unless -e "$projectsdir/$projid.pkg/$packid.xml";
  die("403 package '$packid' is read-only\n") if $packid =~ /^_product:/;
  # add delete commit to both source and meta
  addrev_meta($cgi, $projid, $packid, undef, undef, undef, 'rev');
  addrev_meta($cgi, $projid, $packid, undef, undef, undef);
  unlink("$projectsdir/$projid.pkg/$packid.upload-MD5SUMS");
  unlink("$projectsdir/$projid.pkg/$packid.xml");
  my $oldrev = readstr("$projectsdir/$projid.pkg/$packid.rev", 1);
  if (defined($oldrev) && $oldrev ne '') {
    BSUtil::lockopen(\*F, '+>>', "$projectsdir/$projid.pkg/$packid.rev.del");
    BSUtil::appendstr("$projectsdir/$projid.pkg/$packid.rev.del", $oldrev);
    close F;
    updatelinkinfodb($projid, $packid);
  }
  unlink("$projectsdir/$projid.pkg/$packid.rev");
  $oldrev = readstr("$projectsdir/$projid.pkg/$packid.mrev", 1);
  if (defined($oldrev) && $oldrev ne '') {
    BSUtil::lockopen(\*F, '+>>', "$projectsdir/$projid.pkg/$packid.mrev.del");
    BSUtil::appendstr("$projectsdir/$projid.pkg/$packid.mrev.del", $oldrev);
    close F;
  }
  unlink("$projectsdir/$projid.pkg/$packid.mrev");
  if ($packid eq '_product') {
    expandproduct($projid, $packid, undef);
  }
  notify_repservers('package', $projid, $packid);
  BSNotify::notify("SRCSRV_DELETE_PACKAGE", { "project" => $projid, "package" => $packid, "sender" => ($cgi->{'user'} || "unknown"), "comment" => $cgi->{'comment'} });
  return $BSStdServer::return_ok;
}

sub undelete_rev {
  my ($cgi, $revfilefrom, $revfileto) = @_;
  my @rev = BSFileDB::fdb_getall($revfilefrom, $srcrevlay);
  die("$revfilefrom: no entries\n") unless @rev;
  # XXX add way to specify which block to restore
  for my $rev (reverse splice @rev) {
    unshift @rev, $rev;
    last if $rev->{'rev'} == 1;
  }
  my $rev = $rev[-1];
  my $user = defined($cgi->{'user'}) ? str2utf8xml($cgi->{'user'}) : 'unknown';
  my $comment = defined($cgi->{'comment'}) ? str2utf8xml($cgi->{'comment'}) : '';
  my $nrev = { 'srcmd5' => $rev->{'srcmd5'}, 'time' => time(), 'user' => $user, 'comment' => $comment, 'requestid' => $cgi->{'requestid'} };
  $nrev->{'version'} = $rev->{'version'} if $rev && defined $rev->{'version'};
  $nrev->{'vrev'} = $rev->{'vrev'} if $rev && defined $rev->{'vrev'};
  $nrev->{'rev'} = $rev->{'rev'} + 1;
  push @rev, $nrev;
  BSFileDB::fdb_add_multiple($revfileto, $srcrevlay, @rev);
  return $nrev;
}

sub undeletepackage {
  my ($cgi, $projid, $packid) = @_;
  $cgi->{'comment'} ||= 'package was undeleted';
  die("404 project '$projid' does not exist\n") unless -e "$projectsdir/$projid.xml";
  die("403 package '$packid' already exists\n") if -e "$projectsdir/$projid.pkg/$packid.xml";
  die("403 package '$packid' was not deleted\n") unless -e "$projectsdir/$projid.pkg/$packid.rev.del";
  my $rev = undelete_rev($cgi, "$projectsdir/$projid.pkg/$packid.mrev.del", "$projectsdir/$projid.pkg/$packid.mrev");
  $rev->{'project'} = $projid;
  $rev->{'package'} = $packid;
  extract_old_meta($projid, $packid, $rev);
  if (-s "$projectsdir/$projid.pkg/$packid.rev.del") {
    my $nrev = undelete_rev($cgi, "$projectsdir/$projid.pkg/$packid.rev.del", "$projectsdir/$projid.pkg/$packid.rev");
    $nrev->{'project'} = $projid;
    $nrev->{'package'} = $packid;
    updatelinkinfodb($projid, $packid, $nrev, lsrev($nrev));
  }
  notify_repservers('package', $projid, $packid);
  BSNotify::notify("SRCSRV_UNDELETE_PACKAGE", { "project" => $projid, "package" => $packid, "sender" => ($cgi->{'user'} || "unknown"), "comment" => $cgi->{'comment'} });

  return $BSStdServer::return_ok;
}

sub getpackagehistory {
  my ($cgi, $projid, $packid) = @_;
  my @res;
  my $revfile;
  $packid = '_project' unless defined $packid;
  $revfile = "$projectsdir/$projid.pkg";
  $revfile = "$projectsdir/_deleted/$projid.pkg" if $packid eq '_project' && $cgi->{'deleted'};
  $revfile .= $cgi->{'meta'} ? "/$packid.mrev" : "/$packid.rev";
  $revfile .= '.del'if $packid ne '_project' && $cgi->{'deleted'};
  my $filter;
  if ($cgi->{'rev'}) {
    $filter = sub { return $cgi->{'rev'} eq $_[0]->{'rev'} || $cgi->{'rev'} eq $_[0]->{'srcmd5'} ? 1 : 0 };
  }
  for (BSFileDB::fdb_getall_reverse($revfile, $srcrevlay, $cgi->{'limit'}, $filter)) {
    $_->{'comment'} = str2utf8xml($_->{'comment'}) if $_->{'comment'};
    unshift @res, $_;
  }
  return ({'revision' => \@res}, $BSXML::revisionlist);
}

##########################################################################

##########################################################################

# XXX -> library

sub remoteprojid {
  my ($projid) = @_;
  my $rsuf = '';
  my $origprojid = $projid;

  my $proj = readproj($projid, 1);
  if ($proj) {
    return undef unless $proj->{'remoteurl'};
    return undef unless $proj->{'remoteproject'};
    return {
      'name' => $projid,
      'root' => $projid,
      'remoteroot' => $proj->{'remoteproject'},
      'remoteurl' => $proj->{'remoteurl'},
      'remoteproject' => $proj->{'remoteproject'},
    };
  }
  while ($projid =~ /^(.*)(:.*?)$/) {
    $projid = $1;
    $rsuf = "$2$rsuf";
    $proj = readproj($projid, 1);
    if ($proj) {
      return undef unless $proj->{'remoteurl'};
      if ($proj->{'remoteproject'}) {
        $rsuf = "$proj->{'remoteproject'}$rsuf";
      } else {
        $rsuf =~ s/^://;
      }
      return {
        'name' => $origprojid,
        'root' => $projid,
        'remoteroot' => $proj->{'remoteproject'},
        'remoteurl' => $proj->{'remoteurl'},
        'remoteproject' => $rsuf,
      };
    }
  }
  return undef;
}

sub maptoremote {
  my ($proj, $projid) = @_;
  return "$proj->{'root'}:$projid" unless $proj->{'remoteroot'};
  return $proj->{'root'} if $projid eq $proj->{'remoteroot'};
  return '_unavailable' if $projid !~ /^\Q$proj->{'remoteroot'}\E:(.*)$/;
  return "$proj->{'root'}:$1";
}

sub fetchremoteproj {
  my ($proj, $projid, $remotemap) = @_;
  return undef unless $proj && $proj->{'remoteurl'} && $proj->{'remoteproject'};
  $projid ||= $proj->{'name'};
  my $rproj;
  my $c;
  if ($remotemap) {
    $rproj = $remotemap->{$projid};
    if ($rproj) {
      die($rproj->{'error'}) if $rproj->{'error'};
      return $rproj unless $rproj->{'proto'};
      $c = $rproj->{'config'};	# save old config
      undef $rproj;
    }
  }
  print "fetching remote project data for $projid\n";
  my $param = {
    'uri' => "$proj->{'remoteurl'}/source/$proj->{'remoteproject'}/_meta",
    'timeout' => 60,
    'proxy' => $proxy,
  };
  eval {
    $rproj = BSRPC::rpc($param, $BSXML::proj);
  };
  if ($@) {
    if ($remotemap) {
      $rproj = {%$proj, 'error' => $@, 'proto' => 1};
      $rproj->{'config'} = $c if defined $c;
      $remotemap->{$projid} = $rproj;
    }
    die($@);
  }
  for (qw{name root remoteroot remoteurl remoteproject}) {
    $rproj->{$_} = $proj->{$_};
  }
  for my $repo (@{$rproj->{'repository'} || []}) {
    for my $pathel (@{$repo->{'path'} || []}) {
      $pathel->{'project'} = maptoremote($proj, $pathel->{'project'});
    }
  }
  for my $link (@{$rproj->{'link'} || []}) {
    $link->{'project'} = maptoremote($proj, $link->{'project'});
  }
  $remotemap->{$projid} = $rproj if $remotemap;
  return $rproj;
}

sub fetchremoteconfig {
  my ($proj, $projid, $remotemap) = @_;
  return undef unless $proj && $proj->{'remoteurl'} && $proj->{'remoteproject'};
  $projid ||= $proj->{'name'};
  if ($remotemap) {
    my $rproj = $remotemap->{$projid};
    if ($rproj) {
      die($rproj->{'error'}) if $rproj->{'error'};
      return $rproj->{'config'} if defined $rproj->{'config'};
    } else {
      $remotemap->{$projid} = {%$proj, 'proto' => 1};
    }
  }
  print "fetching remote project config for $projid\n";
  my $param = {
    'uri' => "$proj->{'remoteurl'}/source/$proj->{'remoteproject'}/_config",
    'timeout' => 60,
    'proxy' => $proxy,
  };
  my $c;
  eval {
    $c = BSRPC::rpc($param, undef);
  };
  if ($@) {
    $remotemap->{$projid}->{'error'} = $@ if $remotemap;
    die($@);
  }
  $remotemap->{$projid}->{'config'} = $c if $remotemap;
  return $c;
}

sub remote_getrev {
  my ($projid, $packid, $rev, $linked, $missingok) = @_;
  my $proj = remoteprojid($projid);
  if (!$proj) {
    return {'project' => $projid, 'package' => $packid, 'srcmd5' => 'pattern', 'rev' => 'pattern'} if $packid eq '_pattern';
    return {'project' => $projid, 'package' => $packid, 'srcmd5' => 'empty'} if $missingok;
    die("404 package '$packid' does not exist\n") if -e "$projectsdir/$projid.xml";
    die("404 project '$projid' does not exist\n");
  }
  # check if we already know this srcmd5, if yes don't bother to contact
  # the remote server
  if ($rev && $rev =~ /^[0-9a-f]{32}$/) {
    my $treedir = $BSConfig::nosharedtrees ? "$treesdir/$projid/$packid" : "$treesdir/$packid";
    if ( -e "$treedir/$rev-MD5SUMS") {
      return {'project' => $projid, 'package' => $packid, 'rev' => $rev, 'srcmd5' => $rev};
    }        
  }
  my @args;
  push @args, 'expand';
  push @args, "rev=$rev" if defined $rev;
  my $dir;
  eval {
    $dir = BSRPC::rpc({'uri' => "$proj->{'remoteurl'}/source/$proj->{'remoteproject'}/$packid", 'proxy' => $proxy}, $BSXML::dir, @args, 'withlinked') if $linked;
  };
  if (!$dir || $@) {
    eval {
      $dir = BSRPC::rpc({'uri' => "$proj->{'remoteurl'}/source/$proj->{'remoteproject'}/$packid", 'proxy' => $proxy}, $BSXML::dir, @args);
    };
    if ($@) {
      return {'project' => $projid, 'package' => $packid, 'srcmd5' => 'empty'} if $missingok && $@ =~ /^404[^\d]/;
      die($@);
    }
  }
  die("$dir->{'error'}\n") if $dir->{'error'};
  $rev = {};
  $rev->{'rev'} = $dir->{'rev'} || $dir->{'srcmd5'};
  $rev->{'srcmd5'} = $dir->{'srcmd5'};
  $rev->{'vrev'} = $dir->{'vrev'};
  $rev->{'vrev'} ||= '0';
  # now put everything in local srcrep
  my $files = {};
  for my $entry (@{$dir->{'entry'} || []}) {
    $files->{$entry->{'name'}} = $entry->{'md5'};
    next if -e "$srcrep/$packid/$entry->{'md5'}-$entry->{'name'}";
    if ($linked && $entry->{'size'} > 8192) {
      # getprojpack request, hand over to AJAX
      BSHandoff::rpc($ajaxsocket, "/source/$projid/$packid", undef, "rev=$dir->{'srcmd5'}");
      die("download in progress\n");
    }
    mkdir_p($uploaddir);
    my $param = {
      'uri' => "$proj->{'remoteurl'}/source/$proj->{'remoteproject'}/$packid/$entry->{'name'}",
      'filename' => "$uploaddir/$$",
      'withmd5' => 1,
      'receiver' => \&BSHTTP::file_receiver,
      'proxy' => $proxy,
    };
    my $res = BSRPC::rpc($param, undef, "rev=$rev->{'srcmd5'}");
    die("file download failed\n") unless $res && $res->{'md5'} eq $entry->{'md5'};
    addfile($projid, $packid, "$uploaddir/$$", $entry->{'name'}, $entry->{'md5'});
  }
  my $srcmd5 = addmeta($projid, $packid, $files);
  if ($dir->{'linkinfo'}) {
    $dir->{'srcmd5'} = $rev->{'srcmd5'} = $srcmd5;
    $rev->{'rev'} = $rev->{'srcmd5'} unless $dir->{'rev'};
    if ($linked) {
      # add linked info for getprojpack
      my $li = $dir->{'linkinfo'};
      if ($li->{'linked'}) {
	for my $l (@{$li->{'linked'}}) {
	  $l->{'project'} = maptoremote($proj, $l->{'project'});
	  push @$linked, $l if defined($l->{'project'}) && $l->{'project'} ne '_unavailable';
	}
	undef $li;
      }
      while ($li) {
        my $lprojid = $li->{'project'};
        my $lpackid = $li->{'package'};
        last unless defined($lprojid) && defined($lpackid);
        my $mlprojid = maptoremote($proj, $lprojid);
        last unless defined($mlprojid) && $mlprojid ne '_unavailable';
        push @$linked, {'project' => $mlprojid, 'package' => $lpackid};
	last unless $li->{'srcmd5'} && !$li->{'error'};
	my $ldir;
	eval {
	  $ldir = BSRPC::rpc({'uri' => "$proj->{'remoteurl'}/source/$lprojid/$lpackid", 'proxy' => $proxy}, $BSXML::dir, "rev=$li->{'srcmd5'}");
	};
	last if $@ || !$ldir;
	$li = $ldir->{'linkinfo'};
      }
    }
  }
  die("srcmd5 mismatch\n") if $dir->{'srcmd5'} ne $srcmd5;
  $rev->{'project'} = $projid;
  $rev->{'package'} = $packid;
  return $rev;
}

sub expandsearchpath {
  my ($projid, $repoid, $remotemap) = @_;
  my %done;
  my @ret;
  my @path = {project => $projid, repository => $repoid};
  while (@path) {
    my $t = shift @path;
    my $prp = "$t->{'project'}/$t->{'repository'}";
    push @ret, $prp unless $done{$prp};
    $done{$prp} = 1;
    if (!@path) {
      last if $done{"/$prp"};
      my ($pid, $tid) = ($t->{'project'}, $t->{'repository'});
      my $proj = readproj($pid, 1);
      if (!$proj || $proj->{'remoteurl'}) {
	undef $proj;
	$proj = $remotemap->{$pid} if $remotemap && $remotemap->{$pid};
	if (!$proj || $proj->{'proto'}) {
          $proj = remoteprojid($pid);
          $proj = fetchremoteproj($proj, $pid, $remotemap);
          die("404 project '$pid' does not exist\n") unless $proj;
        }
      }
      $done{"/$prp"} = 1;       # mark expanded
      my @repo = grep {$_->{'name'} eq $tid} @{$proj->{'repository'} || []};
      push @path, @{$repo[0]->{'path'}} if @repo && $repo[0]->{'path'};
    }
  }
  return @ret;
}

sub concatconfigs {
  my ($projid, $repoid, $remotemap, @path) = @_;

  my $config = "%define _project $projid\n";
  my $macros = '';

  #$macros .= "%vendor openSUSE Build Service\n";

  # find the sign project, this is what we use as vendor
  my $vprojid = $projid;
  while ($vprojid ne '') {
    last if -s "$projectsdir/$vprojid.pkg/_signkey";
    $vprojid =~ s/[^:]*$//;
    $vprojid =~ s/:$//;
  }
  $vprojid = $projid if $vprojid eq '';
  my $obsname = $BSConfig::obsname || 'build.opensuse.org';
  $macros .= "%vendor obs://$obsname/$vprojid\n";

  $macros .= "%_project $projid\n";
  my $lastr = '';

  my $distinfo = "$projid / $repoid";
  if ($repoid eq 'standard') {
    $distinfo = $projid;
  } 

  for my $prp (reverse @path) {
    if ($prp eq "$projid/$repoid") {
      $macros .= "\n%distribution $distinfo\n";
      $macros .= "%_project $projid\n";
    }
    my ($p, $r) = split('/', $prp, 2);
    my $c;
    if (-s "$projectsdir/$p.conf") {
      $c = readstr("$projectsdir/$p.conf");
    } elsif (!-e "$projectsdir/$p.xml") {
      my $proj = remoteprojid($p);
      $c = fetchremoteconfig($proj, $p, $remotemap);
    }
    next unless defined $c;
    $config .= "\n### from $p\n";
    $config .= "%define _repository $r\n";
    if ($c =~ /^(.*\n)?\s*macros:[^\n]*\n(.*)/si) {
      $c = defined($1) ? $1 : '';
      $macros .= "\n### from $p\n";
      $macros .= "%_repository $r\n";
      $macros .= $2;
      $lastr = $r;
    }
    $config .= $c;
  }
  if ($lastr ne $repoid) {
    $macros .= "\n### from $projid\n";
    $macros .= "%_repository $repoid\n";
  }
  if (!@path || $path[0] ne "$projid/$repoid") {
    $macros .= "\n%distribution $distinfo\n";
    $macros .= "%_project $projid\n";
  }
  if ($BSConfig::extramacros) {
    for (sort keys %{$BSConfig::extramacros}) {
      $macros .= $BSConfig::extramacros->{$_} if $projid =~ /$_/;
    }
  }
  $config .= "\nMacros:\n$macros" if $macros ne '';
  return $config;
}

sub getbuildconfig {
  my ($cgi, $projid, $repoid) = @_;
  my @path;
  if ($cgi->{'path'}) {
    @path = @{$cgi->{'path'}};
  } else {
    @path = expandsearchpath($projid, $repoid);
  }
  my $config = concatconfigs($projid, $repoid, undef, @path);
  return ($config, 'Content-Type: text/plain');
}

sub getprojectconfig {
  my ($cgi, $projid) = @_;
  my $proj = checkprojrepoarch($projid, undef, undef, 1);
  if ($proj->{'remoteurl'}) {
    my $config = BSRPC::rpc({'uri' => "$proj->{'remoteurl'}/source/$proj->{'remoteproject'}/_config", 'proxy' => $proxy}, undef);
    return ($config, 'Content-Type: text/plain');
  }
  my $config;
  if ($cgi->{'rev'}) {
    my $rev = getrev($projid, '_project', $cgi->{'rev'});
    my $files = $rev ? lsrev($rev) : {};
    $config = repreadstr($rev, '_config', $files->{'_config'}, 1) if $files->{'_config'};
  } else {
    $config = readstr("$projectsdir/$projid.conf", 1);
  }
  $config = '' unless defined $config;
  return ($config, 'Content-Type: text/plain');
}

sub putprojectconfig {
  my ($cgi, $projid) = @_;
  my $proj = readproj($projid);
  mkdir_p($uploaddir);
  my $uploaded = BSServer::read_file("$uploaddir/$$");
  die("upload failed\n") unless $uploaded;
  if (-s "$uploaddir/$$") {
    addrev_meta($cgi, $projid, undef, "$uploaddir/$$", "$projectsdir/$projid.conf", '_config', 'rev');
  } else {
    unlink("$uploaddir/$$");
    addrev_meta($cgi, $projid, undef, undef, undef, '_config', 'rev');
    unlink("$projectsdir/$projid.conf");
  }
  notify_repservers('project', $projid);
  BSNotify::notify("SRCSRV_UPDATE_PROJECT_CONFIG", { "project" => $projid, "sender" => ($cgi->{'user'} || "unknown") });

  return $BSStdServer::return_ok;
}

sub delprojectconfig {
  my ($cgi, $projid) = @_;
  addrev_meta($cgi, $projid, undef, undef, undef, '_config', 'rev');
  unlink("$projectsdir/$projid.conf");
  notify_repservers('project', $projid);
  BSNotify::notify("SRCSRV_UPDATE_PROJECT_CONFIG", { "project" => $projid, "sender" => ($cgi->{'user'} || "unknown") });
  return $BSStdServer::return_ok;
}

##########################################################################

sub getsources {
  my ($cgi, $projid, $packid, $srcmd5) = @_;
  my $rev = {'project' => $projid, 'package' => $packid, 'srcmd5' => $srcmd5};
  my $files = lsrev($rev);
  my @send = map {{'name' => $_, 'filename' => "$srcrep/$packid/$files->{$_}-$_"}} keys %$files;
  BSServer::reply_cpio(\@send);
  return undef;
}

sub detach {
  my $jev = $BSServerEvents::gev;
  return unless exists $jev->{'fd'};
  my $ev = BSEvents::new('never');
  for (keys %$jev) {
    $ev->{$_} = $jev->{$_} unless $_ eq 'id' || $_ eq 'handler' || $_ eq 'fd';
  }
  $jev->{'conf'}->{'stdreply'}->(@_) if $jev->{'conf'}->{'stdreply'};
  $BSServerEvents::gev = $ev;
  return $ev;
}

my %getfilelist_ajax_inprogress;

sub getfilelist_ajax {
  my ($cgi, $projid, $packid) = @_;

  my $jev = $BSServerEvents::gev;
  if (!$jev->{'remoteurl'}) {
    die unless $cgi->{'rev'};
    my $proj = remoteprojid($projid);
    die("missing project/package\n") unless $proj;
    $jev->{'remoteurl'} = $proj->{'remoteurl'};
    $jev->{'remoteproject'} = $proj->{'remoteproject'};
  }
  if (!$jev->{'filelist'}) {
    my $rev = $cgi->{'rev'};
    return $BSStdServer::return_ok if $getfilelist_ajax_inprogress{"$projid/$packid/$rev"};
    my $param = {
      'uri' => "$jev->{'remoteurl'}/source/$jev->{'remoteproject'}/$packid",
      'proxy' => $proxy,
    };
    eval {
      $jev->{'filelist'} = BSWatcher::rpc($param, $BSXML::dir, "rev=$rev");
    };
    if ($@) {
      my $err = $@;
      notify_repservers('package', $projid, $packid);
      die($err);
    }
    return undef unless $jev->{'filelist'};
    $jev = detach($BSStdServer::return_ok);
    $jev->{'idstring'} = "$projid/$packid/$rev";
    $getfilelist_ajax_inprogress{"$projid/$packid/$rev"} = $jev;
    $jev->{'handler'} = sub {delete $getfilelist_ajax_inprogress{"$projid/$packid/$rev"}};
  }
  my $serial;
  my $dir = $jev->{'filelist'};
  for my $entry (@{$dir->{'entry'} || []}) {
    next if -e "$srcrep/$packid/$entry->{'md5'}-$entry->{'name'}";
    $serial ||= BSWatcher::serialize("$jev->{'remoteurl'}/source");
    return undef unless $serial;
    mkdir_p($uploaddir);
    my $param = {
      'uri' => "$jev->{'remoteurl'}/source/$jev->{'remoteproject'}/$packid/$entry->{'name'}",
      'filename' => "$uploaddir/$$-$jev->{'id'}",
      'withmd5' => 1,
      'receiver' => \&BSHTTP::file_receiver,
      'proxy' => $proxy,
    };
    my $res;
    eval {
      $res = BSWatcher::rpc($param, undef, "rev=$cgi->{'rev'}");
    };
    if ($@) {
      # notify scheduler that the download failed
      my $err = $@;
      BSWatcher::serialize_end($serial) if $serial;
      notify_repservers('package', $projid, $packid);
      die($err);
    }
    return undef unless $res;
    die("file download failed\n") unless $res && $res->{'md5'} eq $entry->{'md5'};
    die unless -e "$uploaddir/$$-$jev->{'id'}";
    addfile($projid, $packid, "$uploaddir/$$-$jev->{'id'}", $entry->{'name'}, $entry->{'md5'});
  }
  BSWatcher::serialize_end($serial) if $serial;
  delete $getfilelist_ajax_inprogress{"$projid/$packid/$cgi->{'rev'}"};
  notify_repservers('package', $projid, $packid);
  return '';
}

sub getfilelist {
  my ($cgi, $projid, $packid) = @_;

  my $view = $cgi->{'view'};
  my $rev;
  if ($cgi->{'meta'}) {
    $rev = getrev_meta($projid, $packid, $cgi->{'rev'});
  } else {
    $rev = getrev($projid, $packid, defined($cgi->{'rev'}) ? $cgi->{'rev'} : 'upload');
  }
  my $li = {};
  my $files = lsrev($rev, $li);

  if ($files->{'_link'}) {
    if ($cgi->{'emptylink'}) {
      my $l = repreadxml($rev, '_link', $files->{'_link'}, $BSXML::link);
      delete $l->{'patches'};
      mkdir_p($uploaddir);
      writexml("$uploaddir/$$", undef, $l, $BSXML::link);
      $files = {};
      $files->{'_link'} = addfile($projid, $packid, "$uploaddir/$$", '_link');
      $rev = addrev($projid, $packid, $files, undef, undef, '');
    }
    my %lrev = %$rev;
    $lrev{'linkrev'} = $cgi->{'linkrev'} if $cgi->{'linkrev'};
    $li->{'linked'} = [] if $cgi->{'withlinked'};
    my $lfiles = handlelinks(\%lrev, $files, $li);
    if ($cgi->{'expand'}) {
      die("$lfiles\n") if !ref $lfiles;
      $files = $lfiles;
      %$rev = %lrev;
      $rev->{'rev'} = $rev->{'srcmd5'};
    } else {
      if (ref $lfiles) {
        $li->{'xsrcmd5'} = $lrev{'srcmd5'};
      } else {
	# link is broken
	$li->{'error'} = $lfiles;
	# set xsrcmd5 if we have a link error file
	$li->{'xsrcmd5'} = $lrev{'srcmd5'} if $lrev{'srcmd5'} && -e "$srcrep/$packid/$lrev{'srcmd5'}-_linkerror";
	if ($cgi->{'lastworking'}) {
	  my $lastworking = findlastworkinglink($rev);
	  $li->{'lastworking'} = $lastworking if $lastworking;
	}
      }
    }
  }

  if ($cgi->{'extension'}) {
    for (keys %$files) {
      delete $files->{$_} unless /\.\Q$cgi->{'extension'}\E$/;
    }
  }

  if ($view && $view eq 'cpio') {
    my @files = map {{'name' => $_, 'filename' => "$srcrep/$packid/$files->{$_}-$_"}} sort keys %$files;
    BSServer::reply_cpio(\@files);
    return undef;
  }

  my $ret = {};
  $ret->{'name'} = $packid;
  $ret->{'srcmd5'} = $rev->{'srcmd5'} if $rev->{'srcmd5'} ne 'empty';
  $ret->{'rev'} = $rev->{'rev'} if exists $rev->{'rev'};
  $ret->{'vrev'} = $rev->{'vrev'} if exists $rev->{'vrev'};
  my @res;
  for my $filename (sort keys %$files) {
    my @s = repstat($rev, $filename, $files->{$filename});
    if (@s) {
      push @res, {'name' => $filename, 'md5' => $files->{$filename}, 'size' => $s[7], 'mtime' => $s[9]};
    } else {
      push @res, {'name' => $filename, 'md5' => $files->{$filename}, 'error' => "$!"};
    }
  }
  if (%$li) {
    linkinfo_addtarget($rev, $li);
    $ret->{'linkinfo'} = $li;
  }
  $ret->{'entry'} = \@res;
  return ($ret, $BSXML::dir);
}

sub getfile {
  my ($cgi, $projid, $packid, $filename) = @_;
  die("no filename\n") unless defined($filename) && $filename ne '';
  die("bad filename\n") if $filename =~ /\// || $filename =~ /^\./;
  my $rev = getrev($projid, $packid, defined($cgi->{'rev'}) ? $cgi->{'rev'} : 'upload');
  my $files = lsrev($rev);
  die("404 $filename: no such file\n") unless $files->{$filename};
  my @s = repstat($rev, $filename, $files->{$filename});
  die("$projid/$packid/$files->{$filename}-$filename: $!\n") unless @s;
  if (!$BSStdServer::isajax && $rev->{'srcmd5'} && $rev->{'srcmd5'} ne 'upload' && $rev->{'srcmd5'} ne 'pattern' && $rev->{'srcmd5'} ne 'empty') {
    # hack: we identify remote source downloads by looking at the user agent
    my $useragent = $BSServer::request->{'headers'}->{'user-agent'} || '';
    if ($useragent =~ /BSRPC/) {
      BSHandoff::handoff($ajaxsocket, "/source/$projid/$packid/$filename", undef, "rev=$rev->{'srcmd5'}");
      exit(0);
    }
  }
  my $fd = gensym;
  repopen($rev, $filename, $files->{$filename}, $fd) || die("$projid/$packid/$files->{$filename}-$filename: $!\n");
  BSWatcher::reply_file($fd);
  return undef;
}

sub putfile {
  my ($cgi, $projid, $packid, $filename) = @_;
  die("no filename\n") unless defined($filename) && $filename ne '';
  die("bad filename\n") if $filename =~ /\// || $filename =~ /^\./;
  my $rev = getrev($projid, $packid, defined($cgi->{'rev'}) ? $cgi->{'rev'} : 'upload');
  die("file '$filename' is read-only\n") if ($filename =~ /^_service:/) && !$cgi->{'force'};
  mkdir_p($uploaddir);
  my $uploaded = BSServer::read_file("$uploaddir/$$", 'withmd5' => 1);
  die("upload failed\n") unless $uploaded;
  addfile($projid, $packid, "$uploaddir/$$", $filename, $uploaded->{'md5'});
  # create new meta file
  my $files;
  if ($cgi->{'keeplink'}) {
    $files = lsrev_expanded($rev);
  } else {
    $files = lsrev($rev);
  }
  $files->{$filename} = $uploaded->{'md5'};
  $files = keeplink($cgi, $projid, $packid, $files) if $cgi->{'keeplink'};
  $rev = addrev($projid, $packid, $files, $cgi->{'user'}, $cgi->{'comment'}, $cgi->{'rev'});
# update happens only on commit atm, or we would modify on file upload time ...
# runservice($projid, $packid) if $files->{'_service'} && not ($rev eq 'upload');
  delete $rev->{'project'};
  delete $rev->{'package'};
  return ($rev, $BSXML::revision);
}

sub sourcediff {
  my ($cgi, $projid, $packid) = @_;

  BSVerify::verify_linkrev($cgi->{'olinkrev'}) if defined($cgi->{'olinkrev'}) && $cgi->{'olinkrev'} ne 'linkrev';
  my $oprojid = exists($cgi->{'oproject'}) ? $cgi->{'oproject'} : $projid;
  my $opackid = exists($cgi->{'opackage'}) ? $cgi->{'opackage'} : $packid;

  my $fmax = 200;
  my $tmax = 16000;
  $fmax = $cgi->{'filelimit'} if defined $cgi->{'filelimit'};
  $tmax = $cgi->{'tarlimit'} if defined $cgi->{'tarlimit'};
  undef $fmax unless $fmax;
  undef $tmax unless $tmax;

  my $rev;
  if ($cgi->{'meta'}) {
    $rev = getrev_meta($projid, $packid, $cgi->{'rev'});
  } else {
    $rev = getrev($projid, $packid, defined($cgi->{'rev'}) ? $cgi->{'rev'} : 'upload', undef, $cgi->{'missingok'});
  }
  my $files = lsrev($rev);
  my $orev = $cgi->{'orev'};
  if (!defined($cgi->{'oproject'}) && !defined($cgi->{'opackage'}) && !defined($cgi->{'orev'}) && $rev->{'rev'}) {
    die("revision is not a simple commit\n") unless $rev->{'rev'} =~ /^\d+$/s;
    $orev = $rev->{'rev'} - 1;
    $cgi->{'olinkrev'} = 'linkrev' if !defined($cgi->{'olinkrev'});
  }
  if ($cgi->{'meta'}) {
    $orev = getrev_meta($oprojid, $opackid, $orev);
  } else {
    $orev = getrev($oprojid, $opackid, defined($orev) ? $orev : 'latest', undef, $cgi->{'missingok'});
  }
  my $ofiles = lsrev($orev);
  if ($cgi->{'expand'} || ($files->{'_link'} && !$ofiles->{'_link'}) || ($ofiles->{'_link'} && !$files->{'_link'})) {
    # expand links
    if ($files->{'_link'}) {
      $rev->{'linkrev'} = $cgi->{'linkrev'} if $cgi->{'linkrev'};
      my %li;
      my $l = repreadxml($rev, '_link', $files->{'_link'}, $BSXML::link, 1);
      if ($l) {
        $l->{'project'} = $rev->{'project'} unless defined $l->{'project'};
        $l->{'package'} = $rev->{'package'} unless defined $l->{'package'};
      }
      $files = handlelinks($rev, $files, \%li);
      die("bad link: $files\n") unless ref $files;
      $cgi->{'olinkrev'} = $li{'srcmd5'} if $cgi->{'olinkrev'} eq 'linkrev';
      if ($l && $cgi->{'linkrev'} && $l->{'project'} eq $oprojid && $l->{'package'} eq $opackid && !$l->{'rev'} && !$cgi->{'orev'}) {
        # we're diffing against the link target. As the user specified a baserev, we should use it
        # instead of the latest source
        $orev = getrev($oprojid, $opackid, $li{'srcmd5'});
        $ofiles = lsrev($orev);
      }
    }
    if ($ofiles->{'_link'}) {
      $orev->{'linkrev'} = $cgi->{'olinkrev'} if $cgi->{'olinkrev'} && $cgi->{'olinkrev'} ne 'linkrev';
      $ofiles = handlelinks($orev, $ofiles);
      die("bad link: $ofiles\n") unless ref $ofiles;
    }
  }
  my $cacheid = "$orev->{'srcmd5'}/$rev->{'srcmd5'}";
  $cacheid .= "/unified:$cgi->{'unified'}" if $cgi->{'unified'};
  $cacheid .= "/fmax:$fmax" if defined $fmax;
  $cacheid .= "/tmax:$tmax" if defined $tmax;
  if ($cgi->{'file'}) {
    my %file = map {$_ => 1} @{$cgi->{'file'}};
    $cacheid .= "/file:$_" for sort keys %file;
    for (keys %$ofiles) {
      delete $ofiles->{$_} unless $file{$_};
    }
    for (keys %$files) {
      delete $files->{$_} unless $file{$_};
    }
  }
  $cacheid = Digest::MD5::md5_hex($cacheid);
  return ('', 'Content-Type: text/plain') unless grep {($ofiles->{$_} || '') ne ($files->{$_} || '')} (keys %$ofiles, keys %$files);
  local *F;
  my $cn = "$diffcache/".substr($cacheid, 0, 2)."/$cacheid";
  if (open(F, '<', $cn)) {
    utime(time, time, $cn);
    BSServer::reply_file(\*F, 'Content-Type: text/plain');
    return undef;
  }
  my $tmpdir = "$uploaddir/srcdiff$$";
  my $d = BSSrcdiff::diff("$srcrep/$opackid", $ofiles, $orev->{'rev'}, "$srcrep/$packid", $files, $rev->{'rev'}, $fmax, $tmax, $tmpdir, $cgi->{'unified'});
  mkdir_p("$diffcache/".substr($cacheid, 0, 2));
  writestr("$diffcache/.new$$", $cn, $d);
  return ($d, 'Content-Type: text/plain');
}

sub linkdiff {
  my ($cgi, $projid, $packid) = @_;
  my $rev = getrev($projid, $packid, defined($cgi->{'rev'}) ? $cgi->{'rev'} : 'upload');
  $rev->{'linkrev'} = $cgi->{'linkrev'} if $cgi->{'linkrev'};
  my $linkinfo = {};
  my $files = lsrev_expanded($rev, $linkinfo);
  die("not a link\n") unless $linkinfo->{'srcmd5'};
  linkinfo_addtarget($rev, $linkinfo);
  return sourcediff({
    'oproject' => $linkinfo->{'project'},
    'opackage' => $linkinfo->{'package'},
    'orev' => $linkinfo->{'srcmd5'},
    'rev' => $rev->{'srcmd5'},
  }, $projid, $packid);
}

sub isascii {
  my ($file) = @_;
  local *F;
  open(F, '<', $file) || die("$file: $!\n");
  my $buf = '';
  sysread(F, $buf, 4096);
  close F;
  return 1 unless $buf =~ /[\000-\010\016-\037]/s;
  return 0;
}

sub rundiff {
  my ($file1, $file2, $label, $outfile) = @_;
  my $pid;
  if (!($pid = xfork())) {
    if (!open(STDOUT, '>>', $outfile)) {
      print STDERR "$outfile: $!\n";
      exit(2);
    }
    exec('diff', '-up', '--label', "$label.orig", '--label', $label, $file1, $file2);
    exit(2);
  }
  waitpid($pid, 0) == $pid || die("waitpid $pid: $!\n");
  my $status = $?;
  return 1 if $status == 0 || $status == 0x100;
  return undef;
}

sub findprojectpatchname {
  my ($files) = @_;

  my $i = "";
  while ($files->{"project$i.diff"}) {
    $i = '0' unless $i;
    $i++;
  }
  return "project$i.diff";
}

#
# we are going to commit files to projid/packid, all data is already present
# in the src repository.
# if it was a link before, try to keep this link
# files: expanded file set
#
sub keeplink {
  my ($cgi, $projid, $packid, $files, $orev) = @_;

  my $repair = $cgi->{'repairlink'};
  return $files if !defined($files) || !%$files;
  return $files if $files->{'_link'};
  $orev ||= getrev($projid, $packid, 'latest');
  my $ofilesl = lsrev($orev);
  return $files unless $ofilesl && $ofilesl->{'_link'};
  my $l = repreadxml($orev, '_link', $ofilesl->{'_link'}, $BSXML::link);
  my $changedlink = 0;
  my %lignore;
  my $isbranch;

  if (@{$l->{'patches'}->{''} || []} == 1) {
    my $type = (keys %{$l->{'patches'}->{''}->[0]})[0];
    if ($type eq 'branch') {
      $isbranch = 1;
    }
  }
  undef $isbranch if $cgi->{'convertbranchtopatch'};

  if (!$isbranch && $l->{'patches'}) {
    if ($repair) {
      for (@{$l->{'patches'}->{''} || []}) {
        my $type = (keys %$_)[0];
        if ($type eq 'apply' || $type eq 'delete' || $changedlink) {
          $lignore{$_->{$type}->{'name'}} = 1 if $type ne 'topadd' && $type ne 'delete';
	  $_ = undef;
	  $changedlink = 1;
	}
      }
    } else {
      for (reverse @{$l->{'patches'}->{''} || []}) {
        my $type = (keys %$_)[0];
        if ($type eq 'apply' || $type eq 'delete' || $type eq 'branch') {
          $lignore{$_->{$type}->{'name'}} = 1 if $type eq 'apply';
	  $_ = undef;
	  $changedlink = 1;
	  next;
	}
	last;
      }
    }
    $l->{'patches'}->{''} = [ grep {defined($_)} @{$l->{'patches'}->{''}} ];
  }

  my $linkrev = $cgi->{'linkrev'};
  $linkrev = $l->{'baserev'} if $linkrev && $linkrev eq 'base';

  my $ltgtsrcmd5;
  my $ofiles;
  my $ofilesdir;
  if (!$repair) {
    # expand old link
    my %olrev = %$orev;
    my %li;
    $olrev{'linkrev'} = $linkrev if $linkrev;
    $ofiles = handlelinks(\%olrev, $ofilesl, \%li);
    die("bad link: $ofiles\n") unless ref $ofiles;
    $ltgtsrcmd5 = $li{'srcmd5'};
    $ofilesdir = "$srcrep/$packid";
  }

  # get link target file list
  my $ltgtprojid = defined($l->{'project'}) ? $l->{'project'} : $projid;
  my $ltgtpackid = defined($l->{'package'}) ? $l->{'package'} : $packid;
  my $ltgtfiles;
  if ($ltgtsrcmd5) {
    my $ltgtrev = {'project' => $ltgtprojid, 'package' => $ltgtpackid, 'srcmd5' => $ltgtsrcmd5};
    $ltgtfiles = lsrev($ltgtrev);
  } else {
    my $ltgtrev = getrev($ltgtprojid, $ltgtpackid, $linkrev || $l->{'rev'});
    $ltgtfiles = lsrev_expanded($ltgtrev);
    $ltgtsrcmd5 = $ltgtrev->{'srcmd5'};
  }

  # easy for branches: just copy file list and update baserev
  if ($isbranch) {
    my $nfiles = { %$files };
    $nfiles->{'_link'} = $ofilesl->{'_link'};
    my $lchanged;
    my $baserev = $linkrev || $ltgtsrcmd5;
    if (($l->{'baserev'} || '') ne $baserev) {
      $l->{'baserev'} = $baserev;
      $lchanged = 1;
    }
    $cgi->{'setrev'} = $baserev if $cgi->{'setrev'} && $cgi->{'setrev'} eq 'base';
    if ($cgi->{'setrev'} && ($l->{'rev'} || '') ne $cgi->{'setrev'}) {
      $l->{'rev'} = $cgi->{'setrev'};
      $lchanged = 1;
    }
    if ($lchanged) {
      $l->{'patches'}->{''} = [ { 'branch' => undef} ]; # work around xml problem
      mkdir_p($uploaddir);
      writexml("$uploaddir/$$", undef, $l, $BSXML::link);
      $nfiles->{'_link'} = addfile($projid, $packid, "$uploaddir/$$", '_link')
    }
    return $nfiles;
  }

  if ($cgi->{'convertbranchtopatch'}) {
    $ofilesl = {};
    $ofiles = $ltgtfiles;
    $ofilesdir = "$srcrep/$ltgtpackid";
  } elsif ($repair || $changedlink) {
    # apply changed link
    my $frominfo = {'project' => $ltgtprojid, 'package' => $ltgtpackid, 'srcmd5' => $ltgtsrcmd5};
    my $linkinfo = {'project' => $projid, 'package' => $packid, 'srcmd5' => $orev->{'srcmd5'}, 'link' => $l};
    $linkinfo->{'ignore'} = \%lignore;
    $ofiles = applylink(undef, $frominfo, $linkinfo);
    die("bad link: $ofiles\n") unless ref $ofiles;
    $ofilesdir = "$uploaddir/applylink$$";
  }

  #print "-- ofilesl:\n";
  #print "  $ofilesl->{$_}  $_\n" for sort keys %$ofilesl;
  #print "-- ofiles:\n";
  #print "  $ofiles->{$_}  $_\n" for sort keys %$ofiles;
  #print "-- files:\n";
  #print "  $files->{$_}  $_\n" for sort keys %$files;

  # now create diff between old $ofiles and $files
  my $nfiles = { %$ofilesl };
  delete $nfiles->{$_} for keys %lignore;	# no longer used in link
  mkdir_p($uploaddir);
  unlink("$uploaddir/$$");
  my @dfiles;
  for my $file (sort keys %{{%$files, %$ofiles}}) {
    if ($ofiles->{$file}) {
      if (!$files->{$file}) {
	if (!$ltgtfiles->{$file} && $ofilesl->{$file} && $ofilesl->{$file} eq ($ofiles->{$file} || '')) {
	  # local file no longer needed
	  delete $nfiles->{$file};
	}
	push @dfiles, $file;
	delete $nfiles->{$file};
	next;
      }
      if ($ofiles->{$file} eq $files->{$file}) {
	next;
      }
      if (!isascii("$srcrep/$packid/$files->{$file}-$file") || !isascii("$ofilesdir/$ofiles->{$file}-$file")) {
	$nfiles->{$file} = $files->{$file};
	next;
      }
    } else {
      if (!isascii("$srcrep/$packid/$files->{$file}-$file")) {
	$nfiles->{$file} = $files->{$file};
	next;
      }
    }
    if (($ofilesl->{$file} || '') eq ($ofiles->{$file} || '')) {
      # link did not change file, just record new content
      if ($files->{$file} eq ($ltgtfiles->{$file} || '')) {
	# local overwrite already in link target
	delete $nfiles->{$file};
	next;
      }
      $nfiles->{$file} = $files->{$file};
      next;
    }
    # both are ascii, create diff
    mkdir_p($uploaddir);
    if (!rundiff($ofiles->{$file} ? "$ofilesdir/$ofiles->{$file}-$file" : '/dev/null', "$srcrep/$packid/$files->{$file}-$file", $file, "$uploaddir/$$")) {
      $nfiles->{$file} = $files->{$file};
    }
  }
  my $lchanged;
  $lchanged = 1 if $changedlink;
  for (@dfiles) {
    push @{$l->{'patches'}->{''}}, {'delete' => {'name' => $_}};
    $lchanged = 1;
  }
  if (-s "$uploaddir/$$") {
    my $ppatch = findprojectpatchname($nfiles);
    $nfiles->{$ppatch} = addfile($projid, $packid, "$uploaddir/$$", $ppatch);
    push @{$l->{'patches'}->{''}}, {'apply' => {'name' => $ppatch}};
    $lchanged = 1;
  } else {
    unlink("$uploaddir/$$");
  }
  my $baserev = $linkrev || $ltgtsrcmd5;
  if (($l->{'baserev'} || '') ne $baserev) {
    $l->{'baserev'} = $baserev;
    $lchanged = 1;
  }
  $cgi->{'setrev'} = $baserev if $cgi->{'setrev'} && $cgi->{'setrev'} eq 'base';
  if ($cgi->{'setrev'} && ($l->{'rev'} || '') ne $cgi->{'setrev'}) {
    $l->{'rev'} = $cgi->{'setrev'};
    $lchanged = 1;
  }
  if ($lchanged) {
    writexml("$uploaddir/$$", undef, $l, $BSXML::link);
    $nfiles->{'_link'} = addfile($projid, $packid, "$uploaddir/$$", '_link')
  }
  if ($ofilesdir eq "$uploaddir/applylink$$") {
    BSUtil::cleandir("$uploaddir/applylink$$");
    rmdir("$uploaddir/applylink$$");
  }
  return $nfiles;
}

# integrate link from opackid to packid into packid
sub integratelink {
  my ($files, $projid, $packid, $rev, $ofiles, $oprojid, $opackid, $l, $orev) = @_;

  # append patches from link l to link nl
  my $nl = repreadxml($rev, '_link', $files->{'_link'}, $BSXML::link);

  # FIXME: remove hunks from patches that deal with replaced/deleted files
  my $nlchanged;
  my %dontcopy;
  $dontcopy{'_link'} = 1;
  my $nlisbranch;
  if ($nl->{'patches'}) {
    for (@{$nl->{'patches'}->{''} || []}) {
      my $type = (keys %$_)[0];
      if ($type eq 'add' || $type eq 'apply') {
	$dontcopy{$_->{$type}->{'name'}} = 1;
      }
      $nlisbranch = 1 if $type eq 'branch';
    }
  }
  my $lisbranch;
  if ($l->{'patches'}) {
    for (@{$l->{'patches'}->{''} || []}) {
      my $type = (keys %$_)[0];
      $lisbranch = 1 if $type eq 'branch';
    }
  }

  if ($nlisbranch) {
    # we linked/branched a branch. expand.
    #my %xrev = (%$rev, 'linkrev' => 'base');
    my %xrev = %$rev;
    my $linkinfo = {};
    lsrev_expanded(\%xrev, $linkinfo);
    my %oxrev = (%$orev, 'linkrev' => $xrev{'srcmd5'});
    $ofiles = lsrev_expanded(\%oxrev);
    copyfiles($projid, $packid, $oprojid, $opackid, $ofiles);
    # find new base
    if ($linkinfo->{'srcmd5'} ne $nl->{'baserev'}) {
      # update base rev
      $nl->{'baserev'} = $linkinfo->{'srcmd5'};
      $nlchanged = 1;
    }
    # delete everything but the link
    delete $files->{$_} for grep {$_ ne '_link'} keys %$files;
  }

  if ($lisbranch && !$nlisbranch) {
    # we branched a link. convert branch to link
    # and integrate
    delete $ofiles->{'_link'};
    $ofiles = keeplink({'convertbranchtopatch' => 1, 'linkrev' => 'base'}, $oprojid, $opackid, $ofiles, $orev);
    $l = repreadxml($orev, '_link', $ofiles->{'_link'}, $BSXML::link);
  }

  if (!$nlisbranch && $l->{'patches'}) {
    for (@{$l->{'patches'}->{''} || []}) {
      my $type = (keys %$_)[0];
      if ($type eq 'delete' && $files->{$_->{'delete'}->{'name'}} && !$dontcopy{$_->{'delete'}->{'name'}}) {
	delete $files->{$_->{'delete'}->{'name'}};
      } else {
	$nlchanged = 1;
	$nl->{'patches'} ||= {};
	if ($type eq 'apply') {
	  my $oppatch = $_->{'apply'}->{'name'};
	  if ($files->{$oppatch}) {
	    $dontcopy{$oppatch} = 1;
	    # argh, patch file already exists, rename...
	    my $ppatch = findprojectpatchname($files);
	    mkdir_p($uploaddir);
	    unlink("$uploaddir/$$");
	    link("$srcrep/$opackid/$ofiles->{$oppatch}-$oppatch", "$uploaddir/$$") || die("link $srcrep/$opackid/$ofiles->{$oppatch}-$oppatch $uploaddir/$$: $!\n");
            $files->{$ppatch} = addfile($projid, $packid, "$uploaddir/$$", $ppatch);
	    push @{$nl->{'patches'}->{''}}, {'apply' => {'name' => $ppatch}};
	    next;
	  }
	}
	if ($type eq 'add') {
	  my $oppatch = $_->{'add'}->{'name'};
	  die("cannot apply patch $oppatch twice\n") if $dontcopy{$oppatch};
	}
        push @{$nl->{'patches'}->{''}}, $_;
      }
    }
  }
  if ($nlchanged) {
    mkdir_p($uploaddir);
    writexml("$uploaddir/$$", undef, $nl, $BSXML::link);
    $files->{'_link'} = addfile($projid, $packid, "$uploaddir/$$", '_link');
  }
  for (sort keys %$ofiles) {
    next if $dontcopy{$_};
    $files->{$_} = $ofiles->{$_};
  }
  return $files;
}

sub sourcecommit {
  my ($cgi, $projid, $packid) = @_;
  my $rev = getrev($projid, $packid, defined($cgi->{'rev'}) ? $cgi->{'rev'} : 'upload');
  my $files = lsrev($rev);
  $files = keeplink($cgi, $projid, $packid, $files) if $cgi->{'keeplink'};
  $rev = addrev($projid, $packid, $files, $cgi->{'user'}, $cgi->{'comment'});
  if (!$cgi->{'noservice'}) {
    my $prev = getrev($projid, '_project');
    my $pfiles = lsrev($prev);
    if ($files->{'_service'} || $pfiles->{'_service'}) {
      runservice($cgi, $projid, $packid);
    }
  }
  delete $rev->{'project'};
  delete $rev->{'package'};
  return ($rev, $BSXML::revision);
}

sub sourcecommitfilelist {
  my ($cgi, $projid, $packid) = @_;
  mkdir_p($uploaddir);
  my $uploaded = BSServer::read_file("$uploaddir/$$");
  die("upload failed\n") unless $uploaded;
  my $fl = readxml("$uploaddir/$$", $BSXML::dir);
  unlink("$srcrep/:upload/$$");
  # make sure we know every file
  my @missing;
  my $files = {};
  for my $entry (@{$fl->{'entry'} || []}) {
    BSVerify::verify_filename($entry->{'name'});
    BSVerify::verify_md5($entry->{'md5'});
    if (! -e "$srcrep/$packid/$entry->{'md5'}-$entry->{'name'}") {
      push @missing, $entry;
    } else {
      die("duplicate file: $entry->{'name'}\n") if exists $files->{$entry->{'name'}};
      $files->{$entry->{'name'}} = $entry->{'md5'};
    }
  }
  if (@missing) {
    my $res = {'name' => $packid, 'error' => 'missing', 'entry' => \@missing};
    return ($res, $BSXML::dir);
  }

  $files = keeplink($cgi, $projid, $packid, $files) if $cgi->{'keeplink'};
  if (-e "$projectsdir/$projid.pkg/$packid.upload-MD5SUMS") {
    # autocommit old update revision so that it doesn't get lost
    my $uploadrev = {'project' => $projid, 'package' => $packid, 'srcmd5' => 'upload'};
    my $uploadfiles = lsrev($uploadrev);
    addrev($projid, $packid, $uploadfiles, $cgi->{'user'}, 'autocommit', undef, $cgi->{'requestid'});
  }
  my $rev = addrev($projid, $packid, $files, $cgi->{'user'}, $cgi->{'comment'}, undef, $cgi->{'requestid'});

  if (!$cgi->{'noservice'}) {
    my $prev = getrev($projid, '_project');
    my $pfiles = lsrev($prev);
    if ($files->{'_service'} || $pfiles->{'_service'}) {
      runservice($cgi, $projid, $packid);
    }
  }

  $cgi->{'rev'} = $rev->{'rev'};
  return getfilelist($cgi, $projid, $packid);
}

# copy sources of entire project, project exists ensured by api.
sub copyproject {
  my ($cgi, $projid) = @_;
  my $oprojid = $cgi->{'oproject'};
  return $BSStdServer::return_ok if $oprojid eq $projid;

  my $proj = readproj($projid);
  my $oproj = readproj($oprojid);

  my $user = defined($cgi->{'user'}) && $cgi->{'user'} ne '' ? $cgi->{'user'} : 'unknown';
  my $comment = defined($cgi->{'comment'}) ? $cgi->{'comment'} : '';
  $user = str2utf8xml($user);
  $comment = str2utf8xml($comment);

  # use {} as we do not want to copy project linked packages
  my @pkgs = findpackages($oprojid, {});
  for my $packid (@pkgs) {
    if (! -e "$projectsdir/$projid.pkg/$packid.xml") {
      # new package, create. hopefully the API can deal with this
      my $opack = readpack($oprojid, $packid);
      my $pack = {
	'project' => $projid,
	'name' => $packid,
      };
      for (qw{title description sourceaccess}) {
        $pack->{$_} = $opack->{$_} if defined $opack->{$_};
      }
      mkdir_p($uploaddir);
      writexml("$uploaddir/copyproject$$", undef, $pack, $BSXML::pack);
      addrev_meta($cgi, $projid, $packid, "$uploaddir/copyproject$$", "$projectsdir/$projid.pkg/$packid.xml", '_meta');
    }
    if (-s "$projectsdir/$oprojid.pkg/$packid.rev") {
      my $lastorev;
      if ($cgi->{'withhistory'}) {
        # FIXME: races ahead
        # history copying is a bit tricky, as it renumbers the revisions
        my @allrevs = BSFileDB::fdb_getall("$projectsdir/$oprojid.pkg/$packid.rev", $srcrevlay);
	if (-e "$projectsdir/$projid.pkg/$packid.rev") {
	  my $lastrev = BSFileDB::fdb_getlast("$projectsdir/$projid.pkg/$packid.rev", $srcrevlay);
	  if ($lastrev && $lastrev->{'rev'}) {
	    for my $rev (@allrevs) {
	      $rev->{'rev'} += $lastrev->{'rev'};
	    }
	  }
	}
        # make trees available in new project
        my $treedir = $BSConfig::nosharedtrees ? "$treesdir/$projid/$packid" : "$treesdir/$packid";
        if ($BSConfig::nosharedtrees) {
          my $treedir = "$treesdir/$projid/$packid";
	  for my $rev (@allrevs) {
	    next if -e "$treedir/$rev->{'srcmd5'}-MD5SUMS";
            my $files = lsrev({ %$rev, 'project' => $oprojid, 'package' => $packid });
	    copyfiles($projid, $packid, $oprojid, $packid, $files);
	    addmeta($projid, $packid, $files);
	  }
	}
        BSFileDB::fdb_add_multiple("$projectsdir/$projid.pkg/$packid.rev", $srcrevlay, @allrevs);
	$lastorev = $allrevs[-1];
      } else {
	$lastorev = BSFileDB::fdb_getlast("$projectsdir/$oprojid.pkg/$packid.rev", $srcrevlay);
      }
      next unless $lastorev && $lastorev->{'rev'};
      # always do one new commit, we don't use addrev to have full control over vrev
      my $files = lsrev({ %$lastorev, 'project' => $oprojid, 'package' => $packid });
      copyfiles($projid, $packid, $oprojid, $packid, $files);
      addmeta($projid, $packid, $files);
      $lastorev->{'user'} = $user;
      $lastorev->{'comment'} = $comment;
      $lastorev->{'requestid'} = $cgi->{'requestid'};
      $lastorev->{'time'} = time();
      $lastorev->{'vrev'} += 1;
      delete $lastorev->{'rev'};
      $lastorev = BSFileDB::fdb_add_i("$projectsdir/$projid.pkg/$packid.rev", $srcrevlay, $lastorev);
      updatelinkinfodb($projid, $packid, { %$lastorev, 'project' => $oprojid, 'package' => $packid }, $files);
    }
    # XXX: does this make any sense?
    if ($cgi->{'withbinaries'}) {
      for my $repo (@{$proj->{'repository'} || []}) {
	my $orepo = (grep {$_->{'name'} eq $repo->{'name'}} @{$oproj->{'repository'} || []})[0];
	next unless $orepo;
	for my $arch (@{$repo->{'arch'} || []}) {
	  next unless grep {$_ eq $arch} @{$orepo->{'arch'} || []};

	  # same source and target repo/arch in both projects exists
	  my @args;
	  push @args, "cmd=copy";
	  push @args, "oproject=$oprojid";
	  push @args, "opackage=$packid"; # same package name
	  push @args, "orepository=$repo->{'name'}"; # same repo name
	  my $param = {
	    'uri' => "$BSConfig::reposerver/build/$projid/$repo->{'name'}/$arch/$packid",
	    'request' => 'POST',
	  };
	  eval {
	    # ignore failures for now
	    BSWatcher::rpc($param, undef, @args);
	  };
          warn($@) if $@;
	}
      }
    }
  }
  notify_repservers('project', $projid);
  return $BSStdServer::return_ok;
}

sub sourcecopy {
  my ($cgi, $projid, $packid) = @_;
  die("illegal rev parameter\n") if $cgi->{'rev'} && $cgi->{'rev'} ne 'upload';
  my $oprojid = exists($cgi->{'oproject'}) ? $cgi->{'oproject'} : $projid;
  my $opackid = exists($cgi->{'opackage'}) ? $cgi->{'opackage'} : $packid;
  my $orev = $cgi->{'orev'};
  $orev = getrev($oprojid, $opackid, defined($orev) ? $orev : 'latest');
  $orev->{'linkrev'} = $cgi->{'olinkrev'} if $cgi->{'olinkrev'};
  my $files = lsrev($orev);
  die("need a revision to copy\n") if !$cgi->{'rev'} && !$cgi->{'orev'} && $oprojid eq $projid && $opackid eq $packid && !($files->{'_link'} && $cgi->{'expand'});

  my $autosimplifylink;

  if ($files->{'_link'} && !$cgi->{'dontupdatesource'} && !$cgi->{'rev'}) {
    # fix me: do this in a more generic way
    my $ol = repreadxml($orev, '_link', $files->{'_link'}, $BSXML::link, 1);
    if ($ol) {
      my $lprojid = $oprojid;
      my $lpackid = $opackid;
      my $lrev = $ol->{'rev'};
      $lprojid = $ol->{'project'} if exists $ol->{'project'};
      $lpackid = $ol->{'package'} if exists $ol->{'package'};
      if ($lprojid eq $projid && $lpackid eq $packid) {
        # copy destination is target of link
	# we're integrating this link
        $lrev = getrev($lprojid, $lpackid, $lrev);
	my $lfiles = lsrev($lrev);
	if ($lfiles->{'_link'} && !$cgi->{'expand'}) {
	  # link to a link, join
	  $files = integratelink($lfiles, $lprojid, $lpackid, $lrev, $files, $oprojid, $opackid, $ol, $orev);
	} else {
	  # auto expand
	  $cgi->{'expand'} = 1;
	}
	$autosimplifylink = $ol;
      }
    }
  }

  if ($files->{'_link'} && $cgi->{'expand'}) {
    my %olrev = %$orev;		# copy so that orev still points to unexpanded sources
    $files = handlelinks(\%olrev, $files);
    die("broken link: $files\n") unless ref $files;
  }

  copyfiles($projid, $packid, $oprojid, $opackid, $files);

  $files = keeplink($cgi, $projid, $packid, $files) if $cgi->{'keeplink'};
  my $rev = addrev($projid, $packid, $files, $cgi->{'user'}, $cgi->{'comment'}, $cgi->{'rev'}, $cgi->{'requestid'});

  if ($autosimplifylink && !$autosimplifylink->{'rev'}) {
    my $isbranch = grep {(keys %$_)[0] eq 'branch'} @{$autosimplifylink->{'patches'}->{''} || []};
    if ($isbranch) {
      # update base rev so that there are no changes
      # FIXME: this is a gross hack...
      # we should not need to update the baserev, instead we should change
      # the way branches get applied
      my $ofiles = lsrev($orev);
      delete $ofiles->{'_link'};
      copyfiles($projid, $packid, $oprojid, $opackid, $ofiles);
      my $newbase = addmeta($projid, $packid, $ofiles);
      if ($autosimplifylink->{'baserev'} ne $newbase) {
	eval {
          my $latestorev = getrev($oprojid, $opackid);
          my $latestfiles = lsrev($latestorev);
          if ($latestfiles->{'_link'}) {
	    my $latestl = repreadxml($latestorev, '_link', $latestfiles->{'_link'}, $BSXML::link, 1);
	    my $latestisbranch = grep {(keys %$_)[0] eq 'branch'} @{$latestl->{'patches'}->{''} || []};
	    if ($latestisbranch && $latestl->{'baserev'} eq $autosimplifylink->{'baserev'}) {
	      $latestl->{'baserev'} = $newbase;
	      $latestl->{'patches'}->{''} = [ { 'branch' => undef} ]; # work around xml problem
	      mkdir_p($uploaddir);
	      writexml("$uploaddir/$$", undef, $latestl, $BSXML::link);
              $latestfiles->{'_link'} = addfile($oprojid, $opackid, "$uploaddir/$$", '_link');
              addrev($oprojid, $opackid, $latestfiles, 'buildservice-autocommit', "baserev update by copy to link target\n", undef, $cgi->{'requestid'});
	    }
	  }
	};
        warn($@) if $@;
      }
    } else {
      eval {
        my $latestorev = getrev($oprojid, $opackid);
        if ($latestorev->{'srcmd5'} eq $orev->{'srcmd5'}) {
          # simplify link
          my $nl = {};
          $nl->{'project'} = $autosimplifylink->{'project'} if $autosimplifylink->{'project'};
          $nl->{'package'} = $autosimplifylink->{'package'} if $autosimplifylink->{'package'};
          $nl->{'cicount'} = $autosimplifylink->{'cicount'} if $autosimplifylink->{'cicount'};
	  mkdir_p($uploaddir);
          writexml("$uploaddir/$$", undef, $nl, $BSXML::link);
          my $ofiles = {};
          $ofiles->{'_link'} = addfile($oprojid, $opackid, "$uploaddir/$$", '_link');
          addrev($oprojid, $opackid, $ofiles, 'buildservice-autocommit', "auto commit by copy to link target\n", undef, $cgi->{'requestid'});
        }
      };
      warn($@) if $@;
    }
  }

  delete $rev->{'project'};
  delete $rev->{'package'};
  return ($rev, $BSXML::revision);
}

sub sourcebranch {
  my ($cgi, $projid, $packid) = @_;

  my $usebranch = 1;
  my $oprojid = exists($cgi->{'oproject'}) ? $cgi->{'oproject'} : $projid;
  my $opackid = exists($cgi->{'opackage'}) ? $cgi->{'opackage'} : $packid;
  my $orev = $cgi->{'orev'};
  die("cannot branch myself\n") if $oprojid eq $projid && $opackid eq $packid;
  $orev = getrev($oprojid, $opackid);
  $orev->{'linkrev'} = $cgi->{'olinkrev'} if $cgi->{'olinkrev'};
  my $files = lsrev_expanded($orev);
  my $l = {};
  $l->{'project'} = $oprojid if $oprojid ne $projid;
  $l->{'package'} = $opackid if $opackid ne $projid;
  $l->{'rev'} = $cgi->{'orev'} if defined $cgi->{'orev'};
  $l->{'baserev'} = $orev->{'srcmd5'};
  my $lfiles = {};
  mkdir_p("$srcrep/$packid");
  if ($usebranch) {
    $l->{'patches'}->{''} = [ { 'branch' => undef} ];
    copyfiles($projid, $packid, $oprojid, $opackid, $files);
    $lfiles->{$_} = $files->{$_} for keys %$files;
  }
  mkdir_p($uploaddir);
  writexml("$uploaddir/$$", undef, $l, $BSXML::link);
  $lfiles->{'_link'} = addfile($projid, $packid, "$uploaddir/$$", '_link');
  my $rev = addrev($projid, $packid, $lfiles, $cgi->{'user'}, $cgi->{'comment'});
  delete $rev->{'project'};
  delete $rev->{'package'};
  BSNotify::notify("SRCSRV_BRANCH_COMMAND", {project => $projid, package => $packid, targetproject => $oprojid, targetpackage => $opackid,
                                             user => $cgi->{'user'}});
  return ($rev, $BSXML::revision);
}

sub linktobranch {
  my ($cgi, $projid, $packid) = @_;
  my $rev = getrev($projid, $packid);
  $rev->{'linkrev'} = $cgi->{'linkrev'} if $cgi->{'linkrev'};
  my $files = lsrev($rev);
  die("package is not a link\n") unless $files->{'_link'};
  my $l = repreadxml($rev, '_link', $files->{'_link'}, $BSXML::link);
  die("package is already a branch\n") if $l->{'patches'} && grep {(keys %$_)[0] eq 'branch'} @{$l->{'patches'}->{''} || []};
  my $linkinfo = {};
  $files = lsrev_expanded($rev, $linkinfo);
  $l->{'baserev'} = $linkinfo->{'srcmd5'};
  $l->{'patches'}->{''} = [ { 'branch' => undef} ];
  mkdir_p($uploaddir);
  writexml("$uploaddir/$$", undef, $l, $BSXML::link);
  $files->{'_link'} = addfile($projid, $packid, "$uploaddir/$$", '_link');
  $rev = addrev($projid, $packid, $files, $cgi->{'user'}, $cgi->{'comment'} || "converted link to branch");
  delete $rev->{'project'};
  delete $rev->{'package'};
  runservice($projid, $packid) if $files->{'_service'};
  return ($rev, $BSXML::revision);
}

sub deleteuploadrev {
  my ($cgi, $projid, $packid) = @_;
  unlink("$projectsdir/$projid.pkg/$packid.upload-MD5SUMS");
  return $BSStdServer::return_ok;
}

sub unknowncmd {
  my ($cgi, $projid, $packid) = @_;
  die("unknown command \"$cgi->{'cmd'}\"\n");
}

sub delfile {
  my ($cgi, $projid, $packid, $filename) = @_;
  die("no filename\n") unless defined($filename) && $filename ne '';
  die("bad filename\n") if $filename =~ /\// || $filename =~ /^\./;
  die("file '$filename' is read-only\n") if ($filename =~ /^_service:/) && not $cgi->{'force'};
  my $rev = getrev($projid, $packid, defined($cgi->{'rev'}) ? $cgi->{'rev'} : 'upload');
  my $files;
  if ($cgi->{'keeplink'}) {
    $files = lsrev_expanded($rev);
  } else {
    $files = lsrev($rev);
  }
  die("404 file '$filename' does not exist\n") unless $files->{$filename};
  delete $files->{$filename};
  $files = keeplink($projid, $packid, $files) if $cgi->{'keeplink'};
  $rev = addrev($projid, $packid, $files, $cgi->{'user'}, $cgi->{'comment'}, $cgi->{'rev'});
  delete $rev->{'project'};
  delete $rev->{'package'};
  runservice($cgi, $projid, $packid);
  return ($rev, $BSXML::revision);
}

sub getrepositorylist {
  my ($cgi, $projid) = @_;
  my $proj = checkprojrepoarch($projid, undef, undef, 1);
  if ($proj->{'remoteurl'}) {
    return (BSRPC::rpc({'uri' => "$proj->{'remoteurl'}/build/$proj->{'remoteproject'}", 'proxy' => $proxy}, $BSXML::dir), $BSXML::dir);
  }
  my @res = map {{'name' => $_->{'name'}}} @{$proj->{'repository'} || []};
  return ({'entry' => \@res}, $BSXML::dir);
}

sub getrepository {
  my ($cgi, $projid, $repoid) = @_;
  my $proj = readproj($projid);
  my $repo = (grep {$_->{'name'} eq $repoid} @{$proj->{'repository'} || []})[0];
  die("404 $repoid: no such repository\n") unless $repo;
  return ($repo, $BSXML::repo);
}

sub getarchlist {
  my ($cgi, $projid, $repoid) = @_;
  my $proj = checkprojrepoarch($projid, $repoid, undef, 1);
  if ($proj->{'remoteurl'}) {
    return (BSRPC::rpc({'uri' => "$proj->{'remoteurl'}/build/$proj->{'remoteproject'}", 'proxy' => $proxy}, $BSXML::dir), $BSXML::dir);
  }
  my @repo = grep {$_->{'name'} eq $repoid} @{$proj->{'repository'} || []};
  die("404 $repoid: no such repository\n") unless @repo;
  my @res = map {{'name' => $_}} @{$repo[0]->{'arch'} || []};
  return ({'entry' => \@res}, $BSXML::dir);
}

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

  if ($cgi->{'oldstate'} && !$BSStdServer::isajax) {
    my @args = "oldstate=$cgi->{'oldstate'}";
    push @args, "lastbuild" if $cgi->{'lastbuild'};
    push @args, map {"view=$_"} @{$cgi->{'view'} || []};
    push @args, map {"repository=$_"} @{$cgi->{'repository'} || []};
    push @args, map {"arch=$_"} @{$cgi->{'arch'} || []};
    push @args, map {"package=$_"} @{$cgi->{'package'} || []};
    push @args, map {"code=$_"} @{$cgi->{'code'} || []};
    BSHandoff::handoff($ajaxsocket, "/build/$projid/_result", undef, @args);
    exit(0);
  }

  my %repoidfilter = map {$_ => 1} @{$cgi->{'repository'} || []};
  my %archfilter = map {$_ => 1} @{$cgi->{'arch'} || []};
  my %view = map {$_ => 1} @{$cgi->{'view'} || ['status']};
  my %code = map {$_ => 1} @{$cgi->{'code'} || []};

  my $proj = readproj($projid);
  if ($cgi->{'repository'}) {
    my %knownrepoids = map {$_->{'name'} => 1} @{$proj->{'repository'} || []};
    for (@{$cgi->{'repository'}}) {
      die("404 unknown repository '$_'\n") if !$knownrepoids{$_};
    }
  }
  if ($cgi->{'package'}) {
    my %knownpackids = map {$_ => 1} findpackages($projid, $proj, 1);
    for (@{$cgi->{'package'}}) {
      die("404 unknown package '$_'\n") if !$knownpackids{$_};
    }
  }
  my @prpas;
  for my $repo (@{$proj->{'repository'} || []}) {
    next if %repoidfilter && !$repoidfilter{$repo->{'name'}};
    my @archs = @{$repo->{'arch'} || []};
    @archs = grep {$archfilter{$_}} @archs if %archfilter;
    push @prpas, map {"$projid/$repo->{'name'}/$_"} @archs;
  }

  BSWatcher::addfilewatcher("$projectsdir/$projid.xml") if $BSStdServer::isajax;

  if (!@prpas) {
    my $state = "00000000000000000000000000000000";
    return undef if $BSStdServer::isajax && $cgi->{'oldstate'} && $state eq $cgi->{'oldstate'};
    return ({'state' => $state}, $BSXML::resultlist);
  }

  my $ps = {};
  # XXX FIXME multiple repo handling
  for my $rrserver ($BSConfig::reposerver) {
    my @args;
    push @args, 'lastbuild' if $cgi->{'lastbuild'};
    push @args, "oldstate=$cgi->{'oldstate'}" if $cgi->{'oldstate'};
    push @args, map {"prpa=$_"} @prpas;
    push @args, map {"package=$_"} @{$cgi->{'package'} || []};
    push @args, map {"code=$_"} @{$cgi->{'code'} || []};
    push @args, 'withbinarylist' if $view{'binarylist'};
    push @args, 'summary' if $view{'summary'} && !$view{'status'};
    eval {
      $ps = BSWatcher::rpc("$rrserver/_result", $BSXML::resultlist, @args);
    };
    if ($@) {
      print "warning: $rrserver: $@";
      $ps = {};
    }
  }
  return if $BSStdServer::isajax && !defined($ps);
  if ($view{'summary'} && $view{'status'}) {
    my @order = ('succeeded', 'failed', 'unresolvable', 'broken', 'scheduled');
    my %order = map {$_ => 1} @order;
    for my $p (@{$ps->{'result'} || []}) {
      my %sum;
      for my $pp (@{$p->{'status'} || []}) {
        $sum{$pp->{'code'}}++ if $pp->{'code'};
      }
      my @sum = grep {exists $sum{$_}} @order;
      push @sum, grep {!$order{$_}} sort keys %sum;
      $p->{'summary'} = {'statuscount' => [ map {{'code' => $_, 'count' => $sum{$_}}} @sum ] };
    }
  }
  if (!$view{'status'}) {
    for my $p (@{$ps->{'result'} || []}) {
      delete $p->{'status'};
    }
  }
  return ($ps, $BSXML::resultlist);
}

sub docommand {
  my ($cgi, $projid) = @_;

  my %repoidfilter = map {$_ => 1} @{$cgi->{'repository'} || []};
  my %archfilter = map {$_ => 1} @{$cgi->{'arch'} || []};

  my $proj = readproj($projid);
  my @prpas;
  for my $repo (@{$proj->{'repository'} || []}) {
    next if %repoidfilter && !$repoidfilter{$repo->{'name'}};
    my @archs = @{$repo->{'arch'} || []};
    @archs = grep {$archfilter{$_}} @archs if %archfilter;
    push @prpas, map {"$projid/$repo->{'name'}/$_"} @archs;
  }
  die("no repository defined\n") unless @prpas;
  my @packids = @{$cgi->{'package'} || []};
  if (@packids) {
    my %packids = map {$_ => 1} findpackages($projid, $proj, 1);
    my @badpacks = grep {!$packids{$_}} @packids;
    die("404 unknown package: @badpacks\n") if @badpacks;
  } else {
    @packids = findpackages($projid, $proj);
  }
  die("no packages defined\n") unless @packids;
  
  # XXX FIXME multiple repo handling
  my $res;
  for my $rrserver ($BSConfig::reposerver) {
    my @args;
    push @args, map {"prpa=$_"} @prpas;
    push @args, map {"package=$_"} @packids;
    push @args, map {"code=$_"} @{$cgi->{'code'} || []};
    push @args, "cmd=$cgi->{'cmd'}";
    my $param = {
      'uri' => "$rrserver/_command",
      'request' => 'POST',
    };
    $res = BSWatcher::rpc($param, undef, @args);
  }
  return $res;
}

sub checkprojrepoarch {
  my ($projid, $repoid, $arch, $remoteok) = @_;
  my $proj = readproj($projid, 1);
  $proj = remoteprojid($projid) if $remoteok && (!$proj || $proj->{'remoteurl'});
  die("404 project '$projid' does not exist\n") if !$proj;
  die("404 project '$projid' is remote\n") if $proj->{'remoteurl'} && !$remoteok;
  return $proj if $proj->{'remoteurl'};
  return $proj unless defined $repoid;
  my $repo = (grep {$_->{'name'} eq $repoid} @{$proj->{'repository'} || []})[0];
  die("404 project has no repository '$repoid'\n") unless $repo;
  return $proj unless defined $arch;
  die("404 project has no architecture '$arch'\n") unless grep {$_ eq $arch} @{$repo->{'arch'} || []};
  return $proj;
}

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

  checkprojrepoarch($projid, $repoid, $arch);
  my @args;
  push @args, map {"package=$_"} @{$cgi->{'package'} || []};
  push @args, "view=$cgi->{'view'}" if $cgi->{'view'};
  my $res = BSWatcher::rpc("$BSConfig::reposerver/build/$projid/$repoid/$arch/_builddepinfo", $BSXML::builddepinfo, @args);
  return ($res, $BSXML::builddepinfo);
}

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

  checkprojrepoarch($projid, $repoid, $arch);
  my @args;
  push @args, "limit=$cgi->{'limit'}" if $cgi->{'limit'};
  push @args, map {"package=$_"} @{$cgi->{'package'} || []};
  push @args, map {"code=$_"} @{$cgi->{'code'} || []};
  my $res = BSWatcher::rpc("$BSConfig::reposerver/build/$projid/$repoid/$arch/_jobhistory", $BSXML::jobhistlist, @args);
  return ($res, $BSXML::jobhistlist);
}


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

  my $proj = checkprojrepoarch($projid, $repoid, $arch, 1);
  my $view = $cgi->{'view'};
  my @args;
  push @args, "view=$view" if $view;
  push @args, map {"binary=$_"} @{$cgi->{'binary'} || []};
  if ($view && ($view eq 'cache' || $view eq 'cpio' || $view eq 'solv' || $view eq 'solvstate')) {
    if (!$BSStdServer::isajax) {
      BSHandoff::handoff($ajaxsocket, "/build/$projid/$repoid/$arch/$packid", undef, @args);
      exit(0);
    }
    my $param = {
      'uri' => "$BSConfig::reposerver/build/$projid/$repoid/$arch/$packid",
      'ignorestatus' => 1,
      'receiver' => \&BSServer::reply_receiver,
    };
    if ($proj->{'remoteurl'}) {
      $param->{'uri'} = "$proj->{'remoteurl'}/build/$proj->{'remoteproject'}/$repoid/$arch/$packid";
      $param->{'proxy'} = $proxy;
    }
    BSWatcher::rpc($param, undef, @args);
    return undef;
  }
  my $uri = "$BSConfig::reposerver/build/$projid/$repoid/$arch/$packid";
  if ($proj->{'remoteurl'}) {
    $uri = {'uri' => "$proj->{'remoteurl'}/build/$proj->{'remoteproject'}/$repoid/$arch/$packid"};
    $uri->{'proxy'} = $proxy;
  }
  if ($view && $view eq 'binaryversions') {
    push @args, 'nometa=1' if $cgi->{'nometa'};
    my $bvl = BSWatcher::rpc($uri, $BSXML::binaryversionlist, @args);
    return ($bvl, $BSXML::binaryversionlist);
  }
  my $bl = BSWatcher::rpc($uri, $BSXML::binarylist, @args);
  return ($bl, $BSXML::binarylist);
}

sub getbinary {
  my ($cgi, $projid, $repoid, $arch, $packid, $filename) = @_;
  my $proj = checkprojrepoarch($projid, $repoid, $arch, 1);
  my $view = $cgi->{'view'} || '';
  if ($proj->{'remoteurl'}) {
    # hack: reroute to /getbinaries so that our local cache is used
    die("can only access remote _repository files\n") unless $packid eq '_repository';
    die("cannot use a view for remote binaries\n") if $view;
    die("need the raw package name as filename for remote repository access\n") if $filename =~ /\.(?:rpm|deb)$/;
    my @args;
    push @args, "project=$projid";
    push @args, "repository=$repoid";
    push @args, "arch=$arch";
    push @args, "binaries=$filename";
    push @args, "raw=1";
    BSHandoff::handoff($ajaxsocket, '/getbinaries', undef, @args);
    exit(0);
  }
  my @args;
  push @args, "view=$view" if $view;
  my $param = {
    'uri' => "$BSConfig::reposerver/build/$projid/$repoid/$arch/$packid/$filename",
    'ignorestatus' => 1,
    'receiver' => \&BSServer::reply_receiver,
  };
  BSWatcher::rpc($param, undef, @args);
  return undef;
}

sub putbinary {
  my ($cgi, $projid, $repoid, $arch, $filename) = @_;
  checkprojrepoarch($projid, $repoid, $arch);
  my @args;
  push @args, 'ignoreolder=1' if $cgi->{'ignoreolder'};
  push @args, 'wipe=1' if $cgi->{'wipe'};
  my $param = {
    'uri' => "$BSConfig::reposerver/build/$projid/$repoid/$arch/_repository/$filename",
    'request' => 'PUT',
    'data' => \&BSServer::forward_sender,
    'chunked' => 1,
  };
  # XXX add return type checking
  return BSWatcher::rpc($param, undef, @args);
}

sub delbinary {
  my ($cgi, $projid, $repoid, $arch, $filename) = @_;
  checkprojrepoarch($projid, $repoid, $arch);
  my $param = {
    'uri' => "$BSConfig::reposerver/build/$projid/$repoid/$arch/_repository/$filename",
    'request' => 'DELETE',
  };
  return BSWatcher::rpc($param, undef);
}

sub copybuild {
  my ($cgi, $projid, $repoid, $arch, $packid) = @_;
  die("illegal package '$packid'\n") if $packid =~ /^_/;
  checkprojrepoarch($projid, $repoid, $arch);
  my $oprojid = defined($cgi->{'oproject'}) ? $cgi->{'oproject'} : $projid;
  my $opackid = defined($cgi->{'opackage'}) ? $cgi->{'opackage'} : $packid;
  my $orepoid = defined($cgi->{'orepository'}) ? $cgi->{'orepository'} : $repoid;
  die("nothing to do\n") if "$oprojid/$opackid/$orepoid" eq "$projid/$packid/$repoid";
  checkprojrepoarch($oprojid, $orepoid, $arch);
  # make sure the packages exist. not cheap, but does everything we need
  getrev($projid, $packid);
  getrev($oprojid, $opackid);
  my @args;
  push @args, "cmd=copy";
  push @args, "oproject=$oprojid";
  push @args, "opackage=$opackid";
  push @args, "orepository=$orepoid";
  push @args, "setupdateinfoid=$cgi->{'setupdateinfoid'}" if $cgi->{'setupdateinfoid'};
  my $param = {
    'uri' => "$BSConfig::reposerver/build/$projid/$repoid/$arch/$packid",
    'request' => 'POST',
  };
  # XXX add return type checking
  return BSWatcher::rpc($param, undef, @args);
}

sub uploadbuild {
  my ($cgi, $projid, $repoid, $arch, $packid) = @_;
  die("illageal package '$packid'\n") if $packid =~ /^_/;
  checkprojrepoarch($projid, $repoid, $arch);
  my $param = {
    'uri' => "$BSConfig::reposerver/build/$projid/$repoid/$arch/$packid",
    'request' => 'POST',
    'data' => \&BSServer::forward_sender,
    'chunked' => 1,
  };
  # XXX add return type checking
  return BSWatcher::rpc($param, undef);
}


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

  if (!$cgi->{'start'}) {
    # check if the package is broken
    my $rev = getrev($projid, $packid, 'build');
    my $files = lsrev($rev);
    if (ref($files) && $files->{'_link'}) {
      $files = handlelinks($rev, $files);
      if (!ref $files) {
	my $error = "$files\n";
	if ($rev->{'srcmd5'}) {
	  $files = lsrev($rev);
	  if ($files->{'_linkerror'}) {
	    $error = readstr("$srcrep/$packid/$files->{'_linkerror'}-_linkerror", 1);
	  }
	}
	if ($cgi->{'view'} && $cgi->{'view'} eq 'entry') {
	  my $entry = {'name' => '_log', 'size' => length($error)};
	  return ({'entry' => [ $entry ]}, $BSXML::dir);
	}
	return $error;
      }
    }
  }

  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'};
  push @args, "view=$cgi->{'view'}" if $cgi->{'view'};
  if (!$BSStdServer::isajax && !$cgi->{'view'}) {
    my $url = "/build/$projid/$repoid/$arch/$packid/_log";
    BSHandoff::handoff($ajaxsocket, $url, undef, @args);
    exit(0);
  }
  my $param = {
    'uri' => "$BSConfig::reposerver/build/$projid/$repoid/$arch/$packid/_log",
    'ignorestatus' => 1,
    'receiver' => \&BSServer::reply_receiver,
    'joinable' => 1,
  };
  BSWatcher::rpc($param, undef, @args);
  return undef; # always streams result
}

sub getbuildhistory {
  my ($cgi, $projid, $repoid, $arch, $packid) = @_;
  checkprojrepoarch($projid, $repoid, $arch);
  my @args;
  push @args, "limit=$cgi->{'limit'}" if $cgi->{'limit'};
  my $buildhist = BSWatcher::rpc("$BSConfig::reposerver/build/$projid/$repoid/$arch/$packid/_history", $BSXML::buildhist, @args);
  return ($buildhist, $BSXML::buildhist);
}

sub getbuildinfo {
  my ($cgi, $projid, $repoid, $arch, $packid) = @_;
  checkprojrepoarch($projid, $repoid, $arch);
  my @args;
  push @args, 'internal=1' if $cgi->{'internal'};
  push @args, map {"add=$_"} @{$cgi->{'add'} || []};
  my $buildinfo = BSWatcher::rpc("$BSConfig::reposerver/build/$projid/$repoid/$arch/$packid/_buildinfo", $BSXML::buildinfo, @args);
  return ($buildinfo, $BSXML::buildinfo);
}

sub getbuildinfo_post {
  my ($cgi, $projid, $repoid, $arch, $packid) = @_;
  checkprojrepoarch($projid, $repoid, $arch);
  my @args;
  push @args, map {"add=$_"} @{$cgi->{'add'} || []};
  my $param = {
    'uri' => "$BSConfig::reposerver/build/$projid/$repoid/$arch/$packid/_buildinfo",
    'request' => 'POST',
    'data' => \&BSServer::forward_sender,
    'chunked' => 1,
  };
  my $buildinfo = BSWatcher::rpc($param, $BSXML::buildinfo, @args);
  return ($buildinfo, $BSXML::buildinfo);
}

sub getbuildreason {
  my ($cgi, $projid, $repoid, $arch, $packid) = @_;
  checkprojrepoarch($projid, $repoid, $arch);
  my $reason = BSWatcher::rpc("$BSConfig::reposerver/build/$projid/$repoid/$arch/$packid/_reason", $BSXML::buildreason);
  return ($reason, $BSXML::buildreason);
}

sub getbuildstatus {
  my ($cgi, $projid, $repoid, $arch, $packid) = @_;
  checkprojrepoarch($projid, $repoid, $arch);
  my $status = BSWatcher::rpc("$BSConfig::reposerver/build/$projid/$repoid/$arch/$packid/_status", $BSXML::buildstatus);
  return ($status, $BSXML::buildstatus);
}

sub getworkerstatus {
  my ($cgi) = @_;
  my @args;
  push @args, 'scheduleronly' if $cgi->{'scheduleronly'};
  push @args, map {"arch=$_"} @{$cgi->{'arch'} || []};
  my $ws = BSWatcher::rpc("$BSConfig::reposerver/workerstatus", $BSXML::workerstatus, @args);
  delete $_->{'uri'} for @{$ws->{'idle'}};
  delete $_->{'uri'} for @{$ws->{'building'}};
  return ($ws, $BSXML::workerstatus);
}

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

sub search_proj {
  my ($cgi, $match, $id) = @_;
  $match =~ s/^\[(.*)\]$/$1/s;
  my $data = [];
  for my $projid (findprojects()) {
    my $proj = readproj($projid);
    push @$data, $proj;
  }
  $data = BSXPath::match($data, $match);
  if ($id) {
    for (@{$data || []}) {
      $_ = {'name' => $_->{'name'}};
    }
  }
  my $res = {'project' => $data};
  return ($res, $BSXML::collection);
}

sub pkgsearch_fetch {
  my ($db, $k) = @_;
  my ($projid, $packid) = split('/', $k, 2);
  my $pack = readpack($projid, $packid, 1) || {'name' => $packid};
  $pack->{'project'} = $projid;
  #my @linkinfo = BSDBIndex::getvalues($db, 'linkinfo', $k);
  #$pack->{'linkinfo'} = $linkinfo[0] if @linkinfo;
  return $pack;
}

sub pkgsearch_indexfunc {
  my ($db, $path, $value, $lkeys) = @_;
  if (!defined($path)) {
    return @{$db->{'_allkeys'}} if $db->{'_allkeys'};
    my @projids = findprojects();
    my @r;
    for my $projid (@projids) {
      push @r, map {"$projid/$_"} findpackages($projid, {}, 1);
    }
    $db->{'_allkeys'} = \@r;
    return @r;
  } elsif (!defined($value)) {
    return BSDBIndex::getkeys($db, "$db->{'index'}$path") if $path =~ /^linkinfo\//;
    return findprojects() if $path eq 'project';
    if ($path eq 'name') {
      $lkeys = [ pkgsearch_indexfunc($db) ] unless $lkeys;
      my %v = map {$_ => 1} grep {s/^.*\///} map {$_} @$lkeys;
      return sort keys %v;
    }
  } else {
    return BSDBIndex::getvalues($db, "$db->{'index'}$path", $value) if $path =~ /^linkinfo\//;
    return map {"$value/$_"} findpackages($value, {}, 1) if $path eq 'project';
    if ($path eq 'name') {
      $lkeys = [ pkgsearch_indexfunc($db) ] unless $lkeys;
      return grep {/\Q$value\E$/} @$lkeys;
    }
  }
  return ();
}

sub search_pack {
  my ($cgi, $match, $id) = @_;
  $match =~ s/^\[(.*)\]$/$1/s;
  # really ugly hack to speed up needed api call
  if ($match =~ /^\@project='(.+)' and starts-with\(\@name,'(.+)'\)$/) {
    my $projid = $1;
    my $startswith = $2;
    $projid =~ s/''/'/g;
    $startswith =~ s/''/'/g;
    my @packages = findpackages($projid, {});
    my $data = [];
    for my $packid (grep {/^\Q$startswith\E/} @packages) {
      my ($pack, undef) = getpackage($cgi, $projid, $packid);
      $pack->{'project'} = $projid;
      push @$data, $pack;
    }
    my $res = {'package' => $data};
    return ($res, $BSXML::collection);
  }
  my $db = BSDB::opendb($sourcedb, '');
  $db->{'indexfunc'} = {
    'project' => \&pkgsearch_indexfunc,
    'name' => \&pkgsearch_indexfunc,
    'linkinfo/project' => \&pkgsearch_indexfunc,
    'linkinfo/package' => \&pkgsearch_indexfunc,
    'linkinfo/rev' => \&pkgsearch_indexfunc,
  };
  $db->{'noindexatall'} = 1;
  $db->{'fetch'} = \&pkgsearch_fetch;
  my $data = BSXPathKeys::node($db, '');
  if ($id) {
    $data = $data->keymatch($match);
    for (@$data) {
      my @p = split('/', $_, 2);
      $_ = {'name' => $p[1], 'project' => $p[0]};
    }
  } else {
    $data = BSXPath::match($data, $match);
    delete $_->{'linkinfo'} for @$data;
  }
  my $res = {'package' => $data};
  return ($res, $BSXML::collection);
}

sub search_proj_id {
  return search_proj(@_, 1);
}

sub search_pack_id {
  return search_pack(@_, 1);
}

#############################################################################

sub search_published_updatedb {
  my ($cgi) = @_;
  die("unknown command '$cgi->{'cmd'}'\n") unless $cgi->{'cmd'} eq 'updatedb';
  my $data = BSServer::read_data();
  $data = Storable::thaw($data);
  die("no data\n") unless $data && @$data;
  my $patterndb;
  my $binarydb;
  my $repoinfodb;
  mkdir_p($extrepodb) unless -d $extrepodb;
  while (@$data) {
    my ($w, $k, $v) = splice(@$data, 0, 3);
    if ($w eq 'binary') {
      $binarydb = BSDB::opendb($extrepodb, 'binary') unless $binarydb;
      $binarydb->updateindex_rel($k || [], $v || []);
    } elsif ($w eq 'pattern') {
      $patterndb = BSDB::opendb($extrepodb, 'pattern') unless $patterndb;
      $patterndb->store($k, $v);
    } elsif ($w eq 'repoinfo') {
      if (!$repoinfodb) {
        $repoinfodb = BSDB::opendb($extrepodb, 'repoinfo');
        $repoinfodb->{'noindexatall'} = 1;
      };
      $repoinfodb->store($k, $v);
    } else {
      die("bad data type: '$w'\n");
    }
  }
  return $BSStdServer::return_ok;
}

#sub search_published_id {
#  my ($cgi, $what, $match) = @_;
#  my $res;
#  for my $rrserver ($BSConfig::reposerver) {
#    $res = BSRPC::rpc("$rrserver/search/published/$what/id", $BSXML::collection, "match=$match");
#    last if $res;
#  }
#  return ($res, $BSXML::collection);
#}
#
#sub search_published_binary_id {
#  return search_published_id($_[0], 'binary', $_[1]);
#}
#
#sub search_published_pattern_id {
#  return search_published_id($_[0], 'pattern', $_[1]);
#}

my %prp_to_repoinfo;

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

  my $repoinfo = $prp_to_repoinfo{$prp};
  if (!$repoinfo) {
    my $repoinfodb = BSDB::opendb($extrepodb, 'repoinfo');
    $repoinfo = $repoinfodb->fetch($prp);
    if ($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 published_projectindexfunc {
  my ($db, $path, $value) = @_;
  return findprojects() unless defined $value;
  my $proj = readproj($value);
  return () unless $proj;
  my @repoids = map {$_->{'name'}} @{$proj->{'repository'} || []};
  my %bins;
  for my $repoid (@repoids) {
    my $prp = "$value/$repoid";
    my $prp_ext = $prp;
    $prp_ext =~ s/:/:\//g;
    my $repoinfo = $prp_to_repoinfo{$prp} || prp_to_repoinfo($prp);
    for (keys %{$repoinfo->{'binaryorigins'} || {}}) {
      next unless /\//;
      $bins{"$prp_ext/$_"} = 1;
    }
  }
  return sort keys %bins;
}

sub search_published_binary_id {
  my ($cgi, $match) = @_;
  my $binarydb = BSDB::opendb($extrepodb, 'binary');
  $binarydb->{'allkeyspath'} = 'name';
  $binarydb->{'noindex'} = {'version' => 1, 'arch' => 1, 'project' => 1, 'repository' => 1, 'package' => 1, 'type' => 1, 'path/project' => 1, 'path/repository' => 1};
  $binarydb->{'indexfunc'} = {'project' => \&published_projectindexfunc };
  $binarydb->{'fetch'} = \&binary_key_to_data;
  $binarydb->{'cheapfetch'} = 1;
  my $limit = defined($cgi->{'limit'}) ? $cgi->{'limit'} : 1000;
  my $rootnode = BSXPathKeys::node($binarydb, '', $limit * 10);
  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;
  my $res = {};
  $res->{'matches'} = @$data;
  $res->{'limited'} = 'true' if $limit && @$data > $limit;
  splice(@$data, $limit) if $limit && @$data > $limit;
  delete $_->{'path'} for @$data;
  $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 $limit = defined($cgi->{'limit'}) ? $cgi->{'limit'} : 1000;
  my $rootnode = BSXPathKeys::node($patterndb, '', $limit * 10);
  my $data = BSXPath::match($rootnode, $match) || [];
  my $res = {};
  $res->{'matches'} = @$data;
  $res->{'limited'} = 'true' if $limit && @$data > $limit;
  splice(@$data, $limit) if $limit && @$data > $limit;
  for (@$data) {
    delete $_->{'path'};
    delete $_->{'description'};
    delete $_->{'summary'};
  }
  $res->{'pattern'} = $data;
  return ($res, $BSXML::collection);
}

#############################################################################

sub search {
  my ($cgi, $in, $match) = @_;
  # gather all data
  my $data = [];
  if ($in eq 'projects') {
    for my $projid (findprojects()) {
      my $proj = readproj($projid);
      push @$data, $proj;
    }
  } elsif ($in eq 'packages') {
    for my $projid (findprojects()) {
      my @packages = findpackages($projid, {});
      for my $packid (@packages) {
        my ($pack, undef) = getpackage($cgi, $projid, $packid);
	$pack->{'project'} = $projid;
        push @$data, $pack;
      }
    }
  } else {
    die("'in' parameter needs to be either 'projects' or 'packages'\n");
  }
  my $res;
  if ($cgi->{'values'}) {
    $data = BSXPath::valuematch($data, $match);
    $res = {'value' => $data};
  } else {
    $data = BSXPath::match($data, $match);
    if (exists $cgi->{'return'}) {
      $data = BSXPath::valuematch($data, $cgi->{'return'});
      $res = {'value' => $data};
    } elsif ($in eq 'projects') {
      $res = {'project' => $data};
    } else {
      $res = {'package' => $data};
    }
  }
  return ($res, $BSXML::collection);
}

sub postrepo {
  my ($cgi, $projid, $repoid, $arch) = @_;
  my $param = {
    'uri' => "$BSConfig::reposerver/build/$projid/$repoid/$arch/_repository",
    'request' => 'POST',
  };
  my $res = BSWatcher::rpc($param, $BSXML::collection, "match=$cgi->{'match'}");
  return ($res, $BSXML::collection);
}

sub service {
  my ($cgi, $service) = @_;
  die("404 no such service '$service'\n") unless $BSConfig::serviceserver;
  return BSWatcher::rpc("$BSConfig::serviceserver/service/$service", undef);
}

sub listservices {
  my ($cgi) = @_;
  return "<servicelist/>\n" unless $BSConfig::serviceserver;
  return BSWatcher::rpc("$BSConfig::serviceserver/service", undef);
}

sub published {
  my ($cgi, $projid, $repoid, $arch, $filename) = @_;
  my @args;
  die("unknown view '$cgi->{'view'}'\n") if $cgi->{'view'} && $cgi->{'view'} ne 'ymp' && $cgi->{'view'} ne 'fileinfo';
  push @args, "view=$cgi->{'view'}" if $cgi->{'view'};
  my $p = "/published";
  $p .= "/$projid" if defined $projid;
  $p .= "/$repoid" if defined $repoid;
  $p .= "/$arch" if defined $arch;
  $p .= "/$filename" if defined $filename;
  my $param = {
    'uri' => "$BSConfig::reposerver$p",
    'ignorestatus' => 1,
    'receiver' => \&BSServer::reply_receiver,
  };
  BSWatcher::rpc($param, undef, @args);
  return undef;
}

sub getsignkey {
  my ($cgi, $projid) = @_;

  while ($projid ne '') {
    my $sk = readstr("$projectsdir/$projid.pkg/_signkey", 1);
    if ($sk) {
      if ($cgi->{'withpubkey'}) {
        my $pk = readstr("$projectsdir/$projid.pkg/_pubkey", 1);
        $sk .= "\n" unless $sk =~ /\n$/s;
        $sk .= $pk;
      }
      return ($sk, 'Content-Type: text/plain') if $sk;
    }
    $projid =~ s/[^:]*$//;
    $projid =~ s/:$//;
  }
  return ('', 'Content-Type: text/plain');
}

####################################################################

sub getrequestlist {
  my ($cgi) = @_;

  my @requests = map {{'name' => $_}} sort(grep {!/^\./} ls($requestsdir));
  return ({'entry' => \@requests}, $BSXML::dir);
};

sub nextreqid {
  local *F;
  mkdir_p($requestsdir);
  BSUtil::lockopen(*F, '>>', "$requestsdir/.nextid");
  my $nextid = readstr("$requestsdir/.nextid", 1);
  if (!$nextid) {
    die("nextid was lost\n") if grep {$_ ne '.nextid'} ls($requestsdir);
    $nextid = 1;
  }
  chomp $nextid;
  die("nextid is bad\n") if $nextid =~ /[^0-9]/s;
  writestr("$requestsdir/.nextid.new", "$requestsdir/.nextid", $nextid + 1);
  close F;
  return $nextid;
}

sub writereq {
  my ($oreq, $req) = @_;

  my $id;
  $id = $req->{'id'} if $req;
  $id = $oreq->{'id'} if $oreq && !defined($id);
  die unless defined $id;
  my $name = $id;
  if ($req) {
    writexml("$requestsdir/.$name", "$requestsdir/$name", $req, $BSXML::request);
  }
  mkdir_p($reqindexdb);
  my $db = BSDB::opendb($reqindexdb, '');
  $db->{'noindex'} = {'id' => 1};
  $db->updateindex($id, $oreq || {}, $req || {});
  if (!$req) {
    unlink("$requestsdir/$name");
  }
}

sub putrequest {
  my ($cgi, $id) = @_;
  my $reqxml = BSServer::read_data(1000000);
  my $req = XMLin($BSXML::request, $reqxml);
  BSVerify::verify_request($req);
  my $oreq = readxml("$requestsdir/$id", $BSXML::request, 1);
  die("404 no such request '$id'\n") unless $oreq;
  $req->{'id'} = $id;
  $req->{'history'} = [ @{$oreq->{'history'} || []} ];
  push @{$req->{'history'}}, $oreq->{'state'};
  $req->{'state'}->{'who'} = $cgi->{'user'} if defined $cgi->{'user'};
  my @lt = localtime(time());
  $req->{'state'}->{'when'} = sprintf("%04d-%02d-%02dT%02d:%02d:%02d", $lt[5] + 1900, $lt[4] + 1, @lt[3,2,1,0]);
  writereq($oreq, $req);
  BSNotify::notify("SRCSRV_REQUEST_CHANGE", BSNotify::requestParams($req, $cgi->{'user'}));
  return $BSStdServer::return_ok;
}

sub createrequest {
  my ($cgi) = @_;

  my $reqxml = BSServer::read_data(1000000);
  my $cmd = $cgi->{'cmd'};
  die("unknown command '$cmd'\n") unless $cmd eq 'create';
  my $req = XMLin($BSXML::request, $reqxml);

  if ($req->{'type'}) {
    # old style request, convert to new style
    die("action element in old style request\n") if $req->{'action'};
    die("old style request with unknown type\n") if $req->{'type'} ne 'submit';
    die("old style request without submit element\n") unless $req->{'submit'};
    $req->{'submit'}->{'type'} = 'submit';
    $req->{'action'} = [ $req->{'submit'} ];
    delete $req->{'submit'};
    delete $req->{'type'};
  }

  for my $r (@{$req->{'action'} || []}) {
    if (($r->{'type'} || '') eq 'submit' && $r->{'source'} && !$r->{'target'}) {
      # make source link target the submit request target, if not specified
      my $projid = $r->{'source'}->{'project'};
      my $packid = $r->{'source'}->{'package'};
      my $rev = $r->{'source'}->{'rev'};
      BSVerify::verify_projid($projid);
      BSVerify::verify_packid($packid);
      BSVerify::verify_rev($rev) if defined $rev;
      if (defined($projid) && defined($packid)) {
	my $rev = getrev($projid, $packid, $rev);
        my $files = lsrev($rev);
        if ($files->{'_link'}) {
          my $l = repreadxml($rev, '_link', $files->{'_link'}, $BSXML::link, 1);
          if ($l) {
            $projid = $l->{'project'} if exists $l->{'project'};
            $packid = $l->{'package'} if exists $l->{'package'};
            $r->{'target'} = {'project' => $projid, 'package' => $packid};
          }
        }
      }
    }
    die("target project does not exist\n") if ($r->{'type'} || '') eq 'submit' && (!$r->{'target'}->{'project'} || ! -e "$projectsdir/$r->{'target'}->{'project'}.xml");
  }

  # new requests are either in state 'new' or 'review'
  $req->{'state'}->{'name'} = 'new';
  $req->{'state'}->{'name'} = 'review' if defined($req->{'review'});

  BSVerify::verify_request($req);
  die("request must not contain an id\n") if $req->{'id'};
  die("request must not contain a history\n") if $req->{'history'};
  die("request must not be created by anonymous\n") unless defined $cgi->{'user'};
  $req->{'state'}->{'who'} = $cgi->{'user'};
  my @lt = localtime(time());
  $req->{'state'}->{'when'} = sprintf("%04d-%02d-%02dT%02d:%02d:%02d", $lt[5] + 1900, $lt[4] + 1, @lt[3,2,1,0]);
  $req->{'id'} = nextreqid();
  writereq(undef, $req);

  # notification about new request
  BSNotify::notify("SRCSRV_REQUEST_CREATE", BSNotify::requestParams($req, $cgi->{'user'}));

  # notification about new review of request
  for my $r (@{$req->{'review'} || []}) {
    my $notification = BSNotify::requestParams($req, $cgi->{'user'});
    my $hermes_type;
    if ($r->{'by_package'}) {
      $hermes_type = "SRCSRV_REQUEST_REVIEWER_PACKAGE_ADDED";
      $notification->{'newreviewer_project'} = $r->{'by_project'};
      $notification->{'newreviewer_package'} = $r->{'by_package'};
    }elsif ($r->{'by_project'}) {
      $hermes_type = "SRCSRV_REQUEST_REVIEWER_PROJECT_ADDED";
      $notification->{'newreviewer_project'} = $r->{'by_project'};
    } elsif ($r->{'by_user'}) {
      $hermes_type = "SRCSRV_REQUEST_REVIEWER_ADDED";
      $notification->{'newreviewer'} = $r->{'by_user'};
    } elsif ($r->{'by_group'}) {
      $hermes_type = "SRCSRV_REQUEST_REVIEWER_GROUP_ADDED";
      $notification->{'newreviewer_group'} = $r->{'by_group'};
    }
    $notification->{'comment'} = $r->{'comment'};
    BSNotify::notify( $hermes_type, $notification) if( $hermes_type );
   }

  return ($req, $BSXML::request);
}

sub getrequest {
  my ($cgi, $id) = @_;
  my $req = readxml("$requestsdir/$id", $BSXML::request, 1);
  $req ||= readxml("$oldrequestsdir/$id", $BSXML::request, 1);
  die("404 no such request '$id'\n") unless $req;
  return ($req, $BSXML::request);
}

sub postrequest {
  my ($cgi, $id) = @_;

  # work around bad osc versions
  delete $cgi->{'superseded_by'} if defined($cgi->{'superseded_by'}) && $cgi->{'superseded_by'} eq '';
  my $cmd = $cgi->{'cmd'};
  my $oreq = readxml("$requestsdir/$id", $BSXML::request, 1);
  die("404 no such request '$id'\n") unless $oreq;
  my $req = Storable::dclone($oreq);	# deep clone
  die unless $req->{'id'} eq $id;
  my $oldstate = $req->{'state'};
  my @lt = localtime(time());
  my $mytime = sprintf("%04d-%02d-%02dT%02d:%02d:%02d", $lt[5] + 1900, $lt[4] + 1, @lt[3,2,1,0]);
  if ($cmd eq 'addreview'){
    die("request review is not specified via by_user, by_group or by_project\n") if !$cgi->{'by_user'} && !$cgi->{'by_group'} && !$cgi->{'by_project'};
    push @{$req->{'history'}}, $oldstate;
    $req->{'state'} = {'name' => 'review'};
    $req->{'state'}->{'who'} = $cgi->{'user'} if defined $cgi->{'user'};
    $req->{'state'}->{'comment'} = $cgi->{'comment'} if defined $cgi->{'comment'};
    my @lt = localtime(time());
    $req->{'state'}->{'when'} = sprintf("%04d-%02d-%02dT%02d:%02d:%02d", $lt[5] + 1900, $lt[4] + 1, @lt[3,2,1,0]);
    if ($cgi->{'by_user'}) {
      push @{$req->{'review'}}, { 'state' => 'new', 'by_user' => $cgi->{'by_user'}, 'comment' => $cgi->{'comment'} };
    } elsif ($cgi->{'by_group'}) {
      push @{$req->{'review'}}, { 'state' => 'new', 'by_group' => $cgi->{'by_group'}, 'comment' => $cgi->{'comment'} };
    } else {
      if ($cgi->{'by_package'}) {
        push @{$req->{'review'}}, { 'state' => 'new', 'by_project' => $cgi->{'by_project'}, 'by_package' => $cgi->{'by_package'}, 'comment' => $cgi->{'comment'} };
      } else {
        push @{$req->{'review'}}, { 'state' => 'new', 'by_project' => $cgi->{'by_project'}, 'comment' => $cgi->{'comment'} };
      }
    }
  } elsif ($cmd eq 'changereviewstate') {
    die("request is not in review state\n") unless $req->{'state'} and $req->{'state'}->{'name'} eq "review";
    die("request review item is not specified via by_user or by_group\n") if not $cgi->{'by_user'} and not $cgi->{'by_group'} and not $cgi->{'by_project'};
    die("review state must be accepted, declined or superseded, but was >$cgi->{'newstate'}<\n") unless
        $cgi->{'newstate'} eq 'accepted' or $cgi->{'newstate'} eq 'declined' or $cgi->{'newstate'} eq 'superseded';

    my $go_new_state = 'review';
    $go_new_state = $cgi->{'newstate'} if $cgi->{'newstate'} eq 'declined' or $cgi->{'newstate'} eq 'superseded';
    my $found = 0;
    for my $r (@{$req->{'review'} || []}) {
      my $matching;
      $matching = 1 if defined($r->{'by_user'}) and defined($cgi->{'by_user'}) and $r->{'by_user'} eq $cgi->{'by_user'};
      $matching = 1 if defined($r->{'by_group'}) and defined($cgi->{'by_group'}) and $r->{'by_group'} eq $cgi->{'by_group'};
      if (defined($r->{'by_project'}) and defined($cgi->{'by_project'}) and $r->{'by_project'} eq $cgi->{'by_project'}) {
        if (defined($r->{'by_package'}) or defined($cgi->{'by_package'})) {
          # by_package review
          $matching = 1 if $r->{'by_package'} eq $cgi->{'by_package'};
        } else {
          # by_project review
          $matching = 1;
        }
      }

      if ($matching) {
        $r->{'state'} = $cgi->{'newstate'};
        $r->{'when'} = $mytime;
        $r->{'who'} = $cgi->{'user'} if defined $cgi->{'user'};
        $r->{'comment'} = $cgi->{'comment'} if defined($cgi->{'comment'});
        $found = 1;
        $go_new_state = 'new' if $go_new_state eq "review" and $r->{'state'} eq 'accepted';
        $go_new_state = $r->{'state'} if $go_new_state eq "review"; # take decline
      } else {
        # don't touch the request state if a review is still open, except the
        # review got declined or superseded.
        $go_new_state = '' if $r->{'state'} eq 'new' and $go_new_state ne 'declined' and $go_new_state ne 'superseded';
      }
    }
    die("review item not found.\n") if $found == 0;
    if ($go_new_state or $cgi->{'newstate'} eq 'superseded'){
      push @{$req->{'history'}}, $oldstate;
      if ($cgi->{'newstate'} eq 'superseded') { # superseded
         $req->{'state'} = {'name' => 'superseded'};
         $req->{'state'}->{'superseded_by'} = $cgi->{'superseded_by'} if defined $cgi->{'superseded_by'};
      } else { # no open reviews anymore
         $req->{'state'} = {'name' => $go_new_state} if $go_new_state;
      }
      $req->{'state'}->{'who'} = $cgi->{'user'} if defined $cgi->{'user'};
      $req->{'state'}->{'comment'} = $cgi->{'comment'} if defined $cgi->{'comment'};
      $req->{'state'}->{'when'} = $mytime;
    }
  } elsif ($cmd eq 'changestate') {
    die("no new state\n") unless $cgi->{'newstate'};
    die("missing superseded_by parameter\n") if $cgi->{'newstate'} eq 'superseded' and not defined($cgi->{'superseded_by'});
    push @{$req->{'history'}}, $oldstate;
    $req->{'state'} = {'name' => $cgi->{'newstate'}};
    $req->{'state'}->{'who'} = $cgi->{'user'} if defined $cgi->{'user'};
    $req->{'state'}->{'comment'} = $cgi->{'comment'} if defined $cgi->{'comment'};
    $req->{'state'}->{'superseded_by'} = $cgi->{'superseded_by'} if defined $cgi->{'superseded_by'};
    $req->{'state'}->{'when'} = $mytime;
  } else {
    die("unknown command '$cmd'\n");
  }
  BSVerify::verify_request($req);
  writereq($oreq, $req);
  $req->{'oldstate'} = $oldstate;
  BSNotify::notify("SRCSRV_REQUEST_STATECHANGE", BSNotify::requestParams($req, $cgi->{'user'}));
  # Additionally send type specific hermes notifications
  my $hermes_type;
  my $notification = BSNotify::requestParams($req, $cgi->{'user'});
  if ($cmd eq 'addreview') {
    if ($cgi->{'by_package'}) {
      $hermes_type = "SRCSRV_REQUEST_REVIEWER_PACKAGE_ADDED";
      $notification->{'newreviewer_project'} = $cgi->{'by_project'};
      $notification->{'newreviewer_package'} = $cgi->{'by_package'};
    }elsif ($cgi->{'by_project'}) {
      $hermes_type = "SRCSRV_REQUEST_REVIEWER_PROJECT_ADDED";
      $notification->{'newreviewer_project'} = $cgi->{'by_project'};
    } elsif ($cgi->{'by_user'}) {
      $hermes_type = "SRCSRV_REQUEST_REVIEWER_ADDED";
      $notification->{'newreviewer'} = $cgi->{'by_user'};
    } elsif ($cgi->{'by_group'}) {
      $hermes_type = "SRCSRV_REQUEST_REVIEWER_GROUP_ADDED";
      $notification->{'newreviewer_group'} = $cgi->{'by_group'};
    }
    $notification->{'comment'} = $cgi->{'comment'};
  } else {
    if( $cgi->{'newstate'} eq "accepted" ) {
      $hermes_type = "SRCSRV_REQUEST_ACCEPTED";
    } elsif( $cgi->{'newstate'} eq "rejected" ) {
      $hermes_type = "SRCSRV_REQUEST_REJECTED";
    } elsif( $cgi->{'newstate'} eq "revoked" ) {
      $hermes_type = "SRCSRV_REQUEST_REVOKED";
    }
  }
  BSNotify::notify( $hermes_type, $notification) if( $hermes_type );

  return $BSStdServer::return_ok;
}

sub delrequest {
  my ($cgi, $id) = @_;
  my $oreq = readxml("$requestsdir/$id", $BSXML::request, 1);
  die("404 no such request '$id'\n") unless $oreq;
  die unless $oreq->{'id'} eq $id;
  writereq($oreq, undef);
  BSNotify::notify("SRCSRV_REQUEST_DELETE", BSNotify::requestParams($oreq, $cgi->{'user'}));
  return $BSStdServer::return_ok;
}

sub fetchreq {
  my ($db, $key) = @_;
  my $req = readxml("$requestsdir/$key", $BSXML::request, 1) || {};
  $req->{'id'} = $key;
  return $req;
}

sub search_request {
  my ($cgi, $match) = @_;
  my $db = BSDB::opendb($reqindexdb, '');
  $db->{'noindex'} = {'id' => 1};
  $db->{'allkeyspath'} = 'type';
  $db->{'fetch'} = \&fetchreq;
  my $limit = defined($cgi->{'limit'}) ? $cgi->{'limit'} : 0;
  my $rootnode = BSXPathKeys::node($db, '', $limit * 10);
  my $data = BSXPath::match($rootnode, $match) || [];
  my $res = {};
  $res->{'matches'} = @$data;
  $res->{'limited'} = 'true' if $limit && @$data > $limit;
  splice(@$data, $limit) if $limit && @$data > $limit;
  $res->{'request'} = $data;
  return ($res, $BSXML::collection);
}

sub addacceptinfo {
  my ($id, $projid, $packid, $acceptinfo) = @_;
  my $oreq = readxml("$requestsdir/$id", $BSXML::request, 1);
  return unless $oreq && $oreq->{'id'} eq $id;
  my $req = Storable::dclone($oreq);	# deep clone
  my $changed;
  for my $r (@{$req->{'action'} || []}) {
    next unless $r->{'type'} eq 'submit';
    next unless $r->{'target'} && defined($r->{'target'}->{'project'}) && defined($r->{'target'}->{'package'});
    next unless $r->{'target'}->{'project'} eq $projid && $r->{'target'}->{'package'} eq $packid;
    if ($r->{'acceptinfo'}) {
      for ('rev', 'srcmd5', 'xsrcmd5') {
        delete $r->{'acceptinfo'}->{$_};
        $r->{'acceptinfo'}->{$_} = $acceptinfo->{$_} if defined $acceptinfo->{$_};
      }
    } else {
      $r->{'acceptinfo'} = $acceptinfo;
    }
    $changed = 1;
  }
  writereq($oreq, $req) if $changed;
}

####################################################################

sub findremote {
  my ($projid) = @_;

  my $origprojid = $projid;
  my $proj = readproj($projid, 1);
  if ($proj) {
    return ($BSConfig::reposerver, $projid) if !$proj->{'remoteurl'};
    die("no remoteproject specified\n") unless $proj->{'remoteproject'};
    return ($proj->{'remoteurl'}, $proj->{'remoteproject'});
  }
  my $rsuf = '';
  while ($projid =~ /^(.*)(:.*?)$/) {
    $projid = $1;
    $rsuf = "$2$rsuf";
    $proj = readproj($projid, 1);
    next unless $proj;
    die("404 project '$origprojid' does not exist\n") unless $proj->{'remoteurl'};
    if ($proj->{'remoteproject'}) {
      return ($proj->{'remoteurl'}, "$proj->{'remoteproject'}$rsuf");
    }
    $rsuf =~ s/^://;
    return ($proj->{'remoteurl'}, $rsuf);
  }
  die("404 project '$origprojid' does not exist\n") unless $proj->{'remoteurl'};
}

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

  if (!$BSStdServer::isajax) {
    my @args;
    push @args, "project=$projid";
    push @args, "repository=$repoid";
    push @args, "arch=$arch";
    push @args, "binaries=$cgi->{'binaries'}";
    BSHandoff::handoff($ajaxsocket, '/getbinaries', undef, @args);
    exit(0);
  }
  my @binaries = split(',', $cgi->{'binaries'});
  my ($remoteurl, $remoteprojid) = findremote($projid);
  my $uri = {'uri' => "$remoteurl/build/$remoteprojid/$repoid/$arch/_repository"};
  $uri->{'proxy'} = $proxy if $remoteurl ne $BSConfig::reposerver;
  my $binarylist = BSWatcher::rpc($uri, $BSXML::binarylist, "view=names", map {"binary=$_"} @binaries);
  return undef if $BSStdServer::isajax && !$binarylist;
  my %binarylist;
  for my $b (@{$binarylist->{'binary'} || []}) {
    if ($b->{'filename'} =~ /^(.*)(\.deb|\.rpm)$/) {
      $binarylist{$1} = $b;
    } else {
      $binarylist{$b->{'filename'}} = $b;
    }
  }
  my @fetch;
  my @reply;

  local *LOCK;
  mkdir_p($remotecache);
  BSUtil::lockopen(\*LOCK, '>>', "$remotecache/lock");
  for my $bin (@binaries) {
    my $b = $binarylist{$bin};
    if (!$b || !$b->{'size'} || !$b->{'mtime'}) {
      push @reply, {'name' => $bin, 'error' => 'not available'};
      next;
    }
    my $cachemd5 = Digest::MD5::md5_hex("$projid/$repoid/$arch/$bin");
    substr($cachemd5, 2, 0, '/');
    my @s = stat("$remotecache/$cachemd5");
    if (!@s || $s[9] != $b->{'mtime'} || $s[7] != $b->{'size'}) {
      push @fetch, $bin;
    } else {
      utime time(), $s[9], "$remotecache/$cachemd5";
      push @reply, {'name' => $b->{'filename'}, 'filename' => "$remotecache/$cachemd5"};
    }
  }
  my $slot = sprintf("%02x", (int(rand(256))));
  print "cleaning slot $slot\n";
  if (-d "$remotecache/$slot") {
    my $now = time();
    my $num = 0;
    for my $f (ls("$remotecache/$slot")) {
      my @s = stat("$remotecache/$slot/$f");
      next if $s[8] >= $now - 24*3600;
      unlink("$remotecache/$slot/$f");
      $num++;
    }
    print "removed $num unused files\n" if $num;
  }
  close(LOCK);

  if (@fetch) {
    my $serialmd5 = Digest::MD5::md5_hex("$projid/$repoid/$arch");

    # serialize this upload
    my $serial = BSWatcher::serialize("$remotecache/$serialmd5.lock");
    return undef unless $serial;

    print "fetch: @fetch\n";
    my %fetch = map {$_ => $binarylist{$_}} @fetch;
    my $param = {
      'uri' => "$remoteurl/build/$remoteprojid/$repoid/$arch/_repository",
      'receiver' => \&BSHTTP::cpio_receiver,
      'directory' => $remotecache,
      'map' => "upload$serialmd5:",
      'proxy' => $proxy,
    };
    my $cpio;
    if ($BSStdServer::isajax) {
      $param->{'receiver'} = \&BSHTTP::file_receiver;
      $param->{'filename'} = "$remotecache/upload$serialmd5.cpio";
      local *F;
      if (open(F, '<', $param->{'filename'})) {
        unlink($param->{'filename'});
	$cpio = BSHTTP::cpio_receiver(BSHTTP::fd2hdr(\*F), $param);
	close F;
      }
    }

    # work around api bug: only get 50 packages at a time
    @fetch = splice(@fetch, 0, 50) if !$cpio && @fetch > 50;

    $cpio ||= BSWatcher::rpc($param, undef, "view=cpio", map {"binary=$_"} @fetch);
    return undef if $BSStdServer::isajax && !$cpio;
    for my $f (@{$cpio || []}) {
      my $bin = $f->{'name'};
      $bin =~ s/^upload.*?://;
      $bin =~ s/\.(:?rpm|deb)$//;
      if (!$fetch{$bin}) {
        unlink("$remotecache/$f->{'name'}");
	next;
      }
      my $cachemd5 = Digest::MD5::md5_hex("$projid/$repoid/$arch/$bin");
      substr($cachemd5, 2, 0, '/');
      mkdir_p("$remotecache/".substr($cachemd5, 0, 2));
      rename("$remotecache/$f->{'name'}", "$remotecache/$cachemd5");
      push @reply, {'name' => $fetch{$bin}->{'filename'}, 'filename' => "$remotecache/$cachemd5"};
      delete $fetch{$bin};
    }
    BSWatcher::serialize_end($serial);

    if (@{$cpio || []} >= 50) {
      # work around api bug: get rest
      return worker_getbinaries($cgi, $projid, $repoid, $arch);
    }

    for (sort keys %fetch) {
      push @reply, {'name' => $_, 'error' => 'not available'};
    }
  }
  if ($cgi->{'raw'}) {
    die("can only transport one binary in raw mode\n") unless @reply == 1;
    my $f = $reply[0];
    die("$f->{'name'}: $f->{'error'}\n") if $f->{'error'};
    die("$f->{'name'}: not found\n") unless $f->{'filename'};
    BSWatcher::reply_file($f->{'filename'});
    return undef;
  }
  BSWatcher::reply_cpio(\@reply);
  return undef;
}

sub worker_getbinaryversions {
  my ($cgi, $projid, $repoid, $arch) = @_;
  my @binaries = split(',', $cgi->{'binaries'});
  my ($remoteurl, $remoteprojid) = findremote($projid);
  my $uri = {'uri' => "$remoteurl/build/$remoteprojid/$repoid/$arch/_repository"};
  $uri->{'proxy'} = $proxy if $remoteurl ne $BSConfig::reposerver;
  my $bvl = BSWatcher::rpc($uri, $BSXML::binaryversionlist, 'view=binaryversions', 'nometa=1', map {"binary=$_"} @binaries);
  return ($bvl, $BSXML::binaryversionlist);
}

my @lastev_cache;
my @lastev_stat;

sub worker_lastevents {
  my ($cgi, $watch) = @_;
  if (!$cgi->{'start'}) {
    # just fetch the current event number
    my $lastev = BSFileDB::fdb_getlast("$eventdir/lastevents", $eventlay);
    my $lastno = $lastev ? $lastev->{'number'} : 0;
    my $ret = {'next' => $lastno, 'sync' => 'lost'};
    return ($ret, $BSXML::events);
  }
  if (!$BSStdServer::isajax) {
    my @args;
    push @args, "obsname=$cgi->{'obsname'}" if $cgi->{'obsname'};
    push @args, map {"filter=$_"} @{$watch || []};
    push @args, "start=$cgi->{'start'}";
    BSHandoff::handoff($ajaxsocket, '/lastevents', undef, @args);
    exit(0);
  }
  BSWatcher::addfilewatcher("$eventdir/lastevents");
  # get the last 5 events
  my @s = stat("$eventdir/lastevents");
  my @events;
  if (@s && @lastev_stat && "$s[9]/$s[7]/$s[1]" eq "$lastev_stat[9]/$lastev_stat[7]/$lastev_stat[1]") {
    @events = @lastev_cache;
  } else {
    my $lastev = BSFileDB::fdb_getlast("$eventdir/lastevents", $eventlay);
    push @events, $lastev if $lastev;
    @lastev_cache = @events;
    @lastev_stat = @s;
  }
  my $firstno = @events ? $events[0]->{'number'} : 0;
  my $nextno = @events ? $events[-1]->{'number'} + 1 : 1;
  if ($cgi->{'start'} < $firstno) {
    # we have to get them all
    @events = BSFileDB::fdb_getall("$eventdir/lastevents", $eventlay);
    # re-calculate in case something has changed
    $firstno = @events ? $events[0]->{'number'} : 0;
    $nextno = @events ? $events[-1]->{'number'} + 1 : 1;
    if ($firstno > $cgi->{'start'}) {
      # out of sync!
      return ({'next' => $nextno, 'sync' => 'lost'}, $BSXML::events);
    }
  }
  # filter
  @events = grep {$_->{'number'} >= $cgi->{'start'}} @events;
  if ($watch && @events) {
    my %watch = map {$_ => 1} @$watch;
    for my $ev (splice @events) {
      if ($ev->{'type'} eq 'package') {
        next unless defined $ev->{'package'};
        next unless $watch{"package/$ev->{'project'}/$ev->{'package'}"} || $watch{"package/$ev->{'project'}"};
      } elsif ($ev->{'type'} eq 'project') {
        next unless $watch{"project/$ev->{'project'}"};
      } elsif ($ev->{'type'} eq 'repository') {
        next unless $watch{"repository/$ev->{'project'}/$ev->{'repository'}/$ev->{'arch'}"};
      } else {
	next;
      }
      push @events, $ev;
    }
  }
  # return a sync reply every 100 events for two reasons
  # - get rid of old peers
  # - survive history truncation
  $cgi->{'start_orig'} ||= $cgi->{'start'};
  if ($BSStdServer::isajax && !@events && $nextno < $cgi->{'start_orig'} + 100) {
    # small hack: update cgi to the next event number
    $cgi->{'start'} = $nextno if $cgi->{'start'} < $nextno;
    return undef;
  }
  for (@events) {
    $_ = { %$_ };	# clone em
    # delete unwanted fields
    delete $_->{'time'};
    delete $_->{'number'};
    # clean up a bit
    delete $_->{'package'} unless defined($_->{'package'}) && $_->{'package'} ne '';
  }
  my $ret = {'next' => $nextno};
  $ret->{'event'} = \@events if @events;
  return ($ret, $BSXML::events);
}

sub addevent {
  my ($ev) = @_;
  $ev->{'time'} = time();
  mkdir_p("$eventdir");
  if (-s "$eventdir/lastevents" && -s _ >= 65536) {
    local *F;
    BSUtil::lockopen(\*F, '+>>', "$eventdir/lastevents");
    my $events = readstr("$eventdir/lastevents");
    if (length($events) >= 65536) {
      $events = substr($events, -32768);
      $events =~ s/^[^\n]*\n//s;
      writestr("$eventdir/.lastevents", "$eventdir/lastevents", $events);
    }
    close F;
  }
  BSFileDB::fdb_add_i("$eventdir/lastevents", $eventlay, $ev);
}

sub newevent {
  my ($cgi) = @_;
  my $ev = {};
  for ('type', 'project', 'package', 'repository', 'arch', 'job') {
    $ev->{$_} = $cgi->{$_} if defined $cgi->{$_};
  }
  addevent($ev);
  return $BSStdServer::return_ok;
}

sub getrelsync {
  my ($cgi, $projid, $repoid, $arch) = @_;
  checkprojrepoarch($projid, $repoid, $arch);
  my $param = {
    'uri' => "$BSConfig::reposerver/build/$projid/$repoid/$arch/_relsync",
    'ignorestatus' => 1,
    'receiver' => \&BSServer::reply_receiver,
  };
  BSWatcher::rpc($param, undef);
  return undef;
}

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

  my $proj = checkprojrepoarch($projid, $repoid, $arch);
  my $repo = (grep {$_->{'name'} eq $repoid} @{$proj->{'repository'} || []})[0];
  my $relsyncdata = BSServer::read_data(10000000);
  for my $a (@{$repo->{'arch'} || []}) {
    next if $a eq $arch;
    next if $BSConfig::relsync_pool && ($BSConfig::relsync_pool->{$arch} || '') ne ($BSConfig::relsync_pool->{$a} || '');
    my $param = {
      'uri' => "$BSConfig::reposerver/build/$projid/$repoid/$a/_relsync",
      'request' => 'POST',
      'data' => $relsyncdata,
    };
    eval {
      BSRPC::rpc($param);
    };
    if ($@) {
      warn($@);
    }
  }
  return $BSStdServer::return_ok;
}

sub putdispatchprios {
  my ($cgi) = @_;
  my $param = {
    'uri' => "$BSConfig::reposerver/build/_dispatchprios",
    'request' => 'PUT',
    'data' => \&BSServer::forward_sender,
    'chunked' => 1,
  };
  return BSWatcher::rpc($param, undef);
}

sub getdispatchprios {
  my ($cgi) = @_;
  my $param = {
    'uri' => "$BSConfig::reposerver/build/_dispatchprios",
    'ignorestatus' => 1,
    'receiver' => \&BSServer::reply_receiver,
  };
  BSWatcher::rpc($param, undef);
  return undef;
}

####################################################################

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

####################################################################

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

  '!rw :' => undef,
  '!- GET:' => undef,
  '!- HEAD:' => undef,

  # /source name space: manage project and package data
  '/source deleted:bool?' => \&getprojectlist,

  'POST:/source/$project cmd=createkey user:? comment:?' => \&createkey,
  'POST:/source/$project cmd=extendkey user:? comment:?' => \&extendkey,
  'POST:/source/$project cmd=undelete user:? comment:?' => \&undeleteproject,
  'POST:/source/$project cmd=copy user:? comment:? oproject:project withbinaries:bool? withhistory:bool?' => \&copyproject,
  'POST:/source/$project cmd: *:*' => \&unknowncmd,
  '/source/$project deleted:bool?' => \&getpackagelist,

  'DELETE:/source/$project user:? comment:?' => \&delproject,
  '/source/$project/_meta rev?' => \&getproject,
  'PUT:/source/$project/_meta user:? comment:?' => \&putproject,

  '/source/$project/_pubkey rev?' => \&getpubkey,
  'DELETE:/source/$project/_pubkey user:? comment:?' => \&deletekey,

  '/source/$project/_config rev?' => \&getprojectconfig,
  'PUT:/source/$project/_config user:? comment:?' => \&putprojectconfig,
  'DELETE:/source/$project/_config user:? comment:?' => \&delprojectconfig,

  '/source/$project/_history rev? meta:bool? deleted:bool? limit:num?' => \&getpackagehistory,

  'POST:/source/$project/$package cmd=diff rev? orev:rev? oproject:project? opackage:package? expand:bool? linkrev? olinkrev:? unified:bool? missingok:bool? meta:bool? file:filename* filelimit:num? tarlimit:num?' => \&sourcediff,
  'POST:/source/$project/$package cmd=linkdiff rev? linkrev? unified:bool? file:filename* filelimit:num? tarlimit:num?' => \&linkdiff,
  'POST:/source/$project/$package cmd=commit rev? user:? comment:? keeplink:bool? repairlink:bool? linkrev? setrev:bool? noservice:bool?' => \&sourcecommit,
  'POST:/source/$project/$package cmd=commitfilelist rev? user:? comment:? keeplink:bool? repairlink:bool? linkrev? setrev:bool? noservice:bool? requestid:num?' => \&sourcecommitfilelist,
  'POST:/source/$project/$package cmd=copy rev? user:? comment:? orev:rev? oproject:project? opackage:package? expand:bool? keeplink:bool? repairlink:bool? linkrev? setrev:linkrev? olinkrev:linkrev? requestid:num? dontupdatesource:bool? withhistory:bool?' => \&sourcecopy,
  'POST:/source/$project/$package cmd=branch rev? user:? comment:? orev:rev? oproject:project? opackage:package? olinkrev:linkrev? force:bool?' => \&sourcebranch,
  'POST:/source/$project/$package cmd=linktobranch rev? user:? comment:? linkrev?' => \&linktobranch,
  'POST:/source/$project/$package cmd=deleteuploadrev' => \&deleteuploadrev,
  'POST:/source/$project/$package cmd=undelete user:? comment:?' => \&undeletepackage,
  'POST:/source/$project/$package cmd=runservice user:? comment:?' => \&runservice,
  'POST:/source/$project/$package cmd=getprojectservices' => \&getprojectservices,
  'POST:/source/$project/$package cmd: *:*' => \&unknowncmd,

  'PUT:/source/$project/$package cmd: rev? user:? comment:?' => \&sourcecommitfilelist,	# obsolete

  '/source/$project/$package rev? linkrev? emptylink:bool? expand:bool? view:? extension:? lastworking:bool? withlinked:bool? meta:bool?' => \&getfilelist,
  '/source/$project/$package/_history rev? meta:bool? deleted:bool? limit:num?' => \&getpackagehistory,
  '/source/$project/$package/_meta rev?' => \&getpackage,
  'PUT:/source/$project/$package/_meta user:? comment:?' => \&putpackage,
  'DELETE:/source/$project/$package user:? comment:?' => \&delpackage,
  '/source/$project/$package/$filename rev?' => \&getfile,
  'PUT:/source/$project/$package/$filename rev? user:? comment:? keeplink:bool? force:bool?' => \&putfile,
  'DELETE:/source/$project/$package/$filename rev? user:? comment:? keeplink:bool? force:bool?' => \&delfile,

  # /published name spec: access published binaries
  '/published' => \&published,
  '/published/$project' => \&published,
  '/published/$project/$repository' => \&published,
  '/published/$project/$repository/$arch:filename view:?' => \&published,
  '/published/$project/$repository/$arch:filename/$filename view:?' => \&published,

  # scheduler calls
  '/getprojpack $project* $repository* $package* $arch? withrepos:bool? withsrcmd5:bool? withdeps:bool? withconfig:bool? expandedrepos:bool? ignoredisable:bool? nopackages:bool? withremotemap:bool? noremote:bool?' => \&getprojpack,
  'POST:/relsync $project $repository $arch' => \&postrelsync,
  '/relsync $project $repository $arch' => \&getrelsync,

  # worker calls
  '/getsources $project $package $srcmd5:md5' => \&getsources,
  '/getconfig $project $repository path:prp*' => \&getbuildconfig,

  '/getsignkey $project withpubkey:bool?' => \&getsignkey,
  '/getbinaries $project $repository $arch binaries: nometa:bool?' => \&worker_getbinaries,
  '/getbinaryversions $project $repository $arch binaries: nometa:bool?' => \&worker_getbinaryversions,
  '!- /lastevents $filter:* start:num? obsname:?' => \&worker_lastevents,
  'POST:/event type: project: package:? repository:? arch:? job:?' => \&newevent,
  # tmp until lightty gets fixed
  '/public/lastevents $filter:* start:num? obsname:?' => \&worker_lastevents,

  # search interface
  '/search $in: $match: return:? values:bool?' => \&search,
  '/search/project $match:' => \&search_proj,
  '/search/project/id $match:' => \&search_proj_id,
  '/search/package $match:' => \&search_pack,
  '/search/package/id $match:' => \&search_pack_id,

  'POST:/search/published cmd:' => \&search_published_updatedb,
  '/search/published/binary/id $match: limit:num?' => \&search_published_binary_id,
  '/search/published/pattern/id $match: limit:num?' => \&search_published_pattern_id,

  # service interface, just for listing for now
  '/service' => \&listservices,
#  '/service/$service' => \&service,

  # build calls for binary files
  '/build' => \&getprojectlist,
  '/build/_workerstatus scheduleronly:bool? arch*' => \&getworkerstatus,
  'PUT:/build/_dispatchprios' => \&putdispatchprios,
  '/build/_dispatchprios' => \&getdispatchprios,
  'POST:/build/$project cmd: repository* arch* package* code:*' => \&docommand,
  '/build/$project' => \&getrepositorylist,
  '/build/$project/_result oldstate:md5? view:resultview* lastbuild:bool? repository* arch* package* code:*' => \&getresult,
  '/build/$project/$repository' => \&getarchlist,
  '/build/$project/$repository/_buildconfig path:prp*' => \&getbuildconfig,
  '/build/$project/$repository/$arch' => \&getpackagelist,
  '/build/$project/$repository/$arch/_builddepinfo package* view:?' => \&getbuilddepinfo,
  '/build/$project/$repository/$arch/_jobhistory package* code:* limit:num?' => \&getjobhistory,
  'POST:/build/$project/$repository/$arch/_repository match:' =>  \&postrepo,
  'POST:/build/$project/$repository/$arch/$package cmd=copy oproject:project? opackage:package? orepository:repository? setupdateinfoid:?' => \&copybuild,
  'POST:/build/$project/$repository/$arch/$package' => \&uploadbuild,
  '/build/$project/$repository/$arch/$package_repository view:? binary:filename* nometa:bool?' => \&getbinarylist,
  'POST:/build/$project/$repository/$arch/$package_repository/_buildinfo add:*' => \&getbuildinfo_post,
  '/build/$project/$repository/$arch/$package/_buildinfo add:* internal:bool?' => \&getbuildinfo,
  '/build/$project/$repository/$arch/$package/_log nostream:bool? start:intnum? end:num? view:?' => \&getlogfile,
  '/build/$project/$repository/$arch/$package/_reason' => \&getbuildreason,
  '/build/$project/$repository/$arch/$package/_status' => \&getbuildstatus,
  '/build/$project/$repository/$arch/$package/_history limit:num?' => \&getbuildhistory,
  '/build/$project/$repository/$arch/$package_repository/$filename view:?' => \&getbinary,
  'PUT:/build/$project/$repository/$arch/_repository/$filename ignoreolder:bool? wipe:bool?' => \&putbinary,
  'DELETE:/build/$project/$repository/$arch/_repository/$filename' => \&delbinary,

  'POST:/request cmd: user:?' => \&createrequest,
  '/request' => \&getrequestlist,
  'POST:/request/$id:num cmd: newstate:? user:? comment:? by_user:? by_group:? by_project:? by_package:? superseded_by:?' => \&postrequest,
  '/request/$id:num' => \&getrequest,
  'PUT:/request/$id:num user:?' => \&putrequest,
  'DELETE:/request/$id:num' => \&delrequest,
  '/search/request $match: limit:num?' => \&search_request,

  '/ajaxstatus' => \&getajaxstatus,
  '/serverstatus' => \&BSStdServer::serverstatus,
];

####################################################################

my $dispatches_ajax = [
  '/' => \&hello,
  '/ajaxstatus' => \&getajaxstatus,
  '/build/$project/_result oldstate:md5? view:resultview* repository* arch* package* code:*' => \&getresult,
  '/build/$project/$repository/$arch/$package/_log nostream:bool? start:intnum? end:num?' => \&getlogfile,
  '/build/$project/$repository/$arch/$package_repository view:? binary:filename* nometa:bool?' => \&getbinarylist,
  '/getbinaries $project $repository $arch binaries: nometa:bool? raw:bool?' => \&worker_getbinaries,
  '/lastevents $filter:* start:num? obsname:?' => \&worker_lastevents,
  '/source/$project/$package rev' => \&getfilelist_ajax,
  '/source/$project/$package:package/$filename rev?' => \&getfile,
];

####################################################################

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,
};

# set a repoid for identification of this data repository
mkdir_p("$projectsdir") unless -d "$projectsdir";
if ( ! -e "$projectsdir/_repoid" ) {
  my $randomid = int(rand(1000000000));
  writestr("$projectsdir/._repoid", "$projectsdir/_repoid", sprintf("%09d", $randomid)) || die ("Unable to initialize the project repository");
}
$repoid = readstr("$projectsdir/_repoid");

BSNotify::notify("SRCSRV_START", $conf);

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



Fixed version (ground truth):
#!/usr/bin/perl -w
#
# Copyright (c) 2006, 2007 Michael Schroeder, Novell Inc.
# Copyright (c) 2008 Adrian Schroeter, 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 Source Server
#

BEGIN {
  my ($wd) = $0 =~ m-(.*)/- ;
  $wd ||= '.';
  chdir($wd);
  unshift @INC,  "$wd/build";
  unshift @INC,  "$wd";
}

use XML::Structured ':bytes';
use POSIX;
use Digest::MD5 ();
use Data::Dumper;
use Storable ();
use Symbol;

use BSConfig;
use BSRPC ':https';
use BSServer;
use BSUtil;
use BSFileDB;
use BSXML;
use BSVerify;
use BSHandoff;
use BSWatcher ':https';
use BSXPath;
use BSStdServer;
use BSSrcdiff;
use Build;
use BSNotify;

use BSXPath;
use BSXPathKeys;
use BSDB;
use BSDBIndex;

use strict;

my $port = 5352;	#'SR'
$port = $1 if $BSConfig::srcserver =~ /:(\d+)$/;
my $proxy;
$proxy = $BSConfig::proxy if defined($BSConfig::proxy);

my $projectsdir = "$BSConfig::bsdir/projects";
my $eventdir = "$BSConfig::bsdir/events";
my $srcrep = "$BSConfig::bsdir/sources";
my $treesdir = $BSConfig::nosharedtrees ? "$BSConfig::bsdir/trees" : $srcrep;
my $requestsdir = "$BSConfig::bsdir/requests";
my $oldrequestsdir = "$BSConfig::bsdir/requests.old";
my $rundir = $BSConfig::rundir || "$BSConfig::bsdir/run";
my $diffcache = "$BSConfig::bsdir/diffcache";

my $reqindexdb = "$BSConfig::bsdir/db/request";
my $extrepodb = "$BSConfig::bsdir/db/published";
my $sourcedb = "$BSConfig::bsdir/db/source";

my $remotecache = "$BSConfig::bsdir/remotecache";

my $srcrevlay = [qw{rev vrev srcmd5 version time user comment requestid}];
my $eventlay = [qw{number time type project package repository arch}];

my $ajaxsocket = "$rundir/bs_srcserver.ajax";
my $uploaddir = "$srcrep/:upload";

my $repoid;
my %packagequota;

sub notify_repservers {
  my ($type, $projid, $packid) = @_;

  my $ev = {'type' => $type, 'project' => $projid};
  $ev->{'package'} = $packid if defined $packid;
  addevent($ev);

  my @args = ("type=$type", "project=$projid");
  push @args, "package=$packid" if defined $packid;
  for my $rrserver ($BSConfig::reposerver) {
    my $param = {
      'uri' => "$rrserver/event",
      'request'   => 'POST',
      'background' => 1,
    };
    eval {
      BSWatcher::rpc($param, undef, @args);
    };
    print "warning: $rrserver: $@" if $@;
  }
}

sub runservice {
  my ($cgi, $projid, $packid) = @_;

  return if $packid eq "_project";
  return unless $BSConfig::serviceserver;
  die("No project defined for source update!") if !defined $projid;
  die("No package defined for source update!") if !defined $packid;

  # collect current sources to POST them
  my $projectrev = getrev($projid, '_project');
  my $projectfiles = lsrev($projectrev);
  my $rev = getrev($projid, $packid);
  my $files = lsrev($rev);
  unless ($files->{'_service'} || $projectfiles->{'_service'}){
    # drop all existing service files
    my $dirty;
    for my $pfile (keys %$files) {
      if ($pfile =~ /^_service[_:]/) {
        delete $files->{$pfile};
        $dirty = 1;
      }
    }
    if ($dirty){
      addrev($projid, $packid, $files, "_service", "generated via source service", undef);
      notify_repservers('package', $projid, $packid);
    }
    return;
  }

  if ($files->{'_link'}) {
    # make sure it's a branch
    my $l = repreadxml($rev, '_link', $files->{'_link'}, $BSXML::link, 1);
    if (!$l || !$l->{'patches'} || @{$l->{'patches'}->{''} || []} != 1 || (keys %{$l->{'patches'}->{''}->[0]})[0] ne 'branch') {
      mkdir_p($uploaddir);
      writestr("$uploaddir/_service_error$$", undef, "services only work on branches\n");
      $files->{'_service_error'} = addfile($projid, $packid, "$uploaddir/_service_error$$", '_service_error');
      addrev($projid, $packid, $files, "_service", "generated via source service", undef);
      notify_repservers('package', $projid, $packid);
      return;
    }
  }

  my $lockfile = "$eventdir/service/${projid}::$packid";
  mkdir_p("$eventdir/service");
  BSUtil::touch($lockfile);

  # Run the source update in own process (do not wait for it)
  my @send = map {{'name' => $_, 'filename' => "$srcrep/$packid/$files->{$_}-$_"}} sort(keys %$files);
  # add _service file from projects with different name
  my ($projectservices, undef) = getprojectservices($cgi, $projid, $packid);
  if ($projectservices) {
    push @send, {'name' => '_serviceproject', 'data' => XMLout($BSXML::services, $projectservices)};
  };
  # run update as background job
  my $pid = xfork();
  return $BSStdServer::return_ok if $pid;
  my $odir = "$srcrep/:service/$$";
  BSUtil::cleandir($odir) if -d $odir;
  mkdir_p($odir);
  my $receive;
  eval {
    $receive = BSRPC::rpc({
      'uri'       => "$BSConfig::serviceserver/sourceupdate/$projid/$packid",
      'request'   => 'POST',
      'headers'   => [ 'Content-Type: application/x-cpio' ],
      'chunked'   => 1,
      'data'      => \&BSHTTP::cpio_sender,
      'cpiofiles' => \@send,
      'directory' => $odir,
      'timeout'   => 3600,
      'withmd5'   => 1,
      'receiver' => \&BSHTTP::cpio_receiver,
    }, undef);
  };

  my $error = $@;
  
  # make sure that there was no other commit in the meantime
  my $newrev = getrev($projid, $packid);
  exit(1) if $newrev->{'rev'} ne $rev->{'rev'};

  # and update source repository with the result
  if ($receive) {
    # drop all existing service files
    for my $pfile (keys %$files) {
      delete $files->{$pfile} if $pfile =~ /^_service[_:]/;
    }
    # add new service files
    for my $pfile (ls($odir)) {
      unless ($pfile =~ /^_service[_:]/) {
	unlink($lockfile);
	die("ERROR: bs_service returned a non-_service file\n");
      }
      BSVerify::verify_filename($pfile);
      $files->{$pfile} = addfile($projid, $packid, "$odir/$pfile", $pfile);
    }
  } else {
    $error ||= 'error';
    $error =~ s/\n$//s;
    $error = "service daemon error: $error\n";
    writestr("$odir/_service_error", undef, $error);
    $files->{'_service_error'} = addfile($projid, $packid, "$odir/_service_error", '_service_error');
  }
  addrev($projid, $packid, $files, "_service", "generated via source service", undef);
  BSUtil::cleandir($odir);
  rmdir($odir);
  unlink($lockfile);
  notify_repservers('package', $projid, $packid);
  exit(0);
}


#
# run the productconverter on _product to create/update/delete
# all _product:xxx packages
#
sub expandproduct {
  my ($projid, $packid, $files, $user, $fail) = @_;

  if (!$files) {
    # gone!
    # {} argument makes findpackages ignore packages from project links
    my @packages = grep {/^\Q${packid}:\E/} findpackages($projid, {});
    for my $opid (@packages) {
      unlink("$projectsdir/$projid.pkg/$opid.upload-MD5SUMS");
      unlink("$projectsdir/$projid.pkg/$opid.rev");
      unlink("$projectsdir/$projid.pkg/$opid.xml");
      notify_repservers('package', $projid, $opid);
    }
    return 1;
  }
  my $dir = "$uploaddir/expandproduct_$$";
  BSUtil::cleandir($dir);
  mkdir_p($dir);
  for my $file (sort keys %$files) {
    link("$srcrep/$packid/$files->{$file}-$file", "$dir/$file") || die("link $srcrep/$packid/$files->{$file}-$file $dir/$file: $!\n");
  }
  my @prods = grep {/.product$/}  sort keys %$files;
  my %pids;
  for my $prod (@prods) {
    print "converting product $prod\n";
    my $odir = "$dir/$prod.out";
    my $olog = "$dir/$prod.logfile";
    system('rm', '-rf', $odir) if -d $odir;
    unlink($olog) if -e $olog;
    mkdir_p($odir);
    # run product converter and read stdout
    my $pid;
    if (!($pid = xfork())) {
      delete $SIG{'__DIE__'};
      open(STDOUT, '>>', $olog) || die("$olog: $!\n");
      open(STDERR, '>&STDOUT');
      $| = 1;
      exec("./bs_productconvert", "$dir/$prod", $odir, $projid);
      die("500 bs_productconvert: $!\n");
    }
    waitpid($pid, 0) == $pid || die("500 waitpid $pid: $!\n");
    if ($?) {
      my $s = readstr($olog);
      $s =~ s/^\n+//s;
      $s =~ s/\n+$//s;
      warn("bs_productconvert failed: $?\n");
      BSUtil::cleandir($dir);
      rmdir($dir);
      die("$s\n") if $fail;
      return undef;
    }
    my @out = sort(ls($odir));
    if (!@out) {
      warn("bs_productconvert produced nothing\n");
      BSUtil::cleandir($dir);
      rmdir($dir);
      return undef;
    }
    for my $p (@out) {
      my $pdir = "$odir/$p";
      my $pid = $p;
      $pid =~ s/^_product[_:]//;
      $pid =~ s/[:\000-\037]/_/sg;
      $pid = "$packid:$pid";
      $pids{$pid} = 1;
      my %pfiles;
      for my $pfile (sort(ls($pdir))) {
        next if $pfile eq '_meta';
	$pfiles{$pfile} = addfile($projid, $pid, "$pdir/$pfile", $pfile);
      }
      my $srcmd5 = addmeta($projid, $pid, \%pfiles);
      my @oldrevs = BSFileDB::fdb_getall("$projectsdir/$projid.pkg/$pid.rev", $srcrevlay);
      if (@oldrevs == 1 && $oldrevs[0]->{'srcmd5'} eq $srcmd5 && $oldrevs[0]->{'rev'}) {
	# we're lucky, no change
	next;
      }
      mkdir_p("$projectsdir/$projid.pkg");
      my $prev = {'srcmd5' => $srcmd5, 'time' => time(), 'user' => $user, 'comment' => 'autogenerated', 'version' => '1', 'vrev' => '1'};
      #unlink("$projectsdir/$projid.pkg/$pid.rev");
      #BSFileDB::fdb_add_i2("$projectsdir/$projid.pkg/$pid.rev", $srcrevlay, $prev, 'vrev', 'version', $prev->{'version'});
      BSFileDB::fdb_add_i("$projectsdir/$projid.pkg/$pid.rev", $srcrevlay, $prev);
      if (! -e "$projectsdir/$projid.pkg/$pid.xml") {
        my $pidpack = {
         'name' => $pid,
         'title' => $pid,
         'description' => "autogenerated from $packid by source server",
        };
	$pidpack = readxml("$pdir/_meta", $BSXML::pack, 0) if ( -e "$pdir/_meta" );
	writexml("$projectsdir/$projid.pkg/.$pid.xml", "$projectsdir/$projid.pkg/$pid.xml", $pidpack, $BSXML::pack);
      }
      rmdir($pdir);
      notify_repservers('package', $projid, $pid);
    }
    rmdir($odir);
  }
  BSUtil::cleandir($dir);
  rmdir($dir);
  # now do away with the old packages
  my @packages = grep {/^\Q${packid}:\E/} findpackages($projid, {});
  @packages = grep {!$pids{$_}} @packages;
  for my $opid (@packages) {
    unlink("$projectsdir/$projid.pkg/$opid.upload-MD5SUMS");
    unlink("$projectsdir/$projid.pkg/$opid.rev");
    unlink("$projectsdir/$projid.pkg/$opid.xml");
    notify_repservers('package', $projid, $opid);
  }
  return 1;
}

#
# return version and release of commit
#
sub getcommitinfo {
  my ($projid, $packid, $srcmd5, $files) = @_;

  # get version/release from rpm spec/deb dsc/kiwi xml file
  my $version = 'unknown';
  my $release;
  if ($files->{'_link'}) {
    # can't know the version/release of a link as it is
    # a moving target
    return ('unknown', '0');
  }
  my $bconf = Build::read_config('noarch');
  for my $type ('spec', 'dsc', 'kiwi') {
    my $rev = {'project' => $projid, 'package' => $packid, 'srcmd5' => $srcmd5};
    my (undef, $file) = findfile($rev, undef, $type, $files);
    next unless defined $file;
    my $d = Build::parse($bconf, "$srcrep/$packid/$files->{$file}-$file");
    next unless defined $d->{'version'};
    $version = $d->{'version'};
    $release = $d->{'release'} if defined $d->{'release'};
    $version = 'unknown' if $d->{'multiversion'};
    last;
  }
  if (defined($release)) {
    if ($release =~ /(\d+)\.<B_CNT>/) {
      $release = $1;
    } elsif ($release =~ /<RELEASE(\d+)>/) {
      $release = $1;
    } elsif ($release =~ /^(\d+)/) {
      $release = $1;
    } else {
      $release = '0';
    }
  }
  $release ||= '0';
  return ($version, $release);
}

sub checksourceaccess {
  my ($projid, $packid) = @_;

  my $proj = readproj($projid, 1);
  return unless $proj;
  my $pack = readpack($projid, $packid, 1);
  my $sourceaccess = 1;
  $sourceaccess = BSUtil::enabled('', $proj->{'sourceaccess'}, $sourceaccess, '');
  $sourceaccess = BSUtil::enabled('', $pack->{'sourceaccess'}, $sourceaccess, '') if $pack;
  die("403 source access denied\n") unless $sourceaccess;
  my $access = 1;
  $access = BSUtil::enabled('', $proj->{'access'}, $access, '');
  $access = BSUtil::enabled('', $pack->{'access'}, $access, '') if $pack;
  die("404 package '$packid' does not exist\n") unless $access;	# hmm...
  return 1;
}

###########################################################################
###
###  low level source handling: tree and revision management
###

sub repgitdir {
  my ($rev) = @_;
  my $projid = $rev->{'project'};
  my $packid = $rev->{'package'};
  my $gitdir = "$projectsdir/$projid.pkg/$packid.git";
  die("$projid/$packid is not a git repository\n") unless -d $gitdir;
  return $gitdir;
}

sub repstat_git {
  my ($rev, $filename, $id) = @_;
  my $gitdir = repgitdir($rev);
  open(F, '-|', 'git', "--git-dir=$gitdir", 'cat-file', '-s', $id) || return ();
  my $size= '';
  1 while sysread(F, $size, 4096, length($size));
  if (!close(F)) {
    $! = POSIX::ENOENT;
    return ();
  }
  my @s = (0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
  $s[7] = 0 + $size;
  return @s;
}

sub repstat {
  my ($rev, $filename, $md5) = @_;
  if (length($md5) == 40) {
    return repstat_git($rev, $filename, $md5);
  }
  return stat("$srcrep/$rev->{'package'}/$md5-$filename");
}

sub repopen_git {
  my ($rev, $filename, $id, $fd) = @_;
  my $gitdir = repgitdir($rev);
  return open($fd, '-|', 'git', "--git-dir=$gitdir", 'cat-file', 'blob', $id);
}

sub repopen {
  my ($rev, $filename, $md5, $fd) = @_;
  if (length($md5) == 40) {
    return repopen_git($rev, $filename, $md5, $fd);
  }
  return open($fd, '<', "$srcrep/$rev->{'package'}/$md5-$filename");
}

sub repreadstr {
  my ($rev, $filename, $md5, $nonfatal) = @_;
  my $packid = $rev->{'package'};
  return readstr("$srcrep/$packid/$md5-$filename", $nonfatal);
}

sub repreadxml {
  my ($rev, $filename, $md5, $dtd, $nonfatal) = @_;
  my $packid = $rev->{'package'};
  return readxml("$srcrep/$packid/$md5-$filename", $dtd, $nonfatal);
}

#
# add a file to the repository
#
sub addfile {
  my ($projid, $packid, $tmpfile, $filename, $md5) = @_;

  if (!$md5) {
    open(F, '<', $tmpfile) || die("$tmpfile: $!\n");
    my $ctx = Digest::MD5->new;
    $ctx->addfile(*F);
    close F;
    $md5 = $ctx->hexdigest();
  }
  if (! -e "$srcrep/$packid/$md5-$filename") {
    if (!rename($tmpfile, "$srcrep/$packid/$md5-$filename")) {
      mkdir_p("$srcrep/$packid");
      rename($tmpfile, "$srcrep/$packid/$md5-$filename") || die("rename $tmpfile $srcrep/$packid/$md5-$filename: $!\n");
    }
  } else {
    unlink($tmpfile);
  }
  return $md5;
}

#
# make files available in oprojid/opackid available from projid/packid
#
sub copyfiles {
  my ($projid, $packid, $oprojid, $opackid, $files, $except) = @_;

  return if $packid eq $opackid;
  return unless %$files;
  mkdir_p("$srcrep/$packid");
  for my $f (sort keys %$files) {
    next if $except && $except->{$f};
    next if -e "$srcrep/$packid/$files->{$f}-$f";
    link("$srcrep/$opackid/$files->{$f}-$f", "$srcrep/$packid/$files->{$f}-$f");
    die("link error $srcrep/$opackid/$files->{$f}-$f\n") unless -e "$srcrep/$packid/$files->{$f}-$f";
  }
}

sub getrev_git {
  my ($projid, $packid, $rev) = @_;
  my $gitdir = "$projectsdir/$projid.pkg/$packid.git";
  die("$projid/$packid is not a git repository") unless -d $gitdir;
  if (!$rev) {
    my $master = readstr("$gitdir/refs/heads/master");
    chomp $master;
    $rev = $master;
  }
  die("revision is not a valid git id\n") unless $rev =~ /^[0-9a-f]{40}/s;
  open(F, '-|', 'git', "--git-dir=$gitdir", 'cat-file', 'commit', $rev) || return undef;
  my $commit = '';
  1 while sysread(F, $commit, 4096, length($commit));
  close F;
  $commit =~ s/.*?\n\n//;
  $rev = {'project' => $projid, 'package' => $packid, 'rev' => $rev, 'srcmd5' => $rev};
  $rev->{'comment'} = $commit if $commit ne '';
  return $rev;
}

#
# get a revision object from a revision identifier
#
sub getrev {
  my ($projid, $packid, $rev, $linked, $missingok) = @_;
  die("bad projid\n") if $projid =~ /\// || $projid =~ /^\./;
  die("bad packid\n") if $packid =~ /\// || $packid =~ /^\./;
  if ($packid ne '_project' && ! -e "$projectsdir/$projid.pkg/$packid.xml") {
    my $proj = readproj($projid, 1);
    if ($proj && $proj->{'link'}) {
      $linked ||= [];
      for my $lprojid (map {$_->{'project'}} @{$proj->{'link'}}) {
	next if $lprojid eq $projid;
	next if grep {$_->{'project'} eq $lprojid && $_->{'package'} eq $packid} @$linked;
	push @$linked, {'project' => $lprojid, 'package' => $packid};
	my $lrev;
	eval {
	  $lrev = getrev($lprojid, $packid, $rev, $linked, $missingok);
	};
	die($@) if $@ && $@ !~ /^404/;
	if ($lrev) {
	  # make sure that we may access the sources of this package
	  checksourceaccess($lprojid, $packid);
	  my $files = lsrev($lrev);
	  copyfiles($projid, $packid, $lprojid, $packid, $files);
	  addmeta($projid, $packid, $files) if $BSConfig::nosharedtrees;
	  $lrev->{'originproject'} ||= $lprojid;
	  $lrev->{'project'} = $projid;
	  return $lrev;
	}
      }
    }
    return remote_getrev($projid, $packid, $rev, $linked, $missingok);
  }
  undef $rev if $rev && ($rev eq 'latest' || $rev eq 'build');
  undef $rev if $rev && $rev eq 'upload' && ! -e "$projectsdir/$projid.pkg/$packid.upload-MD5SUMS";
  if (!defined($rev)) {
    $rev = BSFileDB::fdb_getlast("$projectsdir/$projid.pkg/$packid.rev", $srcrevlay);
    if (!$rev && -d "$projectsdir/$projid.pkg/$packid.git") {
      return getrev_git($projid, $packid);
    }
    $rev = {'srcmd5' => 'empty'} unless $rev;
  } elsif ($rev =~ /^[0-9a-f]{32}$/) {
    return undef unless -e "$projectsdir/$projid.pkg/$packid.rev" || -e "$projectsdir/$projid.pkg/$packid.mrev";
    $rev = {'srcmd5' => $rev, 'rev' => $rev};
  } elsif ($rev =~ /^[0-9a-f]{40}$/) {
    return getrev_git($projid, $packid, $rev);
  } elsif ($rev eq 'upload') {
    $rev = {'srcmd5' => 'upload', 'rev' => 'upload'}
  } elsif ($rev eq 'repository') {
    $rev = {'srcmd5' => 'empty', 'rev' => 'repository'}
  } else {
    if ($rev eq '0') {
      $rev = {'srcmd5' => 'empty'};
    } else {
      $rev = BSFileDB::fdb_getmatch("$projectsdir/$projid.pkg/$packid.rev", $srcrevlay, 'rev', $rev);
      die("no such revision\n") unless defined $rev;
    }
  }
  $rev->{'project'} = $projid;
  $rev->{'package'} = $packid;
  return $rev;
}

sub addmeta {
  my ($projid, $packid, $files, $rev) = @_;

  # calculate new meta sum
  my $meta = '';
  $meta .= "$files->{$_}  $_\n" for sort keys %$files;
  my $srcmd5 = Digest::MD5::md5_hex($meta);
  if ($rev && $rev eq 'upload') {
    mkdir_p($uploaddir);
    mkdir_p("$projectsdir/$projid.pkg");
    writestr("$uploaddir/addmeta$$", "$projectsdir/$projid.pkg/$packid.upload-MD5SUMS", $meta);
  } else {
    my $treedir = $BSConfig::nosharedtrees ? "$treesdir/$projid/$packid" : "$treesdir/$packid";
    if (! -e "$treedir/$srcmd5-MD5SUMS") {
      mkdir_p($uploaddir);
      mkdir_p($treedir);
      writestr("$uploaddir/addmeta$$", "$treedir/$srcmd5-MD5SUMS", $meta);
    }
  }
  return $srcmd5;
}

# like addmeta, but adds link information. also stores
# under the "wrong" md5sum.
sub addmeta_link {
  my ($projid, $packid, $files, $srcmd5, $linkinfo) = @_;

  my $treedir = $BSConfig::nosharedtrees ? "$treesdir/$projid/$packid" : "$treesdir/$packid";
  if (! -e "$treedir/$srcmd5-MD5SUMS") {
    my $meta = '';
    $meta .= "$files->{$_}  $_\n" for sort keys %$files;
    $meta .= "$linkinfo->{'srcmd5'}  /LINK\n";
    $meta .= "$linkinfo->{'lsrcmd5'}  /LOCAL\n";
    mkdir_p($uploaddir);
    mkdir_p($treedir);
    writestr("$uploaddir/$$", "$treedir/$srcmd5-MD5SUMS", $meta);
  }
}


sub updatelinkinfodb {
  my ($projid, $packid, $rev, $files) = @_;

  mkdir_p($sourcedb) unless -d $sourcedb;
  my $linkdb = BSDB::opendb($sourcedb, 'linkinfo');
  my $linkinfo;
  if ($files && $files->{'_link'}) {
    my $l = repreadxml($rev, '_link', $files->{'_link'}, $BSXML::link, 1);
    if ($l) {
      $linkinfo = {};
      $linkinfo->{'project'} = defined $l->{'project'} ? $l->{'project'} : $projid;
      $linkinfo->{'package'} = defined $l->{'package'} ? $l->{'package'} : $packid;
      $linkinfo->{'rev'} = $l->{'rev'} if defined $l->{'rev'};
    }
  }
  $linkdb->store("$projid/$packid", $linkinfo);
}

#
# create a new revision from a file list, returns revision object
#
sub addrev {
  my ($projid, $packid, $files, $user, $comment, $target, $requestid) = @_;
  die("404 project '$projid' does not exist\n") unless -e "$projectsdir/$projid.xml";
  die("403 package '$packid' is read-only\n") if $packid =~ /^_product:/;
  if ($packid eq '_pattern' || ! -e "$projectsdir/$projid.pkg/$packid.xml") {
    # upgrade pseudo _pattern package to real package
    my $pack = {
      'name' => $packid,
      'project' => $projid,
      'title' => 'pseudo package to store pattern information',
      'description' => "pseudo package to store pattern information\n",
    };
    mkdir_p($uploaddir);
    writexml("$uploaddir/$$.2", undef, $pack, $BSXML::pack);
    mkdir_p("$projectsdir/$projid.pkg");
    addrev_meta({'user' => $user}, $projid, $packid, "$uploaddir/$$.2", "$projectsdir/$projid.pkg/$packid.xml", '_meta');
  }
  die("404 package '$packid' does not exist\n") unless $packid eq '_project' || -e "$projectsdir/$projid.pkg/$packid.xml";
  if ($target && $target eq 'upload') {
    my $srcmd5 = addmeta($projid, $packid, $files, 'upload');
    my $filenames = join( ', ', keys %$files );
    BSNotify::notify("SRCSRV_UPLOAD", {project => $projid, package => $packid, filename => $filenames, comment => $comment, 
                                       target => $target, request_id => $requestid, user => $user});
    return {'project' => $projid, 'package' => $packid, 'rev' => 'upload', 'srcmd5' => $srcmd5};
  } elsif ($target && $target eq 'repository') {
    # repository only upload.
    return {'project' => $projid, 'package' => $packid, 'rev' => 'repository', 'srcmd5' => 'empty'};
  } elsif (defined($target)) {
    # internal version only upload.
    my $srcmd5 = addmeta($projid, $packid, $files);
    return {'project' => $projid, 'package' => $packid, 'rev' => $srcmd5, 'srcmd5' => $srcmd5};
  }
  die("bad projid\n") if $projid =~ /\// || $projid =~ /^\./;
  die("bad packid\n") if $packid =~ /\// || $packid =~ /^\./;
  die("bad files\n") if grep {/\//} keys %$files;
  die("bad files\n") if grep {!/^[0-9a-f]{32}$/} values %$files;

  if ($packid eq '_product') {
    expandproduct($projid, $packid, $files, $user, 1);
  }
  if ($files->{'_patchinfo'}) {
    die("bad files in patchinfo container\n") if grep {$_ ne '_patchinfo'} keys %$files;
    my $p = repreadxml({'project' => $projid, 'package' => $packid}, '_patchinfo', $files->{'_patchinfo'}, $BSXML::patchinfo);
    BSVerify::verify_patchinfo($p);
  }

  my $srcmd5 = addmeta($projid, $packid, $files);
  $user = '' unless defined $user;
  $user = 'unknown' if $user eq '';
  $comment = '' unless defined $comment;
  $user = str2utf8xml($user);
  $comment = str2utf8xml($comment);
  my $rev = {'srcmd5' => $srcmd5, 'time' => time(), 'user' => $user, 'comment' => $comment, 'requestid' => $requestid};
  if ($packid ne '_project' && $packid ne '_pattern') {
    my ($version, $release) = getcommitinfo($projid, $packid, $srcmd5, $files);
    $rev->{'version'} = $version;
    $rev->{'vrev'} = $release;
  }
  
  my $rev_old = getrev($projid, $packid);
  my $files_old = lsrev($rev_old);
  my $filestr = BSNotify::generate_commit_flist($files_old, $files);

  my $acceptinfo;
  if ($requestid) {
    $acceptinfo = {};
    $acceptinfo->{'osrcmd5'} = $rev_old->{'srcmd5'} if $rev_old->{'srcmd5'} ne 'empty';
    if ($files_old->{'_link'}) {
      # see if we can expand it
      eval {
	my %rev = %$rev_old;
	handlelinks(\%rev, $files_old);
	$acceptinfo->{'oxsrcmd5'} = $rev{'srcmd5'};
      };
    }
  }
  if ($packid eq '_project') {
    $rev = BSFileDB::fdb_add_i("$projectsdir/$projid.pkg/$packid.rev", $srcrevlay, $rev);
    $rev->{'project'} = $projid;
    $rev->{'package'} = $packid;
    if ($acceptinfo) {
      $acceptinfo->{'rev'} = $rev->{'rev'};
      $acceptinfo->{'srcmd5'} = $rev->{'srcmd5'};
      addacceptinfo($requestid, $projid, $packid, $acceptinfo);
    }
    extract_old_prjsource($projid, $rev);
    unlink("$projectsdir/$projid.pkg/$packid.upload-MD5SUMS");
    notify_repservers('project', $projid);
    BSNotify::notify("SRCSRV_UPDATE_PROJECT_CONFIG", { "project" => $projid, "files" => $filestr, "comment" => $comment, "sender" => $user });
    return $rev;
  }

  # help a little with link<->nolink and singleversion<->multiversion changes
  if ($rev->{'version'} && $rev_old->{'version'}) {
    # if this is a known -> unknown version change, max with vrev of last commit
    if ($rev->{'version'} eq 'unknown' && $rev_old->{'version'} ne 'unknown') {
      $rev->{'vrev'} = $rev_old->{'vrev'} + 1 if $rev_old->{'vrev'} + 1 > $rev->{'vrev'};
    }
    # same for unknown -> known
    if ($rev->{'version'} ne 'unknown' && $rev_old->{'version'} eq 'unknown') {
      $rev->{'vrev'} = $rev_old->{'vrev'} + 1 if $rev_old->{'vrev'} + 1 > $rev->{'vrev'};
    }
  }

  if (defined($rev->{'version'})) {
    $rev = BSFileDB::fdb_add_i2("$projectsdir/$projid.pkg/$packid.rev", $srcrevlay, $rev, 'vrev', 'version', $rev->{'version'});
  } else {
    $rev = BSFileDB::fdb_add_i("$projectsdir/$projid.pkg/$packid.rev", $srcrevlay, $rev);
  }

  # add missing data to complete the revision object
  $rev->{'project'} = $projid;
  $rev->{'package'} = $packid;

  # update linked package database
  updatelinkinfodb($projid, $packid, $rev, $files);

  # update request acceptinfo
  if ($acceptinfo) {
    $acceptinfo->{'rev'} = $rev->{'rev'};
    $acceptinfo->{'srcmd5'} = $rev->{'srcmd5'};
    if ($files->{'_link'}) {
      # see if we can expand it
      eval {
	my %rev = %$rev;
	handlelinks(\%rev, $files);
	$acceptinfo->{'xsrcmd5'} = $rev{'srcmd5'};
      };
    }
    addacceptinfo($requestid, $projid, $packid, $acceptinfo);
  }

  # send out hermes notification
  BSNotify::notify("SRCSRV_COMMIT", {project => $projid, package => $packid, files => $filestr, rev => $rev->{'rev'}, user => $user, comment => $comment});
  $rev_old->{'version'} = "unknown" unless defined($rev_old->{'version'});
  BSNotify::notify("SRCSRV_VERSION_CHANGE", {project => $projid, package => $packid, files => $filestr, rev => $rev->{'rev'},
                                             oldversion => $rev_old->{'version'}, newversion => $rev->{'version'}, user => $user, comment => $comment})
    if $rev->{'version'} && $rev_old->{'version'} && $rev->{'version'} ne $rev_old->{'version'};

  # kill upload revision as we did a real commit
  unlink("$projectsdir/$projid.pkg/$packid.upload-MD5SUMS");
  # kill obsolete _pattern file
  unlink("$projectsdir/$projid.pkg/pattern-MD5SUMS") if $packid eq '_pattern';

  notify_repservers('package', $projid, $packid);
  return $rev;
}

sub lsrev_git {
  my ($rev, $linkinfo) = @_;
  my $id = $rev->{'srcmd5'};
  local *F;
  my $gitdir = repgitdir($rev);
  open(F, '-|', 'git', "--git-dir=$gitdir", 'cat-file', 'tree', $id) || die("git: $!\n");
  my $tree = '';
  1 while sysread(F, $tree, 4096, length($tree));
  close(F) || die("bad id\n");
  my $files = {};
  while ($tree =~ /(\d+) ([^\000]*)\000(.{20})/sg) {
    next if $1 eq '40000';		# ignore dirs for now
    next if substr($2, 0, 1) eq '.';	# ignore files starting with . for now
    $files->{$2} = unpack('H*', $3);
  }
  return $files;
}

#
# retrieve the file list of a revision object or tree object
# store merge info in linkinfo if available
#
sub lsrev {
  my ($rev, $linkinfo) = @_;

  die("nothing known\n") unless $rev;
  my $projid = $rev->{'project'};
  my $packid = $rev->{'package'};
  my $srcmd5 = $rev->{'srcmd5'};
  die("revision project missing\n") unless defined $projid;
  die("revision package missing\n") unless defined $packid;
  die("no such revision\n") unless defined $srcmd5;
  local *F;
  die("bad packid\n") if $packid =~ /\// || $packid =~ /^\./;
  if ($srcmd5 eq 'upload') {
    open(F, '<', "$projectsdir/$projid.pkg/$packid.upload-MD5SUMS") || die("$packid/$srcmd5-$packid: not in repository\n");
  } elsif ($srcmd5 eq 'pattern') {
    open(F, '<', "$projectsdir/$projid.pkg/pattern-MD5SUMS") || return {};
  } elsif ($srcmd5 eq 'empty' || $srcmd5 eq 'd41d8cd98f00b204e9800998ecf8427e') {
    return {};
  } elsif (length($srcmd5) == 40) {
     return lsrev_git($rev, $linkinfo);
  } else {
    die("bad srcmd5 '$srcmd5'\n") if $srcmd5 !~ /^[0-9a-f]{32}$/;
    my $treedir = $BSConfig::nosharedtrees ? "$treesdir/$projid/$packid" : "$treesdir/$packid";
    if ($BSConfig::nosharedtrees && $BSConfig::nosharedtrees == 2 && ! -e "$treedir/$srcmd5-MD5SUMS") {
      $treedir = "$srcrep/$packid";
    }
    if (!open(F, '<', "$treedir/$srcmd5-MD5SUMS")) {
      return {'_linkerror' => $srcmd5} if -e "$srcrep/$packid/$srcmd5-_linkerror";
      die("$projid/$packid/$srcmd5: not in repository. Either not existing or misconfigured server setting for '\$nosharedtrees' setting in BSConfig.pm\n");
    }
  }
  my @files = <F>;
  close F;
  chomp @files;
  my $files = {map {substr($_, 34) => substr($_, 0, 32)} @files};
  # hack: do not list _signkey in project meta
  delete $files->{'_signkey'} if $packid eq '_project';
  if ($linkinfo) {
    $linkinfo->{'lsrcmd5'} = $files->{'/LOCAL'} if $files->{'/LOCAL'};
    $linkinfo->{'srcmd5'} = $files->{'/LINK'} if $files->{'/LINK'};
  }
  delete $files->{'/LINK'};
  delete $files->{'/LOCAL'};
  return $files;
}


# find last revision that consisted of the tree object
sub findlastrev {
  my ($tree) = @_;
  my $rev = BSFileDB::fdb_getmatch("$projectsdir/$tree->{'project'}.pkg/$tree->{'package'}.rev", $srcrevlay, 'srcmd5', $tree->{'srcmd5'});
  return undef unless $rev;
  $rev->{'project'} = $tree->{'project'};
  $rev->{'package'} = $tree->{'package'};
  return $rev;
}



###########################################################################
###
###  source link handling
###

sub patchspec {
  my ($p, $dir, $spec) = @_;
  local *F;
  open(F, '<', "$dir/$spec") || die("$dir/$spec: $!\n");
  my @preamble;
  while(<F>) {
    chomp;
    push @preamble, $_;
    last if /^\s*%(package|prep|build|install|check|clean|preun|postun|pretrans|posttrans|pre|post|files|changelog|description|triggerpostun|triggerun|triggerin|trigger|verifyscript)(\s|$)/;
  }
  my %patches;
  for (@preamble) {
    next unless /^patch(\d*)\s*:/i;  
    $patches{0 + ($1 eq '' ? 0 : $1)} = $_;
  }
  my @patches = sort {$a <=> $b} keys %patches;
  my $nr = 0;
  if (exists $p->{'after'}) {
    $nr = 0 + $p->{'after'};
    $nr++ while $patches{$nr};
  } else {
    $nr = $patches[-1] + 1 if @patches;
  }
  my @after;
  @after = map {$patches{$_}} grep {$_ < $nr} @patches if @patches;
  @after = grep {/^source(\d*)\s*:/i} @preamble if !@after;
  @after = grep {/^name(\d*)\s*:/i} @preamble if !@after;
  @after = $preamble[-2] if @preamble > 1 && !@after;
  return "could not find a place to insert the patch" if !@after;
  my $nrx = $nr;
  $nrx = '' if $nrx == 0;
  local *O;
  open(O, '>', "$dir/.patchspec$$") || die("$dir/.patchspec$$: $!\n");
  for (@preamble) {
    print O "$_\n";
    next unless @after && $_ eq $after[-1];
    print O "Patch$nrx: $p->{'name'}\n";
    @after = ();
  }
  if ($preamble[-1] !~ /^\s*%prep(\s|$)/) {
    while (1) {
      my $l = <F>;
      return "specfile has no %prep section" if !defined $l;
      chomp $l;
      print O "$l\n";
      last if $l =~ /^\s*%prep(\s|$)/;
    }
  }
  my @prep;
  while(<F>) {
    chomp;
    push @prep, $_;
    last if /^\s*%(package|prep|build|install|check|clean|preun|postun|pretrans|posttrans|pre|post|files|changelog|description|triggerpostun|triggerun|triggerin|trigger|verifyscript)(\s|$)/;
  }
  %patches = ();
  my $ln = -1;
  # find outmost pushd/popd calls and insert new patches after a pushd/popd block
  # $blevel == 0 indicates the outmost block
  my %bend = ();
  my $bln = undef;
  $$bln = $ln;
  my $blevel = -1;
  for (@prep) {
    $ln++;
    $blevel++ if /^pushd/;
    if (/^popd/) {
      unless ($blevel) {
        $$bln = $ln;
        undef $bln;
        $$bln = $ln;
      }
      $blevel--;
    }
    next unless /%patch(\d*)(.*)/;
    if ($1 ne '') {
      $patches{0 + $1} = $ln;
      $bend{0 + $1} = $bln if $blevel >= 0;
      next;
    }
    my $pnum = 0;
    my @a = split(' ', $2);
    if (! grep {$_ eq '-P'} @a) {
      $patches{$pnum} = $ln;
    } else {
      while (@a) {
        next if shift(@a) ne '-P';
        next if !@a || $a[0] !~ /^\d+$/;
        $pnum = 0 + shift(@a);
        $patches{$pnum} = $ln;
      }
    }
    $bend{$pnum} = $bln if $blevel >= 0;
  }
  return "specfile has broken %prep section" unless $blevel == -1;
  @patches = sort {$a <=> $b} keys %patches;
  $nr = 1 + $p->{'after'} if exists $p->{'after'};
  %patches = map { $_ => exists $bend{$_} ? ${$bend{$_}} : $patches{$_} } @patches;
  @after = map {$patches{$_}} grep {$_ < $nr} @patches if @patches;
  @after = ($patches[0] - 1) if !@after && @patches;
  @after = (@prep - 2) if !@after;
  my $after = $after[-1];
  $after = -1 if $after < -1;
  $ln = -1;
  push @prep, '' if $after >= @prep;
  #print "insert %patch after line $after\n";
  for (@prep) {
    if (defined($after) && $ln == $after) {
      print O "pushd $p->{'dir'}\n" if exists $p->{'dir'};
      if ($p->{'popt'}) {
        print O "%patch$nrx -p$p->{'popt'}\n";
      } else {
        print O "%patch$nrx\n";
      }
      print O "popd\n" if exists $p->{'dir'};
      undef $after;
    }
    print O "$_\n";
    $ln++;
  }
  while(<F>) {
    chomp;
    print O "$_\n";
  }
  close(O) || die("close: $!\n");
  rename("$dir/.patchspec$$", "$dir/$spec") || die("rename $dir/.patchspec$$ $dir/$spec: $!\n");
  return '';
}
# " Make emacs wired syntax highlighting happy

sub topaddspec {
  my ($p, $dir, $spec) = @_;
  local (*F, *O);
  open(F, '<', "$dir/$spec") || die("$dir/$spec: $!\n");
  open(O, '>', "$dir/.topaddspec$$") || die("$dir/.topaddspec$$: $!\n");
  my $text = $p->{'text'};
  $text = '' if !defined $text;
  $text .= "\n" if $text ne '' && substr($text, -1, 1) ne "\n";
  print O $text;
  while(<F>) {
    chomp;
    print O "$_\n";
  }
  close(O) || die("close: $!\n");
  rename("$dir/.topaddspec$$", "$dir/$spec") || die("rename $dir/.topaddspec$$ $dir/$spec: $!\n");
}

#
# apply a single link step
# store the result under the identifier "$md5"
#
# if "$md5" is not set, store the result in "$uploaddir/applylink$$"
#
sub applylink {
  my ($md5, $lsrc, $llnk) = @_;
  if ($md5 && -e "$srcrep/$llnk->{'package'}/$md5-_linkerror") {
    # no need to do all the work again...
    my $log = readstr("$srcrep/$llnk->{'package'}/$md5-_linkerror", 1);
    $log ||= "unknown error";
    chomp $log;
    $log =~ s/.*\n//s;
    $log ||= "unknown error";
    return $log;
  }
  my $flnk = lsrev($llnk);
  my $fsrc = lsrev($lsrc);
  my $l = $llnk->{'link'};
  my $patches = $l->{'patches'} || {};
  my @patches = ();
  my $simple = 1;
  my @simple_delete;
  my $isbranch;
  if ($l->{'patches'}) {
    for (@{$l->{'patches'}->{''} || []}) {
      my $type = (keys %$_)[0];
      if (!$type) {
	$simple = 0;
	next;
      }
      if ($type eq 'topadd') {
        push @patches, { 'type' => $type, 'text' => $_->{$type}};
	$simple = 0;
      } elsif ($type eq 'delete') {
        push @patches, { 'type' => $type, %{$_->{$type} || {}}};
	push @simple_delete, $patches[-1]->{'name'};
      } else {
        push @patches, { 'type' => $type, %{$_->{$type} || {}}};
	$simple = 0;
	$isbranch = 1 if $type eq 'branch';
      }
    }
  }
  $simple = 0 unless $md5;
  if ($simple) {
    # simple source link with no patching
    # copy all files but the ones we have locally
    copyfiles($llnk->{'project'}, $llnk->{'package'}, $lsrc->{'project'}, $lsrc->{'package'}, $fsrc, $flnk);
    # calculate meta
    my $newf = { %$fsrc };
    for my $f (sort keys %$flnk) {
      $newf->{$f} = $flnk->{$f} unless $f eq '_link';
    }
    delete $newf->{$_} for @simple_delete;
    # store filelist in md5
    my $linkinfo = {
      'srcmd5'  => $lsrc->{'srcmd5'},
      'lsrcmd5' => $llnk->{'srcmd5'},
    };
    addmeta_link($llnk->{'project'}, $llnk->{'package'}, $newf, $md5, $linkinfo);
    return '';
  }

  # sanity checking...
  for my $p (@patches) {
    return "patch has no type" unless exists $p->{'type'};
    return "patch has illegal type \'$p->{'type'}\'" unless $p->{'type'} eq 'apply' || $p->{'type'} eq 'add' || $p->{'type'} eq 'topadd' || $p->{'type'} eq 'delete' || $p->{'type'} eq 'branch';
    if ($p->{'type'} ne 'topadd' && $p->{'type'} ne 'delete' && $p->{'type'} ne 'branch') {
      return "patch has no patchfile" unless exists $p->{'name'};
      return "patch \'$p->{'name'}\' does not exist" unless $flnk->{$p->{'name'}};
    }
  }
  my $tmpdir = "$uploaddir/applylink$$";
  mkdir_p($tmpdir);
  die("$tmpdir: $!\n") unless -d $tmpdir;
  unlink("$tmpdir/$_") for ls($tmpdir);	# remove old stuff
  my %apply = map {$_->{'name'} => 1} grep {$_->{'type'} eq 'apply'} @patches;
  $apply{$_} = 1 for keys %{$llnk->{'ignore'} || {}};	# also ignore those files, used in keeplink
  my %fl;
  if (!$isbranch) {
    for my $f (sort keys %$fsrc) {
      next if $flnk->{$f} && !$apply{$f};
      link("$srcrep/$lsrc->{'package'}/$fsrc->{$f}-$f", "$tmpdir/$f") || die("$f: $!\n");
      $fl{$f} = "$lsrc->{'package'}/$fsrc->{$f}-$f";
    }
    for my $f (sort keys %$flnk) {
      next if $apply{$f} || $f eq '_link';
      link("$srcrep/$llnk->{'package'}/$flnk->{$f}-$f", "$tmpdir/$f") || die("$f: $!\n");
      $fl{$f} = "$llnk->{'package'}/$flnk->{$f}-$f";
    }
  }
  my $failed;
  for my $p (@patches) {
    my $pn = $p->{'name'};
    if ($p->{'type'} eq 'delete') {
      unlink("$tmpdir/$pn");
      next;
    }
    if ($p->{'type'} eq 'branch') {
      # flnk: mine
      # fbas: old
      # fsrc: new
      my $baserev = $l->{'baserev'};
      return "no baserev in branch patch" unless $baserev;
      return "baserev is not srcmd5" unless $baserev =~ /^[0-9a-f]{32}$/s;
      my %brev = (%$lsrc, 'srcmd5' => $baserev);
      my $fbas;
      eval {
        $fbas = lsrev(\%brev);
      };
      return "baserev $baserev does not exist" unless $fbas;
      return "baserev is link" if $fbas->{'link'};

      # ignore linked generated service files if our link contains a service
      if ($flnk->{'_service'}) {
	delete $fbas->{$_} for grep {/^_service[:_]/} keys %$fbas;
	delete $fsrc->{$_} for grep {/^_service[:_]/} keys %$fsrc;
      }
      # do 3-way merge
      my %destnames = (%$fsrc, %$flnk);
      delete $destnames{'_link'};
      for my $f (sort {length($a) <=> length($b) || $a cmp $b} keys %destnames) {
	my $mbas = $fbas->{$f} || '';
	my $msrc = $fsrc->{$f} || '';
	my $mlnk = $flnk->{$f} || '';
	if ($mbas eq $mlnk) {
	  next if $msrc eq '';
	  link("$srcrep/$lsrc->{'package'}/$fsrc->{$f}-$f", "$tmpdir/$f") || die("$fsrc->{$f}-$f: $!\n");
	  $fl{$f} = "$lsrc->{'package'}/$fsrc->{$f}-$f";
	  next;
	}
	if ($mbas eq $msrc || $mlnk eq $msrc) {
	  next if $mlnk eq '';
	  link("$srcrep/$llnk->{'package'}/$flnk->{$f}-$f", "$tmpdir/$f") || die("$flnk->{$f}-$f: $!\n");
	  $fl{$f} = "$llnk->{'package'}/$flnk->{$f}-$f";
	  next;
	}
	if ($mbas eq '' || $msrc eq '' || $mlnk eq '') {
	  $failed = "conflict in file $f";
	  last;
	}
        # run diff3
	link("$srcrep/$lsrc->{'package'}/$fsrc->{$f}-$f", "$tmpdir/$f.new") || die("link $fsrc->{$f}-$f: $!\n");
	link("$srcrep/$lsrc->{'package'}/$fbas->{$f}-$f", "$tmpdir/$f.old") || die("link $fbas->{$f}-$f: $!\n");
	link("$srcrep/$llnk->{'package'}/$flnk->{$f}-$f", "$tmpdir/$f.mine") || die("link $flnk->{$f}-$f: $!\n");
	if (!isascii("$tmpdir/$f.new") || !isascii("$tmpdir/$f.old") || !isascii("$tmpdir/$f.mine")) {
	  $failed = "conflict in file $f";
	  last;
	}
	my $pid;
	if (!($pid = xfork())) {
	  delete $SIG{'__DIE__'};
	  chdir($tmpdir) || die("$tmpdir: $!\n");
	  open(STDERR, '>>', ".log") || die(".log: $!\n");
	  open(STDOUT, '>', $f) || die("$f: $!\n");
          print STDERR "running diff3 on $f\n";
	  exec('/usr/bin/diff3', '-m', '-E', "$f.mine", "$f.old", "$f.new");
	  die("/usr/bin/diff3: $!\n");
	}
	waitpid($pid, 0) == $pid || die("waitpid $pid: $!\n");
	if ($?) {
	  $failed = "conflict in file $f";
	  last;
	}
	unlink("$tmpdir/$f.old");
	unlink("$tmpdir/$f.new");
	unlink("$tmpdir/$f.mine");
      }
      last if $failed;
      next;
    }
    if ($p->{'type'} eq 'add') {
      for my $spec (grep {/\.spec$/} ls($tmpdir)) {
	local *F;
	open(F, '>>', "$tmpdir/.log") || die("$tmpdir/.log: $!\n");
	print F "adding patch $pn to $spec\n";
	close F;
        my $err = patchspec($p, $tmpdir, $spec);
        if ($err) {
	  open(F, '>>', "$tmpdir/.log") || die("$tmpdir/.log: $!\n");
	  print F "error: $err\n";
	  close F;
	  $failed = "could not add patch '$pn'";
	  last;
	  unlink("$tmpdir/$_") for ls($tmpdir);
	  rmdir($tmpdir);
	  return "could not add patch '$pn'";
	}
        delete $fl{$spec};
      }
      last if $failed;
      next;
    }
    if ($p->{'type'} eq 'topadd') {
      for my $spec (grep {/\.spec$/} ls($tmpdir)) {
	local *F;
	open(F, '>>', "$tmpdir/.log") || die("$tmpdir/.log: $!\n");
	print F "adding text at top of $spec\n";
	close F;
        topaddspec($p, $tmpdir, $spec);
        delete $fl{$spec};
      }
      next;
    }
    next unless $p->{'type'} eq 'apply';
    my $pid;
    if (!($pid = xfork())) {
      delete $SIG{'__DIE__'};
      chdir($tmpdir) || die("$tmpdir: $!\n");
      open(STDIN, '<', "$srcrep/$llnk->{'package'}/$flnk->{$pn}-$pn") || die("$srcrep/$llnk->{'package'}/$flnk->{$pn}-$pn: $!\n");
      open(STDOUT, '>>', ".log") || die(".log: $!\n");
      open(STDERR, '>&STDOUT');
      $| = 1;
      print "applying patch $pn\n";
      $::ENV{'TMPDIR'} = '.';
      # Old patch command still supported --unified-reject-files and --global-reject-file.
      # exec('/usr/bin/patch', '--no-backup-if-mismatch', '--unified-reject-files', '--global-reject-file=.rejects', '-g', '0', '-f');
      exec('/usr/bin/patch', '--no-backup-if-mismatch', '-g', '0', '-f');
      die("/usr/bin/patch: $!\n");
    }
    waitpid($pid, 0) == $pid || die("waitpid $pid: $!\n");
    if ($?) {
      $failed = "could not apply patch '$pn'";
      last;
    }
  }
  if ($failed) {
    local *F;
    # add result as last line
    open(F, '>>', "$tmpdir/.log") || die("$tmpdir/.log: $!\n");
    print F "\n$failed\n";
    close F;
    # link error marker
    if ($md5 && !link("$tmpdir/.log", "$srcrep/$llnk->{'package'}/$md5-_linkerror")) {
      my $err = "link $tmpdir/.log $srcrep/$llnk->{'package'}/$md5-_linkerror: $!\n";
      die($err) unless -e "$srcrep/$llnk->{'package'}/$md5-_linkerror";
    }
    unlink("$tmpdir/$_") for ls($tmpdir);
    rmdir($tmpdir);
    return $failed;
  }
  my @newf = grep {!/^\./} ls($tmpdir);
  my $newf = {};
  local *F;
  for my $f (@newf) {
    my @s = stat "$tmpdir/$f";
    die("$tmpdir/$f: $!\n") unless @s;
    if ($s[3] > 1 && $fl{$f}) {
      my @s2 = stat "$srcrep/$fl{$f}";
      die("$srcrep/$fl{$f}: $!\n") unless @s2;
      if ("$s[0]/$s[1]" eq "$s2[0]/$s2[1]") {
        $newf->{$f} = $fl{$f};
        $newf->{$f} =~ s/.*\///;
        $newf->{$f} = substr($newf->{$f}, 0, 32);
	next;
      }
    }
    open(F, '<', "$tmpdir/$f") || die("$tmpdir/$f: $!\n");
    my $ctx = Digest::MD5->new;
    $ctx->addfile(*F);
    close F;
    $newf->{$f} = $ctx->hexdigest();
  }

  # if we just want the patched files we're finished
  if (!$md5) {
    # rename into md5 form, sort so that there's no collision
    for my $f (sort {length($b) <=> length($a) || $a cmp $b} @newf) {
      rename("$tmpdir/$f", "$tmpdir/$newf->{$f}-$f");
    }
    return $newf;
  }

  # otherwise link everything over
  for my $f (@newf) {
    addfile($llnk->{'project'}, $llnk->{'package'}, "$tmpdir/$f", $f, $newf->{$f});
  }
  # clean up tmpdir
  unlink("$tmpdir/$_") for ls($tmpdir);
  rmdir($tmpdir);
  # store filelist
  my $linkinfo = {
    'srcmd5'  => $lsrc->{'srcmd5'},
    'lsrcmd5' => $llnk->{'srcmd5'},
  };
  addmeta_link($llnk->{'project'}, $llnk->{'package'}, $newf, $md5, $linkinfo);
  return '';
}

#
# expand a source link
# - returns expanded file list
# - side effects:
#   modifies $rev->{'srcmd5'}, $rev->{'vrev'}, $rev->{'linkrev'}
#   modifies $li->{'srcmd5'}, $li->{'lsrcmd5'}
#   modifies $li->{'linked'} if exists
#
sub handlelinks {
  my ($rev, $files, $li) = @_;

  my @linkinfo;
  my %seen;
  my $projid = $rev->{'project'};
  my $packid = $rev->{'package'};
  my $linkrev = $rev->{'linkrev'};
  push @linkinfo, {'project' => $projid, 'package' => $packid, 'srcmd5' => $rev->{'srcmd5'}, 'rev' => $rev->{'rev'}};
  delete $rev->{'srcmd5'};
  delete $rev->{'linkrev'};
  my $vrev = $rev->{'vrev'};
  my $vrevdone;
  my $lrev = $rev;
  while ($files->{'_link'}) {
    my $l = repreadxml($lrev, '_link', $files->{'_link'}, $BSXML::link, 1);
    return '_link is bad' unless $l;
    eval {
      BSVerify::verify_link($l);
    };
    if ($@) {
      my $err = $@;
      $err =~ s/\n$//s;
      return "_link is bad: $err";
    }
    $l->{'project'} = $linkinfo[-1]->{'project'} unless exists $l->{'project'};
    $l->{'package'} = $linkinfo[-1]->{'package'} unless exists $l->{'package'};
    $linkrev = $l->{'baserev'} if $linkrev && $linkrev eq 'base';
    ($l->{'rev'}, $linkrev) = ($linkrev, undef) if $linkrev;
    $linkinfo[-1]->{'link'} = $l;
    $projid = $l->{'project'};
    $packid = $l->{'package'};
    $lrev = $l->{'rev'} || '';
    return 'circular package link' if $seen{"$projid/$packid/$lrev"};
    $seen{"$projid/$packid/$lrev"} = 1;
    # record link target for projpack
    push @{$li->{'linked'}}, {'project' => $projid, 'package' => $packid} if $li && $li->{'linked'}; 
    eval {
      $lrev = getrev($projid, $packid, $l->{'rev'}, $li ? $li->{'linked'} : undef);
    };
    if ($@) {
      my $error = $@;
      $error =~ s/\n$//s;
      $error = $2 if $error =~ /^(\d+) +(.*?)$/s;
      return "$projid $packid: $error";
    }
    return "linked package '$packid' does not exist in project '$projid'" unless $lrev;
    return "linked package '$packid' is empty" if $lrev->{'srcmd5'} eq 'empty';
    return "linked package '$packid' is strange" unless $lrev->{'srcmd5'} =~ /^[0-9a-f]{32}$/;
    undef $files;
    eval {
      $files = lsrev($lrev);
    };
    return 'linked package is not in repository' unless $files;
    my $cicount = $l->{'cicount'} || 'add';
    if ($cicount eq 'copy') {
      $rev->{'vrev'} -= $vrev unless $vrevdone;
    } elsif ($cicount eq 'local') {
      $vrevdone = 1;
    } elsif ($cicount ne 'add') {
      return '_link is bad: illegal cicount';
    }
    $vrev = $lrev->{'vrev'};
    $rev->{'vrev'} += $lrev->{'vrev'} unless $vrevdone;
    push @linkinfo, {'project' => $projid, 'package' => $packid, 'srcmd5' => $lrev->{'srcmd5'}, 'rev' => $lrev->{'rev'}};
  }
  my $md5;
  my $oldl;
  for my $l (reverse @linkinfo) {
    if (!$md5) {
      $md5 = $l->{'srcmd5'};
      $oldl = $l;
      next;
    }
    my $md5c = "$md5  /LINK\n$l->{'srcmd5'}  /LOCAL\n";
    $md5 = Digest::MD5::md5_hex($md5c);
    my $treedir = $BSConfig::nosharedtrees ? "$treesdir/$l->{'project'}/$l->{'package'}" : "$treesdir/$l->{'package'}";
    if (! -e "$treedir/$md5-MD5SUMS") {
      my $error = applylink($md5, $oldl, $l);
      if ($error) {
        $rev->{'srcmd5'} = $md5 if $l == $linkinfo[0];
	$error = "$l->{'project'}/$l->{'package'}: $error" if $l != $linkinfo[0];
        return $error;
      }
    }
    $l->{'srcmd5'} = $md5;
    $oldl = $l;
  }
  $rev->{'srcmd5'} = $md5;
  $files = lsrev($rev, $li);
  return $files;
}

# returns expanded filelist
# modifies $rev->{'srcmd5'}, $rev->{'vrev'}
sub lsrev_expanded {
  my ($rev, $linkinfo) = @_;
  my $files = lsrev($rev, $linkinfo);
  return $files unless $files->{'_link'};
  $files = handlelinks($rev, $files, $linkinfo);
  die("$files\n") unless ref $files;
  return $files;
}

# add missing target information to linkinfo
sub linkinfo_addtarget {
  my ($rev, $linkinfo) = @_;
  my %lrev = %$rev;
  $lrev{'srcmd5'} = $linkinfo->{'lsrcmd5'} if $linkinfo->{'lsrcmd5'};
  my $files = lsrev(\%lrev);
  die("linkinfo_addtarget: not a link?\n") unless $files->{'_link'};
  my $l = repreadxml(\%lrev, '_link', $files->{'_link'}, $BSXML::link, 1);
  if ($l) {
    $linkinfo->{'project'} = defined($l->{'project'}) ? $l->{'project'} : $lrev{'project'};
    $linkinfo->{'package'} = defined($l->{'package'}) ? $l->{'package'} : $lrev{'package'};
    $linkinfo->{'rev'} = $l->{'rev'} if $l->{'rev'};
    $linkinfo->{'baserev'} = $l->{'baserev'} if $l->{'baserev'};
  }
}

sub findlastworkinglink {
  my ($rev) = @_;

  my $projid = $rev->{'project'};
  my $packid = $rev->{'package'};
  my $treedir = $BSConfig::nosharedtrees ? "$treesdir/$projid/$packid" : "$treesdir/$packid";
  my @cand = grep {s/-MD5SUMS$//} ls($treedir);
  if ($BSConfig::nosharedtrees && $BSConfig::nosharedtrees == 2) {
    push @cand, grep {s/-MD5SUMS$//} ls("$srcrep/$packid");
    @cand = unify(@cand);
  }
  my %cand;
  for my $cand (@cand) {
    my $candrev = {'project' => $projid, 'package' => $packid, 'srcmd5' => $cand};
    my %li;
    my $files = lsrev($candrev, \%li);
    next unless $li{'lsrcmd5'} && $li{'lsrcmd5'} eq $rev->{'srcmd5'};
    $cand{$cand} = $li{'srcmd5'};
  }
  return undef unless %cand;
  @cand = sort keys %cand;
  return $cand[0] if @cand == 1;

  while (1) {
    my $lrev = {'project' => $projid, 'package' => $packid, 'srcmd5' => $rev->{'srcmd5'}};
    my $lfiles = lsrev($lrev);
    return undef unless $lfiles;
    my $l = repreadxml($lrev, '_link', $lfiles->{'_link'}, $BSXML::link, 1);
    return undef unless $l;
    $projid = $l->{'project'} if exists $l->{'project'};
    $packid = $l->{'package'} if exists $l->{'package'};
    my $lastcand;
    for my $cand (splice @cand) {
      next unless $cand{$cand};
      my %li;
      my $candrev = {'project' => $projid, 'package' => $packid, 'srcmd5' => $cand{$cand}};
      lsrev($candrev, \%li);
      $candrev->{'srcmd5'} = $li{'lsrcmd5'} if $li{'lsrcmd5'};
      $candrev = findlastrev($candrev);
      next unless $candrev;
      next if $lastcand && $lastcand->{'rev'} > $candrev->{'rev'};
      $cand{$cand} = $li{'srcmd5'} ? $li{'srcmd5'} : undef;
      if ($lastcand && $lastcand->{'rev'} == $candrev->{'rev'}) {
        push @cand, $cand;
	next;
      }
      @cand = ($cand);
      $lastcand = $candrev;
    }
    return undef unless @cand;
    return $cand[0] if @cand == 1;
    $rev = $lastcand;
  }
}


###########################################################################
###
###  project/package management
###

sub identical {
  my ($d1, $d2, @except) = @_;

  return 0 unless defined($d1) && defined($d2);
  my $r = ref($d1);
  return 0 if $r ne ref($d2);
  if ($r eq '') {
    return 0 if $d1 ne $d2;
  } elsif ($r eq 'HASH') {
    my %k = (%$d1, %$d2);
    my %except = map {$_ => 1} @except;
    for my $k (keys %k) {
      next if $except{$k};
      return 0 unless identical($d1->{$k}, $d2->{$k});
    }
  } elsif ($r eq 'ARRAY') {
    return 0 unless @$d1 == @$d2;
    for (my $i = 0; $i < @$d1; $i++) {
      return 0 unless identical($d1->[$i], $d2->[$i], @except);
    }
  } else {
    return 0;
  }
  return 1;
}

sub findprojects {
  local *D;
  mkdir_p("$projectsdir") || die("creating $projectsdir: $!\n");
  opendir(D, $projectsdir) || die("$projectsdir: $!\n");
  my @projids = grep {s/\.xml$//} readdir(D);
  closedir(D);
  return sort @projids;
}

sub findpackages {
  my ($projid, $proj, $nonfatal, $seen) = @_;
  $proj ||= readproj($projid, 1) || {};
  local *D;
  my @packids;
  if (opendir(D, "$projectsdir/$projid.pkg")) {
    @packids = grep {s/\.xml$//} readdir(D);
    closedir(D);
  }
  if ($proj->{'link'}) {
    $seen ||= {};
    for my $lprojid (map {$_->{'project'}} @{$proj->{'link'}}) {
      next if $seen->{$lprojid};
      $seen->{$lprojid} = 1;
      my @lpackids;
      my $lproj = readproj($lprojid, 1);
      if (!$lproj || $lproj->{'remoteurl'}) {
        $lproj = remoteprojid($lprojid);
	my $r;
	eval {
	  $r = BSRPC::rpc({'uri' => "$lproj->{'remoteurl'}/source/$lproj->{'remoteproject'}", 'proxy' => $proxy}, $BSXML::dir);
	};
        if ($@ && $@ !~ /^404/) {
          die($@) unless $nonfatal;
          warn($@);
        }
	@lpackids = map {$_->{'name'}} @{($r || {})->{'entry'} || []};
      } else {
	@lpackids = findpackages($lprojid, undef, $nonfatal, $seen);
      }
      if (grep {$_ eq '_product'} @packids) {
	@lpackids = grep {$_ ne '_product' && !/^_product:/} @lpackids;
      }
      push @packids, @lpackids;
    }
    @packids = unify(@packids);
  }
  return sort @packids;
}

sub getrev_meta {
  my ($projid, $packid, $revid, $nonfatal) = @_;
  my $revfile = defined($packid) ? "$projectsdir/$projid.pkg/$packid.mrev" : "$projectsdir/$projid.pkg/_meta.mrev";
  my $rev;
  if (!defined($revid) || $revid eq 'latest') {
    $rev = BSFileDB::fdb_getlast($revfile, $srcrevlay);
  } elsif ($revid =~ /^[0-9a-f]{32}$/) {
    $rev = { 'srcmd5' => $revid };
  } else {
    $rev = BSFileDB::fdb_getmatch($revfile, $srcrevlay, 'rev', $revid);
  }
  if ($rev) {
    $rev->{'project'} = $projid;
    $rev->{'package'} = defined($packid) ? $packid : '_meta';
  } elsif (!$nonfatal) {
    die("404 revision '$revid' does not exist\n");
  }
  return $rev;
}

sub retrofit_old_prjsource {
  my ($projid) = @_;
  my $files = {};
  my $packid = '_project';
  if (-e "$projectsdir/$projid.conf") {
    BSUtil::cp("$projectsdir/$projid.conf", "$uploaddir/addrev_meta$$");
    $files->{'_config'} = addfile($projid, $packid, "$uploaddir/addrev_meta$$", '_config');
  }
  return $files;
}

sub retrofit_old_meta {
  my ($projid, $packid) = @_;
  my $files = {};
  if (defined($packid) && $packid ne '_project') {
    if (-e "$projectsdir/$projid.pkg/$packid.xml") {
      BSUtil::cp("$projectsdir/$projid.pkg/$packid.xml", "$uploaddir/addrev_meta$$");
      $files->{'_meta'} = addfile($projid, $packid, "$uploaddir/addrev_meta$$", '_meta');
    }
  } else {
    $packid = '_project';
    if (-e "$projectsdir/$projid.xml") {
      BSUtil::cp("$projectsdir/$projid.xml", "$uploaddir/addrev_meta$$");
      $files->{'_meta'} = addfile($projid, $packid, "$uploaddir/addrev_meta$$", '_meta');
    }
    if (-e "$projectsdir/$projid.pkg/_pubkey") {
      BSUtil::cp("$projectsdir/$projid.pkg/_pubkey", "$uploaddir/addrev_meta$$");
      $files->{'_pubkey'} = addfile($projid, $packid, "$uploaddir/addrev_meta$$", '_pubkey');
    }
    if (-e "$projectsdir/$projid.pkg/_signkey") {
      BSUtil::cp("$projectsdir/$projid.pkg/_signkey", "$uploaddir/addrev_meta$$");
      chmod(0600, "$uploaddir/addrev_meta$$");
      $files->{'_signkey'} = addfile($projid, $packid, "$uploaddir/addrev_meta$$", '_signkey');
    }
  }
  return $files;
}

sub extract_old_prjsource {
  my ($projid, $rev) = @_;
  my $files = lsrev($rev);
  my $config;
  $config = repreadstr($rev, '_config', $files->{'_config'}, 1) if $files->{'_config'};
  writestr("$uploaddir/$$.2", "$projectsdir/$projid.conf", $config) if $config;
}

sub extract_old_meta {
  my ($projid, $packid, $rev) = @_;
  my $files = lsrev($rev);
  if (!defined($packid) || $packid eq '_project') {
    $packid = '_project';
    my $pubkey;
    $pubkey = repreadstr($rev, '_pubkey', $files->{'_pubkey'}, 1) if $files->{'_pubkey'};
    writestr("$uploaddir/$$.2", "$projectsdir/$projid.pkg/_pubkey", $pubkey) if $pubkey;
    my $signkey;
    $signkey = repreadstr($rev, '_signkey', $files->{'_signkey'}, 1) if $files->{'_signkey'};
    if ($signkey) {
      writestr("$uploaddir/$$.2", undef, $signkey);
      chmod(0600, "$uploaddir/$$.2");
      rename("$uploaddir/$$.2", "$projectsdir/$projid.pkg/_signkey") || die("rename $uploaddir/$$.2 $projectsdir/$projid.pkg/_signkey: $!\n");
    }
    my $meta;
    $meta = repreadstr($rev, '_meta', $files->{'_meta'}, 1) if $files->{'_meta'};
    writestr("$uploaddir/$$.2", "$projectsdir/$projid.xml", $meta) if $meta;
  } else {
    my $meta;
    $meta = repreadstr($rev, '_meta', $files->{'_meta'}, 1) if $files->{'_meta'};
    writestr("$uploaddir/$$.2", "$projectsdir/$projid.pkg/$packid.xml", $meta) if $meta;
  }
}

sub addrev_meta {
  my ($cgi, $projid, $packid, $tmpfile, $file, $rfile, $suf) = @_;

  $suf ||= 'mrev';
  my $md5;
  my $rpackid = defined($packid) ? $packid : '_project';
  if ($file) {
    mkdir_p($uploaddir);
    BSUtil::cp($tmpfile, "$uploaddir/addrev_meta$$");
    chmod(0600, "$uploaddir/addrev_meta$$") if !defined($packid) && $suf eq 'mrev' && $rfile eq '_signkey';
    $md5 = addfile($projid, $rpackid, "$uploaddir/addrev_meta$$", $rfile);
  }
  mkdir_p("$projectsdir/$projid.pkg");
  my $revfile = "$projectsdir/$projid.pkg/$rpackid.$suf";
  local *FF;
  BSUtil::lockopen(\*FF, '+>>', $revfile);
  my $rev = BSFileDB::fdb_getlast($revfile, $srcrevlay);
  my $files;
  if ($rev) {
    $rev->{'project'} = $projid;
    $rev->{'package'} = $rpackid;
    $files = lsrev($rev);
  } else {
    $files = {};
    if ((defined($packid) && -e "$projectsdir/$projid.pkg/$packid.xml") || (!defined($packid) && -e "$projectsdir/$projid.xml")) {
      if ($suf eq 'mrev') {
        $files = retrofit_old_meta($projid, $packid);
      } elsif (!defined($packid)) {
        $files = retrofit_old_prjsource($projid);
      }
    }
  }
  if ($md5) {
    $files->{$rfile} = $md5;
  } else {
    # if rfile is not defined this is a delete project/package operation.
    # leave files untouched
    delete $files->{$rfile} if defined $rfile;
  }
  my $srcmd5 = addmeta($projid, $rpackid, $files);
  my $user = defined($cgi->{'user'}) ? str2utf8xml($cgi->{'user'}) : 'unknown';
  my $comment = defined($cgi->{'comment'}) ? str2utf8xml($cgi->{'comment'}) : '';
  my $nrev = { 'srcmd5' => $srcmd5, 'time' => time(), 'user' => $user, 'comment' => $comment, 'requestid' => $cgi->{'requestid'} };
  if (!defined($rfile) && defined($packid) && $suf ne 'mrev') {
    $nrev->{'version'} = $rev->{'version'} if $rev && defined $rev->{'version'};
    $nrev->{'vrev'} = $rev->{'vrev'} if $rev && defined $rev->{'vrev'};
  }
  BSFileDB::fdb_add_i(\*FF,  $srcrevlay, $nrev);
  if ($file) {
    rename($tmpfile, $file) || die("rename $tmpfile $file: $!\n");
  }
  close FF;	# free lock
}

sub readproj {
  my ($projid, $nonfatal, $revid) = @_;
  my $proj;
  if ($revid) {
    my $rev = getrev_meta($projid, undef, $revid);
    my $files = $rev ? lsrev($rev) : {};
    $proj = repreadxml($rev, '_meta', $files->{'_meta'}, $BSXML::proj, 1) if $files->{'_meta'};
  } else {
    $proj = readxml("$projectsdir/$projid.xml", $BSXML::proj, 1);
  }
  die("404 project '$projid' does not exist\n") if !$proj && !$nonfatal;
  return $proj;
}

sub readpack {
  my ($projid, $packid, $nonfatal, $revid) = @_;
  my $pack;
  if ($revid) {
    my $rev = getrev_meta($projid, $packid, $revid, $nonfatal);
    my $files = $rev ? lsrev($rev) : {};
    $pack = repreadxml($rev, '_meta', $files->{'_meta'}, $BSXML::pack, 1) if $files->{'_meta'};
  } else {
    $pack = readxml("$projectsdir/$projid.pkg/$packid.xml", $BSXML::pack, 1);
  }
  if (!$pack && !$nonfatal) {
    readproj($projid);
    die("404 package '$packid' does not exist in project '$projid'\n");
  }
  return $pack;
}

# collect all globale source services via all package and project links
sub getprojectservices {
  my ($cgi, $projid, $packid, $projectloop) = @_;
  my $services;

  # protection against loops and double matches
  $projectloop = {} unless $projectloop;
  return ({}, $BSXML::services) if $projectloop->{$projid};
  $projectloop->{$projid}=1;

  # get source services from this project
  my $projectrev = getrev($projid, '_project');
  my $projectfiles = lsrev($projectrev);
  if ($projectfiles->{'_service'}) {
    $services = readxml("$srcrep/_project/$projectfiles->{'_service'}-_service", $BSXML::services, 1);
  }

  # find further projects via project link
  my $proj = readproj($projid, 1);
  for my $lprojid (map {$_->{'project'}} @{$proj->{'link'} || []}) {
    my ($as, undef) = getprojectservices($cgi, $lprojid, $packid, $projectloop);
    if (defined($as) && defined($as->{'service'})) {
      push @{$services->{'service'}}, @{$as->{'service'}};
    }
  }

  # find further projects via package link
  my $packagerev = getrev($projid, $packid);
  my $packagefiles = lsrev($packagerev);
  if ($packagefiles->{'_link'}) {
    my $l = repreadxml($packagerev, '_link', $packagefiles->{'_link'}, $BSXML::link, 1);
    my $lprojid=$projid;
    my $lpackid=$packid;
    $lprojid=$l->{'project'} if $l->{'project'};
    $lpackid=$l->{'package'} if $l->{'package'};

    # honor project links
    my ($lpack, undef) = getpackage($cgi, $lprojid, $lpackid);
    if ($lprojid ne $lpack->{'project'}) {
      my ($as, undef) = getprojectservices($cgi, $lprojid, $packid, $projectloop);
      if (defined($as) && defined($as->{'service'})) {
        push @{$services->{'service'}}, @{$as->{'service'}};
      }
      $lprojid = $lpack->{'project'};
    }

    my ($as, undef) = getprojectservices($cgi, $lprojid, $lpackid, $projectloop);
    if (defined($as) && defined($as->{'service'})) {
      push @{$services->{'service'}}, @{$as->{'service'}};
    }
  }

  $services = {} unless $services;
  return ($services, $BSXML::services);
};

# find matching .spec/.dsc/.kiwi file depending on packid and/or repoid
sub findfile {
  my ($rev, $repoid, $ext, $files) = @_;

  $files = lsrev($rev) unless $files;
  return (undef, undef) unless $files;

  # create filename -> return value hash
  my %files = map {$_ => [$files->{$_}, $_]} keys %$files;

  # map services files to their real name
  if ($files{'_service'}) {
    for (sort keys %files) {
      next unless /^_service:.*:(.*?)$/s;
      next unless $files{$_};
      $files{$1} = $files{$_};
      delete $files{$_};
    }
  }

  my $packid = $rev->{'package'};
  return (@{$files{"$packid-$repoid.$ext"}}) if defined($repoid) && $files{"$packid-$repoid.$ext"};
  # 28.4.2009 mls: deleted "&& defined($repoid)"
  return @{$files{"$packid.$ext"}} if $files{"$packid.$ext"};
  # try again without last components
  if ($packid =~ /^(.*?)\./) {
    return @{$files{"$1.$ext"}} if $files{"$1.$ext"};
  }
  my @files = grep {/\.$ext$/} keys %files;
  @files = grep {/^\Q$packid\E/i} @files if @files > 1;
  return @{$files{$files[0]}} if @files == 1;
  if (@files > 1) {
    if (!defined($repoid)) {
      # return (undef, undef);
      @files = sort @files;
      return @{$files{$files[0]}};
    }
    @files = grep {/^\Q$packid-$repoid\E/i} @files if @files > 1;
    return @{$files{$files[0]}} if @files == 1;
  }
  return (undef, undef);
}

sub unify {
  my %h = map {$_ => 1} @_;
  return grep(delete($h{$_}), @_);
}

#########################################################################

# set up kiwi project callback

sub kiwibootcallback {
  my ($projid, $packid) = @_;
  BSVerify::verify_projid($projid);
  BSVerify::verify_packid($packid);
  checksourceaccess($projid, $packid);
  my $rev = getrev($projid, $packid);
  my $files = lsrev($rev);
  my ($md5, $file) = findfile($rev, undef, 'kiwi', $files);
  die("no kiwi file found\n") unless $md5 && $file;
  my $xml = readstr("$srcrep/$packid/$md5-$file");
  return ($xml, {'project' => $projid, 'package' => $packid, 'srcmd5' => $rev->{'srcmd5'}, 'file' => $file});
}
$Build::Kiwi::bootcallback = \&kiwibootcallback;

#########################################################################

sub getprojquotapackage {
  my ($projid) = @_;
  if (!exists($packagequota{':packages'})) {
    my $quotaxml = readxml($BSConfig::bsquotafile, $BSXML::quota, 1);
    for my $p (@{$quotaxml->{'project'} || []}) {
      $packagequota{$p->{'name'}} = $p->{'packages'};
    }
    $packagequota{':packages'} = $quotaxml->{'packages'};
  }
  while ($projid) {
    return $packagequota{$projid} if exists $packagequota{$projid};
    last unless $projid =~ s/:[^:]*$//;
  }
  return $packagequota{':packages'};
}

sub getprojpack {
  my ($cgi, $projids, $repoids, $packids, $arch) = @_;
  local *oldbsrpc = *BSRPC::rpc;
  local *BSRPC::rpc;
  if ($cgi->{'noremote'}) {
    *BSRPC::rpc = sub {die("500 remote error: noremote option\n");};
  } else {
    *BSRPC::rpc = *oldbsrpc;
  }
  $arch ||= 'noarch';
  $projids = [ findprojects() ] unless $projids;
  if ($BSConfig::limit_projects && $BSConfig::limit_projects->{$arch}) {
    $projids ||= $BSConfig::limit_projects->{$arch};
    my %limit_projids = map {$_ => 1} @{$BSConfig::limit_projects->{$arch}};
    $projids = [ grep {$limit_projids{$_}} @$projids ];
  }
  $repoids = { map {$_ => 1} @$repoids } if $repoids;
  $packids = { map {$_ => 1} @$packids } if $packids;
  my $bconf = Build::read_config($arch);

  my $remotemap = $cgi->{'withremotemap'} ? {} : undef;
  my @res;
  for my $projid (@$projids) {
    my $jinfo = { 'name' => $projid };
    my $proj = readproj($projid, 1);
    if ($remotemap && (!$proj || $proj->{'remoteurl'}) && !exists($remotemap->{$projid})) {
      my $r = remoteprojid($projid);
      $remotemap->{$projid} = {%$r, 'proto' => 1} if $r;
    }
    next unless $proj;

    my %expandedrepos;

    if ($cgi->{'withrepos'}) {
      if ($repoids) {
	$jinfo->{'repository'} = [ grep {$repoids->{$_->{'name'}}} @{$proj->{'repository'} || []} ];
      } else {
        $jinfo->{'repository'} = $proj->{'repository'} || [];
      }
      if ($cgi->{'expandedrepos'}) {
	$jinfo->{'repository'} = Storable::dclone($jinfo->{'repository'});
	for my $repo (@{$jinfo->{'repository'}}) {
	  my @prps = expandsearchpath($projid, $repo->{'name'}, $remotemap);
          $expandedrepos{"$projid/$repo->{'name'}"} = [ @prps ];
	  for my $prp (@prps) {
	    my @s = split('/', $prp, 2);
	    $prp = {'project' => $s[0], 'repository' => $s[1]};
	  }
	  $repo->{'path'} = \@prps;
	}
      } elsif ($remotemap) {
	for my $repo (@{$jinfo->{'repository'}}) {
	  eval {
	    my @prps = expandsearchpath($projid, $repo->{'name'}, $remotemap);
            $expandedrepos{"$projid/$repo->{'name'}"} = [ @prps ];
	  };
	  $expandedrepos{"$projid/$repo->{'name'}"} = $@ if $@;
	}
      }
    }

    if ($remotemap) {
      for my $lprojid (map {$_->{'project'}} @{$proj->{'link'} || []}) {
        my $lproj = remoteprojid($lprojid);
	eval {
	  fetchremoteproj($lproj, $lprojid, $remotemap) if $lproj;
	};
      }
    }

    if ($cgi->{'withconfig'}) {
      my $config = readstr("$projectsdir/$projid.conf", 1);
      if ($config) {
	# strip away macro blocks
	while ($config =~ /^(.*?\n)?\s*(macros:[^\n]*\n.*)/si) {
	  my ($c1, $c2) = ($1, $2);
	  $c1 = '' unless defined $c1;
	  if ($c2 =~ /^(?:.*?\n)?\s*:macros\s*\n(.*)$/si) {
	    $config = "$c1$c2";
	  } else {
	    $config = $c1;
	    last;
	  }
	}
	$jinfo->{'config'} = $config unless $config =~ /^\s*$/s;
      }
    }
    if ($cgi->{'withsrcmd5'} && -s "$projectsdir/$projid.pkg/pattern-MD5SUMS") {
      my $patterns = readstr("$projectsdir/$projid.pkg/pattern-MD5SUMS", 1);
      $jinfo->{'patternmd5'} = Digest::MD5::md5_hex($patterns) if $patterns;
    } elsif ($cgi->{'withsrcmd5'} && $cgi->{'nopackages'}) {
      # used by publisher to get patternmd5
      eval {
	my $rev = getrev($projid, '_pattern');
	my $files = lsrev_expanded($rev);
	$jinfo->{'patternmd5'} = $rev->{'srcmd5'};
      };
    }
    my @packages;
    @packages = findpackages($projid, $proj, 1) unless $cgi->{'nopackages'} || $proj->{'remoteurl'};
    next if $repoids && !grep {$repoids->{$_->{'name'}}} @{$proj->{'repository'} || []};
    next if $packids && !grep {$packids->{$_}} @packages;
    for (qw{title description build publish debuginfo useforbuild remoteurl remoteproject download link sourceaccess privacy access}) {
      $jinfo->{$_} = $proj->{$_} if exists $proj->{$_};
    }
    # Check build flags in project meta data
    # packages inherit the project wide settings and may override them
    my $pdisabled;
    my $pdisable = {};
    my $penable = {};
    undef($penable) if $cgi->{'ignoredisable'};
    if ($jinfo->{'build'} && $penable) {
      for (@{$proj->{'repository'} || []}) {
        my $disen = BSUtil::enabled($_->{'name'}, $jinfo->{'build'}, 1, $arch);
        if ($disen) {
          $penable->{$_->{'name'}} = 1;
        } else {
          $pdisable->{$_->{'name'}} = 1;
        }
      }
      $pdisabled = 1 if !keys(%$penable);
    } else {
      # build is enabled
      undef($penable);
    }

    # Check package number quota
    my $quota_exceeded;
    if ($BSConfig::bsquotafile) {
      my $pquota = getprojquotapackage($projid);
      $quota_exceeded = 1 if defined($pquota) && @packages > $pquota;
    }

    if (!$cgi->{'ignoredisable'} && !grep {!$_->{'status'} || $_->{'status'} ne 'disabled'} @{$proj->{'repository'} || []}) {
      # either no repositories or all disabled. No need to check packages
      @packages = ();
    }
    @packages = () if $cgi->{'nopackages'};
    my @pinfo;
    my %bconfs;

    for my $packid (@packages) {

      next if $packids && !$packids->{$packid};
      my $pinfo = {'name' => $packid};
      push @pinfo, $pinfo;
      my $pack = readpack($projid, $packid, 1);
      $pack ||= {} if $proj->{'link'};
      if (!$pack) {
	$pinfo->{'error'} = 'no metadata';
	next;
      }
      for (qw{build publish debuginfo useforbuild bcntsynctag sourceaccess privacy access}) {
	$pinfo->{$_} = $pack->{$_} if $pack->{$_};
      }
      if (!$pinfo->{'build'}) {
        $pinfo->{'build'}->{'enable'} = $pack->{'enable'} if $pack->{'enable'};
        $pinfo->{'build'}->{'disable'} = $pack->{'disable'} if $pack->{'disable'};
      }
      my $enable = defined($penable) ? {%$penable} : undef;
      my $disable = {%$pdisable};
      if (!$cgi->{'ignoredisable'} && $pinfo->{'build'}) {
        for (@{$proj->{'repository'} || []}) {
          my $default = exists($disable->{$_->{'name'}}) ? 0 : 1;
          my $disen = BSUtil::enabled($_->{'name'}, $pinfo->{'build'}, $default, $arch);
          if ($disen) {
            $enable->{$_->{'name'}} = 1;
            delete $disable->{$_->{'name'}};
          } else {
            $disable->{$_->{'name'}} = 1;
            delete $enable->{$_->{'name'}};
          }
        }
      }
      undef($disable) if $enable && !keys(%$enable);
      undef($enable) if $disable && !keys(%$disable);
      if ((!$disable || $pdisabled) && $enable && !%$enable) {
	$pinfo->{'error'} = 'disabled';
	next;
      }
      if ($quota_exceeded) {
	$pinfo->{'error'} = 'quota exceeded';
	next;
      }
      if ($cgi->{'withsrcmd5'} || $cgi->{'withdeps'}) {
        my $rev;
	my $linked = [];
	eval {
	  $rev = getrev($projid, $packid, 'build', $linked);
	};
        $pinfo->{'originproject'} = $rev->{'originproject'} if $rev && $rev->{'originproject'};
        $pinfo->{'linked'} = $linked if @$linked;
	if ($@) {
	  $pinfo->{'error'} = $@;
	  $pinfo->{'error'} =~ s/\n$//s;
 	  next;
	}
	if (!$rev || $rev->{'srcmd5'} eq 'empty' || $rev->{'srcmd5'} eq 'd41d8cd98f00b204e9800998ecf8427e') {
	  $pinfo->{'error'} = 'no source uploaded';
	  next;
	}
	$pinfo->{'srcmd5'} = $rev->{'srcmd5'};
	$pinfo->{'rev'} = $rev->{'rev'};
	$pinfo->{'revtime'} = $rev->{'time'} if $rev->{'time'};
	my $files;
	eval {
          $files = lsrev($rev);
	};
	if ($@) {
	  $pinfo->{'error'} = $@;
	  $pinfo->{'error'} =~ s/\n$//s;
 	  next;
	}
	if ($files->{'_service'} && -e "$eventdir/service/${projid}::$packid") {
	  $pinfo->{'error'} = 'source update running';
 	  next;
	}
        if ($files->{'_service_error'}) {
	  $pinfo->{'error'} = 'source service failed';
 	  next;
        }
	if ($files->{'_link'}) {
	  my %li = ('linked' => $linked);
	  eval {
	    $files = handlelinks($rev, $files, \%li);
	  };
	  if ($@) {
	    $files = "$@";
	    $files =~ s/\n$//;
	  }
          $pinfo->{'linked'} = $linked if @$linked;
	  if (!ref $files) {
	    $pinfo->{'error'} = defined($files) ? $files : "could not get file list";
	    next;
	  }
	  $pinfo->{'srcmd5'} = $rev->{'srcmd5'};
	  my $meta = '';
	  $meta .= "$files->{$_}  $_\n" for sort keys %$files;
	  $pinfo->{'verifymd5'} = Digest::MD5::md5_hex($meta);
	}
	if ($packid eq '_pattern') {
	  $jinfo->{'patternmd5'} = $pinfo->{'srcmd5'};
	  $pinfo->{'error'} = 'excluded';
	  next;
	}
	if ($files->{'_aggregate'}) {
	  my $aggregatelist = repreadxml($rev, '_aggregate', $files->{'_aggregate'}, $BSXML::aggregatelist, 1);
	  if (!$aggregatelist) {
	    $pinfo->{'error'} = "bad aggregatelist data";
	    next;
	  }
          eval {
	    BSVerify::verify_aggregatelist($aggregatelist);
          };
	  if ($@) {
	    my $err = $@;
	    $err =~ s/\n$//s;
	    $pinfo->{'error'} = "bad aggregatelist: $err";
	    next;
	  }
	  $pinfo->{'aggregatelist'} = $aggregatelist;
	  if (($enable && %$enable) || ($disable && %$disable)) {
	    my @dinfo = ();
	    for my $repo (@{$proj->{'repository'} || []}) {
	      my $repoid = $repo->{'name'};
	      next if $repoids && !$repoids->{$repoid};
	      if ((!$disable || $disable->{$repoid}) && !(!$enable || $enable->{$repoid})) {
	        push @dinfo, {'repository' => $repoid, 'error' => 'disabled'};
		next;
	      }
	    }
	    $pinfo->{'info'} = \@dinfo if @dinfo;
	  }
	} elsif ($files->{'_patchinfo'}) {
	  my $patchinfo = repreadxml($rev, '_patchinfo', $files->{'_patchinfo'}, $BSXML::patchinfo, 1);
          if (!$patchinfo) {
	    $pinfo->{'error'} = "bad patchinfo data";
	    next;
	  }
          eval {
	    BSVerify::verify_patchinfo($patchinfo);
          };
	  if ($@) {
	    my $err = $@;
	    $err =~ s/\n$//s;
	    $pinfo->{'error'} = "bad patchinfo: $err";
	    next;
	  }
	  $pinfo->{'patchinfo'} = $patchinfo;
	  if (($enable && %$enable) || ($disable && %$disable)) {
	    my @dinfo = ();
	    for my $repo (@{$proj->{'repository'} || []}) {
	      my $repoid = $repo->{'name'};
	      next if $repoids && !$repoids->{$repoid};
	      if ((!$disable || $disable->{$repoid}) && !(!$enable || $enable->{$repoid})) {
	        push @dinfo, {'repository' => $repoid, 'error' => 'disabled'};
		next;
	      }
	    }
	    $pinfo->{'info'} = \@dinfo if @dinfo;
	  }
        } elsif ($cgi->{'withdeps'}) {
	  my @dinfo;

	  for my $repo (@{$proj->{'repository'} || []}) {
	    my $repoid = $repo->{'name'};
	    next if $repoids && !$repoids->{$repoid};

	    my $rinfo = {'repository' => $repoid};
	    push @dinfo, $rinfo;
	    if ((!$disable || $disable->{$repoid}) && !(!$enable || $enable->{$repoid})) {
	      $rinfo->{'error'} = 'disabled';
	      next;
	    }
            if (!$bconfs{$repoid}) {
	      print "calculating config for $projid/$repoid $arch\n";
	      my $path = $expandedrepos{"$projid/$repoid"};
	      if (!$path) {
	        eval {
		  my @path = expandsearchpath($projid, $repoid, $remotemap);
		  $expandedrepos{"$projid/$repoid"} = \@path;
		};
		$expandedrepos{"$projid/$repoid"} = $@ if $@;
		$path = $expandedrepos{"$projid/$repoid"};
	      }
	      my $c;
	      eval {
		die($path) unless ref $path;
		$c = concatconfigs($projid, $repoid, $remotemap, @$path);
	      };
	      if ($@) {
	        my $err = $@;
	        $err =~ s/\n$//;
	        $rinfo->{'error'} = $err;
	        next;
	      }
	      $c = [ split("\n", $c) ];
	      $bconfs{$repoid} = Build::read_config($arch, $c);
            }
	    my $conf = $bconfs{$repoid};
	    my $type = $conf->{'type'};
	    if (!$type || $type eq 'UNDEFINED') {
	      $rinfo->{'error'} = 'bad build configuration';
	      next;
	    }
            my ($md5, $file) = findfile($rev, $repoid, $type, $files);
	    if (!$md5) {
	      # no spec/dsc/kiwi file found
	      if (grep {/\.(?:spec|dsc|kiwi)$/} keys %$files) {
		# only different types available
		$rinfo->{'error'} = 'excluded';
	      }
	      next;
	    }
	    if ($type eq 'kiwi' && $BSConfig::kiwiprojects && !$cgi->{'ignoredisable'}) {
	      my %kiwiprojects = map {$_ => 1} @$BSConfig::kiwiprojects;
	      if (!$kiwiprojects{$projid}) {
		$rinfo->{'error'} = 'kiwi image building is not enabled for this project';
	        next;
	      }
	    }
	    $rinfo->{'file'} = $file;
	    # get build dependency info
            my $d = Build::parse($conf, "$srcrep/$packid/$md5-$file");
	    data2utf8xml($d);
            if (defined($d->{'name'})) {
	      my $version = defined($d->{'version'}) ? $d->{'version'} : 'unknown';
	      $pinfo->{'versrel'} ||= "$version-$rev->{'vrev'}";
	      $rinfo->{'name'} = $d->{'name'};
	      $rinfo->{'dep'} = $d->{'deps'};
              if ($d->{'prereqs'}) {
		my %deps = map {$_ => 1} (@{$d->{'deps'} || []}, @{$d->{'subpacks'} || []});
		my @prereqs = grep {!$deps{$_} && !/^%/} @{$d->{'prereqs'}};
		$rinfo->{'prereq'} = \@prereqs if @prereqs;
	      }
	      # KIWI Products need local arch added if we have it defined on this server
	      if ($type eq 'kiwi' && $d->{'imagetype'}[0] eq 'product' && $d->{'exclarch'}) {
		$rinfo->{'imagearch'} = [ @{$d->{'exclarch'}} ];
	        unshift @{$d->{'exclarch'}}, 'local' if defined($BSConfig::localarch);
	      }
	      # KIWI Images don't build with local arch
	      if ($type eq 'kiwi' && $d->{'imagetype'}[0] ne 'product') {
	        $rinfo->{'error'} = 'excluded' if defined($BSConfig::localarch) && $arch eq 'local';
	      }
	      $rinfo->{'error'} = 'excluded' if $d->{'exclarch'} && !grep {$_ eq $arch} @{$d->{'exclarch'}};
	      $rinfo->{'error'} = 'excluded' if $d->{'badarch'} && grep {$_ eq $arch} @{$d->{'badarch'}};
	      for ('imagetype', 'path', 'extrasource') {
	        $rinfo->{$_} = $d->{$_} if exists $d->{$_};
	      }
	      if ($remotemap && $rinfo->{'path'} && !$repo->{'path'}) {
		eval {
		  concatconfigs($projid, $repoid, $remotemap, @{$rinfo->{'path'}});
		};
	      }
	    } else {
	      $rinfo->{'error'} = "can not parse package name from $file";
	      $rinfo->{'error'} .= " because: ".$d->{'error'} if $d->{'error'};
	    }
	  }
	  $pinfo->{'info'} = \@dinfo if @dinfo;
	}
      }
    }
    $jinfo->{'package'} = \@pinfo;
    push @res, $jinfo;
  }
  my $ret = {'repoid' => $repoid, 'project' => \@res};
  #print Dumper($remotemap);
  if ($remotemap && %$remotemap) {
    for my $p (sort keys %$remotemap) {
      next unless $remotemap->{$p};
      my $r = {'project' => $p};
      for (qw{remoteurl remoteproject remoteroot root config repository error proto}) {
        $r->{$_} = $remotemap->{$p}->{$_} if defined($remotemap->{$p}->{$_});
      }
      $r->{'error'} =~ s/\n$// if $r->{'error'};
      push @{$ret->{'remotemap'}}, $r;
    }
  }
  return ($ret, $BSXML::projpack);
}

sub getprojectlist {
  my ($cgi) = @_;
  my @projects;
  if (!$cgi->{'deleted'}) {
    @projects = findprojects();
  } else {
    @projects = grep {s/\.pkg$//} ls("$projectsdir/_deleted");
    @projects = grep {! -e "$projectsdir/$_.xml"} @projects;
    @projects = sort @projects;
  }
  @projects = map {{'name' => $_}} @projects;
  return ({'entry' => \@projects}, $BSXML::dir);
}

sub getproject {
  my ($cgi, $projid) = @_;
  # Read the project xml file
  my $proj = readproj($projid, 1, $cgi->{'rev'});
  $proj = remoteprojid($projid) if !$proj || $proj->{'remoteurl'};
  die("404 project '$projid' does not exist\n") unless $proj;
  if ($proj->{'remoteurl'}) {
    my $p = BSRPC::rpc({'uri' => "$proj->{'remoteurl'}/source/$proj->{'remoteproject'}/_meta", 'proxy' => $proxy}, $BSXML::proj);
    # map remote names to local names
    $p->{'name'} = $projid;
    for my $r (@{$p->{'repository'} || []}) {
      for my $re (@{$r->{'path'} || []}) {
	$re->{'project'} = maptoremote($proj, $re->{'project'});
      }
    }
    for my $pp (@{$p->{'link'} || []}) {
      $pp->{'project'} = maptoremote($proj, $pp->{'project'});
    }
    $p->{'mountproject'} = $proj->{'root'} if defined $proj->{'root'};
    $proj = $p;
  }
  return ($proj, $BSXML::proj);
}

#########################################################################

sub createkey {
  my ($cgi, $projid) = @_;
  $cgi->{'comment'} ||= 'create sign key';
  die("don't know how to create a key\n") unless $BSConfig::sign;
  die("404 project $projid does not exist\n") unless -s "$projectsdir/$projid.xml";
  mkdir_p($uploaddir);
  local *F;
  my $pubkey = '';
  my @keyargs = ('dsa@1024', '800');
  my @signargs;
  push @signargs, '--project', $projid if $BSConfig::sign_project;
  my $obsname = $BSConfig::obsname || 'build.opensuse.org';
  open(F, '-|', $BSConfig::sign, @signargs, '-P', "$uploaddir/signkey.$$", '-g', @keyargs, "$projid OBS Project", "$projid\@$obsname") || die("$BSConfig::sign: $!\n");
  1 while sysread(F, $pubkey, 4096, length($pubkey));
  close(F) || die("$BSConfig::sign: $?\n");
  die("sign did not create signkey\n") unless -s "$uploaddir/signkey.$$";
  mkdir_p("$projectsdir/$projid.pkg");
  writestr("$uploaddir/pubkey.$$", undef, $pubkey);
  # XXX: these are two commits...
  addrev_meta($cgi, $projid, undef, "$uploaddir/pubkey.$$", "$projectsdir/$projid.pkg/_pubkey", '_pubkey');
  addrev_meta($cgi, $projid, undef, "$uploaddir/signkey.$$", "$projectsdir/$projid.pkg/_signkey", '_signkey');
  return $BSStdServer::return_ok;
}

sub extendkey {
  my ($cgi, $projid) = @_;
  $cgi->{'comment'} ||= 'extend public key expiry date';
  die("don't know how to extend a key\n") unless $BSConfig::sign;
  die("project does not have a key\n") unless -s "$projectsdir/$projid.pkg/_pubkey";
  die("project does not have a signkey\n") unless -s "$projectsdir/$projid.pkg/_signkey";
  my @keyargs = ('800');
  my @signargs;
  push @signargs, '--project', $projid if $BSConfig::sign_project;
  my $pubkey = '';
  open(F, '-|', $BSConfig::sign, @signargs, '-P', "$projectsdir/$projid.pkg/_signkey", '-x', @keyargs, "$projectsdir/$projid.pkg/_pubkey") || die("$BSConfig::sign: $!\n");
  1 while sysread(F, $pubkey, 4096, length($pubkey));
  close(F) || die("$BSConfig::sign: $?\n");
  mkdir_p($uploaddir);
  writestr("$uploaddir/pubkey.$$", undef, $pubkey);
  addrev_meta($cgi, $projid, undef, "$uploaddir/pubkey.$$", "$projectsdir/$projid.pkg/_pubkey", '_pubkey');
  return $BSStdServer::return_ok;
}

sub deletekey {
  my ($cgi, $projid) = @_;
  $cgi->{'comment'} ||= 'delete sign key';
  if ($BSConfig::forceprojectkeys) {
    my $pprojid = $projid;
    $pprojid =~ s/:[^:]*$//;
    my $sk;
    ($sk) = getsignkey({}, $pprojid) if $projid ne $pprojid;
    die("must have a key for signing\n") unless $sk;
  }
  # XXX: these are two commits...
  addrev_meta($cgi, $projid, undef, undef, undef, '_pubkey');
  addrev_meta($cgi, $projid, undef, undef, undef, '_signkey');
  unlink("$projectsdir/$projid.pkg/_signkey");
  unlink("$projectsdir/$projid.pkg/_pubkey");
  rmdir("$projectsdir/$projid.pkg");
  return $BSStdServer::return_ok;
}

sub getpubkey {
  my ($cgi, $projid) = @_;
  my $pubkey;

  my $proj = readproj($projid, 1, $cgi->{'rev'});
  $proj = remoteprojid($projid) if !$proj || $proj->{'remoteurl'};
  die("404 project '$projid' does not exist\n") unless $proj;

  if ($proj->{'remoteurl'}) {
    $pubkey = BSRPC::rpc({'uri' => "$proj->{'remoteurl'}/source/$proj->{'remoteproject'}/_pubkey", 'proxy' => $proxy}, undef);
  } else {
    if ($cgi->{'rev'}) {
      my $rev = getrev_meta($projid, undef, $cgi->{'rev'});
      my $files = $rev ? lsrev($rev) : {};
      $pubkey = repreadstr($rev, '_pubkey', $files->{'_pubkey'}, 1) if $files->{'_pubkey'};
    } else {
      $pubkey = readstr("$projectsdir/$projid.pkg/_pubkey", 1);
    }
  }
  die("404 $projid: no pubkey available\n") unless $pubkey;
  return ($pubkey, 'Content-Type: text/plain');
}

#########################################################################

sub putproject {
  my ($cgi, $projid) = @_;
  mkdir_p($uploaddir);
  my $uploaded = BSServer::read_file("$uploaddir/$$");
  die("upload failed\n") unless $uploaded;
  my $proj = readxml("$uploaddir/$$", $BSXML::proj);
  $proj->{'name'} = $projid unless defined $proj->{'name'};
  BSVerify::verify_proj($proj, $projid);
  writexml("$uploaddir/$$.2", undef, $proj, $BSXML::proj);
  unlink("$uploaddir/$$");
  my $oldproj = readxml("$projectsdir/$projid.xml", $BSXML::proj, 1);
  BSNotify::notify($oldproj ? "SRCSRV_UPDATE_PROJECT" : "SRCSRV_CREATE_PROJECT", { "project" => $projid, "sender" => ($cgi->{'user'} || "unknown") });
  mkdir_p("$projectsdir") || die("creating $projectsdir: $!\n");
  addrev_meta($cgi, $projid, undef, "$uploaddir/$$.2", "$projectsdir/$projid.xml", '_meta');
  if ($BSConfig::forceprojectkeys) {
    my ($sk) = getsignkey({}, $projid);
    createkey({ %$cgi, 'comment' => 'autocreate key' }, $projid) if $sk eq '';
  }

  if (!identical($oldproj, $proj, 'title', 'description', 'person', 'group', 'url', 'attributes')) {
    notify_repservers('project', $projid);
  }

  $proj = readproj($projid);
  return ($proj, $BSXML::proj);
}

sub delproject {
  my ($cgi, $projid) = @_;

  $cgi->{'comment'} ||= 'project was deleted';
  die("404 project '$projid' does not exist\n") unless -e "$projectsdir/$projid.xml";
  # add delete commit to both source and meta
  addrev_meta($cgi, $projid, undef, undef, undef, undef, 'rev');
  addrev_meta($cgi, $projid, undef, undef, undef, undef);
  if (-d "$projectsdir/$projid.pkg") {
    # delete packages in sub process to avoid timeout errors
    my $pid;
    if (!($pid = xfork())) {
      # delete those packages and keys
      mkdir_p("$projectsdir/_deleted/$projid.pkg");
      # make room in old delete by deleting all old packages
      for my $f (ls("$projectsdir/_deleted/$projid.pkg")) {
        if ($f =~ /\.m?rev$/) {
          my $oldrev = readstr("$projectsdir/_deleted/$projid.pkg/$f", 1);
          if (defined($oldrev) && $oldrev ne '') {
            BSUtil::lockopen(\*F, '+>>', "$projectsdir/_deleted/$projid.pkg/$f.del");
            BSUtil::appendstr("$projectsdir/_deleted/$projid.pkg/$f.del", $oldrev);
            # XXX: add comment
            close F;
          }
          unlink("$projectsdir/_deleted/$projid.pkg/$f");
        }
      }
      for my $f (ls("$projectsdir/$projid.pkg")) {
        if ($f =~ /^(.*)\.xml$/) {
          my $packid = $1;
          if (! -f "$projectsdir/$projid.pkg/$1.mrev") {
            # create initial meta revision in case it does not exist yet
            addrev_meta($cgi, $projid, $packid, undef, undef, undef);
          }
        }
      }
      for my $f (ls("$projectsdir/$projid.pkg")) {
        if ($f =~ /\.m?rev(?:\.del)?$/) {
          updatelinkinfodb($projid, $1) if $f =~ /^(.*)\.rev$/;
          my $oldrev = readstr("$projectsdir/$projid.pkg/$f", 1);
          if (defined($oldrev) && $oldrev ne '') {
            BSUtil::lockopen(\*F, '+>>', "$projectsdir/_deleted/$projid.pkg/$f");
            BSUtil::appendstr("$projectsdir/_deleted/$projid.pkg/$f", $oldrev);
            close F;
          }
        }
        unlink("$projectsdir/$projid.pkg/$f");
      }
      rmdir("$projectsdir/$projid.pkg") || die("rmdir $projectsdir/$projid.pkg: $!\n");
    }
  }
  unlink("$projectsdir/$projid.conf");
  unlink("$projectsdir/$projid.xml");
  notify_repservers('project', $projid);

  BSNotify::notify("SRCSRV_DELETE_PROJECT", { "project" => $projid, "comment" => $cgi->{'comment'}, "sender" => ($cgi->{'user'} || "unknown") });

  return $BSStdServer::return_ok;
}

sub undeleteproject {
  my ($cgi, $projid) = @_;

  die("404 project '$projid' already exists\n") if -e "$projectsdir/$projid.xml";
  die("404 project '$projid' is not deleted\n") unless -e "$projectsdir/_deleted/$projid.pkg";
  $cgi->{'comment'} ||= 'project was undeleted';
  mkdir_p($uploaddir);
  mkdir_p("$projectsdir/$projid.pkg");
  for my $f (ls("$projectsdir/_deleted/$projid.pkg")) {
    if ($f =~ /\.m?rev\.del$/) {
      BSUtil::cp("$projectsdir/_deleted/$projid.pkg/$f", "$uploaddir/$$.2", "$projectsdir/$projid.pkg/$f");
    } elsif ($f =~ /^(.*)\.(m?rev)$/) {
      my $packid = $1;
      my $suf = $2;
      my $rev = undelete_rev($cgi, "$projectsdir/_deleted/$projid.pkg/$f", "$projectsdir/$projid.pkg/$f");
      $rev->{'project'} = $projid;
      $rev->{'package'} = $packid;
      # extract legacy files
      if ($suf eq 'rev') {
	if ($packid eq '_project') {
          extract_old_prjsource($projid, $rev);
	} else {
	  updatelinkinfodb($projid, $packid, $rev, lsrev($rev));
	}
      } elsif ($suf eq 'mrev') {
        extract_old_meta($projid, $packid, $rev);
      }
    }
  }
  notify_repservers('project', $projid);
  BSNotify::notify("SRCSRV_UNDELETE_PROJECT", { "project" => $projid, "comment" => $cgi->{'comment'}, "sender" => ($cgi->{'user'} || "unknown") });

  return $BSStdServer::return_ok;
}

#########################################################################

sub getpackagelist {
  my ($cgi, $projid, $repoid, $arch) = @_;
  my $proj = checkprojrepoarch($projid, $repoid, $arch, 1);
  if ($proj->{'remoteurl'}) {
    my @args;
    push @args, "deleted" if $cgi->{'deleted'};
    return BSRPC::rpc({'uri' => "$proj->{'remoteurl'}/source/$proj->{'remoteproject'}", 'proxy' => $proxy}, $BSXML::dir, @args), $BSXML::dir;
  }
  my @packages;
  if (!$cgi->{'deleted'}) {
    @packages = findpackages($projid, $proj);
  } else {
    @packages = grep {s/\.mrev\.del$//} ls("$projectsdir/$projid.pkg");
    @packages = grep {! -e "$projectsdir/$projid.pkg/$_.xml"} @packages;
    @packages = sort @packages;
  }
  my @plist = map {{'name' => $_}} @packages;
  return ({'entry' => \@plist}, $BSXML::dir);
}

sub getpackage {
  my ($cgi, $projid, $packid) = @_;
  my $proj = checkprojrepoarch($projid, undef, undef, 1);
  if ($proj->{'remoteurl'}) {
    my @args;
    push @args, "rev=$cgi->{'rev'}" if $cgi->{'rev'};
    my $pack = BSRPC::rpc({'uri' => "$proj->{'remoteurl'}/source/$proj->{'remoteproject'}/$packid/_meta", 'proxy' => $proxy}, $BSXML::pack, @args);
    $pack->{'project'} = $projid;	# local name
    if ($pack->{'devel'} && exists($pack->{'devel'}->{'project'})) {
      $pack->{'devel'}->{'project'} = maptoremote($proj, $pack->{'devel'}->{'project'});
    }
    return ($pack, $BSXML::pack);
  }
  if ($cgi->{'rev'}) {
    # return the exact file here
    # we also do not look at project links
    # we return the data as string so that the md5 sum matches
    my $rev = getrev_meta($projid, $packid, $cgi->{'rev'});
    my $files = lsrev($rev);
    die("404 _meta: no such file\n") unless $files->{'_meta'};
    my $meta = repreadstr($rev, '_meta', $files->{'_meta'});
    return ($meta);
  }
  my $pack = readpack($projid, $packid, 1);
  if (!$pack && $proj->{'link'}) {
    my %checked = ($projid => 1);
    my @todo = map {$_->{'project'}} @{$proj->{'link'}};
    while (@todo) {
      my $lprojid = shift @todo;
      next if $checked{$lprojid};
      $checked{$lprojid} = 1;
      my $lproj = readproj($lprojid, 1);
      $lproj = remoteprojid($lprojid) if !$lproj || $lproj->{'remoteurl'};
      if ($lproj->{'remoteurl'}) {
	eval {
	  $pack = BSRPC::rpc({'uri' => "$lproj->{'remoteurl'}/source/$lproj->{'remoteproject'}/$packid/_meta", 'proxy' => $proxy}, $BSXML::pack);
	};
        die($@) if $@ && $@ !~ /^404/;
	if ($pack) {
	  $pack->{'project'} = $lprojid;	# local name
	  if ($pack->{'devel'} && exists($pack->{'devel'}->{'project'})) {
	    $pack->{'devel'}->{'project'} = maptoremote($lproj, $pack->{'devel'}->{'project'});
	  }
	}
      } else {
        $pack = readpack($lprojid, $packid, 1);
        unshift @todo, map {$_->{'project'}} @{$lproj->{'link'}} if !$pack && $lproj->{'link'};
      }
      last if $pack;
    }
  }
  die("404 package '$packid' does not exist in project '$projid'\n") unless $pack;
  return ($pack, $BSXML::pack);
}

sub putpackage {
  my ($cgi, $projid, $packid) = @_;
  mkdir_p($uploaddir);
  my $uploaded = BSServer::read_file("$uploaddir/$$");
  die("upload failed\n") unless $uploaded;
  my $pack = readxml("$uploaddir/$$", $BSXML::pack);
  $pack->{'name'} = $packid unless defined $pack->{'name'};
  BSVerify::verify_pack($pack, $packid);
  die("package contains revision data\n") if grep {exists $pack->{$_}} @$srcrevlay;
  # XXX
  # delete rev stuff, just in case...
  # delete $pack->{$_} for @$srcrevlay;
  # $pack->{'name'} = $packid;
  writexml("$uploaddir/$$.2", undef, $pack, $BSXML::pack);
  unlink("$uploaddir/$$");
  my $proj = readproj($projid);
  die("package '$packid' is read-only\n") if ($packid =~ /^_product:/) && ! -e "$projectsdir/$projid.pkg/$packid.xml";
  mkdir_p("$projectsdir/$projid.pkg");

  my $oldpack = readxml("$projectsdir/$projid.pkg/$packid.xml", $BSXML::pack, 1);
  BSNotify::notify($oldpack ? "SRCSRV_UPDATE_PACKAGE" : "SRCSRV_CREATE_PACKAGE", { "project" => $projid, "package" => $packid, "sender" => ($cgi->{'user'} || "unknown")});

  addrev_meta($cgi, $projid, $packid, "$uploaddir/$$.2", "$projectsdir/$projid.pkg/$packid.xml", '_meta');
  if (!identical($oldpack, $pack, 'title', 'description', 'devel', 'person', 'group', 'url')) {
    notify_repservers('package', $projid, $packid);
  }
  $pack = readpack($projid, $packid);
  return ($pack, $BSXML::pack);
}

sub delpackage {
  my ($cgi, $projid, $packid) = @_;
  $cgi->{'comment'} ||= 'package was deleted';
  die("404 project '$projid' does not exist\n") unless -e "$projectsdir/$projid.xml";
  die("404 package '$packid' does not exist in project '$projid'\n") unless -e "$projectsdir/$projid.pkg/$packid.xml";
  die("403 package '$packid' is read-only\n") if $packid =~ /^_product:/;
  # add delete commit to both source and meta
  addrev_meta($cgi, $projid, $packid, undef, undef, undef, 'rev');
  addrev_meta($cgi, $projid, $packid, undef, undef, undef);
  unlink("$projectsdir/$projid.pkg/$packid.upload-MD5SUMS");
  unlink("$projectsdir/$projid.pkg/$packid.xml");
  my $oldrev = readstr("$projectsdir/$projid.pkg/$packid.rev", 1);
  if (defined($oldrev) && $oldrev ne '') {
    BSUtil::lockopen(\*F, '+>>', "$projectsdir/$projid.pkg/$packid.rev.del");
    BSUtil::appendstr("$projectsdir/$projid.pkg/$packid.rev.del", $oldrev);
    close F;
    updatelinkinfodb($projid, $packid);
  }
  unlink("$projectsdir/$projid.pkg/$packid.rev");
  $oldrev = readstr("$projectsdir/$projid.pkg/$packid.mrev", 1);
  if (defined($oldrev) && $oldrev ne '') {
    BSUtil::lockopen(\*F, '+>>', "$projectsdir/$projid.pkg/$packid.mrev.del");
    BSUtil::appendstr("$projectsdir/$projid.pkg/$packid.mrev.del", $oldrev);
    close F;
  }
  unlink("$projectsdir/$projid.pkg/$packid.mrev");
  if ($packid eq '_product') {
    expandproduct($projid, $packid, undef);
  }
  notify_repservers('package', $projid, $packid);
  BSNotify::notify("SRCSRV_DELETE_PACKAGE", { "project" => $projid, "package" => $packid, "sender" => ($cgi->{'user'} || "unknown"), "comment" => $cgi->{'comment'} });
  return $BSStdServer::return_ok;
}

sub undelete_rev {
  my ($cgi, $revfilefrom, $revfileto) = @_;
  my @rev = BSFileDB::fdb_getall($revfilefrom, $srcrevlay);
  die("$revfilefrom: no entries\n") unless @rev;
  # XXX add way to specify which block to restore
  for my $rev (reverse splice @rev) {
    unshift @rev, $rev;
    last if $rev->{'rev'} == 1;
  }
  my $rev = $rev[-1];
  my $user = defined($cgi->{'user'}) ? str2utf8xml($cgi->{'user'}) : 'unknown';
  my $comment = defined($cgi->{'comment'}) ? str2utf8xml($cgi->{'comment'}) : '';
  my $nrev = { 'srcmd5' => $rev->{'srcmd5'}, 'time' => time(), 'user' => $user, 'comment' => $comment, 'requestid' => $cgi->{'requestid'} };
  $nrev->{'version'} = $rev->{'version'} if $rev && defined $rev->{'version'};
  $nrev->{'vrev'} = $rev->{'vrev'} if $rev && defined $rev->{'vrev'};
  $nrev->{'rev'} = $rev->{'rev'} + 1;
  push @rev, $nrev;
  BSFileDB::fdb_add_multiple($revfileto, $srcrevlay, @rev);
  return $nrev;
}

sub undeletepackage {
  my ($cgi, $projid, $packid) = @_;
  $cgi->{'comment'} ||= 'package was undeleted';
  die("404 project '$projid' does not exist\n") unless -e "$projectsdir/$projid.xml";
  die("403 package '$packid' already exists\n") if -e "$projectsdir/$projid.pkg/$packid.xml";
  die("403 package '$packid' was not deleted\n") unless -e "$projectsdir/$projid.pkg/$packid.rev.del";
  my $rev = undelete_rev($cgi, "$projectsdir/$projid.pkg/$packid.mrev.del", "$projectsdir/$projid.pkg/$packid.mrev");
  $rev->{'project'} = $projid;
  $rev->{'package'} = $packid;
  extract_old_meta($projid, $packid, $rev);
  if (-s "$projectsdir/$projid.pkg/$packid.rev.del") {
    my $nrev = undelete_rev($cgi, "$projectsdir/$projid.pkg/$packid.rev.del", "$projectsdir/$projid.pkg/$packid.rev");
    $nrev->{'project'} = $projid;
    $nrev->{'package'} = $packid;
    updatelinkinfodb($projid, $packid, $nrev, lsrev($nrev));
  }
  notify_repservers('package', $projid, $packid);
  BSNotify::notify("SRCSRV_UNDELETE_PACKAGE", { "project" => $projid, "package" => $packid, "sender" => ($cgi->{'user'} || "unknown"), "comment" => $cgi->{'comment'} });

  return $BSStdServer::return_ok;
}

sub getpackagehistory {
  my ($cgi, $projid, $packid) = @_;
  my @res;
  my $revfile;
  $packid = '_project' unless defined $packid;
  $revfile = "$projectsdir/$projid.pkg";
  $revfile = "$projectsdir/_deleted/$projid.pkg" if $packid eq '_project' && $cgi->{'deleted'};
  $revfile .= $cgi->{'meta'} ? "/$packid.mrev" : "/$packid.rev";
  $revfile .= '.del'if $packid ne '_project' && $cgi->{'deleted'};
  my $filter;
  if ($cgi->{'rev'}) {
    $filter = sub { return $cgi->{'rev'} eq $_[0]->{'rev'} || $cgi->{'rev'} eq $_[0]->{'srcmd5'} ? 1 : 0 };
  }
  for (BSFileDB::fdb_getall_reverse($revfile, $srcrevlay, $cgi->{'limit'}, $filter)) {
    $_->{'comment'} = str2utf8xml($_->{'comment'}) if $_->{'comment'};
    unshift @res, $_;
  }
  return ({'revision' => \@res}, $BSXML::revisionlist);
}

##########################################################################

##########################################################################

# XXX -> library

sub remoteprojid {
  my ($projid) = @_;
  my $rsuf = '';
  my $origprojid = $projid;

  my $proj = readproj($projid, 1);
  if ($proj) {
    return undef unless $proj->{'remoteurl'};
    return undef unless $proj->{'remoteproject'};
    return {
      'name' => $projid,
      'root' => $projid,
      'remoteroot' => $proj->{'remoteproject'},
      'remoteurl' => $proj->{'remoteurl'},
      'remoteproject' => $proj->{'remoteproject'},
    };
  }
  while ($projid =~ /^(.*)(:.*?)$/) {
    $projid = $1;
    $rsuf = "$2$rsuf";
    $proj = readproj($projid, 1);
    if ($proj) {
      return undef unless $proj->{'remoteurl'};
      if ($proj->{'remoteproject'}) {
        $rsuf = "$proj->{'remoteproject'}$rsuf";
      } else {
        $rsuf =~ s/^://;
      }
      return {
        'name' => $origprojid,
        'root' => $projid,
        'remoteroot' => $proj->{'remoteproject'},
        'remoteurl' => $proj->{'remoteurl'},
        'remoteproject' => $rsuf,
      };
    }
  }
  return undef;
}

sub maptoremote {
  my ($proj, $projid) = @_;
  return "$proj->{'root'}:$projid" unless $proj->{'remoteroot'};
  return $proj->{'root'} if $projid eq $proj->{'remoteroot'};
  return '_unavailable' if $projid !~ /^\Q$proj->{'remoteroot'}\E:(.*)$/;
  return "$proj->{'root'}:$1";
}

sub fetchremoteproj {
  my ($proj, $projid, $remotemap) = @_;
  return undef unless $proj && $proj->{'remoteurl'} && $proj->{'remoteproject'};
  $projid ||= $proj->{'name'};
  my $rproj;
  my $c;
  if ($remotemap) {
    $rproj = $remotemap->{$projid};
    if ($rproj) {
      die($rproj->{'error'}) if $rproj->{'error'};
      return $rproj unless $rproj->{'proto'};
      $c = $rproj->{'config'};	# save old config
      undef $rproj;
    }
  }
  print "fetching remote project data for $projid\n";
  my $param = {
    'uri' => "$proj->{'remoteurl'}/source/$proj->{'remoteproject'}/_meta",
    'timeout' => 60,
    'proxy' => $proxy,
  };
  eval {
    $rproj = BSRPC::rpc($param, $BSXML::proj);
  };
  if ($@) {
    if ($remotemap) {
      $rproj = {%$proj, 'error' => $@, 'proto' => 1};
      $rproj->{'config'} = $c if defined $c;
      $remotemap->{$projid} = $rproj;
    }
    die($@);
  }
  for (qw{name root remoteroot remoteurl remoteproject}) {
    $rproj->{$_} = $proj->{$_};
  }
  for my $repo (@{$rproj->{'repository'} || []}) {
    for my $pathel (@{$repo->{'path'} || []}) {
      $pathel->{'project'} = maptoremote($proj, $pathel->{'project'});
    }
  }
  for my $link (@{$rproj->{'link'} || []}) {
    $link->{'project'} = maptoremote($proj, $link->{'project'});
  }
  $remotemap->{$projid} = $rproj if $remotemap;
  return $rproj;
}

sub fetchremoteconfig {
  my ($proj, $projid, $remotemap) = @_;
  return undef unless $proj && $proj->{'remoteurl'} && $proj->{'remoteproject'};
  $projid ||= $proj->{'name'};
  if ($remotemap) {
    my $rproj = $remotemap->{$projid};
    if ($rproj) {
      die($rproj->{'error'}) if $rproj->{'error'};
      return $rproj->{'config'} if defined $rproj->{'config'};
    } else {
      $remotemap->{$projid} = {%$proj, 'proto' => 1};
    }
  }
  print "fetching remote project config for $projid\n";
  my $param = {
    'uri' => "$proj->{'remoteurl'}/source/$proj->{'remoteproject'}/_config",
    'timeout' => 60,
    'proxy' => $proxy,
  };
  my $c;
  eval {
    $c = BSRPC::rpc($param, undef);
  };
  if ($@) {
    $remotemap->{$projid}->{'error'} = $@ if $remotemap;
    die($@);
  }
  $remotemap->{$projid}->{'config'} = $c if $remotemap;
  return $c;
}

sub remote_getrev {
  my ($projid, $packid, $rev, $linked, $missingok) = @_;
  my $proj = remoteprojid($projid);
  if (!$proj) {
    return {'project' => $projid, 'package' => $packid, 'srcmd5' => 'pattern', 'rev' => 'pattern'} if $packid eq '_pattern';
    return {'project' => $projid, 'package' => $packid, 'srcmd5' => 'empty'} if $missingok;
    die("404 package '$packid' does not exist\n") if -e "$projectsdir/$projid.xml";
    die("404 project '$projid' does not exist\n");
  }
  # check if we already know this srcmd5, if yes don't bother to contact
  # the remote server
  if ($rev && $rev =~ /^[0-9a-f]{32}$/) {
    my $treedir = $BSConfig::nosharedtrees ? "$treesdir/$projid/$packid" : "$treesdir/$packid";
    if ( -e "$treedir/$rev-MD5SUMS") {
      return {'project' => $projid, 'package' => $packid, 'rev' => $rev, 'srcmd5' => $rev};
    }        
  }
  my @args;
  push @args, 'expand';
  push @args, "rev=$rev" if defined $rev;
  my $dir;
  eval {
    $dir = BSRPC::rpc({'uri' => "$proj->{'remoteurl'}/source/$proj->{'remoteproject'}/$packid", 'proxy' => $proxy}, $BSXML::dir, @args, 'withlinked') if $linked;
  };
  if (!$dir || $@) {
    eval {
      $dir = BSRPC::rpc({'uri' => "$proj->{'remoteurl'}/source/$proj->{'remoteproject'}/$packid", 'proxy' => $proxy}, $BSXML::dir, @args);
    };
    if ($@) {
      return {'project' => $projid, 'package' => $packid, 'srcmd5' => 'empty'} if $missingok && $@ =~ /^404[^\d]/;
      die($@);
    }
  }
  die("$dir->{'error'}\n") if $dir->{'error'};
  $rev = {};
  $rev->{'rev'} = $dir->{'rev'} || $dir->{'srcmd5'};
  $rev->{'srcmd5'} = $dir->{'srcmd5'};
  $rev->{'vrev'} = $dir->{'vrev'};
  $rev->{'vrev'} ||= '0';
  # now put everything in local srcrep
  my $files = {};
  for my $entry (@{$dir->{'entry'} || []}) {
    $files->{$entry->{'name'}} = $entry->{'md5'};
    next if -e "$srcrep/$packid/$entry->{'md5'}-$entry->{'name'}";
    if ($linked && $entry->{'size'} > 8192) {
      # getprojpack request, hand over to AJAX
      BSHandoff::rpc($ajaxsocket, "/source/$projid/$packid", undef, "rev=$dir->{'srcmd5'}");
      die("download in progress\n");
    }
    mkdir_p($uploaddir);
    my $param = {
      'uri' => "$proj->{'remoteurl'}/source/$proj->{'remoteproject'}/$packid/$entry->{'name'}",
      'filename' => "$uploaddir/$$",
      'withmd5' => 1,
      'receiver' => \&BSHTTP::file_receiver,
      'proxy' => $proxy,
    };
    my $res = BSRPC::rpc($param, undef, "rev=$rev->{'srcmd5'}");
    die("file download failed\n") unless $res && $res->{'md5'} eq $entry->{'md5'};
    addfile($projid, $packid, "$uploaddir/$$", $entry->{'name'}, $entry->{'md5'});
  }
  my $srcmd5 = addmeta($projid, $packid, $files);
  if ($dir->{'linkinfo'}) {
    $dir->{'srcmd5'} = $rev->{'srcmd5'} = $srcmd5;
    $rev->{'rev'} = $rev->{'srcmd5'} unless $dir->{'rev'};
    if ($linked) {
      # add linked info for getprojpack
      my $li = $dir->{'linkinfo'};
      if ($li->{'linked'}) {
	for my $l (@{$li->{'linked'}}) {
	  $l->{'project'} = maptoremote($proj, $l->{'project'});
	  push @$linked, $l if defined($l->{'project'}) && $l->{'project'} ne '_unavailable';
	}
	undef $li;
      }
      while ($li) {
        my $lprojid = $li->{'project'};
        my $lpackid = $li->{'package'};
        last unless defined($lprojid) && defined($lpackid);
        my $mlprojid = maptoremote($proj, $lprojid);
        last unless defined($mlprojid) && $mlprojid ne '_unavailable';
        push @$linked, {'project' => $mlprojid, 'package' => $lpackid};
	last unless $li->{'srcmd5'} && !$li->{'error'};
	my $ldir;
	eval {
	  $ldir = BSRPC::rpc({'uri' => "$proj->{'remoteurl'}/source/$lprojid/$lpackid", 'proxy' => $proxy}, $BSXML::dir, "rev=$li->{'srcmd5'}");
	};
	last if $@ || !$ldir;
	$li = $ldir->{'linkinfo'};
      }
    }
  }
  die("srcmd5 mismatch\n") if $dir->{'srcmd5'} ne $srcmd5;
  $rev->{'project'} = $projid;
  $rev->{'package'} = $packid;
  return $rev;
}

sub expandsearchpath {
  my ($projid, $repoid, $remotemap) = @_;
  my %done;
  my @ret;
  my @path = {project => $projid, repository => $repoid};
  while (@path) {
    my $t = shift @path;
    my $prp = "$t->{'project'}/$t->{'repository'}";
    push @ret, $prp unless $done{$prp};
    $done{$prp} = 1;
    if (!@path) {
      last if $done{"/$prp"};
      my ($pid, $tid) = ($t->{'project'}, $t->{'repository'});
      my $proj = readproj($pid, 1);
      if (!$proj || $proj->{'remoteurl'}) {
	undef $proj;
	$proj = $remotemap->{$pid} if $remotemap && $remotemap->{$pid};
	if (!$proj || $proj->{'proto'}) {
          $proj = remoteprojid($pid);
          $proj = fetchremoteproj($proj, $pid, $remotemap);
          die("404 project '$pid' does not exist\n") unless $proj;
        }
      }
      $done{"/$prp"} = 1;       # mark expanded
      my @repo = grep {$_->{'name'} eq $tid} @{$proj->{'repository'} || []};
      push @path, @{$repo[0]->{'path'}} if @repo && $repo[0]->{'path'};
    }
  }
  return @ret;
}

sub concatconfigs {
  my ($projid, $repoid, $remotemap, @path) = @_;

  my $config = "%define _project $projid\n";
  my $macros = '';

  #$macros .= "%vendor openSUSE Build Service\n";

  # find the sign project, this is what we use as vendor
  my $vprojid = $projid;
  while ($vprojid ne '') {
    last if -s "$projectsdir/$vprojid.pkg/_signkey";
    $vprojid =~ s/[^:]*$//;
    $vprojid =~ s/:$//;
  }
  $vprojid = $projid if $vprojid eq '';
  my $obsname = $BSConfig::obsname || 'build.opensuse.org';
  $macros .= "%vendor obs://$obsname/$vprojid\n";

  $macros .= "%_project $projid\n";
  my $lastr = '';

  my $distinfo = "$projid / $repoid";
  if ($repoid eq 'standard') {
    $distinfo = $projid;
  } 

  for my $prp (reverse @path) {
    if ($prp eq "$projid/$repoid") {
      $macros .= "\n%distribution $distinfo\n";
      $macros .= "%_project $projid\n";
    }
    my ($p, $r) = split('/', $prp, 2);
    my $c;
    if (-s "$projectsdir/$p.conf") {
      $c = readstr("$projectsdir/$p.conf");
    } elsif (!-e "$projectsdir/$p.xml") {
      my $proj = remoteprojid($p);
      $c = fetchremoteconfig($proj, $p, $remotemap);
    }
    next unless defined $c;
    $config .= "\n### from $p\n";
    $config .= "%define _repository $r\n";
    if ($c =~ /^(.*\n)?\s*macros:[^\n]*\n(.*)/si) {
      $c = defined($1) ? $1 : '';
      $macros .= "\n### from $p\n";
      $macros .= "%_repository $r\n";
      $macros .= $2;
      $lastr = $r;
    }
    $config .= $c;
  }
  if ($lastr ne $repoid) {
    $macros .= "\n### from $projid\n";
    $macros .= "%_repository $repoid\n";
  }
  if (!@path || $path[0] ne "$projid/$repoid") {
    $macros .= "\n%distribution $distinfo\n";
    $macros .= "%_project $projid\n";
  }
  if ($BSConfig::extramacros) {
    for (sort keys %{$BSConfig::extramacros}) {
      $macros .= $BSConfig::extramacros->{$_} if $projid =~ /$_/;
    }
  }
  $config .= "\nMacros:\n$macros" if $macros ne '';
  return $config;
}

sub getbuildconfig {
  my ($cgi, $projid, $repoid) = @_;
  my @path;
  if ($cgi->{'path'}) {
    @path = @{$cgi->{'path'}};
  } else {
    @path = expandsearchpath($projid, $repoid);
  }
  my $config = concatconfigs($projid, $repoid, undef, @path);
  return ($config, 'Content-Type: text/plain');
}

sub getprojectconfig {
  my ($cgi, $projid) = @_;
  my $proj = checkprojrepoarch($projid, undef, undef, 1);
  if ($proj->{'remoteurl'}) {
    my $config = BSRPC::rpc({'uri' => "$proj->{'remoteurl'}/source/$proj->{'remoteproject'}/_config", 'proxy' => $proxy}, undef);
    return ($config, 'Content-Type: text/plain');
  }
  my $config;
  if ($cgi->{'rev'}) {
    my $rev = getrev($projid, '_project', $cgi->{'rev'});
    my $files = $rev ? lsrev($rev) : {};
    $config = repreadstr($rev, '_config', $files->{'_config'}, 1) if $files->{'_config'};
  } else {
    $config = readstr("$projectsdir/$projid.conf", 1);
  }
  $config = '' unless defined $config;
  return ($config, 'Content-Type: text/plain');
}

sub putprojectconfig {
  my ($cgi, $projid) = @_;
  my $proj = readproj($projid);
  mkdir_p($uploaddir);
  my $uploaded = BSServer::read_file("$uploaddir/$$");
  die("upload failed\n") unless $uploaded;
  if (-s "$uploaddir/$$") {
    addrev_meta($cgi, $projid, undef, "$uploaddir/$$", "$projectsdir/$projid.conf", '_config', 'rev');
  } else {
    unlink("$uploaddir/$$");
    addrev_meta($cgi, $projid, undef, undef, undef, '_config', 'rev');
    unlink("$projectsdir/$projid.conf");
  }
  notify_repservers('project', $projid);
  BSNotify::notify("SRCSRV_UPDATE_PROJECT_CONFIG", { "project" => $projid, "sender" => ($cgi->{'user'} || "unknown") });

  return $BSStdServer::return_ok;
}

sub delprojectconfig {
  my ($cgi, $projid) = @_;
  addrev_meta($cgi, $projid, undef, undef, undef, '_config', 'rev');
  unlink("$projectsdir/$projid.conf");
  notify_repservers('project', $projid);
  BSNotify::notify("SRCSRV_UPDATE_PROJECT_CONFIG", { "project" => $projid, "sender" => ($cgi->{'user'} || "unknown") });
  return $BSStdServer::return_ok;
}

##########################################################################

sub getsources {
  my ($cgi, $projid, $packid, $srcmd5) = @_;
  my $rev = {'project' => $projid, 'package' => $packid, 'srcmd5' => $srcmd5};
  my $files = lsrev($rev);
  my @send = map {{'name' => $_, 'filename' => "$srcrep/$packid/$files->{$_}-$_"}} keys %$files;
  BSServer::reply_cpio(\@send);
  return undef;
}

sub detach {
  my $jev = $BSServerEvents::gev;
  return unless exists $jev->{'fd'};
  my $ev = BSEvents::new('never');
  for (keys %$jev) {
    $ev->{$_} = $jev->{$_} unless $_ eq 'id' || $_ eq 'handler' || $_ eq 'fd';
  }
  $jev->{'conf'}->{'stdreply'}->(@_) if $jev->{'conf'}->{'stdreply'};
  $BSServerEvents::gev = $ev;
  return $ev;
}

my %getfilelist_ajax_inprogress;

sub getfilelist_ajax {
  my ($cgi, $projid, $packid) = @_;

  my $jev = $BSServerEvents::gev;
  if (!$jev->{'remoteurl'}) {
    die unless $cgi->{'rev'};
    my $proj = remoteprojid($projid);
    die("missing project/package\n") unless $proj;
    $jev->{'remoteurl'} = $proj->{'remoteurl'};
    $jev->{'remoteproject'} = $proj->{'remoteproject'};
  }
  if (!$jev->{'filelist'}) {
    my $rev = $cgi->{'rev'};
    return $BSStdServer::return_ok if $getfilelist_ajax_inprogress{"$projid/$packid/$rev"};
    my $param = {
      'uri' => "$jev->{'remoteurl'}/source/$jev->{'remoteproject'}/$packid",
      'proxy' => $proxy,
    };
    eval {
      $jev->{'filelist'} = BSWatcher::rpc($param, $BSXML::dir, "rev=$rev");
    };
    if ($@) {
      my $err = $@;
      notify_repservers('package', $projid, $packid);
      die($err);
    }
    return undef unless $jev->{'filelist'};
    $jev = detach($BSStdServer::return_ok);
    $jev->{'idstring'} = "$projid/$packid/$rev";
    $getfilelist_ajax_inprogress{"$projid/$packid/$rev"} = $jev;
    $jev->{'handler'} = sub {delete $getfilelist_ajax_inprogress{"$projid/$packid/$rev"}};
  }
  my $serial;
  my $dir = $jev->{'filelist'};
  for my $entry (@{$dir->{'entry'} || []}) {
    next if -e "$srcrep/$packid/$entry->{'md5'}-$entry->{'name'}";
    $serial ||= BSWatcher::serialize("$jev->{'remoteurl'}/source");
    return undef unless $serial;
    mkdir_p($uploaddir);
    my $param = {
      'uri' => "$jev->{'remoteurl'}/source/$jev->{'remoteproject'}/$packid/$entry->{'name'}",
      'filename' => "$uploaddir/$$-$jev->{'id'}",
      'withmd5' => 1,
      'receiver' => \&BSHTTP::file_receiver,
      'proxy' => $proxy,
    };
    my $res;
    eval {
      $res = BSWatcher::rpc($param, undef, "rev=$cgi->{'rev'}");
    };
    if ($@) {
      # notify scheduler that the download failed
      my $err = $@;
      BSWatcher::serialize_end($serial) if $serial;
      notify_repservers('package', $projid, $packid);
      die($err);
    }
    return undef unless $res;
    die("file download failed\n") unless $res && $res->{'md5'} eq $entry->{'md5'};
    die unless -e "$uploaddir/$$-$jev->{'id'}";
    addfile($projid, $packid, "$uploaddir/$$-$jev->{'id'}", $entry->{'name'}, $entry->{'md5'});
  }
  BSWatcher::serialize_end($serial) if $serial;
  delete $getfilelist_ajax_inprogress{"$projid/$packid/$cgi->{'rev'}"};
  notify_repservers('package', $projid, $packid);
  return '';
}

sub getfilelist {
  my ($cgi, $projid, $packid) = @_;

  my $view = $cgi->{'view'};
  my $rev;
  if ($cgi->{'meta'}) {
    $rev = getrev_meta($projid, $packid, $cgi->{'rev'});
  } else {
    $rev = getrev($projid, $packid, defined($cgi->{'rev'}) ? $cgi->{'rev'} : 'upload');
  }
  my $li = {};
  my $files = lsrev($rev, $li);

  if ($files->{'_link'}) {
    if ($cgi->{'emptylink'}) {
      my $l = repreadxml($rev, '_link', $files->{'_link'}, $BSXML::link);
      delete $l->{'patches'};
      mkdir_p($uploaddir);
      writexml("$uploaddir/$$", undef, $l, $BSXML::link);
      $files = {};
      $files->{'_link'} = addfile($projid, $packid, "$uploaddir/$$", '_link');
      $rev = addrev($projid, $packid, $files, undef, undef, '');
    }
    my %lrev = %$rev;
    $lrev{'linkrev'} = $cgi->{'linkrev'} if $cgi->{'linkrev'};
    $li->{'linked'} = [] if $cgi->{'withlinked'};
    my $lfiles = handlelinks(\%lrev, $files, $li);
    if ($cgi->{'expand'}) {
      die("$lfiles\n") if !ref $lfiles;
      $files = $lfiles;
      %$rev = %lrev;
      $rev->{'rev'} = $rev->{'srcmd5'};
    } else {
      if (ref $lfiles) {
        $li->{'xsrcmd5'} = $lrev{'srcmd5'};
      } else {
	# link is broken
	$li->{'error'} = $lfiles;
	# set xsrcmd5 if we have a link error file
	$li->{'xsrcmd5'} = $lrev{'srcmd5'} if $lrev{'srcmd5'} && -e "$srcrep/$packid/$lrev{'srcmd5'}-_linkerror";
	if ($cgi->{'lastworking'}) {
	  my $lastworking = findlastworkinglink($rev);
	  $li->{'lastworking'} = $lastworking if $lastworking;
	}
      }
    }
  }

  if ($cgi->{'extension'}) {
    for (keys %$files) {
      delete $files->{$_} unless /\.\Q$cgi->{'extension'}\E$/;
    }
  }

  if ($view && $view eq 'cpio') {
    my @files = map {{'name' => $_, 'filename' => "$srcrep/$packid/$files->{$_}-$_"}} sort keys %$files;
    BSServer::reply_cpio(\@files);
    return undef;
  }

  my $ret = {};
  $ret->{'name'} = $packid;
  $ret->{'srcmd5'} = $rev->{'srcmd5'} if $rev->{'srcmd5'} ne 'empty';
  $ret->{'rev'} = $rev->{'rev'} if exists $rev->{'rev'};
  $ret->{'vrev'} = $rev->{'vrev'} if exists $rev->{'vrev'};
  my @res;
  for my $filename (sort keys %$files) {
    my @s = repstat($rev, $filename, $files->{$filename});
    if (@s) {
      push @res, {'name' => $filename, 'md5' => $files->{$filename}, 'size' => $s[7], 'mtime' => $s[9]};
    } else {
      push @res, {'name' => $filename, 'md5' => $files->{$filename}, 'error' => "$!"};
    }
  }
  if (%$li) {
    linkinfo_addtarget($rev, $li);
    $ret->{'linkinfo'} = $li;
  }
  $ret->{'entry'} = \@res;
  return ($ret, $BSXML::dir);
}

sub getfile {
  my ($cgi, $projid, $packid, $filename) = @_;
  die("no filename\n") unless defined($filename) && $filename ne '';
  die("bad filename\n") if $filename =~ /\// || $filename =~ /^\./;
  my $rev = getrev($projid, $packid, defined($cgi->{'rev'}) ? $cgi->{'rev'} : 'upload');
  my $files = lsrev($rev);
  die("404 $filename: no such file\n") unless $files->{$filename};
  my @s = repstat($rev, $filename, $files->{$filename});
  die("$projid/$packid/$files->{$filename}-$filename: $!\n") unless @s;
  if (!$BSStdServer::isajax && $rev->{'srcmd5'} && $rev->{'srcmd5'} ne 'upload' && $rev->{'srcmd5'} ne 'pattern' && $rev->{'srcmd5'} ne 'empty') {
    # hack: we identify remote source downloads by looking at the user agent
    my $useragent = $BSServer::request->{'headers'}->{'user-agent'} || '';
    if ($useragent =~ /BSRPC/) {
      BSHandoff::handoff($ajaxsocket, "/source/$projid/$packid/$filename", undef, "rev=$rev->{'srcmd5'}");
      exit(0);
    }
  }
  my $fd = gensym;
  repopen($rev, $filename, $files->{$filename}, $fd) || die("$projid/$packid/$files->{$filename}-$filename: $!\n");
  BSWatcher::reply_file($fd);
  return undef;
}

sub putfile {
  my ($cgi, $projid, $packid, $filename) = @_;
  die("no filename\n") unless defined($filename) && $filename ne '';
  die("bad filename\n") if $filename =~ /\// || $filename =~ /^\./;
  my $rev = getrev($projid, $packid, defined($cgi->{'rev'}) ? $cgi->{'rev'} : 'upload');
  die("file '$filename' is read-only\n") if ($filename =~ /^_service:/) && !$cgi->{'force'};
  mkdir_p($uploaddir);
  my $uploaded = BSServer::read_file("$uploaddir/$$", 'withmd5' => 1);
  die("upload failed\n") unless $uploaded;
  addfile($projid, $packid, "$uploaddir/$$", $filename, $uploaded->{'md5'});
  # create new meta file
  my $files;
  if ($cgi->{'keeplink'}) {
    $files = lsrev_expanded($rev);
  } else {
    $files = lsrev($rev);
  }
  $files->{$filename} = $uploaded->{'md5'};
  $files = keeplink($cgi, $projid, $packid, $files) if $cgi->{'keeplink'};
  $rev = addrev($projid, $packid, $files, $cgi->{'user'}, $cgi->{'comment'}, $cgi->{'rev'});
# update happens only on commit atm, or we would modify on file upload time ...
# runservice($projid, $packid) if $files->{'_service'} && not ($rev eq 'upload');
  delete $rev->{'project'};
  delete $rev->{'package'};
  return ($rev, $BSXML::revision);
}

sub sourcediff {
  my ($cgi, $projid, $packid) = @_;

  BSVerify::verify_linkrev($cgi->{'olinkrev'}) if defined($cgi->{'olinkrev'}) && $cgi->{'olinkrev'} ne 'linkrev';
  my $oprojid = exists($cgi->{'oproject'}) ? $cgi->{'oproject'} : $projid;
  my $opackid = exists($cgi->{'opackage'}) ? $cgi->{'opackage'} : $packid;

  my $fmax = 200;
  my $tmax = 16000;
  $fmax = $cgi->{'filelimit'} if defined $cgi->{'filelimit'};
  $tmax = $cgi->{'tarlimit'} if defined $cgi->{'tarlimit'};
  undef $fmax unless $fmax;
  undef $tmax unless $tmax;

  my $rev;
  if ($cgi->{'meta'}) {
    $rev = getrev_meta($projid, $packid, $cgi->{'rev'});
  } else {
    $rev = getrev($projid, $packid, defined($cgi->{'rev'}) ? $cgi->{'rev'} : 'upload', undef, $cgi->{'missingok'});
  }
  my $files = lsrev($rev);
  my $orev = $cgi->{'orev'};
  if (!defined($cgi->{'oproject'}) && !defined($cgi->{'opackage'}) && !defined($cgi->{'orev'}) && $rev->{'rev'}) {
    die("revision is not a simple commit\n") unless $rev->{'rev'} =~ /^\d+$/s;
    $orev = $rev->{'rev'} - 1;
    $cgi->{'olinkrev'} = 'linkrev' if !defined($cgi->{'olinkrev'});
  }
  if ($cgi->{'meta'}) {
    $orev = getrev_meta($oprojid, $opackid, $orev);
  } else {
    $orev = getrev($oprojid, $opackid, defined($orev) ? $orev : 'latest', undef, $cgi->{'missingok'});
  }
  my $ofiles = lsrev($orev);
  if ($cgi->{'expand'} || ($files->{'_link'} && !$ofiles->{'_link'}) || ($ofiles->{'_link'} && !$files->{'_link'})) {
    # expand links
    if ($files->{'_link'}) {
      $rev->{'linkrev'} = $cgi->{'linkrev'} if $cgi->{'linkrev'};
      my %li;
      my $l = repreadxml($rev, '_link', $files->{'_link'}, $BSXML::link, 1);
      if ($l) {
        $l->{'project'} = $rev->{'project'} unless defined $l->{'project'};
        $l->{'package'} = $rev->{'package'} unless defined $l->{'package'};
      }
      $files = handlelinks($rev, $files, \%li);
      die("bad link: $files\n") unless ref $files;
      $cgi->{'olinkrev'} = $li{'srcmd5'} if $cgi->{'olinkrev'} eq 'linkrev';
      if ($l && $cgi->{'linkrev'} && $l->{'project'} eq $oprojid && $l->{'package'} eq $opackid && !$l->{'rev'} && !$cgi->{'orev'}) {
        # we're diffing against the link target. As the user specified a baserev, we should use it
        # instead of the latest source
        $orev = getrev($oprojid, $opackid, $li{'srcmd5'});
        $ofiles = lsrev($orev);
      }
    }
    if ($ofiles->{'_link'}) {
      $orev->{'linkrev'} = $cgi->{'olinkrev'} if $cgi->{'olinkrev'} && $cgi->{'olinkrev'} ne 'linkrev';
      $ofiles = handlelinks($orev, $ofiles);
      die("bad link: $ofiles\n") unless ref $ofiles;
    }
  }
  my $cacheid = "$orev->{'srcmd5'}/$rev->{'srcmd5'}";
  $cacheid .= "/unified:$cgi->{'unified'}" if $cgi->{'unified'};
  $cacheid .= "/fmax:$fmax" if defined $fmax;
  $cacheid .= "/tmax:$tmax" if defined $tmax;
  if ($cgi->{'file'}) {
    my %file = map {$_ => 1} @{$cgi->{'file'}};
    $cacheid .= "/file:$_" for sort keys %file;
    for (keys %$ofiles) {
      delete $ofiles->{$_} unless $file{$_};
    }
    for (keys %$files) {
      delete $files->{$_} unless $file{$_};
    }
  }
  $cacheid = Digest::MD5::md5_hex($cacheid);
  return ('', 'Content-Type: text/plain') unless grep {($ofiles->{$_} || '') ne ($files->{$_} || '')} (keys %$ofiles, keys %$files);
  local *F;
  my $cn = "$diffcache/".substr($cacheid, 0, 2)."/$cacheid";
  if (open(F, '<', $cn)) {
    utime(time, time, $cn);
    BSServer::reply_file(\*F, 'Content-Type: text/plain');
    return undef;
  }
  my $tmpdir = "$uploaddir/srcdiff$$";
  my $d = BSSrcdiff::diff("$srcrep/$opackid", $ofiles, $orev->{'rev'}, "$srcrep/$packid", $files, $rev->{'rev'}, $fmax, $tmax, $tmpdir, $cgi->{'unified'});
  mkdir_p("$diffcache/".substr($cacheid, 0, 2));
  writestr("$diffcache/.new$$", $cn, $d);
  return ($d, 'Content-Type: text/plain');
}

sub linkdiff {
  my ($cgi, $projid, $packid) = @_;
  my $rev = getrev($projid, $packid, defined($cgi->{'rev'}) ? $cgi->{'rev'} : 'upload');
  $rev->{'linkrev'} = $cgi->{'linkrev'} if $cgi->{'linkrev'};
  my $linkinfo = {};
  my $files = lsrev_expanded($rev, $linkinfo);
  die("not a link\n") unless $linkinfo->{'srcmd5'};
  linkinfo_addtarget($rev, $linkinfo);
  return sourcediff({
    'oproject' => $linkinfo->{'project'},
    'opackage' => $linkinfo->{'package'},
    'orev' => $linkinfo->{'srcmd5'},
    'rev' => $rev->{'srcmd5'},
  }, $projid, $packid);
}

sub isascii {
  my ($file) = @_;
  local *F;
  open(F, '<', $file) || die("$file: $!\n");
  my $buf = '';
  sysread(F, $buf, 4096);
  close F;
  return 1 unless $buf =~ /[\000-\010\016-\037]/s;
  return 0;
}

sub rundiff {
  my ($file1, $file2, $label, $outfile) = @_;
  my $pid;
  if (!($pid = xfork())) {
    if (!open(STDOUT, '>>', $outfile)) {
      print STDERR "$outfile: $!\n";
      exit(2);
    }
    exec('diff', '-up', '--label', "$label.orig", '--label', $label, $file1, $file2);
    exit(2);
  }
  waitpid($pid, 0) == $pid || die("waitpid $pid: $!\n");
  my $status = $?;
  return 1 if $status == 0 || $status == 0x100;
  return undef;
}

sub findprojectpatchname {
  my ($files) = @_;

  my $i = "";
  while ($files->{"project$i.diff"}) {
    $i = '0' unless $i;
    $i++;
  }
  return "project$i.diff";
}

#
# we are going to commit files to projid/packid, all data is already present
# in the src repository.
# if it was a link before, try to keep this link
# files: expanded file set
#
sub keeplink {
  my ($cgi, $projid, $packid, $files, $orev) = @_;

  my $repair = $cgi->{'repairlink'};
  return $files if !defined($files) || !%$files;
  return $files if $files->{'_link'};
  $orev ||= getrev($projid, $packid, 'latest');
  my $ofilesl = lsrev($orev);
  return $files unless $ofilesl && $ofilesl->{'_link'};
  my $l = repreadxml($orev, '_link', $ofilesl->{'_link'}, $BSXML::link);
  my $changedlink = 0;
  my %lignore;
  my $isbranch;

  if (@{$l->{'patches'}->{''} || []} == 1) {
    my $type = (keys %{$l->{'patches'}->{''}->[0]})[0];
    if ($type eq 'branch') {
      $isbranch = 1;
    }
  }
  undef $isbranch if $cgi->{'convertbranchtopatch'};

  if (!$isbranch && $l->{'patches'}) {
    if ($repair) {
      for (@{$l->{'patches'}->{''} || []}) {
        my $type = (keys %$_)[0];
        if ($type eq 'apply' || $type eq 'delete' || $changedlink) {
          $lignore{$_->{$type}->{'name'}} = 1 if $type ne 'topadd' && $type ne 'delete';
	  $_ = undef;
	  $changedlink = 1;
	}
      }
    } else {
      for (reverse @{$l->{'patches'}->{''} || []}) {
        my $type = (keys %$_)[0];
        if ($type eq 'apply' || $type eq 'delete' || $type eq 'branch') {
          $lignore{$_->{$type}->{'name'}} = 1 if $type eq 'apply';
	  $_ = undef;
	  $changedlink = 1;
	  next;
	}
	last;
      }
    }
    $l->{'patches'}->{''} = [ grep {defined($_)} @{$l->{'patches'}->{''}} ];
  }

  my $linkrev = $cgi->{'linkrev'};
  $linkrev = $l->{'baserev'} if $linkrev && $linkrev eq 'base';

  my $ltgtsrcmd5;
  my $ofiles;
  my $ofilesdir;
  if (!$repair) {
    # expand old link
    my %olrev = %$orev;
    my %li;
    $olrev{'linkrev'} = $linkrev if $linkrev;
    $ofiles = handlelinks(\%olrev, $ofilesl, \%li);
    die("bad link: $ofiles\n") unless ref $ofiles;
    $ltgtsrcmd5 = $li{'srcmd5'};
    $ofilesdir = "$srcrep/$packid";
  }

  # get link target file list
  my $ltgtprojid = defined($l->{'project'}) ? $l->{'project'} : $projid;
  my $ltgtpackid = defined($l->{'package'}) ? $l->{'package'} : $packid;
  my $ltgtfiles;
  if ($ltgtsrcmd5) {
    my $ltgtrev = {'project' => $ltgtprojid, 'package' => $ltgtpackid, 'srcmd5' => $ltgtsrcmd5};
    $ltgtfiles = lsrev($ltgtrev);
  } else {
    my $ltgtrev = getrev($ltgtprojid, $ltgtpackid, $linkrev || $l->{'rev'});
    $ltgtfiles = lsrev_expanded($ltgtrev);
    $ltgtsrcmd5 = $ltgtrev->{'srcmd5'};
  }

  # easy for branches: just copy file list and update baserev
  if ($isbranch) {
    my $nfiles = { %$files };
    $nfiles->{'_link'} = $ofilesl->{'_link'};
    my $lchanged;
    my $baserev = $linkrev || $ltgtsrcmd5;
    if (($l->{'baserev'} || '') ne $baserev) {
      $l->{'baserev'} = $baserev;
      $lchanged = 1;
    }
    $cgi->{'setrev'} = $baserev if $cgi->{'setrev'} && $cgi->{'setrev'} eq 'base';
    if ($cgi->{'setrev'} && ($l->{'rev'} || '') ne $cgi->{'setrev'}) {
      $l->{'rev'} = $cgi->{'setrev'};
      $lchanged = 1;
    }
    if ($lchanged) {
      $l->{'patches'}->{''} = [ { 'branch' => undef} ]; # work around xml problem
      mkdir_p($uploaddir);
      writexml("$uploaddir/$$", undef, $l, $BSXML::link);
      $nfiles->{'_link'} = addfile($projid, $packid, "$uploaddir/$$", '_link')
    }
    return $nfiles;
  }

  if ($cgi->{'convertbranchtopatch'}) {
    $ofilesl = {};
    $ofiles = $ltgtfiles;
    $ofilesdir = "$srcrep/$ltgtpackid";
  } elsif ($repair || $changedlink) {
    # apply changed link
    my $frominfo = {'project' => $ltgtprojid, 'package' => $ltgtpackid, 'srcmd5' => $ltgtsrcmd5};
    my $linkinfo = {'project' => $projid, 'package' => $packid, 'srcmd5' => $orev->{'srcmd5'}, 'link' => $l};
    $linkinfo->{'ignore'} = \%lignore;
    $ofiles = applylink(undef, $frominfo, $linkinfo);
    die("bad link: $ofiles\n") unless ref $ofiles;
    $ofilesdir = "$uploaddir/applylink$$";
  }

  #print "-- ofilesl:\n";
  #print "  $ofilesl->{$_}  $_\n" for sort keys %$ofilesl;
  #print "-- ofiles:\n";
  #print "  $ofiles->{$_}  $_\n" for sort keys %$ofiles;
  #print "-- files:\n";
  #print "  $files->{$_}  $_\n" for sort keys %$files;

  # now create diff between old $ofiles and $files
  my $nfiles = { %$ofilesl };
  delete $nfiles->{$_} for keys %lignore;	# no longer used in link
  mkdir_p($uploaddir);
  unlink("$uploaddir/$$");
  my @dfiles;
  for my $file (sort keys %{{%$files, %$ofiles}}) {
    if ($ofiles->{$file}) {
      if (!$files->{$file}) {
	if (!$ltgtfiles->{$file} && $ofilesl->{$file} && $ofilesl->{$file} eq ($ofiles->{$file} || '')) {
	  # local file no longer needed
	  delete $nfiles->{$file};
	}
	push @dfiles, $file;
	delete $nfiles->{$file};
	next;
      }
      if ($ofiles->{$file} eq $files->{$file}) {
	next;
      }
      if (!isascii("$srcrep/$packid/$files->{$file}-$file") || !isascii("$ofilesdir/$ofiles->{$file}-$file")) {
	$nfiles->{$file} = $files->{$file};
	next;
      }
    } else {
      if (!isascii("$srcrep/$packid/$files->{$file}-$file")) {
	$nfiles->{$file} = $files->{$file};
	next;
      }
    }
    if (($ofilesl->{$file} || '') eq ($ofiles->{$file} || '')) {
      # link did not change file, just record new content
      if ($files->{$file} eq ($ltgtfiles->{$file} || '')) {
	# local overwrite already in link target
	delete $nfiles->{$file};
	next;
      }
      $nfiles->{$file} = $files->{$file};
      next;
    }
    # both are ascii, create diff
    mkdir_p($uploaddir);
    if (!rundiff($ofiles->{$file} ? "$ofilesdir/$ofiles->{$file}-$file" : '/dev/null', "$srcrep/$packid/$files->{$file}-$file", $file, "$uploaddir/$$")) {
      $nfiles->{$file} = $files->{$file};
    }
  }
  my $lchanged;
  $lchanged = 1 if $changedlink;
  for (@dfiles) {
    push @{$l->{'patches'}->{''}}, {'delete' => {'name' => $_}};
    $lchanged = 1;
  }
  if (-s "$uploaddir/$$") {
    my $ppatch = findprojectpatchname($nfiles);
    $nfiles->{$ppatch} = addfile($projid, $packid, "$uploaddir/$$", $ppatch);
    push @{$l->{'patches'}->{''}}, {'apply' => {'name' => $ppatch}};
    $lchanged = 1;
  } else {
    unlink("$uploaddir/$$");
  }
  my $baserev = $linkrev || $ltgtsrcmd5;
  if (($l->{'baserev'} || '') ne $baserev) {
    $l->{'baserev'} = $baserev;
    $lchanged = 1;
  }
  $cgi->{'setrev'} = $baserev if $cgi->{'setrev'} && $cgi->{'setrev'} eq 'base';
  if ($cgi->{'setrev'} && ($l->{'rev'} || '') ne $cgi->{'setrev'}) {
    $l->{'rev'} = $cgi->{'setrev'};
    $lchanged = 1;
  }
  if ($lchanged) {
    writexml("$uploaddir/$$", undef, $l, $BSXML::link);
    $nfiles->{'_link'} = addfile($projid, $packid, "$uploaddir/$$", '_link')
  }
  if ($ofilesdir eq "$uploaddir/applylink$$") {
    BSUtil::cleandir("$uploaddir/applylink$$");
    rmdir("$uploaddir/applylink$$");
  }
  return $nfiles;
}

# integrate link from opackid to packid into packid
sub integratelink {
  my ($files, $projid, $packid, $rev, $ofiles, $oprojid, $opackid, $l, $orev) = @_;

  # append patches from link l to link nl
  my $nl = repreadxml($rev, '_link', $files->{'_link'}, $BSXML::link);

  # FIXME: remove hunks from patches that deal with replaced/deleted files
  my $nlchanged;
  my %dontcopy;
  $dontcopy{'_link'} = 1;
  my $nlisbranch;
  if ($nl->{'patches'}) {
    for (@{$nl->{'patches'}->{''} || []}) {
      my $type = (keys %$_)[0];
      if ($type eq 'add' || $type eq 'apply') {
	$dontcopy{$_->{$type}->{'name'}} = 1;
      }
      $nlisbranch = 1 if $type eq 'branch';
    }
  }
  my $lisbranch;
  if ($l->{'patches'}) {
    for (@{$l->{'patches'}->{''} || []}) {
      my $type = (keys %$_)[0];
      $lisbranch = 1 if $type eq 'branch';
    }
  }

  if ($nlisbranch) {
    # we linked/branched a branch. expand.
    #my %xrev = (%$rev, 'linkrev' => 'base');
    my %xrev = %$rev;
    my $linkinfo = {};
    lsrev_expanded(\%xrev, $linkinfo);
    my %oxrev = (%$orev, 'linkrev' => $xrev{'srcmd5'});
    $ofiles = lsrev_expanded(\%oxrev);
    copyfiles($projid, $packid, $oprojid, $opackid, $ofiles);
    # find new base
    if ($linkinfo->{'srcmd5'} ne $nl->{'baserev'}) {
      # update base rev
      $nl->{'baserev'} = $linkinfo->{'srcmd5'};
      $nlchanged = 1;
    }
    # delete everything but the link
    delete $files->{$_} for grep {$_ ne '_link'} keys %$files;
  }

  if ($lisbranch && !$nlisbranch) {
    # we branched a link. convert branch to link
    # and integrate
    delete $ofiles->{'_link'};
    $ofiles = keeplink({'convertbranchtopatch' => 1, 'linkrev' => 'base'}, $oprojid, $opackid, $ofiles, $orev);
    $l = repreadxml($orev, '_link', $ofiles->{'_link'}, $BSXML::link);
  }

  if (!$nlisbranch && $l->{'patches'}) {
    for (@{$l->{'patches'}->{''} || []}) {
      my $type = (keys %$_)[0];
      if ($type eq 'delete' && $files->{$_->{'delete'}->{'name'}} && !$dontcopy{$_->{'delete'}->{'name'}}) {
	delete $files->{$_->{'delete'}->{'name'}};
      } else {
	$nlchanged = 1;
	$nl->{'patches'} ||= {};
	if ($type eq 'apply') {
	  my $oppatch = $_->{'apply'}->{'name'};
	  if ($files->{$oppatch}) {
	    $dontcopy{$oppatch} = 1;
	    # argh, patch file already exists, rename...
	    my $ppatch = findprojectpatchname($files);
	    mkdir_p($uploaddir);
	    unlink("$uploaddir/$$");
	    link("$srcrep/$opackid/$ofiles->{$oppatch}-$oppatch", "$uploaddir/$$") || die("link $srcrep/$opackid/$ofiles->{$oppatch}-$oppatch $uploaddir/$$: $!\n");
            $files->{$ppatch} = addfile($projid, $packid, "$uploaddir/$$", $ppatch);
	    push @{$nl->{'patches'}->{''}}, {'apply' => {'name' => $ppatch}};
	    next;
	  }
	}
	if ($type eq 'add') {
	  my $oppatch = $_->{'add'}->{'name'};
	  die("cannot apply patch $oppatch twice\n") if $dontcopy{$oppatch};
	}
        push @{$nl->{'patches'}->{''}}, $_;
      }
    }
  }
  if ($nlchanged) {
    mkdir_p($uploaddir);
    writexml("$uploaddir/$$", undef, $nl, $BSXML::link);
    $files->{'_link'} = addfile($projid, $packid, "$uploaddir/$$", '_link');
  }
  for (sort keys %$ofiles) {
    next if $dontcopy{$_};
    $files->{$_} = $ofiles->{$_};
  }
  return $files;
}

sub sourcecommit {
  my ($cgi, $projid, $packid) = @_;
  my $rev = getrev($projid, $packid, defined($cgi->{'rev'}) ? $cgi->{'rev'} : 'upload');
  my $files = lsrev($rev);
  $files = keeplink($cgi, $projid, $packid, $files) if $cgi->{'keeplink'};
  $rev = addrev($projid, $packid, $files, $cgi->{'user'}, $cgi->{'comment'});
  if (!$cgi->{'noservice'}) {
    my $prev = getrev($projid, '_project');
    my $pfiles = lsrev($prev);
    if ($files->{'_service'} || $pfiles->{'_service'}) {
      runservice($cgi, $projid, $packid);
    }
  }
  delete $rev->{'project'};
  delete $rev->{'package'};
  return ($rev, $BSXML::revision);
}

sub sourcecommitfilelist {
  my ($cgi, $projid, $packid) = @_;
  mkdir_p($uploaddir);
  my $uploaded = BSServer::read_file("$uploaddir/$$");
  die("upload failed\n") unless $uploaded;
  my $fl = readxml("$uploaddir/$$", $BSXML::dir);
  unlink("$srcrep/:upload/$$");
  # make sure we know every file
  my @missing;
  my $files = {};
  for my $entry (@{$fl->{'entry'} || []}) {
    BSVerify::verify_filename($entry->{'name'});
    BSVerify::verify_md5($entry->{'md5'});
    if (! -e "$srcrep/$packid/$entry->{'md5'}-$entry->{'name'}") {
      push @missing, $entry;
    } else {
      die("duplicate file: $entry->{'name'}\n") if exists $files->{$entry->{'name'}};
      $files->{$entry->{'name'}} = $entry->{'md5'};
    }
  }
  if (@missing) {
    my $res = {'name' => $packid, 'error' => 'missing', 'entry' => \@missing};
    return ($res, $BSXML::dir);
  }

  $files = keeplink($cgi, $projid, $packid, $files) if $cgi->{'keeplink'};
  if (-e "$projectsdir/$projid.pkg/$packid.upload-MD5SUMS") {
    # autocommit old update revision so that it doesn't get lost
    my $uploadrev = {'project' => $projid, 'package' => $packid, 'srcmd5' => 'upload'};
    my $uploadfiles = lsrev($uploadrev);
    addrev($projid, $packid, $uploadfiles, $cgi->{'user'}, 'autocommit', undef, $cgi->{'requestid'});
  }
  my $rev = addrev($projid, $packid, $files, $cgi->{'user'}, $cgi->{'comment'}, undef, $cgi->{'requestid'});

  if (!$cgi->{'noservice'}) {
    my $prev = getrev($projid, '_project');
    my $pfiles = lsrev($prev);
    if ($files->{'_service'} || $pfiles->{'_service'}) {
      runservice($cgi, $projid, $packid);
    }
  }

  $cgi->{'rev'} = $rev->{'rev'};
  return getfilelist($cgi, $projid, $packid);
}

# copy sources of entire project, project exists ensured by api.
sub copyproject {
  my ($cgi, $projid) = @_;
  my $oprojid = $cgi->{'oproject'};
  return $BSStdServer::return_ok if $oprojid eq $projid;

  my $proj = readproj($projid);
  my $oproj = readproj($oprojid);

  my $user = defined($cgi->{'user'}) && $cgi->{'user'} ne '' ? $cgi->{'user'} : 'unknown';
  my $comment = defined($cgi->{'comment'}) ? $cgi->{'comment'} : '';
  $user = str2utf8xml($user);
  $comment = str2utf8xml($comment);

  # use {} as we do not want to copy project linked packages
  my @pkgs = findpackages($oprojid, {});
  for my $packid (@pkgs) {
    if (! -e "$projectsdir/$projid.pkg/$packid.xml") {
      # new package, create. hopefully the API can deal with this
      my $opack = readpack($oprojid, $packid);
      my $pack = {
	'project' => $projid,
	'name' => $packid,
      };
      for (qw{title description sourceaccess}) {
        $pack->{$_} = $opack->{$_} if defined $opack->{$_};
      }
      mkdir_p($uploaddir);
      writexml("$uploaddir/copyproject$$", undef, $pack, $BSXML::pack);
      addrev_meta($cgi, $projid, $packid, "$uploaddir/copyproject$$", "$projectsdir/$projid.pkg/$packid.xml", '_meta');
    }
    if (-s "$projectsdir/$oprojid.pkg/$packid.rev") {
      my $lastorev;
      if ($cgi->{'withhistory'}) {
        # FIXME: races ahead
        # history copying is a bit tricky, as it renumbers the revisions
        my @allrevs = BSFileDB::fdb_getall("$projectsdir/$oprojid.pkg/$packid.rev", $srcrevlay);
	if (-e "$projectsdir/$projid.pkg/$packid.rev") {
	  my $lastrev = BSFileDB::fdb_getlast("$projectsdir/$projid.pkg/$packid.rev", $srcrevlay);
	  if ($lastrev && $lastrev->{'rev'}) {
	    for my $rev (@allrevs) {
	      $rev->{'rev'} += $lastrev->{'rev'};
	    }
	  }
	}
        # make trees available in new project
        my $treedir = $BSConfig::nosharedtrees ? "$treesdir/$projid/$packid" : "$treesdir/$packid";
        if ($BSConfig::nosharedtrees) {
          my $treedir = "$treesdir/$projid/$packid";
	  for my $rev (@allrevs) {
	    next if -e "$treedir/$rev->{'srcmd5'}-MD5SUMS";
            my $files = lsrev({ %$rev, 'project' => $oprojid, 'package' => $packid });
	    copyfiles($projid, $packid, $oprojid, $packid, $files);
	    addmeta($projid, $packid, $files);
	  }
	}
        BSFileDB::fdb_add_multiple("$projectsdir/$projid.pkg/$packid.rev", $srcrevlay, @allrevs);
	$lastorev = $allrevs[-1];
      } else {
	$lastorev = BSFileDB::fdb_getlast("$projectsdir/$oprojid.pkg/$packid.rev", $srcrevlay);
      }
      next unless $lastorev && $lastorev->{'rev'};
      # always do one new commit, we don't use addrev to have full control over vrev
      my $files = lsrev({ %$lastorev, 'project' => $oprojid, 'package' => $packid });
      copyfiles($projid, $packid, $oprojid, $packid, $files);
      addmeta($projid, $packid, $files);
      $lastorev->{'user'} = $user;
      $lastorev->{'comment'} = $comment;
      $lastorev->{'requestid'} = $cgi->{'requestid'};
      $lastorev->{'time'} = time();
      $lastorev->{'vrev'} += 1;
      delete $lastorev->{'rev'};
      $lastorev = BSFileDB::fdb_add_i("$projectsdir/$projid.pkg/$packid.rev", $srcrevlay, $lastorev);
      updatelinkinfodb($projid, $packid, { %$lastorev, 'project' => $oprojid, 'package' => $packid }, $files);
    }
    # XXX: does this make any sense?
    if ($cgi->{'withbinaries'}) {
      for my $repo (@{$proj->{'repository'} || []}) {
	my $orepo = (grep {$_->{'name'} eq $repo->{'name'}} @{$oproj->{'repository'} || []})[0];
	next unless $orepo;
	for my $arch (@{$repo->{'arch'} || []}) {
	  next unless grep {$_ eq $arch} @{$orepo->{'arch'} || []};

	  # same source and target repo/arch in both projects exists
	  my @args;
	  push @args, "cmd=copy";
	  push @args, "oproject=$oprojid";
	  push @args, "opackage=$packid"; # same package name
	  push @args, "orepository=$repo->{'name'}"; # same repo name
	  my $param = {
	    'uri' => "$BSConfig::reposerver/build/$projid/$repo->{'name'}/$arch/$packid",
	    'request' => 'POST',
	  };
	  eval {
	    # ignore failures for now
	    BSWatcher::rpc($param, undef, @args);
	  };
          warn($@) if $@;
	}
      }
    }
  }
  notify_repservers('project', $projid);
  return $BSStdServer::return_ok;
}

sub sourcecopy {
  my ($cgi, $projid, $packid) = @_;
  die("illegal rev parameter\n") if $cgi->{'rev'} && $cgi->{'rev'} ne 'upload';
  my $oprojid = exists($cgi->{'oproject'}) ? $cgi->{'oproject'} : $projid;
  my $opackid = exists($cgi->{'opackage'}) ? $cgi->{'opackage'} : $packid;
  my $orev = $cgi->{'orev'};
  $orev = getrev($oprojid, $opackid, defined($orev) ? $orev : 'latest');
  $orev->{'linkrev'} = $cgi->{'olinkrev'} if $cgi->{'olinkrev'};
  my $files = lsrev($orev);
  die("need a revision to copy\n") if !$cgi->{'rev'} && !$cgi->{'orev'} && $oprojid eq $projid && $opackid eq $packid && !($files->{'_link'} && $cgi->{'expand'});

  my $autosimplifylink;

  if ($files->{'_link'} && !$cgi->{'dontupdatesource'} && !$cgi->{'rev'}) {
    # fix me: do this in a more generic way
    my $ol = repreadxml($orev, '_link', $files->{'_link'}, $BSXML::link, 1);
    if ($ol) {
      my $lprojid = $oprojid;
      my $lpackid = $opackid;
      my $lrev = $ol->{'rev'};
      $lprojid = $ol->{'project'} if exists $ol->{'project'};
      $lpackid = $ol->{'package'} if exists $ol->{'package'};
      if ($lprojid eq $projid && $lpackid eq $packid) {
        # copy destination is target of link
	# we're integrating this link
        $lrev = getrev($lprojid, $lpackid, $lrev);
	my $lfiles = lsrev($lrev);
	if ($lfiles->{'_link'} && !$cgi->{'expand'}) {
	  # link to a link, join
	  $files = integratelink($lfiles, $lprojid, $lpackid, $lrev, $files, $oprojid, $opackid, $ol, $orev);
	} else {
	  # auto expand
	  $cgi->{'expand'} = 1;
	}
	$autosimplifylink = $ol;
      }
    }
  }

  if ($files->{'_link'} && $cgi->{'expand'}) {
    my %olrev = %$orev;		# copy so that orev still points to unexpanded sources
    $files = handlelinks(\%olrev, $files);
    die("broken link: $files\n") unless ref $files;
  }

  copyfiles($projid, $packid, $oprojid, $opackid, $files);

  $files = keeplink($cgi, $projid, $packid, $files) if $cgi->{'keeplink'};
  my $rev = addrev($projid, $packid, $files, $cgi->{'user'}, $cgi->{'comment'}, $cgi->{'rev'}, $cgi->{'requestid'});

  if ($autosimplifylink && !$autosimplifylink->{'rev'}) {
    my $isbranch = grep {(keys %$_)[0] eq 'branch'} @{$autosimplifylink->{'patches'}->{''} || []};
    if ($isbranch) {
      # update base rev so that there are no changes
      # FIXME: this is a gross hack...
      # we should not need to update the baserev, instead we should change
      # the way branches get applied
      my $ofiles = lsrev($orev);
      delete $ofiles->{'_link'};
      copyfiles($projid, $packid, $oprojid, $opackid, $ofiles);
      my $newbase = addmeta($projid, $packid, $ofiles);
      if ($autosimplifylink->{'baserev'} ne $newbase) {
	eval {
          my $latestorev = getrev($oprojid, $opackid);
          my $latestfiles = lsrev($latestorev);
          if ($latestfiles->{'_link'}) {
	    my $latestl = repreadxml($latestorev, '_link', $latestfiles->{'_link'}, $BSXML::link, 1);
	    my $latestisbranch = grep {(keys %$_)[0] eq 'branch'} @{$latestl->{'patches'}->{''} || []};
	    if ($latestisbranch && $latestl->{'baserev'} eq $autosimplifylink->{'baserev'}) {
	      $latestl->{'baserev'} = $newbase;
	      $latestl->{'patches'}->{''} = [ { 'branch' => undef} ]; # work around xml problem
	      mkdir_p($uploaddir);
	      writexml("$uploaddir/$$", undef, $latestl, $BSXML::link);
              $latestfiles->{'_link'} = addfile($oprojid, $opackid, "$uploaddir/$$", '_link');
              addrev($oprojid, $opackid, $latestfiles, 'buildservice-autocommit', "baserev update by copy to link target\n", undef, $cgi->{'requestid'});
	    }
	  }
	};
        warn($@) if $@;
      }
    } else {
      eval {
        my $latestorev = getrev($oprojid, $opackid);
        if ($latestorev->{'srcmd5'} eq $orev->{'srcmd5'}) {
          # simplify link
          my $nl = {};
          $nl->{'project'} = $autosimplifylink->{'project'} if $autosimplifylink->{'project'};
          $nl->{'package'} = $autosimplifylink->{'package'} if $autosimplifylink->{'package'};
          $nl->{'cicount'} = $autosimplifylink->{'cicount'} if $autosimplifylink->{'cicount'};
	  mkdir_p($uploaddir);
          writexml("$uploaddir/$$", undef, $nl, $BSXML::link);
          my $ofiles = {};
          $ofiles->{'_link'} = addfile($oprojid, $opackid, "$uploaddir/$$", '_link');
          addrev($oprojid, $opackid, $ofiles, 'buildservice-autocommit', "auto commit by copy to link target\n", undef, $cgi->{'requestid'});
        }
      };
      warn($@) if $@;
    }
  }

  delete $rev->{'project'};
  delete $rev->{'package'};
  return ($rev, $BSXML::revision);
}

sub sourcebranch {
  my ($cgi, $projid, $packid) = @_;

  my $usebranch = 1;
  my $oprojid = exists($cgi->{'oproject'}) ? $cgi->{'oproject'} : $projid;
  my $opackid = exists($cgi->{'opackage'}) ? $cgi->{'opackage'} : $packid;
  my $orev = $cgi->{'orev'};
  die("cannot branch myself\n") if $oprojid eq $projid && $opackid eq $packid;
  $orev = getrev($oprojid, $opackid);
  $orev->{'linkrev'} = $cgi->{'olinkrev'} if $cgi->{'olinkrev'};
  my $files = lsrev_expanded($orev);
  my $l = {};
  $l->{'project'} = $oprojid if $oprojid ne $projid;
  $l->{'package'} = $opackid if $opackid ne $projid;
  $l->{'rev'} = $cgi->{'orev'} if defined $cgi->{'orev'};
  $l->{'baserev'} = $orev->{'srcmd5'};
  my $lfiles = {};
  mkdir_p("$srcrep/$packid");
  if ($usebranch) {
    $l->{'patches'}->{''} = [ { 'branch' => undef} ];
    copyfiles($projid, $packid, $oprojid, $opackid, $files);
    $lfiles->{$_} = $files->{$_} for keys %$files;
  }
  mkdir_p($uploaddir);
  writexml("$uploaddir/$$", undef, $l, $BSXML::link);
  $lfiles->{'_link'} = addfile($projid, $packid, "$uploaddir/$$", '_link');
  my $rev = addrev($projid, $packid, $lfiles, $cgi->{'user'}, $cgi->{'comment'});
  delete $rev->{'project'};
  delete $rev->{'package'};
  BSNotify::notify("SRCSRV_BRANCH_COMMAND", {project => $projid, package => $packid, targetproject => $oprojid, targetpackage => $opackid,
                                             user => $cgi->{'user'}});
  return ($rev, $BSXML::revision);
}

sub linktobranch {
  my ($cgi, $projid, $packid) = @_;
  my $rev = getrev($projid, $packid);
  $rev->{'linkrev'} = $cgi->{'linkrev'} if $cgi->{'linkrev'};
  my $files = lsrev($rev);
  die("package is not a link\n") unless $files->{'_link'};
  my $l = repreadxml($rev, '_link', $files->{'_link'}, $BSXML::link);
  die("package is already a branch\n") if $l->{'patches'} && grep {(keys %$_)[0] eq 'branch'} @{$l->{'patches'}->{''} || []};
  my $linkinfo = {};
  $files = lsrev_expanded($rev, $linkinfo);
  $l->{'baserev'} = $linkinfo->{'srcmd5'};
  $l->{'patches'}->{''} = [ { 'branch' => undef} ];
  mkdir_p($uploaddir);
  writexml("$uploaddir/$$", undef, $l, $BSXML::link);
  $files->{'_link'} = addfile($projid, $packid, "$uploaddir/$$", '_link');
  $rev = addrev($projid, $packid, $files, $cgi->{'user'}, $cgi->{'comment'} || "converted link to branch");
  delete $rev->{'project'};
  delete $rev->{'package'};
  runservice($projid, $packid) if $files->{'_service'};
  return ($rev, $BSXML::revision);
}

sub deleteuploadrev {
  my ($cgi, $projid, $packid) = @_;
  unlink("$projectsdir/$projid.pkg/$packid.upload-MD5SUMS");
  return $BSStdServer::return_ok;
}

sub unknowncmd {
  my ($cgi, $projid, $packid) = @_;
  die("unknown command \"$cgi->{'cmd'}\"\n");
}

sub delfile {
  my ($cgi, $projid, $packid, $filename) = @_;
  die("no filename\n") unless defined($filename) && $filename ne '';
  die("bad filename\n") if $filename =~ /\// || $filename =~ /^\./;
  die("file '$filename' is read-only\n") if ($filename =~ /^_service:/) && not $cgi->{'force'};
  my $rev = getrev($projid, $packid, defined($cgi->{'rev'}) ? $cgi->{'rev'} : 'upload');
  my $files;
  if ($cgi->{'keeplink'}) {
    $files = lsrev_expanded($rev);
  } else {
    $files = lsrev($rev);
  }
  die("404 file '$filename' does not exist\n") unless $files->{$filename};
  delete $files->{$filename};
  $files = keeplink($projid, $packid, $files) if $cgi->{'keeplink'};
  $rev = addrev($projid, $packid, $files, $cgi->{'user'}, $cgi->{'comment'}, $cgi->{'rev'});
  delete $rev->{'project'};
  delete $rev->{'package'};
  runservice($cgi, $projid, $packid);
  return ($rev, $BSXML::revision);
}

sub getrepositorylist {
  my ($cgi, $projid) = @_;
  my $proj = checkprojrepoarch($projid, undef, undef, 1);
  if ($proj->{'remoteurl'}) {
    return (BSRPC::rpc({'uri' => "$proj->{'remoteurl'}/build/$proj->{'remoteproject'}", 'proxy' => $proxy}, $BSXML::dir), $BSXML::dir);
  }
  my @res = map {{'name' => $_->{'name'}}} @{$proj->{'repository'} || []};
  return ({'entry' => \@res}, $BSXML::dir);
}

sub getrepository {
  my ($cgi, $projid, $repoid) = @_;
  my $proj = readproj($projid);
  my $repo = (grep {$_->{'name'} eq $repoid} @{$proj->{'repository'} || []})[0];
  die("404 $repoid: no such repository\n") unless $repo;
  return ($repo, $BSXML::repo);
}

sub getarchlist {
  my ($cgi, $projid, $repoid) = @_;
  my $proj = checkprojrepoarch($projid, $repoid, undef, 1);
  if ($proj->{'remoteurl'}) {
    return (BSRPC::rpc({'uri' => "$proj->{'remoteurl'}/build/$proj->{'remoteproject'}", 'proxy' => $proxy}, $BSXML::dir), $BSXML::dir);
  }
  my @repo = grep {$_->{'name'} eq $repoid} @{$proj->{'repository'} || []};
  die("404 $repoid: no such repository\n") unless @repo;
  my @res = map {{'name' => $_}} @{$repo[0]->{'arch'} || []};
  return ({'entry' => \@res}, $BSXML::dir);
}

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

  if ($cgi->{'oldstate'} && !$BSStdServer::isajax) {
    my @args = "oldstate=$cgi->{'oldstate'}";
    push @args, "lastbuild" if $cgi->{'lastbuild'};
    push @args, map {"view=$_"} @{$cgi->{'view'} || []};
    push @args, map {"repository=$_"} @{$cgi->{'repository'} || []};
    push @args, map {"arch=$_"} @{$cgi->{'arch'} || []};
    push @args, map {"package=$_"} @{$cgi->{'package'} || []};
    push @args, map {"code=$_"} @{$cgi->{'code'} || []};
    BSHandoff::handoff($ajaxsocket, "/build/$projid/_result", undef, @args);
    exit(0);
  }

  my %repoidfilter = map {$_ => 1} @{$cgi->{'repository'} || []};
  my %archfilter = map {$_ => 1} @{$cgi->{'arch'} || []};
  my %view = map {$_ => 1} @{$cgi->{'view'} || ['status']};
  my %code = map {$_ => 1} @{$cgi->{'code'} || []};

  my $proj = readproj($projid);
  if ($cgi->{'repository'}) {
    my %knownrepoids = map {$_->{'name'} => 1} @{$proj->{'repository'} || []};
    for (@{$cgi->{'repository'}}) {
      die("404 unknown repository '$_'\n") if !$knownrepoids{$_};
    }
  }
  if ($cgi->{'package'}) {
    my %knownpackids = map {$_ => 1} findpackages($projid, $proj, 1);
    for (@{$cgi->{'package'}}) {
      die("404 unknown package '$_'\n") if !$knownpackids{$_};
    }
  }
  my @prpas;
  for my $repo (@{$proj->{'repository'} || []}) {
    next if %repoidfilter && !$repoidfilter{$repo->{'name'}};
    my @archs = @{$repo->{'arch'} || []};
    @archs = grep {$archfilter{$_}} @archs if %archfilter;
    push @prpas, map {"$projid/$repo->{'name'}/$_"} @archs;
  }

  BSWatcher::addfilewatcher("$projectsdir/$projid.xml") if $BSStdServer::isajax;

  if (!@prpas) {
    my $state = "00000000000000000000000000000000";
    return undef if $BSStdServer::isajax && $cgi->{'oldstate'} && $state eq $cgi->{'oldstate'};
    return ({'state' => $state}, $BSXML::resultlist);
  }

  my $ps = {};
  # XXX FIXME multiple repo handling
  for my $rrserver ($BSConfig::reposerver) {
    my @args;
    push @args, 'lastbuild' if $cgi->{'lastbuild'};
    push @args, "oldstate=$cgi->{'oldstate'}" if $cgi->{'oldstate'};
    push @args, map {"prpa=$_"} @prpas;
    push @args, map {"package=$_"} @{$cgi->{'package'} || []};
    push @args, map {"code=$_"} @{$cgi->{'code'} || []};
    push @args, 'withbinarylist' if $view{'binarylist'};
    push @args, 'summary' if $view{'summary'} && !$view{'status'};
    eval {
      $ps = BSWatcher::rpc("$rrserver/_result", $BSXML::resultlist, @args);
    };
    if ($@) {
      print "warning: $rrserver: $@";
      $ps = {};
    }
  }
  return if $BSStdServer::isajax && !defined($ps);
  if ($view{'summary'} && $view{'status'}) {
    my @order = ('succeeded', 'failed', 'unresolvable', 'broken', 'scheduled');
    my %order = map {$_ => 1} @order;
    for my $p (@{$ps->{'result'} || []}) {
      my %sum;
      for my $pp (@{$p->{'status'} || []}) {
        $sum{$pp->{'code'}}++ if $pp->{'code'};
      }
      my @sum = grep {exists $sum{$_}} @order;
      push @sum, grep {!$order{$_}} sort keys %sum;
      $p->{'summary'} = {'statuscount' => [ map {{'code' => $_, 'count' => $sum{$_}}} @sum ] };
    }
  }
  if (!$view{'status'}) {
    for my $p (@{$ps->{'result'} || []}) {
      delete $p->{'status'};
    }
  }
  return ($ps, $BSXML::resultlist);
}

sub docommand {
  my ($cgi, $projid) = @_;

  my %repoidfilter = map {$_ => 1} @{$cgi->{'repository'} || []};
  my %archfilter = map {$_ => 1} @{$cgi->{'arch'} || []};

  my $proj = readproj($projid);
  my @prpas;
  for my $repo (@{$proj->{'repository'} || []}) {
    next if %repoidfilter && !$repoidfilter{$repo->{'name'}};
    my @archs = @{$repo->{'arch'} || []};
    @archs = grep {$archfilter{$_}} @archs if %archfilter;
    push @prpas, map {"$projid/$repo->{'name'}/$_"} @archs;
  }
  die("no repository defined\n") unless @prpas;
  my @packids = @{$cgi->{'package'} || []};
  if (@packids) {
    my %packids = map {$_ => 1} findpackages($projid, $proj, 1);
    my @badpacks = grep {!$packids{$_}} @packids;
    die("404 unknown package: @badpacks\n") if @badpacks;
  } else {
    @packids = findpackages($projid, $proj);
  }
  die("no packages defined\n") unless @packids;
  
  # XXX FIXME multiple repo handling
  my $res;
  for my $rrserver ($BSConfig::reposerver) {
    my @args;
    push @args, map {"prpa=$_"} @prpas;
    push @args, map {"package=$_"} @packids;
    push @args, map {"code=$_"} @{$cgi->{'code'} || []};
    push @args, "cmd=$cgi->{'cmd'}";
    my $param = {
      'uri' => "$rrserver/_command",
      'request' => 'POST',
    };
    $res = BSWatcher::rpc($param, undef, @args);
  }
  return $res;
}

sub checkprojrepoarch {
  my ($projid, $repoid, $arch, $remoteok) = @_;
  my $proj = readproj($projid, 1);
  $proj = remoteprojid($projid) if $remoteok && (!$proj || $proj->{'remoteurl'});
  die("404 project '$projid' does not exist\n") if !$proj;
  die("404 project '$projid' is remote\n") if $proj->{'remoteurl'} && !$remoteok;
  return $proj if $proj->{'remoteurl'};
  return $proj unless defined $repoid;
  my $repo = (grep {$_->{'name'} eq $repoid} @{$proj->{'repository'} || []})[0];
  die("404 project has no repository '$repoid'\n") unless $repo;
  return $proj unless defined $arch;
  die("404 project has no architecture '$arch'\n") unless grep {$_ eq $arch} @{$repo->{'arch'} || []};
  return $proj;
}

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

  checkprojrepoarch($projid, $repoid, $arch);
  my @args;
  push @args, map {"package=$_"} @{$cgi->{'package'} || []};
  push @args, "view=$cgi->{'view'}" if $cgi->{'view'};
  my $res = BSWatcher::rpc("$BSConfig::reposerver/build/$projid/$repoid/$arch/_builddepinfo", $BSXML::builddepinfo, @args);
  return ($res, $BSXML::builddepinfo);
}

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

  checkprojrepoarch($projid, $repoid, $arch);
  my @args;
  push @args, "limit=$cgi->{'limit'}" if $cgi->{'limit'};
  push @args, map {"package=$_"} @{$cgi->{'package'} || []};
  push @args, map {"code=$_"} @{$cgi->{'code'} || []};
  my $res = BSWatcher::rpc("$BSConfig::reposerver/build/$projid/$repoid/$arch/_jobhistory", $BSXML::jobhistlist, @args);
  return ($res, $BSXML::jobhistlist);
}


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

  my $proj = checkprojrepoarch($projid, $repoid, $arch, 1);
  my $view = $cgi->{'view'};
  my @args;
  push @args, "view=$view" if $view;
  push @args, map {"binary=$_"} @{$cgi->{'binary'} || []};
  if ($view && ($view eq 'cache' || $view eq 'cpio' || $view eq 'solv' || $view eq 'solvstate')) {
    if (!$BSStdServer::isajax) {
      BSHandoff::handoff($ajaxsocket, "/build/$projid/$repoid/$arch/$packid", undef, @args);
      exit(0);
    }
    my $param = {
      'uri' => "$BSConfig::reposerver/build/$projid/$repoid/$arch/$packid",
      'ignorestatus' => 1,
      'receiver' => \&BSServer::reply_receiver,
    };
    if ($proj->{'remoteurl'}) {
      $param->{'uri'} = "$proj->{'remoteurl'}/build/$proj->{'remoteproject'}/$repoid/$arch/$packid";
      $param->{'proxy'} = $proxy;
    }
    BSWatcher::rpc($param, undef, @args);
    return undef;
  }
  my $uri = "$BSConfig::reposerver/build/$projid/$repoid/$arch/$packid";
  if ($proj->{'remoteurl'}) {
    $uri = {'uri' => "$proj->{'remoteurl'}/build/$proj->{'remoteproject'}/$repoid/$arch/$packid"};
    $uri->{'proxy'} = $proxy;
  }
  if ($view && $view eq 'binaryversions') {
    push @args, 'nometa=1' if $cgi->{'nometa'};
    my $bvl = BSWatcher::rpc($uri, $BSXML::binaryversionlist, @args);
    return ($bvl, $BSXML::binaryversionlist);
  }
  my $bl = BSWatcher::rpc($uri, $BSXML::binarylist, @args);
  return ($bl, $BSXML::binarylist);
}

sub getbinary {
  my ($cgi, $projid, $repoid, $arch, $packid, $filename) = @_;
  my $proj = checkprojrepoarch($projid, $repoid, $arch, 1);
  my $view = $cgi->{'view'} || '';
  if ($proj->{'remoteurl'}) {
    # hack: reroute to /getbinaries so that our local cache is used
    die("can only access remote _repository files\n") unless $packid eq '_repository';
    die("cannot use a view for remote binaries\n") if $view;
    die("need the raw package name as filename for remote repository access\n") if $filename =~ /\.(?:rpm|deb)$/;
    my @args;
    push @args, "project=$projid";
    push @args, "repository=$repoid";
    push @args, "arch=$arch";
    push @args, "binaries=$filename";
    push @args, "raw=1";
    BSHandoff::handoff($ajaxsocket, '/getbinaries', undef, @args);
    exit(0);
  }
  my @args;
  push @args, "view=$view" if $view;
  my $param = {
    'uri' => "$BSConfig::reposerver/build/$projid/$repoid/$arch/$packid/$filename",
    'ignorestatus' => 1,
    'receiver' => \&BSServer::reply_receiver,
  };
  BSWatcher::rpc($param, undef, @args);
  return undef;
}

sub putbinary {
  my ($cgi, $projid, $repoid, $arch, $filename) = @_;
  checkprojrepoarch($projid, $repoid, $arch);
  my @args;
  push @args, 'ignoreolder=1' if $cgi->{'ignoreolder'};
  push @args, 'wipe=1' if $cgi->{'wipe'};
  my $param = {
    'uri' => "$BSConfig::reposerver/build/$projid/$repoid/$arch/_repository/$filename",
    'request' => 'PUT',
    'data' => \&BSServer::forward_sender,
    'chunked' => 1,
  };
  # XXX add return type checking
  return BSWatcher::rpc($param, undef, @args);
}

sub delbinary {
  my ($cgi, $projid, $repoid, $arch, $filename) = @_;
  checkprojrepoarch($projid, $repoid, $arch);
  my $param = {
    'uri' => "$BSConfig::reposerver/build/$projid/$repoid/$arch/_repository/$filename",
    'request' => 'DELETE',
  };
  return BSWatcher::rpc($param, undef);
}

sub copybuild {
  my ($cgi, $projid, $repoid, $arch, $packid) = @_;
  die("illegal package '$packid'\n") if $packid =~ /^_/;
  checkprojrepoarch($projid, $repoid, $arch);
  my $oprojid = defined($cgi->{'oproject'}) ? $cgi->{'oproject'} : $projid;
  my $opackid = defined($cgi->{'opackage'}) ? $cgi->{'opackage'} : $packid;
  my $orepoid = defined($cgi->{'orepository'}) ? $cgi->{'orepository'} : $repoid;
  die("nothing to do\n") if "$oprojid/$opackid/$orepoid" eq "$projid/$packid/$repoid";
  checkprojrepoarch($oprojid, $orepoid, $arch);
  # make sure the packages exist. not cheap, but does everything we need
  getrev($projid, $packid);
  getrev($oprojid, $opackid);
  my @args;
  push @args, "cmd=copy";
  push @args, "oproject=$oprojid";
  push @args, "opackage=$opackid";
  push @args, "orepository=$orepoid";
  push @args, "setupdateinfoid=$cgi->{'setupdateinfoid'}" if $cgi->{'setupdateinfoid'};
  my $param = {
    'uri' => "$BSConfig::reposerver/build/$projid/$repoid/$arch/$packid",
    'request' => 'POST',
  };
  # XXX add return type checking
  return BSWatcher::rpc($param, undef, @args);
}

sub uploadbuild {
  my ($cgi, $projid, $repoid, $arch, $packid) = @_;
  die("illageal package '$packid'\n") if $packid =~ /^_/;
  checkprojrepoarch($projid, $repoid, $arch);
  my $param = {
    'uri' => "$BSConfig::reposerver/build/$projid/$repoid/$arch/$packid",
    'request' => 'POST',
    'data' => \&BSServer::forward_sender,
    'chunked' => 1,
  };
  # XXX add return type checking
  return BSWatcher::rpc($param, undef);
}


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

  if (!$cgi->{'start'}) {
    # check if the package is broken
    my $rev = getrev($projid, $packid, 'build');
    my $files = lsrev($rev);
    if (ref($files) && $files->{'_link'}) {
      $files = handlelinks($rev, $files);
      if (!ref $files) {
	my $error = "$files\n";
	if ($rev->{'srcmd5'}) {
	  $files = lsrev($rev);
	  if ($files->{'_linkerror'}) {
	    $error = readstr("$srcrep/$packid/$files->{'_linkerror'}-_linkerror", 1);
	  }
	}
	if ($cgi->{'view'} && $cgi->{'view'} eq 'entry') {
	  my $entry = {'name' => '_log', 'size' => length($error)};
	  return ({'entry' => [ $entry ]}, $BSXML::dir);
	}
	return $error;
      }
    }
  }

  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'};
  push @args, "view=$cgi->{'view'}" if $cgi->{'view'};
  if (!$BSStdServer::isajax && !$cgi->{'view'}) {
    my $url = "/build/$projid/$repoid/$arch/$packid/_log";
    BSHandoff::handoff($ajaxsocket, $url, undef, @args);
    exit(0);
  }
  my $param = {
    'uri' => "$BSConfig::reposerver/build/$projid/$repoid/$arch/$packid/_log",
    'ignorestatus' => 1,
    'receiver' => \&BSServer::reply_receiver,
    'joinable' => 1,
  };
  BSWatcher::rpc($param, undef, @args);
  return undef; # always streams result
}

sub getbuildhistory {
  my ($cgi, $projid, $repoid, $arch, $packid) = @_;
  checkprojrepoarch($projid, $repoid, $arch);
  my @args;
  push @args, "limit=$cgi->{'limit'}" if $cgi->{'limit'};
  my $buildhist = BSWatcher::rpc("$BSConfig::reposerver/build/$projid/$repoid/$arch/$packid/_history", $BSXML::buildhist, @args);
  return ($buildhist, $BSXML::buildhist);
}

sub getbuildinfo {
  my ($cgi, $projid, $repoid, $arch, $packid) = @_;
  checkprojrepoarch($projid, $repoid, $arch);
  my @args;
  push @args, 'internal=1' if $cgi->{'internal'};
  push @args, map {"add=$_"} @{$cgi->{'add'} || []};
  my $buildinfo = BSWatcher::rpc("$BSConfig::reposerver/build/$projid/$repoid/$arch/$packid/_buildinfo", $BSXML::buildinfo, @args);
  return ($buildinfo, $BSXML::buildinfo);
}

sub getbuildinfo_post {
  my ($cgi, $projid, $repoid, $arch, $packid) = @_;
  checkprojrepoarch($projid, $repoid, $arch);
  my @args;
  push @args, map {"add=$_"} @{$cgi->{'add'} || []};
  my $param = {
    'uri' => "$BSConfig::reposerver/build/$projid/$repoid/$arch/$packid/_buildinfo",
    'request' => 'POST',
    'data' => \&BSServer::forward_sender,
    'chunked' => 1,
  };
  my $buildinfo = BSWatcher::rpc($param, $BSXML::buildinfo, @args);
  return ($buildinfo, $BSXML::buildinfo);
}

sub getbuildreason {
  my ($cgi, $projid, $repoid, $arch, $packid) = @_;
  checkprojrepoarch($projid, $repoid, $arch);
  my $reason = BSWatcher::rpc("$BSConfig::reposerver/build/$projid/$repoid/$arch/$packid/_reason", $BSXML::buildreason);
  return ($reason, $BSXML::buildreason);
}

sub getbuildstatus {
  my ($cgi, $projid, $repoid, $arch, $packid) = @_;
  checkprojrepoarch($projid, $repoid, $arch);
  my $status = BSWatcher::rpc("$BSConfig::reposerver/build/$projid/$repoid/$arch/$packid/_status", $BSXML::buildstatus);
  return ($status, $BSXML::buildstatus);
}

sub getworkerstatus {
  my ($cgi) = @_;
  my @args;
  push @args, 'scheduleronly' if $cgi->{'scheduleronly'};
  push @args, map {"arch=$_"} @{$cgi->{'arch'} || []};
  my $ws = BSWatcher::rpc("$BSConfig::reposerver/workerstatus", $BSXML::workerstatus, @args);
  delete $_->{'uri'} for @{$ws->{'idle'}};
  delete $_->{'uri'} for @{$ws->{'building'}};
  return ($ws, $BSXML::workerstatus);
}

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

sub search_proj {
  my ($cgi, $match, $id) = @_;
  $match =~ s/^\[(.*)\]$/$1/s;
  my $data = [];
  for my $projid (findprojects()) {
    my $proj = readproj($projid);
    push @$data, $proj;
  }
  $data = BSXPath::match($data, $match);
  if ($id) {
    for (@{$data || []}) {
      $_ = {'name' => $_->{'name'}};
    }
  }
  my $res = {'project' => $data};
  return ($res, $BSXML::collection);
}

sub pkgsearch_fetch {
  my ($db, $k) = @_;
  my ($projid, $packid) = split('/', $k, 2);
  my $pack = readpack($projid, $packid, 1) || {'name' => $packid};
  $pack->{'project'} = $projid;
  #my @linkinfo = BSDBIndex::getvalues($db, 'linkinfo', $k);
  #$pack->{'linkinfo'} = $linkinfo[0] if @linkinfo;
  return $pack;
}

sub pkgsearch_indexfunc {
  my ($db, $path, $value, $lkeys) = @_;
  if (!defined($path)) {
    return @{$db->{'_allkeys'}} if $db->{'_allkeys'};
    my @projids = findprojects();
    my @r;
    for my $projid (@projids) {
      push @r, map {"$projid/$_"} findpackages($projid, {}, 1);
    }
    $db->{'_allkeys'} = \@r;
    return @r;
  } elsif (!defined($value)) {
    return BSDBIndex::getkeys($db, "$db->{'index'}$path") if $path =~ /^linkinfo\//;
    return findprojects() if $path eq 'project';
    if ($path eq 'name') {
      $lkeys = [ pkgsearch_indexfunc($db) ] unless $lkeys;
      my %v = map {$_ => 1} grep {s/^.*\///} map {$_} @$lkeys;
      return sort keys %v;
    }
  } else {
    return BSDBIndex::getvalues($db, "$db->{'index'}$path", $value) if $path =~ /^linkinfo\//;
    return map {"$value/$_"} findpackages($value, {}, 1) if $path eq 'project';
    if ($path eq 'name') {
      $lkeys = [ pkgsearch_indexfunc($db) ] unless $lkeys;
      return grep {/\Q$value\E$/} @$lkeys;
    }
  }
  return ();
}

sub search_pack {
  my ($cgi, $match, $id) = @_;
  $match =~ s/^\[(.*)\]$/$1/s;
  # really ugly hack to speed up needed api call
  if ($match =~ /^\@project='(.+)' and starts-with\(\@name,'(.+)'\)$/) {
    my $projid = $1;
    my $startswith = $2;
    $projid =~ s/''/'/g;
    $startswith =~ s/''/'/g;
    my @packages = findpackages($projid, {});
    my $data = [];
    for my $packid (grep {/^\Q$startswith\E/} @packages) {
      my ($pack, undef) = getpackage($cgi, $projid, $packid);
      $pack->{'project'} = $projid;
      push @$data, $pack;
    }
    my $res = {'package' => $data};
    return ($res, $BSXML::collection);
  }
  my $db = BSDB::opendb($sourcedb, '');
  $db->{'indexfunc'} = {
    'project' => \&pkgsearch_indexfunc,
    'name' => \&pkgsearch_indexfunc,
    'linkinfo/project' => \&pkgsearch_indexfunc,
    'linkinfo/package' => \&pkgsearch_indexfunc,
    'linkinfo/rev' => \&pkgsearch_indexfunc,
  };
  $db->{'noindexatall'} = 1;
  $db->{'fetch'} = \&pkgsearch_fetch;
  my $data = BSXPathKeys::node($db, '');
  if ($id) {
    $data = $data->keymatch($match);
    for (@$data) {
      my @p = split('/', $_, 2);
      $_ = {'name' => $p[1], 'project' => $p[0]};
    }
  } else {
    $data = BSXPath::match($data, $match);
    delete $_->{'linkinfo'} for @$data;
  }
  my $res = {'package' => $data};
  return ($res, $BSXML::collection);
}

sub search_proj_id {
  return search_proj(@_, 1);
}

sub search_pack_id {
  return search_pack(@_, 1);
}

#############################################################################

sub search_published_updatedb {
  my ($cgi) = @_;
  die("unknown command '$cgi->{'cmd'}'\n") unless $cgi->{'cmd'} eq 'updatedb';
  my $data = BSServer::read_data();
  $data = Storable::thaw($data);
  die("no data\n") unless $data && @$data;
  my $patterndb;
  my $binarydb;
  my $repoinfodb;
  mkdir_p($extrepodb) unless -d $extrepodb;
  while (@$data) {
    my ($w, $k, $v) = splice(@$data, 0, 3);
    if ($w eq 'binary') {
      $binarydb = BSDB::opendb($extrepodb, 'binary') unless $binarydb;
      $binarydb->updateindex_rel($k || [], $v || []);
    } elsif ($w eq 'pattern') {
      $patterndb = BSDB::opendb($extrepodb, 'pattern') unless $patterndb;
      $patterndb->store($k, $v);
    } elsif ($w eq 'repoinfo') {
      if (!$repoinfodb) {
        $repoinfodb = BSDB::opendb($extrepodb, 'repoinfo');
        $repoinfodb->{'noindexatall'} = 1;
      };
      $repoinfodb->store($k, $v);
    } else {
      die("bad data type: '$w'\n");
    }
  }
  return $BSStdServer::return_ok;
}

#sub search_published_id {
#  my ($cgi, $what, $match) = @_;
#  my $res;
#  for my $rrserver ($BSConfig::reposerver) {
#    $res = BSRPC::rpc("$rrserver/search/published/$what/id", $BSXML::collection, "match=$match");
#    last if $res;
#  }
#  return ($res, $BSXML::collection);
#}
#
#sub search_published_binary_id {
#  return search_published_id($_[0], 'binary', $_[1]);
#}
#
#sub search_published_pattern_id {
#  return search_published_id($_[0], 'pattern', $_[1]);
#}

my %prp_to_repoinfo;

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

  my $repoinfo = $prp_to_repoinfo{$prp};
  if (!$repoinfo) {
    my $repoinfodb = BSDB::opendb($extrepodb, 'repoinfo');
    $repoinfo = $repoinfodb->fetch($prp);
    if ($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 published_projectindexfunc {
  my ($db, $path, $value) = @_;
  return findprojects() unless defined $value;
  my $proj = readproj($value);
  return () unless $proj;
  my @repoids = map {$_->{'name'}} @{$proj->{'repository'} || []};
  my %bins;
  for my $repoid (@repoids) {
    my $prp = "$value/$repoid";
    my $prp_ext = $prp;
    $prp_ext =~ s/:/:\//g;
    my $repoinfo = $prp_to_repoinfo{$prp} || prp_to_repoinfo($prp);
    for (keys %{$repoinfo->{'binaryorigins'} || {}}) {
      next unless /\//;
      $bins{"$prp_ext/$_"} = 1;
    }
  }
  return sort keys %bins;
}

sub search_published_binary_id {
  my ($cgi, $match) = @_;
  my $binarydb = BSDB::opendb($extrepodb, 'binary');
  $binarydb->{'allkeyspath'} = 'name';
  $binarydb->{'noindex'} = {'version' => 1, 'arch' => 1, 'project' => 1, 'repository' => 1, 'package' => 1, 'type' => 1, 'path/project' => 1, 'path/repository' => 1};
  $binarydb->{'indexfunc'} = {'project' => \&published_projectindexfunc };
  $binarydb->{'fetch'} = \&binary_key_to_data;
  $binarydb->{'cheapfetch'} = 1;
  my $limit = defined($cgi->{'limit'}) ? $cgi->{'limit'} : 1000;
  my $rootnode = BSXPathKeys::node($binarydb, '', $limit * 10);
  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;
  my $res = {};
  $res->{'matches'} = @$data;
  $res->{'limited'} = 'true' if $limit && @$data > $limit;
  splice(@$data, $limit) if $limit && @$data > $limit;
  delete $_->{'path'} for @$data;
  $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 $limit = defined($cgi->{'limit'}) ? $cgi->{'limit'} : 1000;
  my $rootnode = BSXPathKeys::node($patterndb, '', $limit * 10);
  my $data = BSXPath::match($rootnode, $match) || [];
  my $res = {};
  $res->{'matches'} = @$data;
  $res->{'limited'} = 'true' if $limit && @$data > $limit;
  splice(@$data, $limit) if $limit && @$data > $limit;
  for (@$data) {
    delete $_->{'path'};
    delete $_->{'description'};
    delete $_->{'summary'};
  }
  $res->{'pattern'} = $data;
  return ($res, $BSXML::collection);
}

#############################################################################

sub search {
  my ($cgi, $in, $match) = @_;
  # gather all data
  my $data = [];
  if ($in eq 'projects') {
    for my $projid (findprojects()) {
      my $proj = readproj($projid);
      push @$data, $proj;
    }
  } elsif ($in eq 'packages') {
    for my $projid (findprojects()) {
      my @packages = findpackages($projid, {});
      for my $packid (@packages) {
        my ($pack, undef) = getpackage($cgi, $projid, $packid);
	$pack->{'project'} = $projid;
        push @$data, $pack;
      }
    }
  } else {
    die("'in' parameter needs to be either 'projects' or 'packages'\n");
  }
  my $res;
  if ($cgi->{'values'}) {
    $data = BSXPath::valuematch($data, $match);
    $res = {'value' => $data};
  } else {
    $data = BSXPath::match($data, $match);
    if (exists $cgi->{'return'}) {
      $data = BSXPath::valuematch($data, $cgi->{'return'});
      $res = {'value' => $data};
    } elsif ($in eq 'projects') {
      $res = {'project' => $data};
    } else {
      $res = {'package' => $data};
    }
  }
  return ($res, $BSXML::collection);
}

sub postrepo {
  my ($cgi, $projid, $repoid, $arch) = @_;
  my $param = {
    'uri' => "$BSConfig::reposerver/build/$projid/$repoid/$arch/_repository",
    'request' => 'POST',
  };
  my $res = BSWatcher::rpc($param, $BSXML::collection, "match=$cgi->{'match'}");
  return ($res, $BSXML::collection);
}

sub service {
  my ($cgi, $service) = @_;
  die("404 no such service '$service'\n") unless $BSConfig::serviceserver;
  return BSWatcher::rpc("$BSConfig::serviceserver/service/$service", undef);
}

sub listservices {
  my ($cgi) = @_;
  return "<servicelist/>\n" unless $BSConfig::serviceserver;
  return BSWatcher::rpc("$BSConfig::serviceserver/service", undef);
}

sub published {
  my ($cgi, $projid, $repoid, $arch, $filename) = @_;
  my @args;
  die("unknown view '$cgi->{'view'}'\n") if $cgi->{'view'} && $cgi->{'view'} ne 'ymp' && $cgi->{'view'} ne 'fileinfo';
  push @args, "view=$cgi->{'view'}" if $cgi->{'view'};
  my $p = "/published";
  $p .= "/$projid" if defined $projid;
  $p .= "/$repoid" if defined $repoid;
  $p .= "/$arch" if defined $arch;
  $p .= "/$filename" if defined $filename;
  my $param = {
    'uri' => "$BSConfig::reposerver$p",
    'ignorestatus' => 1,
    'receiver' => \&BSServer::reply_receiver,
  };
  BSWatcher::rpc($param, undef, @args);
  return undef;
}

sub getsignkey {
  my ($cgi, $projid) = @_;

  while ($projid ne '') {
    my $sk = readstr("$projectsdir/$projid.pkg/_signkey", 1);
    if ($sk) {
      if ($cgi->{'withpubkey'}) {
        my $pk = readstr("$projectsdir/$projid.pkg/_pubkey", 1);
        $sk .= "\n" unless $sk =~ /\n$/s;
        $sk .= $pk;
      }
      return ($sk, 'Content-Type: text/plain') if $sk;
    }
    $projid =~ s/[^:]*$//;
    $projid =~ s/:$//;
  }
  return ('', 'Content-Type: text/plain');
}

####################################################################

sub getrequestlist {
  my ($cgi) = @_;

  my @requests = map {{'name' => $_}} sort(grep {!/^\./} ls($requestsdir));
  return ({'entry' => \@requests}, $BSXML::dir);
};

sub nextreqid {
  local *F;
  mkdir_p($requestsdir);
  BSUtil::lockopen(*F, '>>', "$requestsdir/.nextid");
  my $nextid = readstr("$requestsdir/.nextid", 1);
  if (!$nextid) {
    die("nextid was lost\n") if grep {$_ ne '.nextid'} ls($requestsdir);
    $nextid = 1;
  }
  chomp $nextid;
  die("nextid is bad\n") if $nextid =~ /[^0-9]/s;
  writestr("$requestsdir/.nextid.new", "$requestsdir/.nextid", $nextid + 1);
  close F;
  return $nextid;
}

sub writereq {
  my ($oreq, $req) = @_;

  my $id;
  $id = $req->{'id'} if $req;
  $id = $oreq->{'id'} if $oreq && !defined($id);
  die unless defined $id;
  my $name = $id;
  if ($req) {
    writexml("$requestsdir/.$name", "$requestsdir/$name", $req, $BSXML::request);
  }
  mkdir_p($reqindexdb);
  my $db = BSDB::opendb($reqindexdb, '');
  $db->{'noindex'} = {'id' => 1};
  $db->updateindex($id, $oreq || {}, $req || {});
  if (!$req) {
    unlink("$requestsdir/$name");
  }
}

sub putrequest {
  my ($cgi, $id) = @_;
  my $reqxml = BSServer::read_data(1000000);
  my $req = XMLin($BSXML::request, $reqxml);
  BSVerify::verify_request($req);
  my $oreq = readxml("$requestsdir/$id", $BSXML::request, 1);
  die("404 no such request '$id'\n") unless $oreq;
  $req->{'id'} = $id;
  $req->{'history'} = [ @{$oreq->{'history'} || []} ];
  push @{$req->{'history'}}, $oreq->{'state'};
  $req->{'state'}->{'who'} = $cgi->{'user'} if defined $cgi->{'user'};
  my @lt = localtime(time());
  $req->{'state'}->{'when'} = sprintf("%04d-%02d-%02dT%02d:%02d:%02d", $lt[5] + 1900, $lt[4] + 1, @lt[3,2,1,0]);
  writereq($oreq, $req);
  BSNotify::notify("SRCSRV_REQUEST_CHANGE", BSNotify::requestParams($req, $cgi->{'user'}));
  return $BSStdServer::return_ok;
}

sub createrequest {
  my ($cgi) = @_;

  my $reqxml = BSServer::read_data(1000000);
  my $cmd = $cgi->{'cmd'};
  die("unknown command '$cmd'\n") unless $cmd eq 'create';
  my $req = XMLin($BSXML::request, $reqxml);

  if ($req->{'type'}) {
    # old style request, convert to new style
    die("action element in old style request\n") if $req->{'action'};
    die("old style request with unknown type\n") if $req->{'type'} ne 'submit';
    die("old style request without submit element\n") unless $req->{'submit'};
    $req->{'submit'}->{'type'} = 'submit';
    $req->{'action'} = [ $req->{'submit'} ];
    delete $req->{'submit'};
    delete $req->{'type'};
  }

  for my $r (@{$req->{'action'} || []}) {
    if (($r->{'type'} || '') eq 'submit' && $r->{'source'} && !$r->{'target'}) {
      # make source link target the submit request target, if not specified
      my $projid = $r->{'source'}->{'project'};
      my $packid = $r->{'source'}->{'package'};
      my $rev = $r->{'source'}->{'rev'};
      BSVerify::verify_projid($projid);
      BSVerify::verify_packid($packid);
      BSVerify::verify_rev($rev) if defined $rev;
      if (defined($projid) && defined($packid)) {
	my $rev = getrev($projid, $packid, $rev);
        my $files = lsrev($rev);
        if ($files->{'_link'}) {
          my $l = repreadxml($rev, '_link', $files->{'_link'}, $BSXML::link, 1);
          if ($l) {
            $projid = $l->{'project'} if exists $l->{'project'};
            $packid = $l->{'package'} if exists $l->{'package'};
            $r->{'target'} = {'project' => $projid, 'package' => $packid};
          }
        }
      }
    }
    die("target project does not exist\n") if ($r->{'type'} || '') eq 'submit' && (!$r->{'target'}->{'project'} || ! -e "$projectsdir/$r->{'target'}->{'project'}.xml");
  }

  # new requests are either in state 'new' or 'review'
  $req->{'state'}->{'name'} = 'new';
  $req->{'state'}->{'name'} = 'review' if defined($req->{'review'});

  BSVerify::verify_request($req);
  die("request must not contain an id\n") if $req->{'id'};
  die("request must not contain a history\n") if $req->{'history'};
  die("request must not be created by anonymous\n") unless defined $cgi->{'user'};
  $req->{'state'}->{'who'} = $cgi->{'user'};
  my @lt = localtime(time());
  $req->{'state'}->{'when'} = sprintf("%04d-%02d-%02dT%02d:%02d:%02d", $lt[5] + 1900, $lt[4] + 1, @lt[3,2,1,0]);
  $req->{'id'} = nextreqid();
  writereq(undef, $req);

  # notification about new request
  BSNotify::notify("SRCSRV_REQUEST_CREATE", BSNotify::requestParams($req, $cgi->{'user'}));

  # notification about new review of request
  for my $r (@{$req->{'review'} || []}) {
    my $notification = BSNotify::requestParams($req, $cgi->{'user'});
    my $hermes_type;
    if ($r->{'by_package'}) {
      $hermes_type = "SRCSRV_REQUEST_REVIEWER_PACKAGE_ADDED";
      $notification->{'newreviewer_project'} = $r->{'by_project'};
      $notification->{'newreviewer_package'} = $r->{'by_package'};
    }elsif ($r->{'by_project'}) {
      $hermes_type = "SRCSRV_REQUEST_REVIEWER_PROJECT_ADDED";
      $notification->{'newreviewer_project'} = $r->{'by_project'};
    } elsif ($r->{'by_user'}) {
      $hermes_type = "SRCSRV_REQUEST_REVIEWER_ADDED";
      $notification->{'newreviewer'} = $r->{'by_user'};
    } elsif ($r->{'by_group'}) {
      $hermes_type = "SRCSRV_REQUEST_REVIEWER_GROUP_ADDED";
      $notification->{'newreviewer_group'} = $r->{'by_group'};
    }
    $notification->{'comment'} = $r->{'comment'};
    BSNotify::notify( $hermes_type, $notification) if( $hermes_type );
   }

  return ($req, $BSXML::request);
}

sub getrequest {
  my ($cgi, $id) = @_;
  my $req = readxml("$requestsdir/$id", $BSXML::request, 1);
  $req ||= readxml("$oldrequestsdir/$id", $BSXML::request, 1);
  die("404 no such request '$id'\n") unless $req;
  return ($req, $BSXML::request);
}

sub postrequest {
  my ($cgi, $id) = @_;

  # work around bad osc versions
  delete $cgi->{'superseded_by'} if defined($cgi->{'superseded_by'}) && $cgi->{'superseded_by'} eq '';
  my $cmd = $cgi->{'cmd'};
  my $oreq = readxml("$requestsdir/$id", $BSXML::request, 1);
  die("404 no such request '$id'\n") unless $oreq;
  my $req = Storable::dclone($oreq);	# deep clone
  die unless $req->{'id'} eq $id;
  my $oldstate = $req->{'state'};
  my @lt = localtime(time());
  my $mytime = sprintf("%04d-%02d-%02dT%02d:%02d:%02d", $lt[5] + 1900, $lt[4] + 1, @lt[3,2,1,0]);
  if ($cmd eq 'addreview'){
    die("request review is not specified via by_user, by_group or by_project\n") if !$cgi->{'by_user'} && !$cgi->{'by_group'} && !$cgi->{'by_project'};
    push @{$req->{'history'}}, $oldstate;
    $req->{'state'} = {'name' => 'review'};
    $req->{'state'}->{'who'} = $cgi->{'user'} if defined $cgi->{'user'};
    $req->{'state'}->{'comment'} = $cgi->{'comment'} if defined $cgi->{'comment'};
    my @lt = localtime(time());
    $req->{'state'}->{'when'} = sprintf("%04d-%02d-%02dT%02d:%02d:%02d", $lt[5] + 1900, $lt[4] + 1, @lt[3,2,1,0]);
    if ($cgi->{'by_user'}) {
      push @{$req->{'review'}}, { 'state' => 'new', 'by_user' => $cgi->{'by_user'}, 'comment' => $cgi->{'comment'} };
    } elsif ($cgi->{'by_group'}) {
      push @{$req->{'review'}}, { 'state' => 'new', 'by_group' => $cgi->{'by_group'}, 'comment' => $cgi->{'comment'} };
    } else {
      if ($cgi->{'by_package'}) {
        push @{$req->{'review'}}, { 'state' => 'new', 'by_project' => $cgi->{'by_project'}, 'by_package' => $cgi->{'by_package'}, 'comment' => $cgi->{'comment'} };
      } else {
        push @{$req->{'review'}}, { 'state' => 'new', 'by_project' => $cgi->{'by_project'}, 'comment' => $cgi->{'comment'} };
      }
    }
  } elsif ($cmd eq 'changereviewstate') {
    die("request is not in review state\n") unless $req->{'state'} and $req->{'state'}->{'name'} eq "review";
    die("request review item is not specified via by_user or by_group\n") if not $cgi->{'by_user'} and not $cgi->{'by_group'} and not $cgi->{'by_project'};
    die("review state must be accepted, declined or superseded, but was >$cgi->{'newstate'}<\n") unless
        $cgi->{'newstate'} eq 'accepted' or $cgi->{'newstate'} eq 'declined' or $cgi->{'newstate'} eq 'superseded';

    my $go_new_state = 'review';
    $go_new_state = $cgi->{'newstate'} if $cgi->{'newstate'} eq 'declined' or $cgi->{'newstate'} eq 'superseded';
    my $found = 0;
    for my $r (@{$req->{'review'} || []}) {
      my $matching;
      $matching = 1 if defined($r->{'by_user'}) and defined($cgi->{'by_user'}) and $r->{'by_user'} eq $cgi->{'by_user'};
      $matching = 1 if defined($r->{'by_group'}) and defined($cgi->{'by_group'}) and $r->{'by_group'} eq $cgi->{'by_group'};
      if (defined($r->{'by_project'}) and defined($cgi->{'by_project'}) and $r->{'by_project'} eq $cgi->{'by_project'}) {
        if (defined($r->{'by_package'}) or defined($cgi->{'by_package'})) {
          # by_package review
          $matching = 1 if $r->{'by_package'} eq $cgi->{'by_package'};
        } else {
          # by_project review
          $matching = 1;
        }
      }

      if ($matching) {
        $r->{'state'} = $cgi->{'newstate'};
        $r->{'when'} = $mytime;
        $r->{'who'} = $cgi->{'user'} if defined $cgi->{'user'};
        $r->{'comment'} = $cgi->{'comment'} if defined($cgi->{'comment'});
        $found = 1;
        $go_new_state = 'new' if $go_new_state eq "review" and $r->{'state'} eq 'accepted';
        $go_new_state = $r->{'state'} if $go_new_state eq "review"; # take decline
      } else {
        # don't touch the request state if a review is still open, except the
        # review got declined or superseded.
        $go_new_state = '' if $r->{'state'} eq 'new' and $go_new_state ne 'declined' and $go_new_state ne 'superseded';
      }
    }
    die("review item not found.\n") if $found == 0;
    if ($go_new_state or $cgi->{'newstate'} eq 'superseded'){
      push @{$req->{'history'}}, $oldstate;
      if ($cgi->{'newstate'} eq 'superseded') { # superseded
         $req->{'state'} = {'name' => 'superseded'};
         $req->{'state'}->{'superseded_by'} = $cgi->{'superseded_by'} if defined $cgi->{'superseded_by'};
      } else { # no open reviews anymore
         $req->{'state'} = {'name' => $go_new_state} if $go_new_state;
      }
      $req->{'state'}->{'who'} = $cgi->{'user'} if defined $cgi->{'user'};
      $req->{'state'}->{'comment'} = $cgi->{'comment'} if defined $cgi->{'comment'};
      $req->{'state'}->{'when'} = $mytime;
    }
  } elsif ($cmd eq 'changestate') {
    die("no new state\n") unless $cgi->{'newstate'};
    die("missing superseded_by parameter\n") if $cgi->{'newstate'} eq 'superseded' and not defined($cgi->{'superseded_by'});
    push @{$req->{'history'}}, $oldstate;
    $req->{'state'} = {'name' => $cgi->{'newstate'}};
    $req->{'state'}->{'who'} = $cgi->{'user'} if defined $cgi->{'user'};
    $req->{'state'}->{'comment'} = $cgi->{'comment'} if defined $cgi->{'comment'};
    $req->{'state'}->{'superseded_by'} = $cgi->{'superseded_by'} if defined $cgi->{'superseded_by'};
    $req->{'state'}->{'when'} = $mytime;
  } else {
    die("unknown command '$cmd'\n");
  }
  BSVerify::verify_request($req);
  writereq($oreq, $req);
  $req->{'oldstate'} = $oldstate;
  BSNotify::notify("SRCSRV_REQUEST_STATECHANGE", BSNotify::requestParams($req, $cgi->{'user'}));
  # Additionally send type specific hermes notifications
  my $hermes_type;
  my $notification = BSNotify::requestParams($req, $cgi->{'user'});
  if ($cmd eq 'addreview') {
    if ($cgi->{'by_package'}) {
      $hermes_type = "SRCSRV_REQUEST_REVIEWER_PACKAGE_ADDED";
      $notification->{'newreviewer_project'} = $cgi->{'by_project'};
      $notification->{'newreviewer_package'} = $cgi->{'by_package'};
    }elsif ($cgi->{'by_project'}) {
      $hermes_type = "SRCSRV_REQUEST_REVIEWER_PROJECT_ADDED";
      $notification->{'newreviewer_project'} = $cgi->{'by_project'};
    } elsif ($cgi->{'by_user'}) {
      $hermes_type = "SRCSRV_REQUEST_REVIEWER_ADDED";
      $notification->{'newreviewer'} = $cgi->{'by_user'};
    } elsif ($cgi->{'by_group'}) {
      $hermes_type = "SRCSRV_REQUEST_REVIEWER_GROUP_ADDED";
      $notification->{'newreviewer_group'} = $cgi->{'by_group'};
    }
    $notification->{'comment'} = $cgi->{'comment'};
  } else {
    if( $cgi->{'newstate'} eq "accepted" ) {
      $hermes_type = "SRCSRV_REQUEST_ACCEPTED";
    } elsif( $cgi->{'newstate'} eq "rejected" ) {
      $hermes_type = "SRCSRV_REQUEST_REJECTED";
    } elsif( $cgi->{'newstate'} eq "revoked" ) {
      $hermes_type = "SRCSRV_REQUEST_REVOKED";
    }
  }
  BSNotify::notify( $hermes_type, $notification) if( $hermes_type );

  return $BSStdServer::return_ok;
}

sub delrequest {
  my ($cgi, $id) = @_;
  my $oreq = readxml("$requestsdir/$id", $BSXML::request, 1);
  die("404 no such request '$id'\n") unless $oreq;
  die unless $oreq->{'id'} eq $id;
  writereq($oreq, undef);
  BSNotify::notify("SRCSRV_REQUEST_DELETE", BSNotify::requestParams($oreq, $cgi->{'user'}));
  return $BSStdServer::return_ok;
}

sub fetchreq {
  my ($db, $key) = @_;
  my $req = readxml("$requestsdir/$key", $BSXML::request, 1) || {};
  $req->{'id'} = $key;
  return $req;
}

sub search_request {
  my ($cgi, $match) = @_;
  my $db = BSDB::opendb($reqindexdb, '');
  $db->{'noindex'} = {'id' => 1};
  $db->{'allkeyspath'} = 'type';
  $db->{'fetch'} = \&fetchreq;
  my $limit = defined($cgi->{'limit'}) ? $cgi->{'limit'} : 0;
  my $rootnode = BSXPathKeys::node($db, '', $limit * 10);
  my $data = BSXPath::match($rootnode, $match) || [];
  my $res = {};
  $res->{'matches'} = @$data;
  $res->{'limited'} = 'true' if $limit && @$data > $limit;
  splice(@$data, $limit) if $limit && @$data > $limit;
  $res->{'request'} = $data;
  return ($res, $BSXML::collection);
}

sub addacceptinfo {
  my ($id, $projid, $packid, $acceptinfo) = @_;
  my $oreq = readxml("$requestsdir/$id", $BSXML::request, 1);
  return unless $oreq && $oreq->{'id'} eq $id;
  my $req = Storable::dclone($oreq);	# deep clone
  my $changed;
  for my $r (@{$req->{'action'} || []}) {
    next unless $r->{'type'} eq 'submit';
    next unless $r->{'target'} && defined($r->{'target'}->{'project'}) && defined($r->{'target'}->{'package'});
    next unless $r->{'target'}->{'project'} eq $projid && $r->{'target'}->{'package'} eq $packid;
    if ($r->{'acceptinfo'}) {
      for ('rev', 'srcmd5', 'xsrcmd5') {
        delete $r->{'acceptinfo'}->{$_};
        $r->{'acceptinfo'}->{$_} = $acceptinfo->{$_} if defined $acceptinfo->{$_};
      }
    } else {
      $r->{'acceptinfo'} = $acceptinfo;
    }
    $changed = 1;
  }
  writereq($oreq, $req) if $changed;
}

####################################################################

sub findremote {
  my ($projid) = @_;

  my $origprojid = $projid;
  my $proj = readproj($projid, 1);
  if ($proj) {
    return ($BSConfig::reposerver, $projid) if !$proj->{'remoteurl'};
    die("no remoteproject specified\n") unless $proj->{'remoteproject'};
    return ($proj->{'remoteurl'}, $proj->{'remoteproject'});
  }
  my $rsuf = '';
  while ($projid =~ /^(.*)(:.*?)$/) {
    $projid = $1;
    $rsuf = "$2$rsuf";
    $proj = readproj($projid, 1);
    next unless $proj;
    die("404 project '$origprojid' does not exist\n") unless $proj->{'remoteurl'};
    if ($proj->{'remoteproject'}) {
      return ($proj->{'remoteurl'}, "$proj->{'remoteproject'}$rsuf");
    }
    $rsuf =~ s/^://;
    return ($proj->{'remoteurl'}, $rsuf);
  }
  die("404 project '$origprojid' does not exist\n") unless $proj->{'remoteurl'};
}

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

  if (!$BSStdServer::isajax) {
    my @args;
    push @args, "project=$projid";
    push @args, "repository=$repoid";
    push @args, "arch=$arch";
    push @args, "binaries=$cgi->{'binaries'}";
    BSHandoff::handoff($ajaxsocket, '/getbinaries', undef, @args);
    exit(0);
  }
  my @binaries = split(',', $cgi->{'binaries'});
  my ($remoteurl, $remoteprojid) = findremote($projid);
  my $uri = {'uri' => "$remoteurl/build/$remoteprojid/$repoid/$arch/_repository"};
  $uri->{'proxy'} = $proxy if $remoteurl ne $BSConfig::reposerver;
  my $binarylist = BSWatcher::rpc($uri, $BSXML::binarylist, "view=names", map {"binary=$_"} @binaries);
  return undef if $BSStdServer::isajax && !$binarylist;
  my %binarylist;
  for my $b (@{$binarylist->{'binary'} || []}) {
    if ($b->{'filename'} =~ /^(.*)(\.deb|\.rpm)$/) {
      $binarylist{$1} = $b;
    } else {
      $binarylist{$b->{'filename'}} = $b;
    }
  }
  my @fetch;
  my @reply;

  local *LOCK;
  mkdir_p($remotecache);
  BSUtil::lockopen(\*LOCK, '>>', "$remotecache/lock");
  for my $bin (@binaries) {
    my $b = $binarylist{$bin};
    if (!$b || !$b->{'size'} || !$b->{'mtime'}) {
      push @reply, {'name' => $bin, 'error' => 'not available'};
      next;
    }
    my $cachemd5 = Digest::MD5::md5_hex("$projid/$repoid/$arch/$bin");
    substr($cachemd5, 2, 0, '/');
    my @s = stat("$remotecache/$cachemd5");
    if (!@s || $s[9] != $b->{'mtime'} || $s[7] != $b->{'size'}) {
      push @fetch, $bin;
    } else {
      utime time(), $s[9], "$remotecache/$cachemd5";
      push @reply, {'name' => $b->{'filename'}, 'filename' => "$remotecache/$cachemd5"};
    }
  }
  my $slot = sprintf("%02x", (int(rand(256))));
  print "cleaning slot $slot\n";
  if (-d "$remotecache/$slot") {
    my $now = time();
    my $num = 0;
    for my $f (ls("$remotecache/$slot")) {
      my @s = stat("$remotecache/$slot/$f");
      next if $s[8] >= $now - 24*3600;
      unlink("$remotecache/$slot/$f");
      $num++;
    }
    print "removed $num unused files\n" if $num;
  }
  close(LOCK);

  if (@fetch) {
    my $serialmd5 = Digest::MD5::md5_hex("$projid/$repoid/$arch");

    # serialize this upload
    my $serial = BSWatcher::serialize("$remotecache/$serialmd5.lock");
    return undef unless $serial;

    print "fetch: @fetch\n";
    my %fetch = map {$_ => $binarylist{$_}} @fetch;
    my $param = {
      'uri' => "$remoteurl/build/$remoteprojid/$repoid/$arch/_repository",
      'receiver' => \&BSHTTP::cpio_receiver,
      'directory' => $remotecache,
      'map' => "upload$serialmd5:",
      'proxy' => $proxy,
    };
    my $cpio;
    if ($BSStdServer::isajax) {
      $param->{'receiver'} = \&BSHTTP::file_receiver;
      $param->{'filename'} = "$remotecache/upload$serialmd5.cpio";
      local *F;
      if (open(F, '<', $param->{'filename'})) {
        unlink($param->{'filename'});
	$cpio = BSHTTP::cpio_receiver(BSHTTP::fd2hdr(\*F), $param);
	close F;
      }
    }

    # work around api bug: only get 50 packages at a time
    @fetch = splice(@fetch, 0, 50) if !$cpio && @fetch > 50;

    $cpio ||= BSWatcher::rpc($param, undef, "view=cpio", map {"binary=$_"} @fetch);
    return undef if $BSStdServer::isajax && !$cpio;
    for my $f (@{$cpio || []}) {
      my $bin = $f->{'name'};
      $bin =~ s/^upload.*?://;
      $bin =~ s/\.(:?rpm|deb)$//;
      if (!$fetch{$bin}) {
        unlink("$remotecache/$f->{'name'}");
	next;
      }
      my $cachemd5 = Digest::MD5::md5_hex("$projid/$repoid/$arch/$bin");
      substr($cachemd5, 2, 0, '/');
      mkdir_p("$remotecache/".substr($cachemd5, 0, 2));
      rename("$remotecache/$f->{'name'}", "$remotecache/$cachemd5");
      push @reply, {'name' => $fetch{$bin}->{'filename'}, 'filename' => "$remotecache/$cachemd5"};
      delete $fetch{$bin};
    }
    BSWatcher::serialize_end($serial);

    if (@{$cpio || []} >= 50) {
      # work around api bug: get rest
      return worker_getbinaries($cgi, $projid, $repoid, $arch);
    }

    for (sort keys %fetch) {
      push @reply, {'name' => $_, 'error' => 'not available'};
    }
  }
  if ($cgi->{'raw'}) {
    die("can only transport one binary in raw mode\n") unless @reply == 1;
    my $f = $reply[0];
    die("$f->{'name'}: $f->{'error'}\n") if $f->{'error'};
    die("$f->{'name'}: not found\n") unless $f->{'filename'};
    BSWatcher::reply_file($f->{'filename'});
    return undef;
  }
  BSWatcher::reply_cpio(\@reply);
  return undef;
}

sub worker_getbinaryversions {
  my ($cgi, $projid, $repoid, $arch) = @_;
  my @binaries = split(',', $cgi->{'binaries'});
  my ($remoteurl, $remoteprojid) = findremote($projid);
  my $uri = {'uri' => "$remoteurl/build/$remoteprojid/$repoid/$arch/_repository"};
  $uri->{'proxy'} = $proxy if $remoteurl ne $BSConfig::reposerver;
  my $bvl = BSWatcher::rpc($uri, $BSXML::binaryversionlist, 'view=binaryversions', 'nometa=1', map {"binary=$_"} @binaries);
  return ($bvl, $BSXML::binaryversionlist);
}

my @lastev_cache;
my @lastev_stat;

sub worker_lastevents {
  my ($cgi, $watch) = @_;
  if (!$cgi->{'start'}) {
    # just fetch the current event number
    my $lastev = BSFileDB::fdb_getlast("$eventdir/lastevents", $eventlay);
    my $lastno = $lastev ? $lastev->{'number'} : 0;
    my $ret = {'next' => $lastno, 'sync' => 'lost'};
    return ($ret, $BSXML::events);
  }
  if (!$BSStdServer::isajax) {
    my @args;
    push @args, "obsname=$cgi->{'obsname'}" if $cgi->{'obsname'};
    push @args, map {"filter=$_"} @{$watch || []};
    push @args, "start=$cgi->{'start'}";
    BSHandoff::handoff($ajaxsocket, '/lastevents', undef, @args);
    exit(0);
  }
  BSWatcher::addfilewatcher("$eventdir/lastevents");
  # get the last 5 events
  my @s = stat("$eventdir/lastevents");
  my @events;
  if (@s && @lastev_stat && "$s[9]/$s[7]/$s[1]" eq "$lastev_stat[9]/$lastev_stat[7]/$lastev_stat[1]") {
    @events = @lastev_cache;
  } else {
    my $lastev = BSFileDB::fdb_getlast("$eventdir/lastevents", $eventlay);
    push @events, $lastev if $lastev;
    @lastev_cache = @events;
    @lastev_stat = @s;
  }
  my $firstno = @events ? $events[0]->{'number'} : 0;
  my $nextno = @events ? $events[-1]->{'number'} + 1 : 1;
  if ($cgi->{'start'} < $firstno) {
    # we have to get them all
    @events = BSFileDB::fdb_getall("$eventdir/lastevents", $eventlay);
    # re-calculate in case something has changed
    $firstno = @events ? $events[0]->{'number'} : 0;
    $nextno = @events ? $events[-1]->{'number'} + 1 : 1;
    if ($firstno > $cgi->{'start'}) {
      # out of sync!
      return ({'next' => $nextno, 'sync' => 'lost'}, $BSXML::events);
    }
  }
  # filter
  @events = grep {$_->{'number'} >= $cgi->{'start'}} @events;
  if ($watch && @events) {
    my %watch = map {$_ => 1} @$watch;
    for my $ev (splice @events) {
      if ($ev->{'type'} eq 'package') {
        next unless defined $ev->{'package'};
        next unless $watch{"package/$ev->{'project'}/$ev->{'package'}"} || $watch{"package/$ev->{'project'}"};
      } elsif ($ev->{'type'} eq 'project') {
        next unless $watch{"project/$ev->{'project'}"};
      } elsif ($ev->{'type'} eq 'repository') {
        next unless $watch{"repository/$ev->{'project'}/$ev->{'repository'}/$ev->{'arch'}"};
      } else {
	next;
      }
      push @events, $ev;
    }
  }
  # return a sync reply every 100 events for two reasons
  # - get rid of old peers
  # - survive history truncation
  $cgi->{'start_orig'} ||= $cgi->{'start'};
  if ($BSStdServer::isajax && !@events && $nextno < $cgi->{'start_orig'} + 100) {
    # small hack: update cgi to the next event number
    $cgi->{'start'} = $nextno if $cgi->{'start'} < $nextno;
    return undef;
  }
  for (@events) {
    $_ = { %$_ };	# clone em
    # delete unwanted fields
    delete $_->{'time'};
    delete $_->{'number'};
    # clean up a bit
    delete $_->{'package'} unless defined($_->{'package'}) && $_->{'package'} ne '';
  }
  my $ret = {'next' => $nextno};
  $ret->{'event'} = \@events if @events;
  return ($ret, $BSXML::events);
}

sub addevent {
  my ($ev) = @_;
  $ev->{'time'} = time();
  mkdir_p("$eventdir");
  if (-s "$eventdir/lastevents" && -s _ >= 65536) {
    local *F;
    BSUtil::lockopen(\*F, '+>>', "$eventdir/lastevents");
    my $events = readstr("$eventdir/lastevents");
    if (length($events) >= 65536) {
      $events = substr($events, -32768);
      $events =~ s/^[^\n]*\n//s;
      writestr("$eventdir/.lastevents", "$eventdir/lastevents", $events);
    }
    close F;
  }
  BSFileDB::fdb_add_i("$eventdir/lastevents", $eventlay, $ev);
}

sub newevent {
  my ($cgi) = @_;
  my $ev = {};
  for ('type', 'project', 'package', 'repository', 'arch', 'job') {
    $ev->{$_} = $cgi->{$_} if defined $cgi->{$_};
  }
  addevent($ev);
  return $BSStdServer::return_ok;
}

sub getrelsync {
  my ($cgi, $projid, $repoid, $arch) = @_;
  checkprojrepoarch($projid, $repoid, $arch);
  my $param = {
    'uri' => "$BSConfig::reposerver/build/$projid/$repoid/$arch/_relsync",
    'ignorestatus' => 1,
    'receiver' => \&BSServer::reply_receiver,
  };
  BSWatcher::rpc($param, undef);
  return undef;
}

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

  my $proj = checkprojrepoarch($projid, $repoid, $arch);
  my $repo = (grep {$_->{'name'} eq $repoid} @{$proj->{'repository'} || []})[0];
  my $relsyncdata = BSServer::read_data(10000000);
  for my $a (@{$repo->{'arch'} || []}) {
    next if $a eq $arch;
    next if $BSConfig::relsync_pool && ($BSConfig::relsync_pool->{$arch} || '') ne ($BSConfig::relsync_pool->{$a} || '');
    my $param = {
      'uri' => "$BSConfig::reposerver/build/$projid/$repoid/$a/_relsync",
      'request' => 'POST',
      'data' => $relsyncdata,
    };
    eval {
      BSRPC::rpc($param);
    };
    if ($@) {
      warn($@);
    }
  }
  return $BSStdServer::return_ok;
}

sub putdispatchprios {
  my ($cgi) = @_;
  my $param = {
    'uri' => "$BSConfig::reposerver/build/_dispatchprios",
    'request' => 'PUT',
    'data' => \&BSServer::forward_sender,
    'chunked' => 1,
  };
  return BSWatcher::rpc($param, undef);
}

sub getdispatchprios {
  my ($cgi) = @_;
  my $param = {
    'uri' => "$BSConfig::reposerver/build/_dispatchprios",
    'ignorestatus' => 1,
    'receiver' => \&BSServer::reply_receiver,
  };
  BSWatcher::rpc($param, undef);
  return undef;
}

####################################################################

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

####################################################################

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

  '!rw :' => undef,
  '!- GET:' => undef,
  '!- HEAD:' => undef,

  # /source name space: manage project and package data
  '/source deleted:bool?' => \&getprojectlist,

  'POST:/source/$project cmd=createkey user:? comment:?' => \&createkey,
  'POST:/source/$project cmd=extendkey user:? comment:?' => \&extendkey,
  'POST:/source/$project cmd=undelete user:? comment:?' => \&undeleteproject,
  'POST:/source/$project cmd=copy user:? comment:? oproject:project withbinaries:bool? withhistory:bool?' => \&copyproject,
  'POST:/source/$project cmd: *:*' => \&unknowncmd,
  '/source/$project deleted:bool?' => \&getpackagelist,

  'DELETE:/source/$project user:? comment:?' => \&delproject,
  '/source/$project/_meta rev?' => \&getproject,
  'PUT:/source/$project/_meta user:? comment:?' => \&putproject,

  '/source/$project/_pubkey rev?' => \&getpubkey,
  'DELETE:/source/$project/_pubkey user:? comment:?' => \&deletekey,

  '/source/$project/_config rev?' => \&getprojectconfig,
  'PUT:/source/$project/_config user:? comment:?' => \&putprojectconfig,
  'DELETE:/source/$project/_config user:? comment:?' => \&delprojectconfig,

  '/source/$project/_history rev? meta:bool? deleted:bool? limit:num?' => \&getpackagehistory,

  'POST:/source/$project/$package cmd=diff rev? orev:rev? oproject:project? opackage:package? expand:bool? linkrev? olinkrev:? unified:bool? missingok:bool? meta:bool? file:filename* filelimit:num? tarlimit:num?' => \&sourcediff,
  'POST:/source/$project/$package cmd=linkdiff rev? linkrev? unified:bool? file:filename* filelimit:num? tarlimit:num?' => \&linkdiff,
  'POST:/source/$project/$package cmd=commit rev? user:? comment:? keeplink:bool? repairlink:bool? linkrev? setrev:bool? noservice:bool?' => \&sourcecommit,
  'POST:/source/$project/$package cmd=commitfilelist rev? user:? comment:? keeplink:bool? repairlink:bool? linkrev? setrev:bool? noservice:bool? requestid:num?' => \&sourcecommitfilelist,
  'POST:/source/$project/$package cmd=copy rev? user:? comment:? orev:rev? oproject:project? opackage:package? expand:bool? keeplink:bool? repairlink:bool? linkrev? setrev:linkrev? olinkrev:linkrev? requestid:num? dontupdatesource:bool? withhistory:bool?' => \&sourcecopy,
  'POST:/source/$project/$package cmd=branch rev? user:? comment:? orev:rev? oproject:project? opackage:package? olinkrev:linkrev? force:bool?' => \&sourcebranch,
  'POST:/source/$project/$package cmd=linktobranch rev? user:? comment:? linkrev?' => \&linktobranch,
  'POST:/source/$project/$package cmd=deleteuploadrev' => \&deleteuploadrev,
  'POST:/source/$project/$package cmd=undelete user:? comment:?' => \&undeletepackage,
  'POST:/source/$project/$package cmd=runservice user:? comment:?' => \&runservice,
  'POST:/source/$project/$package cmd=getprojectservices' => \&getprojectservices,
  'POST:/source/$project/$package cmd: *:*' => \&unknowncmd,

  'PUT:/source/$project/$package cmd: rev? user:? comment:?' => \&sourcecommitfilelist,	# obsolete

  '/source/$project/$package rev? linkrev? emptylink:bool? expand:bool? view:? extension:? lastworking:bool? withlinked:bool? meta:bool?' => \&getfilelist,
  '/source/$project/$package/_history rev? meta:bool? deleted:bool? limit:num?' => \&getpackagehistory,
  '/source/$project/$package/_meta rev?' => \&getpackage,
  'PUT:/source/$project/$package/_meta user:? comment:?' => \&putpackage,
  'DELETE:/source/$project/$package user:? comment:?' => \&delpackage,
  '/source/$project/$package/$filename rev?' => \&getfile,
  'PUT:/source/$project/$package/$filename rev? user:? comment:? keeplink:bool? force:bool?' => \&putfile,
  'DELETE:/source/$project/$package/$filename rev? user:? comment:? keeplink:bool? force:bool?' => \&delfile,

  # /published name spec: access published binaries
  '/published' => \&published,
  '/published/$project' => \&published,
  '/published/$project/$repository' => \&published,
  '/published/$project/$repository/$arch:filename view:?' => \&published,
  '/published/$project/$repository/$arch:filename/$filename view:?' => \&published,

  # scheduler calls
  '/getprojpack $project* $repository* $package* $arch? withrepos:bool? withsrcmd5:bool? withdeps:bool? withconfig:bool? expandedrepos:bool? ignoredisable:bool? nopackages:bool? withremotemap:bool? noremote:bool?' => \&getprojpack,
  'POST:/relsync $project $repository $arch' => \&postrelsync,
  '/relsync $project $repository $arch' => \&getrelsync,

  # worker calls
  '/getsources $project $package $srcmd5:md5' => \&getsources,
  '/getconfig $project $repository path:prp*' => \&getbuildconfig,

  '/getsignkey $project withpubkey:bool?' => \&getsignkey,
  '/getbinaries $project $repository $arch binaries: nometa:bool?' => \&worker_getbinaries,
  '/getbinaryversions $project $repository $arch binaries: nometa:bool?' => \&worker_getbinaryversions,
  '!- /lastevents $filter:* start:num? obsname:?' => \&worker_lastevents,
  'POST:/event type: project: package:? repository:? arch:? job:?' => \&newevent,
  # tmp until lightty gets fixed
  '/public/lastevents $filter:* start:num? obsname:?' => \&worker_lastevents,

  # search interface
  '/search $in: $match: return:? values:bool?' => \&search,
  '/search/project $match:' => \&search_proj,
  '/search/project/id $match:' => \&search_proj_id,
  '/search/package $match:' => \&search_pack,
  '/search/package/id $match:' => \&search_pack_id,

  'POST:/search/published cmd:' => \&search_published_updatedb,
  '/search/published/binary/id $match: limit:num?' => \&search_published_binary_id,
  '/search/published/pattern/id $match: limit:num?' => \&search_published_pattern_id,

  # service interface, just for listing for now
  '/service' => \&listservices,
#  '/service/$service' => \&service,

  # build calls for binary files
  '/build' => \&getprojectlist,
  '/build/_workerstatus scheduleronly:bool? arch*' => \&getworkerstatus,
  'PUT:/build/_dispatchprios' => \&putdispatchprios,
  '/build/_dispatchprios' => \&getdispatchprios,
  'POST:/build/$project cmd: repository* arch* package* code:*' => \&docommand,
  '/build/$project' => \&getrepositorylist,
  '/build/$project/_result oldstate:md5? view:resultview* lastbuild:bool? repository* arch* package* code:*' => \&getresult,
  '/build/$project/$repository' => \&getarchlist,
  '/build/$project/$repository/_buildconfig path:prp*' => \&getbuildconfig,
  '/build/$project/$repository/$arch' => \&getpackagelist,
  '/build/$project/$repository/$arch/_builddepinfo package* view:?' => \&getbuilddepinfo,
  '/build/$project/$repository/$arch/_jobhistory package* code:* limit:num?' => \&getjobhistory,
  'POST:/build/$project/$repository/$arch/_repository match:' =>  \&postrepo,
  'POST:/build/$project/$repository/$arch/$package cmd=copy oproject:project? opackage:package? orepository:repository? setupdateinfoid:?' => \&copybuild,
  'POST:/build/$project/$repository/$arch/$package' => \&uploadbuild,
  '/build/$project/$repository/$arch/$package_repository view:? binary:filename* nometa:bool?' => \&getbinarylist,
  'POST:/build/$project/$repository/$arch/$package_repository/_buildinfo add:*' => \&getbuildinfo_post,
  '/build/$project/$repository/$arch/$package/_buildinfo add:* internal:bool?' => \&getbuildinfo,
  '/build/$project/$repository/$arch/$package/_log nostream:bool? start:intnum? end:num? view:?' => \&getlogfile,
  '/build/$project/$repository/$arch/$package/_reason' => \&getbuildreason,
  '/build/$project/$repository/$arch/$package/_status' => \&getbuildstatus,
  '/build/$project/$repository/$arch/$package/_history limit:num?' => \&getbuildhistory,
  '/build/$project/$repository/$arch/$package_repository/$filename view:?' => \&getbinary,
  'PUT:/build/$project/$repository/$arch/_repository/$filename ignoreolder:bool? wipe:bool?' => \&putbinary,
  'DELETE:/build/$project/$repository/$arch/_repository/$filename' => \&delbinary,

  'POST:/request cmd: user:?' => \&createrequest,
  '/request' => \&getrequestlist,
  'POST:/request/$id:num cmd: newstate:? user:? comment:? by_user:? by_group:? by_project:? by_package:? superseded_by:?' => \&postrequest,
  '/request/$id:num' => \&getrequest,
  'PUT:/request/$id:num user:?' => \&putrequest,
  'DELETE:/request/$id:num' => \&delrequest,
  '/search/request $match: limit:num?' => \&search_request,

  '/ajaxstatus' => \&getajaxstatus,
  '/serverstatus' => \&BSStdServer::serverstatus,
];

####################################################################

my $dispatches_ajax = [
  '/' => \&hello,
  '/ajaxstatus' => \&getajaxstatus,
  '/build/$project/_result oldstate:md5? view:resultview* repository* arch* package* code:*' => \&getresult,
  '/build/$project/$repository/$arch/$package/_log nostream:bool? start:intnum? end:num?' => \&getlogfile,
  '/build/$project/$repository/$arch/$package_repository view:? binary:filename* nometa:bool?' => \&getbinarylist,
  '/getbinaries $project $repository $arch binaries: nometa:bool? raw:bool?' => \&worker_getbinaries,
  '/lastevents $filter:* start:num? obsname:?' => \&worker_lastevents,
  '/source/$project/$package rev' => \&getfilelist_ajax,
  '/source/$project/$package:package/$filename rev?' => \&getfile,
];

####################################################################

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,
};

# set a repoid for identification of this data repository
mkdir_p("$projectsdir") unless -d "$projectsdir";
if ( ! -e "$projectsdir/_repoid" ) {
  my $randomid = int(rand(1000000000));
  writestr("$projectsdir/._repoid", "$projectsdir/_repoid", sprintf("%09d", $randomid)) || die ("Unable to initialize the project repository");
}
$repoid = readstr("$projectsdir/_repoid");

BSNotify::notify("SRCSRV_START", $conf);

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