diff options
Diffstat (limited to 'perl-install')
| -rw-r--r-- | perl-install/crypto.pm | 45 |
1 files changed, 40 insertions, 5 deletions
diff --git a/perl-install/crypto.pm b/perl-install/crypto.pm index 749538bab..4d9033e28 100644 --- a/perl-install/crypto.pm +++ b/perl-install/crypto.pm @@ -8,7 +8,7 @@ use common; use log; use ftp; -my %url2lang = ( +my %url2land = ( fr => _("France"), cr => _("Costa Rica"), be => _("Belgium"), @@ -19,6 +19,17 @@ my %url2lang = ( se => _("Sweden"), ); +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' ], + _("Grece") => [ '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' ], + ); + my %static_mirrors = ( # "ackbar" => [ "Ackbar", "/updates", "a", "a" ], ); @@ -44,12 +55,12 @@ sub mirrors { 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 $land = _("United States"); + foreach (keys %url2land) { my $qu = quotemeta $_; - $url =~ /\.$qu(?:\..*)?$/ and $lang = $url2lang{$_}; + $url =~ /\.$qu(?:\..*)?$/ and $land = $url2land{$_}; } - $mirrors{$url} = [ $lang, $dir ]; + $mirrors{$url} = [ $land, $dir ]; } http::getFile('/XXX'); #- close connection. @@ -59,6 +70,30 @@ sub 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]; +} + #sub dir { $mirrors{$_[0]}[1] . '/' . $::VERSION } sub dir { $mirrors{$_[0]}[1] . '/' . '8.1' } sub ftp($) { ftp::new($_[0], dir($_[0])) } |