Ignore:
Timestamp:
2008-10-13T21:55:51+13:00 (13 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:
1 edited

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) {
Note: See TracChangeset for help on using the changeset viewer.