path: root/iurt2

#!/usr/bin/perl
#
# Copyright (C) 2005 Mandrakesoft
# Copyright (C) 2005,2006 Mandriva
# 
# Author: Florent Villard <warly@mandriva.com>
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2, or (at your option)
# any later version.
#
# 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; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
#
# compare and rebuild packages on different architecture
#
# TODO
#
# - use a cache (rpmctl cache for example) to find maintainer
# - add icecream compilation support
# - add a --group option to compile a set of packages (in progress)
# - add a function to update a packages when it obviously need to be recompile
# - Maybe call the function from the initial todo list (thus making the argument ordering important)
#
use strict;
use RPM4::Header;
use Iurt::Config qw(config_usage get_date config_init dump_cache_par);
use Data::Dumper;
use URPM;
use Iurt::DKMS;
use Iurt::Urpmi;
use Iurt::Chroot qw(clean_chroot dump_rpmmacros add_local_user create_temp_chroot remove_chroot);
use Iurt::Process qw(perform_command clean);
use File::NCopy qw(copy);
use MIME::Words qw(encode_mimewords);
# I did not manage to make locks work over the network
#use File::lockf;
use Mkcd::Commandline qw(parseCommandLine usage);
use MDK::Common;
use Filesys::Df qw(df);

my $program_name = 'iurt2';
# sessing parameters
my $arg = @ARGV;
my (@params, %run);
$run{program_name} = $program_name;
my %arch_comp = (
    'i586' => { 'i386' => 1, 'i486' => 1, 'i586' => 1 },
    'i686' => { 'i386' => 1, 'i486' => 1, 'i586' => 1, 'i686' => 1 },
    'x86_64' => { 'x86_64' => 1 },
    'ppc' => { 'ppc' => 1 },
    'ppc64' => { 'ppc' => 1, 'ppc64' => 1 },
);

$run{todo} = [ ];
@params = ( 
    #    [ "one letter option", "long name option", "number of args (-X means ´at least X´)", "help text", "function to call", "log info"]
    #
    # no_rsync, config_help and copy_srpm kept for compatibility reasons
    #
    [ "", "$program_name", 0, "[--cache] [--chrooted-urpmi <media prefix>] [--concurrent-run] [--config foo value] [--warn] [--verbose integer]
            [--copy-srpm] [--debug] [--distro] [--no-rsync] [--clean user1 user2 user3] [--clean-all] [--shell] [--stop {p|c|i|l|b|a|s}]
 	    [--use-system-distrib] [--dir] [--help foo?] [--log filename] [--group] [--unionfs]
 	    [--upload [--markrelease] [--source]] [--dir] [--help foo?] [--log filename]  [--unionfs] [--status] [--ignore-failure]
 	    {--config_help | --dkms 
	    --chroot --arch {i586|x86_64|ppc} --distro {cooker|2006.0|community/2006.0|...} } |
 	    --rebuild {cooker|2006.0|community/2006.0|...} {i586|x86_64|ppc|...} {filename1.src.rpm} {filename2.src.rpm} ... {filenamen.src.rpm} }", 
    "$program_name is a perl script to rebuild automatically several rpm in chroot, given a sourcerpm repository, and mail authors or rebuilder when problems occurs.", 
    sub { $arg or usage($program_name, \@params) }, "" ],
    [ "", "distro", 1, "<distro>", 
    "Set the distribution",
    sub { ($run{distro}) = @_; 1 }, "Setting the distribution" ],
    [ "", "dkms", 0, "", 
    "Set the DKMS rebuild mode",
    sub { ($run{dkms}) = 1; 1 }, "Running a DKMS rebuild run" ],
    [ "a", "arch", 1, "<architecture>", 
    "Set the architecture",
    sub { ($run{my_arch}) = @_; 1 }, "Setting architecture" ],
    [ "", "cache", 0, "", 
    "Use the global cache file",
    sub { $run{use_cache} = 1 }, "Activating cache use" ],
    [ "", "copy-srpm", 0, "", 
    "Copy also the regenerated SRPM",
    sub { $run{copy_srpm} = 1 }, "Activating the copy_srpm mode" ],
    [ "", "copy_srpm", 0, "", 
    "Copy also the regenerated SRPM",
    sub { $run{copy_srpm} = 1 }, "Activating the copy_srpm mode" ],
    [ "c", "chroot", 0, "", 
    "Check chroot and update it if needed",
    sub { $run{chroot} = 1 }, "Activating chroot updating" ],
    [ "", "chrooted-urpmi", 1, "<media prefix>", 
    "Create urpmi media inside the chroot instead of using --root (media prefix is like http:///server.mandriva.com/dis/)",
    sub { $run{chrooted_urpmi} = shift }, "Activating chroot updating" ],
    [ "", "clean-all", 0, "", 
    "Clean all remaining chroots for all the users",
    sub { $run{clean_all} = 1 }, "Activating clean chroot flag" ],
    [ "", "clean", -1, "<user 1> <user 2> ... <user n>", 
    "Clean remaining chroot before runing",
    sub { $run{clean} = \@_ }, "Activating clean chroot flag" ],
    [ "", "concurrent-run", 0, "", 
    "Allow several iurt to run on different machines (slower)",
    sub { $run{concurrent_run} = 1 }, "Activating concurrent run checks" ],
    [ "d", "dir", -1, "", 
    "Directory where to find packages to rebuild", 
    sub { $run{extra_dir} = \@_; 1 }, "Adding extra source packages directories" ],
    [ "", "config", 2, "<configuration keyword> <value>", 
    "Override a configuration file variable",
    sub { my ($key, $value) = @_; $run{config}{$key} = $value }, "Overriding configuration variable" ],
    [ "", "config-help", 0, "", 
    "Explain configuration files keywords", 
    sub { $run{config_usage} = 1 }, "Activating debug mode" ],
    [ "", "config_help", 0, "", 
    "Explain configuration files keywords", 
    sub { $run{config_usage} = 1 }, "Activating debug mode" ],
    [ "", "debug", 0, "", 
    "Activate debug mode", 
    sub { $run{debug} = 1 }, "Activating debug mode" ],
    [ "g", "group", 0, "", 
    "Activate group mode, packages will be compiled as a global set, not as individual packages", 
    sub { $run{group} = 1 }, "Activating the group mode" ],
    [ "", "ignore-failure", 0, "", 
    "Do not take into account the failure cache, try to recompile all the packages not synchronized", 
    sub { $run{ignore_failure} = 1 }, "Activating the mode ignoring previous failure" ],
    [ "u", "unionfs", 0, "", 
    "Activate unionfs mode", 
    sub { $run{unionfs} = 1 }, "Activating unionfs mode" ],
    [ "l", "log", 1, "<log file>", 
    "Log file.", 
    sub { 
	$run{log} = pop @_; 
	open $run{LOG}, ">$run{log}" or die "unable to open $run{log}\n";
	print *{$run{LOG}}, "command line: @ARGV\n";
	1
    }, "Log file" ],
    [ "m", "media", -1, "<media 1> <media 2> ... <media 3>", 
    "Media to rebuild", 
    sub { ($run{media}) = @_; 1 }, "Adding a media to rebuild" ],
    [ "n", "no", 0, "", 
    "Perform all the check but do not compile anything", 
    sub { ($run{no_compile}) = 1 }, "Setting the no compilation flag" ],
    [ "r", "rebuild", -2, "<distro> <architecture> <srpm 1> <srpm 2> ... <srpm n>", 
    "Rebuild the packages, e.g. $program_name -r cooker x86_64 /home/foo/rpm/SRPMS/foo-2.3-12mdv2007.0.src.rpm", 
    sub { 
	$run{rebuild} = 1; 
	$run{distro} = shift @_;
       	$run{my_arch} = shift @_;
	foreach (@_) {
	    my ($path, $srpm);
	    if (m,(.*/)([^/]*.src.rpm)$, && -f $_) {
		($path, $srpm) = ( $1, $2 )
	    } elsif (m,([^/]*.src.rpm)$, && -f $_) {
		($path, $srpm) = ( './', $1 )
	    } else {
		die "FATAL $program_name: $_ does not seems to be a SRPM\n"
	    }
	    my $hdr = RPM4::Header->new($_);
	    if (check_arch($hdr)) {
		print {$run{LOG}} "$program_name: force build for $2 (from $1)\n";
		push @{$run{todo}}, [ $path, $srpm, 1 ]
	    } else {
		print {$run{LOG}} "ERROR $program_name: $_ could not be build on $run{my_arch}, ignored.\n"
	    }
	}
	1
	}, "Activating rebuild mode" ],
    [ "", "upload", [
	["", "upload", 0, "[options]", 
	"Upload the rebuild packages", 
	sub {   my ($tmp) = @_;
	    $tmp->[0] ||= {};
	    1
	}, "Setting upload options"],
	[ "m", "markrelease", 0, "", 
	"Mark SVN directory when uploading the packages", 
	sub { $run{markrelease} = 1 }, "Adding markrelease repsys option" ],
	[ "s", "source", 0, "", 
	"Upload the source package as wells", 
	sub { $run{source_upload} = 1 }, "Setting source flag for upload" ],
    ], "[options]", 
    "Upload the rebuild packages", 
    sub { $run{upload} = 1 }, "Setting the upload flag" ],
    [ "", "no_rsync", 0, "", 
    "Do not send build log to the distant rsync server", 
    sub { $run{no_rsync} = 1 }, "Setting the no rsync warn flag" ],
    [ "", "no-rsync", 0, "", 
    "Do not send build log to the distant rsync server", 
    sub { $run{no_rsync} = 1 }, "Setting the no rsync warn flag" ],
    [ "", "use-system-distrib", 1, "<media>", 
    "Use the current system urpmi configuration", 
    sub { $run{use_system_distrib} = shift; 1 }, "Setting system distrib for urpmi configuration" ],
    [ "v", "verbose", 1, "<verbose level>", 
    "Give more info messages about what is going on (level from 1 to 10)", 
    sub { $run{verbose} = $_[0]; 1 }, "Setting verbose level" ],
    [ "w", "warn", 0, "", 
    "Warn maintainer of the packages about problem in the rebuild", 
    sub { $run{warn} = 1 ; 1 }, "Setting warn flag to warn maintainers" ],
    [ "", "shell", 0, "", 
    "Dump to a shell into the newly created chroot with sudo on rpm, urpmi, urpme and urpmi.addmedia", 
    sub { 
	($run{shell}) = 1; 
	1 }, "Setting option to dump to a shell" ],
    [ "", "stop", 1, "<rpm step>", 
    "Perform rpm -b<rpm step> (p c i l b a s) instead of rpm -ba and then open a shell in the chroot", 
    sub { 
	($run{stop}) = @_; 
	1 
    }, "Setting rpm build option" ],
    [ "", "status", 1, "<mail>", 
    "Send a status mail to the provided mail address", 
    sub { 
	($run{status_mail}) = @_; 
	1 
    }, "Setting status mail option" ],
);

open(my $LOG, ">&STDERR");
$run{LOG} = $LOG;

my $todo = parseCommandLine($program_name, \@ARGV, \@params);
@ARGV and usage($program_name, \@params, "@ARGV, too many arguments");
foreach my $t (@$todo)  {
    print {$run{LOG}} "$program_name: $t->[2]\n" if $run{verbose} > 5;
    &{$t->[0]}(@{$t->[1]}) or print {$run{LOG}} "ERROR: $t->[2]\n";
}

$run{distro_tag} = $run{distro};
$run{distro_tag} =~ s,/,-,g;

my $real_arch = `uname -m`;
chomp $real_arch;
my $HOME = $ENV{HOME};
my $configfile = "$HOME/.iurt.$run{distro_tag}.conf";
print {$run{LOG}} "$program_name: loading config file $configfile\n" if $run{verbose} > 1;
my $config;
if (-f $configfile) {
    $config = do $configfile or die "FATAL $program_name: syntax error in $configfile";
} else {
    $config = {}
}
my $urpmi = Iurt::Urpmi->new(run => \%run, config => $config, urpmi_options => "-v --no-verify-rpm --nolock --auto --ignoresize");
$run{urpmi} = $urpmi;

if (!$run{chrooted_urpmi} && $run{group}) {
    die "FATAL $program_name: option --chrooted-urpmi is mandatory if --group is selected"
} 

my %config_usage = ( 
    admin => { desc => 'Mail of the administrator of packages builds', default => '' },
    all_media => { desc => 'List of known media', default => { 'main' => [ '' ], 'contrib' => [ '' ] } },
    basesystem_media_root => { desc => 'Name of the media holding basesystem packages', default => sub { my ($config, $run) = @_; "$config->{repository}/$run{distro}/$run{my_arch}/" } },
    basesystem_media => { desc => 'Where to find basesystem packages', default => 'main/release' },
    cache_home => { desc => 'Where to store the cache files', default => "$HOME/.bugs" },
    cache_min_size => { desc => 'Minimal size to consider a cache file valid', default => 1000000 },
    distribution => { desc => 'Name of the packages distribution', default => 'Mandriva Linux' },
    home => { desc => 'Home dir', default => $HOME },
    install_chroot_binary => { desc => 'Tool used to create initial chroot', default => 'install-chroot-tar.sh' },
    local_home => { desc => 'Where to build packages', default => $HOME },
    local_upload => { desc => 'Where to store build packages and log', default => '' },
    local_spool => { desc => 'To override the directory where all the results are stored', default => '' },
    log_size_limit => { desc => 'Maximum authorized size for a log file', default => '100M' },
    log_size_date => { desc => 'Number of days log should be kept', default => '30' },
    log_url => { desc => 'Where the log can be seen', default => '' },
    minimum_package_number => { "Minimum number of packages in a synthesis file to consider it valid", default => 1000 },
    max_command_retry => { "Maximum number of retry Iurt will perform for a given command", fault => 20 },
    no_mail  => { desc => 'Hash table with people mail address where we should not send any mails', default => {} },
    packager => { desc => 'Name of the build bot', default => 'Iurt' },
    repository => { desc => 'Prefix of the repositories', default => '/mnt/BIG/dis/' },
    rsync_to => { desc => 'Server where the result of the builds should be rsynced (name@server:path format)', default => ''},
    sendmail => { desc => 'If the bot will send mail reports regarding build', default => 0 },
    supported_arch => { desc => 'Table of supported architecture', default => ['i586', 'x86_64'] },
    upload => { desc => 'Where to copy build packages', default => "$HOME/uploads/" },
    vendor => { desc => 'Name of the packages vendor', default => 'Mandriva' },
   );
config_usage() if $run{config_usage};
$run{my_arch} or usage($program_name, \@params, "no architecture given (media $run{media}, run{my_arch} $run{my_arch}, todo @{$run{todo}})");
if (!$arch_comp{$real_arch}{$run{my_arch}}) {
    die "FATAL $program_name: could not compile $run{my_arch} binaries on a $real_arch"
}
config_init(\%config_usage, $config, \%run);

$config->{upload} .= $run{distro};
$config->{upload} =~ s/community//g;
if ($run{distro} ne 'cooker') {
    if ($run{media} ne 'main') {
	$config->{upload} .= "/$run{media}"
    }
} elsif ($run{media} eq 'contrib') {
    $config->{upload} =~ s/cooker/contrib/g;
}

-d $config->{upload} or usage($program_name, \@params, "$config->{upload} does not exist");

# cache file name is needed early to remove the manual lock file if the lock mechanism does not work
my $cachefile = "$config->{cache_home}/iurt.$run{distro_tag}.$run{my_arch}.$run{media}.cache";
$run{cachefile} = $cachefile;
if (!$run{debug} && $run{media} || $run{chroot}) {
    $run{pidfile_home} = "$config->{cache_home}/";
    $run{pidfile} = "iurt.$run{distro_tag}.$run{my_arch}.$run{media}";
    check_pid(\%run)
}

my $debug_tag = '_debug' if $run{debug};
$run{debug_tag} = $debug_tag;
my $chroot_name = "chroot_$run{distro_tag}$debug_tag";
my $chroot = "$config->{local_home}/$chroot_name";
$run{chroot_path} = $chroot;
my $chroot_tar = "$chroot.$run{my_arch}.tar.gz";
$run{chroot_tar} = $chroot_tar;
if ($run{chroot} || !-d "$chroot/dev") {
    check_chroot($chroot, $chroot_tar, \%run) or die "FATAL $program_name: could not prepare initial chroot"
}

my $cache;
my $clear_cache = 1;
if (-f $cachefile && $run{use_cache}) {
    print {$run{LOG}} "$program_name: loading cache file $cachefile\n" if $run{verbose} > 1;
    $cache = do $cachefile or print "FATAL $program_name: could not load cache $cachefile ($!)\n";
    if (!$cache) {
	opendir my $cache_dir, $config->{cache_home};
	my $to_load;
	foreach my $file (readdir $cache_dir) {
	    (my $date) = $file =~ /iurt\.$run{distro_tag}\.$run{my_arch}\.$run{media}\.cache\.tmp\.(\d{8})/ or next;
	    if ($date > $to_load && -s "$config->{cache_home}/$file" > $config->{cache_min_size}) {
		$to_load = $date;
		$cachefile = "$config->{cache_home}/$file"
	    }
	}
	print {$run{LOG}} "$program_name: loading alternate cache file $cachefile\n";
	$cache = do $cachefile or print "FATAL $program_name: could not load cache $cachefile ($!)\n"
    }
    $clear_cache = 0 if $cache
}

if ($clear_cache) {
    $cache = { rpm_srpm => {}, failure => {}, queue => {}, warning => {}, run => 1, needed => {}, no_unionfs => {} }
}
$run{cache} = $cache;

my (%srpm_version, @wrong_rpm, %provides, %pack_provide, $to_compile, %maint);
$to_compile = @{$run{todo}};
$to_compile += check_media(\%run, $cache, $config, \%srpm_version, \@wrong_rpm, \%provides, \%pack_provide, \%maint) if $run{media};
$to_compile += search_packages(1, $cache, \%provides, \%run, \%maint, \%srpm_version, @{$run{extra_dir}}) if $run{extra};
my $dkms;
if ($run{dkms}) {
    $dkms = Iurt::DKMS->new(run => \%run, config => $config);
    $to_compile += $dkms->search_dkms() 
}
$run{to_compile} = $to_compile;

dump_cache_par(\%run);

print {$run{LOG}} "$program_name: will try to compile $to_compile packages\n" if $run{verbose} > 1;

my ($fulldate, $daydate) = get_date();
if ($run{use_cache}) {
    $run{run} = $cache->{run};
    $run{run} ||= 1;
    $cache->{run} = $run{run} + 1
} else {
    $run{run} = "0.$fulldate"
}
$run{daydate} = $daydate;
print {$run{LOG}} "$program_name: using $run{run} as chroot extension\n" if $run{verbose} > 4;
$run{user} = $ENV{SUDO_USER} || $ENV{USER};
$run{uid} = getpwnam $run{user};
print {$run{LOG}} "$program_name: using local user $run{user}, id $run{uid}\n" if $run{verbose} > 3;
my $luser = $run{user} || 'builder';

if ($run{unionfs}) {
    # FIXME need to grep /proc/modules not ot try to load it if already loaded
    open my $modules, '/proc/modules';
    my $ok;
    while (my $m = <$modules>) {
	if ($m =~ /unionfs/) {
	    $ok = 1;
	    last
	}
    }
    if (!$ok) {
	print {$run{LOG}} "$program_name: adding unionfs module\n" if $run{verbose} > 0;
	system("sudo /sbin/depmod -a");
	system("sudo /sbin/modprobe -f unionfs") and $run{unionfs} = 0;
    }
    if ($run{unionfs}) {
	$run{unionfs_dir} = "$config->{local_home}/iurt_unionfs$debug_tag/";
	remove_chroot(\%run, \&clean_all_unionfs);
	$run{unionfs_dir} = "$run{unionfs_dir}/$run{user}/";
	-d $run{unionfs_dir} or mkdir $run{unionfs_dir}
    }
}

my (%done, $wait_limit, $done);
$run{done} = \%done;
my $home = $config->{local_home};
my $union_id = 1;
$run{unionfs_tmp} = $run{unionfs};	
my $chroot_tmp = "$config->{local_home}/chroot_tmp";
if (!-d $chroot_tmp) {
    mkdir $chroot_tmp
} else {
    remove_chroot(\%run, $chroot_tmp, \&clean_all_chroot_tmp, $chroot_name);
}
$chroot_tmp = "$config->{local_home}/chroot_tmp/$run{user}";
if (!-d $chroot_tmp) {
    mkdir $chroot_tmp
}
$chroot_tmp = "$config->{local_home}/chroot_tmp/$run{user}/$chroot_name.$run{run}";
$run{chroot_tmp} = $chroot_tmp;

# now exit if there is nothing to do and it was just a cleaning pass
if ($run{no_compile} || !@{$run{todo}} && !$run{debug} && !$run{shell} && !$run{rebuild} && !$run{dkms}) {
    send_status_mail(\%run, $config, $cache) if ($run{status_mail});
    print {$run{LOG}} "$program_name: no package to compile :(\n";
    unlink "$run{pidfile_home}/$run{pidfile}" if $run{pidfile};
    exit
}
print {$run{LOG}} "$program_name: running with pid $$\n";

my $df = df $home;
if ($df->{per} == 100) {
    die "FATAL $program_name: not enough space on the filesystem, only $df->{bavail} KB on $home, full at $df->{per}%"
}

if ($run{shell}) {
    ($union_id, my $chroot_tmp) = create_temp_chroot(\%run, $config, $cache, $union_id) or die "FATAL $program_name: could not create temporary chroot";
    add_local_user($chroot_tmp, \%run, $luser, $run{uid}) or die "FATAL $program_name: could not add local user";
    $urpmi->set_command($chroot_tmp);
    $urpmi->add_packages($chroot_tmp, $luser, 'sudo', 'urpmi') or die "FATAL $program_name: could not add urpmi and sudo in the chroot";
    add_sudoers(\%run, $chroot_tmp, $luser);
    if ($run{shell}) {
	print {$run{LOG}} "$program_name: dumping to a chrooted shell into $chroot_tmp\n";
	exec "sudo chroot $chroot_tmp /bin/su $luser -c bash";
	die "FATAL $program_name: could not exec chroot to $chroot_tmp ($!)"
    }
}

$config->{local_upload} ||= $config->{local_home};
my $local_spool;
if ($config->{local_spool}) {
    $local_spool = $config->{local_spool}
} else {
    $local_spool = "$config->{local_upload}/iurt/$run{distro_tag}/$run{my_arch}/$run{media}/"
}
print {$run{LOG}} "$program_name: using $local_spool as local spooler\n" if $run{verbose} > 4;
if (!-d "$local_spool/log") {
    print {$run{LOG}} "$program_name: creating local spool $local_spool\n" if $run{verbose} > 4;
    mkdir_p("$local_spool/log") or die "FATAL $program_name: could not create local spool dir $local_spool ($!)"
}

# perform some cleaning before running to have some more space, rsync to the server too in case previous iurt crashed
if ($config->{rsync_to} && !$run{no_rsync}) { 
    	# remove some old and very big log files not to saturate the server
	system(qq|find $local_spool/log/ -name "*.log" \\( -size +$config->{log_size_limit} -or -mtime +$config->{log_size_date} \\) -exec rm -f {} \\;|);
	system("rsync --delete -alHPe 'ssh -xc arcfour' $local_spool/log/ $config->{rsync_to}/$run{distro_tag}/$run{my_arch}/$run{media}/log/");
}

print {$run{LOG}} "$program_name: try to dump rpm macros to $chroot/home/builder/.rpmmacros\n" if $run{verbose} > 3;
if (!dump_rpmmacros(\%run, $config, "$chroot/home/builder/.rpmmacros")) {
     print {$run{LOG}} "ERROR $program_name: could not dump rpm macros to $chroot/home/builder/.rpmmacros, trying to rebuild the chroot\n";
     check_chroot($chroot, $chroot_tar, \%run) or die "FATAL $program_name: could not prepare initial chroot";
     dump_rpmmacros(\%run, $config, "$chroot/home/builder/.rpmmacros") or die "FATAL $program_name: could not dump rpm macros to $chroot/home/builder/.rpmmacros"
}

$done += $dkms->dkms_compile($local_spool, $done);

# The next loop should be moved in a module someday

my $s = sub { 
    if ($run{main}) {
	print {$run{LOG}} "$program_name: dumping cache...\n"; 
	dump_cache_par(\%run);
	$Data::Dumper::Indent = 0;
	$Data::Dumper::Terse = 1;
	print {$run{LOG}} "Running environment:\n", Data::Dumper->Dump([\%run]), "\n\n" if $run{verbose} > 5; 
	print {$run{LOG}} "Configuration:\n",Data::Dumper->Dump([$config]),"\n\n";
    }
    exit 
};
$SIG{TERM} = $s;
$SIG{INT} = $s;
$run{main} = 1;

my $rebuild;
$run{group} = 0 if @{$run{todo}} == 1;
if ($run{group}) { 
    $rebuild = 1;
    $urpmi->order_packages($union_id, $luser) or die "FATAL $program_name: could not order packages";
    $urpmi->set_local_media("$local_spool/$run{run}/")
}
do { 
    $rebuild = 0;
    foreach (my $i ; $i < @{$run{todo}}; $i++) {
	my ($dir, $srpm, $status) = @{$run{todo}[$i]};
	$status or next;
	$done{$srpm} and next;
	$done{$srpm} = 1;
	check_version($srpm, \%srpm_version) or next;
	if ($run{debug}) { $run{debug}++ == 2 and exit }
	$done++;
	mkdir "$local_spool/log/$srpm";
	print {$run{LOG}} "$program_name: packages $srpm [$done/$to_compile]\n";
	# FIXME unfortunately urpmi stalls quite often
	my $retry = 0;
	# 
	# current rpm is sometime segfaulting, and iurt is them blocked and cannot 
	#
	# $cache->{failure}{$srpm} = 1;
	# dump_cache(\%run);
	retry:
	$urpmi->clean_urpmi_process($chroot_tmp);
	
	my ($u_id, $chroot_tmp) = create_temp_chroot(\%run, $config, $cache, $union_id, $chroot_tmp, $chroot_tar, $srpm) or next;
	$union_id = $u_id;

	$urpmi->urpmi_command($chroot, $luser);
	my ($srpm_name) = $srpm =~ /(.*)-[^-]+-[^-]+\.src\.rpm$/ or next;
	my ($maintainer, $cc);
	if (!$run{warn}) {
	    ($maintainer) = get_maint(\%run, $srpm);
	    $cc = "$maint{$srpm}";#, maintainers\@mandriva.com";
	    chomp $maintainer;
	    if (!$maintainer || $maintainer eq 'NOT_FOUND') {
		$maintainer = $cc;
		#$cc = 'maintainers@mandriva.com'
	    }
	}
	#($maintainer, $cc) = ($config->{admin},'');

	print {$run{LOG}} "$program_name: adding local user $luser into $chroot_tmp...\n" if $run{verbose};
	add_local_user($chroot_tmp, \%run, $luser, $run{uid}) or next;

	my $ret = recreate_srpm(\%run, $config, $chroot_tmp, $dir, $srpm, $luser, $retry);
	if ($ret == -1) {
	    $retry = 1;
	    goto retry
	} elsif (!$ret) {
	    next
	} 
	
	print {$run{LOG}} "$program_name: installing build dependencies of $srpm...\n" if $run{verbose};
	my $path_srpm =  $run{chrooted_urpmi} ? "/home/$luser/rpm/SRPMS/" : "$chroot_tmp/home/$luser/rpm/SRPMS/";
	# 
	# on x86_64 the rpm database is getting corrupted and sometimes rpm do not found anymore 
	# installed packages, retrying several time to be sure something is really broken
	my $ok = $urpmi->install_srpm_deps_hard($path_srpm, $srpm, $chroot_tmp, $local_spool, \%pack_provide, $maintainer);
	if (!$ok) {
	    $run{status}{$srpm} = 'install_deps_failure';
	    next;
	}
	# try to workarround the rpm -qa db4 error(2) from dbcursor->c_get: No such file or directory
	# system("sudo chroot $chroot_tmp rm -rf /var/lib/rpm/__db* &> /dev/null");
	system("sudo chroot $chroot_tmp rpm --rebuilddb &> /dev/null");
	perform_command("sudo chroot $chroot_tmp rpm -qa", 
	    \%run, $config, $cache, 
	    hash => "rpm_qa_$srpm", 
	    timeout => 60, 
	    debug_mail => $run{debug},
	    log => "$local_spool/log/$srpm/"); # or next; As this failed quite often, do not stop
	print {$run{LOG}} "Compiling $srpm\n" if $run{verbose}; 
	my $command = "rpm --rebuild /home/$luser/rpm/SRPMS/$srpm";
	if ($run{stop}) {
	    $urpmi->add_packages($chroot_tmp, $luser, 'urpmi', 'sudo');
	    add_sudoers(\%run, $chroot_tmp, $luser);
	    $command = "rpm -b$run{stop} /home/$luser/rpm/SPECS/*.spec"
	}
	if (!perform_command(qq{TMP=/home/$luser/tmp/ sudo chroot $chroot_tmp /bin/su $luser -c "$command"}, 
		\%run, $config, $cache, 
		#	mail => $maintainer, 
		error => "[REBUILD] $srpm from $run{distro_tag} does not build correctly on $run{my_arch}", 
		hash => "build_$srpm", 
		timeout => 18000, 
		srpm => $srpm,
		debug_mail => $run{debug},
		cc => $cc, 
		log => "$local_spool/log/$srpm/", 
		error_regexp => 'rror.*ailed|Bad exit status|RPM build error',
		callback => sub { 
		    my ($opt, $output) = @_;
		    if ($run{stop}) {
			print {$run{LOG}} "$program_name: dumping to a chrooted shell into $chroot_tmp (pid $$)\n";
			# exec does not work because it seems stdin and out are shared between children
			system("sudo chroot $chroot_tmp /bin/su $luser -c bash");
			exit
		    }
		    print {$run{LOG}} "$program_name: calling callback for $opt->{hash}\n" if $run{verbose} > 4;
		    if ($run{unionfs_tmp} && $output =~ /no space left on device/i) {
			print {$run{LOG}} "ERROR $program_name: running out of space to compile $srpm in unionfs mode, will recompile it in normal mode\n";
			$cache->{no_unionfs}{$srpm} = 1;
			return 1
		    } elsif ($run{unionfs_tmp} && $output =~ m,$home,) {
			print {$run{LOG}} "ERROR $program_name: seems like building $srpm needs to access /proc/self/exe, which is broken with unionfs, will try to recompile it in non unionfs mode\n";
			$cache->{no_unionfs}{$srpm} = 1;
			return 1
		    } elsif ($output =~ /bin\/ld: cannot find -l(\S*)|configure.*error.* (?:-l([^\s]+)|([^\s]+) includes)/) {
			my $missing = $1;
			my @rpm = find_provides(\%run, \%pack_provide, $missing);
			print {$run{LOG}} "$program_name: likely @rpm ($missing-devel) needed to rebuilt $srpm is not in build_requires\n" if $run{verbose} > 4;
			if ($maintainer ne 'NOT_FOUND') {
			    $opt->{mail} = $config->{admin};
			    #$opt->{mail} .= ", $other_maint";
			}
			if (!$opt->{mail}) { 
			    $opt->{mail} = $config->{admin};
			}
			if (@rpm > 1) {
			    $opt->{error} = "[MISSING_BUILD_REQUIRES_TAG] one of @rpm ($missing-devel), needed to build $srpm, is not in buildrequires";
			} elsif (@rpm == 1) {
			    $opt->{error} = "[MISSING_BUILD_REQUIRES_TAG] @rpm ($missing-devel), needed to build $srpm, is not in buildrequires";
			} else {
			    $opt->{error} = "[MISSING_BUILD_REQUIRES_TAG] $missing-devel, needed to build $srpm, is not in buildrequires";
			}
			$cache->{buildrequires}{$srpm}{$missing} = \@rpm;
			return 
		    }
		    1
		}, 
		freq => 1)) {
	    # FIXME
	    # The simple algo used here is : 
	    #  try to compile it with unionfs, if it runs out of space, compile it without the next time
	    #
	    #  This could be improved in keeping this srpm name for future version, but if we compile it 
	    #  on a new machine with more ram, or if next version compiles just fine with unionfs, we will
	    #  loose the unionfs advantage. 
	    #
	    #  Maybe the right thing to do would be to first try to increase the tmpfs size (more than 50 % of the 
	    #  physical RAM), but this will lead to more swap usage, and slower compilation (and lost of the unionfs
	    #  plus). Or to keep the faulty package a unionfs exception for some time, to save some more extra builds.
	    # 
	    if (!glob "$chroot_tmp/home/$luser/rpm/RPMS/*/*.rpm") {
		if ($run{unionfs_tmp} && $cache->{no_unionfs}{$srpm}) {
		    goto retry
		}
		$cache->{failure}{$srpm} = 1;
		$run{status}{$srpm} = 'build_failure';
		# 20060615
		dump_cache_par(\%run);
		dump_status($local_spool, \%run);
		next
	    }
	}
	# do some cleaning if the compilation is successful
	delete $cache->{needed}{$srpm} if defined $cache->{needed}{$srpm};
	delete $cache->{buildrequires}{$srpm} if defined $cache->{buildrequires}{$srpm};
	my $path_rpm =  $run{chrooted_urpmi} ? "/home/$luser/rpm/RPMS/" : "$chroot_tmp/home/$luser/rpm/RPMS/";
	# FIXME It seems the glob is not correctly expanded any more, so listing the directory content to do so
	opendir my $binfh, "$chroot_tmp/home/$luser/rpm/RPMS/";
	my @packages;
	foreach my $bindir (readdir $binfh) {
	    -d "$chroot_tmp/home/$luser/rpm/RPMS/$bindir" or next;
	    opendir my $rpmfh, "$chroot_tmp/home/$luser/rpm/RPMS/$bindir";
	    push @packages, map { "/home/$luser/rpm/RPMS/$bindir/$_" } grep { /\.rpm$/ } readdir $rpmfh;
	}
	$urpmi->install_packages($srpm, $local_spool, @packages) or next;
	
	$run{status}{$srpm} = 'ok';
	delete $cache->{failure}{$srpm} if defined $cache->{failure}{$srpm};
	if ($run{debug}) {
	    print {$run{LOG}} "$program_name: debug mode, skip other packages\n";
	    exit
	} elsif ($run{group}) {
	    $rebuild = 1;
	    print {$run{LOG}} "$program_name: group mode, keep packages for local media\n";
	    $run{done}{$srpm} = $done;
	    $urpmi->add_to_local_media($chroot_tmp, $srpm, $luser);
	} else {
	    print {$run{LOG}} "$program_name: build successful, copying packages to $local_spool.\n";
	    system("cp $chroot_tmp/home/$luser/rpm/RPMS/*/*.rpm $local_spool &>/dev/null") and print {$run{LOG}} "ERROR: could not copy rpm files from $chroot_tmp/home/$luser/rpm/RPMS/ to $local_spool ($!)\n";
	    if ($run{copy_srpm}) {
		system("cp $chroot_tmp/home/$luser/rpm/SRPMS/$srpm $local_spool &>/dev/null") and print {$run{LOG}} "ERROR: could not copy $srpm from $chroot_tmp/home/$luser/rpm/SRPMS/ to $local_spool ($!)\n";
	    }
	    process_queue($config, \%run, \@wrong_rpm, 1)
	}
	# dymp_cache each time so that concurrent process can get updated
	dump_cache_par(\%run) if $run{concurrent_run};
    }
    if ($run{group} && $rebuild) {
	$urpmi->order_packages($union_id)
    }
} while ($rebuild);

print {$run{LOG}} "$program_name: reprocess generated packages queue\n" if $run{verbose};
process_queue($config, \%run, \@wrong_rpm);

dump_cache_par(\%run);

print {$run{LOG}} "ERROR $program_name: RPM with a wrong SRPM name\n" if @wrong_rpm;
if (open my $file, ">$local_spool/log/wrong_srpm_names.log") {
    foreach (@wrong_rpm) {
	print $file "$_->[1] -> $_->[0] (", $cache->{rpm_srpm}{$_->[1]},")\n";
    }
    close $file
}

dump_status($local_spool, \%run);

send_status_mail(\%run, $config, $cache) if ($run{status_mail});

if ($config->{rsync_to} && !$run{no_rsync}) { 
    	# remove some old and very big log files not to saturate the server
	system(qq|find $local_spool/log/ -name "*.log" \\( -size +$config->{log_size_limit} -or -mtime +$config->{log_size_date} \\) -exec rm -f {} \\;|);
	system("rsync --delete -alHPe 'ssh -xc arcfour' $local_spool/log/ $config->{rsync_to}/$run{distro_tag}/$run{my_arch}/$run{media}/log/");
}

# one last try to clean
print {$run{LOG}} "$program_name: try to clean remaining unionfs\n" if $run{verbose};
if ($run{unionfs}) {
    my ($dir) = $run{unionfs_dir} =~ /(.*)\/[^\/]+\/?/;
    remove_chroot(\%run, $dir, \&clean_all_unionfs)
}
unlink "$run{pidfile_home}/$run{pidfile}" if $run{pidfile};
exit;

sub clean_all_unionfs {
    my ($unionfs_dir) = @_;
    print {$run{LOG}} "Cleaning old unionfs remaining dir in $unionfs_dir\n" if $run{verbose} > 1;
    my $dir;
    if (!opendir $dir, $unionfs_dir) {
	print {$run{LOG}} "FATAL $program_name: could not open $unionfs_dir ($!)";
	return
    }
    foreach (readdir $dir) {
	/unionfs\.((?:0\.)?\d+)\.(\d*)$/ or next;
	clean_unionfs($unionfs_dir, \%run, $1, $2);
    }
    closedir $dir
}

sub clean_all_chroot_tmp {
    my ($chroot_dir, $prefix) = @_;
    print {$run{LOG}} "Cleaning old chroot remaining dir in $chroot_dir\n" if $run{verbose};
    my $dir;
    if (!opendir $dir, $chroot_dir) { 
	print "ERROR $program_name: could not open $chroot_dir ($!)";
	return
    }
    foreach (readdir $dir) {
	/$prefix.*$/ or next;
	clean_chroot_tmp($chroot_dir, $_);
    }
    closedir $dir
}

sub clean_mnt {
    my ($run, $mount_point, $verbose) = @_;
    return clean($run, $mount_point, "/sbin/fuser", "sudo /sbin/fuser -k", $verbose);
}

sub clean_unionfs {
    my ($unionfs_dir, $run, $r, $union_id) = @_;
    -d "$unionfs_dir/unionfs.$r.$union_id" or return $union_id;
    print {$run->{LOG}} "Cleaning $unionfs_dir/unionfs.$r.$union_id\n" if $run->{verbose} > 1;
    my $nok = 1;
    my $path = "$unionfs_dir/unionfs.$r.$union_id";
    while ($nok) {
	$nok = 0;
	foreach my $fs ([ 'proc', 'proc'],[ 'dev/pts', 'devpts']) {
	    my ($dir, $type) = @$fs;
	    if (-d "$path/$dir" && check_mounted("$path/$dir", $type)) {
		print {$run->{LOG}} "$program_name clean_unionfs: umounting $path/$dir\n" if $run->{verbose} > 2;
		if (system("sudo umount $path/$dir &>/dev/null")) { 
		    print {$run->{LOG}} "ERROR $program_name: could not umount $path/$dir\n";
		    return $union_id + 1
		}
	    }
	}
	foreach my $t ("unionfs",'tmpfs') {
	    # unfortunately quite oftem the unionfs is busy and could not be unmounted
	    my $d = "$unionfs_dir/$t.$r.$union_id";
	    my $last;
	    if (-d $d && check_mounted($d, $t)) {
		$nok = 1;
		system("sudo /sbin/fuser -k $d &> /dev/null");
		print {$run->{LOG}} "$program_name: umounting $d\n" if $run->{verbose} > 2;
		if (system(qq{sudo umount $d &> /dev/null})) {
		    print {$run->{LOG}} "WARNING $program_name: could not umount $d ($!)\n" if $run->{verbose} > 1;
		    return $union_id + 1;
		}
	    }
	}
    }
    foreach my $t ("unionfs",'tmpfs') {
	my $d = "$unionfs_dir/$t.$r.$union_id";
	print {$run->{LOG}} "$program_name: removing $d\n" if $run->{verbose} > 1;
	if (system(qq{sudo rm -rf $d})) {
	    print {$run->{LOG}} "ERROR $program_name: removing $d failed ($!)\n";
	    return $union_id + 1
	}
    }
    $union_id
}

sub clean_chroot_tmp {
    my ($chroot_dir, $dir) = @_;
    my $d = "$chroot_dir/$dir";
    foreach my $m ( 'proc', 'dev/pts') {
	if (system("sudo umount $d/$m &>/dev/null") && $run{verbose} > 1) { 
	    print {$run{LOG}} "ERROR $program_name: could not umount /$m in $d/\n" 
	}
    }
    print {$run{LOG}} "$program_name: cleaning $d\n" if $run{verbose};
    system("sudo /sbin/fuser -k $d &> /dev/null");
    print {$run{LOG}} "$program_name: removing $d\n" if $run{verbose};
    system(qq{sudo rm -rf $d});
}

sub check_mounted {
    my ($mount_point, $type) = @_;
    my $mount;
    if (!open $mount, '/proc/mounts') {
	print 'ERROR $program_name: could not open /proc/mounts';
	return
    }
    $mount_point =~ s,//+,/,g;
    while (<$mount>) {
	return 1 if /^\w+ $mount_point $type /
    }
    0
}

sub check_needed {
    my ($srpm, $cache, $provides) = @_;
    if (!defined $cache->{needed}{$srpm} && !ref $cache->{needed}{$srpm}) { return 1 } 
    my $ok = 1;
    # migrate old cache format
    my $ent = $cache->{needed}{$srpm};
    if (ref $ent eq 'ARRAY') {
	my $table = $ent;
	$cache->{needed}{$srpm} = {};
	foreach my $t (@$table) {
	    my ($missing, $version, $maint) = @$t;
	    $cache->{needed}{$srpm}{$missing} = {
		version => $version,
		maint => $maint
	    }
	}
	$ent = $cache->{needed}{$srpm}
    }
    foreach my $name (keys %$ent) {
	my ($package, $version, $maint) = @{$ent->{$name}}{'package', 'version','maint'};
	# if packages does not exist anymore, it may have been rebuild, then try to recompute the build dependencies
	last if $package && !$provides->{$package};
	my ($p_version) = $provides->{$name};
	if ($p_version) {
	    next if $version == $p_version;
	    next if URPM::ranges_overlap($version, $p_version)
	}
	$ok = 0;
	if ($version) {
	    $ent->{$name}{version} = $version;
	}
	my $v ||= $version;
	if ($package) {
	    print {$run{LOG}} "ERROR $program_name: $srpm needs package $package which requires missing $name $v to be compiled.\n";
	} else {
	    print {$run{LOG}} "ERROR $program_name: $srpm needs $name $v to be compiled.\n";
	} 
	# try to recompile it once in a while
	last if $cache->{warning}{"install_deps_$srpm"}{$maint}++ % 72;
	return 1
    }
    delete $cache->{needed}{$srpm} if $ok;
    $ok
}

sub process_queue {
    my ($config, $run, $wrong_rpm, $quiet) = @_;
    return if !$run->{upload} && $quiet;
    my $dir = "$config->{local_upload}/iurt/$run->{distro_tag}/$run->{my_arch}/$run->{media}/";
    opendir my $rpmdir, $dir or return;
    foreach my $rpm (readdir $rpmdir) {
	my ($rarch, $srpm) = update_srpm($dir, $rpm, $wrong_rpm);
	$rarch or next;
	print {$run{LOG}} "$program_name: $rpm\n";
	next if !$run->{upload};
	# recheck if the package has not been uploaded in the meantime
	my $rpms_dir = "$config->{repository}/$run->{distro}/$run->{my_arch}/media/$run->{media}/";
	if (! -f "$rpms_dir/$rpm") {
	    my $ok = copy "$dir/$rpm", "$config->{upload}/$config->{extra_subdir}/RPMS/";
	    # try to keep the opportunity to prevent disk full
	    if (!$ok){
		print {$run{LOG}} "ERROR process_queue: cannot copy $dir/$rpm to $config->{upload}/$config->{extra_subdir}/RPMS/ ($!)\n";
		next
	    }
	}
	if ($run->{upload_source}) {

	}
	unlink "$dir/$rpm";
	$cache->{queue}{$srpm} = 1
    }
    closedir $rpmdir;
}

sub update_srpm {
	my ($dir, $rpm, $wrong_rpm) = @_;
	my ($arch) = $rpm =~ /([^\.]+)\.rpm$/ or return 0;
	my $srpm = $cache->{rpm_srpm}{$rpm};
	if (!$srpm) {
		my $hdr = RPM4::Header->new("$dir/$rpm");
		$hdr or return 0;
		$srpm = $hdr->queryformat('%{SOURCERPM}');
		$cache->{rpm_srpm}{$rpm} = $srpm
	}
	$srpm = fix_srpm_name($srpm, $rpm, $wrong_rpm);
	$arch, $srpm
}

sub sendmail {
	my ($to, $cc, $subject, $text, $from, $debug) = @_;
	do { print "Cannot find sender-email-address [$to]\n"; return } unless defined($to);
	$from ||= $config->{packager};
	my $MAIL;
	if (!$debug) { open $MAIL,  "| /usr/sbin/sendmail -t" or return } else { open $MAIL,  ">&STDOUT" or return }
	my $sender = encode_mimewords($to);
	my $subject = encode_mimewords($subject);
	print $MAIL "To: $sender\n";
	if ($cc) { $cc = encode_mimewords($cc); print $MAIL "Cc: $cc\n" }
	print $MAIL "From: $from\n";
	print $MAIL "Subject: $subject\n";
	print $MAIL "\n";
	print $MAIL $text; 
	close($MAIL)
}

sub check_arch {
	my ($hdr) = @_;
	my (@exclusive_arch) = $hdr->queryformat('%{EXCLUSIVEARCH}');
	return if ! grep { $arch_comp{$run{my_arch}}{$_} || $_ eq '(none)' } @exclusive_arch;
	my (@exclude_arch) = $hdr->queryformat('%{EXCLUDEARCH}');
	return if grep { $_ eq $run{my_arch} } @exclude_arch;
	1
}

sub check_version {
	my ($srpm, $srpm_version) = @_;
	my ($srpm_name) = $srpm =~ /(.*)-[^-]+-[^-]+\.src\.rpm/;
	if (URPM::ranges_overlap("= $srpm",">= $srpm_version->{$srpm_name}")) {
		$srpm_version->{$srpm_name} = $srpm;
		return 1
	}
	0
}

sub fix_srpm_name {
	my ($srpm, $rpm, $wrong_rpm) = @_;
	my $old_srpm = $srpm;
	if ($srpm =~ s/^lib64/lib/){
		push @$wrong_rpm, [ $old_srpm, $rpm ];
		$cache->{rpm_srpm}{$rpm} = $srpm
	}
	$srpm
}

sub kill_for_good {
    my ($pid) = @_;
    use POSIX ":sys_wait_h";
    kill 14, $pid;
    sleep 1;
    waitpid(-1, WNOHANG);
    if (getpgrp $pid != -1) {
	kill 15, $pid;
	sleep 1;
	waitpid(-1, WNOHANG);
	if (getpgrp $pid  != -1) {
	    print STDERR "WARNING $program_name: have to kill -9 pid $pid\n";
	    kill 9, $pid;
	    sleep 1;
	    waitpid(-1, WNOHANG);
	}
    }
}

sub check_chroot {
    my ($chroot, $chroot_tar, $run, $opt) = @_;
    print {$run{LOG}} "$program_name: checking basesystem tar\n" if $run{verbose};
    my $urpmi = $run->{urpmi};
    $urpmi->clean_urpmi_process($chroot);
    if (!clean_chroot($chroot, $chroot_tar, $run, $config, 1)) {
	print {$run{LOG}} "ERROR $program_name: Could no prepare initial chroot";
	return
    }
    my (@stat) = stat $chroot_tar;
    if (time - $stat[9] > 604800) {
	print {$run{LOG}} "$program_name check_chroot: tar chroot is more than one week old, forcing the rebuild\n";
	system("sudo rm -rf $chroot_tar $chroot");
    }
    perform_command("sudo $config->{install_chroot_binary} $config->{basesystem_media_root} $config->{basesystem_media_root}/media/$config->{basesystem_media} $chroot_tar $chroot 501 basesystem tar rpm-build rpm-mandriva-setup-build", 
	$run, $config, $cache, 
	mail => $config->{admin},
	error => "[REBUILD] Creating the inital chroot for $run->{distro_tag} on $run->{my_arch} failed", 
	hash => 'chroot_inititialization', 
	timeout => 600, 
	debug_mail => $run->{debug},
	die => 1);
}

sub check_pid {
    my ($run) = @_;
    my $hostname = `hostname`;
    chomp $hostname;
    my $pidfile = $run->{pidfile};
    my $lockfile = "$run->{pidfile_home}/$pidfile.$hostname.pid.lock";
    print {$run->{LOG}} "$program_name: trying to lock $lockfile\n";
    open my $lock, ">$lockfile";
    my $lock_ok;
    # lockf seems not to work, try to workarround, but this start to create lock on the lock for the lock of the file.
    my $status = 1; #File::lockf::lock($lock);
    if (!$status) {
	$lock_ok = 1;
    } else {
	print {$run->{LOG}} "ERROR $program_name: could not lock pid file (status $status $!)\n";
	if (! -f "$lockfile.2") {
	    print {$run->{LOG}} "$program_name: using $lockfile.2 as lock file\n";
	    open my $lock2, ">$lockfile.2" or die "FATAL $program_name: could not open lock file $lockfile.2";
	    print $lock2 $$;
	    close $lock2;
	}
    }
    if (!$run->{concurrent_run}) {
	opendir my $dir, $run->{pidfile_home};
	foreach my $f (readdir $dir) {
	    my ($pid_host) = $f =~ /$pidfile\.pid\.(.*)\.pid$/ or next; 
	    if ($pid_host ne $hostname) {
		my $pf = "$run->{pidfile_home}/$f";
		open my $test_PID, $pf;
		my $pid = <$test_PID>;
		my (@stat) = stat $pf;
		my $time = $stat[9];
		my $diff = time - $time;
		my $msg = "$program_name: an other iurt is running for $run->{my_arch} on $pid_host, pid $pid, since $diff seconds";
		if ($diff < 36000) {
		    print {$run->{LOG}} "$msg\n";
		    exit
		} else {
		    print {$run->{LOG}} "$msg, ignoring it\n"
		}
	    }
	}
	$run->{pidfile} .= ".pid";
    }
    $run->{pidfile} .= ".$hostname.pid";
    $pidfile = "$run->{pidfile_home}/$run->{pidfile}";
    if (-f $pidfile)  {
	my (@stat) = stat $pidfile;
	open my $test_PID, $pidfile;
	my $pid = <$test_PID>;
	close $test_PID;
	if (!$pid) {
	    print {$run->{LOG}} "ERROR $program_name: invalid pidfile ($pid), should be <pid>";
	    unlink $pidfile
	}
	if ($pid && getpgrp $pid != -1) {
	    my $time = $stat[9];
	    my $state = `ps h -o state $pid`;
	    chomp $state;
	    if ($time < time - 36000 || $state eq 'Z') {
		print {$run->{LOG}} "$program_name: an other iurt pid $pid is running for a very long time or is zombie, killing it\n";
		my $i;
		while ($i < 5 && getpgrp $pid != -1) {
		    kill_for_good($pid);
		    $i++;
		    sleep 1
		}
	    } else  {
		print {$run->{LOG}} "$program_name: an other iurt is running for $run->{my_arch}, pid $pid, since ",time - $time," seconds\n";
		exit
	    }
	} else {
	    print {$run->{LOG}} "$program_name: a previous iurt for $run->{my_arch} seems dead, cleaning.\n";
	    unlink $pidfile
	}
    }
    print {$run->{LOG}} "$program_name: setting $pidfile pid lock\n";
    open my $PID, ">$pidfile" or die "FATAL $program_name: could not open pidfile $pidfile for writing";
    print $PID $$;
    close $PID;
    if ($lock_ok) { 
	File::lockf::ulock($lock);
    } else {
	unlink "$lockfile.2"
    }
    close $lock;
    unlink $lockfile
}

sub check_media {
    my ($run, $cache, $config, $srpm_version, $wrong_rpm, $provides, $pack_provide, $maint) = @_;
# We could rely on only parsing the synthesis, hoping that they are correct, however this scan is very fast, so...
    foreach my $subdir (@{$config->{all_media}{$run->{media}}}) {
	my $rpms_dir = "$config->{repository}/$run->{distro}/$run->{my_arch}/media/$run->{media}/$subdir/";
	print {$run->{LOG}} "$program_name: checking current packages in $rpms_dir\n";
	opendir my $rpmdir, $rpms_dir or die "Could not open $rpms_dir: $!"; 
	foreach my $rpm (readdir $rpmdir) {
	    my ($rarch, $srpm) = update_srpm($rpms_dir, $rpm, $wrong_rpm);
	    $rarch or next;
	    $cache->{queue}{$srpm} = 1;
	    $run{status}{$srpm} = 'ok';
	    check_version($srpm, $srpm_version)
	}
	closedir $rpmdir;
    }

    foreach my $m (keys %{$config->{all_media}}) {
	foreach my $subdir (@{$config->{all_media}{$m}}) {
	    my $synthesis_file = "$config->{repository}/$run->{distro}/$run->{my_arch}/media/$m/$subdir/media_info/synthesis.hdlist.cz";
	    if (-f $synthesis_file) {
		print {$run->{LOG}} "Parsing $synthesis_file\n";
		if (open my $syn, "zcat $synthesis_file |") { 
		    my @prov;
		    my $nb;
		    while (<$syn>) {
			if (/^\@provides@(.*)/) {
			    foreach my $p (split '@', $1) {
				$p =~ /([^[]+)(?:\[(.*)\])?/g;
				push @prov, $1;
				$provides->{$1} = $2 || 1
			    }
			} elsif (/\@info\@([^@]+)@/) {
			    $nb++;
			    my $p = $1;
			    my ($name) = $p =~ /(.*)-[^-]+-[^-]+\..*$/;
			    $provides->{$p} = 1;
			    foreach (@prov) {
				$pack_provide->{$_} = $name
			    }
			    @prov = ()
			}
		    }
		    $nb < $config->{minimum_package_number} and die "FATAL $program_name: synthesis files seems corrupted, only $nb packages found."
		} else {
		    die "FATAL $program_name: Could not open $synthesis_file\n";
		}
	    }
	}
    }
    #"
    my $nb;
    foreach my $subdir (@{$config->{all_media}{$run->{media}}}) {
	$nb += search_packages(0, $cache, $provides, $run, $maint, $srpm_version, "$config->{repository}/$run->{distro}/SRPMS/$run->{media}/$subdir/")
    }
    $nb
}

sub search_packages {
    my ($clean, $cache, $provides, $run, $maint, $srpm_version, @dir) = @_;
    my ($to_compile, %rep, %done_rpm);
    print {$run->{LOG}} "iurt search_package: @dir\n";
    foreach my $dir (@dir) {
	print {$run->{LOG}} "$program_name: checking SRPMS dir $dir\n";
	opendir my $rpmdir, $dir or next;
	foreach my $srpm (readdir $rpmdir) {
	    # this is for the output of the new svn system
	    if ($srpm =~ /^\@\d+:(.*)/) {
		link "$dir/$srpm", "$dir/$1";
		# unlink "$dir/$srpm";
		$srpm = $1
	    }
	    $srpm =~ /(.*)-[^-]+-[^-]+\.src\.rpm$/ or next;
	    $run->{status}{$srpm} ||= 0;
	    if ($config->{unwanted_packages} && $srpm =~ /$config->{unwanted_packages}/) { next }
	    my $ok = 1;
	    if (check_version($srpm, $srpm_version)) { 
		if (!$run->{ignore_failure} && defined $cache->{failure}{$srpm}) {
		    $run->{status}{$srpm} = 'build_failure';
		    next
		}
		my $check_needed = check_needed($srpm, $cache, $provides);
		$run->{status}{$srpm} = 'missing_buildrequires' if !$check_needed;
		if (!$cache->{queue}{$srpm} && $check_needed) {
		    my $hdr = RPM4::Header->new("$dir/$srpm");
		    if (!check_arch($hdr)) {
			$run->{status}{$srpm} = 'not_on_this_arch';
			next
		    }
		    my $changelog = $hdr->queryformat("%{CHANGELOGNAME}");
		    my ($mail) = $changelog =~ /<(.*@.*)>/;
		    $maint{$srpm} = $mail;
		    print "$program_name: will try to compile $srpm\n";
		    $to_compile++;
		    push @{$run->{todo}}, [ $dir , $srpm, 1 ]
		}
		foreach my $arch (@{$config->{supported_arch}}) {
		    $ok &&= $cache->{queue}{$srpm}
		}
	    }
	    if ($clean && ($rep{$srpm} || $ok)) {
		print "$program_name: cleaning $dir/$srpm\n";
		unlink "$dir/build/$srpm";
		unlink "$dir/$srpm"
	    }
	    $rep{$srpm} = 1
	}
	closedir $rpmdir
    }
    $to_compile
}    

sub add_sudoers {
    my ($run, $chroot, $user) = @_;
    my $file = "$chroot/etc/sudoers";
    my $f;
    if (!open $f, qq{| sudo sh -c "cat > $file"}) {
	print {$run->{LOG}} "ERROR $program_name: could not open $file ($!)\n";
	return 0
    }
    print $f qq{Cmnd_Alias RPM=/bin/rpm,/usr/sbin/urpmi,/usr/sbin/urpme,/usr/sbin/urpmi.addmedia,/usr/sbin/urpmi.update,/usr/sbin/urpmi.removemedia
root    ALL=(ALL) ALL
$user   ALL=(ALL) NOPASSWD:RPM
};
    close $f;
    print {$run->{LOG}} "$program_name: adding sudo for /bin/rpm, /usr/sbin/urpmi and /usr/sbin/urpme\n";
    -f $file or return 0;
    1
}



sub recreate_srpm {
    my ($run, $config, $chroot_tmp, $dir, $srpm, $luser, $retry) = @_;
# recreate a new srpm for buildarch condition in the spec file
    print {$run->{LOG}} "$program_name: copying $srpm to $chroot_tmp\n" if $run->{verbose} > 1;
    perform_command("sudo cp $dir/$srpm $chroot_tmp/home/$luser/rpm/SRPMS/", 
	\%run, $config, $cache, 
	mail => $config->{admin}, 
	error => "[REBUILD] cannot copy $srpm to $chroot_tmp", 
	debug_mail => $run->{debug},
	hash => "copy_$srpm") or return;

    my %opt = ( mail => $config->{admin}, 
	error => "[REBUILD] cannot install $srpm in $chroot_tmp", 
	debug_mail => $run->{debug},
	hash => "install_$srpm",
	retry => $retry,
	callback => sub { 
	    my ($opt, $output) = @_;
	    print {$run->{LOG}} "calling callback for $opt->{hash}\n" if $run->{debug};
	    if ($output =~ /warning: (group|user) .* does not exist - using root|Header V3 DSA signature/i) {
		return 1
	    } elsif ($output =~ /user $luser does not exist|cannot write to \%sourcedir/) {
		print {$run->{LOG}} "WARNING $program_name: chroot seems corrupted...\n" if $run->{verbose} > 1;
		$opt->{error} = "[CHROOT] chroot is corrupted";
		$opt->{retry} = 1 if !$opt->{retry};
		return 
	    }
	    1
	});
    print {$run->{LOG}} "$program_name: recreating src.rpm...\n" if $run->{verbose};
    if (!perform_command(qq{sudo chroot $chroot_tmp su $luser -c "rpm -i /home/$luser/rpm/SRPMS/$srpm"}, 
	    \%run, $config, $cache, %opt)) {
	print {$run->{LOG}} "ERROR $program_name: chrooting failed (retry $opt{retry}\n" if $run->{debug};
	if ($opt{retry}) {
	    check_chroot($run->{chroot_path}, $run->{chroot_tar}, \%run) or return;
	    return -1
	}
	return
    }
    # 20060515 This should not be necessairy any more if urpmi *.spec works, but it doesn't
    #
    perform_command(qq{sudo chroot $chroot_tmp su $luser -c "rpm --nodeps -bs /home/$luser/rpm/SPECS/*.spec"}, 
	\%run, $config, $cache, 
	mail => $config->{admin}, 
	error => "[REBUILD] cannot create $srpm in $chroot_tmp", 
	debug_mail => $run->{debug},
	hash => "create_$srpm")
}

sub dump_status {
    my ($local_spool, $run) = @_;
    my $media = $run->{media} ? "$run->{media}." : "";
    if (open my $file, ">$local_spool/log/status.${media}log") {
	foreach my $srpm (sort keys %{$run->{status}}) {
	    print $file "$srpm: ";
	    if ($run{status}->{$srpm}) {
		print $file $run->{status}{$srpm}
	    } else {
		print $file "unknown"
	    }
	    print $file "\n"
	}
	close $file
    }
}

sub send_status_mail {
    my ($run, $config, $cache) = @_;
    print "iurt compilation status\n";
    my %output;
    foreach my $rpm (keys %{$run->{status}}) {
	next if $run->{status}{$rpm} =~ /ok|not_on_this_arch/;
	if ($run->{status}{$rpm} eq 'missing_buildrequires') {
	    foreach my $missing (keys %{$cache->{needed}{$rpm}}) {
		my $h = $cache->{needed}{$rpm}{$missing};
		my $maint = $h->{maint} || 'Other';
		my $package = $h->{package};
		if ($package) {
		    push @{$output{missing}{$maint}{$package}{$missing}{$h->{version}}}, $rpm
		} else {
		    $output{missing}{$maint}{$rpm}{$missing}{$h->{version}} = 1
		}
	    }
        } elsif ($run->{status}{$rpm} eq 'build_failure') {
	    my ($maint) = get_maint($run, $rpm);
	    if ($cache->{buildrequires}{$rpm}) {
		push @{$output{buildrequires}{$maint}}, $rpm
	    } else {
		push @{$output{build}{$maint}}, $rpm
	    }
	} elsif (!$run->{status}{$rpm}) {
	    # need to find something more usefull to do at that point
	    next
	}
    }
    my $text = "*** Missing buildrequires tag in specfile ***\n";
    foreach my $maint (keys %{$output{buildrequires}}) {
	$text .= "\n$maint\n";
	foreach my $pack (keys %{$output{missing}{$maint}}) {
	    foreach my $missing (keys %{$cache->{buildrequires}{$pack}}) {
		my $rpms = $cache->{buildrequires}{$pack}{$missing};
		if (@$rpms) {
		    $text .= "  $pack should have a buildrequires on @$rpms (for $missing-devel)\n"
		} else {
		    $text .= "  $pack should have a buildrequires for $missing-devel\n"
		}
	    }
	}
    }

    my $text = "*** Missing dependencies ***\n";
    foreach my $maint (keys %{$output{missing}}) {
	$text .= "\n$maint\n";
	foreach my $pack (keys %{$output{missing}{$maint}}) {
	    foreach my $missing (%{$output{missing}{$maint}{$pack}}) {
		my $h = $output{missing}{$maint}{$pack}{$missing};
		foreach my $version (keys %$h) {
		    if (ref $h->{$version}) {
			$text .= "  $pack should be recompile because\n  $missing ". ($version ? "$version " : ''). "is not provided anymore\n";
			$text .= "    to compile ". join("\n               ", @{$h->{$version}}). "\n"
		    } else {
			$text .= "  $pack needs $missing ". ($version ? "$version " : ''). "\n";
		    }
		}
	    }
	}
    }
    $text .=  "\n*** Build failure ***\n";
    foreach my $maint (keys %{$output{build}}) {
	$text .= "\n$maint\n";
	foreach my $rpm (@{$output{build}{$maint}}) {
	    $text .= "  $rpm (see $config->{log_url}/$run{distro_tag}/$run{my_arch}/$run->{media}/log/$rpm/)\n"
	}
    }
    print "$text\n";
    sendmail($run->{status_mail}, '' , "Iurt report for $run->{my_arch}/$run->{media}", "$text", 0, 0, 0)
}

sub get_maint {
    my ($run, $srpm) = @_;
    my ($srpm_name) = $srpm =~ /(.*)-[^-]+-[^-]+\.[^.]+$/;
    $srpm_name ||= $srpm;
    if ($run{maint}{$srpm}) {
	return $run{maint}{$srpm}, $srpm_name
    }
    my $maint = `rpmmon -s -p "$srpm_name"`;
    chomp $maint;
    $run{maint}{$srpm} = $maint;
    $maint, $srpm_name
}

sub find_provides {
    my ($run, $pack_provide, $p) = @_;
    my @rpm;
    foreach my $provides (keys %{pack_provide}) {
	if ($provides =~ /$p/ && $provides =~ /devel/) {
	    push @rpm, $pack_provide->{$provides};
	}
    }
    @rpm
}