summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--crypto.pm167
-rw-r--r--ftp.pm84
-rw-r--r--http.pm42
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;
+}
diff --git a/ftp.pm b/ftp.pm
new file mode 100644
index 00000000..20b837b8
--- /dev/null
+++ b/ftp.pm
@@ -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;