diff options
author | Daouda Lo <daouda@mandriva.com> | 2002-03-14 10:06:49 +0000 |
---|---|---|
committer | Daouda Lo <daouda@mandriva.com> | 2002-03-14 10:06:49 +0000 |
commit | 6a7a81e53170d9a2b785efa8e953977dc6dddb62 (patch) | |
tree | fb2a1973bc87eee990fba226f7e3d4a91b0364c4 | |
parent | 6cd4b2ac8899ced4c5eb4ea67eab54c8f60eb1f2 (diff) | |
download | mgaonline-6a7a81e53170d9a2b785efa8e953977dc6dddb62.tar mgaonline-6a7a81e53170d9a2b785efa8e953977dc6dddb62.tar.gz mgaonline-6a7a81e53170d9a2b785efa8e953977dc6dddb62.tar.bz2 mgaonline-6a7a81e53170d9a2b785efa8e953977dc6dddb62.tar.xz mgaonline-6a7a81e53170d9a2b785efa8e953977dc6dddb62.zip |
removed http ftp crypto
-rw-r--r-- | crypto.pm | 167 | ||||
-rw-r--r-- | ftp.pm | 84 | ||||
-rw-r--r-- | http.pm | 42 |
3 files changed, 0 insertions, 293 deletions
diff --git a/crypto.pm b/crypto.pm deleted file mode 100644 index 6a33baff..00000000 --- a/crypto.pm +++ /dev/null @@ -1,167 +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'); - $pkg && pkgs::packageVersion($pkg) || '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 getDepslist { getFile("depslist-crypto", $_[0]) or die "unable to get depslist-crypto" } - -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; -} diff --git a/ftp.pm b/ftp.pm deleted file mode 100644 index 20b837b8..00000000 --- a/ftp.pm +++ /dev/null @@ -1,84 +0,0 @@ -package ftp; # $Id$ - -use Net::FTP; - -use network; -use log; - -my %hosts; - -1; - -sub fromEnv() { - #- now URLPREFIX is generated from what is given by mdk-stage1 which is only this 4 variables. - $ENV{URLPREFIX} = "ftp://" . ($ENV{LOGIN} && ("$ENV{LOGIN}" . ($ENV{PASSWORD} && ":$ENV{PASSWORD}") . '@')) . - "$ENV{HOST}/$ENV{PREFIX}"; - @ENV{qw(HOST PREFIX LOGIN PASSWORD)}; -} - -sub new { - my ($host, $prefix, $login, $password) = @_; - my @l = do { if ($hosts{"$host$prefix"}) { - @{$hosts{"$host$prefix"}}; - } else { - my %options = (Passive => 1, Timeout => 60, Port => 21); - $options{Firewall} = $ENV{PROXY} if $ENV{PROXY}; - $options{Port} = $ENV{PROXYPORT} if $ENV{PROXYPORT}; - unless ($login) { - $login = 'anonymous'; - $password = '-drakx@'; - } - - my $ftp; - foreach (1..10) { - $ftp = Net::FTP->new(network::resolv($host), %options) or die; - $ftp && $ftp->login($login, $password) and last; - - log::l("ftp login failed, sleeping before trying again"); - sleep 5 * $_; - } - $ftp or die "unable to open ftp connection to $host"; - $ftp->binary; - $ftp->cwd($prefix); - - my @l = ($ftp, \ (my $retr = undef)); - $hosts{"$host$prefix"} = \@l; - @l; - }}; - wantarray ? @l : $l[0]; -} - -sub getFile { - my ($f, @para) = @_; - $f eq 'XXX' and rewindGetFile(), return; #- special case to force closing connection. - foreach (1..3) { - my ($ftp, $retr) = new(@para ? @para : fromEnv); - $$retr->close if $$retr; - $$retr = $ftp->retr($f) and return $$retr; - ($ftp->code == 550) and log::l("FTP: 550 file unavailable"), return; - rewindGetFile(); - log::l("ftp get failed, sleeping before trying again"); - sleep 1; - } -} - -#-sub closeFiles() { -#- #- close any existing connections -#- foreach (values %hosts) { -#- my $retr = $_->[1] if ref $_; -#- $$retr->close if $$retr; -#- undef $$retr; -#- } -#-} - -sub rewindGetFile() { - #- close any existing connection. - foreach (values %hosts) { - my ($ftp, $retr) = @{$_ || []}; - $$retr->close if $$retr; - $ftp->close() if $ftp; - } - - #- make sure to reconnect to server. - %hosts = (); -} diff --git a/http.pm b/http.pm deleted file mode 100644 index 8d1e8d5d..00000000 --- a/http.pm +++ /dev/null @@ -1,42 +0,0 @@ -package http; # $Id$ - -use IO::Socket; -use network; - - -my $sock; - -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 = IO::Socket::INET->new(PeerAddr => $host, - PeerPort => $port || 80, - Proto => 'tcp', - Timeout => 60) or die "can't connect $@"; - $sock->autoflush; - print $sock join("\015\012" => - "GET $path HTTP/1.0", - "Host: $host" . ($port && ":$port"), - "User-Agent: DrakX/vivelinuxabaszindozs", - "", ""); - - #- skip until empty line - my ($now, $last, $buf, $tmp) = 0; - my $read = sub { sysread($sock, $buf, 1) || die; $tmp .= $buf }; - do { - $last = $now; - &$read; &$read if $buf =~ /\015/; - $now = $buf =~ /\012/; - } until ($now && $last); - - $tmp =~ /^.*\b200\b/ ? $sock : undef; -} - -1; |