*** empty log message ***

7 files changed, 191 insertions, 83 deletions

diff --git a/perl-install/ChangeLog b/perl-install/ChangeLog
index aed1ad361..c22e8aa36 100644
--- a/perl-install/ChangeLog
+++ b/perl-install/ChangeLog
@@ -1,3 +1,13 @@
+2000-04-05  François Pons  <fpons@mandrakesoft.com>
+
+	* crypto.pm, install_steps_interactive.pm, install2.pm,
+	install_steps.pm: added crypto stuff to support hdlist-crypto.cz2
+	and depslist-crypto. dependancies are not supported but with a
+	simpler format of depslist file where closure are not done and
+	only package name are used for dependancies.
+	* pkgs.pm: added better support for multi CD manipulation,
+	including selection and refus.
+
 2000-04-04  François Pons  <fpons@mandrakesoft.com>
 
 	* pkgs.pm: modified selection packages from compssList by
diff --git a/perl-install/crypto.pm b/perl-install/crypto.pm
index 884286c9a..6490fb0de 100644
--- a/perl-install/crypto.pm
+++ b/perl-install/crypto.pm
@@ -17,6 +17,7 @@ my %mirrors = (
  "ftp.leo.org" => [ "Germany", "/pub/comp/os/unix/linux/Mandrake/Mandrake-crypto" ],
  "sunsite.uio.no" => [ "Norway", "/pub/unix/Linux/Mandrake-crypto" ],
  "ftp.sunet.se" => [ "Sweden", "/pub/Linux/distributions/mandrake-crypto" ],
+ "ackbar" => [ "Ackbar", "/crypto", "a", "a" ],
 );
 
 my %deps = (
@@ -31,7 +32,33 @@ sub mirrorstext() { map { mirror2text($_) } keys %mirrors }
 sub text2mirror($) { first($_[0] =~ /\((.*)\)$/) }
 sub ftp($) { ftp::new($_[0], "$mirrors{$_[0]}[1]/$::VERSION") }
 
-sub packages($) { ftp($_[0])->ls }
+sub getFile($$) {
+    my ($file, $host) = @_;
+    log::l("getting crypto file $file on directory $host:$mirrors{$host}[1]/$::VERSION with login $mirrors{$host}[2]");
+    my ($ftp, $retr) = ftp::new($_[1], "$mirrors{$host}[1]/$::VERSION",
+				($mirrors{$host}[2] ? ($mirrors{$host}[2]) : ()),
+				($mirrors{$host}[3] ? ($mirrors{$host}[3]) : ())
+			       );
+    $$retr->close if $$retr;
+    $$retr   = $ftp->retr($file) or ftp::rewindGetFile();
+    $$retr ||= $ftp->retr($file);
+}
+
+sub getDepslist($) { getFile("depslist-crypto", $_[0]) or die "unable to get depslist-crypto" }
+sub getHdlist($) { getFile("hdlist-crypto.cz2", $_[0]) or die "unable to get hdlist-crypto.cz2" }
+
+#sub packages($) { ftp($_[0])->ls }
+sub getPackages($) {
+    my ($prefix, $packages, $mirror) = @_;
+
+    #- extract hdlist of crypto, then depslist.
+    require pkgs;
+    pkgs::psUsingHdlist($prefix, '', $packages, getHdlist($mirror), "hdlistCrypto.cz2", "Crypto", "Crytographic site", 1) and
+	pkgs::getOtherDeps($packages, getDepslist($mirror));
+
+    #- produce an output suitable for visualization.
+    pkgs::packagesOfMedium($packages, "Crypto");
+}
 
 sub get {
     my ($mirror, $dir, @files) = @_;
diff --git a/perl-install/ftp.pm b/perl-install/ftp.pm
index 014fe7237..8e5989ae4 100644
--- a/perl-install/ftp.pm
+++ b/perl-install/ftp.pm
@@ -55,7 +55,7 @@ sub getFile {
     my ($ftp, $retr) = new(@_ ? @_ : fromEnv);
     $$retr->close if $$retr;
     $$retr   = $ftp->retr(install_any::relGetFile($f)) or rewindGetFile();
-    $$retr ||= $ftp->retr(install_any::relGetFile($f));    
+    $$retr ||= $ftp->retr(install_any::relGetFile($f));
 }
 
 sub rewindGetFile() {
diff --git a/perl-install/install2.pm b/perl-install/install2.pm
index 338f3bc5f..6b52ded91 100644
--- a/perl-install/install2.pm
+++ b/perl-install/install2.pm
@@ -410,8 +410,7 @@ sub configureNetwork {
     $o->configureNetwork($_[1] == 1);
 }
 #------------------------------------------------------------------------------
-sub installCrypto { return; #TODO broken
-		    $o->installCrypto }
+sub installCrypto { $o->installCrypto }
 
 #------------------------------------------------------------------------------
 sub configureTimezone {
diff --git a/perl-install/install_steps.pm b/perl-install/install_steps.pm
index bc4d623f3..6d13edf22 100644
--- a/perl-install/install_steps.pm
+++ b/perl-install/install_steps.pm
@@ -436,31 +436,30 @@ sub pppConfig {
 #------------------------------------------------------------------------------
 sub installCrypto {
     my ($o) = @_;
-    return; #TODO broken for now
     my $u = $o->{crypto} or return; $u->{mirror} or return;
     my ($packages, %done);
     my $dir = "$o->{prefix}/tmp";
     modules::write_conf("$o->{prefix}/etc/conf.modules");
     network::up_it($o->{prefix}, $o->{intf}) if $o->{intf};
 
+    require pkgs;
+    foreach (values %{$u->{packages}}) {
+	pkgs::selectPackage($o->{packages}, $_->{pkg}) if $_->{selected};
+    }
+
+    require crypto;
+    my $oldGetFile = \&install_any::getFile;
     local *install_any::getFile = sub {
-	local *F;
-	open F, "$dir/$_[0]" or return;
-	*F;
+	my ($rpmfile) = @_;
+	if ($rpmfile =~ /^(.*)-[^-]*-[^-]*$/) {
+	    return crypto::getFile($rpmfile, $u->{mirror}) if $u->{packages}{$1};
+	}
+	#- use previous getFile typically if non cryptographic packages
+	#- have been selected by dependancies.
+	&$oldGetFile($rpmfile);
     };
-    require crypto;
-    require pkgs;
-    while (crypto::get($u->{mirror}, $dir, 
-		       grep { !$done{$_} && ($done{$_} = $u->{packages}{$_}) } %{$u->{packages}})) {
-#	 $packages = pkgs::psUsingDirectory($dir);
-#	 foreach (values %$packages) {
-#	     foreach (c::headerGetEntry(pkgs::getHeader($_), 'requires')) {
-#		 my $r = quotemeta crypto::require2package($_);
-#		 /^$r-\d/ and $u->{packages}{$_} = 1 foreach keys %{$u->{packages}};
-#	     }
-#	 }
-    }
-    pkgs::install($o->{prefix}, $o->{isUpgrade}, [ values %$packages ]); #- TODO
+
+    $o->installPackages($o->{packages});
 }
 
 #------------------------------------------------------------------------------
diff --git a/perl-install/install_steps_interactive.pm b/perl-install/install_steps_interactive.pm
index 5304ea647..d089797c1 100644
--- a/perl-install/install_steps_interactive.pm
+++ b/perl-install/install_steps_interactive.pm
@@ -519,7 +519,7 @@ sub installCrypto {
     } elsif ($o->{modem}) {
 	run_program::rooted($o->{prefix}, "ifup", "ppp0");
     } else {
-	return;
+	$::testing or return;
     }
     
     is_empty_hash_ref($u) and $o->ask_yesorno('', 
@@ -558,12 +558,16 @@ USA")) || return;
     };
     return if $@;
     
-    my @packages = do {
+    my @packages = sort { pkgs::packageHeaderFile($a) cmp pkgs::packageHeaderFile($b) } do {
       my $w = $o->wait_message('', _("Contacting the mirror to get the list of available packages"));
-      crypto::packages($u->{mirror});
+      crypto::getPackages($o->{prefix}, $o->{packages}, $u->{mirror}); #- make sure $o->{packages} is defined when testing
     };
 
-    $o->ask_many_from_list_ref('', _("Which packages do you want to install"), \@packages, [ map { \$u->{packages}{$_} } @packages ]) or return;
+    map { $u->{packages}{pkgs::packageName($_)} = { pkg => $_, selected => 0 } } @packages;
+
+    $o->ask_many_from_list_ref('', _("Which packages do you want to install"),
+			       [ map { pkgs::packageHeaderFile($_) } @packages ],
+			       [ map { \$u->{packages}{pkgs::packageName($_)}{selected} } @packages ]) or return;
 
     my $w = $o->wait_message('', _("Downloading cryptographic packages"));
     install_steps::installCrypto($o);
diff --git a/perl-install/pkgs.pm b/perl-install/pkgs.pm
index 04813bd8c..b25dfdd6f 100644
--- a/perl-install/pkgs.pm
+++ b/perl-install/pkgs.pm
@@ -93,7 +93,7 @@ sub packageVersion    { my ($pkg) = @_; $pkg->{file} =~ /.*-([^-]+)-[^-]+/ ? $1
 sub packageRelease    { my ($pkg) = @_; $pkg->{file} =~ /.*-[^-]+-([^-]+)/ ? $1 : die "invalid file `$pkg->{file}'" }
 
 sub packageSize   { my ($pkg) = @_; to_int($pkg->{sizeDeps}) }
-sub packageDepsId { my ($pkg) = @_; split ' ', ($pkg->{sizeDeps} =~ /^\d*\s+(.*)/)[0] }
+sub packageDepsId { my ($pkg) = @_; split ' ', ($pkg->{sizeDeps} =~ /^\d*\s*(.*)/)[0] }
 
 sub packageFlagSelected  { my ($pkg) = @_; $pkg->{flags} & $PKGS_SELECTED }
 sub packageFlagForce     { my ($pkg) = @_; $pkg->{flags} & $PKGS_FORCE }
@@ -118,6 +118,13 @@ sub packageFile {
     $pkg->{file} . "." . c::headerGetEntry($pkg->{header}, 'arch') . ".rpm";
 }
 
+sub packageId {
+    my ($packages, $pkg) = @_;
+    my $i = 0;
+    foreach (@{$packages->[1]}) { return $i if $pkg == $packages->[1][$i]; $i++ }
+    return;
+}
+
 sub cleanHeaders {
     my ($prefix) = @_;
     commands::rm("-rf", "$prefix/tmp/headers") if -e "$prefix/tmp/headers";
@@ -173,6 +180,11 @@ sub allPackages {
     my %skip_list; @skip_list{@skip_list} = ();
     grep { !exists $skip_list{packageName($_)} } values %{$packages->[0]};
 }
+sub packagesOfMedium {
+    my ($packages, $mediumName) = @_;
+    my $medium = $packages->[2]{$mediumName};
+    grep { $_->{medium} == $medium } @{$packages->[1]};
+}
 
 #- selection, unselection of package.
 sub selectPackage($$;$$$) {
@@ -296,53 +308,103 @@ sub psUsingHdlists {
 	my ($hdlist, $medium, $descr) = @$_;
 	my $f = install_any::getFile($hdlist) or die "no $hdlist found";
 
-	my $fakemedium = $method . ($medium || 1);
-	$packages[2]{$medium} = { hdlist     => $hdlist,
-				  medium     => $medium, #- default medium is ''.
-				  descr      => $descr, #- default value is '' too.
-				  fakemedium => $fakemedium,
-				  min        => scalar keys %{$packages[0]},
-				  max        => -1, #- will be updated after reading current hdlist.
-				  selected   => !$medium, #- default value is only CD1, it is really the minimal.
-				};
-
-	#- 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.$fakemedium.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;
-
-	symlinkf $newf, "/tmp/$hdlist";
-
-	#- 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;
+	psUsingHdlist($prefix, $method, \@packages, $f, $hdlist, $medium, $descr, !$medium);
+    }
+
+    log::l("psUsingHdlists read " . scalar keys(%{$packages[0]}) . " headers on " . scalar keys(%{$packages[2]}) . " hdlists");
+
+    \@packages;
+}
+
+sub psUsingHdlist {
+    my ($prefix, $method, $packages, $f, $hdlist, $medium, $descr, $selected) = @_;
+
+    #- if the medium already exist, use it.
+    $packages->[2]{$medium} and return;
+
+    my $fakemedium = $method . ($medium || 1);
+    my $m = $packages->[2]{$medium} = { hdlist     => $hdlist,
+					medium     => $medium, #- default medium is ''.
+					descr      => $descr, #- default value is '' too.
+					fakemedium => $fakemedium,
+					min        => scalar keys %{$packages->[0]},
+					max        => -1, #- will be updated after reading current hdlist.
+					selected   => $selected, #- default value is only CD1, it is really the minimal.
+				      };
+
+    #- 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.$fakemedium.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;
+
+    symlinkf $newf, "/tmp/$hdlist";
+
+    #- 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 => $m,
+		      };
+	    if ($packages->[0]{packageName($pkg)}) {
+		log::l("ignoring package $1 already present in distribution");
 	    } else {
-		die "cannot determine how to handle such file in $newf: $_";
+		$packages->[0]{packageName($pkg)} = $pkg;
 	    }
+	} else {
+	    die "bad hdlist file: $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";
     }
+    close F;
 
-    log::l("psUsingHdlists read " . scalar keys(%{$packages[0]}) . " headers on " . scalar keys(%{$packages[2]}) . " hdlists");
+    #- update maximal index.
+    $m->{max} = scalar(keys %{$packages->[0]}) - 1;
+    $m->{max} >= $m->{min} or die "nothing found while parsing $newf";
+    log::l("read " . ($m->{max} - $m->{min} + 1) . " headers in $hdlist");
+    1;
+}
 
-    \@packages;
+sub getOtherDeps($$) {
+    my ($packages, $f) = @_;
+
+    #- this version of getDeps is customized for handling errors more easily and
+    #- convert reference by name to deps id including closure computation.
+    foreach (<$f>) {
+	my ($name, $version, $release, $size, $deps) = /^(\S*)-([^-\s]+)-([^-\s]+)\s+(\d+)\s+(.*)/;
+	my $pkg = $packages->[0]{$name};
+
+	$pkg or log::l("ignoring package $name-$version-$release in depslist is not in hdlist"), next;
+	$version eq packageVersion($pkg) and $release eq packageRelease($pkg)
+	  or log::l("warning package $name-$version-$release in depslist mismatch version or release in hdlist"), next;
+
+	my $index = scalar @{$packages->[1]};
+	$index >= $pkg->{medium}{min} && $index <= $pkg->{medium}{max}
+	  or log::l("ignoring package $name-$version-$release in depslist outside of hdlist indexation");
+
+	#- here we have to translate referenced deps by name to id.
+	#- this include a closure on deps too.
+	my %closuredeps;
+	@closuredeps{map { packageId($packages, $_), packageDepsId($_) }
+		       grep { $_ }
+			 map { packageByName($packages, $_) or do { log::l("unknown package $_ in depslist for closure"); undef } }
+			   split /\s+/, $deps} = ();
+
+	$pkg->{sizeDeps} = join " ", $size, keys %closuredeps;
+
+	push @{$packages->[1]}, $pkg;
+    }
+
+    #- check for same number of package in depslist and hdlists, avoid being to hard.
+    scalar(keys %{$packages->[0]}) == scalar(@{$packages->[1]})
+      or log::l("other depslist has not same package as hdlist file");
 }
 
 sub getDeps($) {
@@ -789,26 +851,33 @@ sub install($$$;$$) {
 
 	if (!$depOrder || !$media) {
 	    @transToInstall = values %packages;
+	    $nb = 0;
 	} else {
-	    #- 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;
+	    do {
+		#- 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)) {
-		    $min < $_ and $min = $_;
+		$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;
+		    if ($dep->{medium}{selected}) {
+			push @transToInstall, $dep;
+			foreach (map { split '\|' } packageDepsId($dep)) {
+			    $min < $_ and $min = $_;
+			}
+		    } else {
+			log::l("ignoring package $dep->{file} as its medium is not selected");
+		    }
+		    --$nb; #- make sure the package is not taken into account as its medium is not selected.
 		}
-	    }
+	    } while (scalar(@transToInstall) == 0); #- avoid null transaction, it a nop that cost a bit.
 	}
-	$nb -= scalar @transToInstall;
 
 	log::l("starting new transaction of ". scalar @transToInstall ." packages, still $nb after that to do");
 	my $trans = c::rpmtransCreateSet($db, $prefix);