*** empty log message ***

7 files changed, 180 insertions, 60 deletions

diff --git a/perl-install/c/stuff.xs.pm b/perl-install/c/stuff.xs.pm
index bc405af1d..cdaa2d292 100644
--- a/perl-install/c/stuff.xs.pm
+++ b/perl-install/c/stuff.xs.pm
@@ -527,7 +527,16 @@ rpmtransSetScriptFd(trans, fd)
   void *trans
   int fd
   CODE:
-  rpmtransSetScriptFd(trans, fdDup(fd));
+  /* this code core dumps on install...
+  static FD_t scriptFd = NULL;
+  if (scriptFd == NULL) scriptFd = fdNew("");
+  fdSetFdno(scriptFd, fd);
+  rpmtransSetScriptFd(trans, scriptFd);
+  */
+  static FD_t scriptFd = NULL;
+  if (scriptFd != NULL) fdClose(scriptFd);
+  scriptFd = fdDup(fd);
+  rpmtransSetScriptFd(trans, scriptFd);
 
 void
 rpmRunTransactions(trans, callbackOpen, callbackClose, callbackMessage, force)
diff --git a/perl-install/devices.pm b/perl-install/devices.pm
index 61d6bd4c7..19baec6f7 100644
--- a/perl-install/devices.pm
+++ b/perl-install/devices.pm
@@ -40,7 +40,7 @@ sub set_loop {
 
     foreach (0..9) {
 	local *F;
-	my $dev = devices::make("loop$_");
+	my $dev = make("loop$_");
 	sysopen F, $dev, 0 or next;
 	!ioctl(F, c::LOOP_GET_STATUS(), my $tmp) && $! == 6 or next; #- 6 == ENXIO
 	return c::set_loop(fileno F, $file) && $dev;
diff --git a/perl-install/fs.pm b/perl-install/fs.pm
index b5d80010e..5a506c411 100644
--- a/perl-install/fs.pm
+++ b/perl-install/fs.pm
@@ -137,7 +137,7 @@ sub mount($$$;$) {
     } else {
 	$dev = devices::make($dev) if $fs ne 'proc';
 
-	my $flag = 0;#c::MS_MGC_VAL();
+	my $flag = c::MS_MGC_VAL();
 	$flag |= c::MS_RDONLY() if $rdonly;
 	my $mount_opt = "";
 
diff --git a/perl-install/install_any.pm b/perl-install/install_any.pm
index c11e24be3..5e1232f90 100644
--- a/perl-install/install_any.pm
+++ b/perl-install/install_any.pm
@@ -4,7 +4,7 @@ use diagnostics;
 use strict;
 use Config;
 
-use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK);
+use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK $current_medium $asked_medium %refused_media);
 
 @ISA = qw(Exporter);
 %EXPORT_TAGS = (
@@ -30,28 +30,70 @@ use log;
 
 
 #-######################################################################################
-#- Functions
+#- Media change variables&functions
 #-######################################################################################
+$current_medium = '';
+$asked_medium = '';
+%refused_media = ();
+sub medium() { $current_medium }
+sub useMedium($) { $asked_medium eq $_[0] or log::l("selecting new medium $_[0]"); $asked_medium = $_[0] }
+sub changeMedium($$) {
+    my ($method, $medium) = @_;
+    log::l("change to medium $medium for method $method (refused by default)");
+    0;
+}
 sub relGetFile($) {
     local $_ = $_[0];
     /\.img$/ and return "images/$_";
-    my $dir = m|/| ? "mdkinst" :
-      member($_, qw(compss compssList compssUsers depslist depslist.ordered hdlist hdlist.cz hdlist.cz2)) ? "base/" : "/RPMS/";
+    my $dir = m|/| ? "mdkinst" : /^(?:compss|compssList|compssUsers|depslist.*|hdlist.*)$/ ? "base/": "RPMS$asked_medium/";
     $_ = "Mandrake/$dir$_";
     s/i386/i586/;
     $_;
 }
+sub errorOpeningFile($) {
+    my ($file) = @_;
+    $file eq 'XXX' and return; #- special case to force closing file after rpmlib transaction.
+    $current_medium eq $asked_medium and return; #- nothing to do in such case.
+    $refused_media{$asked_medium} and return; #- refused forever...
+
+    my $max = 32; #- always refuse after $max tries.
+    if ($::o->{method} eq "cdrom") {
+	cat_("/proc/mounts") =~ m|/tmp/(\S+)\s+/tmp/rhimage| or return;
+	my $cdrom = $1;
+	ejectCdrom();
+	while ($max > 0 && changeMedium($::o->{method}, $asked_medium)) {
+	    $current_medium = $asked_medium;
+	    eval { fs::mount($cdrom, "/tmp/rhimage", "iso9660", 'readonly') };
+	    my $getFile = getFile($file); $getFile and return $getFile;
+	    $current_medium = 'unknown'; #- don't know what CD is inserted now.
+	    ejectCdrom();
+	    --$max;
+	}
+    } else {
+	while ($max > 0 && changeMedium($::o->{method}, $asked_medium)) {
+	    $current_medium = $asked_medium;
+	    my $getFile = getFile($file); $getFile and return $getFile;
+	    $current_medium = 'unknown'; #- don't know what CD image has been copied.
+	    --$max;
+	}
+    }
+
+    #- keep in mind the asked medium has been refused on this way.
+    $refused_media{$asked_medium} = 'refused';
+
+    return;
+}
 sub getFile($) {
     local $^W = 0;
     if ($::o->{method} && $::o->{method} eq "ftp") {
 	require ftp;
-	*install_any::getFile = \&ftp::getFile;
+	*install_any::getFile = sub { ftp::getFile($_[0]) or errorOpeningFile($_[0]) };
     } elsif ($::o->{method} && $::o->{method} eq "http") {
 	require http;
-	*install_any::getFile = \&http::getFile;
+	*install_any::getFile = sub { http::getFile($_[0]) or errorOpeningFile($_[0]) };
     } else {
 	*install_any::getFile = sub($) {
-	    open getFile, "/tmp/rhimage/" . relGetFile($_[0]) or return;
+	    open getFile, "/tmp/rhimage/" . relGetFile($_[0]) or return errorOpeningFile($_[0]);
 	    *getFile;
 	};
     }
@@ -64,6 +106,9 @@ sub rewindGetFile() {
     }
 }
 
+#-######################################################################################
+#- Functions
+#-######################################################################################
 sub kernelVersion {
     local $_ = readlink("$::o->{prefix}/boot/vmlinuz") || $::testing && "vmlinuz-2.2.testversion" or die "I couldn't find the kernel package!";
     first(/vmlinuz-(.*)/);
@@ -123,7 +168,7 @@ sub setPackages($) {
 
     require pkgs;
     if (!$o->{packages} || is_empty_hash_ref($o->{packages}[0])) {
-	$o->{packages} = pkgs::psUsingHdlist($o->{prefix});
+	$o->{packages} = pkgs::psUsingHdlists($o->{prefix});
 
 	push @{$o->{default_packages}}, "nfs-utils-clients" if $o->{method} eq "nfs";
 	push @{$o->{default_packages}}, "numlock" if $o->{miscellaneous}{numlock};
diff --git a/perl-install/install_steps.pm b/perl-install/install_steps.pm
index 099f44659..6004096b1 100644
--- a/perl-install/install_steps.pm
+++ b/perl-install/install_steps.pm
@@ -236,7 +236,7 @@ sub installPackages($$) { #- complete REWORK, TODO and TOCHECK!
 
     #- small transaction will be built based on this selection and depslist.
     my @toInstall = grep { pkgs::packageFlagSelected($_) && !pkgs::packageFlagInstalled($_) } values %{$packages->[0]};
-    pkgs::install($o->{prefix}, $o->{isUpgrade}, \@toInstall, $o->{packages}[1]);
+    pkgs::install($o->{prefix}, $o->{isUpgrade}, \@toInstall, $o->{packages}[1], $o->{packages}[2]);
 }
 
 sub afterInstallPackages($) {
diff --git a/perl-install/install_steps_gtk.pm b/perl-install/install_steps_gtk.pm
index 13f2485bc..3533f26da 100644
--- a/perl-install/install_steps_gtk.pm
+++ b/perl-install/install_steps_gtk.pm
@@ -408,7 +408,7 @@ sub choosePackagesTree {
 
     my $display_info = sub {
 	my $p = $packages->[0]{$curr} or return gtktext_insert($info_widget, '');
-	pkgs::extractHeaders($o->{prefix}, [$p]);
+	pkgs::extractHeaders($o->{prefix}, [$p], $p->{medium});
 	$p->{header} or die;
 
 	my $ind = $o->{compssListLevels}{$o->{install_class}};
@@ -498,7 +498,7 @@ sub installPackages {
     $msg->set(_("Preparing installation"));
     $w->sync;
 
-    my $old = \&pkgs::installCallback;
+    my $oldInstallCallback = \&pkgs::installCallback;
     local *pkgs::installCallback = sub {
 	my $m = shift;
 	if ($m =~ /^Starting installation/) {
@@ -529,7 +529,30 @@ sub installPackages {
 		$last_dtime = $dtime;
 	    }
 	    $w->flush;
-	} else { unshift @_, $m; goto $old }
+	} else { unshift @_, $m; goto $oldInstallCallback }
+    };
+    my $oldChangeMedium = \&install_any::changeMedium;
+    local *install_any::changeMedium = sub {
+	my ($method, $medium) = @_;
+	my %medium_msg = (
+			  '' => _("Installation CD #1"),
+			 );
+	$medium_msg{$medium} or $medium_msg{$medium} = _("Installation CD #%s", $medium);
+	my %method_msg = (
+			  cdrom =>
+_("Change your Cd-Rom!
+
+Please insert the Cd-Rom labelled \"%s\" in your drive and press Ok when done.
+If you don't have it press Cancel to avoid installation from this Cd-Rom.", $medium_msg{$medium}),
+			 );
+	$method_msg{$method} or $method_msg{$method} =
+_("Update installation image!
+
+Ask your system administrator or reboot to update your installation image to include
+the Cd-Rom image labelled \"%s\". Press Ok if image has been updated or press Cancel
+to avoid installation from this Cd-Rom image.", $medium_msg{$medium});
+
+	$o->ask_okcancel('', $method_msg{$method});
     };
     catch_cdie { $o->install_steps::installPackages($packages); }
       sub {
diff --git a/perl-install/pkgs.pm b/perl-install/pkgs.pm
index 8a028b53a..d30d0e408 100644
--- a/perl-install/pkgs.pm
+++ b/perl-install/pkgs.pm
@@ -2,7 +2,7 @@ package pkgs;
 
 use diagnostics;
 use strict;
-use vars qw(*LOG %compssListDesc @skip_list %by_lang @preferred $limitMinTrans $limitMaxTrans $PKGS_SELECTED $PKGS_FORCE $PKGS_INSTALLED $PKGS_BASE $PKGS_SKIP $PKGS_UNSKIP);
+use vars qw(*LOG %compssListDesc @skip_list %by_lang @preferred $limitMinTrans $PKGS_SELECTED $PKGS_FORCE $PKGS_INSTALLED $PKGS_BASE $PKGS_SKIP $PKGS_UNSKIP);
 
 use common qw(:common :file :functional);
 use install_any;
@@ -69,7 +69,6 @@ autoirpm autoirpm-icons numlock
 
 #- constant for small transaction.
 $limitMinTrans = 8;
-$limitMaxTrans = 24;
 
 #- constant for packing flags, see below.
 $PKGS_SELECTED  = 0x00ffffff;
@@ -118,14 +117,14 @@ sub packageFile {
 }
 
 
-#- get all headers from hdlist.cz
-sub extractHeaders {
-    my ($prefix, $pkgs) = @_;
+#- get all headers from an hdlist file.
+sub extractHeaders($$$) {
+    my ($prefix, $pkgs, $medium) = @_;
 
     commands::rm("-rf", "$prefix/tmp/headers") if -e "$prefix/tmp/headers";
 
-    run_program::run("extract_archive", 
-		     "$prefix/var/lib/urpmi/hdlist.cz2",
+    run_program::run("extract_archive",
+		     "$prefix/var/lib/urpmi/$medium->{hdlist}",
 		     "$prefix/tmp/headers",
 		     map { packageHeaderFile($_) } @$pkgs);
 
@@ -266,40 +265,64 @@ sub skipSetWithProvides {
     packageSetFlagSkip($_, 1) foreach grep { $_ } map { $_, packageProvides($_) } map { packageByName($packages, $_) } @l;
 }
 
-sub psUsingHdlist($) {
+sub psUsingHdlists($) {
     my ($prefix) = @_;
-    my $f = install_any::getFile('hdlist.cz2') or die "no hdlist.cz2 found";
-    my @packages;
-
-    #- copy hdlist file directly to $prefix/var/lib/urpmi, this will be used
-    #- for getting header of package during installation or after by urpmi.
-    my $newf = "$prefix/var/lib/urpmi/hdlist.cz2";
-    -e $newf and do { unlink $newf or die "cannot remove $newf: $!"; };
-    local *F;
-    open F, ">$newf" or die "cannot create $newf: $!";
-    my ($buf, $sz); while (($sz = sysread($f, $buf, 16384))) { syswrite(F, $buf) }
-    close F;
-
-    #- extract filename from archive, this take advantage of verifying
-    #- the archive too.
-    open F, "extract_archive $newf |" or die "unable to parse $newf";
-    foreach (<F>) {
+    my $listf = install_any::getFile('hdlists') or die "no hdlists found";
+    my @packages = ({}, [], {});
+    my @hdlists;
+
+    #- parse hdlist.list file.
+    foreach (<$listf>) {
 	chomp;
-	next unless /^[dlf]\s+/;
-	if (/^f\s+\d+\s+(.*)/) {
-	    my $pkg = { file  => $1, #- rebuild filename according to header one
-			flags => 0,        #- flags
-		      };
-	    $packages[0]{packageName($pkg)} = $pkg;
-	} else {
-	    die "cannot determine how to handle such file in $newf: $_";
-	}
+	s/\s*#.*$//;
+	/^\s*$/ and next;
+	m/^hdlist(.*)\.cz.*$/ or die "invalid hdlist filename $_";
+	push @hdlists, [ $_, $1 ];
     }
-    close F;
 
-    $packages[1] = [];
+    foreach (@hdlists) {
+	my ($hdlist, $medium) = @$_;
+	my $f = install_any::getFile($hdlist) or die "no $hdlist found";
+
+	$packages[2]{$medium} = { hdlist => $hdlist,
+				  medium => $medium, #- default medium is ''.
+				  min    => scalar keys %{$packages[0]},
+				  max    => -1, #- will be updated after reading current hdlist.
+				};
+
+	#- copy hdlist file directly to $prefix/var/lib/urpmi, this will be used
+	#- for getting header of package during installation or after by urpmi.
+	my $newf = "$prefix/var/lib/urpmi/$hdlist";
+	-e $newf and do { unlink $newf or die "cannot remove $newf: $!"; };
+	local *F;
+	open F, ">$newf" or die "cannot create $newf: $!";
+	my ($buf, $sz); while (($sz = sysread($f, $buf, 16384))) { syswrite(F, $buf) }
+	close F;
+
+	#- extract filename from archive, this take advantage of verifying
+	#- the archive too.
+	open F, "extract_archive $newf |" or die "unable to parse $newf";
+	foreach (<F>) {
+	    chomp;
+	    /^[dlf]\s+/ or next;
+	    if (/^f\s+\d+\s+(.*)/) {
+		my $pkg = { file   => $1, #- rebuild filename according to header one
+			    flags  => 0,  #- flags
+			    medium => $packages[2]{$medium},
+			  };
+		$packages[0]{packageName($pkg)} = $pkg;
+	    } else {
+		die "cannot determine how to handle such file in $newf: $_";
+	    }
+	}
+	close F;
+
+	#- update maximal index.
+	$packages[2]{$medium}{max} = scalar(keys %{$packages[0]}) - 1;
+	$packages[2]{$medium}{max} >= $packages[2]{$medium}{min} or die "nothing found while parsing $newf";
+    }
 
-    log::l("psUsingHdlist read " . scalar keys(%{$packages[0]}) . " headers");
+    log::l("psUsingHdlists read " . scalar keys(%{$packages[0]}) . " headers on " . scalar keys(%{$packages[2]}) . " hdlists");
 
     \@packages;
 }
@@ -322,15 +345,24 @@ sub getDeps($) {
 	  or log::l("ignoring package $name-$version-$release in depslist mismatch version or release in hdlist"), next;
 	$pkg->{sizeDeps} = $sizeDeps;
 
-	#- package are already sorted in depslist to enable small transaction.
+	#- check position of package in depslist according to precomputed
+	#- limit by hdlist, very strict :-)
+	#- above warning have chance to raise an exception here, but may help
+	#- for debugging.
+	my $i = scalar @{$packages->[1]};
+	$i >= $pkg->{medium}{min} && $i <= $pkg->{medium}{max} or die "depslist.ordered mismatch against hdlist files";
+
+	#- package are already sorted in depslist to enable small transaction and multiple medium.
 	push @{$packages->[1]}, $pkg;
     }
-#	map { push @{$packages->{$_}{provides}}, $name if $packages->{$_} } @deps;
+
+    #- check for same number of package in depslist and hdlists.
+    scalar(keys %{$packages->[0]}) == scalar(@{$packages->[1]}) or die "depslist.ordered has not same package as hdlist files";
 }
 
 sub getProvides($) {
     my ($packages) = @_;
-    
+
     #- update provides according to dependencies, here are stored
     #- reference to package directly and choice are included, this
     #- assume only 1 of the choice is selected, else on unselection
@@ -682,8 +714,8 @@ sub installCallback {
     log::l($msg .": ". join(',', @_));
 }
 
-sub install($$$;$) {
-    my ($prefix, $isUpgrade, $toInstall, $depOrder) = @_;
+sub install($$$;$$) {
+    my ($prefix, $isUpgrade, $toInstall, $depOrder, $media) = @_;
     my %packages;
 
     return if $::g_auto_install;
@@ -720,13 +752,24 @@ sub install($$$;$) {
     #- place (install_steps_gtk.pm,...).
     installCallback("Starting installation", $nb, $total);
 
-    my ($i, $min) = (0, 0);
+    my ($i, $min, $medium) = (0, 0, install_any::medium());
     do {
 	my @transToInstall;
-	if ($nb <= $limitMaxTrans || !$depOrder) {
+
+	if (!$depOrder || !$media) {
 	    @transToInstall = values %packages;
 	} else {
-	    while ($i < @$depOrder && ($i < $min || scalar @transToInstall < $limitMinTrans)) {
+	    #- change current media if needed.
+	    if ($i > $media->{$medium}{max}) {
+		#- search for media that contains the desired package to install.
+		foreach (keys %$media) {
+		    $i >= $media->{$_}{min} && $i <= $media->{$_}{max} and $medium = $_, last;
+		}
+	    }
+	    $i >= $media->{$medium}{min} && $i <= $media->{$medium}{max} or die "unable to find right medium";
+	    install_any::useMedium($medium);
+
+	    while ($i <= $media->{$medium}{max} && ($i < $min || scalar @transToInstall < $limitMinTrans)) {
 		my $dep = $packages{packageName($depOrder->[$i++])} or next;
 		push @transToInstall, $dep;
 		foreach (map { split '\|' } packageDepsId($dep)) {
@@ -739,7 +782,7 @@ sub install($$$;$) {
 	log::l("starting new transaction of ". scalar @transToInstall ." packages, still $nb after that to do");
 	my $trans = c::rpmtransCreateSet($db, $prefix);
 
-	extractHeaders($prefix, \@transToInstall);
+	extractHeaders($prefix, \@transToInstall, $media->{$medium});
 
 	c::rpmtransAddPackage($trans, $_->{header}, packageName($_), $isUpgrade && packageName($_) !~ /kernel/) #- TODO: replace `named kernel' by `provides kernel'
 	    foreach @transToInstall;