/[soft]/rpm/urpmi/trunk/urpm.pm
ViewVC logotype

Contents of /rpm/urpmi/trunk/urpm.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 7282 - (show annotations) (download)
Tue Feb 5 14:31:13 2013 UTC (11 years, 1 month ago) by tv
File size: 16336 byte(s)
bump copyright
1 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 # perl_checker: require urpm::args
15 # perl_checker: require urpm::media
16 # perl_checker: require urpm::parallel
17
18 our $VERSION = '7.16';
19 our @ISA = qw(URPM Exporter);
20 our @EXPORT_OK = ('file_from_local_url', 'file_from_local_medium', 'is_local_medium');
21
22 # 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 use URPM;
27 use URPM::Resolve;
28
29
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 #- 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 =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 All C<URPM> methods are available on an urpm object.
83
84 =cut
85
86 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 sub check_dir {
141 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 sub init_dir {
147 my ($urpm, $dir) = @_;
148
149 mkdir $dir, 0755; # try to create it
150
151 check_dir($urpm, $dir);
152
153 mkdir "$dir/partial";
154 mkdir "$dir/rpms";
155
156 $dir;
157 }
158
159 sub userdir_prefix {
160 my ($_urpm) = @_;
161 '/tmp/.urpmi-';
162 }
163
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 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 init_dir($urpm, $dir);
179 }
180
181 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
189 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 $urpmi_root ? (urpmi_root => $urpmi_root) : @{[]},
238 );
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 =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 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 $db = URPM->new;
357 $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 =item register_rpms($urpm, @files)
377
378 Register local packages for being installed, keep track of source.
379
380 =cut
381
382 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 =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 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
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 sub extract_packages_to_install {
472 my ($urpm, $sources) = @_;
473 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 #- 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 =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 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 The L<URPM> package is used to manipulate at a lower level synthesis and rpm
551 files.
552
553 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 =head1 COPYRIGHT
563
564 Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005 MandrakeSoft SA
565
566 Copyright (C) 2005-2010 Mandriva SA
567
568 Copyright (C) 2011-2013 Mageia SA
569
570 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:

  ViewVC Help
Powered by ViewVC 1.1.30