#!/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)
# - Change the packager tag in the chroot to have the one who submit the package
# - use containers

use strict;
use RPM4::Header;
use Iurt::Config qw(config_usage get_date get_prefix config_init get_maint %arch_comp get_package_prefix);
use Data::Dumper;
use URPM;

use Iurt::Urpmi;
use Iurt::Chroot qw(add_local_user create_temp_chroot remove_chroot create_build_chroot clean_chroot);
use Iurt::Process qw(perform_command kill_for_good sudo);
use Iurt::Mail qw(sendmail);
use Iurt::RPM qw(check_arch check_noarch);
use Iurt::Util qw(plog_init plog);
use File::NCopy qw(copy);
use File::Path qw(mkpath);
use File::Spec::Functions qw(rel2abs);
use File::Basename qw(fileparse);
# I did not manage to make locks work over the network
#use File::lockf;
use Fcntl qw(:flock SEEK_END);
use Mkcd::Commandline qw(parseCommandLine usage);
use MDK::Common;
use Filesys::Df qw(df);
use POSIX;
use urpm;

# copied from drakx' standalone:
sub bug_handler {
    my ($error, $is_signal) = @_;

    # exceptions in eval are OK:
    return if $error && $^S && !$is_signal;

    # we want the full backtrace:
    $error .= "\n" if $is_signal;
    $error .= backtrace() if $error;

    warn "We got an uncatched exception:\n$error\n";
    #exit(1);
}

my ($chroot_name, $chroot_tmp, $chroot, $chroot_ref);

$SIG{SEGV} = sub { bug_handler(@_, 1) };
#$SIG{__DIE__} = \&bug_handler;
my $program_name = 'iurt';

# sessing parameters
my $sudo = '/usr/bin/sudo';
my $arg = @ARGV;
my (@params, %run);
$run{program_name} = $program_name;
	
$run{todo} = [];
@params = ( 
    #    [ "one letter option", "long name option", "number of args (-X means ´at least X´)", "help text", "function to call", "log info"]
    #
    # config_help and copy_srpm kept for compatibility reasons
    #
    [ "", $program_name, 0, "[--chrooted-urpmi <media prefix>] [--config foo value] [--warn] [--verbose integer]
            [--copy-srpm] [--debug] [--distro] [--clean user1 user2 user3] [--clean-all] [--shell] [--stop {p|c|i|l|b|a|s}]
 	    [--use-system-distrib] [--dir] [--help foo?] [--log filename] [--group]
	    [--dir] [--help foo?] [--log filename] [--status]
	    [--repository <distribution path>]
	    [--rpmmacros <macro definition> [<macro definition>...]]
	    {--config-help}
	    --chroot --arch {i586|x86_64|ppc} --distro {cauldron|...} |
	    --build-user <user> --rebuild {cauldron|...} {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.

		e.g.: iurt --repository /dis/ -p foo\@foo.net -r cauldron x86_64  /SRPMS/main/release/mkcd-4.2.5-1mdv2007.1.src.rpm", 
    sub { $arg or usage($program_name, \@params) }, "" ],
    [ "", "distro", 1, "<distro>", 
    "Set the distribution",
    sub { ($run{distro}) = @_; 1 }, "Setting the distribution" ],
    [ "a", "arch", 1, "<architecture>", 
    "Set the architecture",
    sub { ($run{my_arch}) = @_; 1 }, "Setting architecture" ],
    [ "", "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", [
        [ "", "chrooted-urpmi", 1, "",
	"Create urpmi media inside the chroot instead of using --root (media prefix is like http:///server.mandriva.com/dis/)",
	sub {
            my ($tmp, @arg) = @_; 
            $tmp->[0] ||= {}; 
            push @$tmp, @arg; 
            1;
	}, "Setting chrooted-urpmi options" ],
        ["m", "media", -1, "<media1> <media2> ... <median>",  
        "Media to add instead of --distrib",  
        sub { my ($tmp, @media) = @_; $tmp->[0]{media} = \@media; 1 }, "Limiting rebuild to the kernel in the given media regexp"], 
    ] , "[options] <media prefix>", 
    "Create urpmi media inside the chroot instead of using --root (media prefix is like http:///server.mandriva.com/dis/)",
    sub { my ($opt, $_media) = @_; $run{chrooted_urpmi} = $opt; 1 }, "Activating chroot media" ],
    [ "", "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" ],
    [ "", "parallel", 1, "<n>",
    "Build up to <n> packages in parallel",
    sub { ($run{parallel}) = @_; 1 }, "Enabling parallel build" ],
    [ "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" ],
    [ "l", "log", 1, "<log file>", 
    "Log file.", 
    sub { 
	$run{log} = pop @_; 
	open my $log, ">$run{log}" or die "unable to open $run{log}\n";
	$run{logfd} = $log;
	print *$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" ],
    [ "", "build-all", 0, "",
    "Build all packages of the media, even if they are up to date",
    sub { $run{build_all} = 1 }, "Setting the full build flag" ],
    [ "", "num_shards", 1, "<n>",
    "Number of shards for building",
    sub { ($run{num_shards}) = @_; 1 }, 'Setting number of shards' ],
    [ "", "shard_id", 1, "<n>",
    "Shard id (starts at 0)",
    sub { ($run{shard_id}) = @_; 1 }, 'Setting shard id' ],
    [ "", "resume", 0, "",
    "Only build packages not yet done during previous build-all run",
    sub { $run{resume} = 1 }, "Setting the resume flag" ],
    [ "", "fixed_media", 0, "",
    "Assume media do not change between build (useful for full rebuild of a snapshot of the distro)",
    sub { $run{fixed_media} = 1 }, "Setting the fixed_media flag" ],
    [ "n", "no", 0, "", 
    "Perform all the check but do not compile anything", 
    sub { ($run{no_compile}) = 1 }, "Setting the no compilation flag" ],
    [ "p", "packager", 1, "<packager>", 
    "Use a specific packager",
    sub { ($run{packager}) = @_ }, 'Setting packager tag' ],
    [ "", "build-user", 1, "<user>", 
    "Use this username to build package",
    sub { ($run{user}) = @_ }, 'Setting build username' ],
    [ "r", "rebuild", -2, "<distro> <architecture> <srpm 1> <srpm 2> ... <srpm n>", 
    "Rebuild the packages, e.g. $program_name -r cauldron x86_64 /home/foo/rpmbuild/SRPMS/foo-2.3-12mdv2007.0.src.rpm", 
    sub { 
	$run{rebuild} = 1; 
	$run{distro} = shift @_;
       	$run{my_arch} = shift @_;

	foreach (@_) {
	    my ($path, $srpm);

	    unless (-f $_ && -r $_) {
		die "FATAL $program_name: $_ not a file or cannot be read\n";
	    }

	    ($srpm, $path) = fileparse(rel2abs($_));
	    $srpm =~ /\.src\.rpm$/ or die "FATAL: $_ doesn't look like an SRPM";

	    if (check_arch($_, $run{my_arch})) {
		plog('DEBUG', "force build for $2 (from $1)");
		push @{$run{todo}}, [ $path, $srpm, 1 ];
	    } else {
		plog("ERROR: $_ could not be build on $run{my_arch}, ignored.");
	    }
	}
	1;
	}, "Activating rebuild mode" ],
    [ "", "rpmmacros", -1, "<macro definition 1> .. <macro definition n>", 
    "Additional rpm macros to define",
    sub { $run{rpmmacros} = \@_ }, 'Setting rpm macros' ],
    [ "", "use-old-chroot", 1, "<chroot path>", 
    "Use the given chroot as chroot (usefull for debugging)", 
    sub { ($run{use_old_chroot}) = @_ }, "Using given chroot" ],
    [ "", "no_rsync", 0, "",
    "Do not send build log to the distant rsync server",
    sub { $run{no_rsync} = 1 }, "Setting the no rsync flag" ],
    [ "", "delete-on-success", 0, "",
    "Don't keep generated packages and their logs",
    sub { $run{delete_on_success} = 1 }, "Setting the delete on success flag" ],
    [ "", "discard-packages", 0, "",
    "Don't save built packages, only keep the logs",
    sub { $run{discard_packages} = 1 }, "Setting the discard packages flag" ],
    [ "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 rpmbuild -b<rpm step> (p c i l b a s) instead of rpmbuild -ba and then open a shell in the chroot", 
    sub { 
	($run{stop}) = @_; 
	1;
    }, "Setting rpm build option" ],
    [ "", "repository", 1, "<distribution root path>",
    "Set a repository path if one is not created in the configuration file",
    sub {
	($run{repository}) = @_;
	1;
    } , "Setting the repository" ],
    [ "", "with", 1, "<flag>",
    "Use specified --with flag with rpm (can be used multiple times)",
    sub {
	$run{with_flags} .= " --with " . $_[0];
	1;
    }, "Adding specified extra --with parameter to rpm" ],
    [ "", "without", 1, "<flag>",
    "Use specified --without flag with rpm (can be used multiple times)",
    sub {
	$run{with_flags} .= " --without " . $_[0];
	1;
    }, "Adding specified extra --without parameter to rpm" ],
    # [ short option, long option, # of args, syntax description,
    #      action description, action, execution message ] 
    #############################
    [ "", "additional-media",
	[
	    [ "", "additional-media", 1, "",
		"Use additional medias (media prefix is like http:///server.mandriva.com/dis/)",
		sub {
		    my ($tmp, @arg) = @_; 
		    $tmp->[0] ||= {}; 
		    push @$tmp, @arg; 
		    1;
		}, "Setting additional medias options"
	    ],
	    [ "m", "media", -1, "<media1> <media2> ... <median>",
		"Media to add instead of --distrib",
		sub {
		    my ($tmp, @media) = @_;
		    $tmp->[0]{media} = \@media;
		    1;
		}, "Limiting rebuild to the kernel in the given media regexp"
	    ],
        ],
	"[options] <media prefix>", 
	"Also uses these medias (media prefix is like http:///server.mandriva.com/dis/)",
	sub {
	    my ($opt, $media) = @_;
	    $opt->{repository} = $media;
	    $run{additional_media} = $opt;
	    1;
	}, "Activating additional medias"
    ],
    ###############################
    [ "", "icecream", 1, "<procs>", 
    "Enables icecream usage by <procs> procs",
    sub {
	    $run{icecream} = $_[0];
    }, "Enabling icecream usage" ],
    ###############################
    [ "", "storage", 1, "[btrfs|tar]", 
    "Select how to store reference chroot",
    sub {
	    $run{storage} = $_[0];
    }, "Setting storage" ],
);

open(my $LOG, ">&STDERR");

plog_init($program_name, $run{logfd} || $LOG, 7, 1); # For parsing command line

# Display version information
#
my $version = '0.9.0';
plog("MSG", "This is iurt version $version");

my $todo = parseCommandLine($program_name, \@ARGV, \@params);
@ARGV and usage($program_name, \@params, "@ARGV, too many arguments");
foreach my $t (@$todo)  {
    plog('DEBUG', $t->[2]);
    &{$t->[0]}(@{$t->[1]}) or plog('ERROR', $t->[2]);
}

# Use the real verbose level
plog_init($program_name, $run{logfd} || $LOG, $run{verbose}, 1);

$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";
my $sysconfigfile = "/etc/iurt/build/$run{distro_tag}.conf";

my $config = {};
foreach my $f ($configfile, $sysconfigfile) {
    plog('DEBUG', "load config: $f");
    if (-f $f) {
        $config = eval(cat_($f))
          or die "FATAL $program_name: syntax error in $f";
        last;
    }
}

if ($run{repository}) {
    plog('DEBUG', "overriding configuration repository by the one given in the command line");
    $config->{repository} = $run{repository};
}

my %config_usage = ( 
    admin => {
	desc => 'Mail of the administrator of packages builds',
	default => ''
    },
    all_media => {
	desc => 'List of known media',
	default => {
	    'main' => [ 'release' ],
	    'contrib' => [ 'release' ]
	}
    },
    base_media => {
	desc => 'List of base media used to build chroot',
	default => [ 'core/release' ],
    },
    basesystem_packages => {
	desc => 'List of packages needed for the chroot creation',
	default => [
	    'basesystem-minimal',
	    'makedev',
	    'rpm-build',
	    'sudo',
	    'urpmi',
	    'curl',
	]
    },
    build_timeout => {
	desc => 'Maximum build time after which the build process is terminated (in seconds)',
	default => {
	    default => 18000,
	},
    },
    build_stalled_timeout => {
	desc => 'Maximum build time after which the build process is terminated if it seems stalled',
	default => {
	    default => 300,
	},
    },
    pidfile_home => {
	desc => 'Where to store the pidfile files',
	default => "$HOME/.bugs"
    },
    check_binary_file => {
	desc => 'Packages rebuild should be checked, however sometime rpm is segfaulting and the test is not correct',
	default => 0
    },
    chroot_base => {
	desc => 'Where to store chroots',
	default => $HOME
    },
    chroot_tar_suffix => {
	desc => 'Suffix for the chroot tarball, must be supported by tar',
	default => '.gz'
    },
    iurt_root_command => {
	desc => 'Program to run sudo command',
	default => '/usr/sbin/iurt_root_command'
    },
    distribution => {
	desc => 'Name of the packages distribution',
	default => 'Mageia'
    },
    email_domain => {
	desc => 'Domain to append to usernames when sending emails',
	default => 'mageia.org'
    },
    env => {
	desc => 'Environment variables to export',
	default => { PERL_EXTUTILS_AUTOINSTALL => "--skipdeps", PERL_AUTOINSTALL => "--skipdeps" }
    },
    home => {
	desc => 'Home dir',
	default => $HOME
    },
    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 => ''
    },
    max_command_retry => {
	desc => 'Maximum number of retry Iurt will perform for a given command',
	default => 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'
    },
    prompt => { 
	desc => 'Default prompt in the chroot',
	default => qq(PS1='[\\[\\033[00;33m\\]iurt $run{distro}\\[\\033[00m\\]] \\[\\033[00;31m\\]\\u\\[\\033[00;32m\\]\\h\\[\\033[00m\\]\\w\$ '),
    },
    repository => {
	desc => 'Prefix of the repositories',
	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']
    },
    vendor => {
	desc => 'Name of the packages vendor',
	default => 'Mageia.Org'
    },
    additional_media => {
	desc => 'Additional medias to be used',
	default => []
    },
    icecream => {
	desc => 'Enabled icecream usage and uses N procs',
	default => 0
    },
    use_netns => {
	desc => 'Create a separate network namespace for each chroot to prevent builds from accessing the network',
	default => { default => 1 }
    },
);

if ($run{config_usage}) {
    config_usage(\%config_usage, $config);
    exit();
}

if (!$config->{repository}) {
    die "FATAL $program_name: no repository have been defined (use --repository to specify one on the command line";
}

$SIG{TERM} = sub {
    warn "Got KILLED by SIGTERM at " . strftime("%c", localtime()) . " .\n";
    if (!$run{use_old_chroot} && $chroot_tmp) {
	print "Cleaning up before dying.\n";
	clean_chroot($chroot_tmp, \%run, $config);
    }
    exit(1);
};

my $urpmi = Iurt::Urpmi->new(run => \%run, config => $config, urpmi_options => "-v --no-verify-rpm --tune-rpm=all --nolock --auto --no-recommends --ignoresize $config->{urpmi_options}");
$run{urpmi} = $urpmi;

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

$run{my_arch} or usage($program_name, \@params, "no architecture given (media $run{media}, run{my_arch} $run{my_arch}, todo", join(', ', @{$run{todo}}));
if ($run{my_arch} ne $real_arch && !$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);

if ($config->{env}) {
    foreach my $var (keys %{$config->{env}}) {
	plog('DEBUG', "Setting $var to $config->{env}{$var}");
	$ENV{$var} = $config->{env}{$var};
    }
}

if ($run{icecream}) {
    push @{$config->{basesystem_packages}}, 'icecream';
}

my $lock = $run{media};
if (!$lock && $run{chroot}) {
    $lock = 'chroot';
}
$run{lock} = $lock;

if (!$run{debug} && $run{media} || $run{chroot}) {
    $run{pidfile_home} = $config->{pidfile_home};
    mkpath $run{pidfile_home};
    $run{pidfile} = "iurt.$run{distro_tag}.$run{my_arch}.$lock";
    check_pid(\%run);
}

$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}/";
}

# Squash double slashes
$local_spool =~ s!/+!/!g;
#/

plog('INFO', "local spool: $local_spool");
if (!-d "$local_spool/log") {
    plog('DEBUG', "creating local spool $local_spool");
    mkpath("$local_spool/log")
	or die "FATAL: could not create local spool dir $local_spool ($!)";
}
$run{local_spool} = $local_spool;

if ($run{resume}) {
    load_status($local_spool, \%run);
} else {
    empty_status($local_spool, \%run);
}

my (%srpm_version, %provides, $to_compile, %maint);
$to_compile = @{$run{todo}};
$to_compile += check_media(\%run, $config, \%srpm_version,
	\%provides, \%maint) if $run{media};
$to_compile += search_packages(\%run, \%maint,
	\%srpm_version, @{$run{extra_dir}}) if $run{extra};

$run{to_compile} = $to_compile;

plog("Packages to build: $to_compile");

my ($fulldate, $daydate) = get_date();
$run{run} = "0.$fulldate";
$run{daydate} = $daydate;
plog('DEBUG', "using $run{run} as chroot extension");
$run{user} ||= $ENV{USER};
die "Iurt should not be executed as root.\n" if $run{user} eq "root";
$run{uid} = getpwnam $run{user};

plog('DEBUG', "using local user $run{user}, id $run{uid}");
my $luser = $run{user} || 'builder';

check_sudo_access()
    or die "FATAL: you need to have sudo access on $config->{iurt_root_command} to run $program_name\n";

my $debug_tag = $run{debug} && '_debug';
$run{debug_tag} = $debug_tag;

my (%done, $done);
$run{done} = \%done;
my $home = $config->{local_home};

my $chroot_base = $config->{chroot_base};
$chroot_name = "chroot_$run{distro_tag}$debug_tag.$run{my_arch}";
if (!$run{use_old_chroot}) {
    $chroot_tmp = "$chroot_base/chroot_tmp";

    if (!-d $chroot_tmp) {
	mkdir $chroot_tmp;
    } else {
	remove_chroot(\%run, $config, $chroot_tmp, $chroot_name);
    }

    mkdir_p("$chroot_tmp/$run{user}");
    $chroot_tmp = "$chroot_tmp/$run{user}/$chroot_name.$run{run}";
    $run{chroot_tmp} = $chroot_tmp;

    $chroot = "$config->{local_home}/$chroot_name";
} else {
    plog(1, "using given chroot $run{use_old_chroot}");
    $chroot_tmp = $run{use_old_chroot};
    $chroot = $run{use_old_chroot};
}
$run{chroot_path} = $chroot;
if ($run{storage} eq 'btrfs') {
    $chroot_ref = "$chroot_base/$chroot_name";
} else {
    $chroot_ref = "$chroot_base/$chroot_name.tar$run{chroot_tar_suffix}";
}
$run{chroot_ref} = $chroot_ref;
# 20061222 warly 
# even in use_old_chroot mode we create the chroot if it does not exist (useful 
# if the option is used for the first time
if ($run{chroot} || !-d "$chroot/dev") {
    create_build_chroot($chroot, $chroot_ref, \%run, $config) or die "FATAL $program_name: could not prepare initial chroot";
}

# 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}) {
    plog("no package to compile :(");
    unlink "$run{pidfile_home}/$run{pidfile}" if $run{pidfile};
    exit();
}

plog('DEBUG', "running with pid $$");
$run{prefix} = get_prefix($luser); 

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

if ($run{shell}) {
    if (!$run{use_old_chroot}) {
	create_temp_chroot(\%run, $config, $chroot_tmp, $chroot_ref)
	    or die "FATAL $program_name: could not create temporary chroot";
    }
    add_local_user($chroot_tmp, $config, $luser, $run{uid}) or die "FATAL $program_name: could not add local user";

    #$urpmi->set_command($chroot_tmp);
    $urpmi->urpmi_command($chroot_tmp);

    $urpmi->install_packages('chroot', $chroot_tmp, $local_spool, 'configure', "[ADMIN] installation of urpmi and sudo failed in the chroot $run{my_arch}", { check => 1, maintainer => $config->{admin} }, 'urpmi', 'sudo') or die "FATAL $program_name: could not add urpmi and sudo in the chroot";
    add_sudoers($chroot_tmp, $luser);

    plog('NOTIFY', "dumping to a chrooted shell into $chroot_tmp");
    exec $sudo, $config->{iurt_root_command}, '--chroot', $chroot_tmp, '/bin/su', '-', $luser, '-c', "$config->{prompt} bash";
    die "FATAL $program_name: could not exec chroot to $chroot_tmp ($!)";
}

# If not using --shell or --stop, we don't want an interactive build
if (!$run{stop}) {
    close STDIN;
}

# The next loop should be moved in a module someday

# FIXME: (tv) kill this dead code or use it!!
my $_s = sub { 
    if ($run{main}) {
	$Data::Dumper::Indent = 0;
	$Data::Dumper::Terse = 1;
	plog("Running environment:\n", Data::Dumper->Dump([\%run]), "\n");
	plog("Configuration:\n", Data::Dumper->Dump([$config]), "\n");
    }
    exit();
};
#$SIG{TERM} = $s;
#$SIG{INT} = $s;
$run{main} = 1;

sub rebuild_one {
    my ($dir, $srpm, $_status) = @_;
    # CM: Set argv[0] (in the C sense) to something we can easily spot and
    #     understand in process list
    $0 = "Iurt: $run{distro_tag} $run{my_arch} $run{media} $srpm";

    plog('NOTIFY', "Build package $srpm [$done/$to_compile]");
    # When rebuilding all the media, src.rpm can be removed from mirror before we work on them
    unless (-f "$dir/$srpm") {
	plog('WARNING', "$dir/$srpm missing");
	$run{status}{$srpm} = 'missing';
	return $srpm;
    } 
    # FIXME unfortunately urpmi stalls quite often
    my $retry = 0;

retry:
    my ($srpm_name) = $srpm =~ /(?:.*:)?(.*)-[^-]+-[^-]+\.src\.rpm$/;
    $srpm_name or return $srpm;

    if (!$run{use_old_chroot}) {
	plog('DEBUG', 'Not reusing old chroot');
	my $use_netns = defined($config->{use_netns}{$srpm_name}) ? $config->{use_netns}{$srpm_name} : $config->{use_netns}{default};
	$chroot_tmp = create_temp_chroot(\%run, $config,
					 $chroot_tmp, $chroot_ref, $use_netns) or return $srpm;
    }

    if (!$urpmi->urpmi_command($chroot_tmp)) {
	plog('ERROR', "Creating chroot failed.\nCommand was: $chroot_tmp");
	return $srpm;
    }
    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},'');

    plog('DEBUG', "creating user $luser in chroot $chroot_tmp");
    add_local_user($chroot_tmp, $config, $luser, $run{uid}) or return $srpm;

    my $old_srpm = $srpm;
    my ($ret, $spec);
    ($ret, $srpm, $spec) = $urpmi->recreate_srpm(\%run, $config,
						 $chroot_tmp, $dir, $srpm, $luser, $retry);
    if ($ret == -1) {
	if (create_build_chroot($run{chroot_path}, $run{chroot_ref}, \%run,  $config)) {
	    $retry = 1;
	    goto retry;
	} else {
	    $ret = 0;
	}
    } 
    if (!$ret) {
	# CM: experimental: fail if we can't regenerate the srpm
	#     This should eliminate bouncers that block the input queue 
	#
	$srpm = $old_srpm;
	$run{status}{$srpm} = 'recreate_srpm_failure';
	return $srpm;
    } 

    (my $log_dirname = $srpm) =~ s/.*:(.*)\.src.rpm/$1/;
    my $log_dir = "$local_spool/log/$log_dirname/";
    
    # only create the log dir for the new srpm
    mkdir $log_dir;
    -d $log_dir or die "FATAL: could not create $log_dir (check permissions and group ownerships)";
	
    # We may have media not used to create the chroot (when building for updates_testing
    # or if using additional_media) so need to update basesystem packages.
    $urpmi->update($chroot_tmp);

    plog('INFO', "Install build dependencies for $srpm");
    my $path_srpm = "$chroot_tmp/home/$luser/rpmbuild/SRPMS/";
	
    my $ok = $urpmi->install_packages($srpm, $chroot_tmp, $local_spool, 'install_deps', "[REBUILD] install of build dependencies of $srpm failed on $run{my_arch}", { maintainer => $maintainer }, "$path_srpm/$srpm");
    if (!$ok) {
	$run{status}{$srpm} ||= 'install_deps_failure';
	return $srpm;
    }

    $ok = $urpmi->install_dynamic_buildrequires(\%run, $config, $chroot_tmp, $luser, $spec, $srpm);
    if (!$ok) {
	$run{status}{$srpm} ||= 'install_deps_failure';
	return $srpm;
    }

    perform_command("rpm --root $chroot_tmp -qa | sort", 
		    \%run, $config,
		    logname => "rpm_qa", 
		    hash => "rpm_qa_$srpm", 
		    timeout => 60, 
		    debug_mail => $run{debug},
		    log => $log_dir); # or next; As this failed quite often, do not stop
    plog('NOTIFY', "Building $srpm");
    my $target_arch = check_noarch("$path_srpm/$srpm") ? 'noarch' : $run{my_arch};
    my $command = "rpmbuild  --target $target_arch --rebuild $run{with_flags} /home/$luser/rpmbuild/SRPMS/$srpm";
    if ($run{stop}) {
	$urpmi->install_packages('chroot', $chroot_tmp, $local_spool, 'configure', "[ADMIN] installation of urpmi and sudo failed in the chroot $run{my_arch}", { check => 1, maintainer => $config->{admin} }, 'urpmi', 'sudo');
	add_sudoers($chroot_tmp, $luser);
	$command = "rpmbuild -b$run{stop} /home/$luser/rpmbuild/SPECS/$spec";
    }
    
    my $icecream;
    if ($run{icecream}) {
	$icecream = "RPM_BUILD_NCPUS=$run{icecream}";
    }
    
    if (!perform_command(qq(chroot $chroot_tmp /bin/su - $luser -c "TMP=/home/$luser/tmp/ $icecream $command"), 
			 \%run, $config,
			 use_iurt_root_command => 1,
			 mail => $maintainer, 
			 error => "[REBUILD] $srpm from $run{distro_tag} does not build correctly on $run{my_arch}", 
			 logname => "build", 
			 hash => "build_$srpm", 
			 timeout => $config->{build_timeout}{$srpm_name} || $config->{build_timeout}{default},
			 stalled_timeout => $config->{build_stalled_timeout}{$srpm_name} || $config->{build_stalled_timeout}{default},
			 srpm => $srpm,
			 debug_mail => $run{debug},
			 cc => $cc, 
			 log => $log_dir, 
			 callback => sub { 
			     my ($opt, $_output) = @_;
			     if ($run{stop}) {
				 plog("dumping to a chrooted shell into $chroot_tmp (pid $$)");
				 # exec does not work because it seems stdin and out are shared between children
				 system($sudo, $config->{iurt_root_command}, '--chroot', $chroot_tmp, '/bin/su', '-', $luser, '-c', "$config->{prompt} bash");
				 exit();
			     }
			     plog('DEBUG', "calling callback for $opt->{hash}");
			     1;
			 })) {
	
	$run{status}{$srpm} = 'build_failure';
	return $srpm;
    }
    
    # do some cleaning if the compilation is successful
    # 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/rpmbuild/RPMS/";
    my @packages;
    foreach my $bindir (readdir $binfh) {
	-d "$chroot_tmp/home/$luser/rpmbuild/RPMS/$bindir" or return $srpm;
	opendir my $rpmfh, "$chroot_tmp/home/$luser/rpmbuild/RPMS/$bindir";
	push @packages, map { "$chroot_tmp/home/$luser/rpmbuild/RPMS/$bindir/$_" } grep { !/src\.rpm$/ && /\.rpm$/ } readdir $rpmfh;
    }
    
    # 20060810 warly We should fail here, but rpm is currently
    # segfaulting when trying to install packages
    
    if ($config->{check_binary_file}) {
	$urpmi->install_packages($srpm, $chroot_tmp, $local_spool, 'binary_test', "[REBUILD] binaries packages generated from $srpm do not install correctly", { maintainer => $maintainer } ,@packages) or return $srpm;
    } else  {
	my $successfile = "$log_dir/binary_test_$srpm-1.log";
	output($successfile, "$srpm build ok");
    }
    
    if ($run{debug}) {
	$run{status}{$srpm} = 'ok';
	plog("debug mode, skip other packages");
	exit();
    } elsif ($run{group}) {
	# we should not move the package until they are all compiled
	plog("group mode, keep packages for local media ($srpm is done $done)");
	$run{done}{$srpm} = $done;
	$urpmi->add_to_local_media($chroot_tmp, $srpm, $luser);
    } else { 
	# drop packages and logs if we only want failure logs
	if ($run{delete_on_success}) {
	    system("rm -rf $log_dir");
	} elsif (!$run{discard_packages}) {
	    plog('OK', "build successful, copying packages to $local_spool.");
	    if (system("cp $chroot_tmp/home/$luser/rpmbuild/RPMS/*/*.rpm $local_spool &>/dev/null")) {
		# If copy fails (like disk full), report a failure and delete partially copied files
		plog('ERROR', "ERROR: could not copy rpm files from $chroot_tmp/home/$luser/rpmbuild/RPMS/ to $local_spool ($!)");
		foreach my $package (@packages) {
		    $package =~ s|.*/||;
		    unlink "$local_spool/$package";
		}
	    } else {
		my $packagesfile = "$log_dir/packages.$run{my_arch}.$run{run}.log";
		output($packagesfile, sort(map { m|([^/]*)$|; "$1\n" } @packages));
	    }
	}
	
	if ($run{copy_srpm}) {
	    # replace the old srpm
	    unlink "$local_spool/$old_srpm";
	    
	    if (system("cp $chroot_tmp/home/$luser/rpmbuild/SRPMS/$srpm $local_spool &>/dev/null")) {
		# If copy fails (like disk full), remove partially copied file
		plog('ERROR', "ERROR: could not copy $srpm from $chroot_tmp/home/$luser/rpmbuild/SRPMS/ to $local_spool ($!)");
		unlink "$local_spool/$srpm";
	    }
	}
    }
    $run{status}{$srpm} = 'ok';
    return $srpm;
}

my $rebuild;
$run{group} = 0 if @{$run{todo}} == 1;
if ($run{group}) { 
    $rebuild = 1;
    $urpmi->set_local_media($local_spool);
    $urpmi->order_packages(\%provides, $luser)
	or die "FATAL $program_name: could not order packages";
}	
#
# The build loop
#
my $prev_done = $done;
do { 
    $rebuild = 0;
    $done = $prev_done;
    my $i;
    my %children;
    for ($i; $i < @{$run{todo}}; $i++) {
	my ($dir, $srpm, $status) = @{$run{todo}[$i]};
	if ($run{num_shards} && ($i % $run{num_shards}) != $run{shard_id}) {
	    plog('DEBUG', "Skipping $srpm, not for my shard");
	    next;
	}
	$done{$srpm} and next;
	$done{$srpm} = 1;
	check_version(\%run, $srpm, \%srpm_version) or next;
	if ($run{debug}) { $run{debug}++ == 2 and exit() }
	$done++;
	if ($run{parallel}) {
	    my $pid;
	    # First cleanup all the finished ones
	    do {
		$pid = waitpid(-1, WNOHANG);
		if ($pid > 0) {
		    plog('INFO', "Child $pid has exited");
		    delete $children{$pid};
	        }
	    } while $pid > 0;
	    while (scalar keys %children >= $run{parallel}) {
		plog('INFO', "Too many children, waiting to fork more");
		$pid = waitpid(-1, 0);
		delete $children{$pid} if $pid > 0;
	    }
	    # TODO: check load, free memory and free disk
	    $pid = fork();
	    if ($pid) { #parent
		$children{$pid} = 1;
	    } elsif ($pid == 0) { #child
		$chroot_tmp .= "_" . int($i);
		$srpm = rebuild_one($dir, $srpm, $status);
		write_status($local_spool, \%run, $srpm);
		clean_chroot($chroot_tmp, \%run, $config);
		exit();
	    } else {
		die "could not fork";
	    }
	} else {
	    $srpm = rebuild_one($dir, $srpm, $status);
	    write_status($local_spool, \%run, $srpm);
	}
    }
    if ($run{parallel}) {
	foreach my $pid (keys %children) {
	    plog('INFO', "Waiting for process $pid to exit");
	    waitpid($pid, 0);
	    delete $children{$pid};
	}
    }
    if ($run{group}) {
	my $i;
	for ($i; $i < @{$run{todo}}; $i++) {
	    my (undef, $srpm) = @{$run{todo}[$i]};
	    if (!$run{done}{$srpm}) {
		$rebuild = $urpmi->order_packages(\%provides, $luser);
		last;
	    }
	}
	if ($prev_done == $done) {
	    $rebuild = 0;
	    if ($done == @{$run{todo}}) {
		plog('OK', "all packages succesfully compiled, copying packages to $local_spool.");
		system("cp $chroot_tmp/home/$luser/rpmbuild/RPMS/*/*.rpm $local_spool &>/dev/null") and plog('ERROR', "ERROR: could not copy rpm files from $chroot_tmp/home/$luser/rpmbuild/RPMS/ to $local_spool ($!)");
		if ($run{copy_srpm}) {
		    system("cp $chroot_tmp/home/$luser/rpmbuild/SRPMS/*.src.rpm $local_spool &>/dev/null") and plog('ERROR', "ERROR: could not copy SRPMS from $chroot_tmp/home/$luser/rpmbuild/SRPMS/ to $local_spool ($!)");
		}
	    } else {
		plog('FAIL', "some packages could not be compiled.");
	    }
	}
    }
} while $rebuild;

if (!$run{debug} && !$run{use_old_chroot}) {
    clean_chroot($chroot_tmp, \%run, $config);
}

unlink "$run{pidfile_home}/$run{pidfile}" if $run{pidfile};

exit();


#
#
#

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

sub check_pid {
    my ($run) = @_;
    my $hostname = `hostname`;
    chomp $hostname;
    my $pidfile = $run->{pidfile};
    my $lockfile = "$run->{pidfile_home}/$pidfile.$hostname.pid.lock";
    plog("trying to lock $lockfile");
    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 {
	plog("ERROR: could not lock pid file (status $status $!)");
	if (! -f "$lockfile.2") {
	    plog("using $lockfile.2 as lock file");
	    open my $lock2, ">$lockfile.2" or die "FATAL $program_name: could not open lock file $lockfile.2";
	    print $lock2 $$;
	    close $lock2;
	}
    }
    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) {
		plog("$msg\n");
		exit();
	    } else {
		plog("$msg, ignoring it");
	    }
	}
    }
    $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) {
	    plog("ERROR: 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') {
		plog("an other iurt pid $pid is running for a very long time or is zombie, killing it");
		my $i;
		while ($i < 5 && getpgrp $pid != -1) {
		    kill_for_good($pid);
		    $i++;
		    sleep 1;
		}
	    } else  {
		plog("an other iurt is running for $run->{my_arch}, pid $pid, since ", time()-$time, " seconds");
		exit();
	    }
	} else {
	    plog("a previous iurt for $run->{my_arch} seems dead, cleaning.");
	    unlink $pidfile;
	}
    }
    plog("setting $pidfile pid lock");
    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, $config, $srpm_version, $provides, $maint) = @_;
    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) {
		plog("Parsing $synthesis_file");
		my $urpm = urpm->new;
		$urpm->parse_synthesis($synthesis_file, callback => sub {
		    my ($_urpm, $pkg) = @_;
		    $provides->{$pkg->fullname} = 1;
		    foreach ($pkg->provides) {
			if (/([^[]+)(?:\[(.*)\])?/g) {
			    $provides->{$1} = $2 || 1;
			}
		    }
		});
	    }
	}
    }
    #"
    my $nb;
    foreach my $subdir (@{$config->{all_media}{$run->{media}}}) {
	$nb += search_packages($run, $maint, $srpm_version, "$config->{repository}/$run->{distro}/SRPMS/$run->{media}/$subdir/");
    }
    $nb;
}

sub guess_release_tag_from_status {
    my ($run) = @_;
    while (my ($srpm, $status) = each %{$run->{status}}) {
        if ($status eq 'ok' || $status eq 'build_failure' || $status eq 'install_deps_failure') {
	    # The regex should probably be in the config
	    my ($tag) = $srpm =~ /.*\.([^.]*)\.src\.rpm$/;
	    plog('INFO', "Guessed release tag: $tag");
	    return $tag;
	}
    }
}

sub search_packages {
    my ($run, $_maint, $srpm_version, @dir) = @_;
    my ($to_compile, %rep);
    plog("iurt search_package: @dir");
    # Status is written with the current release tag which may be different
    my $reltag = guess_release_tag_from_status($run);
    foreach my $dir (@dir) {
	plog("checking SRPMS dir $dir");
	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} and next;
	    # If the package was rebuilt, its release tag may have changed
	    if ($reltag && $srpm !~ /$reltag.src.rpm/) {
		    my $s = $srpm;
		    $s =~ s/\.[^.]*\.src\.rpm$/.$reltag.src.rpm/;
		    $run->{status}{$s} and next;
	    }
	    #print $run->{status}{$srpm};
	    #print " $srpm\n";
	    if ($config->{unwanted_packages} && $srpm =~ /$config->{unwanted_packages}/) { next }
	    if (check_version($run, $srpm, $srpm_version)) { 
		-f "$dir/$srpm" or next;
		if (!check_arch("$dir/$srpm", $run{my_arch})) {
		    $run->{status}{$srpm} = 'not_on_this_arch';
	    	    write_status($local_spool, \%run, $srpm);
		    next;
		}
		my $hdr = RPM4::Header->new("$dir/$srpm");
		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 ];
	    }
	    $rep{$srpm} = 1;
	}
	closedir $rpmdir;
    }
    $to_compile;
}    

sub add_sudoers {
    my ($chroot, $user) = @_;
    my $tmpfile = "/tmp/sudoers";
    my $file = "$chroot/etc/sudoers";
    my $f;
    if (!open $f, ">$tmpfile") {
	plog("ERROR: could not open $file ($!)");
	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;
    chmod 0440, $tmpfile;

    plog("adding sudo for /bin/rpm, /usr/sbin/urpmi and /usr/sbin/urpme");
    my $ret = sudo($config, '--cp', $tmpfile, $file);
    unlink $tmpfile;

    if (!$ret) {
	plog("ERROR: could not write $file ($!)");
	return 0;
    }

    return -f $file;
}

sub status_file {
    my ($local_spool, $run) = @_;
    my $media = $run->{media} ? "$run->{media}." : "";
    return "$local_spool/log/status.${media}log";
}

sub empty_status {
    my ($local_spool, $run) = @_;
    my $status_file = status_file($local_spool, $run);
    truncate($status_file, 0);
}

sub load_status {
    my ($local_spool, $run) = @_;
    my $status_file = status_file($local_spool, $run);
    plog('INFO', "Loading status from $status_file");
    if (open my $file, "<$status_file") {
	while (my $row = <$file>) {
	    chomp $row;
	    if ($row =~ /^(.*): (.*)$/) {
		my $srpm = $1;
		$run->{status}{$srpm} = $2;
	    }
	}
    }
    plog('INFO', "Loaded " . (keys %{$run->{status}}) . " status") if $run->{status};
}

sub write_status {
    my ($local_spool, $run, $srpm) = @_;
    return unless $run{status}{$srpm};
    my $status_file = status_file($local_spool, $run);
    if (open my $file, ">>$status_file") {
	flock($file, LOCK_EX);
	seek($file, 0, SEEK_END);
	print $file "$srpm: $run->{status}{$srpm}\n";
	flock($file, LOCK_UN);
    }
}

sub check_sudo_access() {
    return 0 == system("$sudo -l -n $config->{iurt_root_command} &>/dev/null </dev/null");
}

__END__

Discussion

20061222 Warly
  Group building
  For the group building, we need to order the source packages, the problem is that we do not 
  really know what will be the provides of the resulting packages before building the.
  We could guess them by looking to older version, but that means that we need to have an access to
  the media deps files (synthesis should be enough).
  We can also perform a first pass of build to check which package build and then what are their
  provides. For the second pass, we will them be able to use the previously build packages to
  solve buildrequires.