Ignore:
Timestamp:
2016-05-10T19:02:55+12:00 (8 years ago)
Author:
ak19
Message:

activate.pl going through servercontrol.pl now using wget instead of the perl libraries LWP, as these may not be available in all perl installations, whereas GS binaries include wget.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • main/trunk/greenstone2/perllib/servercontrol.pm

    r30524 r30526  
    3333no strict 'subs'; # allow barewords (eg STDERR) as function arguments
    3434
     35# Greenstone includes
     36use printusage;
     37use parse2;
     38
     39
     40# The perl library imports below are used by deprecated methods config_old(), is_URL_active() and pingHost()
     41# If the following library imports are not supported by your perl installation, comment out these
     42# imports and move the methods config_old(), is_URL_active() and pingHost() out to a temporary file.
    3543use HTTP::Response;
    3644use LWP::Simple qw($ua !head); # import useragent object as $ua from the full LWP to use along with LWP::Simple
    37         # don't import LWP::Simple's head function by name since it can conflict with CGI:head())           
     45        # don't import LWP::Simple's head function by name since it can conflict with CGI:head())
    3846#use CGI qw(:standard);  # then only CGI.pm defines a head()
    3947use Net::Ping;
    4048use URI;
    41 
    42 use printusage;
    43 use parse2;
    4449
    4550
     
    132137    }
    133138    else {
    134     $ua->timeout(5); # set LWP useragent to 5s max timeout for testing the URL
    135     # Need to set this, else it takes I don't know how long to timeout
    136     # http://www.perlmonks.org/?node_id=618534
    137    
    138     # http://search.cpan.org/~gaas/libwww-perl-6.04/lib/LWP/UserAgent.pm
    139     # use LWP::UserAgent's get($url) since it returns an HTTP::Response code
    140    
    141     my $response_obj = $ua->get($library_url.$command);
    142    
    143     # $response_obj->content stores the content and $response_obj->code the HTTP response code
    144     my $response_code = $response_obj->code();
    145    
    146     if(LWP::Simple::is_success($response_code)) {# $response_code eq RC_OK) { # LWP::Simple::is_success($response_code)
     139    # ampersands need to be escaped with single quotes
     140    my $wgetCommand = $command;
     141    $wgetCommand =~ s@&@'&'@g;
     142
     143    my $wget_file_path = &FileUtils::filenameConcatenate($ENV{'GSDLHOME'}, "bin", $ENV{'GSDLOS'}, "wget");
     144
     145    # https://www.gnu.org/software/wget/manual/wget.html
     146    # output-document set to - (STDOUT), so page is streamed to STDOUT
     147    # timeout: 5 seconds, tries: 1
     148    # wget sends status information and response code to STDERR, so redirect it to STDOUT
     149    # Searching for "perl backtick operator redirect stderr to stdout":
     150    # http://www.perlmonks.org/?node=How%20can%20I%20capture%20STDERR%20from%20an%20external%20command%3F
     151    $wgetCommand = "\"$wget_file_path\" --output-document=- -T 5 -t 1 $library_url$wgetCommand 2>&1";   
     152    #$wgetCommand = "\"$wget_file_path\" --spider -T 5 -t 1 $library_url$wgetCommand 2>&1"; # won't save page
     153    my $response_content = `$wgetCommand`;
     154    my $response_code = undef;
     155    my @lines = split( /\n/, $response_content );
     156    foreach my $line (@lines) {
     157        #print STDERR "@@@@ LINE: $line\n";
     158        if($line =~ m@failed: Connection timed out.$@) {
     159        $response_code = "failed: Connection timed out.";
     160        last; # break keyword in perl = last
     161        }
     162        elsif($line =~ m@failed: Connection refused.$@) {
     163        $response_code = "failed: Connection refused.";
     164        last; # break keyword in perl = last
     165        }
     166        elsif($line =~ m@HTTP request sent, @) {
     167        $response_code = $line;
     168        $response_code =~ s@[^\d]*(.*)$@$1@;
     169        last;
     170        }
     171    }
     172
     173    if($command =~ m@ping@ && $response_code =~ m@failed: Connection refused@) {
     174        # server not running
     175        $self->print_msg("*** Server not running. $library_url$command\n", 3);
     176        return 0;
     177    }
     178    if($response_code && $response_code eq "200 OK") {
    147179        $self->print_msg("*** Command $library_url$command\n", 3);
    148180        $self->print_msg("*** HTTP Response Status: $response_code - Complete.", 3);
    149181       
    150182        # check the page content is as expected
    151         my $response_content = $response_obj->content;
    152183        my $resultstr = $response_content;
    153184        $resultstr =~ s@.*gs_content\"\>@@s;       
    154185        $resultstr =~ s@</div>.*@@s;
    155        
    156         if($response_content =~ m/$check_message_against_regex/) {
     186        if($resultstr =~ m/$check_message_against_regex/) {
    157187        $self->print_msg(" Response as expected.\n", 3);
    158188        $self->print_msg("@@@@@@ Got result:\n$resultstr\n", 4);
     
    164194        # So we only suppress the ping col "did not succeed" response if we're in silent mode
    165195        # But if any message other than ping "did not succeed" is returned, we always print it
    166         if($response_content !~ m/did not succeed/ || !$silent) {
     196        if($resultstr !~ m/did not succeed/ || !$silent) {
    167197            $self->print_msg("\n\tBUT: command $library_url$command response UNEXPECTED.\n", 3);
    168198            $self->print_msg("*** Got message:\n$response_content.\n", 4);
     
    171201        return 0; # ping on a collection may "not succeed."
    172202        }
    173     } 
    174     elsif(LWP::Simple::is_error($response_code)) { # method exported by LWP::Simple, along with HTTP::Status constants
     203    }
     204    elsif($response_code && $response_code =~ m@^(4|5)\d\d@) { # client side errors start with 4xx, server side with 5xx
    175205        # check the page content is as expected
    176         if(defined $expected_error_code && $response_code == $expected_error_code) {
     206        if(defined $expected_error_code && $response_code =~ m@^$expected_error_code@) {
    177207        $self->print_msg(" Response status $response_code as expected.\n", 3);
    178208        } else {
    179209        $self->print_msg("*** Command $library_url$command\n");
    180         $self->print_msg("*** Unexpected error. HTTP Response Status: $response_code - Failed.\n");
     210        $self->print_msg("*** Unexpected error type 1. HTTP Response Status: $response_code - Failed.\n");
    181211        }
    182212        return 0; # return false, since the response_code was an error, expected or not
    183     }
    184     else {
     213    }   
     214    else {  # also if response_code is still undefined, as can happen with connection timing out
    185215        $self->print_msg("*** Command $library_url$command\n");
    186         $self->print_msg("*** Unexpected error. HTTP Response Status: $response_code - Failed.\n");
     216        if(defined $response_code) {
     217        $self->print_msg("*** Unexpected error type 2. HTTP Response Status: $response_code - Failed.\n");
     218        } else {
     219        $self->print_msg("*** Unexpected error type 3. Failed:\n\n$response_content\n\n");
     220        }
    187221        return 0;
    188222    }
     223    #print STDERR "********** WgetCommand: $wgetCommand\n\n";
     224    #print STDERR "********** Response_content:\n$response_content\n\n";
     225    #print STDERR "********** Response_CODE: $response_code\n";
     226
    189227    }   
    190228}
     
    437475
    438476    # Can't do $self->{'library_url'}, because it may not yet be set
    439     my $library_url = $self->get_library_URL(); # returns undef if no server is running
     477    my $library_url = $self->get_library_URL(); # returns undef if no valid server URL
    440478
    441479    if(!defined $library_url) { # undef if no valid server URL
    442     return; # can't do any deactivation without a running GS server
     480    return; # can't do any deactivation without a valid server URL
    443481    }
    444482
     
    492530
    493531    if(!defined $library_url) { # undef if no valid server URL
    494     return; # nothing to activate if there's no running server
     532    return; # nothing to activate if without valid server URL
    495533    }
    496534
     
    549587### UNUSED METHODS - CAN BE HANDY
    550588
     589
     590# This method uses the perl libraries we're advised to use in place of wget for pinging and retrieving web
     591# pages. The problem is that not all perl installations may support these libraries. So we now use the new
     592# config() method further above, which uses the wget included in Greenstone binary installations.
     593# If the library imports at page top conflict, comment out those imports and move the methods config_old(),
     594# is_URL_active() and pingHost() out to a temporary file.
     595#
     596# If for some reason you can't use wget, then rename the config() method to config_old(), and rename the
     597# method below to config() and things should work as before.
     598sub config_old {
     599    my $self = shift(@_);
     600    my ($command, $check_message_against_regex, $expected_error_code, $silent) = @_;
     601
     602    my $library_url = $self->get_library_URL(); #$self->{'library_url'};
     603
     604
     605    # Gatherer.java's configGS3Server doesn't use the site variable
     606    # so we don't have to either
     607   
     608    # for GS2, getting the HTTP status isn't enough, we need to read the output
     609    # since this is what CollectionManager.config() stipulates.
     610    # Using LWP::UserAgent::get($url) for this 
     611   
     612    if(!defined $library_url) {
     613    return 0;
     614    }
     615    else {
     616    $ua->timeout(5); # set LWP useragent to 5s max timeout for testing the URL
     617    # Need to set this, else it takes I don't know how long to timeout
     618    # http://www.perlmonks.org/?node_id=618534
     619   
     620    # http://search.cpan.org/~gaas/libwww-perl-6.04/lib/LWP/UserAgent.pm
     621    # use LWP::UserAgent's get($url) since it returns an HTTP::Response code
     622   
     623    my $response_obj = $ua->get($library_url.$command);
     624   
     625    # $response_obj->content stores the content and $response_obj->code the HTTP response code
     626    my $response_code = $response_obj->code();
     627   
     628    if(LWP::Simple::is_success($response_code)) {# $response_code eq RC_OK) { # LWP::Simple::is_success($response_code)
     629        $self->print_msg("*** Command $library_url$command\n", 3);
     630        $self->print_msg("*** HTTP Response Status: $response_code - Complete.", 3);
     631       
     632        # check the page content is as expected
     633        my $response_content = $response_obj->content;
     634        my $resultstr = $response_content;
     635        $resultstr =~ s@.*gs_content\"\>@@s;       
     636        $resultstr =~ s@</div>.*@@s;
     637       
     638        if($resultstr =~ m/$check_message_against_regex/) {#if($response_content =~ m/$check_message_against_regex/) {
     639        $self->print_msg(" Response as expected.\n", 3);
     640        $self->print_msg("@@@@@@ Got result:\n$resultstr\n", 4);
     641        return 1;
     642        } else {
     643        # if we expect the collection to be inactive, then we'd be in silent mode: if so,
     644        # don't print out the "ping did not succeed" response, but print out any other messages
     645       
     646        # So we only suppress the ping col "did not succeed" response if we're in silent mode
     647        # But if any message other than ping "did not succeed" is returned, we always print it
     648        if($resultstr !~ m/did not succeed/ || !$silent) {#if($response_content !~ m/did not succeed/ || !$silent) {
     649            $self->print_msg("\n\tBUT: command $library_url$command response UNEXPECTED.\n", 3);
     650            $self->print_msg("*** Got message:\n$response_content.\n", 4);
     651            $self->print_msg("*** Got result:\n$resultstr\n", 3);
     652        }
     653        return 0; # ping on a collection may "not succeed."
     654        }
     655    }
     656    elsif(LWP::Simple::is_error($response_code)) { # method exported by LWP::Simple, along with HTTP::Status constants
     657        # check the page content is as expected
     658        if(defined $expected_error_code && $response_code == $expected_error_code) {
     659        $self->print_msg(" Response status $response_code as expected.\n", 3);
     660        } else {
     661        $self->print_msg("*** Command $library_url$command\n");
     662        $self->print_msg("*** Unexpected error. HTTP Response Status: $response_code - Failed.\n");
     663        }
     664        return 0; # return false, since the response_code was an error, expected or not
     665    }
     666    else {
     667        $self->print_msg("*** Command $library_url$command\n");
     668        $self->print_msg("*** Unexpected error. HTTP Response Status: $response_code - Failed.\n");
     669        return 0;
     670    }
     671    }   
     672}
     673
    551674# This method is now unused. Using ping_library instead to send the ping action to a
    552675# GS2/GS3 server. This method can be used more generally to test whether a URL is alive.
Note: See TracChangeset for help on using the changeset viewer.