summaryrefslogtreecommitdiffstats
path: root/perl-install
diff options
context:
space:
mode:
authorFrancois Pons <fpons@mandriva.com>2001-03-01 18:44:21 +0000
committerFrancois Pons <fpons@mandriva.com>2001-03-01 18:44:21 +0000
commit1ecbf955e9385b5a449abe02cd2cedff824d430b (patch)
tree37ec0a84521d1e53c6c40302e6b176683ed50734 /perl-install
parentcab80903f656251fa7672d33cba6c1569a6cac48 (diff)
downloaddrakx-backup-do-not-use-1ecbf955e9385b5a449abe02cd2cedff824d430b.tar
drakx-backup-do-not-use-1ecbf955e9385b5a449abe02cd2cedff824d430b.tar.gz
drakx-backup-do-not-use-1ecbf955e9385b5a449abe02cd2cedff824d430b.tar.bz2
drakx-backup-do-not-use-1ecbf955e9385b5a449abe02cd2cedff824d430b.tar.xz
drakx-backup-do-not-use-1ecbf955e9385b5a449abe02cd2cedff824d430b.zip
added retry support but automatic (no user response).
Diffstat (limited to 'perl-install')
-rw-r--r--perl-install/pkgs.pm158
1 files changed, 92 insertions, 66 deletions
diff --git a/perl-install/pkgs.pm b/perl-install/pkgs.pm
index cce8ea227..6545ce9ee 100644
--- a/perl-install/pkgs.pm
+++ b/perl-install/pkgs.pm
@@ -1218,84 +1218,110 @@ sub install($$$;$$) {
#- and make sure there are no staling open file descriptor too (before forking)!
install_any::getFile('XXX');
- local (*INPUT, *OUTPUT); pipe INPUT, OUTPUT;
- if (my $pid = fork()) {
- close OUTPUT;
- my $error_msg = '';
- local $_;
- while (<INPUT>) {
- if (/^die:(.*)/) {
- $error_msg = $1;
- last;
- } else {
- chomp;
- my @params = split ":";
- if ($params[0] eq 'close') {
- &$callbackClose($params[1]);
+ my $retry = 3;
+ while (@transToInstall) {
+ local (*INPUT, *OUTPUT); pipe INPUT, OUTPUT;
+ if (my $pid = fork()) {
+ close OUTPUT;
+ my $error_msg = '';
+ local $_;
+ while (<INPUT>) {
+ if (/^die:(.*)/) {
+ $error_msg = $1;
+ last;
} else {
- installCallback(@params);
+ chomp;
+ my @params = split ":";
+ if ($params[0] eq 'close') {
+ &$callbackClose($params[1]);
+ } else {
+ installCallback(@params);
+ }
}
}
- }
- $error_msg and $error_msg .= join('', <INPUT>);
- waitpid $pid, 0;
- close INPUT;
- $error_msg and die $error_msg;
- } else {
- #- child process will run each transaction.
- $SIG{SEGV} = sub { log::l("segmentation fault on transactions"); c::_exit(0) };
- my $db;
- eval {
+ $error_msg and $error_msg .= join('', <INPUT>);
+ waitpid $pid, 0;
close INPUT;
- select((select(OUTPUT), $| = 1)[0]);
- $db = c::rpmdbOpen($prefix) or die "error opening RPM database: ", c::rpmErrorString();
- my $trans = c::rpmtransCreateSet($db, $prefix);
- log::l("opened rpm database for transaction of ". scalar @transToInstall ." new packages, still $nb after that to do");
-
- c::rpmtransAddPackage($trans, $_->[$HEADER], packageName($_), $isUpgrade && allowedToUpgrade(packageName($_)))
- foreach @transToInstall;
-
- c::rpmdepOrder($trans) or die "error ordering package list: " . c::rpmErrorString();
- c::rpmtransSetScriptFd($trans, fileno LOG);
-
- log::l("rpmRunTransactions start");
- my @probs = c::rpmRunTransactions($trans, $callbackOpen,
- sub { #- callbackClose
- print OUTPUT "close:$_[0]\n"; },
- sub { #- installCallback
- print OUTPUT join(":", @_), "\n"; },
- 1);
- log::l("rpmRunTransactions done, now trying to close still opened fd");
- install_any::getFile('XXX'); #- close still opened fd.
-
- if (@probs) {
- my %parts;
- @probs = reverse grep {
- if (s/(installing package) .* (needs (?:.*) on the (.*) filesystem)/$1 $2/) {
- $parts{$3} ? 0 : ($parts{$3} = 1);
- } else { 1; }
- } reverse map { s|/mnt||; $_ } @probs;
-
- c::rpmdbClose($db);
- die "installation of rpms failed:\n ", join("\n ", @probs);
- }
- }; $@ and print OUTPUT "die:$@\n";
+ $error_msg and die $error_msg;
+ } else {
+ #- child process will run each transaction.
+ $SIG{SEGV} = sub { log::l("segmentation fault on transactions"); c::_exit(0) };
+ my $db;
+ eval {
+ close INPUT;
+ select((select(OUTPUT), $| = 1)[0]);
+ $db = c::rpmdbOpen($prefix) or die "error opening RPM database: ", c::rpmErrorString();
+ my $trans = c::rpmtransCreateSet($db, $prefix);
+ log::l("opened rpm database for transaction of ". scalar @transToInstall ." new packages, still $nb after that to do");
+
+ c::rpmtransAddPackage($trans, $_->[$HEADER], packageName($_), $isUpgrade && allowedToUpgrade(packageName($_)))
+ foreach @transToInstall;
+
+ c::rpmdepOrder($trans) or die "error ordering package list: " . c::rpmErrorString();
+ c::rpmtransSetScriptFd($trans, fileno LOG);
+
+ log::l("rpmRunTransactions start");
+ my @probs = c::rpmRunTransactions($trans, $callbackOpen,
+ sub { #- callbackClose
+ print OUTPUT "close:$_[0]\n"; },
+ sub { #- installCallback
+ print OUTPUT join(":", @_), "\n"; },
+ 1);
+ log::l("rpmRunTransactions done, now trying to close still opened fd");
+ install_any::getFile('XXX'); #- close still opened fd.
+
+ if (@probs) {
+ my %parts;
+ @probs = reverse grep {
+ if (s/(installing package) .* (needs (?:.*) on the (.*) filesystem)/$1 $2/) {
+ $parts{$3} ? 0 : ($parts{$3} = 1);
+ } else {
+ 1;
+ }
+ } reverse map { s|/mnt||; $_ } @probs;
- c::rpmdbClose($db);
- log::l("rpm database closed");
+ c::rpmdbClose($db);
+ die "installation of rpms failed:\n ", join("\n ", @probs);
+ }
+ }; $@ and print OUTPUT "die:$@\n";
- close OUTPUT;
- c::_exit(0);
+ c::rpmdbClose($db);
+ log::l("rpm database closed");
+
+ close OUTPUT;
+ c::_exit(0);
+ }
+
+ #- after enough retry, abort.
+ my @badPackages;
+ foreach (@transToInstall) {
+ if (!packageFlagInstalled($_) && $_->[$MEDIUM]{selected} && !exists($ignoreBadPkg{packageName($_)})) {
+ push @badPackages, $_;
+ } else {
+ packageFreeHeader($_);
+ }
+ }
+ @transToInstall = @badPackages;
+ $retry or last;
+
+ #- examine each package, check they have been installed accordingly.
+ if (@transToInstall) {
+ foreach (@transToInstall) {
+ log::l("bad package $_->[$FILE]");
+ }
+ log::l("retrying transaction on bad packages");
+ --$retry;
+ }
}
packageFreeHeader($_) foreach @transToInstall;
cleanHeaders($prefix);
- if (my @badpkgs = grep { !packageFlagInstalled($_) && $_->[$MEDIUM]{selected} && !exists($ignoreBadPkg{packageName($_)}) } @transToInstall) {
- foreach (@badpkgs) {
- log::l("bad package $_->[$FILE]");
+ if (@transToInstall) {
+ foreach (@transToInstall) {
+ log::l("bad package $_->[$FILE] unable to be installed");
packageSetFlagSelected($_, 0);
}
- cdie ("error installing package list: " . join(", ", map { $_->[$FILE] } @badpkgs));
+ cdie ("error installing package list: " . join(", ", map { $_->[$FILE] } @transToInstall));
}
} while ($nb > 0 && !$pkgs::cancel_install);