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
|
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 => _("Grece"),
no => _("Norway"),
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" ],
);
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");
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.
#- 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];
}
#sub dir { $mirrors{$_[0]}[1] . '/' . $::VERSION }
sub dir { $mirrors{$_[0]}[1] . '/' . '8.1' }
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;
#- 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, getFile("base/hdlist.cz", $mirror)) and
"Updates for Mandrake Linux 8.1", 1, getFile("base/hdlist.cz", $mirror)) 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.
$update_medium->{selected} = 1;
return $update_medium;
}
sub get {
my ($mirror, $dir, @files) = @_;
foreach (@files) {
log::l("crypto: downloading $_");
ftp($mirror)->get($_, "$dir/$_")
}
int @files;
}
|
