Changeset 30526 for main/trunk/greenstone2
- Timestamp:
- 2016-05-10T19:02:55+12:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
main/trunk/greenstone2/perllib/servercontrol.pm
r30524 r30526 33 33 no strict 'subs'; # allow barewords (eg STDERR) as function arguments 34 34 35 # Greenstone includes 36 use printusage; 37 use 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. 35 43 use HTTP::Response; 36 44 use 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()) 38 46 #use CGI qw(:standard); # then only CGI.pm defines a head() 39 47 use Net::Ping; 40 48 use URI; 41 42 use printusage;43 use parse2;44 49 45 50 … … 132 137 } 133 138 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") { 147 179 $self->print_msg("*** Command $library_url$command\n", 3); 148 180 $self->print_msg("*** HTTP Response Status: $response_code - Complete.", 3); 149 181 150 182 # check the page content is as expected 151 my $response_content = $response_obj->content;152 183 my $resultstr = $response_content; 153 184 $resultstr =~ s@.*gs_content\"\>@@s; 154 185 $resultstr =~ s@</div>.*@@s; 155 156 if($response_content =~ m/$check_message_against_regex/) { 186 if($resultstr =~ m/$check_message_against_regex/) { 157 187 $self->print_msg(" Response as expected.\n", 3); 158 188 $self->print_msg("@@@@@@ Got result:\n$resultstr\n", 4); … … 164 194 # So we only suppress the ping col "did not succeed" response if we're in silent mode 165 195 # But if any message other than ping "did not succeed" is returned, we always print it 166 if($res ponse_content!~ m/did not succeed/ || !$silent) {196 if($resultstr !~ m/did not succeed/ || !$silent) { 167 197 $self->print_msg("\n\tBUT: command $library_url$command response UNEXPECTED.\n", 3); 168 198 $self->print_msg("*** Got message:\n$response_content.\n", 4); … … 171 201 return 0; # ping on a collection may "not succeed." 172 202 } 173 } 174 elsif( LWP::Simple::is_error($response_code)) { # method exported by LWP::Simple, along with HTTP::Status constants203 } 204 elsif($response_code && $response_code =~ m@^(4|5)\d\d@) { # client side errors start with 4xx, server side with 5xx 175 205 # 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@) { 177 207 $self->print_msg(" Response status $response_code as expected.\n", 3); 178 208 } else { 179 209 $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"); 181 211 } 182 212 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 185 215 $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 } 187 221 return 0; 188 222 } 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 189 227 } 190 228 } … … 437 475 438 476 # 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 running477 my $library_url = $self->get_library_URL(); # returns undef if no valid server URL 440 478 441 479 if(!defined $library_url) { # undef if no valid server URL 442 return; # can't do any deactivation without a running GS server480 return; # can't do any deactivation without a valid server URL 443 481 } 444 482 … … 492 530 493 531 if(!defined $library_url) { # undef if no valid server URL 494 return; # nothing to activate if there's no running server532 return; # nothing to activate if without valid server URL 495 533 } 496 534 … … 549 587 ### UNUSED METHODS - CAN BE HANDY 550 588 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. 598 sub 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 551 674 # This method is now unused. Using ping_library instead to send the ping action to a 552 675 # 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.