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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 7907 - (show annotations) (download)
Thu Apr 18 16:08:56 2013 UTC (7 years, 6 months ago) by tv
File size: 17608 byte(s)
7.24
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 qw(basename begins_with cat_ cat_utf8 dirname file2absolute_file member);
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.24';
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 B<options>: hashref of urpm options
83
84 several paths:
85
86 =over
87
88 B<config>: path of urpmi.cfg (/etc/urpmi/urpmi.cfg)
89
90 B<mediacfgdir>: path of mediacfg.d (/etc/urpmi/mediacfg.d)
91
92 B<skiplist>: path of skip.list (/etc/urpmi/skip.list),
93
94 B<instlist>: path of inst.list (/etc/urpmi/inst.list),
95
96 B<prefer_list>: path of prefer.list (/etc/urpmi/prefer.list),
97
98 B<prefer_vendor_list>: path of prefer.vendor.list (/etc/urpmi/prefer.vendor.list),
99
100 B<private_netrc>: path of netrc (/etc/urpmi/netrc),
101
102 B<statedir>: state directory (/var/lib/urpmi),
103
104 B<cachedir>: cache directory (/var/cache/urpmi),
105
106 B<root>: path of the rooted system (when using global urpmi config),
107
108 B<urpmi_root>: path of the rooted system (when both urpmi & rpmdb are chrooted)
109
110 =back
111
112 Several subs:
113
114 =over
115
116 B<fatal>: sub for relaying fatal errors (should popup in GUIes)
117
118 B<error>: sub for relaying other errors
119
120 B<log>: sub for relaying messages if --verbose
121
122 B<print>: sub for always displayed messages, enable to redirect output for eg: installer
123
124 B<info>: sub for messages displayed unless --quiet
125
126 =back
127
128 All C<URPM> methods are available on an urpm object.
129
130 =cut
131
132 sub new {
133 my ($class) = @_;
134 my $self;
135 $self = bless {
136 # from URPM
137 depslist => [],
138 provides => {},
139 obsoletes => {},
140
141 media => undef,
142 options => {},
143
144 fatal => sub { printf STDERR "%s\n", $_[1]; exit($_[0]) },
145 error => sub { printf STDERR "%s\n", $_[0] },
146 info => sub { printf "%s\n", $_[0] }, #- displayed unless --quiet
147 log => sub { printf "%s\n", $_[0] }, #- displayed if --verbose
148 print => sub { printf "%s\n", $_[0] }, #- always displayed, enable to redirect output for eg: installer
149 }, $class;
150
151 set_files($self, '');
152 $self->set_nofatal(1);
153 $self;
154 }
155
156 =item urpm->new_parse_cmdline()
157
158 Like urpm->new but also parse the command line and parse the configuration file.
159
160 =cut
161
162 sub new_parse_cmdline {
163 my ($class) = @_;
164 my $urpm = $class->new;
165 urpm::args::parse_cmdline(urpm => $urpm);
166 get_global_options($urpm);
167 $urpm;
168 }
169
170 sub _add2hash { my ($a, $b) = @_; while (my ($k, $v) = each %{$b || {}}) { defined $a->{$k} or $a->{$k} = $v } $a }
171
172 sub get_global_options {
173 my ($urpm) = @_;
174
175 my $config = urpm::cfg::load_config($urpm->{config})
176 or $urpm->{fatal}(6, $urpm::cfg::err);
177
178 if (my $global = $config->{global}) {
179 _add2hash($urpm->{options}, $global);
180 }
181 #- remember global options for write_config
182 $urpm->{global_config} = $config->{global};
183
184 _add2hash($urpm->{options}, default_options());
185 }
186
187 sub prefer_rooted {
188 my ($root, $file) = @_;
189 -e "$root$file" ? "$root$file" : $file;
190 }
191
192 sub check_dir {
193 my ($urpm, $dir) = @_;
194 -d $dir && ! -l $dir or $urpm->{fatal}(1, N("fail to create directory %s", $dir));
195 -o $dir && -w $dir or $urpm->{fatal}(1, N("invalid owner for directory %s", $dir));
196 }
197
198 sub init_dir {
199 my ($urpm, $dir) = @_;
200
201 mkdir $dir, 0755; # try to create it
202
203 check_dir($urpm, $dir);
204
205 mkdir "$dir/partial";
206 mkdir "$dir/rpms";
207
208 $dir;
209 }
210
211 sub userdir_prefix {
212 my ($_urpm) = @_;
213 '/tmp/.urpmi-';
214 }
215
216 sub valid_statedir {
217 my ($urpm) = @_;
218 $< or return;
219
220 my $dir = ($urpm->{urpmi_root} || '') . userdir_prefix($urpm) . $< . "/lib";
221 init_dir($urpm, $dir);
222 }
223
224 sub userdir {
225 #mdkonline uses userdir because it runs as user
226 my ($urpm) = @_;
227 $< or return;
228
229 my $dir = ($urpm->{urpmi_root} || '') . userdir_prefix($urpm) . $<;
230 init_dir($urpm, $dir);
231 }
232
233 sub ensure_valid_cachedir {
234 my ($urpm) = @_;
235 if (my $dir = userdir($urpm)) {
236 $urpm->{cachedir} = $dir;
237 }
238 -w "$urpm->{cachedir}/partial" or $urpm->{fatal}(1, N("Can not download packages into %s", "$urpm->{cachedir}/partial"));
239 }
240
241 sub valid_cachedir {
242 my ($urpm) = @_;
243 userdir($urpm) || $urpm->{cachedir};
244 }
245
246 sub is_temporary_file {
247 my ($urpm, $f) = @_;
248
249 begins_with($f, $urpm->{cachedir});
250 }
251
252 sub set_env {
253 my ($urpm, $env) = @_;
254 -d $env or $urpm->{fatal}(8, N("Environment directory %s does not exist", $env));
255 print N("using specific environment on %s\n", $env);
256 #- setting new environment.
257 $urpm->{config} = "$env/urpmi.cfg";
258 if (cat_($urpm->{config}) =~ /^\s*virtual\s*$/m) {
259 print "dropping virtual from $urpm->{config}\n";
260 system(q(perl -pi -e 's/^\s*virtual\s*$//' ) . $urpm->{config});
261 }
262 $urpm->{mediacfgdir} = "$env/mediacfg.d";
263 $urpm->{skiplist} = "$env/skip.list";
264 $urpm->{instlist} = "$env/inst.list";
265 $urpm->{prefer_list} = "$env/prefer.list";
266 $urpm->{prefer_vendor_list} = "$env/prefer.vendor.list";
267 $urpm->{statedir} = $env;
268 $urpm->{env_rpmdb} = "$env/rpmdb.cz";
269 $urpm->{env_dir} = $env;
270 }
271
272 sub set_files {
273 my ($urpm, $urpmi_root) = @_;
274
275 $urpmi_root and $urpmi_root = file2absolute_file($urpmi_root);
276
277 my %h = (
278 config => "$urpmi_root/etc/urpmi/urpmi.cfg",
279 mediacfgdir => "$urpmi_root/etc/urpmi/mediacfg.d",
280 skiplist => prefer_rooted($urpmi_root, '/etc/urpmi/skip.list'),
281 instlist => prefer_rooted($urpmi_root, '/etc/urpmi/inst.list'),
282 prefer_list => prefer_rooted($urpmi_root, '/etc/urpmi/prefer.list'),
283 prefer_vendor_list =>
284 prefer_rooted($urpmi_root, '/etc/urpmi/prefer.vendor.list'),
285 private_netrc => "$urpmi_root/etc/urpmi/netrc",
286 statedir => "$urpmi_root/var/lib/urpmi",
287 cachedir => "$urpmi_root/var/cache/urpmi",
288 root => $urpmi_root,
289 $urpmi_root ? (urpmi_root => $urpmi_root) : @{[]},
290 );
291 $urpm->{$_} = $h{$_} foreach keys %h;
292
293 create_var_lib_rpm($urpm, %h);
294
295 # policy is too use chroot environment only for --urpmi-root, not for --root:
296 if ($urpmi_root && -e "$urpmi_root/etc/rpm/macros") {
297 URPM::loadmacrosfile("$urpmi_root/etc/rpm/macros");
298 }
299 }
300
301 sub create_var_lib_rpm {
302 my ($urpm, %h) = @_;
303 require File::Path;
304 File::Path::mkpath([ $h{statedir},
305 (map { "$h{cachedir}/$_" } qw(partial rpms)),
306 dirname($h{config}),
307 "$urpm->{root}/var/lib/rpm",
308 "$urpm->{root}/var/tmp",
309 ]);
310 }
311
312 sub modify_rpm_macro {
313 my ($name, $to_remove, $to_add) = @_;
314
315 my $val = URPM::expand('%' . $name);
316 $val =~ s/$to_remove/$to_add/ or $val = join(' ', grep { $_ } $val, $to_add);
317 URPM::add_macro("$name $val");
318 }
319
320 sub set_tune_rpm {
321 my ($urpm, $para) = @_;
322
323 my %h = map { $_ => 1 } map {
324 if ($_ eq 'all') {
325 ('nofsync', 'private');
326 } else {
327 $_;
328 }
329 } split(',', $para);
330
331 $urpm->{tune_rpm} = \%h;
332 }
333
334 sub tune_rpm {
335 my ($urpm) = @_;
336
337 if ($urpm->{tune_rpm}{nofsync}) {
338 modify_rpm_macro('__dbi_other', 'fsync', 'nofsync');
339 }
340 if ($urpm->{tune_rpm}{private}) {
341 urpm::sys::clean_rpmdb_shared_regions($urpm->{root});
342 modify_rpm_macro('__dbi_other', 'usedbenv', 'private');
343 }
344 }
345
346 sub _blist_pkg_to_urls {
347 my ($blist, @pkgs) = @_;
348 my $base_url = $blist->{medium}{url} . '/';
349 map { $base_url . $_->filename } @pkgs;
350 }
351 sub blist_pkg_to_url {
352 my ($blist, $pkg) = @_;
353 my ($url) = _blist_pkg_to_urls($blist, $pkg);
354 $url;
355 }
356 sub blist_to_urls {
357 my ($blist) = @_;
358 _blist_pkg_to_urls($blist, values %{$blist->{pkgs}});
359 }
360 sub blist_to_filenames {
361 my ($blist) = @_;
362 map { $_->filename } values %{$blist->{pkgs}};
363 }
364
365 sub protocol_from_url {
366 my ($url) = @_;
367 $url =~ m!^(\w+)(_[^:]*)?:! && $1;
368 }
369 sub file_from_local_url {
370 my ($url) = @_;
371 $url =~ m!^(?:removable[^:]*:/|file:/)?(/.*)! && $1;
372 }
373 sub file_from_local_medium {
374 my ($medium, $o_url) = @_;
375 my $url = $o_url || $medium->{url};
376 if ($url =~ m!^cdrom://(.*)!) {
377 my $rel = $1;
378 $medium->{mntpoint} or do { require Carp; Carp::confess("cdrom is not mounted yet!\n") };
379 "$medium->{mntpoint}/$rel";
380 } else {
381 file_from_local_url($url);
382 }
383 }
384 sub is_local_url {
385 my ($url) = @_;
386 file_from_local_url($url) || is_cdrom_url($url);
387 }
388 sub is_local_medium {
389 my ($medium) = @_;
390 is_local_url($medium->{url});
391 }
392 sub is_cdrom_url {
393 my ($url) = @_;
394 protocol_from_url($url) eq 'cdrom';
395 }
396
397 =item db_open_or_die($urpm, $b_write_perm)
398
399 Open RPM database (RW or not) and die if it fails
400
401 =cut
402
403 sub db_open_or_die_ {
404 my ($urpm, $b_write_perm) = @_;
405 my $db;
406 if ($urpm->{env_rpmdb}) {
407 #- URPM has same methods as URPM::DB and empty URPM will be seen as empty URPM::DB.
408 $db = URPM->new;
409 $db->parse_synthesis($urpm->{env_rpmdb});
410 } else {
411 $db = db_open_or_die($urpm, $urpm->{root}, $b_write_perm);
412 }
413 $db;
414 }
415
416 # please use higher level function db_open_or_die_()
417 sub db_open_or_die {
418 my ($urpm, $root, $b_write_perm) = @_;
419
420 $urpm->{debug} and $urpm->{debug}("opening rpmdb (root=$root, write=$b_write_perm)");
421
422 my $db = URPM::DB::open($root, $b_write_perm || 0)
423 or $urpm->{fatal}(9, N("unable to open rpmdb"));
424
425 $db;
426 }
427
428 =item register_rpms($urpm, @files)
429
430 Register local packages for being installed, keep track of source.
431
432 =cut
433
434 sub register_rpms {
435 my ($urpm, @files) = @_;
436 my ($start, $id, $error, %requested);
437
438 #- examine each rpm and build the depslist for them using current
439 #- depslist and provides environment.
440 $start = @{$urpm->{depslist}};
441 foreach (@files) {
442 /\.(?:rpm|spec)$/ or $error = 1, $urpm->{error}(N("invalid rpm file name [%s]", $_)), next;
443
444 #- if that's an URL, download.
445 if (protocol_from_url($_)) {
446 my $basename = basename($_);
447 unlink "$urpm->{cachedir}/partial/$basename";
448 $urpm->{log}(N("retrieving rpm file [%s] ...", $_));
449 if (urpm::download::sync_url($urpm, $_, quiet => 1)) {
450 $urpm->{log}(N("...retrieving done"));
451 $_ = "$urpm->{cachedir}/partial/$basename";
452 } else {
453 $urpm->{error}(N("...retrieving failed: %s", $@));
454 unlink "$urpm->{cachedir}/partial/$basename";
455 next;
456 }
457 } else {
458 -r $_ or $error = 1, $urpm->{error}(N("unable to access rpm file [%s]", $_)), next;
459 }
460
461 if (/\.spec$/) {
462 my $pkg = URPM::spec2srcheader($_)
463 or $error = 1, $urpm->{error}(N("unable to parse spec file %s [%s]", $_, $!)), next;
464 $id = @{$urpm->{depslist}};
465 $urpm->{depslist}[$id] = $pkg;
466 $pkg->set_id($id); #- sets internal id to the depslist id.
467 $urpm->{source}{$id} = $_;
468 } else {
469 ($id) = $urpm->parse_rpm($_);
470 my $pkg = defined $id && $urpm->{depslist}[$id];
471 $pkg or $error = 1, $urpm->{error}(N("unable to register rpm file")), next;
472 $pkg->arch eq 'src' || $pkg->is_arch_compat
473 or $error = 1, $urpm->{error}(N("Incompatible architecture for rpm [%s]", $_)), next;
474 $urpm->{source}{$id} = $_;
475 }
476 }
477 $error and $urpm->{fatal}(2, N("error registering local packages"));
478 defined $id && $start <= $id and @requested{($start .. $id)} = (1) x ($id-$start+1);
479
480 #- distribute local packages to distant nodes directly in cache of each machine.
481 if (@files && $urpm->{parallel_handler}) {
482 $urpm->{parallel_handler}->parallel_register_rpms($urpm, @files);
483 }
484
485 %requested;
486 }
487
488 =item is_delta_installable($urpm, $pkg, $root)
489
490 checks whether the delta RPM represented by $pkg is installable wrt the
491 RPM DB on $root. For this, it extracts the rpm version to which the
492 delta applies from the delta rpm filename itself. So naming conventions
493 do matter :)
494
495 =cut
496
497 sub is_delta_installable {
498 my ($urpm, $pkg, $root) = @_;
499 $pkg->flag_installed or return 0;
500 my $f = $pkg->filename;
501 my $n = $pkg->name;
502 my ($v_match) = $f =~ /^\Q$n\E-(.*)_.+\.delta\.rpm$/;
503 my $db = db_open_or_die($urpm, $root);
504 my $v_installed;
505 $db->traverse(sub {
506 my ($p) = @_;
507 $p->name eq $n and $v_installed = $p->version . '-' . $p->release;
508 });
509 $v_match eq $v_installed;
510 }
511
512
513 =item extract_packages_to_install($urpm, $sources)
514
515 Extract package that should be installed instead of upgraded,
516 installing instead of upgrading is useful
517 - for inst.list (cf flag disable_obsolete)
518
519 Sources is a hash of id -> source rpm filename.
520
521 =cut
522
523 sub extract_packages_to_install {
524 my ($urpm, $sources) = @_;
525 my %inst;
526
527 foreach (keys %$sources) {
528 my $pkg = $urpm->{depslist}[$_] or next;
529 $pkg->flag_disable_obsolete
530 and $inst{$pkg->id} = delete $sources->{$pkg->id};
531 }
532
533 \%inst;
534 }
535
536 #- deprecated, use find_candidate_packages_() directly
537 #-
538 #- side-effects: none
539 sub find_candidate_packages_ {
540 my ($urpm, $id_prop) = @_;
541
542 my %packages;
543 foreach ($urpm->find_candidate_packages($id_prop)) {
544 push @{$packages{$_->name}}, $_;
545 }
546 values %packages;
547 }
548
549 =item get_updates_description($urpm, @update_medias)
550
551 Get reason of update for packages to be updated.
552 Use all update medias if none given.
553
554 =cut
555
556 sub get_updates_description {
557 my ($urpm, @update_medias) = @_;
558 my %update_descr;
559 my ($cur, $section);
560
561 @update_medias or @update_medias = urpm::media::non_ignored_media($urpm, 'update');
562
563 foreach my $medium (@update_medias) {
564 # fix not taking into account the last %package token of each descrptions file: '%package dummy'
565 foreach (cat_utf8(urpm::media::statedir_descriptions($urpm, $medium)),
566 ($::env ? cat_utf8("$::env/descriptions") : ()), '%package dummy') {
567 /^%package +(.+)/ and do {
568 # fixes not parsing descriptions file when MU adds itself the security source:
569 if (exists $cur->{importance} && !member($cur->{importance}, qw(security bugfix))) {
570 $cur->{importance} = 'normal';
571 }
572 $update_descr{$medium->{name}}{$_} = $cur foreach @{$cur->{pkgs} || []};
573 $cur = { pkgs => [ split /\s/, $1 ] };
574 $section = 'pkg';
575 next;
576 };
577 /^Updated?: +(.+)/ && $section eq 'pkg' and do { $cur->{updated} = $1; next };
578 /^Importance: +(.+)/ && $section eq 'pkg' and do { $cur->{importance} = $1; next };
579 /^(ID|URL): +(.+)/ && $section eq 'pkg' and do { $cur->{$1} = $2; next };
580 /^%(pre|description)/ and do { $section = $1; next };
581 $section =~ /^(pre|description)\z/ and $cur->{$1} .= $_;
582 }
583 }
584 \%update_descr;
585 }
586
587 sub error_restricted ($) {
588 my ($urpm) = @_;
589 $urpm->{fatal}(2, N("This operation is forbidden while running in restricted mode"));
590 }
591
592 sub DESTROY {}
593
594 1;
595
596 __END__
597
598 =back
599
600 =head1 SEE ALSO
601
602 The L<URPM> package is used to manipulate at a lower level synthesis and rpm
603 files.
604
605 See also submodules: L<gurpmi>, L<urpm::args>, L<urpm::bug_report>,
606 L<urpm::cdrom>, L<urpm::cfg>, L<urpm::download>, L<urpm::get_pkgs>,
607 L<urpm::install>, L<urpm::ldap>, L<urpm::lock>, L<urpm::main_loop>,
608 L<urpm::md5sum>, L<urpm::media>, L<urpm::mirrors>, L<urpm::msg>,
609 L<urpm::orphans>, L<urpm::parallel_ka_run>, L<urpm::parallel>,
610 L<urpm::parallel_ssh>, L<urpm::prompt>, L<urpm::removable>,
611 L<urpm::select>, L<urpm::signature>, L<urpm::sys>, L<urpm::util>,
612 L<urpm::xml_info_pkg>, L<urpm::xml_info>
613
614 =head1 COPYRIGHT
615
616 Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005 MandrakeSoft SA
617
618 Copyright (C) 2005-2010 Mandriva SA
619
620 Copyright (C) 2011-2013 Mageia SA
621
622 This program is free software; you can redistribute it and/or modify
623 it under the terms of the GNU General Public License as published by
624 the Free Software Foundation; either version 2, or (at your option)
625 any later version.
626
627 This program is distributed in the hope that it will be useful,
628 but WITHOUT ANY WARRANTY; without even the implied warranty of
629 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
630 GNU General Public License for more details.
631
632 You should have received a copy of the GNU General Public License
633 along with this program; if not, write to the Free Software
634 Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
635
636 =cut
637
638 # ex: set ts=8 sts=4 sw=4 noet:

  ViewVC Help
Powered by ViewVC 1.1.28