summaryrefslogtreecommitdiffstats
path: root/perl-install/mirror.pm
blob: f0a54f4d1c4b55ffa155804b6f89f200cfdc7648 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
package mirror; # $Id: mirror.pm 269985 2010-06-09 22:02:57Z herton $

use diagnostics;
use strict;
use feature 'state';

use common;
use log;

my %land2tzs = (
	     N_("Australia") => [ 'Australia/Sydney' ],
	     N_("Austria") => [ 'Europe/Vienna', 'Europe/Brussels', 'Europe/Berlin' ],
	     N_("Belgium") => [ 'Europe/Brussels', 'Europe/Paris', 'Europe/Berlin' ],
	     N_("Brazil") => [ 'America/Sao_Paulo' ],
	     N_("Canada") => [ 'Canada/Atlantic', 'Canada/Eastern' ],
	     N_("Costa Rica") => [ 'America/Costa_Rica' ],
	     N_("Czech Republic") => [ 'Europe/Prague', 'Europe/Berlin' ],
	     N_("Denmark") => [ 'Europe/Copenhagen', 'Europe/Berlin' ],
	     N_("Estonia") => [ 'Europe/Tallinn', 'Europe/Helsinki' ],
	     N_("Finland") => [ 'Europe/Helsinki', 'Europe/Tallinn' ],
	     N_("France") => [ 'Europe/Paris', 'Europe/Brussels', 'Europe/Berlin' ],
	     N_("Germany") => [ 'Europe/Berlin', 'Europe/Prague' ],
	     N_("Greece") => [ 'Europe/Athens', 'Europe/Prague' ],
	     N_("Hungary") => [ 'Europe/Budapest' ],
	     N_("Ireland") => [ 'Europe/Dublin', 'Europe/London' ],
	     N_("Israel") => [ 'Asia/Tel_Aviv' ],
	     N_("Italy") => [ 'Europe/Rome', 'Europe/Brussels', 'Europe/Paris' ],
	     N_("Japan") => [ 'Asia/Tokyo', 'Asia/Seoul' ],
	     N_("Netherlands") => [ 'Europe/Amsterdam', 'Europe/Brussels', 'Europe/Berlin' ],
	     N_("New Zealand") => [ 'Pacific/Auckland' ],
	     N_("Norway") => [ 'Europe/Oslo', 'Europe/Stockholm' ],
	     N_("Poland") => [ 'Europe/Warsaw' ],
	     N_("Portugal") => [ 'Europe/Lisbon', 'Europe/Madrid' ],
	     N_("Russia") => [ 'Europe/Moscow', ],
	     N_("Slovakia") => [ 'Europe/Bratislava' ],
	     N_("South Africa") => [ 'Africa/Johannesburg' ],
	     N_("Spain") => [ 'Europe/Madrid', 'Europe/Lisbon' ],
	     N_("Sweden") => [ 'Europe/Stockholm', 'Europe/Oslo' ],
	     N_("Switzerland") => [ 'Europe/Zurich', 'Europe/Berlin', 'Europe/Brussels' ],
	     N_("Taiwan") => [ 'Asia/Taipei', 'Asia/Seoul' ],
	     N_("Thailand") => [ 'Asia/Bangkok', 'Asia/Seoul' ],
	     N_("United States") => [ 'America/New_York', 'Canada/Atlantic', 'Asia/Tokyo', 'Australia/Sydney', 'Europe/Paris' ],
	    );

sub mirror2text {
    my ($mirror) = @_;
    translate($mirror->{country})  . '|' . $mirror->{host} . ($mirror->{method} ? " ($mirror->{method})" : '');
}

my $downloader;
sub register_downloader {
    my ($func) = @_;
    $downloader = $func;
}

sub _mirrors_raw_install {
    my ($list) = @_;
    require install::http;
    my $f = install::http::getFile($list, "strict-certificate-check" => 1) or die "mirror list not found";
    local $SIG{ALRM} = sub { die "timeout" };
    alarm 60;
    log::l("using mirror list $list");
    my @lines;
    push @lines, $_ while <$f>;
    alarm 0;
    @lines;
}

sub _mirrors_raw_standalone {
    my ($list) = @_;
    my @lines;
    if (ref($downloader)) {
        @lines = $downloader->($list);
        @lines or die "mirror list not found";
    } else {
        die "Missing download callback";
    }
    @lines;
}

sub mirrors_raw {
    my ($product_id) = @_;

    #- contact the following URL to retrieve the list of mirrors.
    #- http://wiki.mageia.org/en/Product_id
    my $type = lc($product_id->{type}); $type =~ s/\s//g;
    #- FIXME! (blino) we use use https here
    my $list = "http://mirrors.mageia.org/api/$type.$product_id->{version}.$product_id->{arch}.list?product=$product_id->{product}";
    log::explanations("trying mirror list from $list");
    my @lines = $::isInstall ? _mirrors_raw_install($list) : _mirrors_raw_standalone($list);
    map { common::parse_LDAP_namespace_structure(chomp_($_)) } @lines;
}

sub list {
    my ($product_id, $type) = @_;

    our @mirrors_raw;
    if (!@mirrors_raw) {
        @mirrors_raw = eval { mirrors_raw($product_id) };
        if (my $err = $@) {
            log::explanations("failed to download mirror list");
            die $err;
        }
        @mirrors_raw or log::explanations("empty mirror list"), return;
    }

	my @mirrors = grep {
	    ($_->{method}, $_->{host}, $_->{dir}) = $_->{url} =~ m!^(ftp|http)://(.*?)(/.*)!;
	    $_->{method} && ($type eq 'all' || $_->{type} eq $type);
	} @mirrors_raw or log::explanations("no mirrors of type $type"), return;

    @mirrors && \@mirrors;
}

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 @l = @country ? @country : @zone;
    shift @l while !$l[0] && @l;
    
    my @possible = @l ? ((@{$l[0]}) x 2, @{$l[1] || []}) : @$mirrors;
    $possible[rand @possible];
}

1;