From aa560937696c59232dfdf00f3b493b8f85bf412a Mon Sep 17 00:00:00 2001 From: Francois Pons Date: Fri, 4 Jan 2002 16:41:45 +0000 Subject: added update installation support to install (big modifs need testing). --- perl-install/crypto.pm | 78 ++++++++++++++++++++++++++++++++++++-------------- 1 file changed, 57 insertions(+), 21 deletions(-) (limited to 'perl-install/crypto.pm') 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 { -- cgit v1.2.1