summaryrefslogtreecommitdiffstats
path: root/perl-install
diff options
context:
space:
mode:
authorFrancois Pons <fpons@mandriva.com>2000-04-05 17:24:05 +0000
committerFrancois Pons <fpons@mandriva.com>2000-04-05 17:24:05 +0000
commitc3de4c115afa51c96bdd3684644cae2176f015b4 (patch)
tree98eebc1de911977e1861bafaa2fb3515ce5b1b2e /perl-install
parentdebc157ddf436583fd777e33829c8609a65e0c67 (diff)
downloaddrakx-backup-do-not-use-c3de4c115afa51c96bdd3684644cae2176f015b4.tar
drakx-backup-do-not-use-c3de4c115afa51c96bdd3684644cae2176f015b4.tar.gz
drakx-backup-do-not-use-c3de4c115afa51c96bdd3684644cae2176f015b4.tar.bz2
drakx-backup-do-not-use-c3de4c115afa51c96bdd3684644cae2176f015b4.tar.xz
drakx-backup-do-not-use-c3de4c115afa51c96bdd3684644cae2176f015b4.zip
*** empty log message ***
Diffstat (limited to 'perl-install')
-rw-r--r--perl-install/ChangeLog10
-rw-r--r--perl-install/crypto.pm29
-rw-r--r--perl-install/ftp.pm2
-rw-r--r--perl-install/install2.pm3
-rw-r--r--perl-install/install_steps.pm33
-rw-r--r--perl-install/install_steps_interactive.pm12
-rw-r--r--perl-install/pkgs.pm185
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);