/[soft]/rpm/urpmi/branches/2/urpm.pm
ViewVC logotype

Annotation of /rpm/urpmi/branches/2/urpm.pm

Parent Directory Parent Directory | Revision Log Revision Log


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

  ViewVC Help
Powered by ViewVC 1.1.30