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
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
|
#!/usr/bin/perl
#- Copyright (C) 2000 MandrakeSoft (fpons@mandrakesoft.com)
#-
#- This program is free software; you can redistribute it and/or modify
#- it under the terms of the GNU General Public License as published by
#- the Free Software Foundation; either version 2, or (at your option)
#- any later version.
#-
#- This program is distributed in the hope that it will be useful,
#- but WITHOUT ANY WARRANTY; without even the implied warranty of
#- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
#- GNU General Public License for more details.
#-
#- You should have received a copy of the GNU General Public License
#- along with this program; if not, write to the Free Software
#- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
#- this program is based upon old urpmi.addmedia
#use strict qw(subs vars refs);
use urpm;
#- get I18N translation method.
import urpm _;
sub main {
my ($name, $url, $with, $relative_hdlist, %options);
my $mirrors = $ENV{URPMI_MIRRORS} || 'http://www.linux-mandrake.com/mirrorsfull.list';
# Translator: The URI types strings 'file:', 'ftp:', 'http:',
# Translator: and 'removable:' must not be translated!
# Translator: neither the ``with''.
# Translator: only what is between <brakets> can be translated.
my $usage = _("usage: urpmi.addmedia [options] <name> <url> [with <relative_path>]
where <url> is one of
file://<path>
ftp://<login>:<password>@<host>/<path> with <relative filename of hdlist>
ftp://<host>/<path> with <relative filename of hdlist>
http://<host>/<path> with <relative filename of hdlist>
removable://<path>
and [options] are from
") . _(" --help - print this help message.
") . _(" --wget - use wget to retrieve distant files.
") . _(" --curl - use curl to retrieve distant files.
") . _(" --proxy - use specified HTTP proxy, the port number is assumed
to be 1080 by default (format is <proxyhost[:port]>).
") . _(" --proxy-user - specify user and password to use for proxy
authentication (format is <user:password>).
") . _(" --update - create an update medium.
") . _(" --distrib - automatically create all media from an installation
medium.
") . _(" --distrib-XXX - automatically create a medium for XXX part of a
distribution, XXX may be main, contrib, updates or
anything else that has been configured ;-)
") . _(" --from - use specified url for list of mirrors, the default is
%s
", $mirrors) . _(" --version - use specified version, the default is version of
mandrake-release package installed.
") . _(" --arch - use specified architecture, the default is arch of
mandrake-release package installed.
") . _(" -c - clean headers cache directory.
") . _(" -h - try to find and use synthesis or hdlist
file.
") . _(" -f - force generation of hdlist files.
");
$options{force} = 0;
$options{noclean} = 1;
my $urpm = new urpm;
while ($_ = shift @_) {
/^--?c/ and $options{noclean} = 0, next;
/^--?h/ and $options{probe_with_hdlist} = 1, next;
/^--?f/ and ++$options{force}, next;
/^--wget/ and $urpm->{sync} = sub { my $options = shift @_;
if (ref $options) { $options->{prefer} = 'wget' }
else { $options = { dir => $options, prefer => 'wget' } }
urpm::sync_webfetch($options, @_) }, next;
/^--curl/ and $urpm->{sync} = \&urpm::sync_webfetch, next;
/^--proxy$/ and do {
my ($proxy, $port) = ($_ = shift @_) =~ m,^(?:http://)?([^:]+(:\d+)?)/*$, or
die _("bad proxy declaration on command line\n");
$proxy .= ":1080" unless $port;
$urpm->{proxy}{http_proxy} = $proxy;
next;
};
/^--proxy-user$/ and do {
($_ = shift @_) =~ /(.+):(.+)/, or
die _("bad proxy declaration on command line\n");
$urpm->{proxy}->{user} = $1;
$urpm->{proxy}->{pwd} = $2;
next;
};
/^--distrib$/ and $options{distrib} = undef, next;
/^--distrib-(.*)$/ and $options{distrib} = $1, next;
/^--from$/ and $options{mirrors_url} = shift @_, next;
/^--version$/ and $options{version} = shift @_, next;
/^--arch$/ and $options{arch} = shift @_, next;
/^--update$/ and $options{update} = 1, next;
/^-/ and die $usage . _("\nunknown options '%s'\n", $_);
($name, $url, $with, $relative_hdlist) = ($_, @_);
last;
}
#- allow not to give name immediately.
$url or ($url, $name) = ($name, '');
my ($type) = $url =~ m,^([^:]*)://, or $options{distrib} or die $usage;
$urpm->read_config;
if (exists $options{distrib}) {
if (defined $options{distrib}) {
#- extended distribution support, code is directly inlined here.
#- -h always set, updates should allow setting update flag.
$options{probe_with_hdlist} = 1;
$options{distrib} =~ /update/ and $options{update} = 1;
#- official site by default.
$options{from} ||= $mirrors;
#- get default value unless already provided.
unless ($options{version} && $options{arch}) {
my $db = URPM::DB::open;
$db->traverse_tag('name', [ qw(mandrake-release basesystem) ], sub {
my ($pkg) = @_;
$pkg->release =~ /0\./ and $options{version} ||= 'cooker';
$options{version} ||= $pkg->version;
$pkg->arch ne 'noarch' and $options{arch} ||= $pkg->arch;
});
}
#- sanity checks...
$options{distrib} eq 'updates' && $options{version} eq 'cooker' and
die _("cannot add updates of a cooker distribution\n");
#- get mirrors list file in urpmi cache.
my ($basename) = $options{from} =~ /^.*\/([^\/]+)\/*$/;
unlink "$urpm->{cachedir}/partial/$basename";
eval {
$urpm->{log}(_("retrieving mirrors at %s ...", $options{from}));
$urpm->{sync}({dir => "$urpm->{cachedir}/partial", quiet => 0, proxy => $urpm->{proxy}}, $options{from});
$urpm->{log}(_("...retrieving done"));
};
$@ and $urpm->{log}(_("...retrieving failed: %s", $@));
#- examine its contents and create all requested media, url is now a simple regex.
my $heading = quotemeta($options{version} eq 'cooker' ? 'cooker' : $options{distrib});
my $qarch = quotemeta($options{arch});
my $i = 1;
local *F;
open F, "$urpm->{cachedir}/partial/$basename";
while (<F>) {
chomp;
my ($burl, $relative_hdlist) = /^$heading$qarch:(.*?)(?:\s+with\+(.*))?$/ or next;
!$url || $burl =~ /$url/ or next;
$urpm->add_medium("$name$i",
$options{distrib} eq 'updates' ? "$burl/$options{version}/RPMS" :
$options{distrib} eq 'contrib' ? $burl."2" : $burl,
$options{distrib} eq 'contrib' ? '../base/hdlist2.cz' : $relative_hdlist,
update => $options{update});
++$i;
}
close F;
} else {
$with || $relative_hdlist and die _("%s\nno need to give <relative path of hdlist> with --distrib", $usage);
$urpm->add_distrib_media($name, $url, update => $options{update});
}
$urpm->update_media(%options);
if (my @unsynced_media = grep { $_->{modified} } @{$urpm->{media}}) {
print STDERR join("\n", map { _("unable to update medium \"%s\"\n", $_->{name}) } @unsynced_media);
#- remove quietly the failing media.
$urpm->{log} = sub {};
$urpm->remove_selected_media;
$urpm->update_media(%options);
}
} else {
$name or die $usage;
if ($with eq "with") {
$relative_hdlist or die _("%s\n<relative path of hdlist> missing\n", $usage);
} elsif ($type =~ /ftp|http/) {
$options{probe_with_hdlist} || $with eq "with" or die _("%s\n`with' missing for ftp media\n", $usage);
}
$urpm->add_medium($name, $url, $relative_hdlist, update => $options{update});
$urpm->update_media(%options);
#- check creation of media (during update has been successfull)
my ($medium) = grep { $_->{name} eq $name } @{$urpm->{media}};
$medium or die _("unable to create medium \"%s\"\n", $name);
if ($medium->{modified}) {
print STDERR _("unable to update medium \"%s\"\n", $name);
#- remove quietly the failing media.
$urpm->{log} = sub {};
$urpm->remove_selected_media;
$urpm->update_media(%options);
}
}
}
main(@ARGV);
|
