root/main/trunk/greenstone2/perllib/servercontrol.pm @ 30531

Revision 30531, 27.4 KB (checked in by ak19, 4 years ago)

Fixing up the wget command issued by servercontrol.pm so that it will work on Windows too. Ampersands in URL to wget need to be escaped to work in a subshell. For linux, nesting the ampersand in single quotes suffices. For windows, preceding the ampersand with a hat sign seems to work from DOS prompt. But nesting the entire wget command inside double quotes seems to work on both OS systems.

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