Restoring code lost in the SVN breakage from an old checkout

1 files changed, 318 insertions, 0 deletions

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;