Changeset 17529 for gsdl/trunk/perllib/downloaders/WgetDownload.pm

Timestamp:

2008-10-13T21:55:51+13:00 (16 years ago)

Author:

ak19

Message:

Now WgetDownload.pm uses Sockets to communicate with GLI which launched it, to monitor for when GLI may tell it to prematurely terminate Wget. WgetDownload.pm still uses a signal handler (for SIGINT) to respond to the ctrl-c sent when this script is called frm the command prompt (via downloadfrom.pl).

File:

• gsdl/trunk/perllib/downloaders/WgetDownload.pm (modified) (6 diffs)

gsdl/trunk/perllib/downloaders/WgetDownload.pm

@@ -34 +34 @@
 use BaseDownload;
 use strict;
+use Cwd;
 use IPC::Open2;
-use Cwd;
+use IO::Select;
+use IO::Socket;
+
 
 sub BEGIN {
@@ -75 +78 @@
 
 
-# Declaring variables related to the wget child process so that the termination
-# signal handler for SIGTERM can close the streams and tidy up before ending
-# the child process.
+# Declaring file global variables related to the wget child process so that 
+# the termination signal handler for SIGTERM can close the streams and tidy
+# up before ending the child process.
 my $childpid;
 my($chld_out, $chld_in);
-
-# Handler called when this process is killed or abruptly ends due to receiving
-# one of the terminating signals that this handler is registered to deal with.
+my ($serverSocket, $read_set);
+
+# When this script is called from the command line, this handler will be called
+# if this process is killed or abruptly ends due to receiving one of the
+# terminating signals that this handler is registered to deal with.
 sub abrupt_end_handler {
     my $termination_signal = shift (@_);
-    {
-    if(defined $childpid) {
-        close($chld_out);
-        close($chld_in);
+    if(defined $childpid) {
+    close($chld_out);
+    close($chld_in);
     
-        # Send TERM signal to child process to terminate it. Sending the INT signal didn't work
-        # See http://perldoc.perl.org/perlipc.html#Signals 
-        # Warning on using kill at http://perldoc.perl.org/perlfork.html
-        kill("TERM", $childpid); 
-    }
-    }
+    #print STDOUT "Received termination signal: $termination_signal\n";
+
+    # Send TERM signal to child process to terminate it. Sending the INT signal doesn't work
+    # See http://perldoc.perl.org/perlipc.html#Signals 
+    # Warning on using kill at http://perldoc.perl.org/perlfork.html
+    kill("TERM", $childpid); 
+
+    # If the SIGTERM sent on Linux calls this handler, we want to make
+    # sure any socket connection is closed.
+    # Otherwise sockets are only used when this script is run from GLI
+    # in which case the handlers don't really get called.
+    if(defined $serverSocket) {
+        $read_set->remove($serverSocket) if defined $read_set;
+        close($serverSocket);
+    }
+    }
+
     exit(0);
 }
@@ -162 +177 @@
     ($self->{'proxy_on'}) || &error("checkProxySetup","The proxy is not on? How could that be happening?");
     # Setup .wgetrc by using $self->{'proxy_host'} and $self->{'proxy_port'}
-    # Test if the connection is succeful. If the connection wasn't succeful then ask user to supply username and password.
+    # Test if the connection is successful. If the connection wasn't successful then ask user to supply username and password.
 
 }
@@ -168 +183 @@
 sub useWget
 {
+    #local $| = 1; # autoflush stdout buffer
+    #print STDOUT "*** Start of subroutine useWget in $0\n";
+
     my ($self, $cmdWget,$blnShow, $working_dir) = @_;
 
@@ -179 +197 @@
     $changed_dir = 1;
     }
+
+    # When we are running this script through GLI, the SIGTERM signal handler 
+    # won't get called on Windows when wget is to be prematurely terminated. 
+    # Instead, when wget has to be terminated in the middle of execution, GLI will
+    # connect to a serverSocket here to communicate when it's time to stop wget.
+    my $port;
+    if(defined $self->{'gli'} && $self->{'gli'}) {
+
+    $port = <STDIN>; # gets a port on localhost that's not yet in use
+    chomp($port);
+    
+    $serverSocket = IO::Socket::INET->new( Proto     => 'tcp',
+                           LocalPort => $port,
+                           Listen    => 1,
+                           Reuse     => 1);
+    
+    die "can't setup server" unless $serverSocket;
+    #print STDOUT "[Serversocket $0 accepting clients at port $port]\n";
+
+    $read_set = new IO::Select();         # create handle set for reading
+    $read_set->add($serverSocket);        # add the main socket to the set
+    }
+
     my $wget_file_path = &util::filename_cat($ENV{'GSDLHOME'}, "bin", $ENV{'GSDLOS'}, "wget");
-    #$command = "\"$wget_file_path\" $cmdWget |";    #open(*WIN,$command) || die "wget request failed: $!\n";
-    #open(*WIN,$command) || die "wget request failed: $!\n";    
-
-
-    $command = "\"$wget_file_path\" $cmdWget";
+    $command = "\"$wget_file_path\" $cmdWget 2>&1";
+    # print STDERR "Command is: $command\n";
     $childpid = open2($chld_out, $chld_in, $command) || die "wget request failed: $!\n";
 
-    while (defined($strLine=<$chld_out>)) # we're reading in from child process' stdout
-    {
-    if($blnShow)
+    my $loop = 1;
+    while($loop)
+    {
+    if (defined(my $strLine=<$chld_out>)) { # we're reading in from child process' stdout
+        if($blnShow) {
+        print STDERR "$strLine\n";
+        }
+        $strReadIn .= $strLine;
+    } 
+    else { # wget finished, terminate naturally
+        print STDERR "\nPerl: open2 command, input stream closed. Wget terminated naturally.\n";
+        close($chld_in);
+        close($chld_out);
+        waitpid $childpid, 0;
+        $loop = 0;
+        
+        $childpid = undef;
+        if(defined $port) {
+        $read_set->remove($serverSocket);
+        close($serverSocket);
+        }
+    }
+
+    # if we run this script from the command-line (as opposed to from GLI), 
+    # then we're not working with sockets and can therefore can skip the next bits
+    next unless(defined $port);
+
+    # http://www.perlfect.com/articles/select.shtml
+    # "multiplex between several filehandles within a single thread of control, 
+    # thus creating the effect of parallelism in the handling of I/O."
+    my @rh_set = $read_set->can_read(0.002); # every 2 ms check if there's a client socket connecting
+
+    # take all readable handles in turn
+    foreach my $rh (@rh_set) {
+        if($rh == $serverSocket) {
+        my $client = $rh->accept();
+        #$client->autoflush(1); # autoflush output buffer - don't put this back in: output split irregularly over lines
+        print $client "Talked to ServerSocket (port $port). Connection accepted\n";
+        
+        # Read from the client (getting rid of trailing newline)
+        # Has the client sent the <<STOP>> signal?
+        my $signal = <$client>;
+        chomp($signal); 
+        if($signal eq "<<STOP>>") {
+            print $client "Perl received STOP signal (on port $port): stopping wget\n";
+            
+            $loop = 0;
+            close($chld_in);
+            close($chld_out);
+            kill("TERM", $childpid);
+            
+            $childpid = undef;
+
+            # Stop monitoring the read_handle
+            # close the serverSocket (the Java end will close the client socket that Java opened)
+            $read_set->remove($rh); #$read_set->remove($serverSocket);
+            close($rh);         #close($serverSocket);
+            #print $client "Perl is about to exit\n";
+            last;
+        }
+        }
+    }
+    }
+
+    if ($changed_dir) {
+    chdir $current_dir;
+    }
+    
+    return $strReadIn;
+}
+
+
+sub useWgetMonitored
+{
+    my ($self, $cmdWget,$blnShow, $working_dir) = @_;
+
+
+    my $current_dir = cwd();
+    my $changed_dir = 0;
+    if (defined $working_dir && -e $working_dir) {
+    chdir "$working_dir";
+    $changed_dir = 1;
+    }
+    my $wget_file_path = &util::filename_cat($ENV{'GSDLHOME'}, "bin", $ENV{'GSDLOS'}, "wget");
+    #my $command = "\"$wget_file_path\" $cmdWget 2>&1 |"; #open(*WIN,$command) || die "wget request failed: $!\n";
+###    print STDERR "**** wget cmd = $command\n";
+    #open(*WIN,$command) || die "wget request failed: $!\n";
+
+    my $command = "\"$wget_file_path\" $cmdWget";
+    $childpid = open2($chld_out, $chld_in, $command) || die "wget request failed: $!\n";
+
+    my $full_text = "";
+    my $error_text = "";
+    my @follow_list = ();
+    my $line;
+
+    while (defined($line=<$chld_out>)) # we're reading in from child process' stdout
+    {
+    if((defined $blnShow) && $blnShow)
     {
-        print STDERR "$strReadIn\n";
-    }
-
-    $strReadIn .= $strLine;
-    }
-    
+        print STDERR "$line";
+    }
+
+    if ($line =~ m/^Location:\s*(.*?)\s*\[following\]\s*$/i) {
+        my $follow_url = $1;
+        push(@follow_list,$follow_url);
+    }
+
+    if ($line =~ m/ERROR\s+\d+/) {
+        $error_text .= $line;
+    }
+
+    $full_text .= $line;
+    }
+
     close($chld_in);
     close($chld_out);
-    
+
     # Program terminates only when the following line is included 
     # http://perldoc.perl.org/IPC/Open2.html explains why this is necessary
@@ -207 +350 @@
     waitpid $childpid, 0;
 
-    if ($changed_dir) {
-    chdir $current_dir;
-    }
-    
-    return $strReadIn;
-}
-
-
-sub useWgetMonitored
-{
-    my ($self, $cmdWget,$blnShow, $working_dir) = @_;
-
-
-    my $current_dir = cwd();
-    my $changed_dir = 0;
-    if (defined $working_dir && -e $working_dir) {
-    chdir "$working_dir";
-    $changed_dir = 1;
-    }
-    my $wget_file_path = &util::filename_cat($ENV{'GSDLHOME'}, "bin", $ENV{'GSDLOS'}, "wget");
-    #my $command = "\"$wget_file_path\" $cmdWget 2>&1 |"; #open(*WIN,$command) || die "wget request failed: $!\n";
-###    print STDERR "**** wget cmd = $command\n";
-    #open(*WIN,$command) || die "wget request failed: $!\n";
-
-    my $command = "\"$wget_file_path\" $cmdWget";
-    $childpid = open2($chld_out, $chld_in, $command) || die "wget request failed: $!\n";
-
-    my $full_text = "";
-    my $error_text = "";
-    my @follow_list = ();
-    my $line;
-
-    while (defined($line=<$chld_out>)) # we're reading in from child process' stdout
-    {
-    if((defined $blnShow) && $blnShow)
-    {
-        print STDERR "$line";
-    }
-
-    if ($line =~ m/^Location:\s*(.*?)\s*\[following\]\s*$/i) {
-        my $follow_url = $1;
-        push(@follow_list,$follow_url);
-    }
-
-    if ($line =~ m/ERROR\s+\d+/) {
-        $error_text .= $line;
-    }
-
-    $full_text .= $line;
-    }
-
-    close($chld_in);
-    close($chld_out);
-
-    # Program terminates only when the following line is included 
-    # http://perldoc.perl.org/IPC/Open2.html explains why this is necessary
-    # it prevents the child from turning into a "zombie process".
-    # While the wget process terminates without it, this perl script does not: 
-    # the DOS prompt is not returned without it.
-    waitpid $childpid, 0;
-
     my $command_status = $?;
     if ($command_status != 0) {