don't fork anymore to install rpms

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;