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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 8338 - (show annotations) (download)
Sun May 19 14:55:59 2013 UTC (7 years ago) by colin
File size: 15115 byte(s)
6.48.5
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 = '6.48.5';
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 #- 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 $urpmi_root ? (urpmi_root => $urpmi_root) : @{[]},
186 );
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 $db = URPM->new;
299 $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.28