Changeset 17529

Show
Ignore:
Timestamp:
13.10.2008 21:55:51 (11 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).

Files:
1 modified

Legend:

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

    r17354 r17529  
    3434use BaseDownload; 
    3535use strict; 
     36use Cwd; 
    3637use IPC::Open2; 
    37 use Cwd; 
     38use IO::Select; 
     39use IO::Socket; 
     40 
    3841 
    3942sub BEGIN { 
     
    7578 
    7679 
    77 # Declaring variables related to the wget child process so that the termination 
    78 # signal handler for SIGTERM can close the streams and tidy up before ending 
    79 # the child process. 
     80# Declaring file global variables related to the wget child process so that  
     81# the termination signal handler for SIGTERM can close the streams and tidy 
     82# up before ending the child process. 
    8083my $childpid; 
    8184my($chld_out, $chld_in); 
    82  
    83 # Handler called when this process is killed or abruptly ends due to receiving 
    84 # one of the terminating signals that this handler is registered to deal with. 
     85my ($serverSocket, $read_set); 
     86 
     87# When this script is called from the command line, this handler will be called 
     88# if this process is killed or abruptly ends due to receiving one of the 
     89# terminating signals that this handler is registered to deal with. 
    8590sub abrupt_end_handler { 
    8691    my $termination_signal = shift (@_); 
    87     { 
    88     if(defined $childpid) { 
    89         close($chld_out); 
    90         close($chld_in); 
     92    if(defined $childpid) { 
     93    close($chld_out); 
     94    close($chld_in); 
    9195     
    92         # Send TERM signal to child process to terminate it. Sending the INT signal didn't work 
    93         # See http://perldoc.perl.org/perlipc.html#Signals  
    94         # Warning on using kill at http://perldoc.perl.org/perlfork.html 
    95         kill("TERM", $childpid);  
    96     } 
    97     } 
     96    #print STDOUT "Received termination signal: $termination_signal\n"; 
     97 
     98    # Send TERM signal to child process to terminate it. Sending the INT signal doesn't work 
     99    # See http://perldoc.perl.org/perlipc.html#Signals  
     100    # Warning on using kill at http://perldoc.perl.org/perlfork.html 
     101    kill("TERM", $childpid);  
     102 
     103    # If the SIGTERM sent on Linux calls this handler, we want to make 
     104    # sure any socket connection is closed. 
     105    # Otherwise sockets are only used when this script is run from GLI 
     106    # in which case the handlers don't really get called. 
     107    if(defined $serverSocket) { 
     108        $read_set->remove($serverSocket) if defined $read_set; 
     109        close($serverSocket); 
     110    } 
     111    } 
     112 
    98113    exit(0); 
    99114} 
     
    162177    ($self->{'proxy_on'}) || &error("checkProxySetup","The proxy is not on? How could that be happening?"); 
    163178    # Setup .wgetrc by using $self->{'proxy_host'} and $self->{'proxy_port'} 
    164     # Test if the connection is succeful. If the connection wasn't succeful then ask user to supply username and password. 
     179    # Test if the connection is successful. If the connection wasn't successful then ask user to supply username and password. 
    165180 
    166181} 
     
    168183sub useWget 
    169184{ 
     185    #local $| = 1; # autoflush stdout buffer 
     186    #print STDOUT "*** Start of subroutine useWget in $0\n"; 
     187 
    170188    my ($self, $cmdWget,$blnShow, $working_dir) = @_; 
    171189 
     
    179197    $changed_dir = 1; 
    180198    } 
     199 
     200    # When we are running this script through GLI, the SIGTERM signal handler  
     201    # won't get called on Windows when wget is to be prematurely terminated.  
     202    # Instead, when wget has to be terminated in the middle of execution, GLI will 
     203    # connect to a serverSocket here to communicate when it's time to stop wget. 
     204    my $port; 
     205    if(defined $self->{'gli'} && $self->{'gli'}) { 
     206 
     207    $port = <STDIN>; # gets a port on localhost that's not yet in use 
     208    chomp($port); 
     209     
     210    $serverSocket = IO::Socket::INET->new( Proto     => 'tcp', 
     211                           LocalPort => $port, 
     212                           Listen    => 1, 
     213                           Reuse     => 1); 
     214     
     215    die "can't setup server" unless $serverSocket; 
     216    #print STDOUT "[Serversocket $0 accepting clients at port $port]\n"; 
     217 
     218    $read_set = new IO::Select();         # create handle set for reading 
     219    $read_set->add($serverSocket);        # add the main socket to the set 
     220    } 
     221 
    181222    my $wget_file_path = &util::filename_cat($ENV{'GSDLHOME'}, "bin", $ENV{'GSDLOS'}, "wget"); 
    182     #$command = "\"$wget_file_path\" $cmdWget |";    #open(*WIN,$command) || die "wget request failed: $!\n"; 
    183     #open(*WIN,$command) || die "wget request failed: $!\n";     
    184  
    185  
    186     $command = "\"$wget_file_path\" $cmdWget"; 
     223    $command = "\"$wget_file_path\" $cmdWget 2>&1"; 
     224    # print STDERR "Command is: $command\n"; 
    187225    $childpid = open2($chld_out, $chld_in, $command) || die "wget request failed: $!\n"; 
    188226 
    189     while (defined($strLine=<$chld_out>)) # we're reading in from child process' stdout 
    190     { 
    191     if($blnShow) 
     227    my $loop = 1; 
     228    while($loop) 
     229    { 
     230    if (defined(my $strLine=<$chld_out>)) { # we're reading in from child process' stdout 
     231        if($blnShow) { 
     232        print STDERR "$strLine\n"; 
     233        } 
     234        $strReadIn .= $strLine; 
     235    }  
     236    else { # wget finished, terminate naturally 
     237        print STDERR "\nPerl: open2 command, input stream closed. Wget terminated naturally.\n"; 
     238        close($chld_in); 
     239        close($chld_out); 
     240        waitpid $childpid, 0; 
     241        $loop = 0; 
     242         
     243        $childpid = undef; 
     244        if(defined $port) { 
     245        $read_set->remove($serverSocket); 
     246        close($serverSocket); 
     247        } 
     248    } 
     249 
     250    # if we run this script from the command-line (as opposed to from GLI),  
     251    # then we're not working with sockets and can therefore can skip the next bits 
     252    next unless(defined $port); 
     253 
     254    # http://www.perlfect.com/articles/select.shtml 
     255    # "multiplex between several filehandles within a single thread of control,  
     256    # thus creating the effect of parallelism in the handling of I/O." 
     257    my @rh_set = $read_set->can_read(0.002); # every 2 ms check if there's a client socket connecting 
     258 
     259    # take all readable handles in turn 
     260    foreach my $rh (@rh_set) { 
     261        if($rh == $serverSocket) { 
     262        my $client = $rh->accept(); 
     263        #$client->autoflush(1); # autoflush output buffer - don't put this back in: output split irregularly over lines 
     264        print $client "Talked to ServerSocket (port $port). Connection accepted\n"; 
     265         
     266        # Read from the client (getting rid of trailing newline) 
     267        # Has the client sent the <<STOP>> signal? 
     268        my $signal = <$client>; 
     269        chomp($signal);  
     270        if($signal eq "<<STOP>>") { 
     271            print $client "Perl received STOP signal (on port $port): stopping wget\n"; 
     272             
     273            $loop = 0; 
     274            close($chld_in); 
     275            close($chld_out); 
     276            kill("TERM", $childpid); 
     277             
     278            $childpid = undef; 
     279 
     280            # Stop monitoring the read_handle 
     281            # close the serverSocket (the Java end will close the client socket that Java opened) 
     282            $read_set->remove($rh); #$read_set->remove($serverSocket); 
     283            close($rh);         #close($serverSocket); 
     284            #print $client "Perl is about to exit\n"; 
     285            last; 
     286        } 
     287        } 
     288    } 
     289    } 
     290 
     291    if ($changed_dir) { 
     292    chdir $current_dir; 
     293    } 
     294     
     295    return $strReadIn; 
     296} 
     297 
     298 
     299sub useWgetMonitored 
     300{ 
     301    my ($self, $cmdWget,$blnShow, $working_dir) = @_; 
     302 
     303 
     304    my $current_dir = cwd(); 
     305    my $changed_dir = 0; 
     306    if (defined $working_dir && -e $working_dir) { 
     307    chdir "$working_dir"; 
     308    $changed_dir = 1; 
     309    } 
     310    my $wget_file_path = &util::filename_cat($ENV{'GSDLHOME'}, "bin", $ENV{'GSDLOS'}, "wget"); 
     311    #my $command = "\"$wget_file_path\" $cmdWget 2>&1 |"; #open(*WIN,$command) || die "wget request failed: $!\n"; 
     312###    print STDERR "**** wget cmd = $command\n"; 
     313    #open(*WIN,$command) || die "wget request failed: $!\n"; 
     314 
     315    my $command = "\"$wget_file_path\" $cmdWget"; 
     316    $childpid = open2($chld_out, $chld_in, $command) || die "wget request failed: $!\n"; 
     317 
     318    my $full_text = ""; 
     319    my $error_text = ""; 
     320    my @follow_list = (); 
     321    my $line; 
     322 
     323    while (defined($line=<$chld_out>)) # we're reading in from child process' stdout 
     324    { 
     325    if((defined $blnShow) && $blnShow) 
    192326    { 
    193         print STDERR "$strReadIn\n"; 
    194     } 
    195  
    196     $strReadIn .= $strLine; 
    197     } 
    198      
     327        print STDERR "$line"; 
     328    } 
     329 
     330    if ($line =~ m/^Location:\s*(.*?)\s*\[following\]\s*$/i) { 
     331        my $follow_url = $1; 
     332        push(@follow_list,$follow_url); 
     333    } 
     334 
     335    if ($line =~ m/ERROR\s+\d+/) { 
     336        $error_text .= $line; 
     337    } 
     338 
     339    $full_text .= $line; 
     340    } 
     341 
    199342    close($chld_in); 
    200343    close($chld_out); 
    201      
     344 
    202345    # Program terminates only when the following line is included  
    203346    # http://perldoc.perl.org/IPC/Open2.html explains why this is necessary 
     
    207350    waitpid $childpid, 0; 
    208351 
    209     if ($changed_dir) { 
    210     chdir $current_dir; 
    211     } 
    212      
    213     return $strReadIn; 
    214 } 
    215  
    216  
    217 sub useWgetMonitored 
    218 { 
    219     my ($self, $cmdWget,$blnShow, $working_dir) = @_; 
    220  
    221  
    222     my $current_dir = cwd(); 
    223     my $changed_dir = 0; 
    224     if (defined $working_dir && -e $working_dir) { 
    225     chdir "$working_dir"; 
    226     $changed_dir = 1; 
    227     } 
    228     my $wget_file_path = &util::filename_cat($ENV{'GSDLHOME'}, "bin", $ENV{'GSDLOS'}, "wget"); 
    229     #my $command = "\"$wget_file_path\" $cmdWget 2>&1 |"; #open(*WIN,$command) || die "wget request failed: $!\n"; 
    230 ###    print STDERR "**** wget cmd = $command\n"; 
    231     #open(*WIN,$command) || die "wget request failed: $!\n"; 
    232  
    233     my $command = "\"$wget_file_path\" $cmdWget"; 
    234     $childpid = open2($chld_out, $chld_in, $command) || die "wget request failed: $!\n"; 
    235  
    236     my $full_text = ""; 
    237     my $error_text = ""; 
    238     my @follow_list = (); 
    239     my $line; 
    240  
    241     while (defined($line=<$chld_out>)) # we're reading in from child process' stdout 
    242     { 
    243     if((defined $blnShow) && $blnShow) 
    244     { 
    245         print STDERR "$line"; 
    246     } 
    247  
    248     if ($line =~ m/^Location:\s*(.*?)\s*\[following\]\s*$/i) { 
    249         my $follow_url = $1; 
    250         push(@follow_list,$follow_url); 
    251     } 
    252  
    253     if ($line =~ m/ERROR\s+\d+/) { 
    254         $error_text .= $line; 
    255     } 
    256  
    257     $full_text .= $line; 
    258     } 
    259  
    260     close($chld_in); 
    261     close($chld_out); 
    262  
    263     # Program terminates only when the following line is included  
    264     # http://perldoc.perl.org/IPC/Open2.html explains why this is necessary 
    265     # it prevents the child from turning into a "zombie process". 
    266     # While the wget process terminates without it, this perl script does not:  
    267     # the DOS prompt is not returned without it. 
    268     waitpid $childpid, 0; 
    269  
    270352    my $command_status = $?; 
    271353    if ($command_status != 0) {