#!/usr/bin/perl
#
# Copyright (C) 2005 Mandrakesoft
# Copyright (C) 2005 Mandriva
# 
# Author: Florent Villard <warly@mandraesoft.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 directory + tmpfs via unionfs to build the packages
# - having only one cache for all the architecture would need a merging before the cache is dumped, this is a bit overkill, so several cache are used, as a consequence the rpm/srpm structure is duplicated. Maybe a separated cache could be done to handle this structure, or just have it created separately. Anyway this is just a mater of some hundreds of kilobytes and directory listings. 
# - 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';

my ($debug, $unionfs, $nocheckchroot);
my @argv = grep { 
   if (/--debug/) { $debug = 1; 0 }
   elsif (/--unionfs/) { $unionfs = 1; 0 }
   elsif (/--nocheckchroot/) { $nocheckchroot = 1; 0 }
   else { 1 }
} @ARGV;

my $distro_version = shift @argv;
my $distro_tag = $distro_version;
$distro_tag =~ s,/,-,g;
my $my_arch = shift @argv;
my $media = shift @argv;
my @special_srpm_dir = @argv;
my $urpmi_options = "-v --no-verify-rpm -s --auto ";

$my_arch or usage();
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 },
);
if (!$arch_comp{$real_arch}{$my_arch}) {
    die "FATAL iurt: could not compile $my_arch binaries on a $real_arch"
}

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

$config->{home} ||= $HOME;
$config->{cache_home} ||= "$HOME/.bugs";
$config->{supported_arch} ||= ['i586', 'x86_64'];
$config->{upload} ||= "$HOME/uploads/";
$config->{local_home} ||= "$HOME";
$config->{repository} ||= "/mnt/BIG/dis/";
$config->{packager} ||= "Iurt";
$config->{install_chroot_binary} ||= 'install-chroot-tar.sh';
$config->{distribution} ||= 'Mandriva Linux';
$config->{vendor} ||= 'Mandriva';
$config->{basesystem_media} ||= "$config->{repository}/$distro_version/$my_arch/media/main/";

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

-d $config->{upload} or usage("$config->{upload} does not exist");

my $pidfile = "$config->{cache_home}/iurt.$distro_tag.$my_arch.pid";
if (!$debug) {
    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 STDERR "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 STDERR "iurt: an other iurt is running for $my_arch, pid $pid, since ",time - $time," seconds\n";
		# exit
	    }
	} else {
	    print STDERR "iurt: a previous iurt for $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;
}

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

my %big;
my %srpm_version;
my @wrong_rpm;
# FIXME need to check if scanning all the architecture is needed (except of noarch unsynchronity this should not be mandatory)
# in that case, @supported_arch may be removed
#
#foreach my $arch (@{$config->{supported_arch}}) {
my $rpms_dir = "$config->{repository}/$distro_version/$my_arch/media/$media/";
print STDERR "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);
    $rarch or next;
    $big{$rpm} = 1;
    $cache->{queue}{$srpm} = 1;
    check_version($srpm)
}
closedir $rpmdir;

my %provides;
my $synthesis_file = "$config->{repository}/$distro_version/$my_arch/media/$media/media_info/synthesis.hdlist.cz";
if (-f $synthesis_file) {
    print STDERR "Parsing $synthesis_file\n";
    if (open my $syn, "zcat $synthesis_file |") { 
	while (<$syn>) {
	    if (/^\@provides@(.*)/) {
		foreach my $p (split '@', $1) {
		    $p =~ /([^[]+)(?:\[(.*)\])?/g;
		    $provides{$1} = $2 || 1
		}
	    }
	}	    
    } else {
	print STDERR "ERROR: Could not open $synthesis_file, will not precheck dependecies avaibility\n";
    }
}
#}

my %maint;

my @todo;
-d "$config->{upload}/build/$my_arch" or mkdir "$config->{upload}/build/$my_arch";
my $clean;
my %rep;
my %done_rpm;
#
# FIXME all the rep but the first one are cleaned
# this may not be usefull anymore
#
my $to_compile;
foreach my $dir ("$config->{repository}/$distro_version/SRPMS/$media/", @special_srpm_dir) {
	print "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 @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
	}
	$clean = 1;
	closedir $rpmdir
}


dump_cache();

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

my $run = $cache->{run}++;


my $debug_tag = '_debug' if $debug;
my $chroot = "$config->{local_home}/chroot$debug_tag";
my $chroot_tar = "$chroot-$distro_tag.$my_arch.tar.gz";
if (!$nocheckchroot) {
    print "iurt: checking basesystem tar\n";
    system(qq{sudo pkill -9 -u root -f "urpmi $urpmi_options --root $chroot"});
    perform_command("sudo $config->{install_chroot_binary} cooker $config->{basesystem_media} $chroot_tar $chroot 501 basesystem tar rpm-build", 
	mail => $config->{admin},
	error => "[REBUILD] Creating the inital chroot for $distro_tag on $my_arch failed", 
	hash => 'chroot_inititialization', 
	timeout => 600, 
	debug_mail => $debug,
	die => 1);

    if ($unionfs) {
	clean_chroot($chroot) or die "FATAL iurt: Could no prepare initial chroot"
    }
}

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

my %done;
my $wait_limit;
my $done;
my $home = $config->{local_home};
foreach (my $i ; $i < @todo; $i++) {
	my ($dir, $srpm) = @{$todo[$i]};
	$done{$srpm} and next;
	$done{$srpm} = 1;
	check_version($srpm) or next;
	if ($debug) { $debug++ == 2 and exit }
	$done++;
	# dump cache every ten packages (we can be killed by other iurt if we are stuck)
	if (!$done % 10) { dump_cache() }
	print "iurt: packages $srpm [$done/$to_compile]\n";
	if ($unionfs) {
	    foreach my $t ("unionfs",'tmpfs') {
		my $d = "$home/$t";
		while (check_mounted($d, $t)) {
		    print STDERR "iurt: umounting $d\n";
		    system(qq{sudo umount $d}) and die "FATAL iurt: could not umount $d"
		}
		print STDERR "iurt: removing $d\n";
		system(qq{sudo rm -rf $d});
		mkdir "$d";
	    }
	    system(qq{sudo mount -t tmpfs none $home/tmpfs}) and die "FATAL iurt: could not mount $home/tmpfs ($!)";
	    system(qq{sudo mount -o dirs=$home/tmpfs=rw:$home/chroot/=ro -t unionfs unionfs $home/unionfs}) and die "FATAL iurt: could not mount $home/tmpfs and $home/chroot with unionfs ($!)";
	} else {
	    print "iurt: installing a new chroot for $srpm in $chroot\n";
	    clean_chroot($chroot)
	}
	my ($srpm_name) = $srpm =~ /(.*)-[^-]+-[^-]+\.src\.rpm$/ or next;
	my $maintainer = `rpmmon -s -p $srpm_name`;
	my $cc = "$maint{$srpm}, maintainers\@mandriva.com";
	chomp $maintainer;
	if (!$maintainer) {
		$maintainer = $cc;
		$cc = 'maintainers@mandriva.com'
	}
	#($maintainer, $cc) = ($config->{admin},'');
	print "Installing build dependencies of $srpm...\n";
	# FIXME unfortunately urpmi stalls quite often
	system(qq{sudo pkill -9 -u root -f "$todo[$i-1][1]"}) if $i - 1 >= 0;
	system(qq{sudo pkill -9 -u root -f "urpmi $urpmi_options --rrot $chroot"});
	perform_command("sudo urpmi $urpmi_options --root $chroot $dir/$srpm", 
		mail => $maintainer, 
		error => "[REBUILD] install of build dependencies of $srpm failed on $my_arch",  
		hash => "install_deps_$srpm", 
		timeout => 600, 
		freq => 1,
		cc => $cc, 
		debug_mail => $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}) } },
		log => "$local_spool/log/",
		callback => sub { 
			my ($opt, $output) = @_;
			print "Calling callback for $opt->{hash}\n" if $debug;
			my ($missing_deps, $version) = $output =~ /\(due to unsatisfied ([^[)]*)(\[.*\])?/;
			$missing_deps or return;
			my $other_maint = `rpmmon -p $missing_deps`;
			$version ||= 1;
			# remember what is needed, and do not try to recompile until it is available
			chomp $other_maint;
			print "Missing Dep: $missing_deps ($other_maint)\n";
			if ($other_maint) {
			    $opt->{mail} = $other_maint;
			    $opt->{error} = "[MISSING] $missing_deps, needed to build $srpm, is not available on $my_arch";
			}
			push @{$cache->{needed}{$srpm}}, [ $missing_deps, $version, $other_maint || $maintainer ];
		},
	) or next;
	perform_command("sudo chroot $chroot rpm -qa", 
		hash => "rpm_qa_$srpm", 
		timeout => 60, 
		debug_mail => $debug,
		log => "$local_spool/log/") or next;
	print "Copying $srpm to $chroot\n";
	perform_command("sudo cp $dir/$srpm $chroot/home/builder/rpm/SRPMS/", 
		mail => $config->{admin}, 
		error => "[REBUILD] cannot copy $srpm to $chroot", 
		debug_mail => $debug,
		hash => "copy_$srpm") or next;
	print "Compiling $srpm\n";
	#system(qq{sudo chroot $chroot /bin/su builder -c "mkdir rpm/RPMS/x86_64 rpm/RPMS/noarch"});
	if (!perform_command(qq{TMP=/home/builder/tmp/ sudo chroot $chroot /bin/su builder -c "rpm --rebuild /home/builder/rpm/SRPMS/$srpm"}, 
			mail => $maintainer, 
			error => "[REBUILD] $srpm from $distro_tag does not build correctly on $my_arch", 
			hash => "build_$srpm", 
			timeout => 18000, 
			debug_mail => $debug,
			cc => $cc, 
			log => "$local_spool/log/", 
			error_regexp => 'rror.*ailed|Bad exit status|RPM build error',
			freq => 1) && !glob "$chroot/home/builder/rpm/RPMS/*/*.rpm") {
		$cache->{failure}{$srpm} = 1;
		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", 
			mail => $maintainer, 
			error => "[REBUILD] binaries packages generated from $srpm do not install correctly", 
			hash => "binary_test_$srpm", 
			timeout => 300, 
			debug_mail => $debug,
			freq => 1, 
			error_regexp => 'unable to access',
			log => "$local_spool/log/")) {
		$cache->{failure}{$srpm} = 1;
		next
	}
	if ($debug) {
	    print "iurt: debug mode, skip other packages\n";
	    exit
	} else {
	    system("cp $chroot/home/builder/rpm/RPMS/*/*.rpm $local_spool") and print "ERROR: could not copy rpm files from $chroot/home/builder/rpm/RPMS/ to $local_spool ($!)\n";
	    process_queue()
	}
	end:
}

print "iurt: reprocess generated packages queue\n";
process_queue();

dump_cache();

print "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}) {
	system("rsync -alHPe 'ssh -c arcfour' $local_spool/log/ $config->{rsync_to}/$distro_tag/$my_arch/log/");
}

unlink $pidfile;

exit;

sub usage {
	my ($error) = @_;
	print "
	ERROR iurt: $error" if $error;
	print "
	
	usage:
	
		iurt [options] <distro version> <arch> <media>
			e.g. iurt community/2006.0 x86_64 main

		options:
			--debug: Compile one package in debug mode (do not send mail, create
				 chroot_debug directory). This mode can be used on a system
				 where a iurt is already running.
";
	exit
}

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

   dump_rpmmacros("$chroot/home/builder/.rpmmacros") or return;
   1
}

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 ];
	# 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 $dir = "$config->{local_home}/iurt/$distro_tag/$my_arch";
	opendir my $rpmdir, $dir or next;
	foreach my $rpm (readdir $rpmdir) {
		my ($rarch, $srpm) = update_srpm($dir, $rpm);
		$rarch or next;
		# recheck if the package has not been uploaded in the meantime
		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 "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) = @_;
	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);
	$arch, $srpm
}

sub dump_cache {
	my $filename = $cachefile;
	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 $my_arch || $_ eq '(none)' } @exclusive_arch or return 1; 
	my (@exclude_arch) = $hdr->queryformat('%{EXCLUDEARCH}');
	grep { $_ eq $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) = @_;
	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, %opt) = @_;
    $opt{timeout} ||= 300;
    $opt{freq} ||= 24;
    print "Timeout $opt{timeout}\n";
    # 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 "$command\n";
	if ($opt{log}) {
	    $output = `$command 2>&1 | tee $opt{log}/$opt{hash}.$run.log`;
	} else {
	    $output = `$command 2>&1`;
	}
	alarm 0;
    };
    if ($@) {
	# timed out
	die unless $@ eq "alarm\n";   # propagate unexpected errors
	return 0
    } else {
	if ($kill) {
	    $output = "Command has been killed after $opt{timeout} seconds: $command\n$output"
	} else {
	    $output = "Command failed: $command\n$output"
	}
	if (ref $opt{callback}) {
	    $opt{callback}(\%opt, $output)
	}
	if ($opt{wait_regexp} && $output =~ /$opt{wait_regexp}/) {
	    $opt{wait_callback}(\%opt, $output) if ref $opt{wait_callback};
	    print STDERR "ERROR iurt: $opt{wait_regexp} !\n";
	    sendmail($config->{admin}, '' , "$opt{hash} on $my_arch for $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 ($? || $opt{error_regexp} && $output =~ /$opt{error_regexp}/) {
	    if ($opt{mail} && $config->{sendmail}) {
		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 STDERR "\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 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}}
}