1 |
dmorgan |
1928 |
package urpm; |
2 |
|
|
|
3 |
|
|
# $Id: urpm.pm 271301 2010-11-22 00:50:49Z eugeni $ |
4 |
|
|
|
5 |
|
|
no warnings 'utf8'; |
6 |
|
|
use strict; |
7 |
|
|
use File::Find (); |
8 |
|
|
use urpm::msg; |
9 |
|
|
use urpm::download; |
10 |
|
|
use urpm::util; |
11 |
|
|
use urpm::sys; |
12 |
|
|
use urpm::cfg; |
13 |
|
|
use urpm::md5sum; |
14 |
tv |
2877 |
# perl_checker: require urpm::args |
15 |
|
|
# perl_checker: require urpm::media |
16 |
|
|
# perl_checker: require urpm::parallel |
17 |
dmorgan |
1928 |
|
18 |
tv |
7268 |
our $VERSION = '7.16'; |
19 |
dmorgan |
1928 |
our @ISA = qw(URPM Exporter); |
20 |
|
|
our @EXPORT_OK = ('file_from_local_url', 'file_from_local_medium', 'is_local_medium'); |
21 |
|
|
|
22 |
tv |
3103 |
# Prepare exit code. If you change this, the exiting with a failure and the message given will be postponed to the end of the overall processing. |
23 |
|
|
our $postponed_msg = N("While some packages may have been installed, there were failures.\n"); |
24 |
|
|
our $postponed_code = 0; |
25 |
|
|
|
26 |
dmorgan |
1928 |
use URPM; |
27 |
|
|
use URPM::Resolve; |
28 |
|
|
|
29 |
tv |
6159 |
|
30 |
|
|
=head1 NAME |
31 |
|
|
|
32 |
|
|
urpm - Mageia perl tools to handle the urpmi database |
33 |
|
|
|
34 |
|
|
=head1 DESCRIPTION |
35 |
|
|
|
36 |
|
|
C<urpm> is used by urpmi executables to manipulate packages and media |
37 |
|
|
on a Mageia Linux distribution. |
38 |
|
|
|
39 |
|
|
=head2 The urpm class |
40 |
|
|
|
41 |
|
|
=over 4 |
42 |
|
|
|
43 |
|
|
=cut |
44 |
|
|
|
45 |
dmorgan |
1928 |
#- this violently overrides is_arch_compat() to always return true. |
46 |
|
|
sub shunt_ignorearch { |
47 |
|
|
eval q( sub URPM::Package::is_arch_compat { 1 } ); |
48 |
|
|
} |
49 |
|
|
|
50 |
|
|
sub xml_info_policies() { qw(never on-demand update-only always) } |
51 |
|
|
|
52 |
|
|
sub default_options { |
53 |
|
|
{ |
54 |
|
|
'split-level' => 1, |
55 |
|
|
'split-length' => 8, |
56 |
|
|
'verify-rpm' => 1, |
57 |
|
|
'post-clean' => 1, |
58 |
|
|
'xml-info' => 'on-demand', |
59 |
|
|
'max-round-robin-tries' => 5, |
60 |
|
|
'max-round-robin-probes' => 2, |
61 |
|
|
'days-between-mirrorlist-update' => 5, |
62 |
|
|
'nb-of-new-unrequested-pkgs-between-auto-select-orphans-check' => 10, |
63 |
|
|
}; |
64 |
|
|
} |
65 |
|
|
|
66 |
tv |
6159 |
=item urpm->new() |
67 |
|
|
|
68 |
|
|
The constructor creates a new urpm object. It's a blessed hash that |
69 |
|
|
contains fields from L<URPM>, and also the following fields: |
70 |
|
|
|
71 |
|
|
B<source>: { id => src_rpm_file|spec_file } |
72 |
|
|
|
73 |
|
|
B<media>: [ { |
74 |
|
|
start => int, end => int, name => string, url => string, |
75 |
|
|
virtual => bool, media_info_dir => string, with_synthesis => string, |
76 |
|
|
no-media-info => bool, |
77 |
|
|
iso => string, downloader => string, |
78 |
|
|
ignore => bool, update => bool, modified => bool, really_modified => bool, |
79 |
|
|
unknown_media_info => bool, |
80 |
|
|
} ], |
81 |
|
|
|
82 |
tv |
6161 |
All C<URPM> methods are available on an urpm object. |
83 |
|
|
|
84 |
tv |
6159 |
=cut |
85 |
|
|
|
86 |
dmorgan |
1928 |
sub new { |
87 |
|
|
my ($class) = @_; |
88 |
|
|
my $self; |
89 |
|
|
$self = bless { |
90 |
|
|
# from URPM |
91 |
|
|
depslist => [], |
92 |
|
|
provides => {}, |
93 |
|
|
obsoletes => {}, |
94 |
|
|
|
95 |
|
|
media => undef, |
96 |
|
|
options => {}, |
97 |
|
|
|
98 |
|
|
fatal => sub { printf STDERR "%s\n", $_[1]; exit($_[0]) }, |
99 |
|
|
error => sub { printf STDERR "%s\n", $_[0] }, |
100 |
|
|
info => sub { printf "%s\n", $_[0] }, #- displayed unless --quiet |
101 |
|
|
log => sub { printf "%s\n", $_[0] }, #- displayed if --verbose |
102 |
|
|
print => sub { printf "%s\n", $_[0] }, #- always displayed, enable to redirect output for eg: installer |
103 |
|
|
}, $class; |
104 |
|
|
|
105 |
|
|
set_files($self, ''); |
106 |
|
|
$self->set_nofatal(1); |
107 |
|
|
$self; |
108 |
|
|
} |
109 |
|
|
|
110 |
|
|
sub new_parse_cmdline { |
111 |
|
|
my ($class) = @_; |
112 |
|
|
my $urpm = $class->new; |
113 |
|
|
urpm::args::parse_cmdline(urpm => $urpm); |
114 |
|
|
get_global_options($urpm); |
115 |
|
|
$urpm; |
116 |
|
|
} |
117 |
|
|
|
118 |
|
|
sub _add2hash { my ($a, $b) = @_; while (my ($k, $v) = each %{$b || {}}) { defined $a->{$k} or $a->{$k} = $v } $a } |
119 |
|
|
|
120 |
|
|
sub get_global_options { |
121 |
|
|
my ($urpm) = @_; |
122 |
|
|
|
123 |
|
|
my $config = urpm::cfg::load_config($urpm->{config}) |
124 |
|
|
or $urpm->{fatal}(6, $urpm::cfg::err); |
125 |
|
|
|
126 |
|
|
if (my $global = $config->{global}) { |
127 |
|
|
_add2hash($urpm->{options}, $global); |
128 |
|
|
} |
129 |
|
|
#- remember global options for write_config |
130 |
|
|
$urpm->{global_config} = $config->{global}; |
131 |
|
|
|
132 |
|
|
_add2hash($urpm->{options}, default_options()); |
133 |
|
|
} |
134 |
|
|
|
135 |
|
|
sub prefer_rooted { |
136 |
|
|
my ($root, $file) = @_; |
137 |
|
|
-e "$root$file" ? "$root$file" : $file; |
138 |
|
|
} |
139 |
|
|
|
140 |
tv |
6191 |
sub check_dir { |
141 |
tv |
5737 |
my ($urpm, $dir) = @_; |
142 |
|
|
-d $dir && ! -l $dir or $urpm->{fatal}(1, N("fail to create directory %s", $dir)); |
143 |
|
|
-o $dir && -w $dir or $urpm->{fatal}(1, N("invalid owner for directory %s", $dir)); |
144 |
|
|
} |
145 |
|
|
|
146 |
tv |
6192 |
sub init_dir { |
147 |
dmorgan |
1928 |
my ($urpm, $dir) = @_; |
148 |
|
|
|
149 |
|
|
mkdir $dir, 0755; # try to create it |
150 |
|
|
|
151 |
tv |
6191 |
check_dir($urpm, $dir); |
152 |
dmorgan |
1928 |
|
153 |
|
|
mkdir "$dir/partial"; |
154 |
|
|
mkdir "$dir/rpms"; |
155 |
|
|
|
156 |
|
|
$dir; |
157 |
|
|
} |
158 |
tv |
6194 |
|
159 |
dmorgan |
1928 |
sub userdir_prefix { |
160 |
|
|
my ($_urpm) = @_; |
161 |
|
|
'/tmp/.urpmi-'; |
162 |
|
|
} |
163 |
tv |
6193 |
|
164 |
|
|
sub valid_statedir { |
165 |
|
|
my ($urpm) = @_; |
166 |
|
|
$< or return; |
167 |
|
|
|
168 |
|
|
my $dir = ($urpm->{urpmi_root} || '') . userdir_prefix($urpm) . $< . "/lib"; |
169 |
|
|
init_dir($urpm, $dir); |
170 |
|
|
} |
171 |
|
|
|
172 |
dmorgan |
1928 |
sub userdir { |
173 |
|
|
#mdkonline uses userdir because it runs as user |
174 |
|
|
my ($urpm) = @_; |
175 |
|
|
$< or return; |
176 |
|
|
|
177 |
|
|
my $dir = ($urpm->{urpmi_root} || '') . userdir_prefix($urpm) . $<; |
178 |
tv |
6192 |
init_dir($urpm, $dir); |
179 |
dmorgan |
1928 |
} |
180 |
tv |
6194 |
|
181 |
dmorgan |
1928 |
sub ensure_valid_cachedir { |
182 |
|
|
my ($urpm) = @_; |
183 |
|
|
if (my $dir = userdir($urpm)) { |
184 |
|
|
$urpm->{cachedir} = $dir; |
185 |
|
|
} |
186 |
|
|
-w "$urpm->{cachedir}/partial" or $urpm->{fatal}(1, N("Can not download packages into %s", "$urpm->{cachedir}/partial")); |
187 |
|
|
} |
188 |
tv |
6194 |
|
189 |
dmorgan |
1928 |
sub valid_cachedir { |
190 |
|
|
my ($urpm) = @_; |
191 |
|
|
userdir($urpm) || $urpm->{cachedir}; |
192 |
|
|
} |
193 |
|
|
|
194 |
|
|
sub is_temporary_file { |
195 |
|
|
my ($urpm, $f) = @_; |
196 |
|
|
|
197 |
|
|
begins_with($f, $urpm->{cachedir}); |
198 |
|
|
} |
199 |
|
|
|
200 |
|
|
sub set_env { |
201 |
|
|
my ($urpm, $env) = @_; |
202 |
|
|
-d $env or $urpm->{fatal}(8, N("Environment directory %s does not exist", $env)); |
203 |
|
|
print N("using specific environment on %s\n", $env); |
204 |
|
|
#- setting new environment. |
205 |
|
|
$urpm->{config} = "$env/urpmi.cfg"; |
206 |
|
|
if (cat_($urpm->{config}) =~ /^\s*virtual\s*$/m) { |
207 |
|
|
print "dropping virtual from $urpm->{config}\n"; |
208 |
|
|
system(q(perl -pi -e 's/^\s*virtual\s*$//' ) . $urpm->{config}); |
209 |
|
|
} |
210 |
|
|
$urpm->{mediacfgdir} = "$env/mediacfg.d"; |
211 |
|
|
$urpm->{skiplist} = "$env/skip.list"; |
212 |
|
|
$urpm->{instlist} = "$env/inst.list"; |
213 |
|
|
$urpm->{prefer_list} = "$env/prefer.list"; |
214 |
|
|
$urpm->{prefer_vendor_list} = "$env/prefer.vendor.list"; |
215 |
|
|
$urpm->{statedir} = $env; |
216 |
|
|
$urpm->{env_rpmdb} = "$env/rpmdb.cz"; |
217 |
|
|
$urpm->{env_dir} = $env; |
218 |
|
|
} |
219 |
|
|
|
220 |
|
|
sub set_files { |
221 |
|
|
my ($urpm, $urpmi_root) = @_; |
222 |
|
|
|
223 |
|
|
$urpmi_root and $urpmi_root = file2absolute_file($urpmi_root); |
224 |
|
|
|
225 |
|
|
my %h = ( |
226 |
|
|
config => "$urpmi_root/etc/urpmi/urpmi.cfg", |
227 |
|
|
mediacfgdir => "$urpmi_root/etc/urpmi/mediacfg.d", |
228 |
|
|
skiplist => prefer_rooted($urpmi_root, '/etc/urpmi/skip.list'), |
229 |
|
|
instlist => prefer_rooted($urpmi_root, '/etc/urpmi/inst.list'), |
230 |
|
|
prefer_list => prefer_rooted($urpmi_root, '/etc/urpmi/prefer.list'), |
231 |
|
|
prefer_vendor_list => |
232 |
|
|
prefer_rooted($urpmi_root, '/etc/urpmi/prefer.vendor.list'), |
233 |
|
|
private_netrc => "$urpmi_root/etc/urpmi/netrc", |
234 |
|
|
statedir => "$urpmi_root/var/lib/urpmi", |
235 |
|
|
cachedir => "$urpmi_root/var/cache/urpmi", |
236 |
|
|
root => $urpmi_root, |
237 |
tv |
3856 |
$urpmi_root ? (urpmi_root => $urpmi_root) : @{[]}, |
238 |
dmorgan |
1928 |
); |
239 |
|
|
$urpm->{$_} = $h{$_} foreach keys %h; |
240 |
|
|
|
241 |
|
|
create_var_lib_rpm($urpm, %h); |
242 |
|
|
|
243 |
|
|
# policy is too use chroot environment only for --urpmi-root, not for --root: |
244 |
|
|
if ($urpmi_root && -e "$urpmi_root/etc/rpm/macros") { |
245 |
|
|
URPM::loadmacrosfile("$urpmi_root/etc/rpm/macros"); |
246 |
|
|
} |
247 |
|
|
} |
248 |
|
|
|
249 |
|
|
sub create_var_lib_rpm { |
250 |
|
|
my ($urpm, %h) = @_; |
251 |
|
|
require File::Path; |
252 |
|
|
File::Path::mkpath([ $h{statedir}, |
253 |
|
|
(map { "$h{cachedir}/$_" } qw(partial rpms)), |
254 |
|
|
dirname($h{config}), |
255 |
|
|
"$urpm->{root}/var/lib/rpm", |
256 |
|
|
"$urpm->{root}/var/tmp", |
257 |
|
|
]); |
258 |
|
|
} |
259 |
|
|
|
260 |
|
|
sub modify_rpm_macro { |
261 |
|
|
my ($name, $to_remove, $to_add) = @_; |
262 |
|
|
|
263 |
|
|
my $val = URPM::expand('%' . $name); |
264 |
|
|
$val =~ s/$to_remove/$to_add/ or $val = join(' ', grep { $_ } $val, $to_add); |
265 |
|
|
URPM::add_macro("$name $val"); |
266 |
|
|
} |
267 |
|
|
|
268 |
|
|
sub set_tune_rpm { |
269 |
|
|
my ($urpm, $para) = @_; |
270 |
|
|
|
271 |
|
|
my %h = map { $_ => 1 } map { |
272 |
|
|
if ($_ eq 'all') { |
273 |
|
|
('nofsync', 'private'); |
274 |
|
|
} else { |
275 |
|
|
$_; |
276 |
|
|
} |
277 |
|
|
} split(',', $para); |
278 |
|
|
|
279 |
|
|
$urpm->{tune_rpm} = \%h; |
280 |
|
|
} |
281 |
|
|
|
282 |
|
|
sub tune_rpm { |
283 |
|
|
my ($urpm) = @_; |
284 |
|
|
|
285 |
|
|
if ($urpm->{tune_rpm}{nofsync}) { |
286 |
|
|
modify_rpm_macro('__dbi_other', 'fsync', 'nofsync'); |
287 |
|
|
} |
288 |
|
|
if ($urpm->{tune_rpm}{private}) { |
289 |
|
|
urpm::sys::clean_rpmdb_shared_regions($urpm->{root}); |
290 |
|
|
modify_rpm_macro('__dbi_other', 'usedbenv', 'private'); |
291 |
|
|
} |
292 |
|
|
} |
293 |
|
|
|
294 |
|
|
sub _blist_pkg_to_urls { |
295 |
|
|
my ($blist, @pkgs) = @_; |
296 |
|
|
my $base_url = $blist->{medium}{url} . '/'; |
297 |
|
|
map { $base_url . $_->filename } @pkgs; |
298 |
|
|
} |
299 |
|
|
sub blist_pkg_to_url { |
300 |
|
|
my ($blist, $pkg) = @_; |
301 |
|
|
my ($url) = _blist_pkg_to_urls($blist, $pkg); |
302 |
|
|
$url; |
303 |
|
|
} |
304 |
|
|
sub blist_to_urls { |
305 |
|
|
my ($blist) = @_; |
306 |
|
|
_blist_pkg_to_urls($blist, values %{$blist->{pkgs}}); |
307 |
|
|
} |
308 |
|
|
sub blist_to_filenames { |
309 |
|
|
my ($blist) = @_; |
310 |
|
|
map { $_->filename } values %{$blist->{pkgs}}; |
311 |
|
|
} |
312 |
|
|
|
313 |
|
|
sub protocol_from_url { |
314 |
|
|
my ($url) = @_; |
315 |
|
|
$url =~ m!^(\w+)(_[^:]*)?:! && $1; |
316 |
|
|
} |
317 |
|
|
sub file_from_local_url { |
318 |
|
|
my ($url) = @_; |
319 |
|
|
$url =~ m!^(?:removable[^:]*:/|file:/)?(/.*)! && $1; |
320 |
|
|
} |
321 |
|
|
sub file_from_local_medium { |
322 |
|
|
my ($medium, $o_url) = @_; |
323 |
|
|
my $url = $o_url || $medium->{url}; |
324 |
|
|
if ($url =~ m!^cdrom://(.*)!) { |
325 |
|
|
my $rel = $1; |
326 |
|
|
$medium->{mntpoint} or do { require Carp; Carp::confess("cdrom is not mounted yet!\n") }; |
327 |
|
|
"$medium->{mntpoint}/$rel"; |
328 |
|
|
} else { |
329 |
|
|
file_from_local_url($url); |
330 |
|
|
} |
331 |
|
|
} |
332 |
|
|
sub is_local_url { |
333 |
|
|
my ($url) = @_; |
334 |
|
|
file_from_local_url($url) || is_cdrom_url($url); |
335 |
|
|
} |
336 |
|
|
sub is_local_medium { |
337 |
|
|
my ($medium) = @_; |
338 |
|
|
is_local_url($medium->{url}); |
339 |
|
|
} |
340 |
|
|
sub is_cdrom_url { |
341 |
|
|
my ($url) = @_; |
342 |
|
|
protocol_from_url($url) eq 'cdrom'; |
343 |
|
|
} |
344 |
|
|
|
345 |
tv |
6162 |
=item db_open_or_die($urpm, $b_write_perm) |
346 |
|
|
|
347 |
|
|
Open RPM database (RW or not) and die if it fails |
348 |
|
|
|
349 |
|
|
=cut |
350 |
|
|
|
351 |
dmorgan |
1928 |
sub db_open_or_die_ { |
352 |
|
|
my ($urpm, $b_write_perm) = @_; |
353 |
|
|
my $db; |
354 |
|
|
if ($urpm->{env_rpmdb}) { |
355 |
|
|
#- URPM has same methods as URPM::DB and empty URPM will be seen as empty URPM::DB. |
356 |
tv |
3547 |
$db = URPM->new; |
357 |
dmorgan |
1928 |
$db->parse_synthesis($urpm->{env_rpmdb}); |
358 |
|
|
} else { |
359 |
|
|
$db = db_open_or_die($urpm, $urpm->{root}, $b_write_perm); |
360 |
|
|
} |
361 |
|
|
$db; |
362 |
|
|
} |
363 |
|
|
|
364 |
|
|
# please use higher level function db_open_or_die_() |
365 |
|
|
sub db_open_or_die { |
366 |
|
|
my ($urpm, $root, $b_write_perm) = @_; |
367 |
|
|
|
368 |
|
|
$urpm->{debug} and $urpm->{debug}("opening rpmdb (root=$root, write=$b_write_perm)"); |
369 |
|
|
|
370 |
|
|
my $db = URPM::DB::open($root, $b_write_perm || 0) |
371 |
|
|
or $urpm->{fatal}(9, N("unable to open rpmdb")); |
372 |
|
|
|
373 |
|
|
$db; |
374 |
|
|
} |
375 |
|
|
|
376 |
tv |
6160 |
=item register_rpms($urpm, @files) |
377 |
|
|
|
378 |
|
|
Register local packages for being installed, keep track of source. |
379 |
|
|
|
380 |
|
|
=cut |
381 |
|
|
|
382 |
dmorgan |
1928 |
sub register_rpms { |
383 |
|
|
my ($urpm, @files) = @_; |
384 |
|
|
my ($start, $id, $error, %requested); |
385 |
|
|
|
386 |
|
|
#- examine each rpm and build the depslist for them using current |
387 |
|
|
#- depslist and provides environment. |
388 |
|
|
$start = @{$urpm->{depslist}}; |
389 |
|
|
foreach (@files) { |
390 |
|
|
/\.(?:rpm|spec)$/ or $error = 1, $urpm->{error}(N("invalid rpm file name [%s]", $_)), next; |
391 |
|
|
|
392 |
|
|
#- if that's an URL, download. |
393 |
|
|
if (protocol_from_url($_)) { |
394 |
|
|
my $basename = basename($_); |
395 |
|
|
unlink "$urpm->{cachedir}/partial/$basename"; |
396 |
|
|
$urpm->{log}(N("retrieving rpm file [%s] ...", $_)); |
397 |
|
|
if (urpm::download::sync_url($urpm, $_, quiet => 1)) { |
398 |
|
|
$urpm->{log}(N("...retrieving done")); |
399 |
|
|
$_ = "$urpm->{cachedir}/partial/$basename"; |
400 |
|
|
} else { |
401 |
|
|
$urpm->{error}(N("...retrieving failed: %s", $@)); |
402 |
|
|
unlink "$urpm->{cachedir}/partial/$basename"; |
403 |
|
|
next; |
404 |
|
|
} |
405 |
|
|
} else { |
406 |
|
|
-r $_ or $error = 1, $urpm->{error}(N("unable to access rpm file [%s]", $_)), next; |
407 |
|
|
} |
408 |
|
|
|
409 |
|
|
if (/\.spec$/) { |
410 |
|
|
my $pkg = URPM::spec2srcheader($_) |
411 |
|
|
or $error = 1, $urpm->{error}(N("unable to parse spec file %s [%s]", $_, $!)), next; |
412 |
|
|
$id = @{$urpm->{depslist}}; |
413 |
|
|
$urpm->{depslist}[$id] = $pkg; |
414 |
|
|
$pkg->set_id($id); #- sets internal id to the depslist id. |
415 |
|
|
$urpm->{source}{$id} = $_; |
416 |
|
|
} else { |
417 |
|
|
($id) = $urpm->parse_rpm($_); |
418 |
|
|
my $pkg = defined $id && $urpm->{depslist}[$id]; |
419 |
|
|
$pkg or $error = 1, $urpm->{error}(N("unable to register rpm file")), next; |
420 |
|
|
$pkg->arch eq 'src' || $pkg->is_arch_compat |
421 |
|
|
or $error = 1, $urpm->{error}(N("Incompatible architecture for rpm [%s]", $_)), next; |
422 |
|
|
$urpm->{source}{$id} = $_; |
423 |
|
|
} |
424 |
|
|
} |
425 |
|
|
$error and $urpm->{fatal}(2, N("error registering local packages")); |
426 |
|
|
defined $id && $start <= $id and @requested{($start .. $id)} = (1) x ($id-$start+1); |
427 |
|
|
|
428 |
|
|
#- distribute local packages to distant nodes directly in cache of each machine. |
429 |
|
|
if (@files && $urpm->{parallel_handler}) { |
430 |
|
|
$urpm->{parallel_handler}->parallel_register_rpms($urpm, @files); |
431 |
|
|
} |
432 |
|
|
|
433 |
|
|
%requested; |
434 |
|
|
} |
435 |
|
|
|
436 |
tv |
6160 |
=item is_delta_installable($urpm, $pkg, $root) |
437 |
|
|
|
438 |
|
|
checks whether the delta RPM represented by $pkg is installable wrt the |
439 |
|
|
RPM DB on $root. For this, it extracts the rpm version to which the |
440 |
|
|
delta applies from the delta rpm filename itself. So naming conventions |
441 |
|
|
do matter :) |
442 |
|
|
|
443 |
|
|
=cut |
444 |
|
|
|
445 |
dmorgan |
1928 |
sub is_delta_installable { |
446 |
|
|
my ($urpm, $pkg, $root) = @_; |
447 |
|
|
$pkg->flag_installed or return 0; |
448 |
|
|
my $f = $pkg->filename; |
449 |
|
|
my $n = $pkg->name; |
450 |
|
|
my ($v_match) = $f =~ /^\Q$n\E-(.*)_.+\.delta\.rpm$/; |
451 |
|
|
my $db = db_open_or_die($urpm, $root); |
452 |
|
|
my $v_installed; |
453 |
|
|
$db->traverse(sub { |
454 |
|
|
my ($p) = @_; |
455 |
|
|
$p->name eq $n and $v_installed = $p->version . '-' . $p->release; |
456 |
|
|
}); |
457 |
|
|
$v_match eq $v_installed; |
458 |
|
|
} |
459 |
|
|
|
460 |
tv |
6160 |
|
461 |
|
|
=item extract_packages_to_install($urpm, $sources) |
462 |
|
|
|
463 |
|
|
Extract package that should be installed instead of upgraded, |
464 |
|
|
installing instead of upgrading is useful |
465 |
|
|
- for inst.list (cf flag disable_obsolete) |
466 |
|
|
|
467 |
|
|
Sources is a hash of id -> source rpm filename. |
468 |
|
|
|
469 |
|
|
=cut |
470 |
|
|
|
471 |
dmorgan |
1928 |
sub extract_packages_to_install { |
472 |
tv |
5481 |
my ($urpm, $sources) = @_; |
473 |
dmorgan |
1928 |
my %inst; |
474 |
|
|
|
475 |
|
|
foreach (keys %$sources) { |
476 |
|
|
my $pkg = $urpm->{depslist}[$_] or next; |
477 |
|
|
$pkg->flag_disable_obsolete |
478 |
|
|
and $inst{$pkg->id} = delete $sources->{$pkg->id}; |
479 |
|
|
} |
480 |
|
|
|
481 |
|
|
\%inst; |
482 |
|
|
} |
483 |
|
|
|
484 |
tv |
6156 |
#- deprecated, use find_candidate_packages_() directly |
485 |
|
|
#- |
486 |
|
|
#- side-effects: none |
487 |
|
|
sub find_candidate_packages_ { |
488 |
|
|
my ($urpm, $id_prop) = @_; |
489 |
|
|
|
490 |
|
|
my %packages; |
491 |
|
|
foreach ($urpm->find_candidate_packages($id_prop)) { |
492 |
|
|
push @{$packages{$_->name}}, $_; |
493 |
|
|
} |
494 |
|
|
values %packages; |
495 |
|
|
} |
496 |
|
|
|
497 |
tv |
6160 |
=item get_updates_description($urpm, @update_medias) |
498 |
|
|
|
499 |
|
|
Get reason of update for packages to be updated. |
500 |
|
|
Use all update medias if none given. |
501 |
|
|
|
502 |
|
|
=cut |
503 |
|
|
|
504 |
dmorgan |
1928 |
sub get_updates_description { |
505 |
|
|
my ($urpm, @update_medias) = @_; |
506 |
|
|
my %update_descr; |
507 |
|
|
my ($cur, $section); |
508 |
|
|
|
509 |
|
|
@update_medias or @update_medias = urpm::media::non_ignored_media($urpm, 'update'); |
510 |
|
|
|
511 |
|
|
foreach my $medium (@update_medias) { |
512 |
|
|
# fix not taking into account the last %package token of each descrptions file: '%package dummy' |
513 |
|
|
foreach (cat_utf8(urpm::media::statedir_descriptions($urpm, $medium)), |
514 |
|
|
($::env ? cat_utf8("$::env/descriptions") : ()), '%package dummy') { |
515 |
|
|
/^%package +(.+)/ and do { |
516 |
|
|
# fixes not parsing descriptions file when MU adds itself the security source: |
517 |
|
|
if (exists $cur->{importance} && !member($cur->{importance}, qw(security bugfix))) { |
518 |
|
|
$cur->{importance} = 'normal'; |
519 |
|
|
} |
520 |
|
|
$update_descr{$medium->{name}}{$_} = $cur foreach @{$cur->{pkgs} || []}; |
521 |
|
|
$cur = { pkgs => [ split /\s/, $1 ] }; |
522 |
|
|
$section = 'pkg'; |
523 |
|
|
next; |
524 |
|
|
}; |
525 |
|
|
/^Updated?: +(.+)/ && $section eq 'pkg' and do { $cur->{updated} = $1; next }; |
526 |
|
|
/^Importance: +(.+)/ && $section eq 'pkg' and do { $cur->{importance} = $1; next }; |
527 |
|
|
/^(ID|URL): +(.+)/ && $section eq 'pkg' and do { $cur->{$1} = $2; next }; |
528 |
|
|
/^%(pre|description)/ and do { $section = $1; next }; |
529 |
|
|
$section =~ /^(pre|description)\z/ and $cur->{$1} .= $_; |
530 |
|
|
} |
531 |
|
|
} |
532 |
|
|
\%update_descr; |
533 |
|
|
} |
534 |
|
|
|
535 |
|
|
sub error_restricted ($) { |
536 |
|
|
my ($urpm) = @_; |
537 |
|
|
$urpm->{fatal}(2, N("This operation is forbidden while running in restricted mode")); |
538 |
|
|
} |
539 |
|
|
|
540 |
|
|
sub DESTROY {} |
541 |
|
|
|
542 |
|
|
1; |
543 |
|
|
|
544 |
|
|
__END__ |
545 |
|
|
|
546 |
|
|
=back |
547 |
|
|
|
548 |
|
|
=head1 SEE ALSO |
549 |
|
|
|
550 |
tv |
6165 |
The L<URPM> package is used to manipulate at a lower level synthesis and rpm |
551 |
dmorgan |
1928 |
files. |
552 |
|
|
|
553 |
tv |
6164 |
See also submodules: L<urpm::args>, L<urpm::bug_report>, |
554 |
|
|
L<urpm::cdrom>, L<urpm::cfg>, L<urpm::download>, L<urpm::get_pkgs>, |
555 |
|
|
L<urpm::install>, L<urpm::ldap>, L<urpm::lock>, L<urpm::main_loop>, |
556 |
|
|
L<urpm::md5sum>, L<urpm::media>, L<urpm::mirrors>, L<urpm::msg>, |
557 |
|
|
L<urpm::orphans>, L<urpm::parallel_ka_run>, L<urpm::parallel>, |
558 |
|
|
L<urpm::parallel_ssh>, L<urpm::prompt>, L<urpm::removable>, |
559 |
|
|
L<urpm::select>, L<urpm::signature>, L<urpm::sys>, L<urpm::util>, |
560 |
|
|
L<urpm::xml_info_pkg>, L<urpm::xml_info> |
561 |
|
|
|
562 |
dmorgan |
1928 |
=head1 COPYRIGHT |
563 |
|
|
|
564 |
|
|
Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005 MandrakeSoft SA |
565 |
|
|
|
566 |
|
|
Copyright (C) 2005-2010 Mandriva SA |
567 |
|
|
|
568 |
tv |
6163 |
Copyright (C) 2011-2012 Mageia SA |
569 |
|
|
|
570 |
dmorgan |
1928 |
This program is free software; you can redistribute it and/or modify |
571 |
|
|
it under the terms of the GNU General Public License as published by |
572 |
|
|
the Free Software Foundation; either version 2, or (at your option) |
573 |
|
|
any later version. |
574 |
|
|
|
575 |
|
|
This program is distributed in the hope that it will be useful, |
576 |
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of |
577 |
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
578 |
|
|
GNU General Public License for more details. |
579 |
|
|
|
580 |
|
|
You should have received a copy of the GNU General Public License |
581 |
|
|
along with this program; if not, write to the Free Software |
582 |
|
|
Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. |
583 |
|
|
|
584 |
|
|
=cut |
585 |
|
|
|
586 |
|
|
# ex: set ts=8 sts=4 sw=4 noet: |