From ac038d3612f652029462d3b77f7c9bd8f29a5b0d Mon Sep 17 00:00:00 2001 From: Thierry Vignaud Date: Fri, 30 Jan 2009 10:37:37 +0000 Subject: (install) reuse urpmi's higher level code (drop librpm ordering hack and retry logic since urpmi should behaves better) --- perl-install/install/media.pm | 8 +- perl-install/install/pkgs.pm | 215 +++++++++++------------------------------- perl-install/install/steps.pm | 2 + 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. -- cgit v1.2.1