summaryrefslogtreecommitdiffstats
path: root/perl-install/crypto.pm
diff options
context:
space:
mode:
authorMystery Man <unknown@mandriva.org>2002-07-31 23:10:55 +0000
committerMystery Man <unknown@mandriva.org>2002-07-31 23:10:55 +0000
commit6b5bb447b11a31fc0961c20485505a633c9ab4eb (patch)
treeeae73bee290e1e328b539f7649818d7584ee667e /perl-install/crypto.pm
parent79d226c48d6de4f26c604ddbd0ce769a58d548c6 (diff)
downloaddrakx-6b5bb447b11a31fc0961c20485505a633c9ab4eb.tar
drakx-6b5bb447b11a31fc0961c20485505a633c9ab4eb.tar.gz
drakx-6b5bb447b11a31fc0961c20485505a633c9ab4eb.tar.bz2
drakx-6b5bb447b11a31fc0961c20485505a633c9ab4eb.tar.xz
drakx-6b5bb447b11a31fc0961c20485505a633c9ab4eb.zip
This commit was manufactured by cvs2svn to create tag 'V1_1_8_16mdk'.V1_1_8_16mdk
Diffstat (limited to 'perl-install/crypto.pm')
-rw-r--r--perl-install/crypto.pm166
1 files changed, 0 insertions, 166 deletions
diff --git a/perl-install/crypto.pm b/perl-install/crypto.pm
deleted file mode 100644
index 06c8db3e6..000000000
--- a/perl-install/crypto.pm
+++ /dev/null
@@ -1,166 +0,0 @@
-package crypto; # $Id$
-
-use diagnostics;
-use strict;
-
-use MDK::Common::System;
-use common;
-use log;
-use ftp;
-
-my %url2land = (
- fr => _("France"),
- cr => _("Costa Rica"),
- be => _("Belgium"),
- cz => _("Czech Republic"),
- de => _("Germany"),
- gr => _("Greece"),
- no => _("Norway"),
- se => _("Sweden"),
- nl => _("Netherlands"),
- it => _("Italy"),
- at => _("Austria"),
- );
-
-my %land2tzs = (
- _("France") => [ 'Europe/Paris', 'Europe/Brussels', 'Europe/Berlin' ],
- _("Belgium") => [ 'Europe/Brussels', 'Europe/Paris', 'Europe/Berlin' ],
- _("Czech Republic") => [ 'Europe/Prague', 'Europe/Berlin' ],
- _("Germany") => [ 'Europe/Berlin', 'Europe/Prague' ],
- _("Greece") => [ 'Europe/Athens', 'Europe/Prague' ],
- _("Norway") => [ 'Europe/Oslo', 'Europe/Stockholm' ],
- _("Sweden") => [ 'Europe/Stockholm', 'Europe/Oslo' ],
- _("United States") => [ 'America/New_York', 'Canada/Atlantic', 'Asia/Tokyo', 'Australia/Sydney', 'Europe/Paris' ],
- _("Netherlands") => [ 'Europe/Amsterdam', 'Europe/Brussels', 'Europe/Berlin' ],
- _("Italy") => [ 'Europe/Rome', 'Europe/Brussels', 'Europe/Paris' ],
- _("Austria") => [ 'Europe/Vienna', 'Europe/Brussels', 'Europe/Berlin' ],
- );
-
-my %static_mirrors = (
-# "ackbar" => [ "Ackbar", "/updates", "a", "a" ],
- );
-
-my %mirrors;
-
-my %deps = (
- 'libcrypto.so.0' => 'openssl',
- 'libssl.so.0' => 'openssl',
- 'mod_sxnet.so' => 'mod_ssl-sxnet',
-);
-
-sub require2package { $deps{$_[0]} || $_[0] }
-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");
-
- local $SIG{ALRM} = sub { die "timeout" };
- alarm 60;
- 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 $land = _("United States");
- foreach (keys %url2land) {
- my $qu = quotemeta $_;
- $url =~ /\.$qu(?:\..*)?$/ and $land = $url2land{$_};
- }
- $mirrors{$url} = [ $land, $dir ];
- }
- http::getFile('/XXX'); #- close connection.
- alarm 0;
-
- #- now add static mirror (in case of something wrong happened above).
- add2hash(\%mirrors, \%static_mirrors);
- }
- keys %mirrors;
-}
-
-sub bestMirror {
- my ($string) = @_;
- my %mirror2value;
-
- foreach my $url (mirrors()) {
- my $value = 0;
- my $cvalue = mirrors();
-
- $mirror2value{$url} ||= 1 + $cvalue;
- foreach (@{$land2tzs{$mirrors{$url}[0]} || []}) {
- $_ eq $string and $mirror2value{$url} > $value and $mirror2value{$url} = $value;
- (split '/')[0] eq (split '/', $string)[0] and $mirror2value{$url} > $cvalue and $mirror2value{$url} = $cvalue;
- ++$value;
- }
- }
- my ($min_value) = sort { $a <=> $b } values %mirror2value;
-
- my @possible = grep { $mirror2value{$_} == $min_value } keys %mirror2value;
- push @possible, grep { $mirror2value{$_} == $min_value } keys %mirror2value;
- push @possible, grep { $mirror2value{$_} == 1 + $min_value } keys %mirror2value;
-
- $possible[rand @possible];
-}
-
-#- hack to retrieve Mandrake Linux version...
-sub version {
- require pkgs;
- my $pkg = pkgs::packageByName($::o->{packages}, 'mandrake-release');
- return '8.2'; #- very dangerous but for testing waiting for post 8.2 distrib TODO
- $pkg && $pkg->version || '8.2'; #- safe but dangerous ;-)
-}
-
-sub dir { $mirrors{$_[0]}[1] . '/' . version() }
-sub ftp($) { ftp::new($_[0], dir($_[0])) }
-
-sub getFile {
- my ($file, $host) = @_;
- $host ||= $crypto::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] : ()
- );
- $$retr->close if $$retr;
- $$retr = $ftp->retr($file) or ftp::rewindGetFile();
- $$retr ||= $ftp->retr($file);
-}
-
-sub getPackages {
- my ($prefix, $packages, $mirror) = @_;
-
- $crypto::host = $mirror;
-
- #- check first if there is something to get...
- my $fhdlist = getFile("base/hdlist.cz", $mirror);
- unless ($fhdlist) {
- log::l("no updates available, bailing out");
- return;
- }
-
- #- extract hdlist of crypto, then depslist.
- require pkgs;
- my $update_medium = pkgs::psUsingHdlist($prefix, 'ftp', $packages, "hdlist-updates.cz", "1u", "RPMS",
- "Updates for Mandrake Linux " . version(), 1, $fhdlist) 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} = "ftp://$mirror" . dir($mirror);
- #- (re-)enable the medium to allow install of package,
- #- make it an update medium (for install_any::install_urpmi).
- $update_medium->{selected} = 1;
- $update_medium->{update} = 1;
-
- return $update_medium;
-}
-
-sub get {
- my ($mirror, $dir, @files) = @_;
- foreach (@files) {
- log::l("crypto: downloading $_");
- ftp($mirror)->get($_, "$dir/$_")
- }
- int @files;
-}