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

Revision 30523, 21.7 KB (checked in by ak19, 4 years ago)

Renaming activate.pm to servercontrol.pm.

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
35use HTTP::Response;
36use LWP::Simple qw($ua !head); # import useragent object as $ua from the full LWP to use along with LWP::Simple
37        # don't import LWP::Simple's head function by name since it can conflict with CGI:head())           
38#use CGI qw(:standard);  # then only CGI.pm defines a head()
39use Net::Ping;
40use URI;
41
42use printusage;
43use parse2;
44
45
46sub new
47{
48  my $class = shift(@_);
49
50  my ($qualified_collection, $site, $verbosity, $build_dir, $index_dir, $collect_dir, $library_url, $library_name) = @_;
51
52  my $self = {'build_dir' => $build_dir,
53              'index_dir' => $index_dir,
54              'collect_dir' => $collect_dir,
55              'site' => $site,
56              'qualified_collection' => $qualified_collection,
57          #'is_persistent_server' => undef,
58              'library_url' => $library_url || $ENV{'GSDL_LIBRARY_URL'} || undef, # to be specified on the cmdline if not using a GS-included web server
59              'library_name' => $library_name,
60          #'gs_mode' => "gs2",
61          'verbosity' => $verbosity || 2
62             };
63
64
65  # Do we need 'listall' support in buildcol? If so, copy code from inexport
66  # later [jmt12]
67
68  if ((defined $site) && ($site ne "")) { # GS3
69      $self->{'gs_mode'} = "gs3";
70  } else {
71      $self->{'gs_mode'} = "gs2";
72  }
73
74  return bless($self, $class);
75}
76
77## TODO: gsprintf to $self->{'out'} in these 2 print functions
78## See buildcolutils.pm new() for setting up $out
79
80sub print_task_msg {
81    my $self = shift(@_);
82    my ($task_msg, $verbosity_setting) = @_;
83   
84    $verbosity_setting = $self->{'verbosity'} unless $verbosity_setting;
85    #$verbosity_setting = 1 unless defined $verbosity;
86    if($verbosity_setting >= 1) {
87    print STDERR "\n";
88    print STDERR "************************\n";
89    print STDERR "* $task_msg\n";
90    print STDERR "************************\n";
91    }
92}
93
94# Prints messages if the verbosity is right. Does not add new lines.
95sub print_msg {
96    my $self = shift(@_);
97    my ($msg, $min_verbosity, $verbosity_setting) = @_;
98
99    # only display error messages if the current
100    # verbosity setting >= the minimum verbosity level
101    # needed for that message to be displayed.
102   
103    $verbosity_setting = $self->{'verbosity'} unless defined $verbosity_setting;
104    $min_verbosity = 1 unless defined $min_verbosity;
105    if($verbosity_setting >= $min_verbosity) { # by default display all 1 messages
106    print STDERR "$msg";
107    }
108}
109
110# Method to send a command to a GS2 or GS3 library_URL
111# the commands used in this script can be activate, deactivate, ping,
112# and is-persistent (is-persistent only implemented for GS2).
113sub config {
114    my $self = shift(@_);
115    my ($command, $check_message_against_regex, $site, $expected_error_code, $silent) = @_;
116
117    my ($library_url);
118    $library_url = $self->{'library_url'};
119    #$site = $self->{'site'};
120
121
122    # Gatherer.java's configGS3Server doesn't use the site variable
123    # so we don't have to either
124   
125    # for GS2, getting the HTTP status isn't enough, we need to read the output
126    # since this is what CollectionManager.config() stipulates.
127    # Using LWP::UserAgent::get($url) for this 
128   
129    if(!defined $library_url) {
130    return 0;
131    }
132    else {
133    $ua->timeout(5); # set LWP useragent to 5s max timeout for testing the URL
134    # Need to set this, else it takes I don't know how long to timeout
135    # http://www.perlmonks.org/?node_id=618534
136   
137    # http://search.cpan.org/~gaas/libwww-perl-6.04/lib/LWP/UserAgent.pm
138    # use LWP::UserAgent's get($url) since it returns an HTTP::Response code
139   
140    my $response_obj = $ua->get($library_url.$command);
141   
142    # $response_obj->content stores the content and $response_obj->code the HTTP response code
143    my $response_code = $response_obj->code();
144   
145    if(LWP::Simple::is_success($response_code)) {# $response_code eq RC_OK) { # LWP::Simple::is_success($response_code)
146        $self->print_msg("*** Command $library_url$command\n", 3);
147        $self->print_msg("*** HTTP Response Status: $response_code - Complete.", 3);
148       
149        # check the page content is as expected
150        my $response_content = $response_obj->content;
151        my $resultstr = $response_content;
152        $resultstr =~ s@.*gs_content\"\>@@s;       
153        $resultstr =~ s@</div>.*@@s;
154       
155        if($response_content =~ m/$check_message_against_regex/) {
156        $self->print_msg(" Response as expected.\n", 3);
157        $self->print_msg("@@@@@@ Got result:\n$resultstr\n", 4);
158        return 1;
159        } else {
160        # if we expect the collection to be inactive, then we'd be in silent mode: if so,
161        # don't print out the "ping did not succeed" response, but print out any other messages
162       
163        # So we only suppress the ping col "did not succeed" response if we're in silent mode
164        # But if any message other than ping "did not succeed" is returned, we always print it
165        if($response_content !~ m/did not succeed/ || !$silent) {
166            $self->print_msg("\n\tBUT: command $library_url$command response UNEXPECTED.\n", 3);
167            $self->print_msg("*** Got message:\n$response_content.\n", 4);
168            $self->print_msg("*** Got result:\n$resultstr\n", 3);
169        }
170        return 0; # ping on a collection may "not succeed."
171        }
172    }
173    elsif(LWP::Simple::is_error($response_code)) { # method exported by LWP::Simple, along with HTTP::Status constants
174        # check the page content is as expected
175        if(defined $expected_error_code && $response_code == $expected_error_code) {
176        $self->print_msg(" Response status $response_code as expected.\n", 3);
177        } else {
178        $self->print_msg("*** Command $library_url$command\n");
179        $self->print_msg("*** Unexpected error. HTTP Response Status: $response_code - Failed.\n");
180        }
181        return 0; # return false, since the response_code was an error, expected or not
182    }
183    else {
184        $self->print_msg("*** Command $library_url$command\n");
185        $self->print_msg("*** Unexpected error. HTTP Response Status: $response_code - Failed.\n");
186        return 0;
187    }
188    }   
189}
190
191sub deactivate_collection {
192    my $self = shift(@_);
193
194    my ($library_url, $gs_mode, $qualified_collection, $site);
195    $library_url = $self->{'library_url'};
196    $gs_mode = $self->{'gs_mode'};
197    $qualified_collection = $self->{'qualified_collection'};
198    $site = $self->{'site'};
199   
200    if($gs_mode eq "gs2") {
201    my $DEACTIVATE_COMMAND = "?a=config&cmd=release-collection&c=";
202    my $check_message_against_regex = q/configured release-collection/;
203    $self->config($DEACTIVATE_COMMAND.$qualified_collection, $check_message_against_regex);
204    }
205    elsif ($gs_mode eq "gs3") {
206    my $DEACTIVATE_COMMAND = "?a=s&sa=d&st=collection&sn=";
207    my $check_message_against_regex = "collection: $qualified_collection deactivated";
208    $self->config($DEACTIVATE_COMMAND.$qualified_collection, $check_message_against_regex, $site);
209    }   
210}
211
212sub activate_collection {
213    my $self = shift(@_);
214
215    my ($library_url, $gs_mode, $qualified_collection, $site);
216    $library_url = $self->{'library_url'};
217    $gs_mode = $self->{'gs_mode'};
218    $qualified_collection = $self->{'qualified_collection'};
219    $site = $self->{'site'};
220
221    if($gs_mode eq "gs2") {
222    my $ACTIVATE_COMMAND = "?a=config&cmd=add-collection&c=";
223    my $check_message_against_regex = q/configured add-collection/;
224    $self->config($ACTIVATE_COMMAND.$qualified_collection, $check_message_against_regex);
225    }
226    elsif ($gs_mode eq "gs3") {
227    my $ACTIVATE_COMMAND = "?a=s&sa=a&st=collection&sn=";
228    my $check_message_against_regex = "collection: $qualified_collection activated";
229    $self->config($ACTIVATE_COMMAND.$qualified_collection, $check_message_against_regex, $site);
230    }   
231}
232
233sub ping {
234    my $self = shift(@_);
235    my $command = shift(@_);
236    my $silent = shift(@_);
237
238    my ($library_url, $gs_mode, $site);
239    $library_url = $self->{'library_url'};     
240    $gs_mode = $self->{'gs_mode'};
241    $site = $self->{'site'};
242   
243    # If the GS server is not running, we *expect* to see a "500" status code.
244    # If the GS server is running, then "Ping" ... "succeeded" is expected on success.
245    # When pinging an inactive collection, it will say it did "not succeed". This is
246    # a message of interest to return.
247    my $check_responsemsg_against_regex = q/(succeeded)/;
248    my $expected_error_code = 500;
249   
250    $self->print_msg("*** COMMAND WAS: |$command|***\n", 4);
251   
252    return $self->config($command, $check_responsemsg_against_regex, $site, $expected_error_code, $silent);
253}
254
255# send a pingaction to the GS library. General server-level ping.
256sub ping_library {
257    my $self = shift(@_);
258
259    my ($library_url, $gs_mode, $site);
260    $library_url = $self->{'library_url'};
261    $gs_mode = $self->{'gs_mode'};
262    $site = $self->{'site'};
263
264    my $command = "";
265    if($gs_mode eq "gs2") {     
266    $command = "?a=ping";       
267    }
268    elsif ($gs_mode eq "gs3") {     
269    $command = "?a=s&sa=ping";
270    }
271    return $self->ping($command);
272}
273
274
275# send a pingaction to a collection in GS library to check if it's active
276sub ping_library_collection {
277    my $self = shift(@_);
278    my $silent = shift(@_);
279
280    my ($library_url, $gs_mode, $qualified_collection, $site);
281    $library_url = $self->{'library_url'};
282    $gs_mode = $self->{'gs_mode'};
283    $qualified_collection = $self->{'qualified_collection'};
284    $site = $self->{'site'};
285    #$silent = $self->{'silent'};
286
287    my $command = "";
288    if($gs_mode eq "gs2") {     
289    $command = "?a=ping&c=$qualified_collection";
290    }
291    elsif ($gs_mode eq "gs3") {     
292    $command = "?a=s&sa=ping&st=collection&sn=$qualified_collection";       
293    }
294    return $self->ping($command, $silent);
295}
296
297# return true if server is persistent, by calling is-persistent on library_url
298# this is only for GS2, since the GS3 server is always persistent
299sub is_persistent {
300    my $self = shift(@_);
301
302    my ($library_url, $gs_mode);
303    $library_url = $self->{'library_url'};
304    $gs_mode = $self->{'gs_mode'};
305   
306    if($gs_mode eq "gs3") { # GS3 server is always persistent
307    return 1;
308    }
309   
310    my $command = "?a=is-persistent";   
311    my $check_responsemsg_against_regex = q/true/;  # isPersistent: true versus isPersistent: false     
312    return $self->config($command, $check_responsemsg_against_regex);
313}
314
315sub set_library_URL {
316    my $self = shift(@_);
317    my $library_url = shift(@_);
318    $self->{'library_url'} = $library_url;
319}
320
321sub get_library_URL {
322    my $self = shift(@_);   
323   
324    # For web servers that are external to a Greenstone installation,
325    # the user can pass in their web server's library URL.
326    if($self->{'library_url'}) {
327    return $self->{'library_url'};
328    }
329   
330    # For web servers included with GS (like tomcat for GS3 and server.exe
331    # and apache for GS2), we work out the library URL:
332    my ($gs_mode, $lib_name); # gs_mode can be gs3 or gs2, lib_name is the custom servlet name
333    $gs_mode = $self->{'gs_mode'};
334    $lib_name = $self->{'library_name'};
335   
336    # If we get here, we are dealing with a server included with GS.
337    # For GS3, we ask ant for the library URL.
338    # For GS2, we derive the URL from the llssite.cfg file.
339   
340    my $url = undef;   
341   
342    if($gs_mode eq "gs2") {     
343    my $llssite_cfg = &FileUtils::filenameConcatenate($ENV{'GSDLHOME'}, "llssite.cfg");
344   
345    if(-f $llssite_cfg) {
346        # check llssite.cfg for line with url property
347        # for server.exe also need to use portnumber and enterlib properties           
348       
349        # Read in the entire contents of the file in one hit
350        if (!open (FIN, $llssite_cfg)) {
351        $self->print_msg("activate.pl::get_library_URL failed to open $llssite_cfg ($!)\n");
352        return undef;
353        }
354       
355        my $contents;
356        sysread(FIN, $contents, -s FIN);           
357        close(FIN);
358       
359        my @lines = split(/[\n\r]+/, $contents); # split on carriage-returns and/or linefeeds
360        my $enterlib = "";
361        my $portnumber = ""; # will remain empty (implicit port 80) unless it's specifically been assigned
362       
363        foreach my $line (@lines) {             
364        if($line =~ m/^url=(.*)$/) {
365            $url = $1;                 
366        } elsif($line =~ m/^enterlib=(.*)$/) {
367            $enterlib = $1;                 
368        } elsif($line =~ m/^portnumber=(.*)$/) {
369            $portnumber = $1;                   
370        }   
371        }
372       
373        if(!$url) {
374        return undef;
375        }
376        elsif($url eq "URL_pending") { # library is not running
377        # do not process url=URL_pending in the file, since for server.exe
378        # this just means the Enter Library button hasn't been pressed yet             
379        $url = undef;
380        }
381        else {
382        # In the case of server.exe, need to do extra work to get the proper URL
383        # But first, need to know whether we're indeed dealing with server.exe:
384       
385        # compare the URL's domain to the full URL
386        # E.g. for http://localhost:8383/greenstone3/cgi-bin, the domain is localhost:8383
387        my $uri = URI->new( $url );
388        my $host = $uri->host;
389        #print STDERR "@@@@@ host: $host\n";
390        if($url =~ m/http:\/\/$host(\/)?$/) {
391            #if($url !~ m/http:\/\/$host:$portnumber(\/)?/ || $url =~ m/http:\/\/$host(\/)?$/) {
392            # (if the URL does not contain the portnumber, OR if the port is implicitly 80 and)                 
393            # If the domain with http:// prefix is completely the same as the URL, assume server.exe
394            # then the actual URL is the result of suffixing the port and enterlib properties in llssite.cfg
395            $url = $url.":".$portnumber.$enterlib;         
396        } # else, apache web server         
397               
398        }           
399    }
400    } elsif($gs_mode eq "gs3") {
401    # Either check build.properties for tomcat.server, tomcat.port and app.name (and default servlet name).
402    # app.name is stored in app.path by build.xml. Need to move app.name in build.properties from build.xml
403   
404    # Or, run the new target get-default-servlet-url
405    # the output can look like:
406    #
407    # Buildfile: build.xml
408    #   [echo] os.name: Windows Vista
409    #
410    # get-default-servlet-url:
411    #   [echo] http://localhost:8383/greenstone3/library
412    # BUILD SUCCESSFUL
413    # Total time: 0 seconds
414   
415    #my $output = qx/ant get-default-servlet-url/; # backtick operator, to get STDOUT (else 2>&1)
416    # see http://stackoverflow.com/questions/799968/whats-the-difference-between-perls-backticks-system-and-exec
417   
418    # The get-default-servlet-url ant target can be run from anywhere by specifying the
419    # location of GS3's ant build.xml buildfile. Activate.pl can be run from anywhere for GS3
420    # GSDL3SRCHOME will be set for GS3 by gs3-setup.sh, a step that would have been necessary
421    # to run the activate.pl script in the first place
422    my $perl_command = "ant -buildfile \"$ENV{'GSDL3SRCHOME'}/build.xml\" get-default-servlet-url";
423   
424    if (open(PIN, "$perl_command |")) {
425        while (defined (my $perl_output_line = <PIN>)) {
426        if($perl_output_line =~ m@http:\/\/(\S*)@) { # grab all the non-whitespace chars
427            $url="http://".$1;
428        }
429        }
430        close(PIN);
431    } else {
432        $self->print_msg("activate.pl::get_library_URL: Failed to run $perl_command to work out library URL for $gs_mode\n");
433    }
434    if(defined $lib_name) {
435        # replace the servlet_name portion of the url found, with the given library_name
436        $url =~ s@/[^/]*$@/$lib_name@;
437    }
438    }
439   
440    # either the url is still undef or it is now set
441    #print STDERR "\n@@@@@ final URL:|$url|\n" if $url;     
442    #print STDERR "\n@@@@@ URL still undef\n" if !$url;
443   
444    $self->{'library_url'} = $url;
445    return $url;
446}
447
448
449sub do_deactivate {
450    my $self = shift(@_);
451
452    my($is_persistent_server, $library_url, $gs_mode, $site, $qualified_collection);
453    $is_persistent_server = $self->{'is_persistent_server'};
454    $library_url = $self->get_library_URL(); #may not yet be set, so can't do $self->{'library_url'};
455    $site = $self->{'site'};
456    $gs_mode = $self->{'gs_mode'};
457    $qualified_collection = $self->{'qualified_collection'};
458
459
460    $self->print_msg("Pinging $library_url\n");     
461    if ($self->ping_library()) { # server running
462   
463    # server is running, so release the collection if
464    # the server is persistent and the collection is active
465
466    # don't need to work out persistency of server more than once, since the libraryURL hasn't changed
467    if (!defined $is_persistent_server) {
468        $self->print_msg("Checking if Greenstone server is persistent\n");
469        $is_persistent_server = $self->is_persistent();
470        $self->{'is_persistent_server'} = $is_persistent_server;
471    }
472   
473    if ($is_persistent_server) { # only makes sense to issue activate and deactivate cmds to a persistent server
474       
475        $self->print_msg("Checking if the collection $qualified_collection is already active\n");
476        my $collection_active = $self->ping_library_collection();
477       
478        if ($collection_active) {
479        $self->print_msg("De-activating collection $qualified_collection\n");
480        $self->deactivate_collection();
481        }
482        else {
483        $self->print_msg("Collection is not active => No need to deactivate\n");
484        }
485    }
486    else {
487        $self->print_msg("Server is not persistent => No need to deactivate collection\n");
488    }
489    }
490    else {
491    $self->print_msg("No response to Ping => Taken to mean server is not running\n");
492    }
493   
494    return $is_persistent_server;
495}
496
497sub do_activate {
498    my $self = shift @_;
499
500    my($is_persistent_server, $library_url, $gs_mode, $site, $qualified_collection);
501    $is_persistent_server = $self->{'is_persistent_server'};
502    $library_url = $self->get_library_URL(); #may not yet be set, so can't do $self->{'library_url'};
503    $site = $self->{'site'};
504    $gs_mode = $self->{'gs_mode'};
505    $qualified_collection = $self->{'qualified_collection'};
506
507    $self->print_msg("Pinging $library_url\n");
508    if ($self->ping_library()) { # server running
509   
510    # don't need to work out persistency of server more than once, since the libraryURL hasn't changed
511    if (!defined $is_persistent_server) {
512        $self->print_msg("Checking if Greenstone server is persistent\n");
513        $is_persistent_server = $self->is_persistent();
514        $self->{'is_persistent_server'} = $is_persistent_server;
515    }
516   
517    if ($is_persistent_server) { # persistent server, so can try activating collection
518       
519        $self->print_msg("Checking if the collection $qualified_collection is not already active\n");
520       
521        # Since we could have deactivated the collection at this point,
522        # it is likely that it is not yet active. When pinging the collection
523        # a "ping did not succeed" message is expected, therefore tell the ping
524        # to proceed silently
525        my $silent = 1;
526        my $collection_active = $self->ping_library_collection($silent);
527       
528        if (!$collection_active) {
529        $self->print_msg(" Collection is not active.\n");
530        $self->print_msg("Activating collection $qualified_collection\n");
531        $self->activate_collection();
532       
533        # unless an error occurred, the collection should now be active:
534        $collection_active = $self->ping_library_collection(); # not silent if ping did not succeed
535        if(!$collection_active) {
536            $self->print_msg("ERROR: collection $qualified_collection did not get activated\n");
537        }
538        }
539        else {
540        $self->print_msg("Collection is already active => No need to activate\n");
541        }
542    }
543    else {
544        $self->print_msg("Server is not persistent => No need to activate collection\n");
545    }
546    }
547    else {
548    $self->print_msg("No response to Ping => Taken to mean server is not running\n");
549    }
550   
551    return $is_persistent_server;
552}
553
554
555#########################################################
556### UNUSED METHODS - CAN BE HANDY
557
558# This method is now unused. Using ping_library instead to send the ping action to a
559# GS2/GS3 server. This method can be used more generally to test whether a URL is alive.
560# http://search.cpan.org/dist/libwww-perl/lib/LWP/Simple.pm
561# and http://www.perlmonks.org/?node_id=618534
562sub is_URL_active {
563    my $url = shift(@_); # gs3 or gs2 URL   
564   
565    my $status = 0;
566    if(defined $url) {
567    $ua->timeout(10); # set LWP useragent to 5s max timeout for testing the URL
568    # Need to set this, else it takes I don't know how long to timeout
569    # http://www.perlmonks.org/?node_id=618534
570   
571    $status = LWP::Simple::head($url); # returns empty list of headers if it fails
572    # LWP::Simple::get($url) is more intensive, so don't need to do that
573    #print STDERR "**** $url is alive.\n" if $status;
574    }
575    return $status;
576}
577
578# Pinging seems to always return true, so this method doesn't work
579sub pingHost {
580    my $url = shift(@_); # gs3 or gs2 URL
581   
582    my $status = 0;
583    if(defined $url) {
584    # Get just the domain. "http://localhost/gsdl?uq=332033495" becomes "localhost"
585    # "http://localhost/greenstone/cgi-bin/library.cgi" becomes "localhost" too
586   
587    #my $host = $url;       
588    #$host =~ s@^http:\/\/(www.)?@@;       
589    #$host =~ s@\/.*@@;
590    #print STDERR "**** HOST: $host\n";
591   
592    # More robust way
593    # http://stackoverflow.com/questions/827024/how-do-i-extract-the-domain-out-of-an-url
594    my $uri = URI->new( $url );
595    my $host = $uri->host;
596   
597    # Ping the host. http://perldoc.perl.org/Net/Ping.html 
598    my $p = Net::Ping->new();       
599    $status = $p->ping($host); # || 0. Appears to set to undef rather than 0
600    print STDERR "**** $host is alive.\n" if $status; #print "$host is alive.\n" if $p->ping($host);
601    $p->close();       
602    }
603    # return whether pinging was a success or failure
604    return $status;
605}
606
6071;
Note: See TracBrowser for help on using the browser.