This commit was manufactured by cvs2svn to create tagV10_34_11_100mdk

'V10_34_11_100mdk'.

1 files changed, 114 insertions, 47 deletions

diff --git a/perl-install/pkgs.pm b/perl-install/pkgs.pm
index f6626d312..d03b3be9f 100644
--- a/perl-install/pkgs.pm
+++ b/perl-install/pkgs.pm
@@ -1,6 +1,5 @@
 package pkgs; # $Id$
 
-use diagnostics;
 use strict;
 
 use MDK::Common::System;
@@ -47,7 +46,7 @@ sub packageMedium { my ($packages, $p) = @_; $p or die "invalid package from\n"
 			defined $_->{start} && defined $_->{end} or next;
 			$p->id >= $_->{start} && $p->id <= $_->{end} and return $_;
 		    }
-		    return }
+		    return {} }
 
 sub cleanHeaders {
     my ($prefix) = @_;
@@ -85,6 +84,11 @@ sub extractHeaders {
     }
 }
 
+sub isSupplCDMedium($) {
+    my ($medium) = @_;
+    $medium->{method} eq 'cdrom' && $medium->{medium} =~ /^\d+s$/;
+}
+
 #- TODO BEFORE TODO
 #- size and correction size functions for packages.
 my $B = 1.20873;
@@ -224,8 +228,8 @@ sub allMediums {
     sort { $a <=> $b } keys %{$packages->{mediums}};
 }
 sub mediumDescr {
-    my ($packages, $medium) = @_;
-    $packages->{mediums}{$medium}{descr};
+    my ($packages, $medium_name) = @_;
+    $packages->{mediums}{$medium_name}{descr};
 }
 
 sub packageRequest {
@@ -339,14 +343,21 @@ sub unselectAllPackages($) {
 				 callback_choices => \&packageCallbackChoices);
 }
 
+sub urpmidir {
+    my ($prefix) = @_;
+    my $v = "$prefix/var/lib/urpmi";
+    -l $v && !-e _ and unlink $v and mkdir $v, 0755; #- dangling symlink
+    -w $v ? $v : '/tmp';
+}
+
 sub psUpdateHdlistsDeps {
     my ($prefix, $_method, $packages) = @_;
     my $need_copy = 0;
+    my $urpmidir = urpmidir($prefix);
 
     #- check if current configuration is still up-to-date and do not need to be updated.
     foreach (values %{$packages->{mediums}}) {
 	$_->{selected} || $_->{ignored} or next;
-	my $urpmidir = -w "$prefix/var/lib/urpmi" ? "$prefix/var/lib/urpmi" : "/tmp";
 	my $hdlistf = "$urpmidir/hdlist.$_->{fakemedium}.cz" . ($_->{hdlist} =~ /\.cz2/ && "2");
 	my $synthesisf = "$urpmidir/synthesis.hdlist.$_->{fakemedium}.cz" . ($_->{hdlist} =~ /\.cz2/ && "2");
 	if (-s $hdlistf != $_->{hdlist_size}) {
@@ -362,52 +373,62 @@ sub psUpdateHdlistsDeps {
 
     if ($need_copy) {
 	#- this is necessary for urpmi.
-	my $urpmidir = -w "$prefix/var/lib/urpmi" ? "$prefix/var/lib/urpmi" : "/tmp";
 	install_any::getAndSaveFile("Mandrake/base/$_", "$urpmidir/$_") foreach qw(rpmsrate);
     }
 }
 
 sub psUsingHdlists {
-    my ($prefix, $method) = @_;
-    my $listf = install_any::getFile('Mandrake/base/hdlists') or die "no hdlists found";
-    my $packages = new URPM;
-
-    #- add additional fields used by DrakX.
-    @$packages{qw(count mediums)} = (0, {});
+    my ($o, $method, $o_hdlistsprefix, $o_packages, $o_initialmedium) = @_;
+    my $prefix = $o->{prefix};
+    my $listf = install_any::getFile($o_hdlistsprefix ? "$o_hdlistsprefix/Mandrake/base/hdlists" : 'Mandrake/base/hdlists')
+	or die "no hdlists found";
+    my $suppl_CDs = 0;
+    if (!$o_packages) {
+	$o_packages = new URPM;
+	#- add additional fields used by DrakX.
+	@$o_packages{qw(count mediums)} = (0, {});
+    }
 
     #- parse hdlists file.
-    my $medium = 1;
+    my $medium_name = $o_initialmedium || 1;
+    my @hdlists;
     foreach (<$listf>) {
 	chomp;
 	s/\s*#.*$//;
 	/^\s*$/ and next;
+	#- we'll ask afterwards for supplementary CDs, if the hdlists file contains
+	#- a line that begins with "suppl"
+	if (/^suppl/) { $suppl_CDs = 1; next }
+	my $cdsuppl = index($medium_name, 's') >= 0;
 	m/^\s*(noauto:)?(hdlist\S*\.cz2?)\s+(\S+)\s*(.*)$/ or die qq(invalid hdlist description "$_" in hdlists file);
+	push @hdlists, [ $2, $medium_name, $3, $4, !$1, 
+	    #- hdlist path, suppl CDs are mounted on /mnt/cdrom :
+	    $o_hdlistsprefix ? "$o_hdlistsprefix/Mandrake/base/$2" : undef,
+	];
+	$cdsuppl ? ($medium_name = ($medium_name + 1) . 's') : ++$medium_name;
+    }
 
+    foreach my $h (@hdlists) {
 	#- make sure the first medium is always selected!
 	#- by default select all image.
-	psUsingHdlist($prefix, $method, $packages, $2, $medium, $3, $4, !$1);
-
-	++$medium;
+	my $supplmedium = psUsingHdlist($prefix, $method, $o_packages, @$h);
     }
 
-    log::l("psUsingHdlists read " . int(@{$packages->{depslist}}) .
-	   " headers on " . int(keys %{$packages->{mediums}}) . " hdlists");
+    log::l("psUsingHdlists read " . int(@{$o_packages->{depslist}}) .
+	   " headers on " . int(keys %{$o_packages->{mediums}}) . " hdlists");
 
-    $packages;
+    return $o_packages, $suppl_CDs;
 }
 
 sub psUsingHdlist {
-    my ($prefix, $method, $packages, $hdlist, $medium, $rpmsdir, $descr, $selected, $o_fhdlist, $o_pubkey) = @_;
-    my $fakemedium = "$descr ($method$medium)";
-    my $urpmidir = -w "$prefix/var/lib/urpmi" ? "$prefix/var/lib/urpmi" : "/tmp";
-    log::l("trying to read $hdlist for medium $medium");
-
-    #- if the medium already exist, use it.
-    $packages->{mediums}{$medium} and return $packages->{mediums}{$medium};
+    my ($prefix, $method, $packages, $hdlist, $medium_name, $rpmsdir, $descr, $selected, $o_fhdlist, $o_pubkey) = @_;
+    my $fakemedium = "$descr ($method$medium_name)";
+    my $urpmidir = urpmidir($prefix);
+    log::l("trying to read $hdlist for medium $medium_name");
 
     my $m = { hdlist     => $hdlist,
 	      method     => $method,
-	      medium     => $medium,
+	      medium     => $medium_name,
 	      rpmsdir    => $rpmsdir, #- where is RPMS directory.
 	      descr      => $descr,
 	      fakemedium => $fakemedium,
@@ -424,11 +445,17 @@ sub psUsingHdlist {
     $m->{hdlist_size} = -s $newf; #- keep track of size for post-check.
     symlinkf $newf, "/tmp/$hdlist";
 
-    #- if $o_fhdlist is defined, this is preferable not to try to find the associated synthesis.
     my $newsf = "$urpmidir/synthesis.hdlist.$fakemedium.cz" . ($hdlist =~ /\.cz2/ && "2");
-    unless ($o_fhdlist) {
+    #- if $o_fhdlist is a filehandle, it's preferable not to try to find the associated synthesis.
+    if (!ref $o_fhdlist) {
 	#- copy existing synthesis file too.
-	install_any::getAndSaveFile("Mandrake/base/synthesis.$hdlist", $newsf);
+	my $synth;
+	if ($o_fhdlist) {
+	    $synth = $o_fhdlist;
+	    $synth =~ s/hdlist/synthesis.hdlist/ or $synth = undef;
+	}
+	$synth ||= "Mandrake/base/synthesis.$hdlist";
+	install_any::getAndSaveFile($synth, $newsf);
 	$m->{synthesis_hdlist_size} = -s $newsf; #- keep track of size for post-check.
 	-s $newsf > 0 or unlink $newsf;
     }
@@ -444,31 +471,46 @@ sub psUsingHdlist {
     }
 
     #- integrate medium in media list, only here to avoid download error (update) to be propagated.
-    $packages->{mediums}{$medium} = $m;
+    $packages->{mediums}{$medium_name} = $m;
 
     #- avoid using more than one medium if Cd is not ejectable.
     #- but keep all medium here so that urpmi has the whole set.
-    $m->{ignored} ||= $method eq 'cdrom' && $medium > 1 && !common::usingRamdisk();
+    $m->{ignored} ||= (
+	install_any::method_allows_medium_change($method) && $medium_name > 1    #- first cdrom
+	&& $medium_name !~ /^\d+s/			#- not a suppl. CD
+	&& !common::usingRamdisk());
 
     #- parse synthesis (if available) of directly hdlist (with packing).
     if ($m->{ignored}) {
 	log::l("ignoring packages in $hdlist");
     } else {
+	my $nb_suppl_pkg_skipped = 0;
+	my $callback = sub {
+	    my (undef, $p) = @_;
+	    our %uniq_pkg_seen;
+	    if ($uniq_pkg_seen{$p->fullname}++) {
+		log::l("skipping " . scalar $p->fullname);
+		++$nb_suppl_pkg_skipped;
+		return 0;
+	    } else {
+		return 1;
+	    }
+	};
 	if (-s $newsf) {
-	    ($m->{start}, $m->{end}) = $packages->parse_synthesis($newsf);
+	    ($m->{start}, $m->{end}) = $packages->parse_synthesis($newsf, callback => $callback);
 	} elsif (-s $newf) {
-	    ($m->{start}, $m->{end}) = $packages->parse_hdlist($newf, 1);
+	    ($m->{start}, $m->{end}) = $packages->parse_hdlist($newf, callback => $callback);
 	} else {
-	    delete $packages->{mediums}{$medium};
+	    delete $packages->{mediums}{$medium_name};
 	    unlink $newf;
 	    $o_fhdlist or unlink $newsf;
 	    die "fatal: no hdlist nor synthesis to read for $fakemedium";
 	}
-	$m->{start} > $m->{end} and do { delete $packages->{mediums}{$medium};
+	$m->{start} > $m->{end} and do { delete $packages->{mediums}{$medium_name};
 					 unlink $newf;
 					 $o_fhdlist or unlink $newsf;
 					 die "fatal: nothing read in hdlist or synthesis for $fakemedium" };
-	log::l("read " . ($m->{end} - $m->{start} + 1) . " packages in $hdlist");
+	log::l("read " . ($m->{end} - $m->{start} + 1) . " packages in $hdlist, $nb_suppl_pkg_skipped skipped");
     }
     $m;
 }
@@ -560,9 +602,9 @@ sub read_rpmsrate {
 }
 
 sub readCompssUsers {
-    my ($meta_class) = @_;
+    my ($meta_class, $file) = @_;
 
-    my $file = 'Mandrake/base/compssUsers';
+    $file = 'Mandrake/base/compssUsers' if !$file;
     my $f = $meta_class && install_any::getFile("$file.$meta_class") || install_any::getFile($file) or die "can't find $file";
     readCompssUsers_raw($f);
 }
@@ -607,19 +649,19 @@ sub saveCompssUsers {
 	    }
 	}
     }
-    my $urpmidir = -w "$prefix/var/lib/urpmi" ? "$prefix/var/lib/urpmi" : "/tmp";
+    my $urpmidir = urpmidir($prefix);
     output "$urpmidir/compssUsers.flat", $flat;
 }
 
 sub setSelectedFromCompssList {
-    my ($packages, $compssUsersChoice, $min_level, $max_size) = @_;
-    $compssUsersChoice->{TRUE} = 1; #- ensure TRUE is set
+    my ($packages, $rpmsrate_flags_chosen, $min_level, $max_size) = @_;
+    $rpmsrate_flags_chosen->{TRUE} = 1; #- ensure TRUE is set
     my $nb = selectedSize($packages);
     foreach my $p (sort { $b->rate <=> $a->rate } @{$packages->{depslist}}) {
 	my @flags = $p->rflags;
 	next if 
 	  !$p->rate || $p->rate < $min_level || 
-	  any { !any { /^!(.*)/ ? !$compssUsersChoice->{$1} : $compssUsersChoice->{$_} } split('\|\|') } @flags;
+	  any { !any { /^!(.*)/ ? !$rpmsrate_flags_chosen->{$1} : $rpmsrate_flags_chosen->{$_} } split('\|\|') } @flags;
 
 	#- determine the packages that will be selected when
 	#- selecting $p. the packages are not selected.
@@ -885,6 +927,8 @@ sub selectPackagesToUpgrade {
 
 sub allowedToUpgrade { $_[0] !~ /^(kernel|kernel22|kernel2.2|kernel-secure|kernel-smp|kernel-linus|kernel-linus2.2|hackkernel|kernel-enterprise)$/ }
 
+sub supplCDMountPoint { $::o->{mainmethod} eq 'cdrom' ? "/tmp/image" : "/mnt/cdrom" }
+
 sub installTransactionClosure {
     my ($packages, $id2pkg) = @_;
     my ($id, %closure, @l, $medium, $min_id, $max_id);
@@ -920,13 +964,29 @@ sub installTransactionClosure {
     $medium or return (); #- no more medium usable -> end of installation by returning empty list.
     ($min_id, $max_id) = ($medium->{start}, $medium->{end});
 
+    #- Supplementary CD : switch temporarily to "cdrom" method
+    my $suppl_CD = isSupplCDMedium($medium);
+    $::o->{mainmethod} = $::o->{method};
+    local $::o->{method} = do {
+	my $cdrom;
+	cat_("/proc/mounts") =~ m,(/(?:dev|tmp)/\S+)\s+(?:/mnt/cdrom|/tmp/image), and $cdrom = $1;
+	if (!defined $cdrom) {
+	    (my $cdromdev) = detect_devices::cdroms();
+	    $cdrom = $cdromdev->{device};
+	    log::l("cdrom redetected at $cdrom");
+	    devices::make($cdrom);
+	    install_any::ejectCdrom($cdrom) if $::o->{method} eq 'cdrom';
+	    install_any::mountCdrom(supplCDMountPoint(), $cdrom);
+	} else { log::l("cdrom already found at $cdrom") }
+	'cdrom';
+    } if $suppl_CD;
     #- it is sure at least one package will be installed according to medium chosen.
     install_any::useMedium($medium->{medium});
-    if ($medium->{method} eq 'cdrom') {
+    if (install_any::method_allows_medium_change($medium->{method})) {
 	my $pkg = $packages->{depslist}[$l[0]];
 
 	#- force changeCD callback to be called from main process.
-	install_any::getFile($pkg->filename, $medium->{descr});
+	install_any::getFile($pkg->filename, $medium->{descr}, $suppl_CD ? supplCDMountPoint() : undef);
 	#- close opened handle above.
 	install_any::getFile('XXX');
     }
@@ -1062,7 +1122,8 @@ sub install($$$;$$) {
 		    my $trans = $db->create_transaction($prefix);
 		    if ($retry_pkg) {
 			log::l("opened rpm database for retry transaction of 1 package only");
-			$trans->add($retry_pkg, $isUpgrade && allowedToUpgrade($retry_pkg->name));
+			$trans->add($retry_pkg, $isUpgrade && allowedToUpgrade($retry_pkg->name))
+			    or log::l("add failed for ".$retry_pkg->fullname);
 		    } else {
 			log::l("opened rpm database for transaction of " . int(@transToInstall) .
 			       " new packages, still $nb after that to do");
@@ -1082,7 +1143,11 @@ sub install($$$;$$) {
 						my $medium = packageMedium($packages, $pkg);
 						my $f = $pkg && $pkg->filename;
 						print $LOG "$f\n";
-						$fd = install_any::getFile($f, $medium->{descr});
+						if (isSupplCDMedium($medium)) {
+						    $fd = install_any::getFile($f, $medium->{descr}, supplCDMountPoint());
+						} else {
+						    $fd = install_any::getFile($f, $medium->{descr}, $medium->{prefix});
+						}
 						$fd ? fileno $fd : -1;
 					    }, callback_close => sub {
 						my ($data, $_type, $id) = @_;
@@ -1092,6 +1157,7 @@ sub install($$$;$$) {
 								      my ($p) = @_;
 								      $check_installed ||= $pkg->compare_pkg($p) == 0;
 								  });
+						$check_installed or log::l($pkg->name . " not installed, " . c::rpmErrorString());
 						$check_installed and print OUTPUT "close:$id\n";
 					    }, callback_inst => sub {
 						my ($_data, $type, $id, $subtype, $amount, $total) = @_;
@@ -1176,6 +1242,7 @@ sub install($$$;$$) {
 
     log::l("closing install.log file");
     close $LOG;
+    eval { fs::umount("/mnt/cdrom") };
 
     cleanHeaders($prefix);