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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 6543 - (hide annotations) (download)
Sun Dec 2 13:04:18 2012 UTC (11 years, 4 months ago) by tv
File size: 16336 byte(s)
7.12
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 6543 our $VERSION = '7.12';
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:

  ViewVC Help
Powered by ViewVC 1.1.30