summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorThierry Vignaud <tv@mandriva.org>2009-01-30 10:37:37 +0000
committerThierry Vignaud <tv@mandriva.org>2009-01-30 10:37:37 +0000
commitac038d3612f652029462d3b77f7c9bd8f29a5b0d (patch)
treea22ada16e62759ee658b85051d6ce2f1e646d06c
parentc58b03b4c01a056219b606cd0fa8e0a3a5d4869f (diff)
downloaddrakx-backup-do-not-use-ac038d3612f652029462d3b77f7c9bd8f29a5b0d.tar
drakx-backup-do-not-use-ac038d3612f652029462d3b77f7c9bd8f29a5b0d.tar.gz
drakx-backup-do-not-use-ac038d3612f652029462d3b77f7c9bd8f29a5b0d.tar.bz2
drakx-backup-do-not-use-ac038d3612f652029462d3b77f7c9bd8f29a5b0d.tar.xz
drakx-backup-do-not-use-ac038d3612f652029462d3b77f7c9bd8f29a5b0d.zip
(install) reuse urpmi's higher level code (drop librpm ordering hack
and retry logic since urpmi should behaves better)
-rw-r--r--perl-install/install/media.pm8
-rw-r--r--perl-install/install/pkgs.pm215
-rw-r--r--perl-install/install/steps.pm2
3 files changed, 65 insertions, 160 deletions
diff --git a/perl-install/install/media.pm b/perl-install/install/media.pm
index 5b7b906e5..143d6313a 100644
--- a/perl-install/install/media.pm
+++ b/perl-install/install/media.pm
@@ -37,6 +37,7 @@ use urpm::download;
#- selected
#- size (in MB)
#- start (first rpm id, undefined iff not selected)
+#- url (compatibility for urpm)
#- update (for install_urpmi)
@@ -471,7 +472,7 @@ sub _allow_copy_rpms_on_disk {
}
sub _parse_media_cfg {
- my ($cfg) = @_;
+ my ($cfg, $phys_medium) = @_;
require MDV::Distribconf;
my $d = MDV::Distribconf->new('', undef);
@@ -487,6 +488,7 @@ sub _parse_media_cfg {
rel_hdlist => 'media_info/' . $d->getvalue($_, 'hdlist'),
name => $name,
size => $size,
+ url => ($phys_medium->{real_mntpoint} ? "$phys_medium->{real_mntpoint}" : $phys_medium->{url} ) . "$phys_medium->{rel_path}/$_", # FIXME (hackish)
selected => !$d->getvalue($_, 'noauto'),
update => $d->getvalue($_, 'updates_for') ? 1 : undef,
};
@@ -608,7 +610,7 @@ sub get_media_cfg {
my ($distribconf, $hdlists);
if (getAndSaveFile_($phys_medium, 'media_info/media.cfg', '/tmp/media.cfg')) {
- ($distribconf, $hdlists) = _parse_media_cfg('/tmp/media.cfg');
+ ($distribconf, $hdlists) = _parse_media_cfg('/tmp/media.cfg', $phys_medium);
} else {
die "media.cfg not found";
}
@@ -894,6 +896,8 @@ sub install_urpmi {
unlink $medium->{pubkey};
}
+ mkdir_p("$::prefix/etc/urpmi");
+
my (@cfg, @netrc);
foreach my $medium (@media) {
if ($medium->{selected}) {
diff --git a/perl-install/install/pkgs.pm b/perl-install/install/pkgs.pm
index c1751c2ba..fe4ebf3f5 100644
--- a/perl-install/install/pkgs.pm
+++ b/perl-install/install/pkgs.pm
@@ -12,6 +12,8 @@ use URPM;
use URPM::Resolve;
use URPM::Signature;
use urpm;
+use urpm::args;
+use urpm::main_loop;
use urpm::select;
use common;
use install::any;
@@ -328,6 +330,7 @@ sub unselectAllPackages {
sub empty_packages {
my ($o_keep_unrequested_dependencies) = @_;
my $packages = urpm->new;
+ urpm::get_global_options($packages);
#- add additional fields used by DrakX.
@$packages{qw(count media)} = (0, []);
@@ -664,86 +667,6 @@ sub _filter_packages {
} @packages;
}
-sub _installTransactionClosure {
- my ($packages, $id2pkg, $isUpgrade) = @_;
-
- foreach (grep { !$_->{selected} } @{$packages->{media}}) {
- foreach ($_->{start} .. $_->{end}) {
- delete $id2pkg->{$_};
- }
- }
-
- my @l = ikeys %$id2pkg;
- my $medium;
-
- #- search first usable medium (media are sorted).
- foreach (@{$packages->{media}}) {
- if ($l[0] <= $_->{end}) {
- #- we have a candidate medium, it could be the right one containing
- #- the first package of @l...
- $l[0] >= $_->{start} and $medium = $_, last;
- #- ... but it could be necessary to find the first
- #- medium containing package of @l.
- foreach my $id (@l) {
- $id >= $_->{start} && $id <= $_->{end} and $medium = $_, last;
- }
- $medium and last;
- }
- }
- $medium or return (); #- no more medium usable -> end of installation by returning empty list.
-
- #- it is sure at least one package will be installed according to medium chosen.
- {
- my $pkg = $packages->{depslist}[$l[0]];
- my $rpm = install::media::rel_rpm_file($medium, $pkg->filename);
- if ($install::media::postinstall_rpms && -e "$install::media::postinstall_rpms/$rpm") {
- #- very special case where the rpm has been copied on disk
- } elsif (!install::media::change_phys_medium($medium->{phys_medium}, $rpm, $packages)) {
- #- keep in mind the asked medium has been refused.
- #- this means it is no longer selected.
- #- (but do not unselect supplementary CDs.)
- $medium->{selected} = 0;
- }
- }
-
- if (my $p = packageByName($packages, 'mdv-rpm-summary')) {
- #- if it is selected, make it the first package
- exists $id2pkg->{$p->id} and unshift @l, $p->id;
- }
-
- my %closure;
- foreach my $id (@l) {
- my @l2 = $id;
-
- if ($isUpgrade && $id < 20) {
- #- HACK for upgrading to 2006.0: for the 20 first main packages, upgrade one by one
- #- why? well:
- #- * librpm is fucked up when ordering pkgs, pkg "setup" is removed before being installed.
- #- the result is /etc/group.rpmsave and no /etc/group
- #- * pkg locales requires basesystem, this is stupid, the result is a huge first transaction
- #- and it doesn't even help /usr/bin/locale_install.sh since it's not a requires(post)
- $closure{$id} = undef;
- last;
- }
-
- while (defined($id = shift @l2)) {
- exists $closure{$id} and next;
- $closure{$id} = undef;
-
- my $pkg = $packages->{depslist}[$id];
- foreach ($pkg->requires_nosense) {
- if (my $dep_id = find { $id2pkg->{$_} } keys %{$packages->{provides}{$_} || {}}) {
- push @l2, $dep_id;
- }
- }
- }
-
- keys %closure >= $limitMinTrans and last;
- }
-
- map { delete $id2pkg->{$_} } grep { $id2pkg->{$_} } ikeys %closure;
-}
-
sub install {
my ($isUpgrade, $toInstall, $packages, $callback) = @_;
my %packages;
@@ -770,6 +693,9 @@ sub install {
log::l("install::pkgs::install $::prefix");
log::l("install::pkgs::install the following: ", join(" ", map { $_->name } values %packages));
+ #urpm::media::configure($packages);
+
+
URPM::read_config_files();
URPM::add_macro(join(' ', '__dbi_cdb', URPM::expand('%__dbi_cdb'), 'nofsync'));
my $LOG = _openInstallLog();
@@ -779,66 +705,7 @@ sub install {
#- place (install::steps_gtk.pm,...).
$callback->($packages, user => undef, install => $nb, $total);
- do {
- my @transToInstall = _installTransactionClosure($packages, \%packages, $isUpgrade);
- $nb = values %packages;
-
- #- added to exit typically after last media unselected.
- if ($nb == 0 && scalar(@transToInstall) == 0) {
- _cleanHeaders();
-
- fs::loopback::save_boot($loop_boot);
- return;
- }
-
- #- extract headers for parent as they are used by callback.
- extractHeaders(\@transToInstall, $packages->{media});
-
- my ($retry, $retry_count);
- while (@transToInstall) {
- my $retry_pkg = $retry && $transToInstall[0];
-
- if ($retry) {
- log::l("retrying installing package " . $retry_pkg->fullname . " alone in a transaction ($retry_count)");
- }
- _install_raw($packages, [ $retry ? $retry_pkg : @transToInstall ],
- $isUpgrade, $callback, $LOG, $retry_pkg);
-
- @transToInstall = _filter_packages($retry, $packages, @transToInstall);
-
- if (@transToInstall) {
- if (!$retry || $retry_pkg != $transToInstall[0]) {
- #- go to next
- $retry_count = 1;
- } elsif ($retry_pkg == $transToInstall[0] && $retry_count < 3) {
- $retry_count++;
- } else {
- log::l("failed to install " . $retry_pkg->fullname);
-
- my $medium = packageMedium($packages, $retry_pkg);
- my $name = $retry_pkg->fullname;
- my $rc = cdie("error installing package list: $name $medium->{name}");
- if ($rc eq 'retry') {
- $retry_count = 1;
- } else {
- if ($rc eq 'disable_media') {
- $medium->{selected} = 0;
- }
- $retry_pkg->set_flag_requested(0);
- $retry_pkg->set_flag_required(0);
-
- #- dropping it
- $retry_pkg->free_header;
- shift @transToInstall;
- $retry_count = 1;
- }
- }
- $retry = 1;
- }
- }
- log::l("progression: $nb remaining packages to install");
- _cleanHeaders();
- } while $nb > 0 && !$install::pkgs::cancel_install;
+ _install_raw($packages, $isUpgrade, $callback, $LOG, 0);
log::l("closing install.log file");
close $LOG;
@@ -850,7 +717,7 @@ sub install {
}
sub _install_raw {
- my ($packages, $transToInstall, $isUpgrade, $callback, $LOG, $noscripts) = @_;
+ my ($packages, $isUpgrade, $callback, $LOG, $noscripts) = @_;
my $close = sub {
my ($pkg) = @_;
@@ -867,23 +734,32 @@ sub _install_raw {
};
my $db = open_rpm_db_rw() or die "error opening RPM database: ", URPM::rpmErrorString();
- my $trans = $db->create_transaction($::prefix);
- log::l("opened rpm database for transaction of " . int(@$transToInstall) . " packages (isUpgrade=$isUpgrade)");
- foreach (@$transToInstall) {
- $trans->add($_, update => $isUpgrade ? 1 : 0)
- or log::l("add failed for " . $_->fullname);
- }
+ #log::l("opened rpm database for transaction of " . int(@$transToInstall) . " packages (isUpgrade=$isUpgrade)");
+
- my @checks = $trans->check; @checks and log::l("check failed : " . join("\n ", @checks));
- $trans->order or die "error ordering package list: " . URPM::rpmErrorString();
- $trans->set_script_fd(fileno $LOG);
+ # let's be urpmi's compatible:
+ local $packages->{options}{noscripts} = $noscripts;
+ $urpm::args::options{force_transactions} = 1;
+ local $packages->{options}{ignoresize} = 1;
+ local $packages->{options}{script_fd} = fileno $LOG;
+ local $packages->{options}{'priority-upgrade'}; # prevent priority upgrade
+ # log $trans->add() faillure; FIXME: should we override *urpm::msg::sys_log?
+ local $packages->{error} = \&log::l;
+ local $packages->{debug} = \&log::l;
+
+ local packages->{options}{'verify-rpm'} = 0;
+
+ #- HACK for upgrading to 2006.0: for the 20 first main packages, upgrade one by one:
+ local $packages->{options}{hack_for_buggy_librpm} = $isUpgrade;
+
+ my ($retry, $retry_count);
log::l("rpm transactions start");
my $fd; #- since we return the "fileno", perl does not know we're still using it, and so closes it, and :-(
- my @probs = $trans->run($packages, force => 1, nosize => 1,
- if_($noscripts, noscripts => 1),
- callback_open => sub {
+
+ my $exit_code = urpm::main_loop::run($packages, $packages->{state}, undef, undef, \%requested, {
+ open => sub {
my ($packages, $_type, $id) = @_;
&$callback;
my $pkg = defined $id && $packages->{depslist}[$id];
@@ -893,7 +769,7 @@ sub _install_raw {
undef $fd;
$fd = getFile_($medium->{phys_medium}, $f);
$fd ? fileno $fd : -1;
- }, callback_close => sub {
+ }, close => sub {
my ($packages, $_type, $id) = @_;
&$callback;
my $pkg = defined $id && $packages->{depslist}[$id] or return;
@@ -904,11 +780,34 @@ sub _install_raw {
});
$check_installed or log::l($pkg->name . " not installed, " . URPM::rpmErrorString());
$check_installed and $close->($pkg);
- }, callback_inst => $callback,
- );
+ }, inst => $callback,
+ trans => $callback_inst,
+ # FIXME: implement already_installed_or_not_installable
+ bad_signature => sub {
+ my ($msg, $msg2) = @_;
+ $msg =~ s/:$/\n\n/m; # FIXME: to be fixed in urpmi after 2008.0 (sic!)
+ interactive->vnew->ask_yesorno(N("Warning"), "$msg\n\n$msg2");
+ },
+ ask_retry => sub {
+ },
+ trans_error_summary => sub {
+ my ($nok, $errors) = @_;
+ log::l("%d installation transactions failed", $nok);
+ die "installation of rpms failed:\n " . join("\n", @$errors);
+ },
+ message => sub {
+ my ($title, $message) = @_;
+ interactive->vnew->ask_warn($title, $msg);
+ },
+ #ask_yes_or_no => sub { 1 }, # FIXME used for ask for allow-force or allow-nodeps
+ ask_yes_or_no => sub {
+ my ($title, $msg) = @_;
+ interactive->vnew->ask_yesorno($title, $msg);
+ },
+ # Uneeded callbacks: success_summary
+ });
+
log::l("transactions done, now trying to close still opened fd");
-
- @probs and die "installation of rpms failed:\n ", join("\n ", @probs);
}
sub upgrade_by_removing_pkgs {
diff --git a/perl-install/install/steps.pm b/perl-install/install/steps.pm
index e998f648e..c8f87f3f1 100644
--- a/perl-install/install/steps.pm
+++ b/perl-install/install/steps.pm
@@ -414,6 +414,8 @@ sub installPackages {
my ($o) = @_;
my $packages = $o->{packages};
+ $o->install_urpmi;
+
install::pkgs::remove_marked_ask_remove($packages, \&installCallback);
#- small transaction will be built based on this selection and depslist.