summaryrefslogtreecommitdiffstats
path: root/perl-install
diff options
context:
space:
mode:
authorMartin Whitaker <mageia@martin-whitaker.me.uk>2022-11-20 14:43:41 +0000
committerMartin Whitaker <mageia@martin-whitaker.me.uk>2022-11-20 15:43:49 +0000
commit3b45fb27771c561460b641ec1b760926fc39a69c (patch)
tree1fbc5b519c03ff555b4743c661ba281f310b5261 /perl-install
parent787ea420e1ffe713cd2de9e0d8c05608668409a9 (diff)
downloaddrakx-3b45fb27771c561460b641ec1b760926fc39a69c.tar
drakx-3b45fb27771c561460b641ec1b760926fc39a69c.tar.gz
drakx-3b45fb27771c561460b641ec1b760926fc39a69c.tar.bz2
drakx-3b45fb27771c561460b641ec1b760926fc39a69c.tar.xz
drakx-3b45fb27771c561460b641ec1b760926fc39a69c.zip
Rework mirror::nearest() to use the same algorithm as urpm::mirrors.
The old code never really worked. At best it would return a mirror at the same longitude, but usually it returned a random result.
Diffstat (limited to 'perl-install')
-rw-r--r--perl-install/install/share/list.xml5
-rw-r--r--perl-install/mirror.pm67
2 files changed, 62 insertions, 10 deletions
diff --git a/perl-install/install/share/list.xml b/perl-install/install/share/list.xml
index fcab1be9b..e8b6273ce 100644
--- a/perl-install/install/share/list.xml
+++ b/perl-install/install/share/list.xml
@@ -236,6 +236,10 @@
iso8859-1
</from>
+<from dir="/usr/share/zoneinfo">
+ zone.tab
+</from>
+
<filter command="strip">
<from dir="/LIB">
libnss_files.so.2
@@ -623,6 +627,7 @@
MDV/Snapshot/Restore.pm
Parse/EDID.pm
String/ShellQuote.pm
+ Time/ZoneInfo.pm
XML/SAX/Exception.pm
urpm.pm
urpm/args.pm
diff --git a/perl-install/mirror.pm b/perl-install/mirror.pm
index 654bdb2e9..33dbe1c9c 100644
--- a/perl-install/mirror.pm
+++ b/perl-install/mirror.pm
@@ -158,20 +158,67 @@ Randomly returns one of the nearest mirror
=cut
+#- TODO: The following code was forked from urpm::mirrors. Consider refactoring.
+
sub nearest {
my ($timezone, $mirrors) = @_;
- my (@country, @zone);
- foreach my $mirror (@$mirrors) {
- my @tzs = @{$land2tzs{$mirror->{country}} || []};
- eval { push @{$country[find_index { $_ eq $timezone } @tzs]}, $mirror };
- eval { push @{$zone[find_index { ((split '/')[0] eq (split '/', $timezone)[0]) } @tzs]}, $mirror };
+ my ($latitude, $longitude, $country_code);
+
+ require Time::ZoneInfo;
+ if (my $zones = Time::ZoneInfo->new) {
+ if (($latitude, $longitude) = $zones->latitude_longitude_decimal($timezone)) {
+ $country_code = $zones->country($timezone);
+ }
+ }
+ defined $latitude && defined $longitude or return;
+
+ foreach (@$mirrors) {
+ $_->{latitude} || $_->{longitude} or next;
+ my $PI = 3.14159265358979;
+ my $x = $latitude - $_->{latitude};
+ my $y = ($longitude - $_->{longitude}) * cos($_->{latitude} / 180 * $PI);
+ $_->{proximity} = sqrt($x * $x + $y * $y);
}
- my @l = @country ? @country : @zone;
- shift @l while !$l[0] && @l;
-
- my @possible = @l ? ((@{$l[0]}) x 2, @{$l[1] || []}) : @$mirrors;
- $possible[rand @possible];
+ my ($best) = sort { $a->{proximity} <=> $b->{proximity} } @$mirrors;
+
+ foreach (@$mirrors) {
+ $_->{proximity_corrected} = $_->{proximity} * _random_correction();
+ $_->{proximity_corrected} *= _between_country_correction($country_code, $_->{country}) if $best;
+ $_->{proximity_corrected} *= _between_continent_correction($best->{continent}, $_->{continent}) if $best;
+ $_->{proximity_corrected} *= _protocol_correction($_->{url});
+ }
+ ($best) = sort { $a->{proximity_corrected} <=> $b->{proximity_corrected} } @$mirrors;
+ $best;
+}
+
+# add +/- 5% random
+sub _random_correction() {
+ my $correction = 0.05;
+ 1 + (rand() - 0.5) * $correction * 2;
+}
+
+sub _between_country_correction {
+ my ($here, $mirror) = @_;
+ $here && $mirror or return 1;
+ $here eq $mirror ? 0.5 : 1;
+}
+
+sub _between_continent_correction {
+ my ($here, $mirror) = @_;
+ $here && $mirror or return 1;
+ $here eq $mirror ? 0.5 : # favor same continent
+ $here eq 'SA' && $mirror eq 'NA' ? 0.9 : # favor going "South America" -> "North America"
+ 1;
+}
+
+sub _protocol_correction {
+ my ($url) = @_;
+ # favor encrypted protocols, then http
+ ( $url =~ m!https://! ) and return 0.7;
+ ( $url =~ m!ftps://! ) and return 0.8;
+ ( $url =~ m!http://! ) and return 0.9;
+ 1;
}
=back