Restoring code lost in the SVN breakage from an old checkout

9 files changed, 2580 insertions, 0 deletions

diff --git a/lib/Iurt/.perl_checker b/lib/Iurt/.perl_checker
new file mode 100644
index 0000000..2326e2f
--- /dev/null
+++ b/lib/Iurt/.perl_checker
@@ -0,0 +1 @@
+Basedir ../..
diff --git a/lib/Iurt/Chroot.pm b/lib/Iurt/Chroot.pm
new file mode 100644
index 0000000..5f055fa
--- /dev/null
+++ b/lib/Iurt/Chroot.pm
@@ -0,0 +1,515 @@
+package Iurt::Chroot;
+
+use strict;
+use base qw(Exporter);
+use MDV::Distribconf::Build;
+use MDK::Common;
+use Iurt::Process qw(clean sudo);
+use Iurt::Config qw(dump_cache_par);
+use Iurt::Util qw(plog);
+use File::Temp 'mktemp';
+use File::Path 'mkpath';
+
+our @EXPORT = qw(
+    clean_chroot_tmp
+    clean_unionfs
+    clean_all_chroot_tmp
+    clean_all_unionfs
+    clean_chroot
+    dump_rpmmacros
+    add_local_user
+    create_temp_chroot
+    remove_chroot
+    create_chroot
+    create_buid_chroot
+    check_chroot
+    check_build_chroot
+);
+    
+my $sudo = '/usr/bin/sudo';
+
+=head2 clean_chroot($chroot, $run, $only_clean)
+
+Create or clean a chroot
+I<$chroot> chroot path
+I<$run> is the running environment
+I<%only_clean> only clean the chroot, do not create a new one
+Return true.
+
+=cut
+
+sub clean_chroot {
+    my ($chroot, $chroot_tar, $run, $config, $o_only_clean, $o_only_tar) = @_;
+
+    plog('DEBUG', "clean chroot");
+    if (-d $chroot && !$o_only_tar) {
+	system("$sudo umount $chroot/proc &> /dev/null");
+	system("$sudo umount $chroot/dev/pts &> /dev/null");
+	sudo($run, $config, '--rm', '-r', $chroot);
+    }
+
+    return 1 if $o_only_clean;
+
+    mkdir $chroot;
+
+    # various integrity checking
+    return 1 if $o_only_tar && -f "$chroot/home/builder/.rpmmacros" && -d "$chroot/home/builder" && -d "$chroot/proc";
+ 
+    chdir $chroot;
+
+    system($sudo, 'tar', 'xf', $chroot_tar) and create_build_chroot($chroot, $chroot_tar, $run, $config);
+
+    create_build_chroot($chroot, $chroot_tar, $run, $config) if !-d "$chroot/proc" || !-d "$chroot/home/builder";
+
+    dump_rpmmacros($run, $config, "$chroot/home/builder/.rpmmacros") or return;
+    system("$sudo mount none -t proc $chroot/proc &>/dev/null") and return;
+    system("$sudo mount none -t devpts $chroot/dev/pts &>/dev/null") and return;
+    1;
+}  
+
+sub dump_rpmmacros {
+    my ($run, $config, $file) = @_;
+    my $f;
+
+    #plog("adding rpmmacros to $file");
+
+    if (!open $f, qq(| $sudo sh -c "cat > $file")) {
+	plog("ERROR: could not open $file ($!)");
+	return 0;
+    }
+    my $packager = $run->{packager} || $config->{packager};
+
+    print $f qq(\%_topdir                \%(echo \$HOME)/rpm
+\%_tmppath               \%(echo \$HOME)/rpm/tmp/
+\%distribution           $config->{distribution}
+\%vendor                 $config->{vendor}
+\%packager               $packager);
+    # need to be root for permission
+}
+
+sub add_local_user {
+    my ($chroot_tmp, $run, $config, $luser, $uid) = @_;
+    my $program_name = $run->{program_name};
+
+    # change the builder user to the local user id
+    # FIXME it seems that unionfs does not handle well the change of the
+    #       uid of files
+    # if (system(qq|sudo chroot $chroot_tmp usermod -u $run->{uid} builder|)) {
+    
+    # this should not be necessary as the builder user is supposed to have
+    # the macros already
+
+    foreach my $p ('RPMS', 'BUILD', 'SPECS', 'SRPMS', 'SOURCES') {
+	-d "$chroot_tmp/home/builder/rpm/$p" and next;
+	sudo($run, $config, "--mkdir", "$chroot_tmp/home/builder/rpm/$p");
+    } 
+
+    dump_rpmmacros($run, $config, "$chroot_tmp/home/builder/.rpmmacros") or return;
+
+    if ($uid) {
+	if (system($sudo, 'chroot', $chroot_tmp, 'useradd', '-M', '-u', $uid, $luser) ||
+	    system("$sudo chroot $chroot_tmp id $luser >/dev/null 2>&1")) {
+	    plog('ERR', "ERROR: setting userid $uid to $luser in " .
+		"$chroot_tmp failed, checking the chroot");
+	    check_build_chroot($run->{chroot_path}, $run->{chroot_tar}, $run,
+		$config) or return;
+	}
+    } else {
+	# the program has been launch as root, setting the home to /home/root for compatibility
+	system($sudo, 'chroot', $chroot_tmp, 'usermod', '-d', "/home/$luser", '-u', $uid, '-o', '-l', $luser, 'root');
+    }
+
+    if (system(qq($sudo chroot $chroot_tmp cp -R /home/builder /home/$luser))) {
+	plog("ERROR: could not initialized $luser directory");
+	return;
+    }
+
+    if (system(qq($sudo chroot $chroot_tmp chown -R $uid /home/$luser))) {
+	die "ERROR $program_name: could not initialized $luser directory\n"; 
+    }
+
+    1;
+}
+
+sub create_temp_chroot {
+    my ($run, $config, $cache, $union_id, $chroot_tmp, $chroot_tar, $srpm) = @_;
+
+    my $home = $config->{local_home};
+    my $debug_tag = $run->{debug_tag};
+    my $unionfs_dir = $run->{unionfs_dir};
+
+    if ($run->{unionfs_tmp}) {
+	my $mount_point = "$unionfs_dir/unionfs.$run->{run}.$union_id";
+	plog(2, "cleaning temp chroot $mount_point");
+	if (!clean_mnt($run, $mount_point, $run->{verbose})) {
+	    dump_cache_par($run);
+	    die "FATAL: can't 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->{run}, $union_id);
+	$tmpfs = "$unionfs_dir/tmpfs.$run->{run}.$union_id";
+	$chroot_tmp = "$unionfs_dir/unionfs.$run->{run}.$union_id";
+
+	if (!-d $tmpfs) {
+	    if (!mkpath($tmpfs)) {
+		plog("ERROR: Could not create $tmpfs ($!)");
+		return;
+	    }
+	}
+	if (! -d $chroot_tmp) {
+	    if (!mkpath($chroot_tmp)) {
+		plog("ERROR: Could not create $chroot_tmp ($!)");
+		return;
+	    }
+	}
+	if ($cache->{no_unionfs}{$srpm}) {
+	    $run->{unionfs_tmp} = 0;
+	    clean_chroot($chroot_tmp, $chroot_tar, $run, $config);
+	} else {
+	    # if the previous package has been built without unionfs, chroot need to be cleaned
+	    if (!$run->{unionfs_tmp}) {
+		clean_chroot($chroot_tmp, $chroot_tar, $run, $config);
+	    } else {
+		# only detar the chroot if not already
+		clean_chroot($chroot_tmp, $chroot_tar, $run, $config, 0, 1);
+	    }
+	    $run->{unionfs_tmp} = 1;
+	    if (system(qq($sudo mount -t tmpfs none $tmpfs &>/dev/null))) {
+		plog("ERROR: can't mount $tmpfs ($!)"); 
+		return;
+	    }
+	    if (system(qq($sudo mount -o dirs=$tmpfs=rw:$home/chroot_$run->{distro_tag}$debug_tag=ro -t unionfs none $chroot_tmp &>/dev/null))) {
+		plog("ERROR: can't mount $tmpfs and $home/chroot_$run->{distro_tag}$debug_tag with unionfs ($!)");
+		return;
+	    }
+	    if (system("$sudo mount -t proc none $chroot_tmp/proc &>/dev/null")) {
+		plog("ERROR: can't mount /proc in chroot $chroot_tmp ($!)");
+		return;
+	    }
+	    if (!-d "$chroot_tmp/dev/pts") {
+		if (sudo($run, $config, "--mkdir", "$chroot_tmp/dev/pts")) {
+		    plog("ERROR: can't create /dev/pts in chroot $chroot_tmp ($!)");
+		    return;
+		}
+
+		if (system($sudo, "mount", "-t", "devpts", "none", "$chroot_tmp/dev/pts &>/dev/null")) {
+		    plog("ERROR: can't mount /dev/pts in the chroot $chroot_tmp ($!)");
+		    return;
+		}
+	    }
+	}
+    } else {
+	plog("Install new chroot");
+	plog('DEBUG', "... in $chroot_tmp");
+	clean_chroot($chroot_tmp, $chroot_tar, $run, $config);
+    }
+    $union_id, $chroot_tmp;
+}
+
+sub remove_chroot {
+    my ($run, $dir, $func, $prefix) = @_;
+
+    plog("Remove existing chroot");
+    plog('DEBUG', "... dir $dir all $run->{clean_all} prefix $prefix");
+
+    if ($run->{clean_all}) {
+	opendir my $chroot_dir, $dir;
+	foreach (readdir $chroot_dir) {
+	    next if !-d "$dir/$_" || /\.{1,2}/;
+	    plog("cleaning old chroot for $_ in $dir");
+	    $func->($run, "$dir/$_", $prefix);
+	}
+    } else {
+	foreach my $user (@{$run->{clean}}) {
+	    plog("cleaning old chroot for $user in $dir");
+	    $func->($run, "$dir/$user", $prefix);
+	}
+    }
+} 
+
+sub clean_mnt {
+    my ($run, $mount_point, $verbose) = @_;
+    return clean($run, $mount_point, "/sbin/fuser", "$sudo /sbin/fuser -k", $verbose);
+}
+
+sub clean_all_chroot_tmp {
+    my ($run, $chroot_dir, $prefix) = @_;
+
+    plog(1, "cleaning all old chroot remaining dir in $chroot_dir");
+
+    my $dir;
+    if (!opendir $dir, $chroot_dir) { 
+	plog("ERROR: can't open $chroot_dir ($!)");
+	return;
+    }
+    foreach (readdir($dir)) {
+	/$prefix/ or next;
+	clean_chroot_tmp($run, $chroot_dir, $_);
+    }
+    closedir $dir;
+}
+
+sub clean_unionfs {
+    my ($unionfs_dir, $_run, $r, $union_id) = @_;
+
+    -d "$unionfs_dir/unionfs.$r.$union_id" or return $union_id;
+    plog(2, "cleaning unionfs $unionfs_dir/unionfs.$r.$union_id");
+    my $nok = 1;
+    my $path = "$unionfs_dir/unionfs.$r.$union_id";
+
+    while ($nok) {
+	$nok = 0;
+	foreach my $fs ([ 'proc', 'proc' ], [ 'dev/pts', 'devpts' ]) {
+	    my ($dir, $type) = @$fs;
+	    if (-d "$path/$dir" && check_mounted("$path/$dir", $type)) {
+		plog(1, "clean_unionfs: umounting $path/$dir\n");
+		if (system("$sudo umount $path/$dir &>/dev/null")) { 
+		    plog("ERROR: could not umount $path/$dir");
+		}
+	    }
+	}
+	foreach my $t ('unionfs', 'tmpfs') {
+	    # unfortunately quite oftem the unionfs is busy and could not
+	    # be unmounted
+
+	    my $d = "$unionfs_dir/$t.$r.$union_id";
+	    if (-d $d && check_mounted($d, $t)) {
+		$nok = 1;
+		system("$sudo /sbin/fuser -k $d &> /dev/null");
+		plog(3, "umounting $d");
+		if (system(qq($sudo umount $d &> /dev/null))) {
+		    plog(2, "WARNING: could not umount $d ($!)");
+		    return $union_id + 1;
+		}
+	    }
+	}
+    }
+
+    foreach my $t ('unionfs', 'tmpfs') {
+	my $d = "$unionfs_dir/$t.$r.$union_id";
+	plog(2, "removing $d");
+	if (system($sudo, 'rm', '-rf', $d)) {
+	    plog("ERROR: removing $d failed ($!)");
+	    return $union_id + 1;
+	}
+    }
+    $union_id;
+}
+
+sub clean_chroot_tmp {
+    my ($run, $chroot_dir, $dir) = @_;
+    my $d = "$chroot_dir/$dir";
+
+    foreach my $m ('proc', 'dev/pts') {
+	if (system("$sudo umount $d/$m &>/dev/null") && $run->{verbose} > 1) { 
+	    plog("ERROR: could not umount /$m in $d/"); 
+	}
+    }
+
+    plog(1, "cleaning $d");
+    system("$sudo /sbin/fuser -k $d &> /dev/null");
+    plog(1, "removing $d");
+    system($sudo, 'rm', '-rf', $d);
+}
+
+sub check_mounted {
+    my ($mount_point, $type) = @_;
+
+    my $mount;
+    if (!open $mount, '/proc/mounts') {
+	plog("ERROR: could not open /proc/mounts");
+	return;
+    }
+    $mount_point =~ s,//+,/,g;
+    local $_;
+    while (<$mount>) {
+	return 1 if /^\w+ $mount_point $type /;
+    }
+    0;
+}
+
+sub create_build_chroot {
+    my ($chroot, $chroot_tar, $run, $config) = @_;
+    create_chroot($chroot, $chroot_tar, $run, $config,
+			{ packages => $config->{basesystem_packages} });
+}
+
+sub create_chroot {
+    my ($chroot, $chroot_tar, $run, $config, $opt) = @_;
+    my $tmp_tar = mktemp("$chroot_tar.tmp.XXXXXX");
+    my $tmp_chroot = mktemp("$chroot.tmp.XXXXXX");
+    my $rebuild;
+    my $clean = sub {
+	plog("Remove temporary chroot tarball");
+	sudo($run, $config, '--rm', '-r', $tmp_chroot, $tmp_tar);
+    };
+
+    plog('NOTIFY', "creating chroot");
+    plog('DEBUG', "... with packages " . join(', ', @{$opt->{packages}}));
+
+    if (mkdir($tmp_chroot) && (!-f $chroot_tar || link $chroot_tar, $tmp_tar)) {
+	if (!-f $chroot_tar) {
+	    plog("rebuild chroot tarball");
+	    $rebuild = 1;
+	    if (!build_chroot($run, $config, $tmp_chroot, $chroot_tar, $opt)) {
+		$clean->();
+		return;
+	    }
+	} else {
+	    plog('DEBUG', "decompressing /var/log/qa from $chroot_tar in $tmp_chroot");
+	    system($sudo, 'tar', 'xf', $chroot_tar, '-C', $tmp_chroot, "./var/log/qa");
+
+	    my $qa;
+	    if (open $qa, "$tmp_chroot/var/log/qa") {
+		my $ok;
+		my $f;
+		while (!$ok && ($f = <$qa>)) {
+		    chomp $f;
+		    if (!-f "$config->{basesystem_media_root}/media/$config->{basesystem_media}/$f") {
+			plog('DEBUG', "$f has changed");
+			plog('NOTIFY', "Rebuilding chroot tarball");
+
+			$rebuild = 1;
+			sudo($run, $config, '--rm', '-r', $tmp_chroot);
+			mkdir $tmp_chroot;
+			if (!build_chroot($run, $config, $tmp_chroot, $chroot_tar, $opt)) { 
+			    $clean->();
+			    return;
+			}
+			$ok = 1;
+		    }
+		}
+	    } else {
+		plog('DEBUG', "can't open $tmp_chroot/var/log/qa");
+		plog('ERR', "can't check chroot, recreating");
+
+		if (!build_chroot($run, $config, $tmp_chroot, $chroot_tar, $opt)) {
+		    $clean->();       
+		    return;
+		}
+	    }
+	}
+	link $tmp_tar, $chroot_tar;
+    } else {
+	die "FATAL: could not initialize chroot ($!)\n";
+    }
+
+    if (!-d $chroot || $rebuild) {
+	plog('DEBUG', "recreate chroot $chroot");
+	plog('NOTIFY', "recreate chroot");
+	my $urpmi = $run->{urpmi};
+	$urpmi->clean_urpmi_process($chroot);
+	sudo($run, $config, '--rm', '-r', $chroot, $tmp_tar);
+	mkdir_p $chroot;
+	system($sudo, 'tar', 'xf', $chroot_tar, '-C', $chroot);
+	plog('NOTIFY', "chroot recreated in $chroot_tar (live in $chroot)");
+    }
+    
+    $clean->();
+
+    1;
+}
+
+sub build_chroot {
+    my ($run, $config, $tmp_chroot, $chroot_tar, $opt) = @_;
+
+    plog('DEBUG', "building the chroot with "
+			. join(', ', @{$opt->{packages}}));
+
+    sudo($run, $config, "--mkdir", "-p", "$tmp_chroot/dev/pts",
+		"$tmp_chroot/etc/sysconfig", "$tmp_chroot/proc");
+
+    # create empty files
+    foreach ('/etc/ld.so.conf', '/etc/mtab') {
+	system($sudo, 'touch', "$tmp_chroot$_");
+    }
+
+    system($sudo, 'mknod', "$tmp_chroot/dev/null", 'c', 1, 3);
+    system("$sudo chmod a+rw $tmp_chroot/dev/null");
+
+    #system(qq($sudo sh -c "echo 127.0.0.1 localhost > $tmp_chroot/etc/hosts"));
+    # warly some program perform a gethostbyname(hostname) and in the cluster the 
+    # name are not resolved via DNS but via /etc/hosts
+    sudo($run, $config, '--cp', "/etc/hosts", "$tmp_chroot/etc/");
+    sudo($run, $config, '--cp', "/etc/resolv.conf", "$tmp_chroot/etc/");
+
+    sudo($run, $config, "--initdb", $tmp_chroot);
+    # install chroot
+    my $urpmi = $run->{urpmi};
+    $urpmi->set_command($tmp_chroot);
+
+    # 20060826 warly urpmi --root does not work properly
+    $urpmi->install_packages(
+	"chroot",
+	$tmp_chroot,
+	$run->{local_spool},
+	{},
+	'initialize',
+	"[ADMIN] creation of initial chroot failed on $run->{my_arch}",
+	{ maintainer => $config->{admin} },
+	@{$opt->{packages}}
+    );
+
+    if (-f "$tmp_chroot/bin/rpm") {
+	system($sudo, 'sh', '-c', "chroot $tmp_chroot rpm -qa --qf '\%{NAME}-\%{VERSION}-\%{RELEASE}.\%{ARCH}.rpm\n' > $tmp_chroot/var/log/qa");
+	#
+	# CM: Choose a sub-500 uid to prevent collison with $luser
+	#
+	system($sudo, 'chroot', $tmp_chroot, 'adduser', '-o', '--uid', 499, 'builder');
+	sudo($run, $config, "--mkdir", "-p", "$tmp_chroot/home/builder/rpm");
+	foreach my $p (qw(RPMS BUILD SPECS SRPMS SOURCES tmp)) {
+	    -d "$tmp_chroot/home/builder/rpm/$p" and next;
+	    sudo($run, $config, "--mkdir", "$tmp_chroot/home/builder/rpm/$p");
+	}
+	system($sudo, 'chown', '-R', 499, "$tmp_chroot/home/builder");
+	sudo($run, $config, "--rm", "$tmp_chroot/var/lib/rpm/__db*");
+	return !system($sudo, 'tar', 'czf', $chroot_tar, '-C', $tmp_chroot, '.');
+    }
+}
+
+sub check_build_chroot {
+    my ($chroot, $chroot_tar, $run, $config) = @_;
+
+    check_chroot($chroot, $chroot_tar, $run, $config,
+		{ packages => $config->{basesystem_packages} });
+}
+
+sub check_chroot {
+    my ($chroot, $chroot_tar, $run, $config, $opt) = @_;
+
+    plog('DEBUG', "checking basesystem tar");
+    
+    my (@stat) = stat $chroot_tar;
+
+    if (time -$stat[9] > 604800) {
+	plog('WARN', "chroot tarball too old, force rebuild");
+	sudo($run, $config, '--rm', '-r', $chroot, $chroot_tar);
+    }
+    create_chroot($chroot, $chroot_tar, $run, $config, $opt);
+}
+
+sub clean_all_unionfs {
+    my ($run, $unionfs_dir) = @_;
+
+    plog(2, "Cleaning old unionfs remaining dir in $unionfs_dir");
+
+    my $dir;
+    if (!opendir $dir, $unionfs_dir) {
+	plog(0, "FATAL could not open $unionfs_dir ($!)");
+	return;
+    }
+
+    foreach (readdir $dir) {
+	/unionfs\.((?:0\.)?\d+)\.(\d*)$/ or next;
+	clean_unionfs($unionfs_dir, $run, $1, $2);
+    }
+
+    closedir $dir;
+}
+
+
+1;
diff --git a/lib/Iurt/Config.pm b/lib/Iurt/Config.pm
new file mode 100644
index 0000000..9efcd24
--- /dev/null
+++ b/lib/Iurt/Config.pm
@@ -0,0 +1,304 @@
+package Iurt::Config;
+
+use base qw(Exporter);
+use RPM4::Header;
+use Data::Dumper;
+use MDK::Common;
+use Iurt::Util qw(plog);
+use strict;
+
+our @EXPORT = qw(
+    config_usage
+    config_init
+    get_date
+    dump_cache
+    dump_cache_par
+    init_cache
+    get_maint
+    get_date
+    get_prefix
+    get_repsys_conf
+    check_arch
+    check_noarch
+    get_package_prefix
+    %arch_comp
+);
+
+our %arch_comp = (
+    'i586' => { 'i386' => 1, 'i486' => 1, 'i586' => 1 },
+    'i686' => { 'i386' => 1, 'i486' => 1, 'i586' => 1, 'i686' => 1 },
+    'x86_64' => { 'x86_64' => 1 },
+    'ppc' => { 'ppc' => 1 },
+    'ppc64' => { 'ppc' => 1, 'ppc64' => 1 },
+);
+
+
+=head2 config_usage($config_usage, $config)
+
+Create an instance of a class at runtime.
+I<$config_usage> is the configuration help,
+I<%config> is the current configuration values
+Return true.
+
+=cut
+
+sub config_usage {
+    my ($config_usage, $config) = @_;
+	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";
+}
+
+=head2 config_init($config_usage, $config, $rung)
+
+Create an instance of a class at runtime.
+I<$config_usage> is the configuration help,
+I<%config> is the current configuration values
+I<%run> is the current running options
+Return true.
+
+=cut
+
+sub config_init {
+    my ($config_usage, $config, $run) = @_;
+    
+    foreach my $k (keys %$config_usage) {
+	ref $config_usage->{$k}{default} eq 'CODE' and next;
+	$config->{$k} ||= $run->{config}{$k} || $config_usage->{$k}{default};
+    }
+    # warly 20061107
+    # we need to have all the default initialised before calling functions, so this
+    # cannot be done in the same loop
+    foreach my $k (keys %$config_usage) {
+	ref $config_usage->{$k}{default} eq 'CODE' or next;
+	my $a = $config_usage->{$k}{default}($config, $run);
+	$config->{$k} ||= $run->{config}{$k} || $a;
+    }
+}
+
+
+=head2 get_date($shift)
+
+Create a string based on the current date and time
+I<$shift> number of second to shift the date
+Return date-time and date
+
+=cut
+
+sub get_date {
+    my ($o_shift) = @_;
+    my ($sec, $min, $hour, $mday, $mon, $year) = gmtime(time() - $o_shift);
+    $year += 1900;
+    my $fulldate = sprintf "%4d%02d%02d%02d%02d%02d", $year, $mon+1, $mday, $hour, $min, $sec;
+    my $daydate = sprintf "%4d%02d%02d", $year, $mon+1, $mday;
+    $fulldate, $daydate;
+}
+
+sub get_prefix {
+    my ($luser) = @_;
+    my $hostname = `hostname`;
+    my ($fulldate) = get_date();
+    my ($host) = $hostname =~ /([^.]*)/;
+    join('.', $fulldate, $luser, $host, $$) . '_';
+}
+
+sub get_package_prefix {
+    my ($rpm) = @_;
+    my ($prefix1) = $rpm =~ /^(\d{14}\.\w+\.\w+\.\d+)_/;
+    my ($prefix2) = $rpm =~ /^(\@\d+:)/;
+    "$prefix1$prefix2";
+}
+=head2 init_cache($run, $config)
+
+Create a string based on the current date and time
+I<%run> is the current running options
+I<%config> is the current configuration values
+Initialize the cache
+
+=cut
+
+sub init_cache {
+    my ($run, $config, $empty) = @_;
+    my $program_name = $run->{program_name};
+    my $cachefile = "$config->{cache_home}/$program_name.cache";
+    my $cache;
+    if (-f $cachefile) {
+	$run->{LOG}->("$program_name: loading cache file $cachefile\n");
+	$cache = eval(cat_($cachefile)) or print "FATAL $program_name: could not load cache $cachefile ($!)\n";
+    } else {
+	$cache = $empty;
+    }
+    $run->{cachefile} = $cachefile;
+    $run->{cache} = $cache;
+    $cache;
+}
+
+=head2 dump_cache($run, $config)
+
+Create a string based on the current date and time
+I<%run> is the current running options
+Dump the cache
+
+=cut
+
+sub dump_cache {
+    my ($run) = @_;
+    my $program_name = $run->{program_name};
+    my $filename = $run->{cachefile};
+    my $cache = $run->{cache};
+    my $daydate = $run->{daydate};
+    open my $file, ">$filename.tmp.$daydate" or die "FATAL $program_name dump_cache: cannot open $filename.tmp";
+    $Data::Dumper::Indent = 1;
+    $Data::Dumper::Terse = 1;
+    print $file Data::Dumper->Dump([ $cache ], [ "cache" ]);
+    # flock does not work on network files and lockf seems to fail too
+    $run->{LOG}->("$program_name: locking to dump the cache in $filename\n");
+    if (-f "$filename.lock") {
+	$run->{LOG}->("ERROR iurt: manual file lock exist, do not save the cache\n");
+    } else {
+	open my $lock, ">$filename.lock";
+	print $lock $$;
+	close $lock;
+	unlink $filename;
+	link "$filename.tmp.$daydate", $filename;
+	unlink "$filename.lock";
+    }
+}
+
+# FIXME need to merge with the simpler dump_cache
+sub dump_cache_par {
+    my ($run) = @_;
+    my $filename = $run->{cachefile};
+    my $cache = $run->{cache};
+    my $daydate = $run->{daydate};
+
+    # 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->{use_cache};
+    open my $file, ">$filename.tmp.$daydate" or die "FATAL iurt dump_cache: cannot open $filename.tmp";
+    if ($run->{concurrent_run}) {
+	plog('DEBUG', "merging cache");
+	my $old_cache;
+	if (-f $filename) {
+	    plog('DEBUG', "loading cache file $filename");
+	    $old_cache = eval(cat_($filename));
+
+	    foreach my $k ('rpm_srpm', 'failure', 'no_unionfs', 'queue', 'needed', 'warning', 'buildrequires') {
+		foreach my $rpm (%{$old_cache->{$k}}) {
+		    $cache->{$k}{$rpm} ||= $old_cache->{$k}{$rpm};
+		}
+	    }
+	}
+	#  $cache = { rpm_srpm => {}, failure => {}, queue => {}, warning => {}, run => 1, needed => {}, no_unionfs => {} }
+    }
+    $Data::Dumper::Indent = 1;
+    $Data::Dumper::Terse = 1;
+    print $file Data::Dumper->Dump([ $cache ], [ "cache" ]);
+    # flock does not work on network files and lockf seems to fail too
+    my $status = 1; #File::lockf::lock($file);
+    if (!$status) {
+	unlink $filename;
+	link "$filename.tmp.$daydate", $filename;
+	File::lockf::ulock($file);
+    } else {
+	plog('WARN', "WARNING: locking the cache file $filename failed (status $status $!), try to lock manually");
+	if (-f "$filename.lock") {
+	    plog('ERR', "ERROR: manual file lock exist, do not save the cache");
+	} else {
+	    open my $lock, ">$filename.lock";
+	    print $lock $$;
+	    close $lock;
+	    unlink $filename;
+	    link "$filename.tmp.$daydate", $filename;
+	    unlink "$filename.lock";
+	}
+    }
+}
+
+sub get_maint {
+    my ($run, $srpm) = @_;
+    my ($srpm_name) = $srpm =~ /(.*)-[^-]+-[^-]+\.[^.]+$/;
+    $srpm_name ||= $srpm;
+    if ($run->{maint}{$srpm}) {
+	return $run->{maint}{$srpm}, $srpm_name;
+    }
+    my $maint = `rpmmon -s -p "$srpm_name"`;
+    chomp $maint;
+    $run->{maint}{$srpm} = $maint;
+    $maint, $srpm_name;
+}
+
+sub get_repsys_conf {
+    my ($file) = @_;
+    open my $fh, $file or return;
+    my %mail;
+    my $ok;
+    local $_;
+    while (<$fh>) {
+	if (/\[users\]/) {
+	    $ok = 1;
+	} elsif (/\[/) {
+	    $ok = 0;
+	}
+	$ok or next;
+	my ($user, $mail) = split " = ";
+	chomp $mail;
+	$mail{$user} = $mail;
+	$mail or next;
+    }
+    \%mail;
+}
+
+sub check_noarch {
+    my ($rpm) = @_;
+    my $hdr = RPM4::Header->new($rpm);
+
+    # Stupid rpm doesn't return an empty list so we must check for (none)
+
+    my ($build_archs) = $hdr->queryformat('%{BUILDARCHS}');
+
+    if ($build_archs ne '(none)') {
+	($build_archs) = $hdr->queryformat('[%{BUILDARCHS} ]');
+	my @list = split ' ', $build_archs;
+	return 1 if member('noarch', @list);
+    }
+
+    return 0;
+}
+
+sub check_arch {
+    my ($rpm, $arch) = @_;
+    my $hdr = RPM4::Header->new($rpm);
+
+    # Stupid rpm doesn't return an empty list so we must check for (none)
+
+    my ($exclusive_arch) = $hdr->queryformat('%{EXCLUSIVEARCH}');
+
+    if ($exclusive_arch ne '(none)') {
+	($exclusive_arch) = $hdr->queryformat('[%{EXCLUSIVEARCH} ]');
+	my @list = split ' ', $exclusive_arch;
+	return 0 unless any { $arch_comp{$arch}{$_} } @list;
+    }
+
+    my ($exclude_arch) = $hdr->queryformat('[%{EXCLUDEARCH} ]');
+
+    if ($exclude_arch ne '(none)') {
+	($exclude_arch) = $hdr->queryformat('[%{EXCLUDEARCH} ]');
+	my @list = split ' ', $exclude_arch;
+	return 0 if member($arch, @list);
+    }
+
+    return 1;
+}
+
+1;
diff --git a/lib/Iurt/DKMS.pm b/lib/Iurt/DKMS.pm
new file mode 100644
index 0000000..5ab46c8
--- /dev/null
+++ b/lib/Iurt/DKMS.pm
@@ -0,0 +1,318 @@
+package Iurt::DKMS;
+
+use strict;
+use base qw(Exporter);
+use MDV::Distribconf::Build;
+use Iurt::Chroot qw(clean_chroot add_local_user dump_rpmmacros);
+use Iurt::Config qw(get_maint get_prefix dump_cache init_cache);
+use File::NCopy qw(copy);
+use Iurt::Process qw(sudo);
+use Iurt::Util qw(plog);
+use RPM4::Header;
+use MDK::Common;
+
+our @EXPORT = qw(
+	search_dkms
+	dkms_compile
+);
+
+sub new {
+    my ($class, %opt) = @_;
+    my $self = bless {
+        config  => $opt{config},
+        run => $opt{run},
+    }, $class;
+
+    $self;
+}
+
+=head2 search_dkms($run, $config)
+
+Search for dkms packages which needs to be recompiled for new kernel
+I<$run> is the running environment
+I<%config> is the current configuration values
+Return true.
+
+=cut
+
+sub search_dkms {
+    my ($self) = @_;
+    my $config = $self->{config};
+    my $run = $self->{run};
+    my $arch = $run->{my_arch};
+    my $root = $config->{repository};
+    my $distro = $run->{distro};
+    my $cache = $run->{cache};
+    my $path = "$root/$distro/$arch";
+    if (!-d $path) {
+	plog('ERR', "ERROR: $path is not a directory");
+	return;
+    }
+    my $distrib = MDV::Distribconf::Build->new($path);
+    plog("getting media config from $path");
+    if (!$distrib->loadtree) {
+	plog('ERR', "ERROR: $path does not seem to be a distribution tree");
+	return;
+    }
+    $distrib->parse_mediacfg;
+    my %dkms;
+    my @kernel;
+    my %modules;
+    my %kernel_source;
+    foreach my $media ($distrib->listmedia) {
+	$media =~ /(SRPMS|debug_)/ and next;
+	my $path = $distrib->getfullpath($media, 'path');
+	my $media_ok = $run->{dkms}{media} ? $media =~ /$run->{dkms}{media}/ : 1;
+	my $kmedia_ok = $run->{dkms}{kmedia} ? $media =~ /$run->{dkms}{kmedia}/ : 1;
+	plog("searching in $path");
+	opendir my $rpmdh, $path;
+	foreach my $rpm (readdir $rpmdh) {
+	    if ($rpm =~ /^dkms-(.*)-([^-]+-[^-]+)\.[^.]+\.rpm/) {
+		# we only check for kernel or modules in this media
+		$media_ok or next;
+		my $hdr = RPM4::Header->new("$path/$rpm");
+		my $files = $hdr->queryformat('[%{FILENAMES} ])');
+		my ($name, $version) = ($1, $2);
+		my ($modulesourcedir) = $files =~ m, /usr/src/([^/ ]+),;
+		my $script = $hdr->queryformat('%{POSTIN})');
+		my ($realversion) = $script =~ / -v (\S+)/;
+		plog('NOTIFY', "dkms $name version $version source $modulesourcedir realversion $realversion");
+		push @{$dkms{$media}}, [ $name, $version, $modulesourcedir, $realversion, "$path/$rpm" ];
+	    } elsif ($rpm =~ /^kernel-((?:[^-]+-)?[^-]+.*)-[^-]+-[^-]+\.[^.]+\.rpm/ && $rpm !~ /win4lin|latest|debug|stripped|BOOT|xen|doc/) {
+		# we do not check for kernel in this media
+		$kmedia_ok or next;
+		my $hdr = RPM4::Header->new("$path/$rpm");
+		my $files = $hdr->queryformat('[%{FILENAMES} ])');
+		my $version = $1;
+		if ($version =~ /(.*)source-(.*)/) {
+		    my $source = "$1$2";
+		    my ($sourcedir) = $files =~ m, /usr/src/([^/ ]+),;
+		    plog('NOTIFY', "kernel source $version ($source sourcedir $sourcedir)");
+		    $kernel_source{$source} = [ $version, $sourcedir ];
+		} else {
+		    my ($modulesdir) = $files =~ m, /lib/modules/([^/ ]+),;
+		    plog('NOTIFY', "kernel $version (modules dir $modulesdir)");
+		    push @kernel, [ $version, $modulesdir ];
+		}
+	    } elsif ($rpm =~ /^(.*)-kernel-([^-]+-[^-]+.*)-([^-]+-[^-]+)\.[^.]+\.rpm$/) {
+		plog('NOTIFY', "modules $1 version $3 for kernel $2");
+		# module version kernel
+		$modules{$1}{$3}{$2} = 1;
+	    }
+	}
+    }
+    my $nb;
+    foreach my $media (keys %dkms) {
+	foreach my $dkms (@{$dkms{$media}}) {
+	    my ($module, $version, $modulesourcedir, $realversion, $file) = @$dkms;
+	    foreach my $k (@kernel) {
+		my ($kernel, $modulesdir) = @$k;
+		plog("checking $module-kernel-$modulesdir-$realversion");
+		next if $cache->{dkms}{"$module-kernel-$modulesdir-$realversion"} && !$run->{ignore_failure};
+		if (!$modules{$module}{$version}{$modulesdir}) {
+		    my ($name, $v) = $kernel =~ /^([^-]+)-.*-(2\..*)/;
+		    my $source = "$name-$v";
+		    if (!$kernel_source{$source}) {
+			my ($name) = $kernel =~ /(2\..*)/;
+			plog('ERR', "ERROR: no source for kernel $kernel (source $source), testing $name");
+			$source = $name;
+			if (!$kernel_source{$source}) {
+			    my $name = $kernel;
+			    plog('ERR', "ERROR: no source for kernel $kernel (source $source), testing $name");
+			    $source = $name;
+			    if (!$kernel_source{$source}) {
+				plog('ERR', "ERROR: no source for kernel $kernel (source $source), ignoring");
+				next;
+			    }
+			}
+		    }
+		    plog("dkms module $module version $version should be compiled for kernel $kernel ($source)");
+		    $nb++;
+		    push @{$run->{dkms_todo}}, [ $module, $version, $modulesourcedir, $realversion, $file, $kernel, $modulesdir, @{$kernel_source{$source}}, $media ];
+		}
+		$modules{$module}{$version}{$modulesdir}++;
+	    }
+	}
+    }
+    foreach my $module (keys %modules) {
+	foreach my $version (keys %{$modules{$module}}) {
+	    foreach my $modulesdir (keys %{$modules{$module}{$version}}) {
+		next if $modules{$module}{$version}{$modulesdir} < 2;
+		plog('WARN', "dkms module $module version $version for kernel $modulesdir is obsolete");
+		push @{$run->{dkms_obsolete}}, "$module-kernel-$modulesdir-$version";
+	    }
+	}
+    }
+    $nb;
+}
+
+=head2 dkms_compile($class, $local_spool, $done)
+
+Compile the dkms against the various provided kernel
+Return true.
+
+=cut
+
+sub dkms_compile {
+    my ($self, $local_spool, $done) = @_;
+    my $config = $self->{config};
+    my $run = $self->{run};
+    my $urpmi = $run->{urpmi};
+    # For dkms build, the chroot is only installed once and the all the modules are recompiled 
+    my $chroot_tmp = $run->{chroot_tmp};
+    my $chroot_tar = $run->{chroot_tar};
+    my $cache = $run->{cache};
+    my $luser = $run->{user};
+    my $to_compile = $run->{to_compile};
+
+    plog("building chroot: $chroot_tmp");
+    clean_chroot($chroot_tmp, $chroot_tar, $run, $config);
+    my %installed;
+    # initialize urpmi command
+    $urpmi->urpmi_command($chroot_tmp, $luser);
+    # also add macros for root
+    add_local_user($chroot_tmp, $run, $config, $luser, $run->{uid});
+
+    if (!dump_rpmmacros($run, $config, "$chroot_tmp/home/$luser/.rpmmacros") || !dump_rpmmacros($run, $config, "$chroot_tmp/root/.rpmmacros")) {
+	plog('ERR', "ERROR: adding rpmmacros failed");
+	return;
+    }
+
+    my $kerver = `uname -r`;
+    chomp $kerver;
+
+    my $dkms_spool = "$local_spool/dkms/";
+    -d $dkms_spool or mkdir $dkms_spool;
+
+    for (my $i; $i < @{$run->{dkms_todo}}; $i++) {
+	my ($name, $version, $_modulesourcedir, $realversion, $file, $kernel, $modulesdir, $source, $sourcedir, $media) = @{$run->{dkms_todo}[$i]};
+	$done++;
+
+	plog("dkms modules $name version $version for kernel $kernel [$done/$to_compile]");
+
+	# install kernel and dkms if not already installed
+	my $ok = 1;
+        # some of the dkms modules does not handle correclty the -k option and use uname -r to
+	# find kernel modules dir.
+	# FIXME must send a mail to the maintainer for that problem
+	# try to workarround with a symlink
+	if ($kerver ne $modulesdir) {
+	    if (-e "$chroot_tmp/lib/modules/$kerver") {
+		system("sudo mv $chroot_tmp/lib/modules/$kerver $chroot_tmp/lib/modules/$kerver.tmp");
+	    }
+	    if (system("sudo ln -sf $modulesdir $chroot_tmp/lib/modules/$kerver")) {
+		plog('ERR', "ERROR: creating a link from $chroot_tmp/lib/modules/$modulesdir to $kerver failed ($!)");
+		next;
+	    }
+	}
+	foreach my $pkg ("kernel-$source", "dkms", "kernel-$kernel", $file) {
+	    my $pkgname = basename($pkg);
+	    if ($run->{chrooted_urpmi} && -f $pkg) {
+		copy $pkg, "$chroot_tmp/tmp/";
+		$pkg = "/tmp/$pkgname";
+	    }
+	    if (!$installed{$pkg}) {
+		plog('DEBUG', "install package: $pkg");
+		if (!$urpmi->install_packages("dkms-$name-$version", $chroot_tmp, $local_spool, {}, "dkms_$pkgname", "[DKMS] package $pkg installation error", { maintainer => $config->{admin} }, $pkg)) {
+		    plog('ERR', "ERROR: error installing package $pkg");
+		    $ok = 0;
+		    last;
+		}
+		$installed{$pkg} = 1;
+	    }
+	    # recreate the appropriate kernel source link
+	}
+	$ok or next;
+
+	plog('DEBUG', "symlink from /lib/modules/$modulesdir/build to /usr/src/$sourcedir");
+
+	if (system("sudo ln -sf /usr/src/$sourcedir $chroot_tmp/lib/modules/$modulesdir/build")) {
+	    plog('ERR', "linking failed ($!)");
+	    next;
+	}
+	# seems needed for some kernel
+	system("cd $chroot_tmp/usr/src/$sourcedir && sudo make prepare");
+	# If the dkms packages get installed, the modules is correclty built
+	# but if we just compile it for a new kernel, we need to rebuild it manually
+
+	foreach my $cmd ('add', 'build') {
+	    my $command = "TMP=/home/$luser/tmp/ sudo chroot $chroot_tmp /usr/sbin/dkms $cmd -m $name -v $realversion --rpm_safe_upgrade -k $modulesdir --kernelsourcedir=/usr/src/$sourcedir";
+	    plog('DEBUG', "execute: $command");
+	    system($command);
+	}
+
+	# now need to move dkms build if it wrongly assume a build for the running kernel
+	plog("search module in /var/lib/dkms/$name/$version/$kerver/");
+	if (-d "$chroot_tmp/var/lib/dkms/$name/$version/$kerver/") {
+	    system("sudo mv $chroot_tmp/var/lib/dkms/$name/$realversion/$kerver/ $chroot_tmp/var/lib/dkms/$name/$realversion/$modulesdir/");
+	}
+	$cache->{dkms}{"$name-kernel-$modulesdir-$realversion"} = 1;
+	if (system("sudo chroot $chroot_tmp /usr/sbin/dkms mkrpm -m $name -v $realversion --rpm_safe_upgrade -k $modulesdir")) {
+	    plog('FAIL', "build failed ($!)");
+	    next;
+	}
+
+	plog('OK', "build succesful, copy packages to $dkms_spool/$media");
+
+	-d "$dkms_spool/$media" or mkdir_p "$dkms_spool/$media";
+
+	system("cp $chroot_tmp/home/$luser/rpm/RPMS/*/*.rpm $dkms_spool/$media/ &>/dev/null") && system("cp $chroot_tmp/usr/src/rpm/RPMS/*/*.rpm $dkms_spool/$media/ &>/dev/null") and $run->{LOG}->("ERROR: could not copy dkms packages from $chroot_tmp/usr/src/rpm/RPMS/*/*.rpm or $chroot_tmp/home/$luser/rpm/RPMS/*/*.rpm to $dkms_spool/$media ($!)\n");
+	!sudo($run, $config, '--rm', "$chroot_tmp/home/$luser/rpm/RPMS/*/*.rpm") || !sudo($run, $config, '--rm', "$chroot_tmp/usr/src/rpm/RPMS/*/*.rpm") and $run->{LOG}->("ERROR: could not delete dkms packages from $chroot_tmp/usr/src/rpm/RPMS/*/*.rpm or $chroot_tmp/home/$luser/rpm/RPMS/*/*.rpm ($!)\n");
+
+	if ($kerver ne $modulesdir) {
+	    system("sudo rm -f $kerver $chroot_tmp/lib/modules/$modulesdir");
+	    if (-e "$chroot_tmp/lib/modules/$kerver.tmp") {
+		system("sudo mv $chroot_tmp/lib/modules/$kerver.tmp $chroot_tmp/lib/modules/$kerver");
+	    }
+	}
+	process_dkms_queue($self, 0, 0, $media, "$dkms_spool/$media");
+	# compile dkms modules
+    }
+    dump_cache($run);
+    $done;
+}  
+# FIXME will replace the iurt2 process_qeue when youri-queue is active
+sub process_dkms_queue {
+    my ($self, $wrong_rpm, $quiet, $media, $dir) = @_;
+    my $run = $self->{run};
+    return if !$run->{upload} && $quiet;
+    my $config = $self->{config};
+    my $cache = $run->{cache};
+    $media ||= $run->{media};
+    my $urpmi = $run->{urpmi};
+
+    $dir ||= "$config->{local_upload}/iurt/$run->{distro_tag}/$run->{my_arch}/$media}/";
+
+    plog("processing $dir");
+    opendir my $rpmdir, $dir or return;
+    # get a new prefix for each package so that they will not be all rejected if only one is wrong
+    my $prefix = get_prefix('iurt');
+    foreach my $rpm (readdir $rpmdir) {
+	my ($rarch, $srpm) = $urpmi->update_srpm($dir, $rpm, $wrong_rpm);
+	$rarch or next;
+	plog('DEBUG', $rpm);
+	next if !$run->{upload};
+
+	plog("copy $rpm to $config->{upload_queue}/$run->{distro}/$media/");
+
+	# recheck if the package has not been uploaded in the meantime
+	my $rpms_dir = "$config->{repository}/$run->{distro}/$run->{my_arch}/media/$media/";
+	if (! -f "$rpms_dir/$rpm") {
+	    my $err = system("/usr/bin/scp", "$dir/$rpm", $config->{upload_queue} . "/$run->{distro}/$media/$prefix$rpm");
+	    # try to keep the opportunity to prevent disk full "
+	    if ($err) {
+		#$run->{LOG}->("ERROR process_queue: cannot copy $dir/$rpm to ", $config->{upload_queue}, "/$run->{distro}/$media/$prefix$rpm ($!)\n");
+		next;
+	    }
+	}
+	if ($run->{upload_source}) {
+	    #should not be necessary
+	}
+	# should not be necessary to use sudo
+	sudo($run, $config, '--rm', "$dir/$rpm");
+	$cache->{queue}{$srpm} = 1;
+    }
+    closedir $rpmdir;
+}
+
+1;
diff --git a/lib/Iurt/File.pm b/lib/Iurt/File.pm
new file mode 100644
index 0000000..ba5f718
--- /dev/null
+++ b/lib/Iurt/File.pm
@@ -0,0 +1,68 @@
+package Iurt::File;
+
+use base qw(Exporter);
+use Iurt::Util qw(plog);
+use strict;
+
+our @EXPORT = qw(
+    check_upload_tree 
+);
+
+=head2 config_usage($config_usage, $config)
+
+Create an instance of a class at runtime.
+I<$config_usage> is the configuration help,
+I<%config> is the current configuration values
+Return true.
+
+=cut
+
+sub check_upload_tree {
+    my ($_run, $todo, $func, $post) = @_;
+
+    # Squash double slashes for cosmetics
+    $todo =~ s!/+!/!g;
+
+    opendir my $dir, $todo;
+    plog('INFO', "check dir: $todo");
+
+    foreach my $f (readdir $dir) {
+	$f =~ /^\.{1,2}$/ and next;
+	if (-d "$todo/$f") {
+	    plog('DEBUG', "checking target $todo/$f");
+	    opendir my $target_dir, "$todo/$f";
+
+	    foreach my $m (readdir $target_dir) {
+		$m =~ /^\.{1,2}$/ and next;
+		if (-d "$todo/$f/$m") {
+		    plog('DEBUG', "checking media $todo/$f/$m");
+		    opendir my $media_dir, "$todo/$f/$m";
+
+		    foreach my $s (readdir $media_dir) {
+			$s =~ /^\.{1,2}$/ and next;
+			if (-d "$todo/$f/$m/$s") {
+			    if ($func) {
+				opendir my $submedia_dir, "$todo/$f/$m/$s";
+				foreach my $r (readdir $submedia_dir) {
+				    $r =~ /^\.{1,2}$/ and next;
+				    $func->($todo, $f, $m, $s, $r);
+				}
+			    }
+			    # cleaning
+			    if ($post) {
+				opendir my $submedia_dir, "$todo/$f/$m/$s";
+				foreach my $r (readdir $submedia_dir) {
+				    $r =~ /^\.{1,2}$/ and next;
+				    $post->($todo, $f, $m, $s, $r);
+				}
+			    }
+			} else {
+			    # may need to check also here for old target
+			}
+		    }
+		}
+	    }
+	}
+    }
+}
+ 
diff --git a/lib/Iurt/Mail.pm b/lib/Iurt/Mail.pm
new file mode 100644
index 0000000..b805db2
--- /dev/null
+++ b/lib/Iurt/Mail.pm
@@ -0,0 +1,27 @@
+package Iurt::Mail;
+
+use strict;
+use MIME::Words qw(encode_mimewords);
+use base qw(Exporter);
+
+our @EXPORT = qw(
+    sendmail
+);
+
+sub sendmail {
+	my ($to, $cc, $subject, $text, $from, $debug) = @_;
+	do { print "Cannot find sender-email-address [$to]\n"; return } unless defined($to);
+	my $MAIL;
+	if (!$debug) { open $MAIL,  "| /usr/sbin/sendmail -t" or return } else { open $MAIL,  ">&STDOUT" or return }
+	my $sender = encode_mimewords($to);
+	$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);
+}
+
+1
diff --git a/lib/Iurt/Process.pm b/lib/Iurt/Process.pm
new file mode 100644
index 0000000..6982a65
--- /dev/null
+++ b/lib/Iurt/Process.pm
@@ -0,0 +1,355 @@
+package Iurt::Process;
+
+use strict;
+use base qw(Exporter);
+use MDK::Common;
+use Filesys::Df qw(df);
+use Iurt::Mail qw(sendmail);
+use Iurt::Config qw(dump_cache_par);
+use Iurt::Util qw(plog);
+use POSIX ":sys_wait_h";
+
+our @EXPORT = qw(
+    kill_for_good
+    clean_process
+    check_pid
+    clean
+    perform_command
+    sudo
+);
+
+=head2 config_usage($program_name, $run)
+
+Check that there is no other program running and create a pidfile lock
+I<$run> current running options
+Return true.
+
+=cut
+
+# CM: this actually doesn't offer race-free locking, a better system
+#     should be designed
+
+sub check_pid {
+    my ($run) = @_;
+
+    my $pidfile = "$run->{pidfile_home}/$run->{pidfile}";
+
+    # Squash double slashes for cosmetics
+    $pidfile =~ s!/+!/!g;
+
+    plog('DEBUG', "check pidfile: $pidfile");
+
+    if (-f $pidfile)  {
+	my (@stat) = stat $pidfile;
+
+	open my $test_PID, $pidfile;
+	my $pid = <$test_PID>;
+	close $test_PID;
+
+	if (!$pid) {
+	    plog('ERR', "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()-7200 || $state eq 'Z') {
+		my $i;
+
+		plog('WARN', "another instance [$pid] is too old, killing it");
+
+		while ($i < 5 && getpgrp $pid != -1) {
+		    kill_for_good($pid);
+		    $i++;
+		    sleep 1;
+		}
+	    } else  {
+		plog("another instance [$pid] is already running for ",
+				time()-$time, " seconds");
+		exit();
+	    }
+	} else {
+	    plog('WARN', "cleaning stale lockfile");
+	    unlink $pidfile;
+	}
+    }
+
+    open my $PID, ">$pidfile"
+	or die "FATAL: can't open pidfile $pidfile for writing";
+
+    print $PID $$;
+    close $PID;
+    $pidfile;
+}
+
+=head2 perform_command($command, $run, $config, $cache,  %opt)
+
+Run a command and check various running parameters such as log size, timeout...
+I<$command> the command to run
+I<$run> current running options
+I<$config> the configuration
+I<$cache> cached values
+I<%opt> the options for the command run
+Return true.
+
+=cut
+
+sub perform_command {
+    my ($command, $run, $config, $cache, %opt) = @_;
+
+    $opt{timeout} ||= 300;
+    $opt{freq} ||= 24;
+    $opt{type} ||= 'shell';
+
+    plog('DEBUG', "Timeout $opt{timeout}");
+
+    my ($output, $fulloutput, $comment);
+    my ($kill, $pipe);
+
+    if ($opt{debug}) {
+	if ($opt{type} eq 'perl') {
+	    print "Would run perl command with timeout = $opt{timeout}\n";
+	} else {
+	    print "Would run $command with timeout = $opt{timeout}\n";
+	}
+	return 1;
+    }
+
+    local $SIG{PIPE} = sub { print "Broken pipe!\n"; $pipe = 1 };
+
+    my $retry = $opt{retry} || 1;
+    my $call_ret = 1;
+    my ($err, $pid, $try);
+    my $logfile = "$opt{log}/$opt{logname}.$run->{run}.log";
+    my $max_retry = $config->{max_command_retry} < $retry ?
+			$retry : $config->{max_command_retry};
+
+    while ($retry) {
+	$try++;
+	if ($opt{retry} > 1) {
+	    $logfile = "$opt{log}/$opt{logname}-$try.$run->{run}.log";
+	}
+	if ($opt{log}) {
+	    my $parent_pid = $$;
+	    $pid = fork();
+	    #close STDIN; close STDERR;close STDOUT;
+	    my $tot_time;
+	    if (!$pid) {
+		plog('DEBUG', "Forking to monitor log size");
+		$run->{main} = 0;
+		local $SIG{ALRM} = sub { exit() };
+		$tot_time += sleep 30;
+		my $size_limit = $config->{log_size_limit};
+		$size_limit =~ s/k/000/i;
+		$size_limit =~ s/M/000000/i;
+		$size_limit =~ s/G/000000000/i;
+		while ($tot_time < $opt{timeout}) {
+		    my (@stat) = stat $logfile;
+		    if ($stat[7] > $size_limit) {
+			plog('WARN', "WARNING: killing current command because of log size exceeding limit ($stat[7] > $config->{log_size_limit})");
+			kill 14, "-$parent_pid";
+			exit();
+		    }
+		    my $df = df $opt{log};
+		    if ($df->{per} == 100) {
+			plog('WARN', "WARNING: killing current command because running out of disk space (only $df->{bavail}KB left)");
+			kill 14, "-$parent_pid";
+			exit();
+		    }
+		    $tot_time += sleep 30;
+		}
+		exit();
+	    }
+	}
+
+	eval {
+	    local $SIG{ALRM} = sub {
+		print "Timeout!\n";
+		$kill = 1;
+		die "alarm\n";  # NB: \n required
+	    };
+
+	    alarm $opt{timeout};
+
+	    if ($opt{type} eq 'perl') {
+		plog('DEBUG', "perl command");
+		$command->[0](@{$command->[1]});
+	    } else {
+		plog('DEBUG', $command);
+		if ($opt{log}) {
+		    #$output = `$command 2>&1 2>&1 | tee $opt{log}/$opt{hash}.$run.log`;
+		    system("$command &> $logfile");
+		} else {
+		    $output = `$command 2>&1`;
+		}
+	    }
+	    alarm 0;
+	};
+
+	$err = $?;
+	$err = 0 if any { $_ == $err } @{$opt{error_ok}};
+
+	# kill pid watching log file size
+	if ($pid) {
+	    kill_for_good($pid);
+	}
+
+	if ($@) {	# timed out
+	    # propagate unexpected errors
+	    die "FATAL: unexpected signal ($@)" unless $@ eq "alarm\n";
+	}
+
+	# Keep the run first on the harddrive so that one can check the
+	# command status tailing it
+	if ($opt{log} && open my $log, $logfile) {
+	    local $/;
+	    $output = <$log>;
+	}
+
+	$fulloutput .= $output;
+	if (ref $opt{callback}) {
+	    $call_ret = $opt{callback}(\%opt, $output);
+	    $call_ret == -1 and return 1;
+	    $call_ret == -2 and return 0;
+	}
+
+	if ($kill && $opt{type} ne 'shell') {
+	    $comment = "Command killed after $opt{timeout}s: $command\n";
+	    my ($cmd_to_kill) = $command =~ /sudo(?: chroot \S+)? (.*)/;
+	    clean_process($run, $cmd_to_kill, $run->{verbose});
+	} elsif ($pipe) {
+	    $comment = "Command received SIGPIPE: $command\n";
+	    sendmail($config->{admin}, '' ,
+		"$opt{hash} on $run->{my_arch} for $run->{media}: broken pipe",
+		"$comment\n$output", "Iurt the build bot <$config->{admin}>",
+		$opt{debug_mail});
+	} else {
+	    if ($opt{type} eq 'shell') {
+		$comment = "Command failed: $command\n";
+	    } else {
+		$comment = "Command failed: $opt{type}\n";
+	    }
+	}
+
+	# Maybe this has to be put before all the commands altering the
+	# $output var
+
+	my $inc;
+	if ($opt{wait_regexp}) {
+	    foreach my $wr (keys %{$opt{wait_regexp}}) {
+		if ($output =~ /$wr/m) {
+		    if (ref $opt{wait_regexp}{$wr}) {
+			$inc = $opt{wait_regexp}{$wr}(\%opt, $output);
+		    }
+		    plog('ERR', "ERROR: $wr !");
+
+		    sendmail($config->{admin}, '' , "$opt{hash} on $run->{my_arch} for $run->{media}: could not proceed", "$wr\n\n$comment\n$output", "Iurt the rebuild bot <$config->{admin}>", $opt{debug_mail}) if $opt{wait_mail};
+		}
+	    }
+	}
+
+	if ($inc && $try < $max_retry) {
+	    $retry += $inc;
+	} elsif ($call_ret && !$kill && !$err && !$opt{error_regexp} || $fulloutput !~ /$opt{error_regexp}/) {
+	    $retry = 0;
+	} else {
+	    $retry--;
+	}
+    }
+
+    if (!$call_ret || $kill || $err || $opt{error_regexp} && $fulloutput =~ /$opt{error_regexp}/) {
+
+	plog('ERR', "ERROR: call_ret=$call_ret kill=$kill err=$err ($opt{error_regexp})");
+
+	if ($opt{log} && $config->{log_url}) {
+	    $comment = qq(See $config->{log_url}/$run->{distro_tag}/$run->{my_arch}/$run->{media}/log/$opt{srpm}/\n\n$comment);
+	}
+
+	my $out;
+	if (length $fulloutput < 10000) {
+	    $out = $fulloutput;
+	} else { 
+	    $out = "Message too big, see http link for details\n";
+	}
+
+	if ($opt{mail} && $config->{sendmail} && !$config->{no_mail}{$opt{mail}}) {
+	    if (! ($cache->{warning}{$opt{hash}}{$opt{mail}} % $opt{freq})) {
+		my $cc = join ',', grep { !$config->{no_mail}{$_} } split ',', $opt{cc};
+		sendmail($opt{mail}, $cc,  $opt{error} , "$comment\n$out", "Iurt the rebuild bot <$config->{admin}>", $opt{debug_mail});
+	    } elsif ($config->{admin}) {
+		sendmail($config->{admin}, '' , $opt{error}, "$comment\n$out", "Iurt the rebuild bot <$config->{admin}>", $opt{debug_mail});
+	    }
+	}
+	$cache->{warning}{$opt{hash}}{$opt{mail}}++;
+	plog('FAIL', $comment);
+	plog('WARN', "--------------- Command failed, full output follows ---------------");
+	plog('INFO', $fulloutput);
+	plog('WARN', "--------------- end of command output ---------------");
+
+	if ($opt{die}) {
+	    dump_cache_par($run);
+	    die "FATAL: $opt{error}.";
+	}
+	return 0;
+    }
+    1;
+}
+
+sub clean_process {
+    my ($run, $match, $verbose) = @_;
+    return clean($run, $match, "pgrep -u root -f", "sudo pkill -9 -u root -f", $verbose);
+}
+
+sub clean {
+    my ($_run, $var, $cmd, $kill_cmd, $_verbose) = @_;
+
+    plog('DEBUG', "clean command $var");
+    $var or die "FATAL: no command given\n.";
+
+    my $ps;
+    my $i;
+
+    while ($ps = `$cmd "$var"`) {
+	system(qq($kill_cmd "$var" &>/dev/null));
+	sleep 1;
+	$ps =~ s/\n/,/g;
+	plog('WARN', "Trying to remove previous blocked processes for $var ($ps)");
+	waitpid(-1, POSIX::WNOHANG);
+	return 0 if $i++ > 10;
+    }
+    1;
+}
+
+sub kill_for_good {
+    my ($pid) = @_;
+    kill 14, $pid;
+    sleep 1;
+    waitpid(-1, POSIX::WNOHANG);
+    if (getpgrp $pid != -1) {
+	kill 15, $pid;
+	sleep 1;
+	waitpid(-1, POSIX::WNOHANG);
+	if (getpgrp $pid  != -1) {
+	    print STDERR "WARNING: have to kill -9 pid $pid\n";
+	    kill 9, $pid;
+	    sleep 1;
+	    waitpid(-1, POSIX::WNOHANG);
+	}
+    }
+}
+
+sub sudo {
+    my ($_run, $config, @arg) = @_;
+
+    #plog("Running $config->{iurt_root_command} @arg");
+
+    -x $config->{iurt_root_command}
+	or die "FATAL: $config->{iurt_root_command} command not found";
+
+    !system('/usr/bin/sudo', $config->{iurt_root_command}, @arg);
+}
+
+1
diff --git a/lib/Iurt/Urpmi.pm b/lib/Iurt/Urpmi.pm
new file mode 100644
index 0000000..f4628ee
--- /dev/null
+++ b/lib/Iurt/Urpmi.pm
@@ -0,0 +1,789 @@
+package Iurt::Urpmi;
+
+use strict;
+use RPM4::Header;
+use File::Basename;
+use File::NCopy qw(copy);
+use MDV::Distribconf::Build;
+use Iurt::Chroot qw(add_local_user create_temp_chroot check_build_chroot);
+use Iurt::Process qw(perform_command clean clean_process sudo);
+use Iurt::Config qw(dump_cache_par get_maint get_package_prefix);
+use Iurt::Util qw(plog);
+
+
+sub new {
+    my ($class, %opt) = @_;
+    my $self = bless {
+        config  => $opt{config},
+        run => $opt{run},
+	urpmi_options => $opt{urpmi_options},
+    }, $class;
+    my $config = $self->{config};
+    my $run = $self->{run};
+
+    if ($run->{use_system_distrib}) {
+	$config->{basesystem_media_root} ||= $run->{use_system_distrib};
+    } elsif ($run->{chrooted_urpmi}) {
+	my ($host) = $run->{chrooted_urpmi}{rooted_media} =~ m,(?:file|http|ftp)://([^/]*),;
+	my ($_name, $_aliases, $_addrtype, $_length, @addrs) = gethostbyname($host);
+
+	my $ip = join('.', unpack('C4', $addrs[0]));
+
+	$ip =~ /\d+\.\d+\.\d+\.\d+/
+		or die "FATAL: could not resolve $host ip address";
+
+	$run->{chrooted_urpmi}{rooted_media} =~ s/$host/$ip/;
+	$run->{chrooted_media} = $run->{chrooted_urpmi}{rooted_media} .
+			"/$run->{distro}/$run->{my_arch}";
+
+	# Now squash all slashes that don't follow colon
+	$run->{chrooted_media} =~ s|(?<!:)/+|/|g;
+
+	plog('DEBUG', "installation media: $run->{chrooted_media}");
+    }
+    $self->{urpmi_media_options} .=
+	" --use-distrib $config->{repository}/$run->{distro}/$run->{my_arch}";
+
+    $self;
+}
+
+sub set_command {
+    my ($self, $chroot_tmp) = @_;
+    $self->{urpmi_command} = "urpmi $self->{urpmi_options} $self->{urpmi_media_options} --root $chroot_tmp";
+}
+
+sub set_local_media {
+    my ($self, $local_media) = @_;
+    $self->{local_media} = $local_media;
+}
+
+sub add_to_local_media {
+    my ($self, $chroot_tmp, $srpm, $luser) = @_;
+    my $local_media = $self->{local_media};
+
+    system("cp $chroot_tmp/home/$luser/rpm/RPMS/*/*.rpm $local_media &>/dev/null") and plog("ERROR: could not copy rpm files from $chroot_tmp/home/$luser/rpm/RPMS/ to $local_media ($!)");
+    system("cp $chroot_tmp/home/$luser/rpm/SRPMS/$srpm $local_media &>/dev/null") and plog("ERROR: could not copy $srpm from $chroot_tmp/home/$luser/rpm/SRPMS/ to $local_media ($!)");
+}
+
+sub urpmi_command {
+    my ($self, $chroot_tmp, $_luser) = @_;
+    my $run = $self->{run};
+    my $local_media = $self->{local_media};
+
+    #plog(3, "urpmi_command ($chroot_tmp user $luser)");
+    if ($run->{chrooted_urpmi}) { 
+	$self->{urpmi_command} = "urpmi $self->{urpmi_options} $self->{urpmi_media_options} --root $chroot_tmp ";
+
+# CM: commented out
+#     this was causing rpm database corruption problems and the packages
+#     are already installed
+#
+#        if (!install_packages($self, 'chroot', $chroot_tmp, $local_spool, {}, 'configure', "[ADMIN] installation of urpmi and sudo failed in the chroot $run->{my_arch}", { maintainer => $config->{admin}, check => 1 }, 'urpmi', 'sudo')) {
+#	    $run->{chrooted_urpmi} = 0;
+#	    return
+#	}
+
+	# Here should be added only the needed media for the given package
+	#  main/release -> main/release
+	#  main/testing -> main/release main/testing
+	#  contrib/release -> contrib/release main/release
+	#  contrib/testing -> contrib/testing contrib/release main/testing main/release
+	#  non-free/release ...
+	# This is now done with an option in iurt2 --chrooted-urpmi -m media1 media2 -- media_url
+
+	if ($run->{chrooted_urpmi}{media}) {
+	    foreach my $m (@{$run->{chrooted_urpmi}{media}}) {
+		my $m_name = $m;
+		$m_name =~ s,/,_,g;
+		if (!add_media($self, $chroot_tmp, $m_name,
+			"$m_name $run->{chrooted_media}/media/$m")) {
+		    $run->{chrooted_urpmi} = 0;
+		    return;
+		}
+	    }
+	} else {
+	    if (!add_media($self, $chroot_tmp, 'Main', "--distrib $run->{chrooted_media}")) {
+		if (!add_media($self, $chroot_tmp, 'Main', "--wget --distrib $run->{chrooted_media}")) {
+		    $run->{chrooted_urpmi} = 0;
+		    return;
+		}
+	    }
+	}
+
+	if (-d "$local_media/hdlist.cz") {
+	    mkdir("$chroot_tmp/iurt_media/");
+	    opendir my $dir, $local_media;
+	    my $next;
+	    foreach my $f (readdir $dir) {
+		$f =~ /(\.rpm|^hdlist.cz)$/ or next;
+		if (!link "$local_media/$f", "$chroot_tmp/iurt_media") {
+		    if (!copy "$local_media/$f", "$chroot_tmp/iurt_media") {
+			plog("ERROR: could not copy file $local_media/$f to $chroot_tmp/iurt_media");
+			$next = 1;
+			last;
+		    }
+		}
+	    }
+	    next if $next;
+	    add_media($self, $chroot_tmp, 'iurt_group', "iurt_group file:///iurt_media") or next;
+	}
+
+	$self->{urpmi_command} = "chroot $chroot_tmp urpmi $self->{urpmi_options} ";
+	return 1;
+    } else {
+	$self->{urpmi_command} = "urpmi $self->{urpmi_options} $self->{urpmi_media_options} --root $chroot_tmp";
+    }
+}
+
+sub check_media_added {
+    my ($chroot, $media) = @_;
+    my $medias = `sudo chroot $chroot urpmq --list-media 2>&1`;
+    print "MEDIA $medias ($media)\n";
+    $medias =~ /$media/m;
+}
+
+sub add_media {
+    my ($self, $chroot, $regexp, $media) = @_;
+    my $run = $self->{run};
+    my $config = $self->{config};
+    my $cache = $run->{cache};
+
+    plog("add chroot media: $run->{chrooted_media}");
+
+    if (!perform_command("sudo chroot $chroot urpmi.addmedia --probe-hdlist $media", 
+		$run, $config, $cache, 
+		mail => $config->{admin},
+		timeout => 300, 
+		freq => 1,
+		retry => 2,
+		debug_mail => $run->{debug})) {
+	}
+    if (!check_media_added($chroot, $regexp)) { 
+	plog('ERR', "ERROR iurt could not add media into the chroot");
+	return;
+    } 
+    1;
+}
+
+sub add_packages {
+    my ($self, $chroot, $_user, @packages) = @_;
+    my $run = $self->{run};
+    my $config = $self->{config};
+    my $cache = $run->{cache};
+    if (!perform_command("sudo $self->{urpmi_command} @packages", 
+		$run, $config, $cache, 
+		timeout => 300, 
+		freq => 1,
+		retry => 2,
+		error_ok => [ 11 ],
+		debug_mail => $run->{debug},
+		error_regexp => 'cannot be installed',
+		wait_regexp => {
+		    'is needed by' => sub { 
+		        plog("WARNING: rpm database seems corrupted, retrying"); 
+		        system("sudo chroot $chroot rm -rf /var/lib/rpm/__db* &> /dev/null");
+		        1;
+		        }, 
+		    'database locked' => sub { 
+		        plog("WARNING: urpmi database locked, waiting...");
+		        sleep 30; 
+		        $self->{wait_limit}++; 
+		        if ($self->{wait_limit} > 10) { 
+		    	    $self->{wait_limit} = 0;
+			    system(qq(sudo pkill -9 urpmi &>/dev/null));
+			    return;
+			} 
+			1;
+		  } },)) {
+	plog("ERROR: could not install @packages inside $chroot");
+	return 0;
+    }
+    1;
+}
+
+sub get_local_provides {
+    my ($self) = @_;
+    my $run = $self->{run};
+    my $program_name = $run->{program_name};
+    my $local_media = $self->{local_media};
+
+    opendir my $dir, $local_media;
+    plog(1, "get local provides ($local_media)");
+    require URPM;
+    my $urpm = new URPM;
+    foreach my $d (readdir $dir) {
+	$d =~ /\.src\.rpm$/ and next;
+	$d =~ /\.rpm$/ or next;
+	my $id = $urpm->parse_rpm("$local_media/$d");
+	my $pkg = $urpm->{depslist}[$id];
+	plog(3, "$program_name: checking $d provides");
+        foreach ($pkg->provides, $pkg->files) {
+	    plog(3, "$program_name: adding $_ as provides of $d");
+	    $run->{local_provides}{$_} = $d;
+	}
+    }
+    1;
+}
+
+sub get_build_requires {
+    my ($self, $union_id, $luser) = @_;
+    my $run = $self->{run};
+    my $config = $self->{config};
+    my $cache = $run->{cache};
+
+    $run->{todo_requires} = {};
+    plog("get_build_requires");
+
+    my ($u_id, $chroot_tmp) = create_temp_chroot($run, $config, $cache, $union_id, $run->{chroot_tmp}, $run->{chroot_tar}) or return;
+    add_local_user($chroot_tmp, $run, $config, $luser, $run->{uid}) or return;
+    $union_id = $u_id;
+    
+    my $urpm = new URPM;
+    foreach my $p (@{$run->{todo}}) {
+	my ($dir, $srpm, $s) = @$p;
+	recreate_srpm($self, $run, $config, $chroot_tmp, $dir, $srpm, $run->{user}) or return;
+	$s or next;
+	my $id = $urpm->parse_rpm("$dir/$srpm");
+	my $pkg = $urpm->{depslist}[$id];
+        foreach ($pkg->requires) {
+	    plog(3, "adding $_ as requires of $srpm");
+	    $run->{todo_requires}{$_} = $srpm;
+	}
+    }
+    1;
+}
+
+sub order_packages {
+    my ($self, $union_id, $provides, $luser) = @_;
+    my $run = $self->{run};
+    my @packages = @{$run->{todo}};
+    my $move;
+
+    plog(1, "order_packages");
+    get_local_provides($self) or return;
+    if (!$run->{todo_requires}) {
+	get_build_requires($self, $union_id, $luser) or return;
+    }
+    my %visit;
+    my %status;
+    do { 
+	$move = 0;
+	foreach my $p (@packages) {
+	    my ($_dir, $rpm, $status) = @$p;
+	    defined $status{$rpm} && $status{$rpm} == 0 and next;
+	    plog("checking packages $rpm");
+	    foreach my $r (@{$run->{todo_requires}{$rpm}}) {
+		plog("checking requires $r");
+		if (!$run->{local_provides}{$r}) { 
+		    if ($provides->{$r}) {
+			$status = 1;
+		    } else {
+			$status = 0;
+		    }
+		} elsif ($visit{$rpm}{$r}) {
+		    # to evit loops
+		    $status = 0;
+		} elsif ($run->{done}{$rpm} && $run->{done}{$provides->{$r}}) {
+		    if ($run->{done}{$rpm} < $run->{done}{$provides->{$r}}) {
+			$move = 1;
+			$status = $status{$provides->{$r}} + 1;
+		    } else {
+			$status = 0;
+		    }
+		} elsif ($status < $status{$provides->{$r}}) {
+		    $move = 1;
+		    $status = $status{$provides->{$r}} + 1;
+		}
+		$visit{$rpm}{$r} = 1;
+	    }
+	    $status{$rpm} = $status;
+	    $p->[2] = $status;
+	}
+    } while $move;    
+    $run->{todo} = [ sort { $a->[2] <=> $b->[2] } @packages ];
+    if ($run->{verbose}) {
+	foreach (@packages) {
+	    plog("order_packages $_->[1]");
+	}
+    }
+    @packages;
+}
+	
+sub wait_urpmi { 
+    my ($self) = @_;
+    my $run = $self->{run};
+
+    plog("WARNING: urpmi database locked, waiting...") if $run->{debug};
+    sleep 30; 
+    $self->{wait_limit}++; 
+    if ($self->{wait_limit} > 8) { 
+	$self->{wait_limit} = 0; system(qq(sudo pkill -9 urpmi &>/dev/null));
+    } 
+}
+
+sub install_packages_old {
+    my ($self, $local_spool, $srpm, $log, $error, @packages) = @_;
+    my $run = $self->{run};
+    my $config = $self->{config};
+    my $cache = $run->{cache};
+    my $log_spool = "$local_spool/log/$srpm/";
+    -d $log_spool or mkdir $log_spool;
+    if (!perform_command("sudo $self->{urpmi_command} @packages", 
+		$run, $config, $cache, 
+		#	mail => $maintainer, 
+		error => $error, 
+		hash => "${log}_$srpm", 
+		srpm => $srpm,
+		timeout => 600, 
+		retry => 2,
+		debug_mail => $run->{debug},
+		freq => 1, 
+		wait_regexp => { 'database locked' => \&wait_urpmi },
+		error_regexp => 'unable to access',
+		log => $log_spool)) {
+	    $cache->{failure}{$srpm} = 1;
+	    $run->{status}{$srpm} = 'binary_test_failure';
+	    return 0;
+	}
+	1;
+}
+
+sub install_packages {
+    my ($self, $title, $chroot_tmp, $local_spool, $pack_provide, $log, $error, $opt, @packages) = @_;
+
+    my $maintainer = $opt->{maintainer};
+    my $run = $self->{run};
+    my $config = $self->{config};
+    my $cache = $run->{cache};
+    my $program_name = $run->{program_name};
+    my $ok;
+    my @to_install;
+
+    plog('DEBUG', "installing @packages");
+
+    if ($run->{chrooted_urpmi}) {
+       	@to_install = map { s/$chroot_tmp//; $_ } @packages;
+    } else {
+	push @to_install, @packages;
+    }
+
+    @to_install or return 1;
+
+    (my $log_dirname = $title) =~ s/.*:(.*)\.src.rpm/$1/;
+
+    my $log_spool = "$local_spool/log/$log_dirname/";
+
+    mkdir $log_spool;
+
+    my $try_urpmi = 1;
+    my @rpm = grep { !/\.src\.rpm$/ } @to_install;
+
+    return 1 if ($opt->{check} && -f "$chroot_tmp/bin/rpm" && @rpm && !system("sudo chroot $chroot_tmp rpm -q @to_install"));
+
+    if ($try_urpmi) {
+	foreach my $try (
+		[ '', 'using urpmi' ],
+		[ '', 'rebuild rpm base and retry', '_retry' ],
+		[ ' --allow-nodeps', 'retrying with nodeps' , '_nodeps' ],
+		[ ' --no-install', 'using rpm directly', '_rpm' ]
+	) {
+	    my ($opt, $msg, $suf) = @$try;
+
+	    plog('INFO', "install dependencies: $msg");
+	    my $unsatisfied;
+
+	    if (!perform_command(
+		    "sudo $self->{urpmi_command} $opt @to_install", 
+		    $run, $config, $cache,
+		    error => $error,
+		    logname => "${log}$suf", 
+		    hash => "${log}_$title$suf", 
+		    timeout => 600, 
+		    srpm => $title,
+		    freq => 1,
+		    #cc => $cc, 
+		    retry => 3,
+		    debug_mail => $run->{debug},
+		    error_regexp => 'cannot be installed',
+		    wait_regexp => { 
+			'database locked' => \&wait_urpmi, 
+			'is needed by' => sub { 
+			    plog('WARN', "WARNING: rpm database seems corrupted, retrying"); 
+			    system("sudo chroot $chroot_tmp rm -rf /var/lib/rpm/__db* &> /dev/null");
+			    1;
+			}, 
+		    }, 
+		    log => $log_spool,
+		    callback => sub { 
+			my ($opt, $output) = @_;
+			plog('DEBUG', "calling callback for $opt->{hash}");
+
+# 20060614
+# it seems the is needed urpmi error is due to something else (likely a
+# database corruption error).	    
+# my @missing_deps = $output =~ /(?:(\S+) is needed by )|(?:\(due to unsatisfied ([^[ ]*)(?: (.*)|\[(.*)\])?\))/g;
+#
+
+			my @missing_deps = $output =~ /([^ \n]+) \(due to unsatisfied ([^[ \n]*)(?: ([^\n]*)|\[([^\n]*)\])?\)/g;
+
+			# as it seems that rpm db corruption is making urpmi
+			# returning false problem on deps installation, try
+			# to compile anyway
+
+			@missing_deps or return 1;
+			$unsatisfied = 1;
+
+			while (my $missing_package = shift @missing_deps) {
+			    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 ($missing_package_name, $first_maint);
+			    if ($missing_package !~ /\.src$/) {
+				($first_maint, $missing_package_name) = get_maint($run, $missing_package);
+				plog(5, "likely $missing_package_name need to be rebuilt ($first_maint)");
+			    } else {
+				$missing_package = '';
+			    }
+
+			    my ($other_maint) = get_maint($run, $p);
+			    plog('FAIL', "missing dep: $missing_deps ($other_maint) missing_package $missing_package ($first_maint)");
+			    $run->{status}{$title} = 'missing_dep';
+			    foreach my $m ($first_maint, $other_maint) { # FIXME: (tv) this loop is useless !!!
+				if ($other_maint && $other_maint ne 'NOT_FOUND') {
+				    $opt->{mail} = $config->{admin};
+				    #$opt->{mail} .= ", $other_maint";
+				}
+			    }
+
+			    if (!$opt->{mail}) { 
+				$opt->{mail} = $config->{admin};
+			    }
+
+			    # remember what is needed, and do not try to
+			    # recompile until it is available
+
+			    if ($missing_package) {
+				$opt->{error} = "[MISSING] $missing_deps, needed by $missing_package to build $title, is not available on $run->{my_arch} (rebuild $missing_package?)";
+				$cache->{needed}{$title}{$missing_deps} = { package => $missing_package , version => $version, maint => $first_maint || $other_maint || $maintainer };
+			    } else {
+				$opt->{error} = "[MISSING] $missing_deps, needed to build $title, is not available on $run->{my_arch}";
+				$cache->{needed}{$title}{$missing_deps} = { package => $missing_package , version => $version, maint => $maintainer || $other_maint };
+			    }
+			} 
+			0;
+		    },
+		)) {
+		if (!clean_process($run, "$self->{urpmi_command} $opt @to_install", $run->{verbose})) {
+		    dump_cache_par($run);
+		    die "FATAL $program_name: Could not have urpmi working !";
+		}
+		$unsatisfied and last;
+	    } else { 
+		if (!@rpm || !system("sudo chroot $chroot_tmp rpm -q @rpm")) {
+		    plog("installation successful");
+		    $ok = 1;
+		}
+	    }
+
+	    if (-f "$chroot_tmp/bin/rpm") {
+		if (!$ok && system("sudo chroot $chroot_tmp rm -rf /var/lib/rpm/__db*; sudo chroot $chroot_tmp rpm --rebuilddb")) {
+		    plog("ERROR: rebuilding rpm db failed, aborting ($!)");
+		    last;
+		}
+		if ($suf eq '_rpm') {
+		    plog(1, "trying to install all the rpms in $chroot_tmp/var/cache/urpmi/rpms/ manually");
+		    if (!system("sudo chroot $chroot_tmp rpm -Uvh --force --nodeps /var/cache/urpmi/rpms/*.rpm")) {
+			$ok = 1;
+			last;
+		    } else {
+			$ok = 0;
+		    }
+		}
+	    }
+	    last if $ok == 1;
+	}
+    }
+    if (!-f "$chroot_tmp/bin/rpm" || @rpm && system("sudo chroot $chroot_tmp rpm -q @to_install")) {
+	plog(1, "ERROR: urpmi is not working, doing it manually");
+	my $root = "$config->{repository}/$run->{distro}/$run->{my_arch}";
+	my $depslist = "$root/media/media_info/depslist.ordered";
+	if (-f $depslist) {
+	    my $distrib = $self->{distrib};
+	    if (!$distrib) { 
+		$distrib = MDV::Distribconf::Build->new($root);
+		plog(3, "getting media config from $root");
+		if (!$distrib->loadtree) {
+		    plog(1, "ERROR: $root does not seem to be a distribution tree\n");
+		    return;
+		}
+		$distrib->parse_mediacfg;
+		foreach my $media ($distrib->listmedia) {
+		    $media =~ /(SRPMS|debug_)/ and next;
+		    my $path = $distrib->getfullpath($media, 'path');
+		    opendir my $rpmdh, $path;
+		    foreach my $rpm (readdir $rpmdh) {
+			if ($rpm =~ /^(.*)-([^-]+)-([^-]+)\.([^.]+)\.rpm/) {
+			    $distrib->{file}{"$1-$2-$3.$4"} = "$path/$rpm";
+			}
+		    }
+		}
+	    }
+	    $self->{distrib} = $distrib;
+	    plog(3, "using $depslist to resolve dependencies");
+	    open my $depsfh, $depslist;
+	    my %packages;
+	    my @deps;
+	    my $i;
+	    my @install;
+	    my @pack;
+	    while (<$depsfh>) {
+		my ($pack, $_size, @d) = split ' ';
+		$pack =~ s/:\d+$//;
+		push @deps, \@d;
+		my ($name, $version, $release, $arch) = $pack =~ /(.*)-([^-]+)-([^-]+)\.([^.]+)$/;
+		$pack[$i] = $pack;
+		$packages{$pack} ||= $i;
+		if ($arch ne 'src' && !$packages{$name}) {
+		    $packages{$name} = $i;
+		    $packages{"$name-$version"} = $i;
+		    $packages{"$name-$version-$release"} = $i;
+		}
+		$i++;
+	    }
+	    plog(4, "$i packages found");
+	    my %done;
+	    # rpm -root $chroot -qa does not work
+	    if (-f "$chroot_tmp/bin/rpm") {
+		my $qa = `sudo chroot $chroot_tmp rpm -qa --qf "\%{name}-\%{version}-\%{release}.\%{arch}\n"`;
+		foreach my $rpm (split "\n", $qa) {
+		    plog(6, "$rpm already installed");
+		    $done{$rpm} = 1;
+		}
+	    }
+	    foreach my $p (@to_install) {
+		my $pa = $pack[$packages{$p}];
+		$done{$pa} and next;
+		my $f = $distrib->{file}{$pa};
+		if ($f) {
+		    push @install, $pa;
+		} else {
+		    plog(1, "ERROR: main package $p is not present in the repository");
+		    return 0;
+		}
+	    }
+	    my $dok;
+	    while (!$dok) {
+		$dok = 1;
+		foreach my $p (@install) {
+		    $done{$p} and next;
+		    $done{$p} = 1;
+		    plog(5, "adding deps for $p (", join(', ', @{$deps[$packages{$p}]}, ")"));
+		    foreach my $d (@{$deps[$packages{$p}]}) {
+			plog("$d (pack $pack[$d]) done $done{$d} done pack $done{$pack[$d]}");
+			$done{$d} and next;
+			$done{$pack[$d]} and next;
+			$done{$d} = 1;
+			if ($d =~ /\d+/) {
+			    my $f = $distrib->{file}{$pack[$d]};
+			    if ($f) {
+				$dok = 1;
+				plog(5, "adding $pack[$d]");
+				push @install, $pack[$d];
+			    } else {
+				plog(2, "ERROR: deps for $p, $pack[$d] ($d) is not present in the repository");
+			    }
+			} elsif ($d =~ /\|/) {
+			    my $done;
+			    foreach my $a (split '\|', $d) {
+				my $f = $distrib->{file}{$pack[$a]};
+				if ($f) {
+				    $done = 1;
+				    if (!$done{$pack[$a]}) {
+					$dok = 1;
+					plog(5, "adding $pack[$a]");
+					push @install, $pack[$a];
+					$done{$pack[$a]} = 1;
+				    }
+				    last;
+				} else {
+				    plog(2, "ERROR: alternate deps, $pack[$a] ($d) is not present in the repository, using alternative");
+				}
+			    }
+			    if (!$done) {
+				plog(2, "ERROR: no alternatives present in the repository");
+			    }
+			}
+		    }
+		}
+	    }
+	    my $rpms;
+	    my %install_done;
+         # FIXME: (tv) this loop could be simplified with uniq() from MDK::Common:
+         # eg: $rpms = join(map { "$distrib->{file}{$_}" } uniq(@install))
+	    foreach my $rpm (@install) {
+		$install_done{$rpm} and next;
+		print "$program_name: will install $rpm ($distrib->{file}{$rpm})\n" if $run->{verbose} > 3;
+		$install_done{$rpm} = 1;
+		$rpms .= "$distrib->{file}{$rpm} ";
+	    }
+	    if ($rpms) {
+		return !system("sudo rpm --ignoresize --nosignature --root $chroot_tmp -Uvh $rpms");
+	    }
+	    $ok = 1;
+	}
+    }
+    $ok;
+}
+
+sub clean_urpmi_process {
+    my ($self) = @_;
+    my $run = $self->{run};
+    my $program_name = $run->{program_name};
+    if (!$run->{chrooted_urpmi}) {
+	my $match = $self->{urpmi_command} or return;
+	if (!clean_process($run, $match, $run->{verbose})) {
+	    dump_cache_par($run);
+	    die "FATAL $program_name: Could not have urpmi working !";
+	}
+    }
+}
+
+sub update_srpm {
+	my ($self, $dir, $rpm, $wrong_rpm) = @_;
+	my $run = $self->{run};
+	my $cache = $run->{cache};
+	my ($arch) = $rpm =~ /([^\.]+)\.rpm$/ or return 0;
+	my $srpm = $cache->{rpm_srpm}{$rpm};
+	if (!$srpm) {
+		my $hdr = RPM4::Header->new("$dir/$rpm");
+		$hdr or return 0;
+		$srpm = $hdr->queryformat('%{SOURCERPM}');
+		$cache->{rpm_srpm}{$rpm} = $srpm;
+	}
+	$srpm = fix_srpm_name($cache, $srpm, $rpm, $wrong_rpm);
+	$arch, $srpm;
+}
+
+sub fix_srpm_name {
+	my ($cache, $srpm, $rpm, $wrong_rpm) = @_;
+	my $old_srpm = $srpm;
+	if ($srpm =~ s/^lib64/lib/) {
+		push @$wrong_rpm, [ $old_srpm, $rpm ] if ref $wrong_rpm;
+		$cache->{rpm_srpm}{$rpm} = $srpm;
+	}
+	$srpm;
+}
+
+sub recreate_srpm {
+    my ($_self, $run, $config, $chroot_tmp, $dir, $srpm, $luser, $b_retry) = @_;
+# recreate a new srpm for buildarch condition in the spec file
+    my $program_name = $run->{program_name};
+    my $cache = $run->{cache};
+    my $with_flags = $run->{with_flags};
+
+    plog('NOTIFY', "recreate srpm: $srpm");
+
+    perform_command([ 
+	sub { 
+	    my ($s, $d) = @_; 
+	    sudo($run, $config, '--cp', $s, $d) } , [ "$dir/$srpm", "$chroot_tmp/home/$luser/rpm/SRPMS/" ] ], 
+	$run, $config, $cache, 
+	type => 'perl',
+	mail => $config->{admin}, 
+	error => "[REBUILD] cannot copy $srpm to $chroot_tmp", 
+	debug_mail => $run->{debug},
+	hash => "copy_$srpm") or return;
+
+    my %opt = (mail => $config->{admin}, 
+	error => "[REBUILD] cannot install $srpm in $chroot_tmp", 
+	debug_mail => $run->{debug},
+	hash => "install_$srpm",
+	retry => $b_retry,
+	callback => sub { 
+	    my ($opt, $output) = @_;
+	    plog('DEBUG', "calling callback for $opt->{hash}");
+	    if ($output =~ /warning: (group|user) .* does not exist - using root|Header V3 DSA signature/i) {
+		return 1;
+	    } elsif ($output =~ /user $luser does not exist|cannot write to \%sourcedir/) {
+		plog('WARN', "WARNING: chroot seems corrupted!");
+		$opt->{error} = "[CHROOT] chroot is corrupted";
+		$opt->{retry} ||= 1;
+		return;
+	    }
+	    1;
+	});
+    plog('DEBUG', "recreating src.rpm...");
+    if (!perform_command(qq(sudo chroot $chroot_tmp su $luser -c "rpm -i /home/$luser/rpm/SRPMS/$srpm"), 
+	    $run, $config, $cache, %opt)) {
+	plog("ERROR: chrooting failed (retry $opt{retry}") if $run->{debug};
+	if ($opt{retry}) {
+	    check_build_chroot($run->{chroot_path}, $run->{chroot_tar}, $run,  $config) or return;
+	    return -1;
+	}
+	return;
+    }
+    
+    my $spec;
+    my $oldsrpm = "$chroot_tmp/home/$luser/rpm/SRPMS/$srpm";
+    my $filelist = `rpm -qlp $oldsrpm`;
+    my ($name) = $srpm =~ /(?:.*:)?(.*)-[^-]+-[^-]+\.src\.rpm$/;
+    foreach my $file (split "\n", $filelist) {
+	if ($file =~ /(.*)\.spec/) {
+	    if (!$spec) {
+		$spec = $file;
+	    } elsif ($1 eq $name) {
+		$spec = $file;
+	    }
+	}
+    } 
+    # 20060515 This should not be necessairy any more if urpmi *.spec works, but it doesn't
+    #
+    my $ret = perform_command(qq(sudo chroot $chroot_tmp su $luser -c "rpm --nodeps -bs $with_flags /home/$luser/rpm/SPECS/$spec"), 
+	$run, $config, $cache, 
+	mail => $config->{admin}, 
+	error => "[REBUILD] cannot create $srpm in $chroot_tmp", 
+	debug_mail => $run->{debug},
+	hash => "create_$srpm"
+    );
+
+    # Return if we can't regenerate srpm
+    #
+    return (0, ,) unless $ret;
+
+    # CM: was: foreach my $file (readdir $dir)
+    #     The above line returned entries in a strange order in my test
+    #     system, such as
+    #      .. 
+    #      cowsay-3.03-11mdv2007.1.src.rpm
+    #      cowsay-3.03-11mdv2007.0.src.rpm
+    #      .
+    #     assigning '.' to $new_rpm. Now sorting the output.
+
+    # we should better perform a rpm -qp -qf "%{name}-%{version}-%{release}.src.rpm" $spec
+    my $file;
+    my $stat;
+    foreach my $f (glob "$chroot_tmp/home/$luser/rpm/SRPMS/$name-*.src.rpm") {
+	my (@s) = stat $f;
+	if ($s[9] > $stat) {
+	    $file = $f;
+	    $stat = $s[9];
+	}
+    }     
+    my ($new_srpm) = basename($file);
+    my $prefix = get_package_prefix($srpm);
+    my $newfile = "$chroot_tmp/home/$luser/rpm/SRPMS/$prefix$new_srpm";
+    if (-f $file && $newfile ne $file) {
+	if (-f $newfile) {
+	    sudo($run, $config, '--rm', $newfile) or die "$program_name: could not delete $newfile ($!)";
+	}
+	sudo($run, $config, '--ln', $file, $newfile) or die "$program_name: linking $file to $newfile failed ($!)";
+	unlink $file;
+	unlink $oldsrpm if $oldsrpm ne $newfile;
+    }
+    plog('NOTIFY', "new srpm: $prefix$new_srpm");
+    ($ret, "$prefix$new_srpm", $spec);
+}
+
+1;
diff --git a/lib/Iurt/Util.pm b/lib/Iurt/Util.pm
new file mode 100644
index 0000000..a101f76
--- /dev/null
+++ b/lib/Iurt/Util.pm
@@ -0,0 +1,203 @@
+package Iurt::Util;
+
+use base qw(Exporter);
+use strict;
+
+our @EXPORT = qw(
+    plog_init
+    plog
+    pdie
+    ssh_setup
+    ssh
+    sout
+    sget
+    sput
+);
+
+my ($plog_name, $plog_file, $plog_level, $plog_color);
+
+=head2 LOG HELPERS
+
+=over 8
+
+=item plog_init($program_name, $logfile)
+
+=item plog_init($program_name, $logfile, $level)
+
+Initialize plog with the program name, log file and optional log level.
+If not specified, the log level will be set to 9999.
+
+=cut
+
+my %plog_ctr = (
+	red     => "\x1b[31m",
+	green   => "\x1b[32m",
+	yellow  => "\x1b[33m",
+	blue    => "\x1b[34m",
+	magenta => "\x1b[35m",
+	cyan    => "\x1b[36m",
+	grey    => "\x1b[37m",
+	bold	=> "\x1b[1m",
+	normal  => "\x1b[0m",
+);
+
+my @plog_prefix = (
+	"",
+	"E: ",
+	"W: ",
+	"*: ",
+	"F: ",
+	"O: ",
+	"N: ",
+	"I: ",
+	"D: ",
+);
+
+my %plog_level = (
+	NONE	=> 0,
+	ERR	=> 1,
+	WARN	=> 2,
+	MSG	=> 3,
+	FAIL	=> 4,
+	OK	=> 5,
+	NOTIFY	=> 6,
+	INFO	=> 7,
+	DEBUG	=> 8,
+);
+
+sub plog_init {
+        $plog_name = shift;
+        $plog_file = shift;
+        $plog_level = shift @_ || 9999;
+        $plog_color = shift @_ || 0;
+
+	$plog_level = 9999 if $ENV{PLOG_DEBUG};
+
+	$plog_color = 0 unless -t fileno $plog_file;
+
+	foreach (@plog_prefix) { $_ .= "[$plog_name] " }
+
+	if ($plog_color) {
+		$plog_prefix[1] .= "$plog_ctr{bold}$plog_ctr{red}";
+		$plog_prefix[2] .= "$plog_ctr{bold}$plog_ctr{yellow}";
+		$plog_prefix[3] .= $plog_ctr{bold};
+		$plog_prefix[4] .= $plog_ctr{red};
+		$plog_prefix[5] .= $plog_ctr{green};
+		$plog_prefix[6] .= $plog_ctr{cyan};
+		$plog_prefix[8] .= $plog_ctr{yellow};
+	}
+
+	1;
+}
+
+=item plog($message)
+
+=item plog($level, @message)
+
+Print a log message in the format "program: I<message>\n" to the log
+file specified in a call to plog_init(). If a level is specified,
+the message will be printed only if the level is greater or equal the
+level set with plog_init().
+
+=back
+
+=cut
+
+sub plog {
+	my $level = $#_ ? shift : 'INFO';
+	$level = $plog_level{$level};
+	my ($p, $e) = ($plog_prefix[$level], $plog_ctr{normal});
+	
+	print $plog_file "$p@_$e\n" if $plog_level >= $level;
+}
+
+sub pdie {
+	my $level = $plog_level{ERROR};
+	my ($p, $e) = ($plog_prefix[$level], $plog_ctr{normal});
+
+	print $plog_file "$p@_$e\n" if $plog_level >= $level;
+	die $@;
+}
+
+=head2 SSH HELPERS
+
+=over 8
+
+=item ssh_setup($options, $user, $host)
+
+Set up ssh connections with the specified options, user and remote
+host. Return an ssh handle to be used in ssh-based operations.
+
+=cut
+
+sub ssh_setup {
+	my $opt = shift;
+	my $user = shift;
+	my $host = shift;
+	my @conf = ($opt, $user, $host);
+	\@conf;
+}
+
+=item ssh($handle, @commmand)
+
+Open an ssh connection with parameters specified in ssh_setup() and
+execute I<@command>. Return the command execution status.
+
+=cut
+
+# This is currently implemented using direct calls to ssh/scp because.
+# according to Warly's comments in ulri, using the perl SSH module
+# gives us some performance problems
+
+sub ssh {
+	my $conf = shift;
+	my ($opt, $user, $host) = @$conf;
+	system("ssh $opt -x $user\@$host @_");
+}
+
+=item sout($handle, @commmand)
+
+Open an ssh connection with parameters specified in ssh_setup() and
+execute I<@command>. Return the command output.
+
+=cut
+
+sub sout {
+	my $conf = shift;
+	my ($opt, $user, $host) = @$conf;
+	`ssh $opt -x $user\@$host @_ 2>/dev/null`;
+}
+
+=item sget($handle, $from, $to)
+
+Get a file using scp, from the remote location I<$from> to the
+local location I<$to>, using host and user specified in ssh_setup().
+
+=cut
+
+sub sget {
+	my $conf = shift;
+	my ($_opt, $user, $host) = @$conf;
+	system('scp', '-q', '-rc', 'arcfour', "$user\@$host:$_[0]", $_[1]);
+}
+
+=item sput($handle, $from, $to)
+
+Send a file using scp, from a local location I<$from> to the remote
+location I<$to>, using host and user specified in ssh_setup().
+
+=back
+
+=cut
+
+sub sput {
+	my $conf = shift;
+	my ($_opt, $user, $host) = @$conf;
+	system('scp', '-q', '-rc', 'arcfour', $_[0], "$user\@$host:$_[1]");
+}
+
+=back
+
+=cut
+
+1;