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

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

All the changes (I think) to switch from port 80 as default for GS2 to port 8282 as new default.

File size: 27.5 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 if ((defined $site) && ($site ne "")) { # GS3
73 $self->{'gs_mode'} = "gs3";
74 } else {
75 $self->{'gs_mode'} = "gs2";
76 }
77
78 return bless($self, $class);
79}
80
81## TODO: gsprintf to $self->{'out'} in these 2 print functions
82## See buildcolutils.pm new() for setting up $out
83
84sub print_task_msg {
85 my $self = shift(@_);
86 my ($task_msg, $verbosity_setting) = @_;
87
88 $verbosity_setting = $self->{'verbosity'} unless $verbosity_setting;
89 #$verbosity_setting = 1 unless defined $verbosity;
90 if($verbosity_setting >= 1) {
91 print STDERR "\n";
92 print STDERR "************************\n";
93 print STDERR "* $task_msg\n";
94 print STDERR "************************\n";
95 }
96}
97
98# Prints messages if the verbosity is right. Does not add new lines.
99sub print_msg {
100 my $self = shift(@_);
101 my ($msg, $min_verbosity, $verbosity_setting) = @_;
102
103 # only display error messages if the current
104 # verbosity setting >= the minimum verbosity level
105 # needed for that message to be displayed.
106
107 $verbosity_setting = $self->{'verbosity'} unless defined $verbosity_setting;
108 $min_verbosity = 1 unless defined $min_verbosity;
109 if($verbosity_setting >= $min_verbosity) { # by default display all 1 messages
110 print STDERR "$msg";
111 }
112}
113
114# Method to send a command to a GS2 or GS3 library_URL
115# the commands used in this script can be activate, deactivate, ping,
116# and is-persistent (is-persistent only implemented for GS2).
117sub config {
118 my $self = shift(@_);
119 my ($command, $check_message_against_regex, $expected_error_code, $silent) = @_;
120
121 my $library_url = $self->get_library_URL(); #$self->{'library_url'};
122
123
124 # Gatherer.java's configGS3Server doesn't use the site variable
125 # so we don't have to either
126
127 # for GS2, getting the HTTP status isn't enough, we need to read the output
128 # since this is what CollectionManager.config() stipulates.
129 # Using LWP::UserAgent::get($url) for this
130
131 if(!defined $library_url) {
132 return 0;
133 }
134 else {
135 # ampersands need to be escaped
136 # - with single quotes around it for linux for the cmd to run in bash subshell
137 # - with a ^ before it on windows for the cmd to run in a DOS prompt subshell
138 # - or the entire wget command should be nested double quotes (single quotes don't work on windows)
139 my $wgetCommand = $command;
140
141 my $wget_file_path = &FileUtils::filenameConcatenate($ENV{'GSDLHOME'}, "bin", $ENV{'GSDLOS'}, "wget");
142
143 # https://www.gnu.org/software/wget/manual/wget.html
144 # output-document set to - (STDOUT), so page is streamed to STDOUT
145 # timeout: 5 seconds, tries: 1
146 # wget sends status information and response code to STDERR, so redirect it to STDOUT
147 # Searching for "perl backtick operator redirect stderr to stdout":
148 # http://www.perlmonks.org/?node=How%20can%20I%20capture%20STDERR%20from%20an%20external%20command%3F
149 $wgetCommand = "\"$wget_file_path\" --output-document=- -T 5 -t 1 \"$library_url$wgetCommand\" 2>&1";
150 #$wgetCommand = "\"$wget_file_path\" --spider -T 5 -t 1 \"$library_url$wgetCommand\" 2>&1"; # won't save page
151 my $response_content = `$wgetCommand`;
152 my $response_code = undef;
153 my @lines = split( /\n/, $response_content );
154 foreach my $line (@lines) {
155 #print STDERR "@@@@ LINE: $line\n";
156 if($line =~ m@failed: Connection timed out.$@) { # linux
157 $response_code = "failed: Connection timed out.";
158 last; # break keyword in perl = last
159 }
160 elsif($line =~ m@Giving up.$@) { # windows (unless -T 5 -t 1 is not passed in)
161 $response_code = "failed: Giving up.";
162 last; # break keyword in perl = last
163 }
164 elsif($line =~ m@failed: Connection refused.$@) {
165 $response_code = "failed: Connection refused.";
166 last; # break keyword in perl = last
167 }
168 elsif($line =~ m@HTTP request sent, @) {
169 $response_code = $line;
170 $response_code =~ s@[^\d]*(.*)$@$1@;
171 last;
172 }
173 }
174
175 if($command =~ m@ping@ && $response_code =~ m@failed: (Connection refused|Giving up)@) {
176 # server not running
177 $self->print_msg("*** Server not running. $library_url$command\n", 3);
178 return 0;
179 }
180 if($response_code && $response_code eq "200 OK") {
181 $self->print_msg("*** Command $library_url$command\n", 3);
182 $self->print_msg("*** HTTP Response Status: $response_code - Complete.", 3);
183
184 # check the page content is as expected
185 my $resultstr = $response_content;
186 $resultstr =~ s@.*gs_content\"\>@@s;
187 $resultstr =~ s@</div>.*@@s;
188 if($resultstr =~ m/$check_message_against_regex/) {
189 $self->print_msg(" Response as expected.\n", 3);
190 $self->print_msg("@@@@@@ Got result:\n$resultstr\n", 4);
191 return 1;
192 } else {
193 # if we expect the collection to be inactive, then we'd be in silent mode: if so,
194 # don't print out the "ping did not succeed" response, but print out any other messages
195
196 # So we only suppress the ping col "did not succeed" response if we're in silent mode
197 # But if any message other than ping "did not succeed" is returned, we always print it
198 if($resultstr !~ m/did not succeed/ || !$silent) {
199 $self->print_msg("\n\tBUT: command $library_url$command response UNEXPECTED.\n", 3);
200 $self->print_msg("*** Got message:\n$response_content.\n", 4);
201 $self->print_msg("*** Got result:\n$resultstr\n", 3);
202 }
203 return 0; # ping on a collection may "not succeed."
204 }
205 }
206 elsif($response_code && $response_code =~ m@^(4|5)\d\d@) { # client side errors start with 4xx, server side with 5xx
207 # check the page content is as expected
208 if(defined $expected_error_code && $response_code =~ m@^$expected_error_code@) {
209 $self->print_msg(" Response status $response_code as expected.\n", 3);
210 } else {
211 $self->print_msg("*** Command $library_url$command\n");
212 $self->print_msg("*** Unexpected error type 1. HTTP Response Status: $response_code - Failed.\n");
213 }
214 return 0; # return false, since the response_code was an error, expected or not
215 }
216 else { # also if response_code is still undefined, as can happen with connection timing out
217 $self->print_msg("*** Command $library_url$command\n");
218 if(defined $response_code) {
219 $self->print_msg("*** Unexpected error type 2. HTTP Response Status: $response_code - Failed.\n");
220 } else {
221 $self->print_msg("*** Unexpected error type 3. Failed:\n\n$response_content\n\n");
222 }
223 return 0;
224 }
225 #print STDERR "********** WgetCommand: $wgetCommand\n\n";
226 #print STDERR "********** Response_content:\n$response_content\n\n";
227 #print STDERR "********** Response_CODE: $response_code\n";
228
229 }
230}
231
232sub deactivate_collection {
233 my $self = shift(@_);
234
235 my $gs_mode = $self->{'gs_mode'};
236 my $qualified_collection = $self->{'qualified_collection'};
237
238 if($gs_mode eq "gs2") {
239 my $DEACTIVATE_COMMAND = "?a=config&cmd=release-collection&c=";
240 my $check_message_against_regex = q/configured release-collection/;
241 $self->config($DEACTIVATE_COMMAND.$qualified_collection, $check_message_against_regex);
242 }
243 elsif ($gs_mode eq "gs3") {
244 my $DEACTIVATE_COMMAND = "?a=s&sa=d&st=collection&sn=";
245 my $check_message_against_regex = "collection: $qualified_collection deactivated";
246 $self->config($DEACTIVATE_COMMAND.$qualified_collection, $check_message_against_regex);
247 }
248}
249
250sub activate_collection {
251 my $self = shift(@_);
252
253 my $gs_mode = $self->{'gs_mode'};
254 my $qualified_collection = $self->{'qualified_collection'};
255
256 if($gs_mode eq "gs2") {
257 my $ACTIVATE_COMMAND = "?a=config&cmd=add-collection&c=";
258 my $check_message_against_regex = q/configured add-collection/;
259 $self->config($ACTIVATE_COMMAND.$qualified_collection, $check_message_against_regex);
260 }
261 elsif ($gs_mode eq "gs3") {
262 my $ACTIVATE_COMMAND = "?a=s&sa=a&st=collection&sn=";
263 my $check_message_against_regex = "collection: $qualified_collection activated";
264 $self->config($ACTIVATE_COMMAND.$qualified_collection, $check_message_against_regex);
265 }
266}
267
268sub ping {
269 my $self = shift(@_);
270 my $command = shift(@_);
271 my $silent = shift(@_);
272
273 # If the GS server is not running, we *expect* to see a "500" status code.
274 # If the GS server is running, then "Ping" ... "succeeded" is expected on success.
275 # When pinging an inactive collection, it will say it did "not succeed". This is
276 # a message of interest to return.
277 my $check_responsemsg_against_regex = q/(succeeded)/;
278 my $expected_error_code = 500;
279
280 $self->print_msg("*** COMMAND WAS: |$command|***\n", 4);
281
282 return $self->config($command, $check_responsemsg_against_regex, $expected_error_code, $silent);
283}
284
285# send a pingaction to the GS library. General server-level ping.
286sub ping_library {
287 my $self = shift(@_);
288
289 my $gs_mode = $self->{'gs_mode'};
290
291 my $command = "";
292 if($gs_mode eq "gs2") {
293 $command = "?a=ping";
294 }
295 elsif ($gs_mode eq "gs3") {
296 $command = "?a=s&sa=ping";
297 }
298 return $self->ping($command);
299}
300
301
302# send a pingaction to a collection in GS library to check if it's active
303sub ping_library_collection {
304 my $self = shift(@_);
305 my $silent = shift(@_);
306
307 my $gs_mode = $self->{'gs_mode'};
308 my $qualified_collection = $self->{'qualified_collection'};
309
310 my $command = "";
311 if($gs_mode eq "gs2") {
312 $command = "?a=ping&c=$qualified_collection";
313 }
314 elsif ($gs_mode eq "gs3") {
315 $command = "?a=s&sa=ping&st=collection&sn=$qualified_collection";
316 }
317 return $self->ping($command, $silent);
318}
319
320# return true if server is persistent, by calling is-persistent on library_url
321# this is only for GS2, since the GS3 server is always persistent
322sub is_persistent {
323 my $self = shift(@_);
324
325 if($self->{'gs_mode'} eq "gs3") { # GS3 server is always persistent
326 return 1;
327 }
328
329 my $command = "?a=is-persistent";
330 my $check_responsemsg_against_regex = q/true/; # isPersistent: true versus isPersistent: false
331 return $self->config($command, $check_responsemsg_against_regex);
332}
333
334sub set_library_URL {
335 my $self = shift(@_);
336 my $library_url = shift(@_);
337 $self->{'library_url'} = $library_url;
338}
339
340sub get_library_URL {
341 my $self = shift(@_);
342
343 # For web servers that are external to a Greenstone installation,
344 # the user can pass in their web server's library URL.
345 if($self->{'library_url'}) {
346 return $self->{'library_url'};
347 }
348
349 # For web servers included with GS (like tomcat for GS3 and server.exe
350 # and apache for GS2), we work out the library URL:
351 my ($gs_mode, $lib_name); # gs_mode can be gs3 or gs2, lib_name is the custom servlet name
352 $gs_mode = $self->{'gs_mode'};
353 $lib_name = $self->{'library_name'};
354
355 # If we get here, we are dealing with a server included with GS.
356 # For GS3, we ask ant for the library URL.
357 # For GS2, we derive the URL from the llssite.cfg file.
358
359 my $url = undef;
360
361 if($gs_mode eq "gs2") {
362 my $llssite_cfg = &FileUtils::filenameConcatenate($ENV{'GSDLHOME'}, "llssite.cfg");
363
364 if(-f $llssite_cfg) {
365 # check llssite.cfg for line with url property
366 # for server.exe also need to use portnumber and enterlib properties
367
368 # Read in the entire contents of the file in one hit
369 if (!open (FIN, $llssite_cfg)) {
370 $self->print_msg("activate.pl::get_library_URL failed to open $llssite_cfg ($!)\n");
371 return undef;
372 }
373
374 my $contents;
375 sysread(FIN, $contents, -s FIN);
376 close(FIN);
377
378 my @lines = split(/[\n\r]+/, $contents); # split on carriage-returns and/or linefeeds
379 my $enterlib = "";
380 my $portnumber = "8282"; # will remain empty (implicit port 80) unless it's specifically been assigned
381
382 foreach my $line (@lines) {
383 if($line =~ m/^url=(.*)$/) {
384 $url = $1;
385 } elsif($line =~ m/^enterlib=(.*)$/) {
386 $enterlib = $1;
387 } elsif($line =~ m/^portnumber=(.*)$/) {
388 $portnumber = $1;
389 }
390 }
391
392 if(!$url) {
393 return undef;
394 }
395 elsif($url eq "URL_pending") { # library is not running
396 # do not process url=URL_pending in the file, since for server.exe
397 # this just means the Enter Library button hasn't been pressed yet
398 $url = undef;
399 }
400 else {
401 # In the case of server.exe, need to do extra work to get the proper URL
402 # But first, need to know whether we're indeed dealing with server.exe:
403
404 # compare the URL's domain to the full URL
405 # E.g. for http://localhost:8383/greenstone3/cgi-bin, the domain is localhost:8383
406 my $uri = URI->new( $url );
407 my $host = $uri->host;
408 #print STDERR "@@@@@ host: $host\n";
409 if($url =~ m/http:\/\/$host(\/)?$/) {
410 #if($url !~ m/http:\/\/$host:$portnumber(\/)?/ || $url =~ m/http:\/\/$host(\/)?$/) {
411 # (if the URL does not contain the portnumber, OR if the port is implicitly 80 and)
412 # If the domain with http:// prefix is completely the same as the URL, assume server.exe
413 # then the actual URL is the result of suffixing the port and enterlib properties in llssite.cfg
414 $url = $url.":".$portnumber.$enterlib;
415 } # else, apache web server
416
417 }
418 }
419 } elsif($gs_mode eq "gs3") {
420 # Either check build.properties for tomcat.server, tomcat.port and app.name (and default servlet name).
421 # app.name is stored in app.path by build.xml. Need to move app.name in build.properties from build.xml
422
423 # Or, run the new target get-default-servlet-url
424 # the output can look like:
425 #
426 # Buildfile: build.xml
427 # [echo] os.name: Windows Vista
428 #
429 # get-default-servlet-url:
430 # [echo] http://localhost:8383/greenstone3/library
431 # BUILD SUCCESSFUL
432 # Total time: 0 seconds
433
434 #my $output = qx/ant get-default-servlet-url/; # backtick operator, to get STDOUT (else 2>&1)
435 # see http://stackoverflow.com/questions/799968/whats-the-difference-between-perls-backticks-system-and-exec
436
437 # The get-default-servlet-url ant target can be run from anywhere by specifying the
438 # location of GS3's ant build.xml buildfile. Activate.pl can be run from anywhere for GS3
439 # GSDL3SRCHOME will be set for GS3 by gs3-setup.sh, a step that would have been necessary
440 # to run the activate.pl script in the first place
441 my $perl_command = "ant -buildfile \"$ENV{'GSDL3SRCHOME'}/build.xml\" get-default-servlet-url";
442
443 if (open(PIN, "$perl_command |")) {
444 while (defined (my $perl_output_line = <PIN>)) {
445 if($perl_output_line =~ m@http:\/\/(\S*)@) { # grab all the non-whitespace chars
446 $url="http://".$1;
447 }
448 }
449 close(PIN);
450 } else {
451 $self->print_msg("activate.pl::get_library_URL: Failed to run $perl_command to work out library URL for $gs_mode\n");
452 }
453 if(defined $lib_name) {
454 # replace the servlet_name portion of the url found, with the given library_name
455 $url =~ s@/[^/]*$@/$lib_name@;
456 }
457 }
458
459 # either the url is still undef or it is now set
460 #print STDERR "\n@@@@@ final URL:|$url|\n" if $url;
461 #print STDERR "\n@@@@@ URL still undef\n" if !$url;
462
463 $self->{'library_url'} = $url;
464 return $url;
465}
466
467
468sub do_deactivate {
469 my $self = shift(@_);
470
471 # 1. Get library URL
472
473 # For web servers that are external to a Greenstone installation,
474 # the user can pass in their web server's library URL.
475 # For web servers included with GS (like tomcat for GS3 and server.exe
476 # and apache for GS2), we work out the library URL:
477
478 # Can't do $self->{'library_url'}, because it may not yet be set
479 my $library_url = $self->get_library_URL(); # returns undef if no valid server URL
480
481 if(!defined $library_url) { # undef if no valid server URL
482 return; # can't do any deactivation without a valid server URL
483 }
484
485 my $is_persistent_server = $self->{'is_persistent_server'};
486 my $qualified_collection = $self->{'qualified_collection'};
487
488 # CollectionManager's installCollection phase in GLI
489 # 2. Ping the library URL, and if it's a persistent server and running, release the collection
490
491 $self->print_msg("Pinging $library_url\n");
492 if ($self->ping_library()) { # server running
493
494 # server is running, so release the collection if
495 # the server is persistent and the collection is active
496
497 # don't need to work out persistency of server more than once, since the libraryURL hasn't changed
498 if (!defined $is_persistent_server) {
499 $self->print_msg("Checking if Greenstone server is persistent\n");
500 $is_persistent_server = $self->is_persistent();
501 $self->{'is_persistent_server'} = $is_persistent_server;
502 }
503
504 if ($is_persistent_server) { # only makes sense to issue activate and deactivate cmds to a persistent server
505
506 $self->print_msg("Checking if the collection $qualified_collection is already active\n");
507 my $collection_active = $self->ping_library_collection();
508
509 if ($collection_active) {
510 $self->print_msg("De-activating collection $qualified_collection\n");
511 $self->deactivate_collection();
512 }
513 else {
514 $self->print_msg("Collection is not active => No need to deactivate\n");
515 }
516 }
517 else {
518 $self->print_msg("Server is not persistent => No need to deactivate collection\n");
519 }
520 }
521 else {
522 $self->print_msg("No response to Ping => Taken to mean server is not running\n");
523 }
524
525 return $is_persistent_server;
526}
527
528sub do_activate {
529 my $self = shift @_;
530
531 my $library_url = $self->get_library_URL(); # Can't do $self->{'library_url'}; as it may not be set yet
532
533 if(!defined $library_url) { # undef if no valid server URL
534 return; # nothing to activate if without valid server URL
535 }
536
537 my $is_persistent_server = $self->{'is_persistent_server'};
538 my $qualified_collection = $self->{'qualified_collection'};
539
540 $self->print_msg("Pinging $library_url\n");
541 if ($self->ping_library()) { # server running
542
543 # don't need to work out persistency of server more than once, since the libraryURL hasn't changed
544 if (!defined $is_persistent_server) {
545 $self->print_msg("Checking if Greenstone server is persistent\n");
546 $is_persistent_server = $self->is_persistent();
547 $self->{'is_persistent_server'} = $is_persistent_server;
548 }
549
550 if ($is_persistent_server) { # persistent server, so can try activating collection
551
552 $self->print_msg("Checking if the collection $qualified_collection is not already active\n");
553
554 # Since we could have deactivated the collection at this point,
555 # it is likely that it is not yet active. When pinging the collection
556 # a "ping did not succeed" message is expected, therefore tell the ping
557 # to proceed silently
558 my $silent = 1;
559 my $collection_active = $self->ping_library_collection($silent);
560
561 if (!$collection_active) {
562 $self->print_msg(" Collection is not active.\n");
563 $self->print_msg("Activating collection $qualified_collection\n");
564 $self->activate_collection();
565
566 # unless an error occurred, the collection should now be active:
567 $collection_active = $self->ping_library_collection(); # not silent if ping did not succeed
568 if(!$collection_active) {
569 $self->print_msg("ERROR: collection $qualified_collection did not get activated\n");
570 }
571 }
572 else {
573 $self->print_msg("Collection is already active => No need to activate\n");
574 }
575 }
576 else {
577 $self->print_msg("Server is not persistent => No need to activate collection\n");
578 }
579 }
580 else {
581 $self->print_msg("No response to Ping => Taken to mean server is not running\n");
582 }
583
584 return $is_persistent_server;
585}
586
587
588#########################################################
589### UNUSED METHODS - CAN BE HANDY
590
591
592# This method uses the perl libraries we're advised to use in place of wget for pinging and retrieving web
593# pages. The problem is that not all perl installations may support these libraries. So we now use the new
594# config() method further above, which uses the wget included in Greenstone binary installations.
595# If the library imports at page top conflict, comment out those imports and move the methods config_old(),
596# is_URL_active() and pingHost() out to a temporary file.
597#
598# If for some reason you can't use wget, then rename the config() method to config_old(), and rename the
599# method below to config() and things should work as before.
600sub config_old {
601 my $self = shift(@_);
602 my ($command, $check_message_against_regex, $expected_error_code, $silent) = @_;
603
604 my $library_url = $self->get_library_URL(); #$self->{'library_url'};
605
606
607 # Gatherer.java's configGS3Server doesn't use the site variable
608 # so we don't have to either
609
610 # for GS2, getting the HTTP status isn't enough, we need to read the output
611 # since this is what CollectionManager.config() stipulates.
612 # Using LWP::UserAgent::get($url) for this
613
614 if(!defined $library_url) {
615 return 0;
616 }
617 else {
618 $ua->timeout(5); # set LWP useragent to 5s max timeout for testing the URL
619 # Need to set this, else it takes I don't know how long to timeout
620 # http://www.perlmonks.org/?node_id=618534
621
622 # http://search.cpan.org/~gaas/libwww-perl-6.04/lib/LWP/UserAgent.pm
623 # use LWP::UserAgent's get($url) since it returns an HTTP::Response code
624
625 my $response_obj = $ua->get($library_url.$command);
626
627 # $response_obj->content stores the content and $response_obj->code the HTTP response code
628 my $response_code = $response_obj->code();
629
630 if(LWP::Simple::is_success($response_code)) {# $response_code eq RC_OK) { # LWP::Simple::is_success($response_code)
631 $self->print_msg("*** Command $library_url$command\n", 3);
632 $self->print_msg("*** HTTP Response Status: $response_code - Complete.", 3);
633
634 # check the page content is as expected
635 my $response_content = $response_obj->content;
636 my $resultstr = $response_content;
637 $resultstr =~ s@.*gs_content\"\>@@s;
638 $resultstr =~ s@</div>.*@@s;
639
640 if($resultstr =~ m/$check_message_against_regex/) {#if($response_content =~ m/$check_message_against_regex/) {
641 $self->print_msg(" Response as expected.\n", 3);
642 $self->print_msg("@@@@@@ Got result:\n$resultstr\n", 4);
643 return 1;
644 } else {
645 # if we expect the collection to be inactive, then we'd be in silent mode: if so,
646 # don't print out the "ping did not succeed" response, but print out any other messages
647
648 # So we only suppress the ping col "did not succeed" response if we're in silent mode
649 # But if any message other than ping "did not succeed" is returned, we always print it
650 if($resultstr !~ m/did not succeed/ || !$silent) {#if($response_content !~ m/did not succeed/ || !$silent) {
651 $self->print_msg("\n\tBUT: command $library_url$command response UNEXPECTED.\n", 3);
652 $self->print_msg("*** Got message:\n$response_content.\n", 4);
653 $self->print_msg("*** Got result:\n$resultstr\n", 3);
654 }
655 return 0; # ping on a collection may "not succeed."
656 }
657 }
658 elsif(LWP::Simple::is_error($response_code)) { # method exported by LWP::Simple, along with HTTP::Status constants
659 # check the page content is as expected
660 if(defined $expected_error_code && $response_code == $expected_error_code) {
661 $self->print_msg(" Response status $response_code as expected.\n", 3);
662 } else {
663 $self->print_msg("*** Command $library_url$command\n");
664 $self->print_msg("*** Unexpected error. HTTP Response Status: $response_code - Failed.\n");
665 }
666 return 0; # return false, since the response_code was an error, expected or not
667 }
668 else {
669 $self->print_msg("*** Command $library_url$command\n");
670 $self->print_msg("*** Unexpected error. HTTP Response Status: $response_code - Failed.\n");
671 return 0;
672 }
673 }
674}
675
676# This method is now unused. Using ping_library instead to send the ping action to a
677# GS2/GS3 server. This method can be used more generally to test whether a URL is alive.
678# http://search.cpan.org/dist/libwww-perl/lib/LWP/Simple.pm
679# and http://www.perlmonks.org/?node_id=618534
680sub is_URL_active {
681 my $url = shift(@_); # gs3 or gs2 URL
682
683 my $status = 0;
684 if(defined $url) {
685 $ua->timeout(10); # set LWP useragent to 5s max timeout for testing the URL
686 # Need to set this, else it takes I don't know how long to timeout
687 # http://www.perlmonks.org/?node_id=618534
688
689 $status = LWP::Simple::head($url); # returns empty list of headers if it fails
690 # LWP::Simple::get($url) is more intensive, so don't need to do that
691 #print STDERR "**** $url is alive.\n" if $status;
692 }
693 return $status;
694}
695
696# Pinging seems to always return true, so this method doesn't work
697sub pingHost {
698 my $url = shift(@_); # gs3 or gs2 URL
699
700 my $status = 0;
701 if(defined $url) {
702 # Get just the domain. "http://localhost/gsdl?uq=332033495" becomes "localhost"
703 # "http://localhost/greenstone/cgi-bin/library.cgi" becomes "localhost" too
704
705 #my $host = $url;
706 #$host =~ s@^http:\/\/(www.)?@@;
707 #$host =~ s@\/.*@@;
708 #print STDERR "**** HOST: $host\n";
709
710 # More robust way
711 # http://stackoverflow.com/questions/827024/how-do-i-extract-the-domain-out-of-an-url
712 my $uri = URI->new( $url );
713 my $host = $uri->host;
714
715 # Ping the host. http://perldoc.perl.org/Net/Ping.html
716 my $p = Net::Ping->new();
717 $status = $p->ping($host); # || 0. Appears to set to undef rather than 0
718 print STDERR "**** $host is alive.\n" if $status; #print "$host is alive.\n" if $p->ping($host);
719 $p->close();
720 }
721 # return whether pinging was a success or failure
722 return $status;
723}
724
7251;
Note: See TracBrowser for help on using the repository browser.