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
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
|
package crypto; # $Id$
use diagnostics;
use strict;
use vars qw(%url2land %land2tzs %static_mirrors %mirrors);
use MDK::Common::System;
use common;
use log;
use ftp;
%url2land = (
fr => N("France"),
cr => N("Costa Rica"),
be => N("Belgium"),
cz => N("Czech Republic"),
de => N("Germany"),
gr => N("Greece"),
no => N("Norway"),
se => N("Sweden"),
nl => N("Netherlands"),
it => N("Italy"),
at => N("Austria"),
);
%land2tzs = (
N("France") => [ 'Europe/Paris', 'Europe/Brussels', 'Europe/Berlin' ],
N("Belgium") => [ 'Europe/Brussels', 'Europe/Paris', 'Europe/Berlin' ],
N("Czech Republic") => [ 'Europe/Prague', 'Europe/Berlin' ],
N("Germany") => [ 'Europe/Berlin', 'Europe/Prague' ],
N("Greece") => [ 'Europe/Athens', 'Europe/Prague' ],
N("Norway") => [ 'Europe/Oslo', 'Europe/Stockholm' ],
N("Sweden") => [ 'Europe/Stockholm', 'Europe/Oslo' ],
N("United States") => [ 'America/New_York', 'Canada/Atlantic', 'Asia/Tokyo', 'Australia/Sydney', 'Europe/Paris' ],
N("Netherlands") => [ 'Europe/Amsterdam', 'Europe/Brussels', 'Europe/Berlin' ],
N("Italy") => [ 'Europe/Rome', 'Europe/Brussels', 'Europe/Paris' ],
N("Austria") => [ 'Europe/Vienna', 'Europe/Brussels', 'Europe/Berlin' ],
);
%static_mirrors = (
# "ackbar" => [ "Ackbar", "/updates", "a", "a" ],
);
%mirrors = ();
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 = N("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 = min(values %mirror2value);
my @possible = (grep { $mirror2value{$_} == $min_value } keys %mirror2value) x 2; #- increase probability
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 && $pkg->version || '9.1'; #- safe but dangerous ;-)
}
sub dir { $mirrors{$_[0]}[1] . ($::corporate && '/corporate' || '') . '/' . version() }
sub ftp($) { ftp::new($_[0], dir($_[0])) }
sub getFile {
my ($file, $o_host) = @_;
my $host = $o_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,
if_($mirrors{$host}[2], $mirrors{$host}[2]),
if_($mirrors{$host}[3], $mirrors{$host}[3])
);
$$retr->close if $$retr;
$$retr = $ftp->retr($file) or ftp::rewindGetFile();
$$retr ||= $ftp->retr($file);
}
sub getPackages {
my ($prefix, $packages, $mirror) = @_;
$crypto::host = $mirror;
#- get pubkey file first as we cannot handle 2 files opened simultaneously.
my $pubkey;
eval {
my $fpubkey = getFile("base/pubkey", $mirror);
$pubkey = [ $packages->parse_armored_file($fpubkey) ];
};
#- 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;
}
my $fpubkey = getFile("base/pubkey", $mirror);
#- 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, $pubkey);
if ($update_medium) {
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;
#- search for packages to update.
$packages->{rpmdb} ||= pkgs::rpmDbOpen($prefix);
pkgs::selectPackagesToUpgrade($packages, $prefix, $update_medium);
}
return $update_medium;
}
sub get {
my ($mirror, $dir, @files) = @_;
foreach (@files) {
log::l("crypto: downloading $_");
ftp($mirror)->get($_, "$dir/$_")
}
int @files;
}
1;
|
