#!/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 $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.

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.
";
}

#### 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) = @_;
  my $cache = Storable::retrieve($file) || {};
  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 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 "--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" || $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);
  } else {
    echo_help();
    exit(1)
  }
}

