source: main/trunk/greenstone2/perllib/servercontrol.pm@ 30526

Last change on this file since 30526 was 30526, checked in by ak19, 5 years ago

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 size: 27.2 KB
Line 
1#############################################################################
2#
3# activate.pm -- functions to get the GS library URL, ping the library URL,
4# activate and deactivate a collection.
5#
6# A component of the Greenstone digital library software
7# from the New Zealand Digital Library Project at the
8# University of Waikato, New Zealand.
9#
10# Copyright (C) 1999 New Zealand Digital Library Project
11#
12# This program is free software; you can redistribute it and/or modify
13# it under the terms of the GNU General Public License as published by
14# the Free Software Foundation; either version 2 of the License, or
15# (at your option) any later version.
16#
17# This program is distributed in the hope that it will be useful,
18# but WITHOUT ANY WARRANTY; without even the implied warranty of
19# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20# GNU General Public License for more details.
21#
22# You should have received a copy of the GNU General Public License
23# along with this program; if not, write to the Free Software
24# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
25#
26###############################################################################
27
28package servercontrol;
29
30
31use strict;
32no strict 'refs'; # allow filehandles to be variables and vice versa
33no strict 'subs'; # allow barewords (eg STDERR) as function arguments
34
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.
43use HTTP::Response;
44use LWP::Simple qw($ua !head); # import useragent object as $ua from the full LWP to use along with LWP::Simple
45 # don't import LWP::Simple's head function by name since it can conflict with CGI:head())
46#use CGI qw(:standard); # then only CGI.pm defines a head()
47use Net::Ping;
48use URI;
49
50
51sub new
52{
53 my $class = shift(@_);
54
55 my ($qualified_collection, $site, $verbosity, $build_dir, $index_dir, $collect_dir, $library_url, $library_name) = @_;
56
57 # library_url: to be specified on the cmdline if not using a GS-included web server
58 # the GSDL_LIBRARY_URL env var is useful when running cmdline buildcol.pl in the linux package manager versions of GS3
59
60 my $self = {'build_dir' => $build_dir,
61 'index_dir' => $index_dir,
62 'collect_dir' => $collect_dir,
63 'site' => $site,
64 'qualified_collection' => $qualified_collection,
65 #'is_persistent_server' => undef,
66 'library_url' => $library_url || $ENV{'GSDL_LIBRARY_URL'} || undef, # to be specified on the cmdline if not using a GS-included web server
67 'library_name' => $library_name,
68 #'gs_mode' => "gs2",
69 'verbosity' => $verbosity || 2
70 };
71
72
73 # Do we need 'listall' support in buildcol? If so, copy code from inexport
74 # later [jmt12]
75
76 if ((defined $site) && ($site ne "")) { # GS3
77 $self->{'gs_mode'} = "gs3";
78 } else {
79 $self->{'gs_mode'} = "gs2";
80 }
81
82 return bless($self, $class);
83}
84
85## TODO: gsprintf to $self->{'out'} in these 2 print functions
86## See buildcolutils.pm new() for setting up $out
87
88sub print_task_msg {
89 my $self = shift(@_);
90 my ($task_msg, $verbosity_setting) = @_;
91
92 $verbosity_setting = $self->{'verbosity'} unless $verbosity_setting;
93 #$verbosity_setting = 1 unless defined $verbosity;
94 if($verbosity_setting >= 1) {
95 print STDERR "\n";
96 print STDERR "************************\n";
97 print STDERR "* $task_msg\n";
98 print STDERR "************************\n";
99 }
100}
101
102# Prints messages if the verbosity is right. Does not add new lines.
103sub print_msg {
104 my $self = shift(@_);
105 my ($msg, $min_verbosity, $verbosity_setting) = @_;
106
107 # only display error messages if the current
108 # verbosity setting >= the minimum verbosity level
109 # needed for that message to be displayed.
110
111 $verbosity_setting = $self->{'verbosity'} unless defined $verbosity_setting;
112 $min_verbosity = 1 unless defined $min_verbosity;
113 if($verbosity_setting >= $min_verbosity) { # by default display all 1 messages
114 print STDERR "$msg";
115 }
116}
117
118# Method to send a command to a GS2 or GS3 library_URL
119# the commands used in this script can be activate, deactivate, ping,
120# and is-persistent (is-persistent only implemented for GS2).
121sub config {
122 my $self = shift(@_);
123 my ($command, $check_message_against_regex, $expected_error_code, $silent) = @_;
124
125 my $library_url = $self->get_library_URL(); #$self->{'library_url'};
126
127
128 # Gatherer.java's configGS3Server doesn't use the site variable
129 # so we don't have to either
130
131 # for GS2, getting the HTTP status isn't enough, we need to read the output
132 # since this is what CollectionManager.config() stipulates.
133 # Using LWP::UserAgent::get($url) for this
134
135 if(!defined $library_url) {
136 return 0;
137 }
138 else {
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") {
179 $self->print_msg("*** Command $library_url$command\n", 3);
180 $self->print_msg("*** HTTP Response Status: $response_code - Complete.", 3);
181
182 # check the page content is as expected
183 my $resultstr = $response_content;
184 $resultstr =~ s@.*gs_content\"\>@@s;
185 $resultstr =~ s@</div>.*@@s;
186 if($resultstr =~ m/$check_message_against_regex/) {
187 $self->print_msg(" Response as expected.\n", 3);
188 $self->print_msg("@@@@@@ Got result:\n$resultstr\n", 4);
189 return 1;
190 } else {
191 # if we expect the collection to be inactive, then we'd be in silent mode: if so,
192 # don't print out the "ping did not succeed" response, but print out any other messages
193
194 # So we only suppress the ping col "did not succeed" response if we're in silent mode
195 # But if any message other than ping "did not succeed" is returned, we always print it
196 if($resultstr !~ m/did not succeed/ || !$silent) {
197 $self->print_msg("\n\tBUT: command $library_url$command response UNEXPECTED.\n", 3);
198 $self->print_msg("*** Got message:\n$response_content.\n", 4);
199 $self->print_msg("*** Got result:\n$resultstr\n", 3);
200 }
201 return 0; # ping on a collection may "not succeed."
202 }
203 }
204 elsif($response_code && $response_code =~ m@^(4|5)\d\d@) { # client side errors start with 4xx, server side with 5xx
205 # check the page content is as expected
206 if(defined $expected_error_code && $response_code =~ m@^$expected_error_code@) {
207 $self->print_msg(" Response status $response_code as expected.\n", 3);
208 } else {
209 $self->print_msg("*** Command $library_url$command\n");
210 $self->print_msg("*** Unexpected error type 1. HTTP Response Status: $response_code - Failed.\n");
211 }
212 return 0; # return false, since the response_code was an error, expected or not
213 }
214 else { # also if response_code is still undefined, as can happen with connection timing out
215 $self->print_msg("*** Command $library_url$command\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 }
221 return 0;
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
227 }
228}
229
230sub deactivate_collection {
231 my $self = shift(@_);
232
233 my $gs_mode = $self->{'gs_mode'};
234 my $qualified_collection = $self->{'qualified_collection'};
235
236 if($gs_mode eq "gs2") {
237 my $DEACTIVATE_COMMAND = "?a=config&cmd=release-collection&c=";
238 my $check_message_against_regex = q/configured release-collection/;
239 $self->config($DEACTIVATE_COMMAND.$qualified_collection, $check_message_against_regex);
240 }
241 elsif ($gs_mode eq "gs3") {
242 my $DEACTIVATE_COMMAND = "?a=s&sa=d&st=collection&sn=";
243 my $check_message_against_regex = "collection: $qualified_collection deactivated";
244 $self->config($DEACTIVATE_COMMAND.$qualified_collection, $check_message_against_regex);
245 }
246}
247
248sub activate_collection {
249 my $self = shift(@_);
250
251 my $gs_mode = $self->{'gs_mode'};
252 my $qualified_collection = $self->{'qualified_collection'};
253
254 if($gs_mode eq "gs2") {
255 my $ACTIVATE_COMMAND = "?a=config&cmd=add-collection&c=";
256 my $check_message_against_regex = q/configured add-collection/;
257 $self->config($ACTIVATE_COMMAND.$qualified_collection, $check_message_against_regex);
258 }
259 elsif ($gs_mode eq "gs3") {
260 my $ACTIVATE_COMMAND = "?a=s&sa=a&st=collection&sn=";
261 my $check_message_against_regex = "collection: $qualified_collection activated";
262 $self->config($ACTIVATE_COMMAND.$qualified_collection, $check_message_against_regex);
263 }
264}
265
266sub ping {
267 my $self = shift(@_);
268 my $command = shift(@_);
269 my $silent = shift(@_);
270
271 # If the GS server is not running, we *expect* to see a "500" status code.
272 # If the GS server is running, then "Ping" ... "succeeded" is expected on success.
273 # When pinging an inactive collection, it will say it did "not succeed". This is
274 # a message of interest to return.
275 my $check_responsemsg_against_regex = q/(succeeded)/;
276 my $expected_error_code = 500;
277
278 $self->print_msg("*** COMMAND WAS: |$command|***\n", 4);
279
280 return $self->config($command, $check_responsemsg_against_regex, $expected_error_code, $silent);
281}
282
283# send a pingaction to the GS library. General server-level ping.
284sub ping_library {
285 my $self = shift(@_);
286
287 my $gs_mode = $self->{'gs_mode'};
288
289 my $command = "";
290 if($gs_mode eq "gs2") {
291 $command = "?a=ping";
292 }
293 elsif ($gs_mode eq "gs3") {
294 $command = "?a=s&sa=ping";
295 }
296 return $self->ping($command);
297}
298
299
300# send a pingaction to a collection in GS library to check if it's active
301sub ping_library_collection {
302 my $self = shift(@_);
303 my $silent = shift(@_);
304
305 my $gs_mode = $self->{'gs_mode'};
306 my $qualified_collection = $self->{'qualified_collection'};
307
308 my $command = "";
309 if($gs_mode eq "gs2") {
310 $command = "?a=ping&c=$qualified_collection";
311 }
312 elsif ($gs_mode eq "gs3") {
313 $command = "?a=s&sa=ping&st=collection&sn=$qualified_collection";
314 }
315 return $self->ping($command, $silent);
316}
317
318# return true if server is persistent, by calling is-persistent on library_url
319# this is only for GS2, since the GS3 server is always persistent
320sub is_persistent {
321 my $self = shift(@_);
322
323 if($self->{'gs_mode'} eq "gs3") { # GS3 server is always persistent
324 return 1;
325 }
326
327 my $command = "?a=is-persistent";
328 my $check_responsemsg_against_regex = q/true/; # isPersistent: true versus isPersistent: false
329 return $self->config($command, $check_responsemsg_against_regex);
330}
331
332sub set_library_URL {
333 my $self = shift(@_);
334 my $library_url = shift(@_);
335 $self->{'library_url'} = $library_url;
336}
337
338sub get_library_URL {
339 my $self = shift(@_);
340
341 # For web servers that are external to a Greenstone installation,
342 # the user can pass in their web server's library URL.
343 if($self->{'library_url'}) {
344 return $self->{'library_url'};
345 }
346
347 # For web servers included with GS (like tomcat for GS3 and server.exe
348 # and apache for GS2), we work out the library URL:
349 my ($gs_mode, $lib_name); # gs_mode can be gs3 or gs2, lib_name is the custom servlet name
350 $gs_mode = $self->{'gs_mode'};
351 $lib_name = $self->{'library_name'};
352
353 # If we get here, we are dealing with a server included with GS.
354 # For GS3, we ask ant for the library URL.
355 # For GS2, we derive the URL from the llssite.cfg file.
356
357 my $url = undef;
358
359 if($gs_mode eq "gs2") {
360 my $llssite_cfg = &FileUtils::filenameConcatenate($ENV{'GSDLHOME'}, "llssite.cfg");
361
362 if(-f $llssite_cfg) {
363 # check llssite.cfg for line with url property
364 # for server.exe also need to use portnumber and enterlib properties
365
366 # Read in the entire contents of the file in one hit
367 if (!open (FIN, $llssite_cfg)) {
368 $self->print_msg("activate.pl::get_library_URL failed to open $llssite_cfg ($!)\n");
369 return undef;
370 }
371
372 my $contents;
373 sysread(FIN, $contents, -s FIN);
374 close(FIN);
375
376 my @lines = split(/[\n\r]+/, $contents); # split on carriage-returns and/or linefeeds
377 my $enterlib = "";
378 my $portnumber = ""; # will remain empty (implicit port 80) unless it's specifically been assigned
379
380 foreach my $line (@lines) {
381 if($line =~ m/^url=(.*)$/) {
382 $url = $1;
383 } elsif($line =~ m/^enterlib=(.*)$/) {
384 $enterlib = $1;
385 } elsif($line =~ m/^portnumber=(.*)$/) {
386 $portnumber = $1;
387 }
388 }
389
390 if(!$url) {
391 return undef;
392 }
393 elsif($url eq "URL_pending") { # library is not running
394 # do not process url=URL_pending in the file, since for server.exe
395 # this just means the Enter Library button hasn't been pressed yet
396 $url = undef;
397 }
398 else {
399 # In the case of server.exe, need to do extra work to get the proper URL
400 # But first, need to know whether we're indeed dealing with server.exe:
401
402 # compare the URL's domain to the full URL
403 # E.g. for http://localhost:8383/greenstone3/cgi-bin, the domain is localhost:8383
404 my $uri = URI->new( $url );
405 my $host = $uri->host;
406 #print STDERR "@@@@@ host: $host\n";
407 if($url =~ m/http:\/\/$host(\/)?$/) {
408 #if($url !~ m/http:\/\/$host:$portnumber(\/)?/ || $url =~ m/http:\/\/$host(\/)?$/) {
409 # (if the URL does not contain the portnumber, OR if the port is implicitly 80 and)
410 # If the domain with http:// prefix is completely the same as the URL, assume server.exe
411 # then the actual URL is the result of suffixing the port and enterlib properties in llssite.cfg
412 $url = $url.":".$portnumber.$enterlib;
413 } # else, apache web server
414
415 }
416 }
417 } elsif($gs_mode eq "gs3") {
418 # Either check build.properties for tomcat.server, tomcat.port and app.name (and default servlet name).
419 # app.name is stored in app.path by build.xml. Need to move app.name in build.properties from build.xml
420
421 # Or, run the new target get-default-servlet-url
422 # the output can look like:
423 #
424 # Buildfile: build.xml
425 # [echo] os.name: Windows Vista
426 #
427 # get-default-servlet-url:
428 # [echo] http://localhost:8383/greenstone3/library
429 # BUILD SUCCESSFUL
430 # Total time: 0 seconds
431
432 #my $output = qx/ant get-default-servlet-url/; # backtick operator, to get STDOUT (else 2>&1)
433 # see http://stackoverflow.com/questions/799968/whats-the-difference-between-perls-backticks-system-and-exec
434
435 # The get-default-servlet-url ant target can be run from anywhere by specifying the
436 # location of GS3's ant build.xml buildfile. Activate.pl can be run from anywhere for GS3
437 # GSDL3SRCHOME will be set for GS3 by gs3-setup.sh, a step that would have been necessary
438 # to run the activate.pl script in the first place
439 my $perl_command = "ant -buildfile \"$ENV{'GSDL3SRCHOME'}/build.xml\" get-default-servlet-url";
440
441 if (open(PIN, "$perl_command |")) {
442 while (defined (my $perl_output_line = <PIN>)) {
443 if($perl_output_line =~ m@http:\/\/(\S*)@) { # grab all the non-whitespace chars
444 $url="http://".$1;
445 }
446 }
447 close(PIN);
448 } else {
449 $self->print_msg("activate.pl::get_library_URL: Failed to run $perl_command to work out library URL for $gs_mode\n");
450 }
451 if(defined $lib_name) {
452 # replace the servlet_name portion of the url found, with the given library_name
453 $url =~ s@/[^/]*$@/$lib_name@;
454 }
455 }
456
457 # either the url is still undef or it is now set
458 #print STDERR "\n@@@@@ final URL:|$url|\n" if $url;
459 #print STDERR "\n@@@@@ URL still undef\n" if !$url;
460
461 $self->{'library_url'} = $url;
462 return $url;
463}
464
465
466sub do_deactivate {
467 my $self = shift(@_);
468
469 # 1. Get library URL
470
471 # For web servers that are external to a Greenstone installation,
472 # the user can pass in their web server's library URL.
473 # For web servers included with GS (like tomcat for GS3 and server.exe
474 # and apache for GS2), we work out the library URL:
475
476 # Can't do $self->{'library_url'}, because it may not yet be set
477 my $library_url = $self->get_library_URL(); # returns undef if no valid server URL
478
479 if(!defined $library_url) { # undef if no valid server URL
480 return; # can't do any deactivation without a valid server URL
481 }
482
483 my $is_persistent_server = $self->{'is_persistent_server'};
484 my $qualified_collection = $self->{'qualified_collection'};
485
486 # CollectionManager's installCollection phase in GLI
487 # 2. Ping the library URL, and if it's a persistent server and running, release the collection
488
489 $self->print_msg("Pinging $library_url\n");
490 if ($self->ping_library()) { # server running
491
492 # server is running, so release the collection if
493 # the server is persistent and the collection is active
494
495 # don't need to work out persistency of server more than once, since the libraryURL hasn't changed
496 if (!defined $is_persistent_server) {
497 $self->print_msg("Checking if Greenstone server is persistent\n");
498 $is_persistent_server = $self->is_persistent();
499 $self->{'is_persistent_server'} = $is_persistent_server;
500 }
501
502 if ($is_persistent_server) { # only makes sense to issue activate and deactivate cmds to a persistent server
503
504 $self->print_msg("Checking if the collection $qualified_collection is already active\n");
505 my $collection_active = $self->ping_library_collection();
506
507 if ($collection_active) {
508 $self->print_msg("De-activating collection $qualified_collection\n");
509 $self->deactivate_collection();
510 }
511 else {
512 $self->print_msg("Collection is not active => No need to deactivate\n");
513 }
514 }
515 else {
516 $self->print_msg("Server is not persistent => No need to deactivate collection\n");
517 }
518 }
519 else {
520 $self->print_msg("No response to Ping => Taken to mean server is not running\n");
521 }
522
523 return $is_persistent_server;
524}
525
526sub do_activate {
527 my $self = shift @_;
528
529 my $library_url = $self->get_library_URL(); # Can't do $self->{'library_url'}; as it may not be set yet
530
531 if(!defined $library_url) { # undef if no valid server URL
532 return; # nothing to activate if without valid server URL
533 }
534
535 my $is_persistent_server = $self->{'is_persistent_server'};
536 my $qualified_collection = $self->{'qualified_collection'};
537
538 $self->print_msg("Pinging $library_url\n");
539 if ($self->ping_library()) { # server running
540
541 # don't need to work out persistency of server more than once, since the libraryURL hasn't changed
542 if (!defined $is_persistent_server) {
543 $self->print_msg("Checking if Greenstone server is persistent\n");
544 $is_persistent_server = $self->is_persistent();
545 $self->{'is_persistent_server'} = $is_persistent_server;
546 }
547
548 if ($is_persistent_server) { # persistent server, so can try activating collection
549
550 $self->print_msg("Checking if the collection $qualified_collection is not already active\n");
551
552 # Since we could have deactivated the collection at this point,
553 # it is likely that it is not yet active. When pinging the collection
554 # a "ping did not succeed" message is expected, therefore tell the ping
555 # to proceed silently
556 my $silent = 1;
557 my $collection_active = $self->ping_library_collection($silent);
558
559 if (!$collection_active) {
560 $self->print_msg(" Collection is not active.\n");
561 $self->print_msg("Activating collection $qualified_collection\n");
562 $self->activate_collection();
563
564 # unless an error occurred, the collection should now be active:
565 $collection_active = $self->ping_library_collection(); # not silent if ping did not succeed
566 if(!$collection_active) {
567 $self->print_msg("ERROR: collection $qualified_collection did not get activated\n");
568 }
569 }
570 else {
571 $self->print_msg("Collection is already active => No need to activate\n");
572 }
573 }
574 else {
575 $self->print_msg("Server is not persistent => No need to activate collection\n");
576 }
577 }
578 else {
579 $self->print_msg("No response to Ping => Taken to mean server is not running\n");
580 }
581
582 return $is_persistent_server;
583}
584
585
586#########################################################
587### UNUSED METHODS - CAN BE HANDY
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.
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
674# This method is now unused. Using ping_library instead to send the ping action to a
675# GS2/GS3 server. This method can be used more generally to test whether a URL is alive.
676# http://search.cpan.org/dist/libwww-perl/lib/LWP/Simple.pm
677# and http://www.perlmonks.org/?node_id=618534
678sub is_URL_active {
679 my $url = shift(@_); # gs3 or gs2 URL
680
681 my $status = 0;
682 if(defined $url) {
683 $ua->timeout(10); # set LWP useragent to 5s max timeout for testing the URL
684 # Need to set this, else it takes I don't know how long to timeout
685 # http://www.perlmonks.org/?node_id=618534
686
687 $status = LWP::Simple::head($url); # returns empty list of headers if it fails
688 # LWP::Simple::get($url) is more intensive, so don't need to do that
689 #print STDERR "**** $url is alive.\n" if $status;
690 }
691 return $status;
692}
693
694# Pinging seems to always return true, so this method doesn't work
695sub pingHost {
696 my $url = shift(@_); # gs3 or gs2 URL
697
698 my $status = 0;
699 if(defined $url) {
700 # Get just the domain. "http://localhost/gsdl?uq=332033495" becomes "localhost"
701 # "http://localhost/greenstone/cgi-bin/library.cgi" becomes "localhost" too
702
703 #my $host = $url;
704 #$host =~ s@^http:\/\/(www.)?@@;
705 #$host =~ s@\/.*@@;
706 #print STDERR "**** HOST: $host\n";
707
708 # More robust way
709 # http://stackoverflow.com/questions/827024/how-do-i-extract-the-domain-out-of-an-url
710 my $uri = URI->new( $url );
711 my $host = $uri->host;
712
713 # Ping the host. http://perldoc.perl.org/Net/Ping.html
714 my $p = Net::Ping->new();
715 $status = $p->ping($host); # || 0. Appears to set to undef rather than 0
716 print STDERR "**** $host is alive.\n" if $status; #print "$host is alive.\n" if $p->ping($host);
717 $p->close();
718 }
719 # return whether pinging was a success or failure
720 return $status;
721}
722
7231;
Note: See TracBrowser for help on using the repository browser.