diff options
Diffstat (limited to 'perl-install/install/pkgs.pm')
| -rw-r--r-- | perl-install/install/pkgs.pm | 343 |
1 files changed, 259 insertions, 84 deletions
diff --git a/perl-install/install/pkgs.pm b/perl-install/install/pkgs.pm index 0f940939b..a9692e225 100644 --- a/perl-install/install/pkgs.pm +++ b/perl-install/install/pkgs.pm @@ -1,6 +1,7 @@ -package install::pkgs; # $Id$ +package install::pkgs; use strict; +use feature 'state'; BEGIN { # needed before "use URPM" @@ -26,7 +27,6 @@ use fs::any; use fs::loopback; use c; - #- lower bound on the left ( aka 90 means [90-100[ ) our %compssListDesc = ( 5 => N_("must have"), @@ -38,10 +38,11 @@ our %compssListDesc = ( #- TODO BEFORE TODO #- size and correction size functions for packages. -my $B = 1.20873; -my $C = 4.98663; #- does not take hdlist's into account as getAvailableSpace will do it. -sub correctSize { $B * $_[0] + $C } -sub invCorrectSize { ($_[0] - $C) / $B } +my $B = 120873; +my $C = 498663; #- does not take hdlist's into account as getAvailableSpace will do it. +my $D = 100000; +sub correctSize { ($B * $_[0] + $C) / $D } +sub invCorrectSize { ($_[0] * $D - $C) / $B } sub selectedSize { my ($packages) = @_; @@ -69,29 +70,78 @@ sub selectedSize { sub size2time { my ($x, $max) = @_; - my $A = 7e-07; + my $A = 7e9; my $limit = min($max * 3 / 4, 9e8); if ($x < $limit) { $A * $x; } else { $x -= $limit; - my $B = 6e-16; - my $C = 15e-07; + my $B = 6; + my $C = 15e9; $B * $x ** 2 + $C * $x + $A * $limit; } } -#- search package with given name and compatible with current architecture. +# Based on Rpmdrake::pkg::extract_header(): +sub get_pkg_info { + my ($p) = @_; + + my $urpm = $::o->{packages}; + my $name = $p->fullname; + + my $medium = URPM::pkg2media($urpm->{media}, $p); + my ($local_source, %xml_info_pkgs, $description); + my $dir = urpm::file_from_local_url($medium->{url}); + $local_source = "$dir/" . $p->filename if $dir; + + if (-s $local_source) { + log::l("getting information from $dir..."); + $p->update_header($local_source) and $description = $p->description; + log::l("Warning, could not extract header for $name from $medium!") if !$description; + } + if (!$description) { + my $_w = $::o->wait_message(undef, N("Getting package information from XML meta-data...")); + if (my $xml_info_file = eval { urpm::media::any_xml_info($urpm, $medium, 'info', undef, urpm::download::sync_logger) }) { + require urpm::xml_info; + require urpm::xml_info_pkg; + log::l("getting information from $xml_info_file"); + my %nodes = eval { urpm::xml_info::get_nodes('info', $xml_info_file, [ $name ]) }; + goto header_non_available if $@; + put_in_hash($xml_info_pkgs{$name} ||= {}, $nodes{$name}); + } else { + $urpm->{info}(N("No xml info for medium \"%s\", only partial result for package %s", $medium->{name}, $name)); + } + } + + if (!$description && $xml_info_pkgs{$name}) { + $description = $xml_info_pkgs{$name}{description}; + } + header_non_available: + $description || N("No description"); +} + +sub packagesProviding { + my ($packages, $name) = @_; + grep { $_->is_arch_compat } URPM::packages_providing($packages, $name); +} + +#- search package with given name (and optional ISA) and compatible with current architecture. #- take the best one found (most up-to-date). +# FIXME: reuse urpmi higher level code instead! sub packageByName { my ($packages, $name) = @_; - my @l = grep { $_->is_arch_compat && $_->name eq $name } URPM::packages_providing($packages, $name); + my $basename = $name =~ s/\(x86-..\)$//r; + my @l = sort { $b->id <=> $a->id } grep { $_->name eq $basename } packagesProviding($packages, $name); my $best; foreach (@l) { if ($best && $best != $_) { - $_->compare_pkg($best) > 0 and $best = $_; + if ($best->fullname eq $_->fullname) { + $best = $_ if $_->flag_installed; + } else { + $_->compare_pkg($best) > 0 and $best = $_; + } } else { $best = $_; } @@ -100,13 +150,17 @@ sub packageByName { $best; } +sub _is_kernelServer_needed() { + # forbid selecting kernel-server if not having PAE since PAE support is mandatory for kernel-server: + return if !detect_devices::has_cpu_flag('pae'); + arch() =~ /i.86/ && detect_devices::isServer(); +} + sub _bestKernel_extensions { my ($o_match_all_hardware) = @_; - $o_match_all_hardware ? (arch() =~ /i.86/ ? '-desktop586' : '-desktop') : - detect_devices::is_xbox() ? '-xbox' : - detect_devices::is_i586() ? '-desktop586' : - arch() =~ /i.86/ && detect_devices::dmi_detect_memory() > 3.8 * 1024 || detect_devices::isServer() ? '-server' : + $::o->{kernel_extension} ? $::o->{kernel_extension} : + _is_kernelServer_needed() ? '-server' : '-desktop'; } @@ -116,6 +170,12 @@ sub bestKernelPackage { my @preferred_exts = _bestKernel_extensions($o_match_all_hardware); my @kernels = grep { $_ } map { packageByName($packages, "kernel$_-latest") } @preferred_exts; + if (!@kernels) { + #- fallback on most generic kernel if the suitable one is not available + my @fallback_exts = _bestKernel_extensions('force'); + @kernels = grep { $_ } map { packageByName($packages, "kernel$_-latest") } @fallback_exts; + } + log::l("bestKernelPackage (" . join(':', @preferred_exts) . "): " . join(' ', map { $_->name } @kernels) . (@kernels > 1 ? ' (choosing the first)' : '')); $kernels[0]; @@ -129,7 +189,8 @@ sub packagesToInstall { log::l("examining packagesToInstall of medium $_->{name}"); push @packages, grep { $_->flag_selected } install::media::packagesOfMedium($packages, $_); } - log::l("found " . scalar(@packages) . " packages to install"); + log::l("found " . scalar(@packages) . " packages to install: " . formatList(5, map { scalar $_->fullname } @packages)); + @packages; } @@ -142,7 +203,8 @@ sub _packageRequest { #- check for medium selection, if the medium has not been #- selected, the package cannot be selected. - !packageMedium($packages, $pkg)->{ignore} or return; + my $medium = packageMedium($packages, $pkg); + $medium && !$medium->{ignore} or return; +{ $pkg->id => 1 }; } @@ -163,7 +225,7 @@ sub packageCallbackChoices { sub _packageCallbackChoices_ { my ($urpm, $choices, $virtual_pkg_name) = @_; - my ($prefer, $_other) = urpm::select::get_preferred($urpm, $choices, ''); + my ($prefer, $_other) = urpm::select::get_preferred($urpm, $choices, $::o->{preferred_packages}); if (@$prefer) { @$prefer; } elsif ($virtual_pkg_name eq 'kernel') { @@ -226,15 +288,22 @@ sub select_by_package_names_or_die { } } +my @recommended_package_ids; sub _resolve_requested_and_check { my ($packages, $state, $requested) = @_; my @l = $packages->resolve_requested($packages->{rpmdb}, $state, $requested, - callback_choices => \&packageCallbackChoices); + callback_choices => \&packageCallbackChoices, no_recommends => $::o->{no_recommends}); + + #- keep track of recommended packages so that theys could be unselected if the "no recommends" option is choosen later: + if (!is_empty_hash_ref($state->{selected})) { + my @new_ids = map { $packages->{depslist}[$_]->id } grep { $state->{selected}{$_}{recommended} } keys %{$state->{selected}}; + @recommended_package_ids = uniq(@recommended_package_ids, @new_ids); + } my $error; if (find { !exists $state->{selected}{$_} } keys %$requested) { - my @rejected = urpm::select::unselected_packages($packages, $state); + my @rejected = urpm::select::unselected_packages($state); $error = urpm::select::translate_why_unselected($packages, $state, @rejected); log::l("ERROR: selection failed: $error"); } @@ -282,7 +351,13 @@ sub unselectAllPackages { my %keep_selected; log::l("unselecting all packages..."); foreach (@{$packages->{depslist}}) { - if ($_->flag_base || $_->flag_installed && $_->flag_selected) { + my $to_select = $_->flag_base || $_->flag_installed && $_->flag_selected; + # unselect recommended packages if minimal install: + if ($::o->{no_recommends} && member($_->id, @recommended_package_ids)) { + log::l("unselecting recommended package " . $_->name); + undef $to_select; + } + if ($to_select) { #- keep track of packages that should be kept selected. $keep_selected{$_->id} = $_; } else { @@ -296,6 +371,20 @@ sub unselectAllPackages { _resolve_requested_and_check($packages, $packages->{state}, \%keep_selected); } + +my (@errors, $push_errors); +sub start_pushing_error() { + $push_errors = 1; + undef @errors; +} + +sub popup_errors() { + if (@errors) { + $::o->ask_warn(undef, N("An error occurred:") . "\n\n" . join("\n", @errors)); + } + undef $push_errors; +} + sub empty_packages { my ($o_keep_unrequested_dependencies) = @_; my $packages = urpm->new; @@ -303,24 +392,39 @@ sub empty_packages { urpm::set_files($packages, '/mnt'); #- add additional fields used by DrakX. - @$packages{qw(count media)} = (0, []); + $packages->{media} = []; urpm::args::set_debug($packages) if $::o->{debug_urpmi}; $packages->{log} = \&log::l; $packages->{info} = \&log::l; - $packages->{fatal} = $packages->{error} = sub { + $packages->{fatal} = sub { + log::l("urpmi error: $_[1] ($_[0])\n" . common::backtrace()); + $::o->ask_warn(undef, N("A fatal error occurred: %s.", "$_[1] ($_[0])")); + }; + $packages->{error} = sub { log::l("urpmi error: $_[0]"); + if ($push_errors) { + push @errors, @_; + return; + } $::o->ask_warn(undef, N("An error occurred:") . "\n\n" . $_[0]); }; $packages->{root} = $::prefix; $packages->{prefer_vendor_list} = '/etc/urpmi/prefer.vendor.list'; $packages->{keep_unrequested_dependencies} = defined($o_keep_unrequested_dependencies) ? $o_keep_unrequested_dependencies : 1; - $urpm::args::options{force_transactions} = 1; + $urpm::args::options{justdb} = $::o->{justdb}; + urpm::set_tune_rpm($packages, $::o->{'tune-rpm'}) if $::o->{'tune-rpm'}; + $::force = 1; $packages->{options}{ignoresize} = 1; - $packages->{options}{'priority-upgrade'}; # prevent priority upgrade + $packages->{options}{retry} = 3; + $packages->{options}{downloader} = $::o->{options}{downloader}; + # prevent priority upgrade (redundant for now as $urpm->{root} implies disabling it: + $packages->{options}{'priority-upgrade'} = undef; # log $trans->add() faillure; FIXME: should we override *urpm::msg::sys_log? - $packages->{debug} = \&log::l; + $packages->{debug} = $packages->{debug_URPM} = \&log::l; + $urpm::args::options{deploops} = $::o->{deploops}; + $packages->{options}{'curl-options'} = $::o->{curl_options} if $::o->{curl_options}; $packages; } @@ -328,7 +432,7 @@ sub empty_packages { sub readCompssUsers { my ($file) = @_; - my $f = common::open_file($file) or log::l("can not find $file: $!"), return; + my $f = common::open_file($file) or log::l("cannot find $file: $!"), return; my ($compssUsers, $gtk_display_compssUsers) = eval join('', <$f>); if ($@) { log::l("ERROR: bad $file: $@"); @@ -359,26 +463,35 @@ sub setSelectedFromCompssList { my ($packages, $rpmsrate_flags_chosen, $min_level, $max_size) = @_; $rpmsrate_flags_chosen->{TRUE} = 1; #- ensure TRUE is set my $nb = selectedSize($packages); - foreach my $p (sort { $b->rate <=> $a->rate } @{$packages->{depslist}}) { + + my %pkgs; + foreach my $p (@{$packages->{depslist}}) { my @flags = $p->rflags; - next if + next if !$p->rate || $p->rate < $min_level || - any { !any { /^!(.*)/ ? !$rpmsrate_flags_chosen->{$1} : $rpmsrate_flags_chosen->{$_} } split('\|\|') } @flags; - - #- determine the packages that will be selected when - #- selecting $p. the packages are not selected. + any { !any { /^!(.*)/ ? !$rpmsrate_flags_chosen->{$1} : $rpmsrate_flags_chosen->{$_} } split('\|\|') } @flags; + $pkgs{$p->rate} ||= {}; + $pkgs{$p->rate}{$p->id} = 1 if _packageRequest($packages, $p); + } + my %pkgswanted; + foreach my $level (sort { $b <=> $a } keys %pkgs) { + #- determine the packages that will be selected + #- the packages are not selected. my $state = $packages->{state} ||= {}; - - my ($l, $_error) = _resolve_requested_and_check($packages, $state, _packageRequest($packages, $p) || {}); - + foreach my $p (keys %{$pkgs{$level}}) { + $pkgswanted{$p} = 1; + } + my ($l, $_error) = _resolve_requested_and_check($packages, $state, \%pkgswanted); + #- this enable an incremental total size. my $old_nb = $nb; foreach (@$l) { $nb += $_->size; } if ($max_size && $nb > $max_size) { + log::l("disabling selected packages because too big for level $level: $nb > $max_size"); $nb = $old_nb; - $min_level = $p->rate; + $min_level = $level; $packages->disable_selected($packages->{rpmdb}, $state, @$l); last; } @@ -394,7 +507,7 @@ sub setSelectedFromCompssList { sub saveSelected { my ($packages) = @_; my $state = delete $packages->{state}; - my @l = @{$packages->{depslist}}; + my @l = @{$packages->{depslist} || []}; my @flags = map { ($_->flag_requested && 1) + ($_->flag_required && 2) + ($_->flag_upgrade && 4) } @l; [ $packages, $state, \@l, \@flags ]; } @@ -485,7 +598,7 @@ sub computeGroupSize { $newSelection{$id} = undef; my $pkg = $packages->{depslist}[$id]; - my @deps = map { [ $_, keys %{$packages->{provides}{$_} || {}} ] } $pkg->requires_nosense, $pkg->suggests; + my @deps = map { [ $_, keys %{$packages->{provides}{$_} || {}} ] } $pkg->requires_nosense, $pkg->recommends_nosense; foreach (sort { @$a <=> @$b } @deps) { #- sort on number of provides (it helps choosing "b" in: "a" requires both "b" and virtual={"b","c"}) my ($virtual, @choices) = @$_; if (@choices <= 1) { @@ -497,7 +610,7 @@ sub computeGroupSize { if (find { $_->flag_available } @choices_pkgs) { @choices = (); #- one package is already selected (?) } else { - @choices = map { $_->id } packageCallbackChoices($packages, undef, undef, \@choices_pkgs, $virtual); + @choices = map { $_->id } packageCallbackChoices($packages, undef, undef, \@choices_pkgs, $virtual, undef); } } push @l2, @choices; @@ -532,6 +645,27 @@ sub _openInstallLog() { $LOG; } +sub _rebuild_RPM_DB() { + if (my $pid = fork()) { + waitpid $pid, 0; + $? & 0xff00 and die "rebuilding of rpm database failed"; + } else { + log::l("rebuilding rpm database"); + my $rebuilddb_dir = "$::prefix/var/lib/rpmrebuilddb.$$"; + if (-d $rebuilddb_dir) { + log::l("removing stale directory $rebuilddb_dir"); + rm_rf($rebuilddb_dir); + } + + if (!URPM::DB::rebuild($::prefix)) { + log::l("rebuilding of rpm database failed: " . URPM::rpmErrorString()); + c::_exit(2); + } + + c::_exit(0); + } +} + sub rpmDbOpen { my ($b_rebuild_if_needed) = @_; @@ -539,26 +673,7 @@ sub rpmDbOpen { my $need_rebuild = $b_rebuild_if_needed && !URPM::DB::verify($::prefix); - if ($need_rebuild) { - if (my $pid = fork()) { - waitpid $pid, 0; - $? & 0xff00 and die "rebuilding of rpm database failed"; - } else { - log::l("rebuilding rpm database"); - my $rebuilddb_dir = "$::prefix/var/lib/rpmrebuilddb.$$"; - if (-d $rebuilddb_dir) { - log::l("removing stale directory $rebuilddb_dir"); - rm_rf($rebuilddb_dir); - } - - if (!URPM::DB::rebuild($::prefix)) { - log::l("rebuilding of rpm database failed: " . URPM::rpmErrorString()); - c::_exit(2); - } - - c::_exit(0); - } - } + _rebuild_RPM_DB() if $need_rebuild; my $db; if ($db = URPM::DB::open($::prefix)) { @@ -612,6 +727,7 @@ sub selectPackagesAlreadyInstalled { my %sizes; $packages->{rpmdb}->traverse(sub { my ($p) = @_; + $sizes{$p->name} ||= 0; $sizes{$p->name} += $p->size; }); $packages->{sizes} = \%sizes; @@ -642,7 +758,7 @@ sub _filter_packages { my ($retry, $packages, @packages) = @_; grep { if ($_->flag_installed || packageMedium($packages, $_)->{ignore}) { - if ($_->name eq 'mdv-rpm-summary' && $_->flag_installed) { + if ($_->name eq 'mga-rpm-summary' && $_->flag_installed) { install::pkgs::setup_rpm_summary_translations(); } $_->free_header; @@ -669,26 +785,32 @@ sub install { #- first stage to extract some important information #- about the selected packages. - my ($total, $nb); + my ($total, $nb) = (0, 0); foreach my $pkg (@$toInstall) { $packages{$pkg->id} = $pkg; $nb++; - $total += to_int($pkg->size); #- do not correct for upgrade! + $total += $pkg->size; #- do not correct for upgrade! } log::l("install::pkgs::install $::prefix"); log::l("install::pkgs::install the following: ", join(" ", map { $_->name } values %packages)); URPM::read_config_files(); - URPM::add_macro(join(' ', '__dbi_cdb', URPM::expand('%__dbi_cdb'), 'nofsync')); + # force loading libnss* + getgrent(); + URPM::add_macro(join(' ', '__dbi_other', URPM::expand('%__dbi_other'), 'nofsync')); my $LOG = _openInstallLog(); + $packages->{log} = $packages->{info} = $packages->{print} = sub { + print $LOG "$_[0]\n"; + }; + #- do not modify/translate the message used with installCallback since #- these are keys during progressing installation, or change in other #- place (install::steps_gtk.pm,...). $callback->($packages, user => undef, install => $nb, $total); - _install_raw($packages, $isUpgrade, $callback, $LOG, 0); + my $exit_code = _install_raw($packages, $isUpgrade, $callback, $LOG, 0); log::l("closing install.log file"); close $LOG; @@ -699,6 +821,8 @@ sub install { clean_rpmdb_shared_regions(); #- workaround librpm which is buggy when using librpm rooted and the just installed rooted library fs::loopback::save_boot($loop_boot); + + $exit_code; } sub _unselect_package { @@ -715,36 +839,60 @@ sub _unselect_package { } } +sub is_package_installed { + my ($db, $pkg) = @_; + my $check_installed; + $db->traverse_tag('name', [ $pkg->name ], sub { + my ($p) = @_; + $check_installed ||= $pkg->compare_pkg($p) == 0; + }); + return $check_installed; +} + sub _install_raw { - my ($packages, $isUpgrade, $callback, $LOG, $noscripts) = @_; + my ($packages, $_isUpgrade, $callback, $LOG, $noscripts) = @_; + + # prevent warnings in install's logs: + local $ENV{LC_ALL} = 'C'; # let's be urpmi's compatible: local $packages->{options}{noscripts} = $noscripts; - # leaks a fd per transaction: - #local $packages->{options}{script_fd} = fileno $LOG; + # leaks a fd per transaction (around ~100 for a typically gnome install, see #49097): + # bug present in 2009.0, 2008.1, 2008.0, ... (probably since r11141 aka when switching to rpm-4.2 in URPM-0.83) + local $packages->{options}{script_fd} = fileno $LOG; - my ($retry, $retry_count); + start_pushing_error(); log::l("rpm transactions start"); - my $exit_code = urpm::main_loop::run($packages, $packages->{state}, undef, undef, undef, { - open_helper => $callback, + my ($is_installing, $verify_just_closed); + my $exit_code = urpm::main_loop::run($packages, $packages->{state}, undef, undef, { + open_helper => sub { + &$callback; + $is_installing = 0; + }, + verify => $callback, close_helper => sub { my ($db, $packages, $_type, $id) = @_; &$callback; + return if !$is_installing; # don't check if it's installed if it's being verified my $pkg = defined $id && $packages->{depslist}[$id] or return; - my $check_installed; - $db->traverse_tag('name', [ $pkg->name ], sub { - my ($p) = @_; - $check_installed ||= $pkg->compare_pkg($p) == 0; - }); - if ($pkg->name eq 'mdv-rpm-summary' && $check_installed) { + print $LOG $pkg->fullname . "\n"; + my $check_installed = is_package_installed($db, $pkg); + if ($pkg->name eq 'mga-rpm-summary' && $check_installed) { install::pkgs::setup_rpm_summary_translations(); } - $check_installed or log::l($pkg->name . " not installed, " . URPM::rpmErrorString()); - $check_installed and _unselect_package($packages, $pkg); - }, inst => $callback, + if ($check_installed) { + _unselect_package($packages, $pkg); + } else { + log::l($pkg->name . " not installed, " . URPM::rpmErrorString()); + } + }, + inst => sub { + &$callback; + $is_installing = 1; + }, trans => $callback, # FIXME: implement already_installed_or_not_installable bad_signature => sub { @@ -752,12 +900,23 @@ sub _install_raw { $msg =~ s/:$/\n\n/m; # FIXME: to be fixed in urpmi after 2008.0 (sic!) log::l($msg); log::l($msg2); - $::o->ask_yesorno(N("Warning"), "$msg\n\n$msg2"); + return 0 if $packages->{options}{auto}; + state $do_not_ask; + state $answer; + return $answer if $do_not_ask; + $answer = $::o->ask_from_({ messages => "$msg\n\n$msg2" }, [ + { val => \$do_not_ask, + type => 'bool', text => N("Do not ask again"), + }, + ]); }, copy_removable => sub { my ($medium) = @_; $::o->ask_change_cd($medium); }, + is_canceled => sub { + return $install::pkgs::cancel_install; + }, trans_error_summary => sub { my ($nok, $errors) = @_; log::l($nok . " installation transactions failed"); @@ -767,6 +926,11 @@ sub _install_raw { N("Installation of packages failed:") . "\n\n" . join("\n", @$errors)); } }, + completed => sub { + if (!$packages->{options}{auto}) { + popup_errors(); + } + }, message => sub { my ($title, $message) = @_; log::l($message); @@ -777,6 +941,17 @@ sub _install_raw { log::l($msg); $::o->ask_yesorno($title, $msg); }, + ask_for_bad_or_missing => sub { + my ($_title, $msg) = @_; + log::l($msg); + state $do_not_ask; + state $answer; + return $answer if $do_not_ask; + $answer = $::o->ask_from_({ messages => $msg }, [ + { val => \$do_not_ask, type => 'bool', text => N("Do not ask again"), + }, + ]); + }, # Uneeded callbacks: success_summary }); @@ -898,10 +1073,10 @@ sub _remove_raw { log::l("removing: " . join(' ', @$to_remove)); URPM::read_config_files(); - URPM::add_macro(URPM::expand('__dbi_cdb %__dbi_cdb nofsync')); + URPM::add_macro(URPM::expand('__dbi_other %__dbi_other nofsync')); my $db = open_rpm_db_rw() or die "error opening RPM database: ", URPM::rpmErrorString(); - my $trans = $db->create_transaction($::prefix); + my $trans = $db->create_transaction; #- stuff remove all packages that matches $p, not a problem since $p has name-version-release format. $trans->remove($_) foreach @$to_remove; |