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
#
use strict;
use Hdlist;
use Data::Dumper;
use URPM;
use File::NCopy qw(copy);
use MIME::Words qw(encode_mimewords);
use Fcntl ':flock';
use Mkcd::Commandline qw(parseCommandLine usage);

my $program_name = 'iurt';
# sessing parameters
my $arg = @ARGV;
my (@params, %run);
$run{todo} = [ ];
@params = ( 
    #    [ "one letter option", "long name option", "number of args (-X means ´at least X´)", "help text", "function to call", "log info"]
    [ "", "$program_name", 0, "[options]", 
    "$program_name rebuild bot", 
    sub { $arg or usage($program_name, \@params) }, "" ],
    [ "", "cache", 0, "", 
    "Use the global cache file",
    sub { $run{cache} = 1 }, "Activating cache use" ],
    [ "", "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" ],
    [ "", "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" ],
    [ "", "debug", 0, "", 
    "Activate debug mode", 
    sub { $run{debug} = 1 }, "Activating debug mode" ],
    [ "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 to rebuild", 
    sub { ($run{media}) = @_; 1 }, "Adding a media to rebuild" ],
    [ "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-12mdk.src.rpm", 
    sub { 
	$run{rebuild} = 1; 
	$run{distro} = shift @_;
       	$run{my_arch} = shift @_;
	foreach (@_) {
	    if (m,(.*/)([^/]*.src.rpm)$, && -f $_) {
		push @{$run{todo}}, [ $1, $2 ];
		print {$run{LOG}} "iurt: force build for $2 (from $1)\n";
	    } elsif (m,([^/]*.src.rpm)$, && -f $_) {
		push @{$run{todo}}, [ './', $1 ];
		print {$run{LOG}} "iurt: force build for $1\n";
	    } else {
		die "FATAL iurt: $_ does not seems to be a SRPM\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" ],
    ], "[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" ],
    [ "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" ],
    [ "d", "dir", -1, "", 
    "Directory where to find packages to rebuild", 
    sub { $run{extra_dir} = @_; 1 }, "Adding extra source packages directories" ],
);

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 $urpmi_options = "-v --no-verify-rpm --nolock --auto";

my $real_arch = `uname -m`;
chomp $real_arch;
my %arch_comp = (
    'i586' => { 'i386' => 1, 'i486' => 1, 'i586' => 1 },
    'i686' => { 'i386' => 1, 'i486' => 1, 'i586' => 1, 'i686' => 1 },
    'x86_64' => { 'i386' => 1, 'i486' => 1, 'i586' => 1, 'i686' => 1, 'x86_64' => 1 },
    'ppc' => { 'ppc' => 1 },
    'ppc64' => { 'ppc' => 1, 'ppc64' => 1 },
);

my $HOME = $ENV{HOME};
my $configfile = "$HOME/.iurt.$run{distro_tag}.conf";
print {$run{LOG}} "iurt: loading config file $configfile\n" if $run{verbose} > 1;
my $config;
if (-f $configfile) {
    $config = do $configfile or die "FATAL iurt: syntax error in $configfile";
} else {
    $config = {}
}

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 => { desc => 'Where to find basesystem packages', default => "$config->{repository}/$run{distro}/$run{my_arch}/media/main/" },
    cache_home => { desc => 'Where to store the cache files', default => "$HOME/.bugs" },
    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 => '' },
    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' },
    minimum_package_number => { "Minimum number of packages in a synthesis file to consider it valid", default => 1000 },
    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("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 iurt: could not compile $run{my_arch} binaries on a $real_arch"
}
foreach my $k (keys %config_usage) {
    $config->{$k} ||= $run{config}{$k} || $config_usage{$k}{default}
}

$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("$config->{upload} does not exist");

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

my $debug_tag = '_debug' if $run{debug};
my $chroot = "$config->{local_home}/chroot$debug_tag";
my $chroot_tar = "$chroot-$run{distro_tag}.$run{my_arch}.tar.gz";
if ($run{chroot}) {
    check_chroot($chroot, $chroot_tar, \%run)
}

my $cachefile = "$config->{cache_home}/iurt.$run{distro_tag}.$run{my_arch}.cache";
my $cache;
if (-f $cachefile && $run{cache}) {
    print {$run{LOG}} "iurt: loading cache file $cachefile\n" if $run{verbose} > 1;
    $cache = do $cachefile
} else {
    $cache = { rpm_srpm => {}, failure => {}, queue => {}, warning => {}, run => 1, needed => {}, no_unionfs => {} }
}

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, \%run, @{$run{extra_dir}}) if $run{extra};

dump_cache();

if (!@{$run{todo}} && !$run{debug}) {
    print {$run{LOG}} "iurt: nothing to do\n";
    unlink $run{pidfile} if $run{pidfile};
    exit
}
print {$run{LOG}} "iurt: will try to compile $to_compile packages\n" if $run{verbose} > 1;

exit if !$run{rebuild};

if ($run{cache}) {
    $run{run} = ++$cache->{run} 
} else {
    my ($sec,$min,$hour,$mday,$mon,$year) = gmtime(time());
    $year += 1900;
    my $fulldate = sprintf "%4d%02d%02d%02d%02d%02d", $year, $mon+1, $mday, $hour, $min, $sec;
    $run{run} = "0.$fulldate"
}

$config->{local_upload} ||= $config->{local_home};
my $local_spool = "$config->{local_upload}/iurt/$run{distro_tag}/$run{my_arch}";
if (!-d "$config->{local_upload}/iurt/$run{distro_tag}/") {
    mkdir "$config->{local_upload}/iurt/$run{distro_tag}";
    if (!-d $local_spool) {
	mkdir $local_spool;
	mkdir "$local_spool/log"
    }
}

dump_rpmmacros("$chroot/home/builder/.rpmmacros") or die "FATAL iurt: could not dump rpm macros";
my $unionfs_dir;
if ($run{unionfs}) {
    $unionfs_dir = "$config->{local_home}/iurt_unionfs$debug_tag";
    clean_all_unionfs($unionfs_dir);
    -d $unionfs_dir or mkdir $unionfs_dir
}

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

my %done;
my $wait_limit;
my $done;
my $home = $config->{local_home};
my $union_id = 1;
my $unionfs_tmp = $run{unionfs};	
foreach (my $i ; $i < @{$run{todo}}; $i++) {
	my ($dir, $srpm) = @{$run{todo}[$i]};
	$done{$srpm} and next;
	$done{$srpm} = 1;
	check_version($srpm) or next;
	if ($run{debug}) { $run{debug}++ == 2 and exit }
	$done++;
	print {$run{LOG}} "iurt: packages $srpm [$done/$to_compile]\n";
	# FIXME unfortunately urpmi stalls quite often
retry:
	my $match = "urpmi $urpmi_options --root $chroot";
	if (!clean_process($match, $run{verbose})) {
	    dump_cache();
	    die "FATAL iurt: Could not have urpmi working !"
	}
	if ($unionfs_tmp) {
	    my $mount_point = "$unionfs_dir/unionfs.$run{run}.$union_id";
	    print {$run{LOG}} "Cleaning $mount_point\n" if $run{verbose} > 1;
	    if (!clean_mnt($mount_point, $run{verbose})) {
		dump_cache();
		die "FATAL iurt: could not kill remaining processes acceding $mount_point"
	    }
	    my $tmpfs;
	    
	    # we cannont just rm -rf $tmpfs, this create defunct processes afterwards (and lock particularly hard the urpmi database)
	    $union_id = clean_unionfs($unionfs_dir, $run{run}, $union_id);
	    $tmpfs = "$unionfs_dir/tmpfs.$run{run}.$union_id";
	    $chroot = "$unionfs_dir/unionfs.$run{run}.$union_id";
	    mkdir $tmpfs or die "Could not create $tmpfs ($!)";
	    mkdir $chroot or die "Could not create $chroot ($!)";
	    if ($cache->{no_unionfs}{$srpm}) {
		$unionfs_tmp = 0;
		clean_chroot($chroot, \%run)
	    } else {
		# if the previous package has been built without unionfs, chroot need to be cleaned
		clean_chroot($chroot, \%run) if !$unionfs_tmp;
		$unionfs_tmp = 1;
		system(qq{sudo mount -t tmpfs none $tmpfs &>/dev/null}) and die "FATAL iurt: could not mount $tmpfs ($!)";
		system(qq{sudo mount -o dirs=$tmpfs=rw:$home/chroot$debug_tag=ro -t unionfs none $chroot &>/dev/null}) and die "FATAL iurt: could not mount $tmpfs and $home/chroot with unionfs ($!)";
		system("sudo mount -t proc none $chroot/proc &>/dev/null") and die "FATAL iurt: could not mount /proc in the chroot $chroot.";
	    }
	} else {
	    print {$run{LOG}} "iurt: installing a new chroot for $srpm in $chroot\n" if $run{verbose} > 1;
	    clean_chroot($chroot, \%run)
	}
	my ($srpm_name) = $srpm =~ /(.*)-[^-]+-[^-]+\.src\.rpm$/ or next;
	my ($maintainer, $cc);
	if (!$run{warn}) {
	    $maintainer = `rpmmon -s -p $srpm_name`;
	    $cc = "$maint{$srpm}";#, maintainers\@mandriva.com";
	    chomp $maintainer;
	    if (!$maintainer || $maintainer eq 'NOT_FOUND') {
		$maintainer = $cc;
		#$cc = 'maintainers@mandriva.com'
	    }
	}
	#($maintainer, $cc) = ($config->{admin},'');
	
	# recreate a new srpm for buildarch condition in the spec file
	print {$run{LOG}} "Copying $srpm to $chroot\n" if $run{verbose} > 1;
	perform_command("sudo cp $dir/$srpm $chroot/home/builder/rpm/SRPMS/", 
	        \%run, $config,
		mail => $config->{admin}, 
		error => "[REBUILD] cannot copy $srpm to $chroot", 
		debug_mail => $run{debug},
		hash => "copy_$srpm") or next;
	perform_command(qq{sudo chroot $chroot su builder -c "rpm -i /home/builder/rpm/SRPMS/$srpm"}, 
		\%run, $config,
		mail => $config->{admin}, 
		error => "[REBUILD] cannot install $srpm in $chroot", 
		debug_mail => $run{debug},
		hash => "install_$srpm") or next;
	perform_command(qq{sudo chroot $chroot su builder -c "rpm --nodeps -bs /home/builder/rpm/SPECS/*.spec"}, 
		\%run, $config,
		mail => $config->{admin}, 
		error => "[REBUILD] cannot create $srpm in $chroot", 
		debug_mail => $run{debug},
		hash => "create_$srpm") or next;
	print {$run{LOG}} "Installing build dependencies of $srpm...\n" if $run{verbose} > 1;
	
	perform_command("sudo urpmi $urpmi_options --root $chroot $chroot/home/builder/rpm/SRPMS/$srpm", 
		\%run, $config,
		mail => $config->{admin},
		error => "[REBUILD] install of build dependencies of $srpm failed on $run{my_arch}",  
		hash => "install_deps_$srpm", 
		timeout => 600, 
		freq => 1,
		#cc => $cc, 
		debug_mail => $run{debug},
		error_regexp => 'cannot be installed',
		wait_regexp => 'database locked',
		wait_callback => sub { $wait_limit++; if ($wait_limit > 10) { $wait_limit = 0; system(qq{sudo pkill -9 urpmi &>/dev/null}) } },
		log => "$local_spool/log/",
		callback => sub { 
			my ($opt, $output) = @_;
			print {$run{LOG}} "calling callback for $opt->{hash}\n" if $run{debug};
			my @missing_deps = $output =~ /\(due to unsatisfied ([^[ ]*)(?: (.*)|\[(.*)\])?\)/g;
			@missing_deps or return;
			while (my $missing_deps = shift @missing_deps) {
			    my $version = shift @missing_deps;
			    my $version2 = shift @missing_deps;
			    $version ||= $version2 || 0;
			    my $p = $pack_provide{$missing_deps} || $missing_deps;
			    my $other_maint = `rpmmon -p "$p"`;
			    chomp $other_maint;
			    print {$run{LOG}} "missing dep: $missing_deps ($other_maint)\n";
			    if ($other_maint && $other_maint ne 'NOT_FOUND') {
				$opt->{mail} = $other_maint;
				$opt->{error} = "[missing] $missing_deps, needed to build $srpm, is not available on $run{my_arch}";
			    }
			    # remember what is needed, and do not try to recompile until it is available
			    push @{$cache->{needed}{$srpm}}, [ $missing_deps, $version, $other_maint || $maintainer ];
			}
		},
	) or next;
	# try to workarround the rpm -qa db4 error(2) from dbcursor->c_get: No such file or directory
	# running rpm -qa several time seems to fix the problem
	foreach (1 .. 3) {
	    system("sudo chroot $chroot rpm -qa &> /dev/null")
	}
	perform_command("sudo chroot $chroot rpm -qa", 
		\%run, $config,
		hash => "rpm_qa_$srpm", 
		timeout => 60, 
		debug_mail => $run{debug},
		log => "$local_spool/log/"); # or next; As this failed quite often, do not stop
	print {$run{LOG}} "Compiling $srpm\n" if $run{verbose}; 
	if (!perform_command(qq{TMP=/home/builder/tmp/ sudo chroot $chroot /bin/su builder -c "rpm --rebuild /home/builder/rpm/SRPMS/$srpm"}, 
			\%run, $config,
			mail => $maintainer, 
			error => "[REBUILD] $srpm from $run{distro_tag} does not build correctly on $run{my_arch}", 
			hash => "build_$srpm", 
			timeout => 18000, 
			debug_mail => $run{debug},
			cc => $cc, 
			log => "$local_spool/log/", 
			error_regexp => 'rror.*ailed|Bad exit status|RPM build error',
			callback => sub { 
			    my ($opt, $output) = @_;
			    print {$run{LOG}} "iurt: calling callback for $opt->{hash}\n" if $run{debug};
			    if ($unionfs_tmp && $output =~ /no space left on device/i) {
				print {$run{LOG}} "ERROR iurt: running out of space to compile $srpm in unionfs mode, will recompile it in normal mode\n";
				$cache->{no_unionfs}{$srpm} = 1
			    } elsif ($unionfs_tmp && $output =~ m,$home,) {
				print {$run{LOG}} "ERROR iurt: 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
			    }
			}, 
			freq => 1) && !glob "$chroot/home/builder/rpm/RPMS/*/*.rpm") {
		    # 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 (!$unionfs_tmp) {
			$cache->{failure}{$srpm} = 1
		    } elsif (!$cache->{no_unionfs}{$srpm}) {
			$cache->{failure}{$srpm} = 1
		    } else {
			goto retry
		    }
		next
	}
	# do some cleaning if the compilation is successful
	delete $cache->{needed}{$srpm} if defined $cache->{needed}{$srpm};
	if (!perform_command("sudo urpmi $urpmi_options --root $chroot $chroot/home/builder/rpm/RPMS/*/*.rpm", 
			\%run, $config,
			mail => $maintainer, 
			error => "[REBUILD] binaries packages generated from $srpm do not install correctly", 
			hash => "binary_test_$srpm", 
			timeout => 300, 
			debug_mail => $run{debug},
			freq => 1, 
			error_regexp => 'unable to access',
			log => "$local_spool/log/")) {
		$cache->{failure}{$srpm} = 1;
		next
	}
	if ($run{debug}) {
	    print {$run{LOG}} "iurt: debug mode, skip other packages\n";
	    exit
	} else {
	    print {$run{LOG}} "iurt: build successful, copying packages to $local_spool.\n";
	    system("cp $chroot/home/builder/rpm/RPMS/*/*.rpm $local_spool &>/dev/null") and print {$run{LOG}} "ERROR: could not copy rpm files from $chroot/home/builder/rpm/RPMS/ to $local_spool ($!)\n";
	    if ($run{copy_srpm}) {
		system("cp $chroot/home/builder/rpm/SRPMS/$srpm $local_spool &>/dev/null") and print {$run{LOG}} "ERROR: could not copy $srpm from $chroot/home/builder/rpm/SRPMS/ to $local_spool ($!)\n";
	    }
	    process_queue($config, \%run, \@wrong_rpm, 1)
	}
}

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

dump_cache();

print {$run{LOG}} "ERROR iurt: 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";
    }
}

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 -c arcfour' $local_spool/log/ $config->{rsync_to}/$run{distro_tag}/$run{my_arch}/log/");
}

# one last try to clean
print {$run{LOG}} "iurt: try to clean remaining unionfs\n" if $run{verbose};
if ($run{unionfs}) {
    clean_all_unionfs($unionfs_dir)
}
unlink $run{pidfile} if $run{pidfile};
exit;

sub config_usage {
	print "
	
	Iurt configuration keywords:
	
";
    $Data::Dumper::Indent = 0;
    $Data::Dumper::Terse = 1;
    foreach my $k (sort keys %config_usage) {
	print "	$k: $config_usage{$k}{desc} 
			default: ", Data::Dumper->Dump([$config_usage{$k}{default}]), ", current: ", Data::Dumper->Dump([$config->{$k}]),"\n"
    }
    print "\n\n";
    exit
}

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

sub clean_chroot {
    my ($chroot, $run, $only_clean) = @_;
    if (-d $chroot) {
	system("sudo umount $chroot/proc &> /dev/null");
	perform_command("sudo rm -rf $chroot", 
	    $run, $config,
	    mail => $config->{admin},
	    error => "[REBUILD] Deleting of old chroot $chroot failed", 
	    hash => 'chroot_deletion', 
	    debug_mail => $run->{debug},
	    die => 1);
    }
   return 1 if $only_clean;
   mkdir $chroot;
   perform_command("pushd $chroot && sudo tar xvf $chroot_tar", 
		$run, $config,
		mail => $config->{admin}, 
		error => "[REBUILD] creating the initial chroot $chroot failed", 
		hash => 'chroot_init', 
		debug_mail => $run->{debug},
		die => 1);

   dump_rpmmacros("$chroot/home/builder/.rpmmacros") or return;
   system("sudo mount none -t proc $chroot/proc &>/dev/null") and return;
   1
}

sub clean_process {
    my ($match, $verbose) = @_;
    return clean($match, "pgrep -u root -f", "sudo pkill -9 -u root -f", $verbose);
}

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

sub clean {
    my ($var, $cmd, $kill_cmd, $verbose) = @_;
    my $ps;
    my $i;
    while ($ps = `$cmd "$var"`) {
	system(qq{$kill_cmd "$var" &>/dev/null});
	sleep 1;
	$ps =~ s/\n/,/g;
	print {$run{LOG}} "Trying to remove previous blocked processes for $var ($ps)\n" if $verbose > 1;
	return 0 if $i++ > 10
    }
    1
}

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

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

sub check_needed {
    my ($srpm) = @_;
    if (!defined $cache->{needed}{$srpm} && !ref $cache->{needed}{$srpm}) { return 1 } 
    my @n;
    my $ok = 1;
    foreach my $t (@{$cache->{needed}{$srpm}}) {
	my ($name, $version, $maint) = @$t;
	my ($p_version) = $provides{$name};
	if ($p_version) {
	    next if $version == $p_version;
	    next if URPM::ranges_overlap($version, $p_version)
	}
	$ok = 0;
	push @n, [ $name, $version ];
	my $v ||= $version;
	print {$run{LOG}} "ERROR iurt: $srpm needs $name $v to be compiled.\n";
	# try to recompile it once in a while
	return 1 if ! $cache->{warning}{"install_deps_$srpm"}{$maint}++ % 72
    }
    delete $cache->{needed}{$srpm};
    $cache->{needed}{$srpm} = \@n if @n;
    $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}";
    opendir my $rpmdir, $dir or next;
    foreach my $rpm (readdir $rpmdir) {
	my ($rarch, $srpm) = update_srpm($dir, $rpm, $wrong_rpm);
	$rarch or next;
	print {$run{LOG}} "iurt: $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}/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}/RPMS/ ($!)\n";
		next
	    }
	}
	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 = rpm2header("$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 dump_cache {
	my $filename = $cachefile;
	# Right now there are no mechanism of concurrent access/write to the cache. There is 
	# on global lock for one iurt session. A finer cache access would allow several iurt running
	# but the idea is more to have a global parrallel build than several local ones.
	return if $run{debug} || !$run{cache};
	open my $file, ">$filename.tmp" or die "FATAL iurt dump_cache: cannot open $filename.tmp";
	flock($file,LOCK_EX);
	seek($file, 0, 2);
	$Data::Dumper::Indent = 1;
	$Data::Dumper::Terse = 1;
	print $file Data::Dumper->Dump([ $cache ], [ "cache" ]);
	unlink $filename;
	link "$filename.tmp", $filename;
	flock($file,LOCK_UN)
}

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}');
	grep { $_ eq $run{my_arch} || $_ eq '(none)' } @exclusive_arch or return 1; 
	my (@exclude_arch) = $hdr->queryformat('%{EXCLUDEARCH}');
	grep { $_ eq $run{my_arch} } @exclusive_arch and return 1 
}

sub check_version {
	my ($srpm) = @_;
	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 perform_command {
    my ($command, $run, $config, %opt) = @_;
    $opt{timeout} ||= 300;
    $opt{freq} ||= 24;
    print {$run{LOG}} "Timeout $opt{timeout}\n" if $run{verbose} > 2;
    # from alarm perldoc
    my $output;
    my $kill;
    if ($opt{debug}) {
	print "Would have rum $command with a timeout of $opt{timeout}\n";
	return 1
    }
    eval {
	local $SIG{ALRM} = sub { print "Timeout!\n"; $kill = 1; die "alarm\n" }; # NB: \n required
	alarm $opt{timeout};
	print {$run{LOG}} "$command\n" if $run{verbose} > 2;
	if ($opt{log}) {
	    #$output = `$command 2>&1 2>&1 | tee $opt{log}/$opt{hash}.$run.log`;
	    system("$command &> $opt{log}/$opt{hash}.$run->{run}.log");
	} else {
	    $output = `$command 2>&1`;
	}
	alarm 0;
    };
    if ($@) {
	# timed out
	die unless $@ eq "alarm\n";   # propagate unexpected errors
	return 0
    } else {
	# Keep the run first on the harddrive so that one can check the command status tailing it
	if ($opt{log} && open my $log, "$opt{log}/$opt{hash}.$run->{run}.log") {
	    local $/;
	    $output = <$log>
	}
	my $err = $?;
	if (ref $opt{callback}) {
	    $opt{callback}(\%opt, $output)
	}
	if ($kill) {
	    $output = "Command has been killed after $opt{timeout} seconds: $command\n$output"
	} else {
	    $output = "Command failed: $command\n$output"
	}
	if ($opt{wait_regexp} && $output =~ /$opt{wait_regexp}/) {
	    $opt{wait_callback}(\%opt, $output) if ref $opt{wait_callback};
	    print {$run->{LOG}} "ERROR iurt: $opt{wait_regexp} !\n";
	    sendmail($config->{admin}, '' , "$opt{hash} on $run->{my_arch} for $run->{media}: could not proceed", "$opt{wait_regexp}\n\n$output", 0, 0, $opt{debug_mail});
	    if ($opt{die}) {
		dump_cache();
		die "FATAL iurt: $opt{error}."
	    }
	    return 0
	}
	if ($err || $opt{error_regexp} && $output =~ /$opt{error_regexp}/) {
	    if ($opt{mail} && $config->{sendmail} && !$config->{no_mail}{$opt{mail}}) {
		if (! ($cache->{warning}{$opt{hash}}{$opt{mail}} % $opt{freq})) {
		    sendmail($opt{mail}, $opt{cc} , $opt{error} , $output, 0, 0, $opt{debug_mail});
		} elsif ($config->{admin}) {
		    sendmail($config->{admin}, '' , $opt{error}, $output, 0, 0, $opt{debug_mail});
		}
	    }
	    $cache->{warning}{$opt{hash}}{$opt{mail}}++;
	    print {$run->{LOG}} "\n$output\n";
	    if ($opt{die}) {
		dump_cache();
		die "FATAL iurt: $opt{error}."
	    }
	    return 0
	}
    }
    1
}

sub kill_for_good {
    my ($pid) = @_;
    kill 14, $pid;
    sleep 2;
    if (getpgrp $pid != -1) {
	kill 15, $pid;
	sleep 2;
	if (getpgrp $pid  != -1) {
	    kill 9, $pid
	}
    }
}

sub check_chroot {
    my ($chroot, $chroot_tar, $run) = @_;
    print {$run{LOG}} "iurt: checking basesystem tar\n" if $run{verbose};
    system(qq{sudo pkill -9 -u root -f "urpmi $urpmi_options --root $chroot" &> /dev/null});
    clean_chroot($chroot, $run, 1) or die "FATAL iurt: Could no prepare initial chroot";
    perform_command("sudo $config->{install_chroot_binary} cooker $config->{basesystem_media} $chroot_tar $chroot 501 basesystem tar rpm-build", 
	$run, $config,
	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 dump_rpmmacros {
	my ($file) = @_;
	open my $f, qq{| sudo sh -c "cat > $file"} or return 0;
	print $f qq{\%_topdir                \%(echo \$HOME)/rpm
\%_tmppath               \%(echo \$HOME)/rpm/tmp/
\%distribution           $config->{distribution}
\%vendor                 $config->{vendor}
\%packager               $config->{packager}}
}

sub check_pid {
    my ($run) = @_;
    my $pidfile = $run->{pidfile};
    open my $lock, "$pidfile.lock";
    flock($lock,LOCK_EX);
    if (-f $pidfile)  {
	my (@stat) = stat $pidfile;
	open my $test_PID, $pidfile;
	my $pid = <$test_PID>;
	close $test_PID;
	if ($pid && getpgrp $pid != -1) {
	    my $time = $stat[9];
	    if ($time < time - 36000) {
		print {$run->{LOG}} "iurt: an other iurt pid $pid is running for a very long time, killing it\n";
		my $i;
		while ($i < 5 && getpgrp $pid != -1) {
		    kill_for_good($pid);
		    $i++;
		    sleep 1
		}
	    } else  {
		print {$run->{LOG}} "iurt: an other iurt is running for $run->{my_arch}, pid $pid, since ",time - $time," seconds\n";
		exit
	    }
	} else {
	    print {$run->{LOG}} "iurt: a previous iurt for $run->{my_arch} seems dead, cleaning.\n";
	    unlink $pidfile
	}
    }
    open my $PID, ">$pidfile" or die "FATAL iurt: could not open pidfile $pidfile for writing";
    print $PID $$;
    close $PID;

    flock($lock,LOCK_UN);
    close $lock;
}

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...
    my $rpms_dir = "$config->{repository}/$run->{distro}/$run->{my_arch}/media/$run->{media}/";
    print {$run->{LOG}} "iurt: 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;
	check_version($srpm)
    }
    closedir $rpmdir;

    foreach my $m (@{$config->{all_media}}) {
	my $synthesis_file = "$config->{repository}/$run->{distro}/$run->{my_arch}/media/$m/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 ($name) = $1 =~ /(.*)-[^-]+-[^-]+\..*$/;
			foreach (@prov) {
			    $pack_provide->{$_} = $name
			}
			@prov = ()
		    }
		}
		$nb < $config->{minimum_package_number} and die "FATAL iurt: synthesis files seems corrupted, only $nb packages found."
	    } else {
		die "FATAL iurt: Could not open $synthesis_file\n";
	    }
	}
    }
    search_packages(0, $cache, $run, $maint, "$config->{repository}/$run->{distro}/SRPMS/$run->{media}/")
}

sub search_packages {
    my ($clean, $cache, $run, $maint, @dir) = @_;
    my ($to_compile, %rep, %done_rpm);
    foreach my $dir (@dir) {
	print {$run->{LOG}} "iurt: 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;
	    if ($config->{unwanted_packages} && $srpm =~ /$config->{unwanted_packages}/) { next }
	    my $ok = 1;
	    if (check_version($srpm)) { 
		defined $cache->{failure}{$srpm} and next;
		if (!$cache->{queue}{$srpm} && check_needed($srpm)) {
		    my $hdr = rpm2header("$dir/$srpm");
		    check_arch($hdr) and next;
		    my $changelog = $hdr->queryformat("%{CHANGELOGNAME}");
		    my ($mail) = $changelog =~ /<(.*@.*)>/;
		    $maint{$srpm} = $mail;
		    print "iurt: will try to compile $srpm\n";
		    $to_compile++;
		    push @{$run->{todo}}, [ $dir , $srpm ]
		}
		foreach my $arch (@{$config->{supported_arch}}) {
		    $ok &&= $cache->{queue}{$srpm}
		}
	    }
	    if ($clean && ($rep{$srpm} || $ok)) {
		print "iurt: cleaning $dir/$srpm\n";
		unlink "$dir/build/$srpm";
		unlink "$dir/$srpm"
	    }
	    $rep{$srpm} = 1
	}
	closedir $rpmdir
    }
    $to_compile
}