diff options
| -rw-r--r-- | perl-install/ChangeLog | 10 | ||||
| -rw-r--r-- | perl-install/crypto.pm | 29 | ||||
| -rw-r--r-- | perl-install/ftp.pm | 2 | ||||
| -rw-r--r-- | perl-install/install2.pm | 3 | ||||
| -rw-r--r-- | perl-install/install_steps.pm | 33 | ||||
| -rw-r--r-- | perl-install/install_steps_interactive.pm | 12 | ||||
| -rw-r--r-- | perl-install/pkgs.pm | 185 |
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); |