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

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

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

use BSConfig;
use BSRPC;
use BSUtil;
use BSDBIndex;
use Build;
use BSDB;
use BSXML;

use strict;

my $user = $BSConfig::bsuser;
my $group = $BSConfig::bsgroup;

!defined($user) || defined($user = (getpwnam($user))[2]) || die("unknown user\n");
!defined($group) || defined($group = (getgrnam($group))[2]) || die("unknown group\n");
if (defined $group) {
  ($(, $)) = ($group, $group);
  die "setgid: $!\n" if ($) != $group);
}
if (defined $user) {
  ($<, $>) = ($user, $user); 
  die "setuid: $!\n" if ($> != $user); 
}



my $reporoot = "$BSConfig::bsdir/build";
my $eventdir = "$BSConfig::bsdir/events";
my $extrepodir = "$BSConfig::bsdir/repos";
my $extrepodir_sync = "$BSConfig::bsdir/repos_sync";
my $extrepodb = "$BSConfig::bsdir/db/published";
my $uploaddir = "$BSConfig::bsdir/upload";
my $rundir = "$BSConfig::bsdir/run";

my $myeventdir = "$eventdir/publish";

sub qsystem {
  my @args = @_;
  my $pid;
  local (*RH, *WH);
  if ($args[0] eq 'echo') {
    pipe(RH, WH) || die("pipe: $!\n");
  }
  if (!($pid = xfork())) {
    if ($args[0] eq 'echo') {
      close WH;
      open(STDIN, "<&RH");
      close RH;
      splice(@args, 0, 2);
    }
    open(STDOUT, ">/dev/null");
    if ($args[0] eq 'chdir') {
      chdir($args[1]) || die("chdir $args[1]: $!\n");
      splice(@args, 0, 2);
    }
    if ($args[0] eq 'stdout') {
      open(STDOUT, '>', $args[1]) || die("$args[1]: $!\n");
      splice(@args, 0, 2);
    }
    exec(@args);
    die("$args[0]: $!\n");
  }
  if ($args[0] eq 'echo') {
    close RH;
    print WH $args[1];
    close WH;
  }
  waitpid($pid, 0) == $pid || die("waitpid $pid: $!\n");
  return $?;
}

sub fillpkgdescription {
  my ($pkg, $extrep, $repoinfo, $name) = @_;
  my $binaryorigins = $repoinfo->{'binaryorigins'} || {};
  my $hit;
  for my $p (sort keys %$binaryorigins) {
    next if $p =~ /src\.rpm$/;
    next unless $p =~ /\/\Q$name\E/;
    my ($pa, $pn) = split('/', $p, 2);
    if ($pn =~ /^\Q$name\E-([^-]+-[^-]+)\.[^\.]+\.rpm$/) {
      $hit = $p;
      last;
    }
    if ($pn =~ /^\Q$name\E_([^_]+)_[^_]+\.deb$/) {
      $hit = $p;
      last;
    }
  }
  return unless $hit;
  my $data = Build::query("$extrep/$hit", 'description' => 1);
  $pkg->{'description'} = str2utf8($data->{'description'});
  $pkg->{'summary'} = str2utf8($data->{'summary'}) if defined $data->{'summary'};
}

sub updatebinaryindex {
  my ($db, $keyrem, $keyadd) = @_;

  my $index = $db->{'index'};
  $index =~ s/\/$//;
  my @add;
  for my $key (@{$keyadd || []}) {
    my $n;
    if ($key =~ /(?:^|\/)([^\/]+)-[^-]+-[^-]+\.[a-zA-Z][^\/\.\-]*\.rpm$/) {
      $n = $1;
    } elsif ($key =~ /(?:^|\/)([^\/]+)_([^\/]*)_[^\/]*\.deb$/) {
      $n = $1;
    } else {
      next;
    }
    push @add, ["$index/name", $n, $key];
  }
  my @rem;
  for my $key (@{$keyrem || []}) {
    my $n;
    if ($key =~ /(?:^|\/)([^\/]+)-[^-]+-[^-]+\.[a-zA-Z][^\/\.\-]*\.rpm$/) {
      $n = $1;
    } elsif ($key =~ /(?:^|\/)([^\/]+)_([^\/]*)_[^\/]*\.deb$/) {
      $n = $1;
    } else {
      next;
    }
    push @rem, ["$index/name", $n, $key];
  }
  if (@rem + @add < 256) {
    return BSDBIndex::modify($db, \@rem, \@add);
  }
  while (@rem) {
    my @chunk = splice(@rem, 0, 256);
    BSDBIndex::modify($db, \@chunk, []);
  }
  while (@add) {
    my @chunk = splice(@add, 0, 256);
    BSDBIndex::modify($db, [], \@chunk);
  }
}


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

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

  my $dir;
  eval {
    $dir = BSRPC::rpc("$BSConfig::srcserver/source/$projid/_pattern", $BSXML::dir);
  };
  if ($@) {
    warn($@);
    return [];
  }
  my @ret;
  for my $entry (@{$dir->{'entry'} || []}) {
    my $pat;
    eval {
      $pat = BSRPC::rpc("$BSConfig::srcserver/source/$projid/_pattern/$entry->{'name'}");
      # only patterns we can parse, please
      XMLin($BSXML::pattern, $pat);
    };
    if ($@) {
      warn("   pattern $entry->{'name'}: $@");
      next;
    }
    push @ret, {'name' => $entry->{'name'}, 'md5' => $entry->{'md5'}, 'data' => $pat};
  }
  print "    fetched ".@ret." patterns\n";
  return \@ret;
}

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

sub createrepo_rpmmd {
  my ($extrep, $projid, $repoid, $signargs, $pubkey, $repoinfo) = @_;

  my $prp_ext = "$projid/$repoid";
  $prp_ext =~ s/:/:\//g;
  print "    running createrepo\n";
  # cleanup files
  unlink("$extrep/repodata/repomd.xml.asc");
  unlink("$extrep/repodata/repomd.xml.key");
  unlink("$extrep/repodata/latest-feed.xml");
  unlink("$extrep/repodata/index.html");
  qsystem('rm', '-rf', "$extrep/repodata/repoview") if -d "$extrep/repodata/repoview";
  qsystem('rm', '-rf', "$extrep/repodata/.olddata") if -d "$extrep/repodata/.olddata";
  qsystem('rm', '-f', "$extrep/repodata/patterns*");

  # create generic rpm-md meta data
  # --update requires a newer createrepo version, tested with version 0.4.10
  my @update;
  @update = '--update' if -f "$extrep/repodata/primary.xml.gz";
  if (qsystem('createrepo', @update, $extrep)) {
    print("    createrepo failed: $?\n");
    if (@update) {
      print "    re-running without --update\n";
      qsystem('createrepo', $extrep) && print("    createrepo failed again: $?\n");
    }
  }
  if ($BSConfig::repodownload) {
    print "    running repoview\n";
    qsystem('repoview', '-f', "-u$BSConfig::repodownload/$prp_ext", "-t$repoinfo->{'title'}", $extrep) && print("   repoview failed: $?\n");
    }
  if ($BSConfig::sign && -e "$extrep/repodata/repomd.xml") {
    qsystem($BSConfig::sign, @$signargs, '-d', "$extrep/repodata/repomd.xml") && print("    sign failed: $?\n");
    writestr("$extrep/repodata/repomd.xml.key", undef, $pubkey) if $pubkey;
  }
  if ($BSConfig::repodownload) {
    local *FILE;
    open(FILE, '>', "$extrep/$projid.repo$$") || die("$extrep/$projid.repo$$: $!\n");
    my $projidHeader = $projid;
    $projidHeader =~ s/:/_/g;
    print FILE "[$projidHeader]\n";
    print FILE "name=$repoinfo->{'title'}\n";
    print FILE "type=rpm-md\n";
    print FILE "baseurl=$BSConfig::repodownload/$prp_ext/\n";
    print FILE "gpgcheck=1\n";
    if (!@$signargs) {
      # standard key XXX: move to BSConfig!
      print FILE "gpgkey=http://download.opensuse.org/openSUSE-Build-Service.asc\n";
    } else {
      print FILE "gpgkey=$BSConfig::repodownload/$prp_ext/repodata/repomd.xml.key\n";
    }
    print FILE "enabled=1\n";
    close(FILE) || die("close: $!\n");
    rename("$extrep/$projid.repo$$", "$extrep/$projid.repo") || die("rename $extrep/$projid.repo$$ $extrep/$projid.repo: $!\n");
  }
}

sub deleterepo_rpmmd {
  my ($extrep, $projid) = @_;

  qsystem('rm', '-rf', "$extrep/repodata") if -d "$extrep/repodata";
  unlink("$extrep/$projid.repo");
}

sub createrepo_susetags {
  my ($extrep, $projid, $repoid, $signargs, $pubkey, $repoinfo) = @_;

  mkdir_p("$extrep/media.1");
  mkdir_p("$extrep/descr");
  my @lt = localtime(time());
  $lt[4] += 1;
  $lt[5] += 1900;
  my $str = sprintf("openSUSE Build Service\n%04d%02d%02d%02d%02d%02d\n1\n", @lt[5,4,3,2,1,0]);
  writestr("$extrep/media.1/.media", "$extrep/media.1/media", $str);
  writestr("$extrep/media.1/.directory.yast", "$extrep/media.1/directory.yast", "media\n");
  $str = <<"EOL";
PRODUCT openSUSE Build Service $projid $repoid
VERSION 1.0-0
LABEL $repoinfo->{'title'}
VENDOR openSUSE Build Service
ARCH.x86_64 x86_64 i686 i586 i486 i386 noarch
ARCH.ppc64 ppc64 ppc noarch
ARCH.ppc ppc noarch
ARCH.sh4 sh4 noarch
ARCH.i686 i686 i586 i486 i386 noarch
ARCH.i586 i586 i486 i386 noarch
DEFAULTBASE i586
DESCRDIR descr
DATADIR .
EOL
  writestr("$extrep/.content", "$extrep/content", $str);
  print "    running create_package_descr\n";
  qsystem('chdir', $extrep, 'create_package_descr', '-o', 'descr', '-x', '/dev/null') && print "    create_package_descr failed: $?\n";
  unlink("$extrep/descr/directory.yast");
  my @d = map {"$_\n"} sort(ls("$extrep/descr"));
  writestr("$extrep/descr/.directory.yast", "$extrep/descr/directory.yast", join('', @d));
}

sub deleterepo_susetags {
  my ($extrep) = @_;

  unlink("$extrep/directory.yast");
  unlink("$extrep/content");
  unlink("$extrep/media.1/media");
  unlink("$extrep/media.1/directory.yast");
  rmdir("$extrep/media.1");
  qsystem('rm', '-rf', "$extrep/descr") if -d "$extrep/descr";
}

sub createrepo_debian {
  my ($extrep, $projid, $repoid, $signargs, $pubkey, $repoinfo) = @_;

  unlink("$extrep/Packages");
  unlink("$extrep/Packages.gz");
  print "    running dpkg-scanpackages\n";
  qsystem('chdir', $extrep, 'stdout', 'Packages.new', 'dpkg-scanpackages', '.', '/dev/null') && print "    apt-ftparchive failed: $?\n";
  if (-f "$extrep/Packages.new") {
    link("$extrep/Packages.new", "$extrep/Packages");
    qsystem('gzip', '-9', '-f', "$extrep/Packages") && print "    gzip Packages failed: $?\n";
    unlink("$extrep/Packages");
    rename("$extrep/Packages.new", "$extrep/Packages");
  }    
}

sub deleterepo_debian {
  my ($extrep) = @_;

  unlink("$extrep/Packages");
  unlink("$extrep/Packages.gz");
}


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

sub createpatterns_rpmmd {
  my ($extrep, $projid, $repoid, $signargs, $pubkey, $repoinfo, $patterns) = @_;

  deletepatterns_rpmmd($extrep);
  return unless @{$patterns || []};

  # create patterns data structure
  my @pats;
  for my $pattern (@$patterns) {
    push @pats, XMLin($BSXML::pattern, $pattern->{'data'});
  }
  print "    adding patterns to repodata\n";
  my $pats = {'pattern' => \@pats, 'count' => scalar(@pats)};
  writexml("$extrep/repodata/patterns.xml", undef, $pats, $BSXML::patterns);
  qsystem('modifyrepo', "$extrep/repodata/patterns.xml", "$extrep/repodata") && print("    modifyrepo failed: $?\n");
  unlink("$extrep/repodata/patterns.xml");

#  for my $pattern (@{$patterns || []}) {
#    my $pname = "patterns.$pattern->{'name'}";
#    $pname =~ s/\.xml$//;
#    print "    adding pattern $pattern->{'name'} to repodata\n";
#    writestr("$extrep/repodata/$pname.xml", undef, $pattern->{'data'});
#    qsystem('modifyrepo', "$extrep/repodata/$pname.xml", "$extrep/repodata") && print("    modifyrepo failed: $?\n");
#    unlink("$extrep/repodata/$pname.xml");
#  }

  # re-sign changed repomd.xml file
  if ($BSConfig::sign && -e "$extrep/repodata/repomd.xml") {
    qsystem($BSConfig::sign, @$signargs, '-d', "$extrep/repodata/repomd.xml") && print("    sign failed: $?\n");
  }
}

sub deletepatterns_rpmmd {
  my ($extrep) = @_;
  for my $pat (ls("$extrep/repodata")) {
    next unless $pat =~ /^patterns/;
    unlink("$extrep/repodata/$pat");
  }
}

sub createpatterns_ymp {
  my ($extrep, $projid, $repoid, $signargs, $pubkey, $repoinfo, $patterns) = @_;

  deletepatterns_ymp($extrep, $projid, $repoid);
  return unless @{$patterns || []};

  my $prp_ext = "$projid/$repoid";
  $prp_ext =~ s/:/:\//g;
  my $patterndb;
  if ($extrepodb) {
    mkdir_p($extrepodb);
    $patterndb = BSDB::opendb($extrepodb, 'pattern');
  }

  # get title/description data for all involved projects
  my %nprojpack;
  my @nprojids = map {$_->{'project'}} @{$repoinfo->{'prpsearchpath'} || []};
  if (@nprojids) {
    my @args = map {"project=$_"} @nprojids;
    my $nprojpack = BSRPC::rpc("$BSConfig::srcserver/getprojpack", $BSXML::projpack, 'nopackages', @args);
    %nprojpack = map {$_->{'name'} => $_} @{$nprojpack->{'project'} || []};
  }

  for my $pattern (@$patterns) {
    my $ympname = $pattern->{'name'};
    $ympname =~ s/\.xml$//;
    $ympname .= ".ymp";
    my $pat = XMLin($BSXML::pattern, $pattern->{'data'});
    next if !exists $pat->{'uservisible'};
    print "    writing ymp for pattern $pat->{'name'}\n";
    my $ymp = {};
    $ymp->{'xmlns:os'} = 'http://opensuse.org/Standards/One_Click_Install';
    $ymp->{'xmlns'} = 'http://opensuse.org/Standards/One_Click_Install';

    my $group = {};
    $group->{'name'} = $pat->{'name'};
    if ($pat->{'summary'}) {
      $group->{'summary'} = $pat->{'summary'}->[0]->{'_content'};
    }    
    if ($pat->{'description'}) {
      $group->{'description'} = $pat->{'description'}->[0]->{'_content'};
    }    
    my @repos;
    my @sprp = @{$repoinfo->{'prpsearchpath'} || []};
    while (@sprp) {
      my $sprp = shift @sprp;
      my $sprojid = $sprp->{'project'};
      my $srepoid = $sprp->{'repository'};
      my $r = {};
      $r->{'recommended'} = @sprp ? 'true' : 'false';
      $r->{'name'} = $sprojid;
      if ($nprojpack{$sprojid}) {
        $r->{'summary'} = $nprojpack{$sprojid}->{'title'};
        $r->{'description'} = $nprojpack{$sprojid}->{'description'};
      }
      my $sprp_ext = "$sprojid/$srepoid";
      $sprp_ext =~ s/:/:\//g;
      $r->{'url'} = "$BSConfig::repodownload/$sprp_ext/";
      push @repos, $r;
    }    
    $group->{'repositories'} = {'repository' => \@repos };
    my @software;
    for my $entry (@{$pat->{'rpm:requires'}->{'rpm:entry'} || []}) {
      next if $entry->{'kind'} && $entry->{'kind'} ne 'package';
      push @software, {'name' => $entry->{'name'}, 'summary' => "The $entry->{'name'} package", 'description' => "The $entry->{'name'} package."};
      fillpkgdescription($software[-1], "$extrepodir/$prp_ext", $repoinfo, $entry->{'name'});
    }
    for my $entry (@{$pat->{'rpm:recommends'}->{'rpm:entry'} || []}) {
      next if $entry->{'kind'} && $entry->{'kind'} ne 'package';
      push @software, {'name' => $entry->{'name'}, 'summary' => "The $entry->{'name'} package", 'description' => "The $entry->{'name'} package."};
      fillpkgdescription($software[-1], "$extrepodir/$prp_ext", $repoinfo, $entry->{'name'});
    }
    for my $entry (@{$pat->{'rpm:suggests'}->{'rpm:entry'} || []}) {
      next if $entry->{'kind'} && $entry->{'kind'} ne 'package';
      push @software, {'recommended' => 'false', 'name' => $entry->{'name'}, 'summary' => "The $entry->{'name'} package", 'description' => "The $entry->{'name'} package."};
      fillpkgdescription($software[-1], "$extrepodir/$prp_ext", $repoinfo, $entry->{'name'});
    }
    $group->{'software'} = { 'item' => \@software };
    $ymp->{'group'} = [ $group ];
    
    writexml("$extrep/.$ympname", "$extrep/$ympname", $ymp, $BSXML::ymp);
    
    # write database entry
    my $ympidx = {'type' => 'ymp'};
    $ympidx->{'name'} = $pat->{'name'} if defined $pat->{'name'};
    $ympidx->{'summary'} = $pat->{'summary'}->[0]->{'_content'} if $pat->{'summary'};;
    $ympidx->{'description'} = $pat->{'description'}->[0]->{'_content'} if $pat->{'description'};
    $ympidx->{'path'} = $repoinfo->{'prpsearchpath'} if $repoinfo->{'prpsearchpath'};
    $patterndb->store("$prp_ext/$ympname", $ympidx) if $patterndb;
  }
}

sub deletepatterns_ymp {
  my ($extrep, $projid, $repoid) = @_;

  my $prp_ext = "$projid/$repoid";
  $prp_ext =~ s/:/:\//g;
  my $patterndb;
  $patterndb = BSDB::opendb($extrepodb, 'pattern') if -d $extrepodb;
  for my $ympname (ls($extrep)) {
    next unless $ympname =~ /\.ymp$/;
    $patterndb->store("$prp_ext/$ympname", undef) if $patterndb;
    unlink("$extrep/$ympname");
  }
}

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

sub deleterepo {
  my ($projid, $repoid) = @_;
  print "    deleting repository\n";
  my $projid_ext = $projid;
  $projid_ext =~ s/:/:\//g;
  my $prp = "$projid/$repoid";
  my $prp_ext = $prp;
  $prp_ext =~ s/:/:\//g;
  my $extrep = "$extrepodir/$prp_ext";
  if (! -d $extrep) {
    rmdir("$extrepodir/$projid_ext");
    print "    nothing to delete...\n";
    unlink("$reporoot/$prp/:repoinfo");
    rmdir("$reporoot/$prp");
    return;
  }
  # delete all binaries
  my @deleted;
  for my $arch (ls($extrep)) {
    next if $arch =~ /^\./;
    next if $arch eq 'repodata' || $arch eq 'media.1' || $arch eq 'descr';
    my $r = "$extrep/$arch";
    next unless -d $r;
    for my $bin (ls($r)) {
      my $p = "$arch/$bin";
      print "      - $p\n";
      unlink("$r/$bin") || die("unlink $r/$bin: $!\n");
      push @deleted, $p;
    }
  }
  # update repoinfo
  unlink("$reporoot/$prp/:repoinfo");
  rmdir("$reporoot/$prp");
  # update published database
  if ($extrepodb && -d $extrepodb) {
    my $binarydb = BSDB::opendb($extrepodb, 'binary');
    updatebinaryindex($binarydb, [ map {"$prp_ext/$_"} @deleted ], []);
  }
  if ($BSConfig::markfileorigins) {
    for my $f (sort @deleted) {
      my $req = {
        'uri' => "$BSConfig::markfileorigins/$prp_ext/$f",
        'request' => 'HEAD',
        'timeout' => 10,
        'ignorestatus' => 1,
      };
      eval {
        BSRPC::rpc($req, undef, 'cmd=deleted');
      };
      print "      $f: $@" if $@;
    }
  }
  # delete ymps so they get removed from the database
  deletepatterns_ymp($extrep, $projid, $repoid);
  # delete everything else
  qsystem('rm', '-rf', $extrep);
  if ($BSConfig::stageserver && $BSConfig::stageserver =~ /^rsync:\/\/([^\/]+)\/(.*)$/) {
    print "    running rsync to $1\n";
    # rsync with a timeout of 1 hour
    qsystem('echo', "$projid_ext\0", 'rsync', '-arH0', '--delete', '--timeout', '3600', '--files-from=-', $extrepodir, "$1::$2") && die("    rsync failed: $?\n");
  }
  # push done trigger sync to other mirrors
  mkdir_p($extrepodir_sync);
  writestr("$extrepodir_sync/.$$:$projid", "$extrepodir_sync/$projid", "$projid_ext\0");
  if ($BSConfig::stageserver_sync && $BSConfig::stageserver_sync =~ /^rsync:\/\/([^\/]+)\/(.*)$/) {
    print "    running trigger rsync to $1\n";
    # small sync, timout 1 minute
    qsystem('rsync', '-aH', '--timeout', '60', "$extrepodir_sync/$projid", "$1::$2/$projid") && die("    trigger rsync failed: $?\n");
  }
  rmdir("$extrepodir/$projid_ext");
}

sub publish {
  my ($projid, $repoid) = @_;
  my $prp = "$projid/$repoid";

  print "publishing $prp\n";

  # get info from source server about this project/repository
  # we specify "withsrcmd5" so that we get the patternmd5. It still
  # works with "nopackages".
  my $projpack = BSRPC::rpc("$BSConfig::srcserver/getprojpack", $BSXML::projpack, 'withrepos', 'expandedrepos', 'withsrcmd5', 'nopackages', "project=$projid", "repository=$repoid");
  if (!$projpack->{'project'}) {
    # project is gone
    deleterepo($projid, $repoid);
    return;
  }
  my $proj = $projpack->{'project'}->[0];
  die("no such project $projid\n") unless $proj && $proj->{'name'} eq $projid;
  if (!$proj->{'repository'}) {
    # repository is gone
    deleterepo($projid, $repoid);
    return;
  }
  my $repo = $proj->{'repository'}->[0];
  die("no such repository $repoid\n") unless $repo && $repo->{'name'} eq $repoid;
  # this is the already expanded path as we used 'expandedrepos' above
  my $prpsearchpath = $repo->{'path'};

  # we need the config for repotype/patterntype
  my $config = BSRPC::rpc("$BSConfig::srcserver/getconfig", undef, "project=$projid", "repository=$repoid");
  $config = Build::read_config('noarch', [ split("\n", $config) ]);
  $config->{'repotype'} = [ 'rpm-md' ] unless @{$config->{'repotype'} || []};

  # get us the lock
  local *F;
  open(F, '>', "$reporoot/$prp/.finishedlock") || die("$reporoot/$prp/.finishedlock: $!\n");
  if (!flock(F, LOCK_EX | LOCK_NB)) {
    print "    waiting for lock...\n";
    flock(F, LOCK_EX) || die("flock: $!\n");
    print "    got the lock...\n";
  }

  my $prp_ext = $prp;
  $prp_ext =~ s/:/:\//g;
  my $extrep = "$extrepodir/$prp_ext";

  # we now know that $reporoot/$prp/*/:repo will not change.
  # Build repo by mixing all architectures.
  my @archs = @{$repo->{'arch'} || []};
  my %bins;
  my %bins_id;
  my $binaryorigins = {};

  for my $arch (@archs) {
    my $r = "$reporoot/$prp/$arch/:repo";
    my $repoinfo = {};
    if (-s "${r}info") {
      $repoinfo = Storable::retrieve("${r}info") || {};
    }
    $repoinfo->{'binaryorigins'} ||= {};
    for my $bin (sort(ls($r))) {
      next unless $bin =~ /\.(?:rpm|deb)$/;
      my $p;
      if ($bin =~ /^.+-[^-]+-[^-]+\.([a-zA-Z][^\/\.\-]*)\.rpm$/) {
	$p = "$1/$bin";
      } elsif ($bin =~ /^.+_[^_]+_([^_\.]+)\.deb$/) {
	$p = "$1/$bin";
      } elsif ($bin =~ /\.rpm$/) {
	# legacy format
	my $q = Build::query("$r/$bin", 'evra' => 1);
	next unless $q;
	$p = "$q->{'arch'}/$q->{'name'}-$q->{'version'}-$q->{'release'}.$q->{'arch'}.rpm";
      } elsif ($bin =~ /\.deb$/) {
	# legacy format
	my $q = Build::query("$r/$bin", 'evra' => 1);
	$p = "$q->{'arch'}/$q->{'name'}_$q->{'version'}";
	$p .= "-$q->{'release'}" if defined $q->{'release'};
	$p .= "_$q->{'arch'}.deb";
      } else {
	next;
      }
      # next if $bins{$p}; # first arch wins
      my @s = stat("$reporoot/$prp/$arch/:repo/$bin");
      next unless @s;
      if ($bins{$p}) {
        # keep old file (FIXME: should do this different)
        my @s2 = stat("$extrep/$p");
        next if !@s2 || "$s[9]/$s[7]/$s[1]" ne "$s2[9]/$s2[7]/$s2[1]";
      }
      $bins{$p} = "$r/$bin";
      $bins_id{$p} = "$s[9]/$s[7]/$s[1]";
      $binaryorigins->{$p} = $repoinfo->{'binaryorigins'}->{$bin} if defined $repoinfo->{'binaryorigins'}->{$bin};
    }
  }

  # now update external repository
  my $changed = 0;
  my @changed;
  my @deleted;

  my %bins_done;
  for my $arch (sort(ls($extrep))) {
    next if $arch =~ /^\./;
    next if $arch eq 'repodata' || $arch eq 'media.1' || $arch eq 'descr';
    my $r = "$extrep/$arch";
    next unless -d $r;
    for my $bin (sort(ls($r))) {
      my $p = "$arch/$bin";
      if (!exists($bins{$p})) {
	print "      - $p\n";
	unlink("$r/$bin") || die("unlink $r/$bin: $!\n");
	push @deleted, $p;
        $changed = 1;
	next;
      }
      my @s = stat("$r/$bin");
      die("$r/$bin: $!\n") unless @s;
      if ("$s[9]/$s[7]/$s[1]" ne $bins_id{$p}) {
        # changed, link over
	print "      ! $p\n";
	unlink("$r/$bin");
        link($bins{$p}, "$r/$bin") || die("link $bins{$p} $r/$bin: $!\n");
	push @changed, $p;
        $changed = 1;
      }
      $bins_done{$p} = 1;
    }
  }
  for my $p (sort keys %bins) {
    next if $bins_done{$p};
    # a new one
    my ($arch, $bin) = split('/', $p, 2);
    my $r = "$extrep/$arch";
    mkdir_p($r) unless -d $r;
    print "      + $p\n";
    link($bins{$p}, "$r/$bin") || die("link $bins{$p} $r/$bin: $!\n");
    push @changed, $p;
    $changed = 1;
  }

  close F;     # release repository lock

  my $title = $proj->{'title'} || $projid;
  $title .= " ($repoid)";
  $title =~ s/\n/ /sg;

  my $state;
  $state = $proj->{'patternmd5'} || '';
  $state .= "\0".join(',', @{$config->{'repotype'} || []}) if %bins;
  $state .= "\0".($proj->{'title'} || '') if %bins;
  $state .= "\0".join(',', @{$config->{'patterntype'} || []}) if $proj->{'patternmd5'};
  $state .= "\0".join('/', map {"$_->{'project'}/$_->{'repository'}"} @{$prpsearchpath || []}) if $proj->{'patternmd5'};
  $state = Digest::MD5::md5_hex($state) if $state ne '';

  # get us the old repoinfo, so we can compare the state
  my $repoinfo = {};
  if (-s "$reporoot/$prp/:repoinfo") {
    $repoinfo = Storable::retrieve("$reporoot/$prp/:repoinfo") || {};
  }

  if (($repoinfo->{'state'} || '') ne $state) {
    $changed = 1;
  }
  if (!$changed) {
    print "    nothing changed\n";
    return;
  }

  mkdir_p($extrep) unless -d $extrep;

  # get sign key
  my $signargs = [];
  my $signkey = BSRPC::rpc("$BSConfig::srcserver/getsignkey", undef, "project=$projid", "withpubkey=1");
  my $pubkey;
  if ($signkey) {
    ($signkey, $pubkey) = split("\n", $signkey, 2);
    mkdir_p("$uploaddir");
    writestr("$uploaddir/publisher.$$", undef, $signkey);
    $signargs = [ '-P', "$uploaddir/publisher.$$" ];
  } else {
    if ($BSConfig::keyfile) {
      $pubkey = readstr($BSConfig::keyfile);
    }
  }

  # get all patterns
  my $patterns = [];
  if ($proj->{'patternmd5'}) {
    $patterns = getpatterns($projid);
  }

  # create and store the new repoinfo
  $repoinfo = {
    'prpsearchpath' => $prpsearchpath,
    'binaryorigins' => $binaryorigins,
    'title' => $title,
    'state' => $state,
  };
  if ($state ne '') {
    Storable::nstore($repoinfo, "$reporoot/$prp/:repoinfo");
  } else {
    unlink("$reporoot/$prp/:repoinfo");
  }

  # put in published database
  if ($extrepodb) {
    mkdir_p($extrepodb) unless -d $extrepodb;
    my $binarydb = BSDB::opendb($extrepodb, 'binary');
    updatebinaryindex($binarydb, [ map {"$prp_ext/$_"} @deleted ], [ map {"$prp_ext/$_"} @changed ]);
  }

  # mark file origins so we can gather per package statistics
  if ($BSConfig::markfileorigins) {
    print "    marking file origins\n";
    for my $f (sort @changed) {
      my $origin = $binaryorigins->{$f};
      $origin = "?" unless defined $origin;
      my $req = {
        'uri' => "$BSConfig::markfileorigins/$prp_ext/$f",
        'request' => 'HEAD',
        'timeout' => 10,
        'ignorestatus' => 1,
      };
      eval {
        BSRPC::rpc($req, undef, 'cmd=setpackage', "package=$origin");
      };
      print "      $f: $@" if $@;
    }
    for my $f (sort @deleted) {
      my $req = {
        'uri' => "$BSConfig::markfileorigins/$prp_ext/$f",
        'request' => 'HEAD',
        'timeout' => 10,
        'ignorestatus' => 1,
      };
      eval {
        BSRPC::rpc($req, undef, 'cmd=deleted');
      };
      print "      $f: $@" if $@;
    }
  }

  # create repositories and patterns
  my %repotype = map {$_ => 1} @{$config->{'repotype'} || []};
  my %patterntype = map {$_ => 1} @{$config->{'patterntype'} || []};

  if ($repotype{'rpm-md'}) {
    createrepo_rpmmd($extrep, $projid, $repoid, $signargs, $pubkey, $repoinfo);
  } else {
    deleterepo_rpmmd($extrep, $projid, $repoid, $signargs, $pubkey, $repoinfo);
  }
  if ($repotype{'suse'}) {
    createrepo_susetags($extrep, $projid, $repoid, $signargs, $pubkey, $repoinfo);
  } else {
    deleterepo_susetags($extrep, $projid, $repoid, $signargs, $pubkey, $repoinfo);
  }
  if ($repotype{'debian'}) {
    createrepo_debian($extrep, $projid, $repoid, $signargs, $pubkey, $repoinfo);
  } else {
    deleterepo_debian($extrep, $projid, $repoid, $signargs, $pubkey, $repoinfo);
  }

  if ($patterntype{'ymp'}) {
    createpatterns_ymp($extrep, $projid, $repoid, $signargs, $pubkey, $repoinfo, $patterns);
  } else {
    deletepatterns_ymp($extrep, $projid, $repoid, $signargs, $pubkey);
  }
  if ($patterntype{'rpm-md'}) {
    createpatterns_rpmmd($extrep, $projid, $repoid, $signargs, $pubkey, $repoinfo, $patterns);
  } else {
    deletepatterns_rpmmd($extrep, $projid, $repoid, $signargs, $pubkey);
  }

  unlink("$uploaddir/publisher.$$") if $signkey;

  # post process step: create directory listing for poor YaST
  if ($repotype{'suse'}) {
    unlink("$extrep/directory.yast");
    my @d = sort(ls($extrep));
    for (@d) {
      $_ .= '/' if -d "$extrep/$_";
      $_ .= "\n";
    }
    writestr("$extrep/.directory.yast", "$extrep/directory.yast", join('', @d));
  }

  # push to stageserver
  if ($BSConfig::stageserver && $BSConfig::stageserver =~ /^rsync:\/\/([^\/]+)\/(.*)$/) {
    print "    running rsync to $1\n";
    # sync project repos, timeout 1 hour
    qsystem('echo', "$prp_ext\0", 'rsync', '-arH0', '--delete', '--timeout', '3600', '--files-from=-', $extrepodir, "$1::$2") && die("    rsync failed: $?\n");
  }

  # push done trigger to stageserver so that it can send it to the world
  mkdir_p($extrepodir_sync);
  my $projid_ext = $projid;
  $projid_ext =~ s/:/:\//g;
  writestr("$extrepodir_sync/.$projid", "$extrepodir_sync/$projid", "$projid_ext\0");
  if ($BSConfig::stageserver_sync && $BSConfig::stageserver_sync =~ /^rsync:\/\/([^\/]+)\/(.*)$/) {
    print "    running trigger rsync to $1\n";
    # small sync, timeout 1 minute
    qsystem('rsync', '-aH', '--timeout', '60', "$extrepodir_sync/$projid", "$1::$2/$projid") && die("    trigger rsync failed: $?\n");
  }
  
  # all done. till next time...
}


$| = 1;
print "starting build service publisher\n";
open(RUNLOCK, '>>', "$rundir/bs_publish.lock") || die("$rundir/bs_publish.lock: $!\n");
flock(RUNLOCK, LOCK_EX | LOCK_NB) || die("publisher is already running!\n");
utime undef, undef, "$rundir/bs_publish.lock";

mkdir_p($myeventdir);
if (!-p "$myeventdir/.ping") {
  POSIX::mkfifo("$myeventdir/.ping", 0666) || die("$myeventdir/.ping: $!");
  chmod(0666, "$myeventdir/.ping");
}
sysopen(PING, "$myeventdir/.ping", POSIX::O_RDWR) || die("$myeventdir/.ping: $!");

while(1) {
  # drain ping pipe
  my $dummy;
  fcntl(PING,F_SETFL,POSIX::O_NONBLOCK);
  1 while (sysread(PING, $dummy, 1024, 0) || 0) > 0;
  fcntl(PING,F_SETFL,0);

  # check for events
  my @events = ls($myeventdir);
  @events = grep {!/^\./} @events;
  for my $event (@events) {
    my $ev = readxml("$myeventdir/$event", $BSXML::event, 1);
    if (!$ev || !$ev->{'type'} || $ev->{'type'} ne 'publish') {
      unlink("$myeventdir/$event");
      next;
    }
    if (!defined($ev->{'project'}) || !defined($ev->{'repository'})) {
      unlink("$myeventdir/$event");
      next;
    }
    rename("$myeventdir/$event", "$myeventdir/${event}::inprogress");
    eval {
      publish($ev->{'project'}, $ev->{'repository'});
    };
    if ($@) {
      warn("publish failed: $@");
      rename("$myeventdir/${event}::inprogress", "$myeventdir/$event");
    } else {
      unlink("$myeventdir/${event}::inprogress");
    }
  }
  print "waiting for an event...\n";
  sysread(PING, $dummy, 1, 0);
}
