summaryrefslogtreecommitdiffstats
path: root/perl-install
diff options
context:
space:
mode:
Diffstat (limited to 'perl-install')
-rw-r--r--perl-install/install_steps_gtk.pm5
-rw-r--r--perl-install/pkgs.pm96
2 files changed, 28 insertions, 73 deletions
diff --git a/perl-install/install_steps_gtk.pm b/perl-install/install_steps_gtk.pm
index 34787a591..46ac85247 100644
--- a/perl-install/install_steps_gtk.pm
+++ b/perl-install/install_steps_gtk.pm
@@ -439,7 +439,7 @@ sub installPackages {
ugtk2::gtkadd($w->{window}, my $box = gtknew('VBox', spacing => 10));
my $advertize = sub {
- my ($update) = @_;
+ my ($update, $o_chroot_dir) = @_;
@install_any::advertising_images or return;
foreach ($msg, $progress, $text) {
$show_advertising ? $_->hide : $_->show;
@@ -449,6 +449,7 @@ sub installPackages {
if ($show_advertising && $update) {
$change_time = time();
my $f = $install_any::advertising_images[$i++ % @install_any::advertising_images];
+ $f =~ s/\Q$o_chroot_dir// if $o_chroot_dir;
log::l("advertising $f");
my $pl = $f; $pl =~ s/\.png$/.pl/;
my $icon_name = $f; $icon_name =~ s/\.png$/_icon.png/;
@@ -522,7 +523,7 @@ sub installPackages {
$current_total_size += $last_size;
$last_size = $p->size;
gtkset($text, text => (split /\n/, c::from_utf8($p->summary))[0] || '');
- $advertize->(1) if $show_advertising && $total_size > 20_000_000 && time() - $change_time > 20;
+ $advertize->(1, $::prefix) if $show_advertising && $total_size > 20_000_000 && time() - $change_time > 20;
$w->flush;
} elsif ($type eq 'inst' && $subtype eq 'progress') {
$progress->set_fraction($total ? $amount / $total : 0);
diff --git a/perl-install/pkgs.pm b/perl-install/pkgs.pm
index 310d3d76f..2a5e07958 100644
--- a/perl-install/pkgs.pm
+++ b/perl-install/pkgs.pm
@@ -1084,55 +1084,34 @@ sub install {
#- extract headers for parent as they are used by callback.
extractHeaders(\@transToInstall, $packages->{mediums});
+ my $close = sub {
+ my ($pkg) = @_;
+ #- update flag associated to package.
+ $pkg->set_flag_installed(1);
+ $pkg->set_flag_upgrade(0);
+ #- update obsoleted entry.
+ my $rejected = $packages->{state}{rejected};
+ foreach (keys %$rejected) {
+ if (delete $rejected->{$_}{closure}{$pkg->fullname}) {
+ %{$rejected->{$_}{closure}} or delete $rejected->{$_};
+ }
+ }
+ };
+
my ($retry_pkg, $retry_count);
while ($retry_pkg || @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 {
- chomp;
- my @params = split ":";
- if ($params[0] eq 'close') {
- my $pkg = $packages->{depslist}[$params[1]];
- #- update flag associated to package.
- $pkg->set_flag_installed(1);
- $pkg->set_flag_upgrade(0);
- #- update obsoleted entry.
- foreach (keys %{$packages->{state}{rejected}}) {
- if (exists $packages->{state}{rejected}{$_}{closure}{$pkg->fullname}) {
- delete $packages->{state}{rejected}{$_}{closure}{$pkg->fullname};
- %{$packages->{state}{rejected}{$_}{closure}} or delete $packages->{state}{rejected}{$_};
- }
- }
- } else {
- installCallback($packages, @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 @prev_pids = grep { /^\d+$/ } all("/proc");
- close INPUT;
- select((select(OUTPUT), $| = 1)[0]);
if ($::testing) {
my $size_typical = $nb ? int($total/$nb) : 0;
foreach (@transToInstall) {
log::l("i would install ", $_->name, " now");
my $id = $_->id;
- print OUTPUT "inst:$id:start:0:$size_typical\ninst:$id:progress:0:$size_typical\nclose:$id\n";
+ installCallback($packages, inst => $id, start => 0, $size_typical);
+ installCallback($packages, inst => $id, progress => 0, $size_typical);
+ $close->($_);
}
- } else { eval {
+ } else {
my $db = rpmDbOpenForInstall() or die "error opening RPM database: ", URPM::rpmErrorString();
my $trans = $db->create_transaction($::prefix);
if ($retry_pkg) {
@@ -1173,32 +1152,22 @@ sub install {
$check_installed ||= $pkg->compare_pkg($p) == 0;
});
$check_installed or log::l($pkg->name . " not installed, " . URPM::rpmErrorString());
- $check_installed and print OUTPUT "close:$id\n";
- }, callback_inst => sub {
- my ($_data, $type, $id, $subtype, $amount, $total) = @_;
- print OUTPUT "$type:$id:$subtype:$amount:$total\n";
- });
+ $check_installed and $close->($pkg);
+ }, callback_inst => \&installCallback,
+ );
log::l("transactions done, now trying to close still opened fd");
install_any::getFile('XXX'); #- close still opened fd.
@probs and die "installation of rpms failed:\n ", join("\n ", @probs);
- }; $@ and print OUTPUT "die:$@\n" }
- close OUTPUT;
+ }
#- now search for child process which may be locking the cdrom, making it unable to be ejected.
my @allpids = grep { /^\d+$/ } all("/proc");
- my %ppids;
- foreach (@allpids) {
- push @{$ppids{$1 || 1}}, $_
- if cat_("/proc/$_/status") =~ /^PPid:\s+(\d+)/m;
- }
- my @killpid = difference2(\@allpids, [ @prev_pids,
- difference2([ $$, hashtree2list(getppid(), \%ppids) ],
- [ hashtree2list($$, \%ppids) ]) ]);
+ my @killpid = difference2(\@allpids, \@prev_pids);
if (@killpid && $::isInstall && !$::local_install && !$::build_globetrotter) {
foreach (@killpid) {
- my ($prog, @para) = split("\0", cat_("/proc/$_/cmdline"));
+ my ($prog, @para) = split("\0", cat_("/proc/$_/cmdline") || readlink("/proc/$_/exe"));
log::l("ERROR: DrakX should not have to clean the packages shit. Killing $_: " . join(' ', $prog, @para) . ".") if $prog ne '/usr/lib/gconfd-2';
}
kill 15, @killpid;
@@ -1206,9 +1175,6 @@ sub install {
kill 9, @killpid;
}
- c::_exit(0);
- }
-
#- if we are using a retry mode, this means we have to split the transaction with only
#- one package for each real transaction.
if (!$retry_pkg) {
@@ -1418,18 +1384,6 @@ sub naughtyServers {
} naughtyServers_list('quiet');
}
-sub hashtree2list {
- my ($e, $h) = @_;
- my @l;
- my @todo = $e;
- while (@todo) {
- my $e = shift @todo;
- push @l, $e;
- push @todo, @{$h->{$e} || []};
- }
- @l;
-}
-
package install_medium;
use strict;