aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--lib/Iurt/.perl_checker1
-rw-r--r--lib/Iurt/Chroot.pm515
-rw-r--r--lib/Iurt/Config.pm304
-rw-r--r--lib/Iurt/DKMS.pm318
-rw-r--r--lib/Iurt/File.pm68
-rw-r--r--lib/Iurt/Mail.pm27
-rw-r--r--lib/Iurt/Process.pm355
-rw-r--r--lib/Iurt/Urpmi.pm789
-rw-r--r--lib/Iurt/Util.pm203
-rwxr-xr-xuiurt1497
-rwxr-xr-xulri786
11 files changed, 4863 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;
diff --git a/uiurt b/uiurt
new file mode 100755
index 0000000..242221b
--- /dev/null
+++ b/uiurt
@@ -0,0 +1,1497 @@
+#!/usr/bin/perl
+#
+# Copyright (C) 2005 Mandrakesoft
+# Copyright (C) 2005,2006 Mandriva
+#
+# Author: Florent Villard <warly@mandriva.com>
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2, or (at your option)
+# any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+#
+# NAME
+#
+# uiurt - micro iurt
+#
+# DESCRIPTION
+#
+# Minimal, strict, functionality to build packages in a chroot.
+#
+# Does not try to be smart and resolve host environment problems, but just
+# fail and report insted.
+#
+# TODO
+#
+# - use a cache (rpmctl cache for example) to find maintainer
+# - add icecream compilation support
+# - add a --group option to compile a set of packages (in progress)
+# - add a function to update a packages when it obviously need to be recompile
+# - Maybe call the function from the initial todo list (thus making the
+# argument ordering important)
+# - Change the packager tag in the chroot to have the one who submit the package
+
+use strict;
+use RPM4::Header;
+use Iurt::Config qw(config_usage get_date get_prefix config_init dump_cache_par get_maint get_date check_arch %arch_comp get_package_prefix);
+use Data::Dumper;
+use URPM;
+use Iurt::DKMS;
+use Iurt::Urpmi;
+use Iurt::Chroot qw(add_local_user create_temp_chroot remove_chroot clean_unionfs clean_all_unionfs clean_all_chroot_tmp check_build_chroot clean_chroot);
+use Iurt::Process qw(perform_command clean kill_for_good sudo);
+use Iurt::Mail qw(sendmail);
+use Iurt::Util qw(plog_init plog);
+use File::NCopy qw(copy);
+use File::Path qw(mkpath);
+use File::Spec::Functions qw(rel2abs);
+use File::Basename qw(fileparse);
+# I did not manage to make locks work over the network
+#use File::lockf;
+use Mkcd::Commandline qw(parseCommandLine usage);
+use MDK::Common;
+use Filesys::Df qw(df);
+
+my $program_name = 'iurt2';
+my $VERSION = '0.6.2';
+# sessing parameters
+my $sudo = '/usr/bin/sudo';
+my $arg = @ARGV;
+my (@params, %run);
+$run{program_name} = $program_name;
+
+$run{todo} = [];
+@params = (
+ # [ "one letter option", "long name option", "number of args (-X means ´at least X´)", "help text", "function to call", "log info"]
+ #
+ # no_rsync, config_help and copy_srpm kept for compatibility reasons
+ #
+ [ "", $program_name, 0, "[--cache] [--chrooted-urpmi <media prefix>] [--concurrent-run] [--config foo value] [--warn] [--verbose integer]
+ [--copy-srpm] [--debug] [--distro] [--no-rsync] [--clean user1 user2 user3] [--clean-all] [--shell] [--stop {p|c|i|l|b|a|s}]
+ [--use-system-distrib] [--dir] [--help foo?] [--log filename] [--group] [--unionfs]
+ [--upload [--markrelease] [--source]] [--dir] [--help foo?] [--log filename] [--unionfs] [--status] [--ignore-failure]
+ [--repository <distribution path>]
+ {--config_help | --dkms {--media <media regexp>}
+ --chroot --arch {i586|x86_64|ppc} --distro {cooker|2006.0|community/2006.0|...} } |
+ --rebuild {cooker|2006.0|community/2006.0|...} {i586|x86_64|ppc|...} {filename1.src.rpm} {filename2.src.rpm} ... {filenamen.src.rpm} }",
+ "$program_name is a perl script to rebuild automatically several rpm in chroot, given a sourcerpm repository, and mail authors or rebuilder when problems occurs.
+
+ e.g.: iurt --repository /dis/ -p foo\@foo.net -r cooker x86_64 /SRPMS/main/release/mkcd-4.2.5-1mdv2007.1.src.rpm",
+ sub { $arg or usage($program_name, \@params) }, "" ],
+ [ "", "distro", 1, "<distro>",
+ "Set the distribution",
+ sub { ($run{distro}) = @_; 1 }, "Setting the distribution" ],
+ [ "", "dkms", [
+ ["", "dkms", 0, "",
+ "Set the DKMS rebuild mode",
+ sub {
+ my ($tmp, @arg) = @_;
+ $tmp->[0] ||= {};
+ push @$tmp, @arg;
+ 1;
+ }, "Setting auto mode arguments"],
+ ["k", "kmedia", 1, "<kernel media regexp>",
+ "Media Regexp to limit the kernel search to",
+ sub { my ($tmp, $kmedia) = @_; $tmp->[0]{kmedia} = $kmedia; 1 }, "Limiting rebuild to the kernel in the given media regexp"],
+ ["m", "media", 1, "<media regexp>",
+ "Media Regexp to limit rebuild to",
+ sub { my ($tmp, $media) = @_; $tmp->[0]{media} = $media; 1 }, "Limiting rebuild to the given media regexp"],
+], "[options]",
+ "Set the DKMS rebuild mode",
+ sub { my ($opt) = @_; $run{dkms} = $opt; 1 }, "Running a DKMS rebuild run" ],
+ [ "a", "arch", 1, "<architecture>",
+ "Set the architecture",
+ sub { ($run{my_arch}) = @_; 1 }, "Setting architecture" ],
+ [ "", "cache", 0, "",
+ "Use the global cache file",
+ sub { $run{use_cache} = 1 }, "Activating cache use" ],
+ [ "", "copy-srpm", 0, "",
+ "Copy also the regenerated SRPM",
+ sub { $run{copy_srpm} = 1 }, "Activating the copy_srpm mode" ],
+ [ "", "copy_srpm", 0, "",
+ "Copy also the regenerated SRPM",
+ sub { $run{copy_srpm} = 1 }, "Activating the copy_srpm mode" ],
+ [ "c", "chroot", 0, "",
+ "Check chroot and update it if needed",
+ sub { $run{chroot} = 1 }, "Activating chroot updating" ],
+ [ "", "chrooted-urpmi", [
+ [ "", "chrooted-urpmi", 1, "",
+ "Create urpmi media inside the chroot instead of using --root (media prefix is like http:///server.mandriva.com/dis/)",
+ sub {
+ my ($tmp, @arg) = @_;
+ $tmp->[0] ||= {};
+ push @$tmp, @arg;
+ 1;
+ }, "Setting chrooted-urpmi options" ],
+ ["m", "media", -1, "<media1> <media2> ... <median>",
+ "Media to add instead of --distrib",
+ sub { my ($tmp, @media) = @_; $tmp->[0]{media} = \@media; 1 }, "Limiting rebuild to the kernel in the given media regexp"],
+ ] , "[options] <media prefix>",
+ "Create urpmi media inside the chroot instead of using --root (media prefix is like http:///server.mandriva.com/dis/)",
+ sub { my ($opt, $media) = @_; $opt->{rooted_media} = $media; $run{chrooted_urpmi} = $opt; 1 }, "Activating chroot media" ],
+ [ "", "clean-all", 0, "",
+ "Clean all remaining chroots for all the users",
+ sub { $run{clean_all} = 1 }, "Activating clean chroot flag" ],
+ [ "", "clean", -1, "<user 1> <user 2> ... <user n>",
+ "Clean remaining chroot before runing",
+ sub { $run{clean} = \@_ }, "Activating clean chroot flag" ],
+ [ "", "concurrent-run", 0, "",
+ "Allow several iurt to run on different machines (slower)",
+ sub { $run{concurrent_run} = 1 }, "Activating concurrent run checks" ],
+ [ "d", "dir", -1, "",
+ "Directory where to find packages to rebuild",
+ sub { $run{extra_dir} = \@_; 1 }, "Adding extra source packages directories" ],
+ [ "", "config", 2, "<configuration keyword> <value>",
+ "Override a configuration file variable",
+ sub { my ($key, $value) = @_; $run{config}{$key} = $value }, "Overriding configuration variable" ],
+ [ "", "config-help", 0, "",
+ "Explain configuration files keywords",
+ sub { $run{config_usage} = 1 }, "Activating debug mode" ],
+ [ "", "config_help", 0, "",
+ "Explain configuration files keywords",
+ sub { $run{config_usage} = 1 }, "Activating debug mode" ],
+ [ "", "debug", 0, "",
+ "Activate debug mode",
+ sub { $run{debug} = 1 }, "Activating debug mode" ],
+ [ "g", "group", 0, "",
+ "Activate group mode, packages will be compiled as a global set, not as individual packages",
+ sub { $run{group} = 1 }, "Activating the group mode" ],
+ [ "", "ignore-failure", 0, "",
+ "Do not take into account the failure cache, try to recompile all the packages not synchronized",
+ sub { $run{ignore_failure} = 1 }, "Activating the mode ignoring previous failure" ],
+ [ "u", "unionfs", 0, "",
+ "Activate unionfs mode",
+ sub { $run{unionfs} = 1 }, "Activating unionfs mode" ],
+ [ "l", "log", 1, "<log file>",
+ "Log file.",
+ sub {
+ $run{log} = pop @_;
+ open my $log, ">$run{log}" or die "unable to open $run{log}\n";
+ $run{LOG} = sub { print $log @_ };
+ print *$log, "command line: @ARGV\n";
+ 1;
+ }, "Log file" ],
+ [ "m", "media", -1, "<media 1> <media 2> ... <media 3>",
+ "Media to rebuild",
+ sub { ($run{media}) = @_; 1 }, "Adding a media to rebuild" ],
+ [ "n", "no", 0, "",
+ "Perform all the check but do not compile anything",
+ sub { ($run{no_compile}) = 1 }, "Setting the no compilation flag" ],
+ [ "p", "packager", 1, "<packager>",
+ "Use a specific packager",
+ sub { ($run{packager}) = @_ }, 'Setting packager tag'],
+ [ "r", "rebuild", -2, "<distro> <architecture> <srpm 1> <srpm 2> ... <srpm n>",
+ "Rebuild the packages, e.g. $program_name -r cooker x86_64 /home/foo/rpm/SRPMS/foo-2.3-12mdv2007.0.src.rpm",
+ sub {
+ $run{rebuild} = 1;
+ $run{distro} = shift @_;
+ $run{my_arch} = shift @_;
+
+ foreach (@_) {
+ my ($path, $srpm);
+
+ unless (-f $_ && -r $_) {
+ die "FATAL $program_name: $_ not a file or cannot be read\n";
+ }
+
+ ($srpm, $path) = fileparse(rel2abs($_));
+ ($srpm =~ /\.src\.rpm$/) || die "FATAL: $_ doesn't look like an SRPM";
+
+ if (check_arch($_, $run{my_arch})) {
+ plog('DEBUG', "force build for $2 (from $1)");
+ push @{$run{todo}}, [ $path, $srpm, 1 ];
+ } else {
+ plog("ERROR: $_ could not be build on $run{my_arch}, ignored.");
+ }
+ }
+ 1;
+ }, "Activating rebuild mode" ],
+ [ "", "upload", [
+ ["", "upload", 0, "[options]",
+ "Upload the rebuild packages",
+ sub { my ($tmp) = @_;
+ $tmp->[0] ||= {};
+ 1;
+ }, "Setting upload options"],
+ [ "m", "markrelease", 0, "",
+ "Mark SVN directory when uploading the packages",
+ sub { $run{markrelease} = 1 }, "Adding markrelease repsys option" ],
+ [ "s", "source", 0, "",
+ "Upload the source package as wells",
+ sub { $run{source_upload} = 1 }, "Setting source flag for upload" ],
+ ], "[options]",
+ "Upload the rebuild packages",
+ sub { $run{upload} = 1 }, "Setting the upload flag" ],
+ [ "", "use-old-chroot", 1, "<chroot path>",
+ "Use the given chroot as chroot (usefull for debugging)",
+ sub { ($run{use_old_chroot}) = @_ }, "Using given chroot" ],
+ [ "", "no_rsync", 0, "",
+ "Do not send build log to the distant rsync server",
+ sub { $run{no_rsync} = 1 }, "Setting the no rsync warn flag" ],
+ [ "", "no-rsync", 0, "",
+ "Do not send build log to the distant rsync server",
+ sub { $run{no_rsync} = 1 }, "Setting the no rsync warn flag" ],
+ [ "", "use-system-distrib", 1, "<media>",
+ "Use the current system urpmi configuration",
+ sub { $run{use_system_distrib} = shift; 1 }, "Setting system distrib for urpmi configuration" ],
+ [ "v", "verbose", 1, "<verbose level>",
+ "Give more info messages about what is going on (level from 1 to 10)",
+ sub { $run{verbose} = $_[0]; 1 }, "Setting verbose level" ],
+ [ "w", "warn", 0, "",
+ "Warn maintainer of the packages about problem in the rebuild",
+ sub { $run{warn} = 1; 1 }, "Setting warn flag to warn maintainers" ],
+ [ "", "shell", 0, "",
+ "Dump to a shell into the newly created chroot with sudo on rpm, urpmi, urpme and urpmi.addmedia",
+ sub {
+ ($run{shell}) = 1;
+ 1 }, "Setting option to dump to a shell" ],
+ [ "", "stop", 1, "<rpm step>",
+ "Perform rpm -b<rpm step> (p c i l b a s) instead of rpm -ba and then open a shell in the chroot",
+ sub {
+ ($run{stop}) = @_;
+ 1;
+ }, "Setting rpm build option" ],
+ [ "", "repository", 1, "<distribution root path>",
+ "Set a repository path if one is not created in the configuration file",
+ sub {
+ ($run{repository}) = @_;
+ 1;
+ } , "Setting the repository" ],
+ [ "", "status", 1, "<mail>",
+ "Send a status mail to the provided mail address",
+ sub {
+ ($run{status_mail}) = @_;
+ 1;
+ }, "Setting status mail option" ],
+ [ "", "with", 1, "<flag>",
+ "Use specified --with flag with rpm (can be used multiple times)",
+ sub {
+ ($run{with_flags}) = $run{with_flags} . " --with " . @_[0];
+ 1;
+ }, "Adding specified extra --with parameter to rpm" ],
+ [ "", "without", 1, "<flag>",
+ "Use specified --without flag with rpm (can be used multiple times)",
+ sub {
+ ($run{with_flags}) = $run{with_flags} . " --without " . @_[0];
+ 1;
+ }, "Adding specified extra --without parameter to rpm" ],
+);
+
+open(my $LOG, ">&STDERR");
+$run{LOG} = sub { print $LOG @_ };
+
+plog_init($program_name, $LOG, $run{verbose}, 1);
+#plog_init($program_name, $LOG, 7, 1); # CM: hardcoded for now, will fix ASAP
+
+
+# Display version information
+#
+(my $iurt_rev = '$Rev: 145712 $') =~ s/.*: (\d+).*/$1/;
+(my $iurt_aut = '$Author: blino $') =~ s/.*: (..).*/$1/;
+(my $iurt_dat = '$Date: 2007-03-18 09:25:20 -0300 (Sun, 18 Mar 2007) $')
+ =~ s/.*: ([\d-]* [\d:]*) .*/$1/;
+plog("MSG", "This is iurt2 revision $iurt_rev-$iurt_aut ($iurt_dat)");
+
+
+my $todo = parseCommandLine($program_name, \@ARGV, \@params);
+@ARGV and usage($program_name, \@params, "@ARGV, too many arguments");
+foreach my $t (@$todo) {
+ plog('DEBUG', $t->[2]);
+ &{$t->[0]}(@{$t->[1]}) or plog('ERR', $t->[2]);
+}
+
+$run{distro_tag} = $run{distro};
+$run{distro_tag} =~ s,/,-,g;
+
+my $real_arch = `uname -m`;
+chomp $real_arch;
+my $HOME = $ENV{HOME};
+my $configfile = "$HOME/.iurt.$run{distro_tag}.conf";
+
+plog('DEBUG', "load config: $configfile");
+my $config;
+if (-f $configfile) {
+ $config = eval(cat_($configfile))
+ or die "FATAL $program_name: syntax error in $configfile";
+} else {
+ $config = {};
+}
+
+if ($run{repository}) {
+ plog('DEBUG', "overriding configuration repository by the one given in the command line");
+ $config->{repository} = $run{repository}
+}
+
+if (!$config->{repository}) {
+ die "FATAL $program_name: no repository have been defined (use --repository to specify one on the command line"
+}
+
+my $urpmi = Iurt::Urpmi->new(run => \%run, config => $config, urpmi_options => "-v --no-verify-rpm --nolock --auto --ignoresize");
+$run{urpmi} = $urpmi;
+
+if (!$run{chrooted_urpmi} && $run{group}) {
+ die "FATAL $program_name: option --chrooted-urpmi is mandatory if --group is selected";
+}
+
+my %config_usage = (
+ admin => {
+ desc => 'Mail of the administrator of packages builds',
+ default => ''
+ },
+ all_media => {
+ desc => 'List of known media',
+ default => {
+ 'main' => [ '' ],
+ 'contrib' => [ '' ]
+ }
+ },
+ basesystem_media_root => {
+ desc => 'Name of the media holding basesystem packages',
+ default => sub {
+ my ($config, $run) = @_;
+ "$config->{repository}/$run->{distro}/$run->{my_arch}/";
+ }
+ },
+ basesystem_media => {
+ desc => 'Where to find basesystem packages',
+ default => 'main/release'
+ },
+ basesystem_packages => {
+ desc => 'List of packages needed for the chroot creation',
+ default => [
+ 'basesystem',
+ 'rpm-build',
+ 'rpm-mandriva-setup-build',
+ 'sudo',
+ 'urpmi',
+ 'curl',
+ ]
+ },
+ build_timeout => {
+ desc => 'Maximum build time after which the build process is terminated',
+ default => {
+ default => 18000,
+ },
+ },
+ cache_home => {
+ desc => 'Where to store the cache files',
+ default => "$HOME/.bugs"
+ },
+ cache_min_size => {
+ desc => 'Minimal size to consider a cache file valid',
+ default => 1000000
+ },
+ check_binary_file => {
+ desc => 'Packages rebuild should be checked, however sometime rpm is segfaulting and the test is not correct',
+ default => 0
+ },
+ iurt_root_command => {
+ desc => 'Program to run sudo command',
+ default => '/usr/sbin/iurt_root_command'
+ },
+ distribution => {
+ desc => 'Name of the packages distribution',
+ default => 'Mandriva Linux'
+ },
+ home => {
+ desc => 'Home dir',
+ default => $HOME
+ },
+ install_chroot_binary => {
+ desc => 'Tool used to create initial chroot',
+ default => 'install-chroot-tar.sh'
+ },
+ local_home => {
+ desc => 'Where to build packages',
+ default => $HOME
+ },
+ local_upload => {
+ desc => 'Where to store build packages and log',
+ default => ''
+ },
+ local_spool => {
+ desc => 'To override the directory where all the results are stored',
+ default => ''
+ },
+ log_size_limit => {
+ desc => 'Maximum authorized size for a log file',
+ default => '100M'
+ },
+ log_size_date => {
+ desc => 'Number of days log should be kept',
+ default => '30'
+ },
+ log_url => {
+ desc => 'Where the log can be seen',
+ default => ''
+ },
+ minimum_package_number => {
+ "Minimum number of packages in a synthesis file to consider it valid",
+ default => 1000
+ },
+ max_command_retry => {
+ "Maximum number of retry Iurt will perform for a given command",
+ default => 20
+ },
+ no_mail => {
+ desc => 'Hash table with people mail address where we should not send any mails',
+ default => {}
+ },
+ packager => {
+ desc => 'Name of the build bot',
+ default => 'Iurt'
+ },
+ prompt => {
+ desc => 'Default prompt in the chroot',
+ default => qq{PS1='[\\033[00;33m\\]iurt $run{distro}\\[\\033[00m\\]] \\[\\033[00;31m\\]\\u\\[\\033[00;32m\\]\\h\\[\\033[00m\\]\\w\$ '},
+ },
+ repository => {
+ desc => 'Prefix of the repositories',
+ default => ''
+ },
+ rsync_to => {
+ desc => 'Server where the result of the builds should be rsynced (name@server:path format)',
+ default => ''
+ },
+ sendmail => {
+ desc => 'If the bot will send mail reports regarding build',
+ default => 0
+ },
+ supported_arch => {
+ desc => 'Table of supported architecture',
+ default => ['i586', 'x86_64']
+ },
+ upload => {
+ desc => 'Where to copy build packages',
+ default => "$HOME/uploads/"
+ },
+ vendor => {
+ desc => 'Name of the packages vendor',
+ default => 'Mandriva'
+ },
+);
+
+config_usage() if $run{config_usage};
+$run{my_arch} or usage($program_name, \@params, "no architecture given (media $run{media}, run{my_arch} $run{my_arch}, todo", join(', ', @{$run{todo}}));
+if (!$arch_comp{$real_arch}{$run{my_arch}}) {
+ die "FATAL $program_name: could not compile $run{my_arch} binaries on a $real_arch";
+}
+config_init(\%config_usage, $config, \%run);
+
+$config->{upload} .= $run{distro};
+$config->{upload} =~ s/community//g;
+if ($run{distro} ne 'cooker') {
+ if ($run{media} ne 'main') {
+ $config->{upload} .= "/$run{media}";
+ }
+} elsif ($run{media} eq 'contrib') {
+ $config->{upload} =~ s/cooker/contrib/g;
+}
+
+my $lock = $run{media};
+my $local; # FIXME: (tv) variable $local assigned, but not read
+if (!$lock && $run{chroot}) {
+ $lock = 'chroot';
+ $local = 1;
+}
+if (!$lock && $run{dkms}) {
+ $lock = 'dkms';
+ $local = 0;
+}
+$run{lock} = $lock;
+
+# cache file name is needed early to remove the manual lock file if the
+# lock mechanism does not work
+
+mkpath $config->{cache_home};
+my $cachefile = "$config->{cache_home}/iurt.$run{distro_tag}.$run{my_arch}.$lock.cache";
+$run{cachefile} = $cachefile;
+if (!$run{debug} && $run{media} || $run{chroot}) {
+ $run{pidfile_home} = "$config->{cache_home}/";
+ $run{pidfile} = "iurt.$run{distro_tag}.$run{my_arch}.$lock";
+ check_pid(\%run);
+}
+
+$config->{local_upload} ||= $config->{local_home};
+my $local_spool;
+if ($config->{local_spool}) {
+ $local_spool = $config->{local_spool};
+} else {
+ $local_spool = "$config->{local_upload}/iurt/$run{distro_tag}/$run{my_arch}/$run{media}/";
+}
+
+# Squash double slashes
+$local_spool =~ y!/!!s;
+
+plog('INFO', "local spool: $local_spool");
+if (!-d "$local_spool/log") {
+ plog('DEBUG', "creating local spool $local_spool");
+ mkpath("$local_spool/log")
+ or die "FATAL: could not create local spool dir $local_spool ($!)";
+}
+$run{local_spool} = $local_spool;
+
+my $cache;
+my $clear_cache = 1;
+if (-f $cachefile && $run{use_cache}) {
+ plog('INFO', "loading cache file $cachefile");
+
+ $cache = eval(cat_($cachefile))
+ or plog('ERR', "FATAL: could not load cache $cachefile ($!)");
+
+ if (!$cache) {
+ opendir my $cache_dir, $config->{cache_home};
+ my $to_load;
+
+ foreach my $file (readdir $cache_dir) {
+ (my $date) = $file =~ /iurt\.$run{distro_tag}\.$run{my_arch}\.$run{media}\.cache\.tmp\.(\d{8})/ or next;
+ if ($date > $to_load && -s "$config->{cache_home}/$file" > $config->{cache_min_size}) {
+ $to_load = $date;
+ $cachefile = "$config->{cache_home}/$file";
+ }
+ }
+
+ plog('NOTIFY', "loading alternate cache file $cachefile");
+ $cache = eval(cat_($cachefile))
+ or plog('ERR', "FATAL: could not load cache $cachefile ($!)");
+ }
+ $clear_cache = 0 if $cache;
+}
+
+if ($clear_cache) {
+ $cache = {
+ rpm_srpm => {},
+ failure => {},
+ queue => {},
+ warning => {},
+ run => 1,
+ needed => {},
+ no_unionfs => {}
+ };
+}
+$run{cache} = $cache;
+
+my (%srpm_version, @wrong_rpm, %provides, %pack_provide, $to_compile, %maint);
+$to_compile = @{$run{todo}};
+$to_compile += check_media(\%run, $cache, $config, \%srpm_version,
+ \@wrong_rpm, \%provides, \%pack_provide, \%maint) if $run{media};
+$to_compile += search_packages(1, $cache, \%provides, \%run, \%maint,
+ \%srpm_version, @{$run{extra_dir}}) if $run{extra};
+
+my $dkms;
+if ($run{dkms}) {
+ $dkms = Iurt::DKMS->new(run => \%run, config => $config);
+ $to_compile += $dkms->search_dkms;
+}
+$run{to_compile} = $to_compile;
+
+dump_cache_par(\%run);
+
+plog("Packages to build: $to_compile");
+
+my ($fulldate, $daydate) = get_date();
+if ($run{use_cache}) {
+ $run{run} = $cache->{run};
+ $run{run} ||= 1;
+ $cache->{run} = $run{run} + 1;
+} else {
+ $run{run} = "0.$fulldate";
+}
+$run{daydate} = $daydate;
+plog('DEBUG', "using $run{run} as chroot extension");
+$run{user} = $ENV{SUDO_USER} || $ENV{USER};
+$run{uid} = getpwnam $run{user};
+
+plog('DEBUG', "using local user $run{user}, id $run{uid}");
+my $luser = $run{user} || 'builder';
+
+check_sudo_access()
+ or die "FATAL: you need to have sudo access to run $program_name";
+
+my $debug_tag = $run{debug} && '_debug';
+$run{debug_tag} = $debug_tag;
+if ($run{unionfs} && !$run{use_old_chroot}) {
+ plog(1, "adding unionfs module");
+ sudo(\%run, $config, "--modprobe", "unionfs") or $run{unionfs} = 0;
+ if ($run{unionfs}) {
+ $run{unionfs_dir} = "$config->{local_home}/iurt_unionfs$debug_tag/";
+ remove_chroot(\%run, $run{unionfs_dir}, \&clean_all_unionfs);
+ $run{unionfs_dir} = "$run{unionfs_dir}/$run{user}/";
+ -d $run{unionfs_dir} or mkdir $run{unionfs_dir};
+ }
+}
+
+my (%done, $done);
+$run{done} = \%done;
+my $home = $config->{local_home};
+my $union_id = 1;
+$run{unionfs_tmp} = $run{unionfs};
+
+my ($chroot_name, $chroot_tmp, $chroot, $chroot_tar);
+$chroot_name = "chroot_$run{distro_tag}$debug_tag";
+if (!$run{use_old_chroot}) {
+ $chroot_tmp = "$config->{local_home}/chroot_tmp";
+
+ if (!-d $chroot_tmp) {
+ mkdir $chroot_tmp;
+ } else {
+ remove_chroot(\%run, $chroot_tmp, \&clean_all_chroot_tmp, $chroot_name);
+ }
+
+ $chroot_tmp = "$config->{local_home}/chroot_tmp/$run{user}";
+ if (!-d $chroot_tmp) {
+ mkdir $chroot_tmp;
+ }
+ $chroot_tmp = "$config->{local_home}/chroot_tmp/$run{user}/$chroot_name.$run{run}";
+ $run{chroot_tmp} = $chroot_tmp;
+
+ $chroot = "$config->{local_home}/$chroot_name";
+} else {
+ plog(1, "using given chroot $run{use_old_chroot}");
+ $chroot_tmp = $run{use_old_chroot};
+ $chroot = $run{use_old_chroot};
+}
+$run{chroot_path} = $chroot;
+$chroot_tar = "$config->{local_home}/$chroot_name.$run{my_arch}.tar.gz";
+$run{chroot_tar} = $chroot_tar;
+# 20061222 warly
+# even in use_old_chroot mode we create the chroot if it does not exist (useful
+# if the option is used for the first time
+if ($run{chroot} || !-d "$chroot/dev") {
+ check_build_chroot($chroot, $chroot_tar, \%run, $config) or die "FATAL $program_name: could not prepare initial chroot";
+}
+
+# now exit if there is nothing to do and it was just a cleaning pass
+if ($run{no_compile} || !@{$run{todo}} && !$run{debug} && !$run{shell} && !$run{rebuild}) {
+ send_status_mail(\%run, $config, $cache) if $run{status_mail};
+ plog("no package to compile :(");
+ unlink "$run{pidfile_home}/$run{pidfile}" if $run{pidfile};
+ exit();
+}
+
+plog('DEBUG', "running with pid $$");
+$run{prefix} = get_prefix($luser);
+
+my $df = df $home;
+if ($df->{per} >= 99) {
+ die "FATAL: not enough space on the filesystem, only $df->{bavail} KB on $home, full at $df->{per}%";
+}
+
+if ($run{shell}) {
+ if (!$run{use_old_chroot}) {
+ ($union_id, my $chroot_tmp) = create_temp_chroot(\%run, $config,
+ $cache, $union_id, $chroot_tmp, $chroot_tar)
+ or die "FATAL $program_name: could not create temporary chroot";
+ }
+ add_local_user($chroot_tmp, \%run, $config, $luser, $run{uid}) or die "FATAL $program_name: could not add local user";
+
+ #$urpmi->set_command($chroot_tmp);
+ $urpmi->urpmi_command($chroot_tmp, $luser);
+
+ $urpmi->install_packages('chroot', $chroot_tmp, $local_spool, \%pack_provide, 'configure', "[ADMIN] installation of urpmi and sudo failed in the chroot $run{my_arch}", { check => 1, maintainer => $config->{admin} }, 'urpmi', 'sudo') or die "FATAL $program_name: could not add urpmi and sudo in the chroot";
+ add_sudoers(\%run, $chroot_tmp, $luser);
+ if ($run{shell}) {
+ plog('NOTIFY', "dumping to a chrooted shell into $chroot_tmp");
+ exec $sudo, 'chroot', $chroot_tmp, '/bin/su', '-', $luser, '-c', "$config->{prompt} bash";
+ die "FATAL $program_name: could not exec chroot to $chroot_tmp ($!)";
+ }
+}
+
+# perform some cleaning before running to have some more space, rsync to
+# the server too in case previous iurt crashed
+
+if ($config->{rsync_to} && !$run{no_rsync}) {
+ # remove some old and very big log files not to saturate the server
+ system(qq(find $local_spool/log/ -name "*.log" \\( -size +$config->{log_size_limit} -or -mtime +$config->{log_size_date} \\) -exec rm -f {} \\;));
+ system('rsync', '--delete', '-alHPe', 'ssh -xc arcfour', "$local_spool/log/", "$config->{rsync_to}/$run{distro_tag}/$run{my_arch}/$run{media}/log/");
+}
+
+if ($run{dkms} && $run{dkms_todo}) {
+ $done += $dkms->dkms_compile($local_spool, $done);
+}
+
+# The next loop should be moved in a module someday
+
+# FIXME: (tv) kill this dead code or use it!!
+my $_s = sub {
+ if ($run{main}) {
+ plog("dumping cache...");
+ dump_cache_par(\%run);
+ $Data::Dumper::Indent = 0;
+ $Data::Dumper::Terse = 1;
+ plog("Running environment:\n", Data::Dumper->Dump([\%run]), "\n");
+ plog("Configuration:\n", Data::Dumper->Dump([$config]), "\n");
+ }
+ exit();
+};
+#$SIG{TERM} = $s;
+#$SIG{INT} = $s;
+$run{main} = 1;
+
+my $rebuild;
+$run{group} = 0 if @{$run{todo}} == 1;
+if ($run{group}) {
+ $rebuild = 1;
+ $urpmi->set_local_media($local_spool);
+ $urpmi->order_packages($union_id, \%provides, $luser)
+ or die "FATAL $program_name: could not order packages";
+}
+#
+# The build loop
+#
+my $prev_done = $done;
+do {
+ $rebuild = 0;
+ $done = $prev_done;
+ for (my $i; $i < @{$run{todo}}; $i++) {
+ my ($dir, $srpm, $status) = @{$run{todo}[$i]};
+
+ # CM: Set argv[0] (in the C sense) to something we can easily spot and
+ # understand in process list
+ $0 = "Iurt: $run{distro_tag} $run{my_arch} $run{media} $srpm";
+
+ $status or next;
+ $done{$srpm} and next;
+ $done{$srpm} = 1;
+ check_version($srpm, \%srpm_version) or next;
+ if ($run{debug}) { $run{debug}++ == 2 and exit() }
+ $done++;
+ plog('NOTIFY', "Build package $srpm [$done/$to_compile]");
+ # FIXME unfortunately urpmi stalls quite often
+ my $retry = 0;
+
+ # current rpm is sometime segfaulting, and iurt is them blocked
+ # and cannot
+ #
+ # $cache->{failure}{$srpm} = 1;
+ # dump_cache(\%run);
+retry:
+ $urpmi->clean_urpmi_process;
+
+ if (!$run{use_old_chroot}) {
+ (my $u_id, $chroot_tmp) = create_temp_chroot(\%run, $config,
+ $cache, $union_id, $chroot_tmp, $chroot_tar, $srpm) or next;
+ $union_id = $u_id;
+ }
+
+ $urpmi->urpmi_command($chroot_tmp, $luser);
+ $srpm =~ /(.*)-[^-]+-[^-]+\.src\.rpm$/ or next;
+ my ($maintainer, $cc);
+ if (!$run{warn}) {
+ ($maintainer) = get_maint(\%run, $srpm);
+ $cc = $maint{$srpm};#, maintainers\@mandriva.com";
+ chomp $maintainer;
+ if (!$maintainer || $maintainer eq 'NOT_FOUND') {
+ $maintainer = $cc;
+ #$cc = 'maintainers@mandriva.com'
+ }
+ }
+ #($maintainer, $cc) = ($config->{admin},'');
+
+ plog('DEBUG', "creating user $luser in chroot");
+ add_local_user($chroot_tmp, \%run, $config, $luser, $run{uid}) or next;
+
+ my $old_srpm = $srpm;
+ my ($ret, $srpm, $spec) = $urpmi->recreate_srpm(\%run, $config,
+ $chroot_tmp, $dir, $srpm, $luser, $retry);
+ if ($ret == -1) {
+ $retry = 1;
+ goto retry;
+ } elsif (!$ret) {
+ # CM: experimental: fail if we can't regenerate the srpm
+ # This should eliminate bouncers that block the input queue
+ #
+ $srpm = $old_srpm;
+ $cache->{failure}{$srpm} = 1;
+ $run{status}{$srpm} = 'recreate_srpm_failure';
+ dump_cache_par(\%run);
+ dump_status($local_spool, \%run);
+ next;
+ }
+
+ (my $log_dirname = $srpm) =~ s/.*:(.*)\.src.rpm/$1/;
+ my $log_dir = "$local_spool/log/$log_dirname/";
+
+ # only create the log dir for the new srpm
+ mkdir $log_dir;
+ -d $log_dir or die "FATAL: could not create $log_dir (check permissions and group ownerships)";
+
+ plog('INFO', "Install build dependencies");
+ my $path_srpm = "$chroot_tmp/home/$luser/rpm/SRPMS/";
+
+ # on x86_64 the rpm database is getting corrupted and sometimes
+ # rpm do not found anymore installed packages, retrying several
+ # time to be sure something is really broken
+
+ my $ok = $urpmi->install_packages($srpm, $chroot_tmp, $local_spool, \%pack_provide, 'install_deps', "[REBUILD] install of build dependencies of $srpm failed on $run{my_arch}", { maintainer => $maintainer }, "$path_srpm/$srpm");
+ if (!$ok) {
+ $run{status}{$srpm} ||= 'install_deps_failure';
+ next;
+ }
+
+ # try to workarround the rpm -qa db4 error(2) from dbcursor->c_get:
+ # No such file or directory
+ # system("sudo chroot $chroot_tmp rm -rf /var/lib/rpm/__db* &> /dev/null");
+ system("$sudo chroot $chroot_tmp rpm --rebuilddb &> /dev/null");
+
+ perform_command("$sudo chroot $chroot_tmp rpm -qa",
+ \%run, $config, $cache,
+ logname => "rpm_qa",
+ hash => "rpm_qa_$srpm",
+ timeout => 60,
+ debug_mail => $run{debug},
+ log => $log_dir); # or next; As this failed quite often, do not stop
+ plog('NOTIFY', "Building $srpm");
+ my $command = "rpm --rebuild $run{with_flags} /home/$luser/rpm/SRPMS/$srpm";
+ if ($run{stop}) {
+ $urpmi->install_packages('chroot', $chroot_tmp, $local_spool, \%pack_provide, 'configure', "[ADMIN] installation of urpmi and sudo failed in the chroot $run{my_arch}", { check => 1, maintainer => $config->{admin} }, 'urpmi', 'sudo');
+ add_sudoers(\%run, $chroot_tmp, $luser);
+ $command = "rpm -b$run{stop} /home/$luser/rpm/SPECS/$spec";
+ }
+
+ my ($srpm_name) = $srpm =~ /(?:.*:)?(.*)-[^-]+-[^-]+\.src\.rpm$/;
+
+ if (!perform_command(qq(TMP=/home/$luser/tmp/ $sudo chroot $chroot_tmp /bin/su - $luser -c "$command"),
+ \%run, $config, $cache,
+ mail => $maintainer,
+ error => "[REBUILD] $srpm from $run{distro_tag} does not build correctly on $run{my_arch}",
+ logname => "build",
+ hash => "build_$srpm",
+ timeout => $config->{build_timeout}{$srpm_name} ? $config->{build_timeout}{$srpm_name} : $config->{build_timeout}{default},
+ srpm => $srpm,
+ debug_mail => $run{debug},
+ cc => $cc,
+ log => $log_dir,
+ error_regexp => 'rror.*ailed|Bad exit status|RPM build error',
+ callback => sub {
+ my ($opt, $output) = @_;
+ if ($run{stop}) {
+ plog("dumping to a chrooted shell into $chroot_tmp (pid $$)");
+ # exec does not work because it seems stdin and out are shared between children
+ system($sudo, 'chroot', $chroot_tmp, '/bin/su', '-', $luser, '-c', "$config->{prompt} bash");
+ exit();
+ }
+ plog('DEBUG', "calling callback for $opt->{hash}");
+ if ($run{unionfs_tmp} && $output =~ /no space left on device/i) {
+ plog('ERROR', "ERROR: running out of space to compile $srpm in unionfs mode, will recompile it in normal mode");
+ $cache->{no_unionfs}{$srpm} = 1;
+ return 1;
+ } elsif ($run{unionfs_tmp} && $output =~ m,$home,) {
+ plog('ERROR', "ERROR: seems like building $srpm needs to access /proc/self/exe, which is broken with unionfs, will try to recompile it in non unionfs mode");
+ $cache->{no_unionfs}{$srpm} = 1;
+ return 1;
+ } elsif ($output =~ /bin\/ld: cannot find -l(\S*)|configure.*error.* (?:-l([^\s]+)|([^\s]+) includes)/) {
+ my $missing = $1;
+ my @rpm = find_provides(\%run, \%pack_provide, $missing);
+ plog(5, "likely @rpm ($missing-devel) needed to rebuilt $srpm is not in build_requires");
+ if ($maintainer ne 'NOT_FOUND') {
+ $opt->{mail} = $maintainer;
+ #$opt->{mail} .= ", other_maint";
+ }
+ if (!$opt->{mail}) {
+ $opt->{mail} = $config->{admin};
+ }
+ if (@rpm > 1) {
+ $opt->{error} = "[MISSING_BUILD_REQUIRES_TAG] one of @rpm ($missing-devel), needed to build $srpm, is not in buildrequires";
+ } elsif (@rpm == 1) {
+ $opt->{error} = "[MISSING_BUILD_REQUIRES_TAG] @rpm ($missing-devel), needed to build $srpm, is not in buildrequires";
+ } else {
+ $opt->{error} = "[MISSING_BUILD_REQUIRES_TAG] $missing-devel, needed to build $srpm, is not in buildrequires";
+ }
+ $cache->{buildrequires}{$srpm}{$missing} = \@rpm;
+ return;
+ }
+ 1;
+ },
+ freq => 1)) {
+
+ # FIXME
+ # The simple algo used here is :
+ # try to compile it with unionfs, if it runs out of space,
+ # compile it without the next time
+ #
+ # This could be improved in keeping this srpm name for future
+ # version, but if we compile it on a new machine with more ram,
+ # or if next version compiles just fine with unionfs, we will
+ # loose the unionfs advantage.
+ #
+ # Maybe the right thing to do would be to first try to increase
+ # the tmpfs size (more than 50 % of the physical RAM), but this
+ # will lead to more swap usage, and slower compilation (and lost
+ # of the unionfs plus). Or to keep the faulty package a unionfs
+ # exception for some time, to save some more extra builds.
+
+ if (!glob "$chroot_tmp/home/$luser/rpm/RPMS/*/*.rpm") {
+ if ($run{unionfs_tmp} && $cache->{no_unionfs}{$srpm}) {
+ goto retry;
+ }
+ $cache->{failure}{$srpm} = 1;
+ $run{status}{$srpm} = 'build_failure';
+ # 20060615
+ dump_cache_par(\%run);
+ dump_status($local_spool, \%run);
+ next;
+ }
+ }
+
+ # do some cleaning if the compilation is successful
+ delete $cache->{needed}{$srpm} if defined $cache->{needed}{$srpm};
+ delete $cache->{buildrequires}{$srpm} if defined $cache->{buildrequires}{$srpm};
+ # FIXME It seems the glob is not correctly expanded any more, so listing the directory content to do so
+ opendir my $binfh, "$chroot_tmp/home/$luser/rpm/RPMS/";
+ my @packages;
+ foreach my $bindir (readdir $binfh) {
+ -d "$chroot_tmp/home/$luser/rpm/RPMS/$bindir" or next;
+ opendir my $rpmfh, "$chroot_tmp/home/$luser/rpm/RPMS/$bindir";
+ push @packages, map { "$chroot_tmp/home/$luser/rpm/RPMS/$bindir/$_" } grep { !/src\.rpm$/ && /\.rpm$/ } readdir $rpmfh;
+ }
+
+ # 20060810 warly We should fail here, but rpm is currently
+ # segfaulting when trying to install packages
+
+ if ($config->{check_binary_file}) {
+ $urpmi->install_packages($srpm, $chroot_tmp, $local_spool, \%pack_provide, 'binary_test', "[REBUILD] binaries packages generated from $srpm do not install correctly", { maintainer => $maintainer } ,@packages) or next;
+ } else {
+ my $successfile = "$local_spool/log/$srpm/binary_test_$srpm-1.log";
+ open my $f, ">$successfile";
+ print $f "$srpm build ok";
+ }
+
+ $run{status}{$srpm} = 'ok';
+ delete $cache->{failure}{$srpm} if defined $cache->{failure}{$srpm};
+ if ($run{debug}) {
+ plog("debug mode, skip other packages");
+ exit();
+ } elsif ($run{group}) {
+ # we should not move the package until they are all compiled
+ plog("group mode, keep packages for local media ($srpm is done $done)");
+ $run{done}{$srpm} = $done;
+ $urpmi->add_to_local_media($chroot_tmp, $srpm, $luser);
+ } else {
+ plog('OK', "build successful, copying packages to $local_spool.");
+
+ system("cp $chroot_tmp/home/$luser/rpm/RPMS/*/*.rpm $local_spool &>/dev/null") and plog('ERR', "ERROR: could not copy rpm files from $chroot_tmp/home/$luser/rpm/RPMS/ to $local_spool ($!)");
+
+ if ($run{copy_srpm}) {
+ # replace the old srpm
+ unlink "$local_spool/$old_srpm";
+
+ system("cp $chroot_tmp/home/$luser/rpm/SRPMS/$srpm $local_spool &>/dev/null") and plog('ERR', "ERROR: could not copy $srpm from $chroot_tmp/home/$luser/rpm/SRPMS/ to $local_spool ($!)");
+ }
+ process_queue($config, \%run, \@wrong_rpm, 1);
+ }
+ # dymp_cache each time so that concurrent process can get updated
+ dump_cache_par(\%run) if $run{concurrent_run};
+ }
+ if ($run{group}) {
+ for (my $i; $i < @{$run{todo}}; $i++) {
+ my (undef, $srpm) = @{$run{todo}[$i]};
+ if (!$run{done}{$srpm}) {
+ $rebuild = $urpmi->order_packages($union_id, \%provides, $luser);
+ last
+ }
+ }
+ if ($prev_done == $done) {
+ $rebuild = 0;
+ if ($done == @{$run{todo}}) {
+ plog('OK', "all packages succesfully compiled, copying packages to $local_spool.");
+ system("cp $chroot_tmp/home/$luser/rpm/RPMS/*/*.rpm $local_spool &>/dev/null") and plog('ERR', "ERROR: could not copy rpm files from $chroot_tmp/home/$luser/rpm/RPMS/ to $local_spool ($!)");
+ if ($run{copy_srpm}) {
+ system("cp $chroot_tmp/home/$luser/rpm/SRPMS/*.src.rpm $local_spool &>/dev/null") and plog('ERR', "ERROR: could not copy SRPMS from $chroot_tmp/home/$luser/rpm/SRPMS/ to $local_spool ($!)");
+ }
+ } else {
+ plog('FAIL', "some packages could not be compiled.");
+ }
+ }
+ }
+} while $rebuild;
+
+my ($unionfs_dir) = $run{unionfs_dir} =~ m!(.*)/[^/]+/?!;
+if (!$run{debug} && !$run{use_old_chroot}) {
+ if ($run{unionfs}) {
+ clean_unionfs("$unionfs_dir/$run{user}", \%run, $run{run}, $union_id);
+ } else {
+ clean_chroot($chroot_tmp, $chroot_tar, \%run, $config, 1);
+ }
+}
+plog("reprocess generated packages queue");
+process_queue($config, \%run, \@wrong_rpm);
+
+dump_cache_par(\%run);
+
+plog('FAIL', "ERROR: RPM with a wrong SRPM name") if @wrong_rpm;
+if (@wrong_rpm && open my $file, ">$local_spool/log/wrong_srpm_names.log") {
+ foreach (@wrong_rpm) {
+ print $file "$_->[1] -> $_->[0] (", $cache->{rpm_srpm}{$_->[1]}, ")\n";
+ }
+}
+
+dump_status($local_spool, \%run);
+
+send_status_mail(\%run, $config, $cache) if $run{status_mail};
+
+if ($config->{rsync_to} && !$run{no_rsync}) {
+ # remove some old and very big log files not to saturate the server
+ system(qq(find $local_spool/log/ -name "*.log" \\( -size +$config->{log_size_limit} -or -mtime +$config->{log_size_date} \\) -exec rm -f {} \\;));
+ system('rsync', '--delete', '-alHPe', 'ssh -xc arcfour', "$local_spool/log/", "$config->{rsync_to}/$run{distro_tag}/$run{my_arch}/$run{media}/log/");
+}
+
+# one last try to clean
+plog('DEBUG', "clean remaining unionfs");
+if ($run{unionfs} && !$run{use_old_chroot}) {
+ remove_chroot(\%run, $unionfs_dir, \&clean_all_unionfs);
+}
+unlink "$run{pidfile_home}/$run{pidfile}" if $run{pidfile};
+
+exit;
+
+
+#
+#
+#
+
+sub check_needed {
+ my ($srpm, $cache, $provides) = @_;
+ if (!defined $cache->{needed}{$srpm} && !ref $cache->{needed}{$srpm}) { return 1 }
+ my $ok = 1;
+ # migrate old cache format
+ my $ent = $cache->{needed}{$srpm};
+ if (ref $ent eq 'ARRAY') {
+ my $table = $ent;
+ $cache->{needed}{$srpm} = {};
+ foreach my $t (@$table) {
+ my ($missing, $version, $maint) = @$t;
+ $cache->{needed}{$srpm}{$missing} = {
+ version => $version,
+ maint => $maint
+ };
+ }
+ $ent = $cache->{needed}{$srpm};
+ }
+ foreach my $name (keys %$ent) {
+ my ($package, $version, $maint) = @{$ent->{$name}}{'package', 'version', 'maint'};
+ # if packages does not exist anymore, it may have been rebuild, then try to recompute the build dependencies
+ last if $package && !$provides->{$package};
+ my $p_version = $provides->{$name};
+ if ($p_version) {
+ next if $version == $p_version;
+ next if URPM::ranges_overlap($version, $p_version);
+ }
+ $ok = 0;
+ if ($version) {
+ $ent->{$name}{version} = $version;
+ }
+ my $v ||= $version;
+ if ($package) {
+ plog("ERROR: $srpm needs package $package which requires missing $name $v to be compiled.");
+ } else {
+ plog("ERROR: $srpm needs $name $v to be compiled.");
+ }
+ # try to recompile it once in a while
+ last if $cache->{warning}{"install_deps_$srpm"}{$maint}++ % 72;
+ return 1;
+ }
+ delete $cache->{needed}{$srpm} if $ok;
+ $ok;
+}
+
+sub process_queue {
+ my ($config, $run, $wrong_rpm, $quiet) = @_;
+ return if !$run->{upload} && $quiet;
+ my $dir = "$config->{local_upload}/iurt/$run->{distro_tag}/$run->{my_arch}/$run->{media}/";
+ opendir my $rpmdir, $dir or return;
+ my $urpmi = $run->{urpmi};
+ foreach my $rpm (readdir $rpmdir) {
+ my ($rarch, $srpm) = $urpmi->update_srpm($dir, $rpm, $wrong_rpm);
+ $rarch or next;
+ plog($rpm);
+ next if !$run->{upload};
+ # recheck if the package has not been uploaded in the meantime
+ my $rpms_dir = "$config->{repository}/$run->{distro}/$run->{my_arch}/media/$run->{media}/";
+ if (! -f "$rpms_dir/$rpm") {
+ my $err = system('/usr/bin/scp', "$dir/$rpm", $config->{upload} . "/$config->{extra_subdir}/RPMS/");
+ # try to keep the opportunity to prevent disk full
+ if ($err) {
+ plog("ERROR: process_queue: cannot copy $dir/$rpm to ", $config->{upload}, "/$config->{extra_subdir}/RPMS/ ($!)");
+ next;
+ }
+ }
+ if ($run->{upload_source}) {
+
+ }
+ unlink "$dir/$rpm";
+ $cache->{queue}{$srpm} = 1;
+ }
+ closedir $rpmdir;
+}
+
+sub check_version {
+ my ($srpm, $srpm_version) = @_;
+ my ($srpm_name) = $srpm =~ /(.*)-[^-]+-[^-]+\.src\.rpm/;
+ if (URPM::ranges_overlap("= $srpm", ">= $srpm_version->{$srpm_name}")) {
+ $srpm_version->{$srpm_name} = $srpm;
+ return 1;
+ }
+ 0;
+}
+
+sub check_pid {
+ my ($run, $local) = @_;
+ my $hostname = `hostname`;
+ chomp $hostname;
+ my $pidfile = $run->{pidfile};
+ my $lockfile = "$run->{pidfile_home}/$pidfile.$hostname.pid.lock";
+ plog("trying to lock $lockfile");
+ open my $lock, ">$lockfile";
+ my $lock_ok;
+ # lockf seems not to work, try to workarround, but this start to create lock on the lock for the lock of the file.
+ my $status = 1; #File::lockf::lock($lock);
+ if (!$status) {
+ $lock_ok = 1;
+ } else {
+ plog("ERROR: could not lock pid file (status $status $!)");
+ if (! -f "$lockfile.2") {
+ plog("using $lockfile.2 as lock file");
+ open my $lock2, ">$lockfile.2" or die "FATAL $program_name: could not open lock file $lockfile.2";
+ print $lock2 $$;
+ close $lock2;
+ }
+ }
+ if (!$run->{concurrent_run} && !$local) {
+ opendir my $dir, $run->{pidfile_home};
+ foreach my $f (readdir $dir) {
+ my ($pid_host) = $f =~ /$pidfile\.pid\.(.*)\.pid$/ or next;
+ if ($pid_host ne $hostname) {
+ my $pf = "$run->{pidfile_home}/$f";
+ open my $test_PID, $pf;
+ my $pid = <$test_PID>;
+ my (@stat) = stat $pf;
+ my $time = $stat[9];
+ my $diff = time()-$time;
+ my $msg = "$program_name: an other iurt is running for $run->{my_arch} on $pid_host, pid $pid, since $diff seconds";
+ if ($diff < 36000) {
+ plog("$msg\n");
+ exit();
+ } else {
+ plog("$msg, ignoring it");
+ }
+ }
+ }
+ }
+ $run->{pidfile} .= ".$hostname.pid";
+ $pidfile = "$run->{pidfile_home}/$run->{pidfile}";
+ if (-f $pidfile) {
+ my (@stat) = stat $pidfile;
+ open my $test_PID, $pidfile;
+ my $pid = <$test_PID>;
+ close $test_PID;
+ if (!$pid) {
+ plog("ERROR: invalid pidfile ($pid), should be <pid>");
+ unlink $pidfile;
+ }
+ if ($pid && getpgrp $pid != -1) {
+ my $time = $stat[9];
+ my $state = `ps h -o state $pid`;
+ chomp $state;
+ if ($time < time()-36000 || $state eq 'Z') {
+ plog("an other iurt pid $pid is running for a very long time or is zombie, killing it");
+ my $i;
+ while ($i < 5 && getpgrp $pid != -1) {
+ kill_for_good($pid);
+ $i++;
+ sleep 1;
+ }
+ } else {
+ plog("an other iurt is running for $run->{my_arch}, pid $pid, since ", time()-$time, " seconds");
+ exit();
+ }
+ } else {
+ plog("a previous iurt for $run->{my_arch} seems dead, cleaning.");
+ unlink $pidfile;
+ }
+ }
+ plog("setting $pidfile pid lock");
+ open my $PID, ">$pidfile" or die "FATAL $program_name: could not open pidfile $pidfile for writing";
+ print $PID $$;
+ close $PID;
+ if ($lock_ok) {
+ File::lockf::ulock($lock);
+ } else {
+ unlink "$lockfile.2";
+ }
+ close $lock;
+ unlink $lockfile;
+}
+
+sub check_media {
+ my ($run, $cache, $config, $srpm_version, $wrong_rpm, $provides, $pack_provide, $maint) = @_;
+# We could rely on only parsing the synthesis, hoping that they are correct, however this scan is very fast, so...
+ foreach my $subdir (@{$config->{all_media}{$run->{media}}}) {
+ my $rpms_dir = "$config->{repository}/$run->{distro}/$run->{my_arch}/media/$run->{media}/$subdir/";
+ plog("checking current packages in $rpms_dir");
+ opendir my $rpmdir, $rpms_dir or die "Could not open $rpms_dir: $!";
+ my $urpmi = $run->{urpmi};
+ foreach my $rpm (readdir $rpmdir) {
+ my ($rarch, $srpm) = $urpmi->update_srpm($rpms_dir, $rpm, $wrong_rpm);
+ $rarch or next;
+ $cache->{queue}{$srpm} = 1;
+ $run{status}{$srpm} = 'ok';
+ check_version($srpm, $srpm_version);
+ }
+ closedir $rpmdir;
+ }
+
+ foreach my $m (keys %{$config->{all_media}}) {
+ foreach my $subdir (@{$config->{all_media}{$m}}) {
+ my $synthesis_file = "$config->{repository}/$run->{distro}/$run->{my_arch}/media/$m/$subdir/media_info/synthesis.hdlist.cz";
+ if (-f $synthesis_file) {
+ plog("Parsing $synthesis_file");
+ if (open my $syn, "zcat $synthesis_file |") {
+ my @prov;
+ my $nb;
+ while (<$syn>) {
+ if (/^\@provides@(.*)/) {
+ foreach my $p (split '@', $1) {
+ if ($p =~ /([^[]+)(?:\[(.*)\])?/g) {
+ push @prov, $1;
+ $provides->{$1} = $2 || 1;
+ }
+ }
+ } elsif (/\@info\@([^@]+)@/) {
+ $nb++;
+ my $p = $1;
+ my ($name) = $p =~ /(.*)-[^-]+-[^-]+\./;
+ $provides->{$p} = 1;
+ foreach (@prov) {
+ $pack_provide->{$_} = $name;
+ }
+ @prov = ();
+ }
+ }
+ $nb < $config->{minimum_package_number} and die "FATAL $program_name: synthesis files seems corrupted, only $nb packages found.";
+ } else {
+ die "FATAL $program_name: Could not open $synthesis_file\n";
+ }
+ }
+ }
+ }
+ #"
+ my $nb;
+ foreach my $subdir (@{$config->{all_media}{$run->{media}}}) {
+ $nb += search_packages(0, $cache, $provides, $run, $maint, $srpm_version, "$config->{repository}/$run->{distro}/SRPMS/$run->{media}/$subdir/");
+ }
+ $nb;
+}
+
+sub search_packages {
+ my ($clean, $cache, $provides, $run, $_maint, $srpm_version, @dir) = @_;
+ my ($to_compile, %rep);
+ plog("iurt search_package: @dir");
+ foreach my $dir (@dir) {
+ plog("checking SRPMS dir $dir");
+ opendir my $rpmdir, $dir or next;
+ foreach my $srpm (readdir $rpmdir) {
+ # this is for the output of the new svn system
+ if ($srpm =~ /^\@\d+:(.*)/) {
+ link "$dir/$srpm", "$dir/$1";
+ # unlink "$dir/$srpm";
+ $srpm = $1;
+ }
+ $srpm =~ /(.*)-[^-]+-[^-]+\.src\.rpm$/ or next;
+ $run->{status}{$srpm} ||= 0;
+ if ($config->{unwanted_packages} && $srpm =~ /$config->{unwanted_packages}/) { next }
+ my $ok = 1;
+ if (check_version($srpm, $srpm_version)) {
+ if (!$run->{ignore_failure} && defined $cache->{failure}{$srpm}) {
+ $run->{status}{$srpm} = 'build_failure';
+ next;
+ }
+ my $check_needed = check_needed($srpm, $cache, $provides);
+ $run->{status}{$srpm} = 'missing_buildrequires' if !$check_needed;
+ -f "$dir/$srpm" or next;
+ if (!$cache->{queue}{$srpm} && $check_needed) {
+ if (!check_arch("$dir/$srpm", $run{my_arch})) {
+ $run->{status}{$srpm} = 'not_on_this_arch';
+ next;
+ }
+ my $hdr = RPM4::Header->new("$dir/$srpm");
+ my $changelog = $hdr->queryformat("%{CHANGELOGNAME}");
+ my ($mail) = $changelog =~ /<(.*@.*)>/;
+ $maint{$srpm} = $mail;
+ print "$program_name: will try to compile $srpm\n";
+ $to_compile++;
+ push @{$run->{todo}}, [ $dir , $srpm, 1 ];
+ }
+ foreach my $arch (@{$config->{supported_arch}}) { #FIXME: (tv) this loop looks suspiciously broken
+ $ok &&= $cache->{queue}{$srpm};
+ }
+ }
+ if ($clean && ($rep{$srpm} || $ok)) {
+ print "$program_name: cleaning $dir/$srpm\n";
+ unlink "$dir/build/$srpm";
+ unlink "$dir/$srpm";
+ }
+ $rep{$srpm} = 1;
+ }
+ closedir $rpmdir;
+ }
+ $to_compile;
+}
+
+sub add_sudoers {
+ my ($_run, $chroot, $user) = @_;
+ my $file = "$chroot/etc/sudoers";
+ my $f;
+ if (!open $f, qq(| $sudo sh -c "cat > $file")) {
+ plog("ERROR: could not open $file ($!)");
+ return 0;
+ }
+ print $f qq(Cmnd_Alias RPM=/bin/rpm,/usr/sbin/urpmi,/usr/sbin/urpme,/usr/sbin/urpmi.addmedia,/usr/sbin/urpmi.update,/usr/sbin/urpmi.removemedia
+root ALL=(ALL) ALL
+$user ALL=(ALL) NOPASSWD:RPM
+);
+ close $f;
+ plog("adding sudo for /bin/rpm, /usr/sbin/urpmi and /usr/sbin/urpme");
+ -f $file or return 0;
+ 1;
+}
+
+sub dump_status {
+ my ($local_spool, $run) = @_;
+ my $media = $run->{media} ? "$run->{media}." : "";
+ if (open my $file, ">$local_spool/log/status.${media}log") {
+ foreach my $srpm (sort keys %{$run->{status}}) {
+ print $file "$srpm: ";
+ if ($run{status}{$srpm}) {
+ print $file $run->{status}{$srpm};
+ } else {
+ print $file "unknown";
+ }
+ print $file "\n";
+ }
+ }
+}
+
+#
+# CM: FIXME: should notify in case of recreate_srpm_failure
+#
+
+sub send_status_mail {
+ my ($run, $config, $cache) = @_;
+ my %output;
+
+ print "iurt compilation status\n";
+
+ foreach my $rpm (keys %{$run->{status}}) {
+ next if $run->{status}{$rpm} =~ /ok|not_on_this_arch/;
+
+ if ($run->{status}{$rpm} eq 'missing_buildrequires') {
+ foreach my $missing (keys %{$cache->{needed}{$rpm}}) {
+ my $h = $cache->{needed}{$rpm}{$missing};
+ my $maint = $h->{maint} || 'Other';
+ my $package = $h->{package};
+ if ($package) {
+ push @{$output{missing}{$maint}{$package}{$missing}{$h->{version}}}, $rpm;
+ } else {
+ $output{missing}{$maint}{$rpm}{$missing}{$h->{version}} = 1;
+ }
+ }
+ } elsif ($run->{status}{$rpm} eq 'build_failure') {
+ my ($maint) = get_maint($run, $rpm);
+ if ($cache->{buildrequires}{$rpm}) {
+ push @{$output{buildrequires}{$maint}}, $rpm;
+ } else {
+ push @{$output{build}{$maint}}, $rpm;
+ }
+ } elsif (!$run->{status}{$rpm}) {
+ # need to find something more usefull to do at that point
+ next;
+ }
+ }
+
+ my $text = "*** Missing buildrequires tag in specfile ***\n";
+ foreach my $maint (keys %{$output{buildrequires}}) {
+ $text .= "\n$maint\n";
+ foreach my $pack (keys %{$output{missing}{$maint}}) {
+ foreach my $missing (keys %{$cache->{buildrequires}{$pack}}) {
+ my $rpms = $cache->{buildrequires}{$pack}{$missing};
+ if (@$rpms) {
+ $text .= " $pack should have a buildrequires on @$rpms (for $missing-devel)\n";
+ } else {
+ $text .= " $pack should have a buildrequires for $missing-devel\n";
+ }
+ }
+ }
+ }
+
+ $text = "*** Missing dependencies ***\n";
+ foreach my $maint (keys %{$output{missing}}) {
+ $text .= "\n$maint\n";
+ foreach my $pack (keys %{$output{missing}{$maint}}) {
+ foreach my $missing (%{$output{missing}{$maint}{$pack}}) {
+ my $h = $output{missing}{$maint}{$pack}{$missing};
+ foreach my $version (keys %$h) {
+ if (ref $h->{$version}) {
+ $text .= " $pack should be recompile because\n $missing " . ($version ? "$version " : '') . "is not provided anymore\n";
+ $text .= " to compile " . join("\n ", @{$h->{$version}}) . "\n";
+ } else {
+ $text .= " $pack needs $missing " . ($version ? "$version " : '') . "\n";
+ }
+ }
+ }
+ }
+ }
+ $text .= "\n*** Build failure ***\n";
+ foreach my $maint (keys %{$output{build}}) {
+ $text .= "\n$maint\n";
+ foreach my $rpm (@{$output{build}{$maint}}) {
+ $text .= " $rpm (see $config->{log_url}/$run{distro_tag}/$run{my_arch}/$run->{media}/log/$rpm/)\n";
+ }
+ }
+ print "$text\n";
+ sendmail($run->{status_mail}, '' , "Iurt report for $run->{my_arch}/$run->{media}", $text, "Iurt the rebuild bot <$config->{admin}>", 0);
+}
+
+sub find_provides {
+ my ($_run, $pack_provide, $p) = @_;
+ my @rpm;
+ foreach my $provides (keys %{pack_provide}) {
+ if ($provides =~ /$p/ && $provides =~ /devel/) {
+ push @rpm, $pack_provide->{$provides};
+ }
+ }
+ @rpm;
+}
+
+sub check_sudo_access() {
+ open my $right, "$sudo -l |";
+ return 1 if ! $<;
+ local $_;
+ while (<$right>) {
+ /\(ALL\)\s+NOPASSWD:\s+ALL/ and return 1;
+ }
+ 0;
+}
+
+__END__
+
+Discussion
+
+20061222 Warly
+ Group building
+ For the group building, we need to order the source packages, the problem is that we do not
+ really know what will be the provides of the resulting packages before building the.
+ We could guess them by looking to older version, but that means that we need to have an access to
+ the media deps files (synthesis should be enough).
+ We can also perform a first pass of build to check which package build and then what are their
+ provides. For the second pass, we will them be able to use the previously build packages to
+ solve buildrequires.
diff --git a/ulri b/ulri
new file mode 100755
index 0000000..a499759
--- /dev/null
+++ b/ulri
@@ -0,0 +1,786 @@
+#!/usr/bin/perl
+#
+# Copyright (C) 2005,2006 Mandriva
+#
+# Author: Florent Villard <warly@mandriva.com>
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2, or (at your option)
+# any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+#
+# compare and rebuild packages on different architecture
+#
+# TODO
+#
+# - create a configuration file to handle the various iurt running
+# - get the content of the rebuild dir
+# - run as many iurt as machines are available and gather results
+# - the scheduler just take the results, launch new rebuild, and quit
+# - use perl ssh and try to workarround the non working timeout when the
+# remote machine is stalled
+# - use submitter as packager, not generic name
+#
+
+use strict;
+use MDK::Common;
+use Iurt::Config qw(config_usage get_date config_init dump_cache init_cache get_repsys_conf check_arch check_noarch);
+use Iurt::Process qw(check_pid);
+use Iurt::File qw(check_upload_tree);
+use Iurt::Mail qw(sendmail);
+use Iurt::Util qw(plog_init plog ssh_setup ssh sout sget sput);
+use File::Copy 'move';
+use File::Path 'mkpath';
+use File::Temp 'mktemp';
+use Filesys::Df qw(df);
+use Data::Dumper;
+
+my %run;
+my $program_name = 'ulri';
+$run{program_name} = $program_name;
+
+open(my $LOG, ">&STDERR");
+$run{LOG} = sub { print $LOG @_ };
+
+plog_init($program_name, $LOG, 7, 1);
+
+my $HOME = $ENV{HOME};
+my $configfile = "$HOME/.upload.conf";
+
+my $config;
+if (-f $configfile) {
+ $config = eval(cat_($configfile)) or die "FATAL $program_name: syntax error in $configfile";
+} else {
+ $config = {};
+}
+
+my %config_usage = (
+ admin => {
+ desc => 'mail address of the bot administrator',
+ default => 'warly@mandriva.com'
+ },
+ 'arch_translation' => {
+ desc => "Renaming of arch",
+ default => { 'sparc64' => 'sparcv9' }
+ },
+ bot => {
+ desc => "List of bot able to compile the packages",
+ default => {
+ i586 => {
+ n1 => {
+ iurt => {
+ user => 'mandrake' ,
+ command => 'sudo -u mandrake -H /usr/local/bin/iurt2.sh --copy_srpm --group -v 1 --config local_spool /export/home/mandrake/iurt/__DIR__ --no_rsync --chrooted-urpmi http://kenobi/dis/ -r __TARGET__ __ARCH__',
+ packages => '/export/home/mandrake/iurt/',
+ log => '/export/home/mandrake/iurt/',
+ } ,
+ },
+ },
+ },
+ },
+ media => {
+ desc => 'Corresponding media to add given the current media',
+ default => {
+ default => {
+ "main/release" => [ "main/release", "main/updates" ],
+ "main/updates" => [ "main/release", "main/updates" ],
+ "main/testing" => [ "main/release", "main/updates",
+ "main/testing" ],
+ "main/backports" => [ "main/release", "main/updates",
+ "main/testing", "main/backports" ],
+ "contrib/release" => [ "main/release", "main/updates",
+ "contrib/release", "contrib/updates" ],
+ "contrib/updates" => [ "main/release", "main/updates",
+ "contrib/release", "contrib/updates" ],
+ "contrib/testing" => [ "main/release", "main/updates",
+ "main/testing", "contrib/release", "contrib/updates",
+ "contrib/testing" ],
+ "contrib/backports" => [ "main/release", "main/updates",
+ "main/testing", "main/backports", "contrib/release",
+ "contrib/updates", "contrib/testing",
+ "contrib/backports" ],
+ "non-free/release" => [ "main/release", "main/updates",
+ "non-free/release", "non-free/updates" ],
+ "non-free/updates" => [ "main/release", "main/updates",
+ "non-free/release", "non-free/updates" ],
+ "non-free/testing" => [ "main/release", "main/updates",
+ "main/tessting", "non-free/release",
+ "non-free/updates", "non-free/testing" ],
+ "non-free/backports" => [ "main/release", "main/updates",
+ "main/testing", "main/backports", "non-free/release",
+ "non-free/updates", "non-free/testing",
+ "non-free/backports" ],
+ },
+ },
+ },
+ default_mail_domain => {
+ desc => "Default mail domain to append",
+ default => 'mandriva.org'
+ },
+ faildelay => {
+ desc => "Time after which the rebuild is considered as a failure",
+ default => 36000
+ },
+ http_queue => {
+ desc => 'Address where log can be consulted',
+ default => 'http://kenobi.mandriva.com/queue/'
+ },
+ queue => {
+ desc => "Root of the tree where the packages to compile are located",
+ default => "/home/mandrake/uploads/"
+ },
+ cache_home => {
+ desc => 'Where to store the cache files',
+ default => "$HOME/.bugs"
+ },
+ repsys_conf => {
+ desc => 'Path of repsys.conf which includes login mail corresponding',
+ default => '/etc/repsys.conf'
+ },
+ tmp => {
+ desc => "Temporary directory",
+ default => "$HOME/tmp/"
+ },
+ ssh_options => {
+ desc => "SSH options",
+ default => "-o ConnectTimeout=20 -o BatchMode=yes"
+ },
+ packager => {
+ desc => 'Default packager tag user by bot',
+ default => 'Mandriva Team <http://www.mandrivaexpert.com>'
+ },
+);
+config_usage(\%config_usage, $config) if $run{config_usage};
+config_init(\%config_usage, $config, \%run);
+
+my %untranslated_arch;
+foreach my $k (keys %{$config->{arch_translation}}) {
+ my $v = $config->{arch_translation}{$k};
+ push @{$untranslated_arch{$v}}, $k;
+}
+
+my $mail = get_repsys_conf($config->{repsys_conf});
+
+$run{pidfile_home} = $config->{tmp};
+$run{pidfile} = "upload";
+my $pidfile = check_pid(\%run);
+
+#my $cache = init_cache(\%run, $config, { done => {} });
+my $cache = { done => {} };
+
+my ($fulldate, $daydate) = get_date();
+$run{daydate} = $daydate;
+
+my $df = df $config->{queue};
+if ($df->{per} == 100) {
+ # FIXME should send a mail too
+ die "FATAL $program_name: not enough space on the filesystem, only $df->{bavail} KB on $config->{queue}, full at $df->{per}%";
+}
+
+($fulldate, $daydate) = get_date();
+
+my %pkg_tree;
+my $compildone = $cache->{done};
+
+my $todo = "$config->{queue}/todo/";
+my $failure = "$config->{queue}/failure/";
+my $done = "$config->{queue}/done/";
+
+# Raise this when the noarch package starts to build on any bot
+my %noarch_build;
+
+#
+# Part 0: gather data from upload tree
+#
+
+plog('MSG', "check uploads tree");
+
+# A list of what is currently building so we can report at the end
+#
+my %build_list;
+
+plog('DEBUG', "input queue is $todo");
+
+sub todo_func {
+ my ($todo, $f, $m, $s, $r) = @_;
+
+ if ($r =~ /(\d{14}\.(\w+)\.\w+\.\d+)_(.*\.src\.rpm)$/) {
+ my ($prefix, $user, $srpm) = ($1, $2, $3);
+
+ plog('DEBUG', "found srpm $srpm ($prefix)");
+ $pkg_tree{$prefix}{path} = "/$f/$m/$s";
+ $pkg_tree{$prefix}{media} = "$m/$s";
+ $pkg_tree{$prefix}{target} = $f;
+ $pkg_tree{$prefix}{user} = $user;
+ push @{$pkg_tree{$prefix}{srpms}} , $srpm;
+ my ($name) = $srpm =~ /(.*)-[^-]+-[^-]+\.src\.rpm$/;
+
+ return $pkg_tree{$prefix}{srpm_name}{$name} = $srpm;
+ }
+
+ if ($r =~ /(\d{14}\.\w+\.\w+\.\d+)_([\w-]+)\.(\w+)\.(\w+)\.(\d{14})\.(\d+)\.lock$/) {
+ my ($prefix, $arch, $bot, $host, $date, $pid) = ($1, $2, $3, $4, $5, $6);
+
+ $arch = $config->{arch_translation}{$arch} if $config->{arch_translation}{$arch};
+ plog('DEBUG', "found lock on $host/$arch for $prefix");
+
+ # Only for build status reporting
+ #
+ push @{$build_list{"$host/$arch"}}, $prefix;
+
+ if ($arch =~ /noarch/) {
+ plog('DEBUG', "... and $prefix is noarch");
+ $noarch_build{$prefix} = 1;
+ $arch =~ s/-.*//;
+ }
+
+ $run{bot}{$arch}{$host}{$bot} = $prefix;
+
+ # this should be in the cache, but waiting for a cache-clean option
+ $compildone->{$prefix}{$arch} = 1;
+
+ my $time = read_line("$todo/$f/$m/$s/$r");
+ $time = (split ' ', $time)[2];
+ push @{$pkg_tree{$prefix}{bot}}, {
+ bot => $bot,
+ host => $host,
+ date => $date,
+ pid => $pid,
+ 'arch' => $arch,
+ 'time' => $time
+ };
+ }
+}
+
+sub todo_post {
+ my ($todo, $f, $m, $s, $r) = @_;
+
+ if ($r =~ /([^_]*)_(.*).lock$/) {
+ if (!$pkg_tree{$1}{srpms}) {
+ plog('INFO', "cleaning orphan $r");
+ unlink "$todo/$f/$m/$s/$r";
+ }
+ }
+}
+
+sub done_func {
+ my ($_todo, $_f, $_m, $_s, $r) = @_;
+
+ if ($r =~ /(\d{14}\.\w+\.\w+\.\d+)_(.*)\.(done|fail|excluded)$/) {
+ my ($prefix, $arch) = ($1, $2);
+ $arch = $config->{arch_translation}{$arch} if $config->{arch_translation}{$arch};
+ $compildone->{$prefix}{$arch} = 1;
+ } elsif ($r =~ /(\d{14}\.\w+\.\w+\.\d+)_(.*\.([^.]+)\.rpm)$/) {
+ my ($prefix, $rpm) = ($1, $2);
+ plog('DEBUG', "found already built rpm $rpm ($prefix)");
+ push @{$pkg_tree{$prefix}{rpms}} , $rpm;
+ }
+}
+
+
+check_upload_tree(\%run, $todo, \&todo_func, \&todo_post);
+
+# getting already compiled packages
+# The cache should not be needed if the .done file are removed as the same
+# time as the src.rpm in the todo tree
+check_upload_tree(\%run, $done, \&done_func,);
+
+
+#
+# Part 1: get results from finished builds
+#
+
+plog('MSG', "check build bot results");
+
+my %later;
+foreach my $prefix (keys %pkg_tree) {
+ my $ent = $pkg_tree{$prefix};
+ my $path = $ent->{path};
+ my $user = $ent->{user};
+
+ # Local pathnames
+ my $done_dir = "$done/$path";
+ my $todo_dir = "$todo/$path";
+ my $fail_dir = "$failure/$path";
+
+ bot: foreach my $bot_list (@{$ent->{bot}}) {
+ my ($bot, $host, $date, $pid, $arch, $time) =
+ @$bot_list{qw(bot host date pid arch time)};
+
+ my $bot_conf = $config->{bot}{$arch}{$host}{$bot};
+ my $remote = ssh_setup($config->{ssh_options},
+ $bot_conf->{user}, $host);
+
+ # If our build is noarch, set arch appropriately.
+ #
+ my $lock_file =
+ "$todo_dir/${prefix}_$arch-noarch.$bot.$host.$date.$pid.lock";
+
+ if (-f $lock_file) {
+ plog('DEBUG', "$prefix is noarch");
+ $arch = "noarch";
+ } else {
+ $lock_file =~ s/-noarch//;
+ }
+
+ my $prefix_dir = "$bot_conf->{packages}/$path/$prefix/";
+ my $status_file = "$prefix_dir/log/status.log";
+
+ plog('INFO', "check status: $host/$arch ($bot [$pid])");
+ my $status = sout($remote, "cat $status_file");
+ my $success;
+ my $fail;
+ my $later;
+
+ # Check if the build bot finished on the other side
+ #
+ if ($status) {
+ plog('INFO', "check result: $host/$arch ($bot [$pid])");
+ foreach my $res (split "\n", $status) {
+ my ($p, $r) = $res =~ /(.*):\s+(.*)/;
+ plog('DEBUG', $res);
+ if ($r eq 'install_deps_failure') {
+ plog('FAIL', "install deps failure, rebuild later: $p");
+ $later{$prefix} = 1;
+ $later = 1;
+ }
+ if ($r ne 'ok') {
+ plog('FAIL', "$r: $p");
+ $fail = 1;
+ }
+ }
+
+ if (!$fail) {
+ my @list = split "\n", sout($remote, "ls $prefix_dir");
+ my $error;
+
+ my $arch_check = join '|', $arch, if_($untranslated_arch{$arch}, @{$untranslated_arch{$arch}});
+ plog('MSG', "checking for $arch_check arch");
+ foreach my $result (@list) {
+ $result =~ /\.(src|$arch_check|noarch)\.rpm$/ or next;
+
+ # do not copy the initial src package
+ $result =~ /^$prefix/ and next;
+
+ my $result_file = "$done_dir/${prefix}_$result";
+ my $done_file = "$done_dir/${prefix}_$arch.done";
+
+ plog('OK', "build ok: $result");
+ $compildone->{$prefix}{$arch} = 1;
+
+ plog('DEBUG', "copy files to done");
+ mkpath($done_dir);
+ if (sget($remote, "$prefix_dir/$result",
+ "$result_file.new")) {
+ plog('ERR', "copying $result from $host failed ($!)");
+ $error = 1;
+ last;
+ } elsif (move("$result_file.new", $result_file)) {
+ create_file($done_file, "$bot $host");
+ $success = 1;
+ }
+ }
+ next if $error;
+
+ # Do nothing if the scp failed, wait for the other run
+ # (it may be a disk full problem)
+ # next if $error;
+ #if ($success) {
+ # The SRPM should be recreated thus no need to copy it
+ # foreach my $srpm (@{$ent->{srpms}}) {
+ # plog("linking $todo_dir/${prefix}_$srpm to $done_dir/${prefix}_$srpm");
+ # link "$todo_dir/${prefix}_$srpm", "$done_dir/${prefix}_$srpm"
+ # }
+ # FIXME Have to remove remote remaining packages and directory
+ #}
+ }
+ } # if ($status)
+
+ #
+ # Handle build failure
+ #
+
+ my $proc_state;
+ if (!$fail) {
+ chomp($proc_state = sout($remote, "ps h -o state $pid"));
+ }
+
+ my $seconds = time()-$time;
+
+ # Reasons for failure
+ my $timeout = $seconds > $config->{faildelay};
+ my $zombie = $proc_state eq 'Z';
+ my $ended = !$proc_state;
+
+ unless ($success || $later || $fail || $timeout || $zombie || $ended) {
+ next bot;
+ }
+
+ plog('INFO', "delete lock file for $prefix");
+ unlink $lock_file;
+
+ $run{bot}{$arch}{$host}{$bot} = 0;
+
+ if ($later) {
+ next bot;
+ }
+
+ if (!$ended && !$fail) {
+ plog('FAIL', "$bot timed out on $host/$arch ($seconds sec) or " .
+ "it's dead (status $proc_state), removing lock");
+ $compildone->{$prefix}{$arch} = 0;
+ next bot;
+ }
+
+ if ($success && !$fail) {
+ next bot;
+ }
+
+ if (!$status) {
+ plog('ERR', "build bot died on $host, reschedule compilation");
+ next bot;
+ }
+
+ plog('FAIL', "build failed");
+ create_file("$done_dir/${prefix}_$arch.fail", "$bot $host");
+ mkpath($fail_dir);
+
+ if (sget($remote, "$prefix_dir/", "$fail_dir/")) {
+ plog('ERR', "copying from $host:$prefix_dir/ " .
+ "to $fail_dir/ failed ($!)");
+ $compildone->{$prefix}{$arch} = 0;
+ # clean the log on the compilation machine
+ ssh($remote, "rm -rf $prefix_dir");
+ next bot;
+ }
+
+ # What to do with the previously build packages? Move them to
+ # failure, rejected ?
+ # 20061220 warly move them to failure for now
+
+ foreach my $rpm (@{$ent->{rpms}}) {
+ my $file = "$done_dir/${prefix}_$rpm";
+ plog('DEBUG', "moving built rpm $file to $fail_dir/${prefix}_$rpm");
+ link $file, "$fail_dir/${prefix}_$rpm";
+ unlink $file;
+ }
+ # Should clean the queue
+ # Must remove the SRPM and the lock
+ foreach my $srpm (@{$ent->{srpms}}) {
+ my $file = "$todo_dir/${prefix}_$srpm";
+ plog('DEBUG', "moving $file to $fail_dir/${prefix}_$srpm");
+ link $file, "$fail_dir/${prefix}_$srpm";
+ delete $pkg_tree{$prefix};
+ unlink $file;
+ }
+
+ # Notify user if build failed
+ #
+ if ($user) {
+ my $text = "Build of the following packages failed:\n\n";
+ my $srpms = "";
+ foreach my $srpm (@{$ent->{srpms}}) {
+ $srpms .= "$srpm ";
+ $text .= "- $srpm\n";
+ }
+
+ my $to = $mail->{$user} || "$user\@$config->{default_mail_domain}";
+ my $fpath = "$config->{http_queue}/failure/$path/$prefix";
+ $fpath =~ tr!/!!s; # Squash double slashes ...
+ $fpath =~ s!/!//!; # ... except for http://
+
+ $text .= "\nFailure details available in $fpath\n";
+ sendmail($to, $config->{admin},
+ "Rebuild failed on $arch for $srpms", $text,
+ "Ulri the scheduler bot <$config->{admin}>", 0);
+ }
+
+ # clean the log on the compilation machine
+ ssh($remote, "rm -rf $prefix_dir");
+
+ } # end bot
+} # end prefix
+
+
+#
+# Part 2: check queue and start new jobs if a bot is available
+#
+
+plog('MSG', "launching new compilations");
+my %to_compile;
+
+# do not sort the keys to be able to ignore packages which makes iurt
+# crash or just lock ulri somehow
+
+foreach my $prefix (sort keys %pkg_tree) {
+ next if $later{$prefix};
+ my $ent = $pkg_tree{$prefix};
+ my $path = $ent->{path};
+ my $media = $ent->{media};
+ my $target = $ent->{target};
+ my $srpms = $ent->{srpms} or next;
+ my $user = $ent->{user};
+ if ($user) {
+ $user = $mail->{$user} || $config->{packager}
+ } else {
+ $user = $config->{packager}
+ }
+ $user =~ s/([<>])/\\$1/g;
+
+ # Local pathnames
+ my $done_dir = "$done/$path";
+ my $todo_dir = "$todo/$path";
+
+ # Make sure these exist
+ mkpath($done_dir);
+ mkpath($todo_dir);
+
+ #plog('DEBUG', "searching a bot to compile @$srpms");
+
+ # count noarch todos only once even if searching multiple bots
+ my $noarch_countflag = 0;
+
+ # need to find a bot for each arch
+ foreach my $arch (keys %{$config->{bot}}) {
+ my $exclude;
+ my $noarch;
+
+ # Skip this arch if package is building as noarch
+ #
+ next if $noarch_build{$prefix};
+
+ next if $compildone->{$prefix}{noarch};
+ next if $compildone->{$prefix}{$arch};
+
+ # If all packages in a group are noarch, consider the entire group
+ # as noarch
+ #
+ $noarch = 1;
+ foreach my $srpm (@$srpms) {
+ if (!check_noarch("$todo_dir/${prefix}_$srpm")) {
+ $noarch = 0;
+ last;
+ }
+ }
+
+ #plog("@$srpms is noarch") if $noarch;
+
+ foreach my $srpm (@$srpms) {
+ if (!check_arch("$todo_dir/${prefix}_$srpm", $arch)) {
+ plog('WARN', "excluding from $arch: $srpm");
+ $exclude = 1;
+ last;
+ }
+ }
+
+ if ($exclude) {
+ create_file("$done_dir/${prefix}_$arch.excluded",
+ "ulri $arch excluded");
+ next;
+ }
+
+ if ($noarch) {
+ plog('DEBUG', "search any bot for @$srpms") unless $noarch_countflag;
+ } else {
+ plog('DEBUG', "search $arch bot for @$srpms");
+ }
+
+ foreach my $host (keys %{$config->{bot}{$arch}}) {
+ foreach my $bot (keys %{$config->{bot}{$arch}{$host}}) {
+ next if $run{bot}{$arch}{$host}{$bot};
+
+ # Enable noarch lock after the first bot snarfs the package
+ #
+ $noarch_build{$prefix} = 1 if $noarch;
+
+ plog('INFO', "building on $host/$arch ($bot)");
+
+ $run{bot}{$arch}{$host}{$bot} = $prefix;
+ $compildone->{$prefix}{$arch} = 1;
+
+ my $bot_conf = $config->{bot}{$arch}{$host}{$bot};
+ my $remote = ssh_setup($config->{ssh_options},
+ $bot_conf->{user}, $host);
+
+ my $prefix_dir = "$bot_conf->{packages}/$path/$prefix/";
+ my $status_file = "$prefix_dir/log/status.log";
+
+ # Copy packages to build node
+ #
+ next if ssh($remote, "mkdir -p $prefix_dir");
+ my $pkgs = "";
+ my $ok = 1;
+ foreach my $srpm (@$srpms) {
+ plog('NOTIFY', "Send to $host/$arch: $srpm");
+ $ok &&= !sput($remote, "$todo_dir/${prefix}_$srpm",
+ "$prefix_dir/$srpm");
+ $pkgs .= " $prefix_dir/$srpm";
+ }
+ next unless $ok;
+
+ # spawn remote build bot and save output on local file
+ # (remove status.log before building, otherwise we can have
+ # a install_deps_failure and reschedule even if the package
+ # is currently building)
+ #
+ plog('DEBUG', "remove status file");
+ ssh($remote, "rm $status_file 2>/dev/null");
+
+ plog('INFO', "Execute build command on $host/$arch");
+
+ my $temp = mktemp("$config->{tmp}/ulri.tmp.$prefix.XXXXX");
+ my $cmd = $bot_conf->{command};
+ $cmd =~ s!__ARCH__!$arch!g;
+ $cmd =~ s!__DIR__!$path/$prefix!g;
+ $cmd =~ s!__TARGET__!$target!g;
+ $cmd =~ s!__PACKAGER__!$user!g;
+
+ my $media_to_add;
+ if (ref $config->{media}{$target}{$media}) {
+ $media_to_add = join ' ', @{$config->{media}{$target}{$media}};
+ } elsif (ref $config->{media}{default}{$media}) {
+ $media_to_add = join ' ', @{$config->{media}{default}{$media}};
+ }
+ plog('DEBUG', "Will compile only with media $media_to_add");
+ $cmd =~ s!__MEDIA__!$media_to_add!g;
+
+ plog('DEBUG', "Build $pkgs");
+ ssh($remote, "$cmd $pkgs &> $temp &");
+
+ # wait 10 seconds or until we have the log file
+ #
+ last if check_file_timeout($temp, 10);
+
+ # get remote PID from log file
+ #
+ my $pid = get_pid_from_file($temp);
+ unlink $temp;
+ plog('DEBUG', "remote pid $pid");
+ last unless $pid;
+
+ # create lock file
+ #
+ my $lock_arch = $noarch ? "$arch-noarch" : $arch;
+ my $lock_file = "$todo_dir/${prefix}_" .
+ "$lock_arch.$bot.$host.$fulldate.$pid.lock";
+ plog('DEBUG', "create lock $lock_file");
+ create_file($lock_file, "$program_name $$", time());
+
+ last;
+ }
+ last if $compildone->{$prefix}{$arch};
+ last if $compildone->{$prefix}{noarch};
+ }
+
+ # Count packages to compile for each architecture. Count noarch
+ # package only once.
+ #
+ $arch = 'noarch' if $noarch;
+ unless ($compildone->{$prefix}{$arch}) {
+ $to_compile{$arch}++ if !($noarch && $noarch_countflag);
+ }
+ $noarch_countflag = 1 if $noarch;
+ }
+}
+
+plog('MSG', "Current status");
+
+if (keys %build_list) {
+ plog('INFO', "currently building:");
+ map { plog('INFO', " $_: " . join('', @{$build_list{$_}})) } keys %build_list;
+}
+
+plog('INFO', "jobs in queue:", %to_compile ?
+ map { sprintf("%s(%d)", $_, $to_compile{$_}) } keys %to_compile : "none");
+
+
+#dump_cache(\%run);
+unlink $pidfile;
+exit();
+
+
+#
+# Subroutines
+#
+
+sub get_pid_from_file {
+ my $file = shift;
+
+ my $pid;
+ open my $FILE, $file || die "FATAL: can't open $file";
+ local $_;
+ while (<$FILE>) { ($pid) = /PID=(\d+)/ }
+
+ $pid;
+}
+
+sub create_file {
+ my $file = shift;
+ my @contents = @_;
+
+ open my $FILE, ">$file" or die "FATAL: can't open $file for writing";
+ print $FILE "@contents";
+}
+
+sub read_line {
+ my $file = shift;
+
+ open my $FILE, "<$file" or die "FATAL: can't open $file for reading";
+ my $contents = <$FILE>;
+
+ $contents;
+}
+
+sub check_file_timeout {
+ my $file = shift;
+ my $time = shift;
+
+ my $i = 0;
+ while ($i < $time && (!-f $file || -z $file)) { sleep 1; $i++ }
+
+ $i == $time;
+}
+
+__END__
+
+# ulri ends here
+
+Discussion
+----------
+
+20060802 (Warly)
+
+* I prefer creating a separate scheduler, so that it can eventually call
+ other bots.
+* bots should be able to take packages by themselves.
+* Iurt will perform several checks, they have to be standard and usable
+ by the maintainer, the results must be put in a visible directory or path
+* We can put packages either in a dir or to prefix all files with the date
+ and uploader. Having all files in a dir will make the listing simpler.
+ Prefixing the files could be problematic if we base the rpm name and
+ version parsing on the filename.
+* ulri knows the prefix, he could ask iurt to put the packages in a dir
+ with the same prefix.
+
+20060806 (Warly)
+
+* All the packages are put in done, then the final youri is run to put them
+ in queue/
+
+20061104 (claudio)
+
+* Instead if having configuration defaults for our environment and using
+ ulri with the defaults, it would be nicer to have minimalistic/generic
+ defaults and install a configuration file in kenobi
+* Ulri's configuration file could be renamed to .ulri.conf instead of
+ .upload.conf. ==> ok, it's also used by emi
+
generated by cgit v1.2.1 (git 2.21.0) at 2024-06-21 23:39:29 +0000