summaryrefslogtreecommitdiffstats
path: root/perl-install
diff options
context:
space:
mode:
Diffstat (limited to 'perl-install')
-rw-r--r--perl-install/crypto.pm78
-rw-r--r--perl-install/http.pm7
-rw-r--r--perl-install/install2.pm5
-rw-r--r--perl-install/install_any.pm18
-rw-r--r--perl-install/install_steps.pm10
-rw-r--r--perl-install/install_steps_gtk.pm6
-rw-r--r--perl-install/install_steps_interactive.pm64
-rw-r--r--perl-install/pkgs.pm65
-rw-r--r--perl-install/steps.pm1
9 files changed, 194 insertions, 60 deletions
diff --git a/perl-install/crypto.pm b/perl-install/crypto.pm
index 74200ddeb..cb6517536 100644
--- a/perl-install/crypto.pm
+++ b/perl-install/crypto.pm
@@ -3,22 +3,27 @@ package crypto; # $Id$
use diagnostics;
use strict;
+use MDK::Common::System;
use common;
use log;
use ftp;
-my %mirrors = (
- "ftp.ucr.ac.cr" => [ "Costa Rica", "/pub/Unix/linux/mandrake/Mandrake" ],
- "ftp.nectec.or.th" => [ "Thailand", "/pub/mirrors/Mandrake-crypto" ],
- "ftp.tvd.be" => [ "Belgium", "/packages/mandrake-crypto" ],
- "sunsite.mff.cuni.cz" => [ "Czech Republic", "/OS/Linux/Dist/Mandrake-crypto" ],
- "ftp.uni-kl.de" => [ "Germany", "/pub/linux/mandrake/Mandrake-crypto" ],
- "ftp.duth.gr" => [ "Grece", "/pub/mandrake-crypto" ],
- "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 %url2lang = (
+ fr => _("France"),
+ cr => _("Costa Rica"),
+ be => _("Belgium"),
+ cz => _("Czech Republic"),
+ de => _("Germany"),
+ gr => _("Grece"),
+ no => _("Norway"),
+ se => _("Sweden"),
+ );
+
+my %static_mirrors = (
+# "ackbar" => [ "Ackbar", "/updates", "a", "a" ],
+ );
+
+my %mirrors = ();
my %deps = (
'libcrypto.so.0' => 'openssl',
@@ -27,16 +32,43 @@ my %deps = (
);
sub require2package { $deps{$_[0]} || $_[0] }
-sub mirror2text($) { $mirrors{$_[0]} && "$mirrors{$_[0]}[0] ($_[0])" }
-sub mirrors() { keys %mirrors }
-sub dir { $mirrors{$_[0]}[1] . '/' . (arch() !~ /i.86/ && ((arch() =~ /sparc/ ? "sparc" : arch()). '/')) . $::VERSION }
+sub mirror2text { $mirrors{$_[0]} && ($mirrors{$_[0]}[0] . '|' . $_[0]) }
+
+sub mirrors {
+ unless (keys %mirrors) {
+ #- contact the following URL to retrieve list of mirror.
+ #- http://www.linux-mandrake.com/mirrorsfull.list
+ require http;
+ my $f = http::getFile("http://www.linux-mandrake.com/mirrorsfull.list");
+ foreach (<$f>) {
+ my ($arch, $url, $dir) = m|updates([^:]*):ftp://([^/]*)(/\S*)| or next;
+ MDK::Common::System::compat_arch($arch) or
+ log::l("ignoring updates from $url because of incompatible arch: $arch"), next;
+ my $lang = _("United States");
+ foreach (keys %url2lang) {
+ my $qu = quotemeta $_;
+ $url =~ /\.$qu(?:\..*)?$/ and $lang = $url2lang{$_};
+ }
+ $mirrors{$url} = [ $lang, $dir ];
+ }
+ http::getFile('/XXX'); #- close connection.
+
+ #- now add static mirror (in case of something wrong happened above).
+ add2hash(\%mirrors, \%static_mirrors);
+ }
+ keys %mirrors;
+}
+
+#sub dir { $mirrors{$_[0]}[1] . '/' . $::VERSION }
+sub dir { $mirrors{$_[0]}[1] . '/' . '8.1' }
sub ftp($) { ftp::new($_[0], dir($_[0])) }
sub getFile {
my ($file, $host) = @_;
$host ||= $crypto::host;
- log::l("getting crypto file $file on directory " . dir($host) . " with login $mirrors{$host}[2]");
- my ($ftp, $retr) = ftp::new($host, dir($host),
+ my $dir = dir($host) . ($file =~ /\.rpm$/ && "/RPMS");
+ log::l("getting crypto file $file on directory $dir with login $mirrors{$host}[2]");
+ my ($ftp, $retr) = ftp::new($host, $dir,
$mirrors{$host}[2] ? $mirrors{$host}[2] : (),
$mirrors{$host}[3] ? $mirrors{$host}[3] : ()
);
@@ -54,11 +86,15 @@ sub getPackages {
#- extract hdlist of crypto, then depslist.
require pkgs;
- pkgs::psUsingHdlist($prefix, '', $packages, "hdlist-crypto.cz2", "crypto.cz2", "Crypto", "Cryptographic site", 1, getFile("hdlist-crypto.cz2", $mirror)) and
- pkgs::getOtherDeps($packages, getDepslist($mirror));
+ my $update_medium = pkgs::psUsingHdlist($prefix, 'ftp', $packages, "hdlist-updates.cz",
+ 1+scalar(keys %{$packages->{mediums}}), "RPMS",
+ #"Updates for Mandrake Linux $::VERSION", 1, getFile("base/hdlist.cz", $mirror)) and
+ "Updates for Mandrake Linux 8.1", 1, getFile("base/hdlist.cz", $mirror)) and
+ log::l("read updates hdlist");
+ #- keep in mind where is the URL prefix used according to mirror (for install_any::install_urpmi).
+ $update_medium->{prefix} = dir($mirror);
- #- produce an output suitable for visualization.
- map { pkgs::packageName($_) } pkgs::packagesOfMedium($packages, "Crypto");
+ return $update_medium;
}
sub get {
diff --git a/perl-install/http.pm b/perl-install/http.pm
index 057764a27..8d1e8d5de 100644
--- a/perl-install/http.pm
+++ b/perl-install/http.pm
@@ -10,15 +10,16 @@ sub getFile {
local($^W) = 0;
my ($url) = @_;
+ $sock->close if $sock;
+ $url =~ m|/XXX$| and return; #- force closing connection.
+
my ($host, $port, $path) = $url =~ m,^http://([^/:]+)(?::(\d+))?(/\S*)?$,;
$host = network::resolv($host);
- $sock->close if $sock;
- $url =~ m|/XXX$| and return; #- force closing connection.
$sock = IO::Socket::INET->new(PeerAddr => $host,
PeerPort => $port || 80,
Proto => 'tcp',
- Timeout => 60) or die "can't connect ";
+ Timeout => 60) or die "can't connect $@";
$sock->autoflush;
print $sock join("\015\012" =>
"GET $path HTTP/1.0",
diff --git a/perl-install/install2.pm b/perl-install/install2.pm
index 529a3b6ac..f0ec6960d 100644
--- a/perl-install/install2.pm
+++ b/perl-install/install2.pm
@@ -260,6 +260,11 @@ sub installCrypto {
installStepsCall($o, $auto, 'installCrypto');
}
#------------------------------------------------------------------------------
+sub installUpdates {
+ my ($clicked, $ent_number, $auto) = @_;
+ installStepsCall($o, $auto, 'installUpdates');
+}
+#------------------------------------------------------------------------------
sub configureServices {
my ($clicked, $ent_number, $auto) = @_;
installStepsCall($o, $auto, 'configureServices', $clicked);
diff --git a/perl-install/install_any.pm b/perl-install/install_any.pm
index f5fa3ddf9..0821cef2e 100644
--- a/perl-install/install_any.pm
+++ b/perl-install/install_any.pm
@@ -134,7 +134,7 @@ sub getFile {
if ($f =~ m|^http://|) {
require http;
http::getFile($f);
- } elsif ($method =~ /crypto/i) {
+ } elsif ($method =~ /crypto|update/i) {
require crypto;
crypto::getFile($f);
} elsif ($::o->{method} eq "ftp") {
@@ -195,7 +195,7 @@ sub setup_postinstall_rpms($$) {
#- the complete filename of each package.
#- copy the package files in the postinstall RPMS directory.
#- last arg is default medium '' known as the CD#1.
- pkgs::extractHeaders($prefix, \@toCopy, $packages->{mediums}{$boot_medium});
+ pkgs::extractHeaders($prefix, \@toCopy, $packages->{mediums});
cp_af((map { "/tmp/image/" . relGetFile(pkgs::packageFile($_)) } @toCopy), $postinstall_rpms);
log::l("copying Auto Install Floppy");
@@ -517,7 +517,7 @@ sub install_urpmi {
#- rare case where urpmi cannot be installed (no hd install path).
$method eq 'disk' && !hdInstallPath() and return;
- my @cfg = map_index {
+ my @cfg = map {
my $name = $_->{fakemedium};
local *LIST;
@@ -525,11 +525,11 @@ sub install_urpmi {
open LIST, ">$prefix/var/lib/urpmi/list.$name" or log::l("failed to write list.$name");
umask $mask;
- my $dir = ${{ nfs => "file://mnt/nfs",
- disk => "file:/" . hdInstallPath(),
- ftp => $ENV{URLPREFIX},
- http => $ENV{URLPREFIX},
- cdrom => "removable://mnt/cdrom" }}{$method} . "/$_->{rpmsdir}";
+ my $dir = ($_->{prefix} || ${{ nfs => "file://mnt/nfs",
+ disk => "file:/" . hdInstallPath(),
+ ftp => $ENV{URLPREFIX},
+ http => $ENV{URLPREFIX},
+ cdrom => "removable://mnt/cdrom" }}{$method}) . "/$_->{rpmsdir}";
local *FILES; open FILES, "$ENV{LD_LOADER} parsehdlist /tmp/$_->{hdlist} |";
print LIST "$dir/$_\n" foreach chomp_(<FILES>);
@@ -548,7 +548,7 @@ sub install_urpmi {
}
";
- } values %$mediums;
+ } sort { $a->{medium} <=> $b->{medium} } values %$mediums;
eval { output "$prefix/etc/urpmi/urpmi.cfg", @cfg };
#- automatically build all synthesis files.
diff --git a/perl-install/install_steps.pm b/perl-install/install_steps.pm
index ac7f33e98..ef8235c0b 100644
--- a/perl-install/install_steps.pm
+++ b/perl-install/install_steps.pm
@@ -589,6 +589,16 @@ sub installCrypto {
$o->pkg_install(@{$u->{packages}});
}
+sub installUpates {
+ my ($o) = @_;
+ my $u = $o->{updates} or return; $u->{updates} && $u->{packages} or return;
+
+ upNetwork($o);
+ require crypto;
+ my @crypto_packages = crypto::getPackages($o->{prefix}, $o->{packages}, $u->{mirror});
+ $o->pkg_install(@{$u->{packages}});
+}
+
sub summary {
my ($o) = @_;
configureTimezone($o);
diff --git a/perl-install/install_steps_gtk.pm b/perl-install/install_steps_gtk.pm
index 5350faf2f..b13a1467d 100644
--- a/perl-install/install_steps_gtk.pm
+++ b/perl-install/install_steps_gtk.pm
@@ -335,7 +335,7 @@ sub reallyChooseGroups {
sub choosePackagesTree {
- my ($o, $packages) = @_;
+ my ($o, $packages, $limit_to_medium) = @_;
my $available = install_any::getAvailableSpace($o);
my $availableCorrected = pkgs::invCorrectSize($available / sqr(1024)) * sqr(1024);
@@ -356,6 +356,7 @@ sub choosePackagesTree {
my ($add_node, $flat) = @_;
if ($flat) {
foreach (sort keys %{$packages->{names}}) {
+ !$limit_to_medium || pkgs::packageMedium($packages, $_) == $limit_to_medium or next;
$add_node->($_, undef);
}
} else {
@@ -364,6 +365,7 @@ sub choosePackagesTree {
#$fl{$_} = $o->{compssUsersChoice}{$_} foreach @{$o->{compssUsers}{$root}{flags}}; #- FEATURE:improve choce of packages...
$fl{$_} = 1 foreach @{$o->{compssUsers}{$root}{flags}};
foreach my $p (values %{$packages->{names}}) {
+ !$limit_to_medium || pkgs::packageMedium($packages, $p) == $limit_to_medium or next;
my ($rate, @flags) = pkgs::packageRateRFlags($p);
next if !($rate && grep { grep { !/^!/ && $fl{$_} } split('\|\|') } @flags);
$rate >= 3 ?
@@ -378,7 +380,7 @@ sub choosePackagesTree {
},
get_info => sub {
my $p = pkgs::packageByName($packages, $_[0]) or return '';
- pkgs::extractHeaders($o->{prefix}, [$p], pkgs::packageMedium($packages, $p));
+ pkgs::extractHeaders($o->{prefix}, [$p], $packages->{mediums});
pkgs::packageHeader($p) or die;
my $imp = translate($pkgs::compssListDesc{pkgs::packageFlagBase($p) ?
diff --git a/perl-install/install_steps_interactive.pm b/perl-install/install_steps_interactive.pm
index 2ad4cc798..bd1591d39 100644
--- a/perl-install/install_steps_interactive.pm
+++ b/perl-install/install_steps_interactive.pm
@@ -538,13 +538,15 @@ sub chooseSizeToInstall {
min($def, $availableC * 0.7);
}
sub choosePackagesTree {
- my ($o, $packages) = @_;
+ my ($o, $packages, $limit_to_medium) = @_;
$o->ask_many_from_list('', _("Choose the packages you want to install"),
{
list => [
- map { pkgs::packageByName($packages, $_) }
- keys %{$packages->{names}} ],
+ map { pkgs::packageByName($packages, $_) }
+ $limit_to_medium ?
+ (grep { pkgs::packageMedium($packages, $_) == $limit_to_medium } keys %{$packages->{names}}) :
+ (keys %{$packages->{names}}) ],
value => \&pkgs::packageFlagSelected,
label => \&pkgs::packageName,
sort => 1,
@@ -866,17 +868,67 @@ USA")) || return;
#- bring all interface up for installing crypto packages.
install_interactive::upNetwork($o);
- my @packages = do {
+ my $update_medium = do {
+ my $w = $o->wait_message('', _("Contacting the mirror to get the list of available packages"));
+ crypto::getPackages($o->{prefix}, $o->{packages}, $u->{mirror}); #- make sure $o->{packages} is defined when testing
+ };
+
+ if ($update_medium) {
+ $o->choosePackagesTree($o->{packages}, $update_medium);
+ $o->pkg_install();
+ }
+
+ #- stop interface using ppp only.
+ install_interactive::downNetwork($o, 'pppOnly');
+}
+
+sub installUpdates {
+ my ($o) = @_;
+ my $u = $o->{updates} ||= {};
+
+ $o->hasNetwork or return;
+
+ is_empty_hash_ref($u) and $o->ask_yesorno('',
+_("You have now the possibility to download updated packages that have
+been released after the distribution has been made available.
+
+You will get security fixes or bug fixes, but you need to have an
+Internet connection configured to proceed.
+
+Do you want to continue ?")) || return;
+
+ #- bring all interface up for installing crypto packages.
+ install_interactive::upNetwork($o);
+
+ require crypto;
+ eval {
+ my @mirrors = do { my $w = $o->wait_message('',
+ _("Contacting Mandrake Linux web site to get the list of available mirrors"));
+ crypto::mirrors() };
+ $u->{mirror} = $o->ask_from_treelistf('',
+ _("Choose a mirror from which to get the packages"),
+ '|',
+ \&crypto::mirror2text,
+ \@mirrors,
+ $u->{mirror});
+ };
+ return if $@;
+
+ my $update_medium = do {
my $w = $o->wait_message('', _("Contacting the mirror to get the list of available packages"));
crypto::getPackages($o->{prefix}, $o->{packages}, $u->{mirror}); #- make sure $o->{packages} is defined when testing
};
- $u->{packages} = $o->ask_many_from_list('', _("Please choose the packages you want to install."), { list => \@packages, values => $u->{packages} }) or return;
- $o->pkg_install(@{$u->{packages}});
+ if ($update_medium) {
+ $o->choosePackagesTree($o->{packages}, $update_medium);
+ $o->pkg_install();
+ }
+
#- stop interface using ppp only.
install_interactive::downNetwork($o, 'pppOnly');
}
+
#------------------------------------------------------------------------------
sub configureTimezone {
my ($o, $clicked) = @_;
diff --git a/perl-install/pkgs.pm b/perl-install/pkgs.pm
index 4ce9c373e..9110d403d 100644
--- a/perl-install/pkgs.pm
+++ b/perl-install/pkgs.pm
@@ -129,16 +129,25 @@ sub cleanHeaders {
}
#- get all headers from an hdlist file.
-sub extractHeaders($$$) {
- my ($prefix, $pkgs, $medium) = @_;
+sub extractHeaders {
+ my ($prefix, $pkgs, $media) = @_;
+ my %medium2pkgs;
cleanHeaders($prefix);
- eval {
- require packdrake;
- my $packer = new packdrake("/tmp/$medium->{hdlist}", quiet => 1);
- $packer->extract_archive("$prefix/tmp/headers", map { packageHeaderFile($_) } @$pkgs);
- };
+ foreach (@$pkgs) {
+ push @{$medium2pkgs{$_->[$MEDIUM]} ||= []}, $_;
+ }
+
+ foreach (values %medium2pkgs) {
+ my $medium = $media->{$_->[0][$MEDIUM]}; #- the first one is a valid package pointing to right medium to use.
+
+ eval {
+ require packdrake;
+ my $packer = new packdrake("/tmp/$medium->{hdlist}", quiet => 1);
+ $packer->extract_archive("$prefix/tmp/headers", map { packageHeaderFile($_) } @$_);
+ };
+ }
foreach (@$pkgs) {
my $f = "$prefix/tmp/headers/". packageHeaderFile($_);
@@ -404,6 +413,7 @@ sub psUsingHdlists {
sub psUsingHdlist {
my ($prefix, $method, $packages, $hdlist, $medium, $rpmsdir, $descr, $selected, $fhdlist) = @_;
my $fakemedium = "$descr ($method$medium)";
+ my ($relocated, $ignored) = (0, 0);
log::l("trying to read $hdlist for medium $medium");
#- if the medium already exist, use it.
@@ -438,27 +448,38 @@ sub psUsingHdlist {
my $packer = new packdrake($newf, quiet => 1);
foreach (@{$packer->{files}}) {
$packer->{data}{$_}[0] eq 'f' or next;
- ++$packages->{count}; #- take care of this one, so that desplist will be clean with index of package.
my $pkg = [ (undef) x 8 ]; $pkg->[$FILE] = $_; $pkg->[$MEDIUM] = $medium;
my $specific_arch = packageArch($pkg);
if (!$specific_arch || MDK::Common::System::compat_arch($specific_arch)) {
my $old_pkg = $packages->{names}{packageName($pkg)};
if ($old_pkg) {
- if (packageVersion($pkg) eq packageVersion($old_pkg) && packageRelease($pkg) eq packageRelease($old_pkg)) {
- if (MDK::Common::System::better_arch($specific_arch, packageArch($old_pkg))) {
- log::l("replacing old package with package $_ with better arch: $specific_arch");
- $packages->{names}{packageName($pkg)} = $pkg;
- } else {
- log::l("keeping old package against package $_ with worse arch");
+ my $epo_compare = 0; #- NO EPOCH AVAILABLE TODO packageEpoch($pkg) <=> packageEpoch($old_pkg);
+ my $ver_compare = $epo_compare == 0 && versionCompare(packageVersion($pkg), packageVersion($old_pkg));
+ my $rel_compare = $ver_compare == 0 && versionCompare(packageRelease($pkg), packageRelease($old_pkg));
+ if ($epo_compare > 0 || $ver_compare > 0 || $rel_compare > 0 ||
+ $epo_compare == 0 && $ver_compare == 0 && $rel_compare == 0 &&
+ MDK::Common::System::better_arch($specific_arch, packageArch($old_pkg))) {
+ log::l("replacing old package $old_pkg->[$FILE] with package $pkg->[$FILE]");
+ foreach ($FILE, $MEDIUM) { #- TODO KEEP OLD PARAMETER
+ $old_pkg->[$_] = $pkg->[$_];
}
+ packageFreeHeader($old_pkg);
+ if (packageFlagInstalled($old_pkg)) {
+ packageSetFlagInstalled($old_pkg, 0);
+ selectPackage($packages, $old_pkg);
+ }
+ ++$relocated;
} else {
- log::l("ignoring package $_ already present in distribution with different version or release");
+ log::l("no need to replace previous package $old_pkg->[$FILE] with newer package $pkg->[$FILE]");
+ ++$ignored;
}
} else {
$packages->{names}{packageName($pkg)} = $pkg;
+ ++$packages->{count}; #- take care of this one, so that desplist will be clean with index of package.
}
} else {
log::l("ignoring package $_ with incompatible arch: $specific_arch");
+ ++$ignored;
}
}
};
@@ -466,8 +487,10 @@ sub psUsingHdlist {
#- update maximal index.
$m->{max} = $packages->{count} - 1;
$m->{max} >= $m->{min} or die "nothing found while parsing $newf";
- log::l("read " . ($m->{max} - $m->{min} + 1) . " headers in $hdlist");
- 1;
+ $relocated > 0 and log::l("relocated $relocated headers in $hdlist");
+ $ignored > 0 and log::l("ignored $ignored headers in $hdlist");
+ log::l("read " . ($m->{max} - $m->{min} + 1) . " new headers in $hdlist");
+ $m;
}
sub getOtherDeps($$) {
@@ -1327,13 +1350,17 @@ sub install($$$;$$) {
}
#- extract headers for parent as they are used by callback.
- extractHeaders($prefix, \@transToInstall, $media->{$medium});
+ extractHeaders($prefix, \@transToInstall, $media);
if ($media->{$medium}{method} eq 'cdrom') {
+ #- extract packages to make sure the getFile below to force
+ #- accessing medium will not be redirected to updates.
+ my @origin = grep { $_->[$MEDIUM] == $media->{$medium} } @transToInstall;
+
#- reset file descriptor open for main process but
#- make sure error trying to change from hdlist are
#- trown from main process too.
- install_any::getFile(packageFile($transToInstall[0]), $media->{$transToInstall[0][$MEDIUM]}{descr});
+ @origin and install_any::getFile(packageFile($origin[0]), $media->{$origin[0][$MEDIUM]}{descr});
}
#- and make sure there are no staling open file descriptor too (before forking)!
install_any::getFile('XXX');
diff --git a/perl-install/steps.pm b/perl-install/steps.pm
index ddfe7b777..c727b33f6 100644
--- a/perl-install/steps.pm
+++ b/perl-install/steps.pm
@@ -24,6 +24,7 @@ use common;
setRootPassword => [ __("Set root password"), 1, 1, '', "installPackages", 'rootpasswd' ],
addUser => [ __("Add a user"), 1, 1, '', "installPackages", 'user' ],
configureNetwork => [ __("Configure networking"), 1, 1, '', "formatPartitions", 'network' ],
+ installUpdates => [ __("Install system updates"), 1, 1, '', ["installPackages", "configureNetwork"], '' ],
summary => [ __("Summary"), 1, 0, '', "installPackages", 'summary' ],
configureServices => [ __("Configure services"), 1, 1, '!$::expert', "installPackages", 'services' ],
setupBootloader => [ __("Install bootloader"), 1, 0, '', "installPackages", 'bootloader' ],
generated by cgit v1.2.1 (git 2.21.0) at 2024-11-01 15:14:10 +0000