diff options
| -rw-r--r-- | crypto.pm | 167 | ||||
| -rw-r--r-- | ftp.pm | 84 | ||||
| -rw-r--r-- | http.pm | 42 |
3 files changed, 293 insertions, 0 deletions
diff --git a/crypto.pm b/crypto.pm new file mode 100644 index 00000000..6a33baff --- /dev/null +++ b/crypto.pm @@ -0,0 +1,167 @@ +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; +} @@ -0,0 +1,84 @@ +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 new file mode 100644 index 00000000..8d1e8d5d --- /dev/null +++ b/http.pm @@ -0,0 +1,42 @@ +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; |