Changeset 17537

Show
Ignore:
Timestamp:
15.10.2008 12:41:28 (11 years ago)
Author:
ak19
Message:

Subroutine useWgetMonitored updated to include the modifications made recently to subroutine useWget: uses a serverSocket to monitor any signals from GLI indicating that wget should be prematurely terminated.

Files:
1 modified

Legend:

Unmodified
Added
Removed
  • gsdl/trunk/perllib/downloaders/WgetDownload.pm

    r17531 r17537  
    304304sub useWgetMonitored 
    305305{ 
     306    #local $| = 1; # autoflush stdout buffer 
     307    #print STDOUT "*** Start of subroutine useWgetMonitored in $0\n"; 
     308 
    306309    my ($self, $cmdWget,$blnShow, $working_dir) = @_; 
    307310 
     
    313316    $changed_dir = 1; 
    314317    } 
     318 
     319    # When we are running this script through GLI, the SIGTERM signal handler  
     320    # won't get called on Windows when wget is to be prematurely terminated.  
     321    # Instead, when wget has to be terminated in the middle of execution, GLI will 
     322    # connect to a serverSocket here to communicate when it's time to stop wget. 
     323    if(defined $self->{'gli'} && $self->{'gli'} && !defined $port) { 
     324 
     325    $port = <STDIN>; # gets a port on localhost that's not yet in use 
     326    chomp($port); 
     327     
     328    $serverSocket = IO::Socket::INET->new( Proto     => 'tcp', 
     329                           LocalPort => $port, 
     330                           Listen    => 1, 
     331                           Reuse     => 1); 
     332     
     333    die "can't setup server" unless $serverSocket; 
     334    #print STDOUT "[Serversocket $0 accepting clients at port $port]\n"; 
     335 
     336    $read_set = new IO::Select();         # create handle set for reading 
     337    $read_set->add($serverSocket);        # add the main socket to the set 
     338    } 
     339 
    315340    my $wget_file_path = &util::filename_cat($ENV{'GSDLHOME'}, "bin", $ENV{'GSDLOS'}, "wget"); 
    316341    #my $command = "\"$wget_file_path\" $cmdWget 2>&1 |"; #open(*WIN,$command) || die "wget request failed: $!\n"; 
    317 ###    print STDERR "**** wget cmd = $command\n"; 
    318     #open(*WIN,$command) || die "wget request failed: $!\n"; 
    319  
    320     my $command = "\"$wget_file_path\" $cmdWget"; 
     342    my $command = "\"$wget_file_path\" $cmdWget 2>&1"; 
     343    # print STDERR "Command is: $command\n"; 
    321344    $childpid = open2($chld_out, $chld_in, $command) || die "wget request failed: $!\n"; 
    322345 
     
    326349    my $line; 
    327350 
    328     while (defined($line=<$chld_out>)) # we're reading in from child process' stdout 
    329     { 
    330     if((defined $blnShow) && $blnShow) 
    331     { 
    332         print STDERR "$line"; 
    333     } 
    334  
    335     if ($line =~ m/^Location:\s*(.*?)\s*\[following\]\s*$/i) { 
    336         my $follow_url = $1; 
    337         push(@follow_list,$follow_url); 
    338     } 
    339  
    340     if ($line =~ m/ERROR\s+\d+/) { 
    341         $error_text .= $line; 
    342     } 
    343  
    344     $full_text .= $line; 
    345     } 
    346  
    347     close($chld_in); 
    348     close($chld_out); 
    349  
    350     # Program terminates only when the following line is included  
    351     # http://perldoc.perl.org/IPC/Open2.html explains why this is necessary 
    352     # it prevents the child from turning into a "zombie process". 
    353     # While the wget process terminates without it, this perl script does not:  
    354     # the DOS prompt is not returned without it. 
    355     waitpid $childpid, 0; 
     351    my $loop = 1; 
     352    while($loop) 
     353    { 
     354    if (defined($line=<$chld_out>)) { # we're reading in from child process' stdout 
     355        if((defined $blnShow) && $blnShow) 
     356        { 
     357        print STDERR "$line"; 
     358        } 
     359         
     360        if ($line =~ m/^Location:\s*(.*?)\s*\[following\]\s*$/i) { 
     361        my $follow_url = $1; 
     362        push(@follow_list,$follow_url); 
     363        } 
     364         
     365        if ($line =~ m/ERROR\s+\d+/) { 
     366        $error_text .= $line; 
     367        } 
     368         
     369        $full_text .= $line; 
     370    }  
     371    else { # wget finished, terminate naturally 
     372        #print STDERR "\nPerl: open2 command, input stream closed. Wget terminated naturally.\n"; 
     373        close($chld_in); 
     374        close($chld_out); 
     375        # Program terminates only when the following line is included  
     376        # http://perldoc.perl.org/IPC/Open2.html explains why this is necessary 
     377        # it prevents the child from turning into a "zombie process". 
     378        # While the wget process terminates without it, this perl script does not:  
     379        # the DOS prompt is not returned without it. 
     380        waitpid $childpid, 0; 
     381        $loop = 0; 
     382         
     383        $childpid = undef; 
     384        if(defined $port) { 
     385        $read_set->remove($serverSocket); 
     386        close($serverSocket); 
     387        } 
     388    } 
     389 
     390    # if we run this script from the command-line (as opposed to from GLI),  
     391    # then we're not working with sockets and can therefore can skip the next bits 
     392    next unless(defined $port); 
     393 
     394    # http://www.perlfect.com/articles/select.shtml 
     395    # "multiplex between several filehandles within a single thread of control,  
     396    # thus creating the effect of parallelism in the handling of I/O." 
     397    my @rh_set = $read_set->can_read(0.002); # every 2 ms check if there's a client socket connecting 
     398 
     399    # take all readable handles in turn 
     400    foreach my $rh (@rh_set) { 
     401        if($rh == $serverSocket) { 
     402        my $client = $rh->accept(); 
     403        #$client->autoflush(1); # autoflush output buffer - don't put this back in: splits output irregularly over multilines 
     404        print $client "Talked to ServerSocket (port $port). Connection accepted\n"; 
     405         
     406        # Read from the client (getting rid of trailing newline) 
     407        # Has the client sent the <<STOP>> signal? 
     408        my $signal = <$client>; 
     409        chomp($signal);  
     410        if($signal eq "<<STOP>>") { 
     411            print $client "Perl received STOP signal (on port $port): stopping wget\n"; 
     412             
     413            $loop = 0; 
     414            close($chld_in); 
     415            close($chld_out); 
     416            kill("TERM", $childpid); 
     417             
     418            $childpid = undef; 
     419 
     420            # Stop monitoring the read_handle 
     421            # close the serverSocket (the Java end will close the client socket that Java opened) 
     422            $read_set->remove($rh); #$read_set->remove($serverSocket); 
     423            close($rh);         #close($serverSocket); 
     424            #print $client "Perl is about to exit\n"; 
     425            last; 
     426        } 
     427        } 
     428    } 
     429    } 
    356430 
    357431    my $command_status = $?;