From f178a0b654b57e5eb443cee76cd3170bfef0bc4a Mon Sep 17 00:00:00 2001
From: Francois Pons <fpons@mandriva.com>
Date: Wed, 7 Feb 2001 10:45:52 +0000
Subject: now fully fixed ftp connection (and http too) caused by forked DrakX
 with latent ftp connection.

---
 perl-install/ftp.pm  |  4 ++--
 perl-install/http.pm |  1 +
 perl-install/pkgs.pm | 20 ++++++++++----------
 3 files changed, 13 insertions(+), 12 deletions(-)

(limited to 'perl-install')

diff --git a/perl-install/ftp.pm b/perl-install/ftp.pm
index b21058c30..7784bb529 100644
--- a/perl-install/ftp.pm
+++ b/perl-install/ftp.pm
@@ -50,14 +50,14 @@ sub new {
 
 sub getFile {
     my ($f, @para) = @_;
+    $f eq 'XXX' and rewindGetFile(), return; #- special case to force closing connection.
     foreach (1..3) {
 	my ($ftp, $retr) = new(@para ? @para : fromEnv);
 	$$retr->close if $$retr;
-	$f eq 'XXX' and return; #- special case to force closing connection on CD, really necessary here!
 	$$retr = $ftp->retr($f) and return $$retr;
 	rewindGetFile();
 	log::l("ftp get failed, sleeping before trying again");
-	sleep 2;
+	sleep 1;
     }
 }
 
diff --git a/perl-install/http.pm b/perl-install/http.pm
index eb8ca0a09..5c8408478 100644
--- a/perl-install/http.pm
+++ b/perl-install/http.pm
@@ -16,6 +16,7 @@ sub getFile {
     $path .= "/$_[0]";
 
     $sock->close if $sock;
+    $_[0] eq 'XXX' and return; #- force closing connection.
     $sock = IO::Socket::INET->new(PeerAddr => $host,
 				  PeerPort => $port || 80,
 				  Proto    => 'tcp',
diff --git a/perl-install/pkgs.pm b/perl-install/pkgs.pm
index 0baccea9e..a9af7f72d 100644
--- a/perl-install/pkgs.pm
+++ b/perl-install/pkgs.pm
@@ -394,6 +394,7 @@ sub psUsingHdlist {
     $packages->{mediums}{$medium} and return;
 
     my $m = $packages->{mediums}{$medium} = { hdlist     => $hdlist,
+					      method     => $method,
 					      medium     => $medium,
 					      rpmsdir    => $rpmsdir, #- where is RPMS directory.
 					      descr      => $descr,
@@ -1196,17 +1197,15 @@ sub install($$$;$$) {
 	#- extract headers for parent as they are used by callback.
 	extractHeaders($prefix, \@transToInstall, $media->{$medium});
 
-	#- reset file descriptor open for main process but
-	#- make sure error trying to change from hdlist are
-	#- trown from main process too.
-	install_any::getFile(packageFile($transToInstall[0]), $transToInstall[0][$MEDIUM]{descr});
-	#- and make sure there are no staling open file descriptor too!
+	if ($media->{$medium}{method} eq 'cdrom') {
+	    #- reset file descriptor open for main process but
+	    #- make sure error trying to change from hdlist are
+	    #- trown from main process too.
+	    install_any::getFile(packageFile($transToInstall[0]), $transToInstall[0][$MEDIUM]{descr});
+	}
+	#- and make sure there are no staling open file descriptor too (before forking)!
 	install_any::getFile('XXX');
 
-	#- reset ftp handlers before forking, otherwise well ;-(
-	#require ftp;
-	#ftp::rewindGetFile();
-
 	local (*INPUT, *OUTPUT); pipe INPUT, OUTPUT;
 	if (my $pid = fork()) {
 	    close OUTPUT;
@@ -1254,7 +1253,8 @@ sub install($$$;$$) {
 						  sub { #- installCallback
 						      print OUTPUT join(":", @_), "\n"; },
 						  1);
-		log::l("rpmRunTransactions done");
+		log::l("rpmRunTransactions done, now trying to close still opened fd");
+		install_any::getFile('XXX'); #- close still opened fd.
 
 		if (@probs) {
 		    my %parts;
-- 
cgit v1.2.1