#!/usr/bin/perl -w
#
# 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 Admin Tool
#

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

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

use Build;

our $nosharedtrees;
use BSConfig;
use BSFileDB;
use BSWatcher;
use BSUtil;
use BSXML;
use BSKiwiXML;
use BSProductXML;
use BSDB;
use BSDBIndex;
use BSSolv;

$nosharedtrees = $BSConfig::nosharedtrees if defined($BSConfig::nosharedtrees);

my $reporoot  = "$BSConfig::bsdir/build";
my $eventroot = "$BSConfig::bsdir/events";
my $projectsdir = "$BSConfig::bsdir/projects";
my $srcrepdir = "$BSConfig::bsdir/sources";
my $configfile = "$BSConfig::bsdir/configuration.xml";
my $treesdir = $nosharedtrees ? "$BSConfig::bsdir/trees" : $srcrepdir;
my $sourcedb = "$BSConfig::bsdir/db/source";


sub echo_help {
    print "\n
The Open Build Service Admin Tool
=====================================

*** This tool is only intended to be used by experienced admins on
*** the backend server ! 

General options
===============

 --help
   Gives this help output.

Job Controlling
===============

 --shutdown-scheduler <architecture>
   Stops the scheduler nicely with dumping out its current state 
   for fast startup.

 --check-project <project> <architecture>
 --check-project <project> <repository> <architecture>
 --check-all-projects <architecture>
   Check status of a project and its repositories again

 --deep-check-project <project> <architecture>
 --deep-check-project <project> <repository> <architecture>
   Check status of a project and its repositories again
   This deep check includes also the sources, in case of lost events.

 --check-package <project> <package> <architecture>
   Check status of a package in all repositories

 --publish-repository <project> <repository>
   Creates an event for the publisher. The scheduler is NOT scanning for new packages.
   The publisher may skip the event, if nothing has changed. So you might need to remove
   the directory in your /repos/ directory first.

 --unpublish-repository <project> <repository>
   Removes the prepared :repo collection and let the publisher remove the result. This 
   is also updating the search database.
   WARNING: this works also for locked projects!

 --clone-repository <source project> <source repository> <destination repository>
 --clone-repository <source project> <source repository> <destination project> <destination repository>
   Clone an existing repo into another existing repository.
   Usefull for creating snapshots.

 --rescan-repository <project> <repository> <architecture>
   Asks the scheduler to scan a repository for new packages and add
   them to the cache file.

 --force-check-project <project> <repository> <architecture>
   Enforces the check of an repository, even when it is currently blocked due to amount of
   calculating time.

 --create-patchinfo-from-updateinfo
   creates a patchinfo submission based on an updateinfo information.

Maintenance Tasks
=================

Note: the --update-*-db calls are usually only needed when corrupt data has been created, for
      example after a file system corruption.

 --update-source-db
   Update the index for all source files.

 --update-request-db
   Updates the index for all requests.

 --remove-old-sources <days> <y> (--debug)
   WARNING: this is an experimental feature atm. It may trash your data, but you have anyway
            a backup, right?
   remove sources older than <x> days, but keep <y> number of revisions
   --debug for debug output

Debug Options
=============

 --dump-cache <project> <repository> <architecture>
   Dumps out the content of a binary cache file.
   This shows all the content of a repository, including all provides
   and requires.

 --dump-state <architecture>

 --dump-relsync <file>
   To dump content of :relsync files.

 --set-relsync <file> <key> <value>
   Modify key content in a a :relsync file.

 --check-meta-xml <project>
 --check-meta-xml <project> <package>
   Is parsing a project or package xml file and puts out error messages, in case of errors.

 --check-product-xml <file>
   Is parsing a product xml file and puts out error messages, in case of errors.
   It does expand all xi:include references and validates the result.

 --check-product-group-xml <file>
   Is parsing a group xml file from a product definition and puts out error messages, in case of errors.
   
 --check-kiwi-xml <file>
 --check-kiwi-xml <project> <package>
   Is parsing a kiwi xml file and puts out error messages, in case of errors.

 --check-constraints <file>
 --check-constraints <project> <package>
   Validates a _constraints file

 --check-pattern-xml <file>
   Is parsing a pattern xml file and puts out error messages, in case of errors.

 --check-request-xml <file>
   Is parsing a request xml file and puts out error messages, in case of errors.

 --parse-build-desc <file> [<arch> [<buildconfigfile>]]
   Parse a spec, dsc or kiwi file with the Build script parser.

 --show-scheduler-architectures
   Show all architectures which are configured in configuration.xml to be supported by this instance.
";
}

#### FIXME: these functions are copied from src server. We should move it to some util class maybe.
my $srcrevlay = [qw{rev vrev srcmd5 version time user comment requestid}];
sub getrev {
  my ($projid, $packid, $rev) = @_;
  die("bad projid\n") if $projid =~ /\// || $projid =~ /^\./;
  return {'srcmd5' => 'pattern', 'rev' => 'pattern'} if $packid eq '_pattern';
  die("bad packid\n") if $packid =~ /\// || $packid =~ /^\./;
  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);
    $rev = {'srcmd5' => 'd41d8cd98f00b204e9800998ecf8427e'} unless $rev;
  } elsif ($rev =~ /^[0-9a-f]{32}$/) {
    return undef unless -e "$projectsdir/$projid.pkg/$packid.rev";
    $rev = {'srcmd5' => $rev, 'rev' => $rev};
  } elsif ($rev eq 'upload') {
    $rev = {'srcmd5' => 'upload', 'rev' => 'upload'}
  } elsif ($rev eq 'repository') {
    $rev = {'srcmd5' => 'd41d8cd98f00b204e9800998ecf8427e', 'rev' => 'repository'}
  } else {
    $rev = BSFileDB::fdb_getmatch("$projectsdir/$projid.pkg/$packid.rev", $srcrevlay, 'rev', $rev);
  }
  $rev->{'srcmd5'} =~ s/\/.*// if $rev;         # XXX still needed?
  return $rev;
}
sub lsrep {
  my ($projid, $packid, $srcmd5) = @_;
  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 {};
  } else {
    die("bad srcmd5 '$srcmd5'\n") if $srcmd5 !~ /^[0-9a-f]{32}$/;
    if (!open(F, '<', "$srcrepdir/$packid/$srcmd5-MD5SUMS")) {
      return {'_linkerror' => $srcmd5} if -e "$srcrepdir/$packid/$srcmd5-_linkerror";
      die("$packid/$srcmd5-$packid: not in repository\n");
    }
  }
  my @files = <F>;
  close F;
  chomp @files;
  return {map {substr($_, 34) => substr($_, 0, 32)} @files};
}
sub repreadxml {
  my ($rev, $packid, $filename, $md5, $dtd, $nonfatal) = @_;
  return readxml("$srcrepdir/$packid/$md5-$filename", $dtd, $nonfatal);
}
sub findprojects {
  local *D;
  opendir(D, $projectsdir) || die("$projectsdir: $!\n");
  my @projids = grep {s/\.xml$//} readdir(D);
  closedir(D);
  return sort @projids;
}
sub findpackages {
  my ($projid) = @_;
  my @packids;
  if (opendir(D, "$projectsdir/$projid.pkg")) {
    @packids = grep {s/\.xml$//} readdir(D);
    closedir(D);
  }
  return sort @packids;
}

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, $packid, '_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);
}
sub findfile {
  my ($projid, $packid, $repoid, $ext, $files) = @_;
  $files = lsrep($projid, $packid, $files) unless ref $files;
  return ($files->{"$packid-$repoid.$ext"}, "$packid-$repoid.$ext") if defined($repoid) && $files->{"$packid-$repoid.$ext"};
  return ($files->{"$packid.$ext"}, "$packid.$ext") if $files->{"$packid.$ext"} && defined($repoid);
  my @files = grep {/\.$ext$/} keys %$files;
  @files = grep {/^\Q$packid\E/i} @files if @files > 1;
  return ($files->{$files[0]}, $files[0]) if @files == 1;
  if (@files > 1) {
    if (!defined($repoid)) {
      # return (undef, undef);
      @files = sort @files;
      return ($files->{$files[0]}, $files[0]);
    }
    @files = grep {/^\Q$packid-$repoid\E/i} @files if @files > 1;
    return ($files->{$files[0]}, $files[0]) if @files == 1;
  }
  return (undef, undef);
}
#### end of copy from src server

sub find_latest_file {
  my ($project, $package, $type) = @_;

  my $rev = getrev($project, $package);
  if (!$rev || $rev->{'srcmd5'} eq 'empty') {
    return ( "Refered to non existing $type in $project $package" );
  }
  my $files = lsrep($project, $package, $rev->{'srcmd5'});
# FIXME: handle source links
#   $files = handlelinks($projid, $pinfo, $files, $rev) if ref($files) && $files->{'_link'};
  if (!ref $files) {
    return( "could not get file list for $project $package" );
  }
  my ($md5, $file) = findfile($project, $package, undef, $type, $files);
  return ($md5, $file);
}

sub dump_nStore {
  my ($file, $sel) = @_;
  my $cache = Storable::retrieve($file) || {};
  $cache = $cache->{$sel} if defined $sel;
  print Dumper($cache);
  return $cache
}

sub dump_cache {
  my ($project, $repo, $arch) = @_;
  my $full = "$reporoot/$project/$repo/$arch/:full";
  return dump_solv("$full.solv") if -e "$full.solv";
  return dump_nStore("$full.cache") if -e "$full.cache";
  die("neither $full.cache nor $full.solv exists\n");
}

sub dump_solv {
  my ($fn) = @_;
  my $pool = BSSolv::pool->new();
  my $repo = $pool->repofromfile(0, $fn);
  my %names = $repo->pkgnames();
  my $r = {};
  for my $p (values %names) {
    $r->{$pool->pkg2name($p)} = $pool->pkg2data($p);
  }
  print Dumper($r);
}

sub clone_repository {
  my ($srcproject, $srcrepo, $destproject, $destrepo) = @_;
  my $srcdir  = "$reporoot/$srcproject/$srcrepo";
  my $destdir = "$reporoot/$destproject/$destrepo";
  my $tmpdir  = "$BSConfig::bsdir/tmp";

  die("Destination repo must get created by scheduler first!\n") unless -d $destdir;

  mkdir_p($tmpdir) || die("mkdir_p $tmpdir: $!\n");
  $tmpdir .= "/bs_admin.$$";
  if (-d $tmpdir) {
    system('rm', '-rf', $tmpdir) && die("removing of $tmpdir failed!\n");
  }
  if (-d "$tmpdir.old") {
    system('rm', '-rf', "$tmpdir.old") && die("removing of $tmpdir.old failed!\n");
  }

  print "cloning $srcproject / $srcrepo\n";
  system('cp', '-al', $srcdir, $tmpdir) && die("cloning failed !");

  # remove :repoinfo, as the new repo is not published yet
  unlink("$tmpdir/:repoinfo");

  # remove jobhistory files
  for my $a (ls($tmpdir)) {
    unlink("$tmpdir/$a/:jobhistory");
   # the new repo might get published
    system('rm', '-rf', "$tmpdir/$a/:repo", "$tmpdir/$a/:repodone");
  }

  print "exchanging with $destproject / $destrepo\n";
  rename($destdir, "$tmpdir.old") || die("rename $destdir $tmpdir.old: $!\n");
  rename($tmpdir, $destdir) || die("rename $tmpdir $destdir: $!\n");

  print "tell schedulers about the change ";
  my @archs = grep {-d "$destdir/$_"} ls($destdir);
  for my $a (@archs) {
    print "$a, ";
    write_event($destproject, $destrepo, $a, 'scanrepo');
  }

  print "\nremoving old tree in $tmpdir.old\n";
  system('rm', '-rf', "$tmpdir.old") && die("removing of $tmpdir.old failed!\n");

  print "finished. Have a nice day.\n";
}

sub update_request_db {
  my $requestdb  = "$BSConfig::bsdir/db/request";
  my $requestdir = "$BSConfig::bsdir/requests";
  mkdir_p($requestdb) unless -d $requestdb;

  my $db = BSDB::opendb($requestdb, '');
  $db->{'noindex'} = {'id' => 1};

  my @allrequests = ls($requestdir);
  my $i = 0;
  my $count = @allrequests;
  for my $rid (@allrequests) {
    next if $rid eq ".nextid";
    $i++;
    print "$i / $count        \r";
    my $req = readxml("$requestdir/$rid", $BSXML::request, 1);
    print "WARNING: unable to parse request: $rid!\n" unless $req;
    $db->updateindex($rid, {}, $req || {});
  }
}

sub insert_request_db {
  my ($file) = @_;
  my $requestdb  = "$BSConfig::bsdir/db/request";
  my $requestdir = "$BSConfig::bsdir/requests";
  mkdir_p($requestdb) unless -d $requestdb;

  my $db = BSDB::opendb($requestdb, '');
  $db->{'noindex'} = {'id' => 1};

  my @rid = split ('/',$file);
  $rid = $rid[-1];
  my $req = readxml("$requestdir/$rid", $BSXML::request, 1);
  print "WARNING: unable to parse request: $rid!\n" unless $req;
  $db->updateindex($rid, {}, $req || {});
}

sub check_xml_file {
  my ($file, $type) = @_;

  print "parsing $file\n";
  my $xmldesc = readxml("$file", $type, 0);
  if ( defined($xmldesc) ) {
    print "Succesfull parsed file !\n";
  } else {
    die("ERROR: Unable to parse xml file !\n");
  }
}

sub check_product_xml_file {
  my ($file) = @_;

  print "parsing $file\n";
  my $xmldesc = BSProductXML::readproductxml("$file", 0, 1 );
  if ( defined($xmldesc) ) {
    print "Succesfull parsed file !\n";
  } else {
    die("ERROR: Unable to parse xml file !\n");
  }
}

sub check_kiwi_xml {
  my ($project, $package) = @_;

  my ($md5, $file) = find_latest_file($project, $package, 'kiwi');
  if (defined($md5) && defined($file)) {
    my $f = "$srcrepdir/$package/$md5-$file";
    check_xml_file($f, $BSKiwiXML::kiwidesc);
  } else {
    die("ERROR: No kiwi config file found in $project / $package !\n");
  }
}

sub check_constraints_xml {
  my ($project, $package) = @_;

  my ($md5, $file) = find_latest_file($project, $package, '_constraints');
  if (defined($md5) && defined($file)) {
    my $f = "$srcrepdir/$package/$md5-$file";
    check_xml_file($f, $BSXML::constraints);
  } else {
    die("ERROR: No _constraints file found in $project / $package !\n");
  }
}

sub check_meta_xml {
  my ($project, $package) = @_;
  my $file;

  if (defined($package)){
    $file = "$projectsdir/${project}.pkg/${package}.xml";
    $metadesc = readxml("$file", $BSXML::pack, 0);
  } else {
    $file = "$projectsdir/$project.xml";
    $metadesc = readxml("$file", $BSXML::proj, 0);
  }

  if (defined($metadesc)) {
    print "Succesfull parsed $file !\n";
  } else {
    die("ERROR: Unable to parse Meta XML in $file !\n");
  }
}

sub write_event {
  my ($project, $repo, $arch, $event, $package) = @_;
  my $evname = "${event}";
  $evname .= "::$project" if defined $project;
  $evname .= "::$package" if defined $package;
  $evname .= "::$repo" if defined $repo;
  $evname = "${event}:::".Digest::MD5::md5_hex($evname) if length($evname) > 200;
  my $ev = { 'type' => $event };
  $ev->{'project'} = $project if defined $project;
  $ev->{'package'} = $package if defined $package;
  $ev->{'repository'} = $repo if defined $repo;
  writexml("$eventroot/$arch/.$evname$$", "$eventroot/$arch/$evname", $ev, $BSXML::event);
  local *F;
  if (sysopen(F, "$eventroot/$arch/.ping", POSIX::O_WRONLY|POSIX::O_NONBLOCK)) {
    syswrite(F, 'x');
    close(F);
  }
}

sub write_publish_event {
  my ($project, $repo) = @_;
  my $evname = "${project}::${repo}";
  my $ev = { 'type' => "publish" };
  $ev->{'project'} = $project;
  $ev->{'repository'} = $repo;
  writexml("$eventroot/publish/.$evname$$", "$eventroot/publish/$evname", $ev, $BSXML::event);
  local *F;
  if (sysopen(F, "$eventroot/publish/.ping", POSIX::O_WRONLY|POSIX::O_NONBLOCK)) {
    syswrite(F, 'x');
    close(F);
  }
}

sub scan_repo {
  my ($project, $repo, $arch) = @_;
  write_event( $project, $repo, $arch, 'scanrepo' );
}

sub wipe_notyet {
  my ($project, $repo, $arch) = @_;
  write_event( $project, $repo, $arch, 'wipenotyet' );
}

sub dump_state {
  my ($arch) = @_;
  write_event( undef, undef, $arch, 'dumpstate' );
}

sub shutdown_scheduler {
  my ($arch) = @_;
  write_event( '', undef, $arch, 'exitcomplete' );
}

sub check_project {
  my ($project, $repo, $arch, $deep, $admin) = @_;
  if (defined $deep) {
    write_event($project, $repo, $arch, 'package');
    if (defined $admin) {
      write_event($project, $repo, $arch, 'admincheck');
    };
  } else {
    if (defined $admin) {
      write_event($project, $repo, $arch, 'admincheck');
    } else {
      write_event($project, $repo, $arch, 'recheck');
    }
  }
}

sub check_package {
  my ($project, $package, $arch) = @_;
  write_event($project, undef, $arch, 'package', $package);
}

# make stdout non-buffered
$| = 1;

#
# Argument parsing
#
if ( @ARGV < 1 ){
  echo_help();
  exit(1);
}

while (@ARGV) {
  my $arg = shift @ARGV;
  if ($arg eq "--help") {
    echo_help();
    exit(0);
  }
  if ($arg eq "--check-meta-xml") {
    die("ERROR: need at least a project name as argument!\n") if @ARGV < 1;
    my $project = shift @ARGV;
    if (@ARGV == 1) {
      my $package = shift @ARGV;
      check_meta_xml($project, $package);
    } else {
      check_meta_xml($project);
    }
  } elsif ($arg eq "--check-product-group-xml") {
    die("ERROR: need a file name as argument!\n") if @ARGV != 1;
    my $file = shift @ARGV;
    check_xml_file($file, $BSProductXML::group);
  } elsif ($arg eq "--check-product-xml") {
    die("ERROR: need a file name as argument!\n") if @ARGV != 1;
    my $file = shift @ARGV;
    check_product_xml_file($file);
  } elsif ($arg eq "--check-pattern-xml") {
    die("ERROR: need a file name as argument!\n") if @ARGV != 1;
    my $file = shift @ARGV;
    check_xml_file($file, $BSXML::pattern);
  } elsif ($arg eq "--check-request-xml") {
    die("ERROR: need a file name !\n") if @ARGV != 1;
    my $file = shift @ARGV;
    check_xml_file($file, $BSXML::request);
  } elsif ($arg eq "--update-request-db") {
    BSUtil::drop_privs_to($BSConfig::bsuser, $BSConfig::bsgroup);
    if (@ARGV == 1) {
       my $file = shift @ARGV;
	insert_request_db($file);
    } else {
	update_request_db();
    }
  } elsif ($arg eq "--update-source-db") {
    BSUtil::drop_privs_to($BSConfig::bsuser, $BSConfig::bsgroup);
    for my $projid (findprojects()) {
      for my $packid (findpackages($projid)) {
        print "$projid/$packid\n";
        my $rev = getrev($projid, $packid);
        my $files = lsrep($projid, $packid, $rev->{'srcmd5'});
        updatelinkinfodb($projid, $packid, $rev, $files);
      }
    }
  } elsif ($arg eq "--check-kiwi-xml") {
    die("ERROR: need either file name or project and package as argument!\n") if @ARGV < 1;
    if (@ARGV == 1){
      my $file = shift @ARGV;
      check_xml_file($file, $BSKiwiXML::kiwidesc);
    } else {
      my $project = shift @ARGV;
      my $package = shift @ARGV;
      check_kiwi_xml($project, $package);
    }
  } elsif ($arg eq "--check-constraints") {
    die("ERROR: need either file name or project and package as argument!\n") if @ARGV < 1;
    if (@ARGV == 1){
      my $file = shift @ARGV;
      check_xml_file($file, $BSXML::constraints);
    } else {
      my $project = shift @ARGV;
      my $package = shift @ARGV;
      check_constraints_xml($project, $package);
    }
  } elsif ($arg eq "--show-scheduler-architectures") {
    my $c = readxml($configfile, $BSXML::configuration);
    if ($c->{'schedulers'} && @{$c->{'schedulers'}->{'arch'} || []}) {
      print join(' ', @{$c->{'schedulers'}->{'arch'}})."\n";
    }
  } elsif ($arg eq "--parse-build-desc") {
    die("ERROR: need a file name as argument (spec, dsc or kiwi)!\n") if @ARGV < 1;
    my $file = shift @ARGV;
    my $cf = $cfile = $arch = undef;
    $arch = shift @ARGV if @ARGV > 0;
    if (@ARGV > 0) {
      $cfile = shift @ARGV if @ARGV == 1;
      $cf = Build::read_config( $arch, $cfile );
    };
    $cf->{'arch'} = $arch if $arch;
    my $ret = Build::parse($cf, $file);
    print Dumper($ret);
  } elsif ($arg eq "--parse-hdrmd5") {
    die("ERROR: need a file name as argument (rpm or deb)!\n") if @ARGV != 1;
    my $file = shift @ARGV;
    my $ret = Build::queryhdrmd5($file);
    print Dumper($ret);
  } elsif ($arg eq "--dump-cache") {
    if (@ARGV == 1) {
      $fullfile = shift @ARGV;
      die("ERROR: invalid filename (must end with .cache or .solv)\n") if $fullfile !~ /\.(?:solv|cache)$/;
      dump_solv($fullfile) if $fullfile =~ /\.solv$/;
      dump_nStore($fullfile) if $fullfile =~ /\.cache$/;
    } else {
      die("ERROR: need project, repository and architecture as argument!\n") if @ARGV < 3;
      my $project = shift @ARGV;
      my $repo = shift @ARGV;
      my $arch = shift @ARGV;
      dump_cache($project, $repo, $arch);
    }
  } elsif ($arg eq "--dump-relsync") {
    die("ERROR: need file as argument!\n") if @ARGV < 1;
    my $file = shift @ARGV;
    my $sel = shift @ARGV;
    dump_nStore($file, $sel);
  } elsif ($arg eq "--set-relsync") {
    die("ERROR: need file as argument!\n") if @ARGV < 1;
    my $file = shift @ARGV;
    my $s = dump_nStore($file);
    my $key = shift @ARGV;
    my $value = shift @ARGV;
    if (defined($key) && defined($value)){
      $s->{$key} = $value;
      print "\nChanged to:\n";
      print Dumper($s);
      Storable::nstore($s, $file);
    }
  } elsif ($arg eq "--dump-state") {
    die("ERROR: need architecture as argument!\n") if @ARGV < 1;
    my $arch = shift @ARGV;
    dump_state( $arch );
  } elsif ($arg eq "--shutdown-scheduler") {
    die("ERROR: need architecture as argument!\n") if @ARGV < 1;
    my $arch = shift @ARGV;
    shutdown_scheduler( $arch );
  } elsif ( $arg eq "--check-project" ) {
    die("ERROR: need at least project and architecture as argument!\n") if @ARGV < 2;
    my $project = shift @ARGV;
    my $repo;
    $repo = shift @ARGV if @ARGV == 2;
    my $arch = shift @ARGV;
    check_project($project, $repo, $arch);
  } elsif ( $arg eq "--check-all-projects" ) {
    die("ERROR: need architecture as argument!\n") if @ARGV < 1;
    my $arch = shift @ARGV;
    check_project(undef, undef, $arch);
  } elsif ( $arg eq "--check-package" ) {
    die("ERROR: need project, package and architecture as argument!\n") if @ARGV < 3;
    my $project = shift @ARGV;
    my $package = shift @ARGV;
    my $arch = shift @ARGV;
    check_package($project, $package, $arch);
  } elsif ( $arg eq "--deep-check-project" ) {
    die("ERROR: need at least project and architecture as argument!\n") if @ARGV < 2;
    my $project = shift @ARGV;
    my $repo;
    $repo = shift @ARGV if @ARGV == 2;
    my $arch = shift @ARGV;
    check_project($project, $repo, $arch, 1);
  } elsif ( $arg eq "--publish-repository" || $arg eq "--unpublish-repository" ) {
    die("ERROR: need project and repository as argument!\n") if @ARGV != 2;
    my $project = shift @ARGV;
    my $repo = shift @ARGV;
    if ( $arg eq "--unpublish-repository" ) {
      # remove :repo
      my $repo = "$reporoot/$project/$repo/";
      for my $a (ls($repo)) {
        next unless -e "$repo/$a/:repodone";
        system('rm', '-rf', "$repo/$a/:repo", "$repo/$a/:repodone");
      }
    }
    write_publish_event($project, $repo);
  } elsif ( $arg eq "--clone-repository" ) {
    die("ERROR: need source project & repository and destination project & repository as argument!\n") if @ARGV < 3;
    my $srcproject = shift @ARGV;
    my $srcrepo = shift @ARGV;
    my $destproject;
    my $destrepo;
    if (@ARGV == 1) {
       $destrepo = shift @ARGV;
       $destproject = $srcproject;
    } else {
       $destproject = shift @ARGV;
       $destrepo = shift @ARGV;
    }
    clone_repository($srcproject, $srcrepo, $destproject, $destrepo);
  } elsif ($arg eq "--rescan-repository") {
    die("ERROR: need project, repository and architecture as argument!\n") if @ARGV < 3;
    my $project = shift @ARGV;
    my $repo = shift @ARGV;
    my $arch = shift @ARGV;
    wipe_notyet($project, $repo, $arch);
    scan_repo( $project, $repo, $arch );
  } elsif ($arg eq "--force-check-project") {
    die("ERROR: need project, repository and architecture as argument!\n") if @ARGV < 3;
    my $project = shift @ARGV;
    my $repo = shift @ARGV;
    my $arch = shift @ARGV;
    wipe_notyet($project, $repo, $arch);
    check_project($project, $repo, $arch, undef, 1); # with adminhighprio
  } elsif ($arg eq "--create-patchinfo-from-updateinfo") {
    my $uf = shift @ARGV;
    my $pooldirecotory = shift @ARGV;
    my $updateinfo = readxml($uf, $BSXML::updateinfoitem);
    my $patchinfo= {};
    $patchinfo->{'incident'} = $updateinfo->{'id'};
    $patchinfo->{'summary'} = $updateinfo->{'title'};
    $patchinfo->{'description'} = $updateinfo->{'description'};
    $patchinfo->{'version'} = $updateinfo->{'version'};
    $patchinfo->{'category'} = $updateinfo->{'type'};
    $patchinfo->{'packager'} = $updateinfo->{'from'};
    $patchinfo->{'rating'} = 'low';
    $patchinfo->{'issue'} = [];
    for my $ref (@{$updateinfo->{'references'}->{'reference'} || []}) {
      my $b;
      if ($ref->{'type'} eq 'bugzilla') {
        $b = { 'id' => $ref->{'id'}, 'tracker' => 'bnc' };
      } elsif ($ref->{'type'} eq 'cve') {
        $b = { 'id' => $ref->{'id'}, 'tracker' => 'CVE' };
      } else {
       die("Unhandled type $ref->{'type'}");
      };
      push @{$patchinfo->{'issue'}}, $b;
    };
    delete $patchinfo->{'issue'} unless @{$patchinfo->{'issue'}} > 0;
    my $id = "$patchinfo->{'incident'}-$patchinfo->{'version'}";
    mkdir($id);
    writexml("._patchinfo", "$id/_patchinfo", $patchinfo, $BSXML::patchinfo);

    for my $file (@{$updateinfo->{'pkglist'}->{'collection'}[0]->{'package'} || []}) {
      system( "find $pooldirecotory -name $file->{'filename'} | xargs -I {} cp {} $id/" ) && die( "$file->{'filename'} not found in $pooldirecotory" );
    }
    system( "rpm -qp --qf '%{SOURCERPM}\n' $id/*rpm|while read i; do find $pooldirecotory -name \$i | xargs -I {} cp {} $id/; done" );
    my $ufc;
    $ufc->{'update'} = [];
    push @{$ufc->{"update"}}, $updateinfo;
    writexml("$id/.updateinfo.xml", "$id/updateinfo.xml", $ufc, $BSXML::updateinfo);
  } elsif ($arg eq "--remove-old-sources" ) {
    die("ERROR: need age (in days) and count of revisions to keep as argument!\n") if @ARGV < 2;
    my $days = shift @ARGV;
    my $min_revs = shift @ARGV;
    die("ERROR: second argument must be >=1!\n") if $min_revs <1;

    my $debug = 0;
    if ( @ARGV == 1 ) {
      if ( shift @ARGV eq "--debug") {
      $debug = 1;
      }
    } elsif ( @ARGV > 1 ) {
      die("ERROR: too much parameters!\n");
    }

    my $mastertimestamp = time - $days*60*60*24;
    my %deletehashes; #key: hash value: @files
    my %keephashes;
    my @revfiles;
    my %treesfiles;

    my $deletedbytes = 0;

    # get all .rev and .mrev files and fill hashes with files to delete or not do delete
    my @projectdirs;
    opendir(D, $projectsdir) || die ($!);
      foreach my $prjdir (readdir(D)) {
        next if $prjdir =~ /^\.{1,2}$/;
        if ( -d $projectsdir.'/'.$prjdir ) {
          opendir(E, $projectsdir.'/'.$prjdir) || die($!);
            foreach my $file (readdir(E)) {
              if ( $file =~ /\.(mrev|rev)(\.del){0,1}$/ ) {
                push @revfiles, "$projectsdir/$prjdir/$file";
                open(F, '<', $projectsdir.'/'.$prjdir.'/'.$file) || die($!);
                  my @lines = <F>;
                close(F);

                my @keeplines;
                if (scalar(@lines) < $min_revs) {
                  @keeplines = splice(@lines, -scalar(@lines));
                } else {
                  @keeplines = splice(@lines, -$min_revs);
                }
                # remove lines to keep from normal timestamp checking and put them directly into hash
                foreach my $line (@keeplines) {
                  my ($hash, $time) = ( split(/\|/, $line))[2,4];
                  push @{$keephashes{$hash}}, { project => $prjdir, file => $projectsdir.'/'.$prjdir.'/'.$file };
                }

                foreach my $line (@lines) {
                  my ($hash, $time) = ( split(/\|/, $line) )[2,4];
                  if ( $time < $mastertimestamp) {
                    push @{$deletehashes{$hash}},  { project => $prjdir, file => $projectsdir.'/'.$prjdir.'/'.$file };
                  } else {
                    push @{$keephashes{$hash}}, { project => $prjdir, file => $projectsdir.'/'.$prjdir.'/'.$file };
                  }
                }
              }
            }
          closedir(E);
        }
    }
    closedir(D);

    if ($debug) {
      print "all hashes to keep (must be at least one per project):\n";
      foreach my $hash (keys %keephashes) {
        foreach my $entry (@{$keephashes{$hash}}) {
          print "project: ", $entry->{project}, ", file: ", $entry->{file}, " hash: ", $hash, "\n";
        }
      }
      print "\n";
    }


    # get all files from treesdir
    my @treesdirs;
    opendir(D, $treesdir) || die($!);
      push @treesdirs,  map { $treesdir."/".$_ } readdir(D);
    closedir(D);
    opendir(D, $srcrepdir) || die($!);
      push @treesdirs,  map { $srcrepdir."/".$_ } readdir(D);
    closedir(D);
    @treesdirs = grep { $_ !~ /\.{1,2}$/  } @treesdirs;

    if ($debug) {
      print "all treesdirs:\n", join("\n", @treesdirs);
      print "\n\n";
    }

    foreach my $dir (@treesdirs) {
      if ( -d $dir ) {
        if ( $dir =~ /$srcrepdir/ ) {
          opendir(F, $dir) || die($!);
          foreach my $file (readdir(F)) {
            if ( $file =~ /(.+)-MD5SUMS$/ ) {
              my $MD5SUM = $1;
              $treesfiles{$MD5SUM} = $dir.'/'.$file if $file =~ /-MD5SUMS$/;
            }
          }
          closedir(F);
        } else {
          opendir(E, $dir) || die($!);
          foreach my $package (readdir(E)) {
            if ( -d $dir.'/'.$package ) {
              opendir(F, $dir.'/'.$package) || die($!);
              foreach my $file (readdir(F)) {
                if ( $file =~ /(.+)-MD5SUMS$/ ) {
                  my $MD5SUM = $1;
                  $treesfiles{$MD5SUM} = $dir.'/'.$package.'/'.$file if $file =~ /-MD5SUMS$/;
                }
              }
              closedir(F);
            } # if
          } # foreach
          closedir(E);
        } # else
      } # if -d $dir
    } #foreach

    if ($debug) {
      print "all treesfiles:\n";
      foreach my $key (keys %treesfiles) {
        print $treesfiles{$key}, "\n";
      }
      print "\n";
    }


    # get all dir names in srcrepdir
    # fetch all filenames in subdirectories
    my %sourcefiles;
    opendir(D, $srcrepdir) || die($!);
    foreach my $dir (readdir(D)) {
      next if $dir =~ /^\.{1,2}$/;
      if ( -d $srcrepdir.'/'.$dir ) {
        opendir(E, $srcrepdir.'/'.$dir) || die($!);
        foreach my $file (readdir(E)) {
          next if $file =~ /^\.{1,2}$/;
          $sourcefiles{$file} = "$srcrepdir/$dir/$file";
        }
        closedir(E);
      }
    }
    closedir(D);

    if ($debug) {
      print "all sourcefiles:\n";
      foreach my $key (keys %sourcefiles) {
        print $sourcefiles{$key}, "\n";
      }
      print "\n";
    }

    my %deletefiles;
    # create array with files to delete from srcrepdir
    foreach my $file (keys %deletehashes) {
      next if !defined $treesfiles{$file}; 
      open(F, '<', $treesfiles{$file}) || die($!);
        while (<F>) {
          my ($hash, $desc) = split(/\s+/, $_);
          $deletefiles{$hash} = $hash."-".$desc;
        }
      close(F);
    }

    if ($debug) {
      print "files to delete:\n";
      foreach my $key (keys %deletefiles) {
        print $deletefiles{$key}, "\n";
      }
      print "\n";
    }

    my %keepfiles;
    # look if keephashes contains links to revision that would get deleted
    foreach my $file (keys %keephashes) {
      open(F, '<', $treesfiles{$file}) || die($!);
        while (<F>) {
          my ($hash, $desc) = split(/\s+/, $_);
          if ( /_link/ ) {
            my ($hash, $desc) = split(/\s+/, $_);
            next if !defined( $sourcefiles{$hash.'-'.$desc});
            # open link file to look if it links to a file that will be deleted
            my $link = readxml($sourcefiles{$hash.'-'.$desc}, $BSXML::link);
            next if !defined $link->{"package"} || !defined $link->{"project"} || !defined $link->{"rev"};
            my $revision = getrev($link->{"project"}, $link->{"package"}, $link->{"rev"});
            next if !defined($revision->{"time"});
            if ($revision->{"time"} < $mastertimestamp) {
              # delete the hash with the link to be able to rewrite .rev files
              delete ($deletehashes{$revision->{"srcmd5"}});
              next unless (-e $treesfiles{$revision->{"srcmd5"}});
              open(F, '<', $treesfiles{$revision->{"srcmd5"}}) or die($!);
                foreach my $line (<F>) {
                  $keepfiles{$hash} = $hash."-".$desc;
                }
              close(F);
            }
          } else {
            $keepfiles{$hash} = $hash."-".$desc;
          }
        }
      close(F);
    }

    if ($debug) {
      print "files to keep:\n";
      foreach my $key (keys %keepfiles) {
        print $keepfiles{$key}, "\n";
      }
      print "\n";
    }

    my @deletefiles;
    my @keepfiles = map {$_ } %keepfiles;
    foreach my $file (keys %deletefiles) {
      push @deletefiles, $deletefiles{$file} if !grep(/$file/, @keepfiles);
    }


    if ($debug) {
      print "files to delete without kept ones:\n";
      print join("\n", @deletefiles);
      print "\n";
    }

    if (scalar(@deletefiles) == 0) {
      print "nothing to delete\n";
    } else {
      my $deleted = 0;
      my $dr = 0; # delete result
      # delete files!
      print "starting deletion process: \n" if $debug;
      foreach my $f (keys %sourcefiles) {
        print "\nfile:\t$sourcefiles{$f}" if $debug;
        next if !grep(/$f/, @deletefiles);
        if ( -e $sourcefiles{$f} ) {
          $deletedbytes = $deletedbytes + (stat($sourcefiles{$f}))[7];
          $dr = unlink $sourcefiles{$f} || warn "Could not unlink $sourcefiles{$f}: $!"; 
          if ($dr) {
            print " deleted\n" if $debug;
            $deleted++;
          }
        }
      }

      # find treefiles without references
      my @utreefiles;
      foreach my $tfile (keys %treesfiles) {
        
      }
      
      if ($deleted > 0) {
        # rewrite rev files
        foreach my $revfile (@revfiles) {
          my @revfile;
          open(F, '<', $revfile) or die($!);
          foreach my $line (<F>) {
            my ($hash) = ( split(/\|/, $line) )[2];
            # do not rewrite hashes from %deletehashes, to not overwrite files uploaded as the deletion runs
            push @revfile, $line if (!defined $deletehashes{$hash} || defined $keephashes{$hash});
          }
          close(F);
          open(F, '>', $revfile) or die($!);
          print F @revfile;
          close(F);
        }
      }
      # some checking needed to reread everything?
      printf "\nDeleted %d files, Freed  %.3f KB.\n", $deleted, $deletedbytes/1024;
    }
  } else {
    echo_help();
    exit(1)
  }
}

