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

Revision 30533, 27.5 KB (checked in by ak19, 4 years ago)

Adjustments for Windows OS to servercontrol.pm::config() which now uses wget.

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 = ""; # 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 browser.