summaryrefslogtreecommitdiffstats
path: root/perl-install/install/pkgs.pm
diff options
context:
space:
mode:
Diffstat (limited to 'perl-install/install/pkgs.pm')
-rw-r--r--perl-install/install/pkgs.pm244
1 files changed, 181 insertions, 63 deletions
diff --git a/perl-install/install/pkgs.pm b/perl-install/install/pkgs.pm
index 63e33021d..a9692e225 100644
--- a/perl-install/install/pkgs.pm
+++ b/perl-install/install/pkgs.pm
@@ -1,4 +1,4 @@
-package install::pkgs; # $Id: pkgs.pm 267288 2010-04-02 14:49:40Z pterjan $
+package install::pkgs;
use strict;
use feature 'state';
@@ -27,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"),
@@ -39,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) = @_;
@@ -70,34 +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;
}
}
+# 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 compatible with current architecture.
+#- 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 { $_->name eq $name } packagesProviding($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 = $_;
}
@@ -109,16 +153,13 @@ sub packageByName {
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::dmi_detect_memory() > 3.8 * 1024 || detect_devices::isServer();
+ arch() =~ /i.86/ && detect_devices::isServer();
}
sub _bestKernel_extensions {
my ($o_match_all_hardware) = @_;
$::o->{kernel_extension} ? $::o->{kernel_extension} :
- $o_match_all_hardware ? (arch() =~ /i.86/ ? '-desktop586' : '-desktop') :
- detect_devices::is_xbox() ? '-xbox' :
- detect_devices::is_i586() ? '-desktop586' :
_is_kernelServer_needed() ? '-server' :
'-desktop';
}
@@ -131,7 +172,6 @@ sub bestKernelPackage {
if (!@kernels) {
#- fallback on most generic kernel if the suitable one is not available
- #- (only kernel-desktop586-latest is available on Dual ISO for i586)
my @fallback_exts = _bestKernel_extensions('force');
@kernels = grep { $_ } map { packageByName($packages, "kernel$_-latest") } @fallback_exts;
}
@@ -149,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;
}
@@ -247,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, no_suggests => $::o->{no_suggests});
+ 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");
}
@@ -303,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 {
@@ -317,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;
@@ -324,26 +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}{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} = $packages->{debug_URPM} = \&log::l;
+ $urpm::args::options{deploops} = $::o->{deploops};
+ $packages->{options}{'curl-options'} = $::o->{curl_options} if $::o->{curl_options};
$packages;
}
@@ -408,6 +489,7 @@ sub setSelectedFromCompssList {
$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 = $level;
$packages->disable_selected($packages->{rpmdb}, $state, @$l);
@@ -425,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 ];
}
@@ -516,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) {
@@ -528,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;
@@ -563,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) = @_;
@@ -570,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)) {
@@ -643,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;
@@ -700,18 +785,20 @@ 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 {
@@ -723,7 +810,7 @@ sub install {
#- 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;
@@ -734,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 {
@@ -761,7 +850,7 @@ sub is_package_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';
@@ -772,13 +861,21 @@ sub _install_raw {
# 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;
+ 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;
print $LOG $pkg->fullname . "\n";
my $check_installed = is_package_installed($db, $pkg);
@@ -791,7 +888,11 @@ sub _install_raw {
} else {
log::l($pkg->name . " not installed, " . URPM::rpmErrorString());
}
- }, inst => $callback,
+ },
+ inst => sub {
+ &$callback;
+ $is_installing = 1;
+ },
trans => $callback,
# FIXME: implement already_installed_or_not_installable
bad_signature => sub {
@@ -801,12 +902,13 @@ sub _install_raw {
log::l($msg2);
return 0 if $packages->{options}{auto};
state $do_not_ask;
- return if $do_not_ask;
- $::o->ask_from_({ messages => "$msg\n\n$msg2" }, [
- { val => \$do_not_ask,
- type => 'bool', text => N("Do not ask again"),
- },
- ]);
+ 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) = @_;
@@ -824,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);
@@ -834,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
});
@@ -955,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;
generated by cgit v1.2.1 (git 2.21.0) at 2025-11-13 08:22:38 +0000