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

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