root/main/trunk/greenstone2/common-src/cgi-bin/gsdlCGI.pm @ 31989

Revision 31989, 24.8 KB (checked in by ak19, 2 years ago)

Another bugfix with remote GS noticed with GS2: search results didn't return the actual document that contained the search term because remote GS env didn't have the PERL_PERTURB_KEYS env var set to off.

  • Property svn:keywords set to Author Date Id Revision
Line 
1package gsdlCGI;
2
3# This file merges Michael Dewsnip's gsdlCGI.pm for GS2 and Quan Qiu's gsdlCGI4gs3.pm (GS3)
4
5use strict;
6no strict 'subs';
7no strict 'refs'; # allow filehandles to be variables and viceversa
8
9use CGI;
10use Cwd;
11use MIME::Base64;
12
13@gsdlCGI::ISA = ( 'CGI' );
14
15our $server_software;
16our $server_version;
17
18sub BEGIN {
19    $server_software = $ENV{'SERVER_SOFTWARE'};
20
21    if (defined $server_software) {
22    if ($server_software =~ m/^Microsoft-IIS\/(.*)$/) {
23        $server_version = $1;
24    }
25    }
26}
27
28
29sub prenew {
30    my $class = shift @_;
31       
32    my $version;
33    if (-e "gsdl3site.cfg") {
34    $version = 3;
35    } else {
36    $version = 2;
37    }
38
39    my $self = {};
40
41    if ($version == 2) {
42    $self->{'site_filename'} = "gsdlsite.cfg";
43    $self->{'greenstone_version'} = 2;
44    }
45    elsif ($version == 3) {
46    $self->{'site_filename'} = "gsdl3site.cfg";
47    $self->{'greenstone_version'} = 3;
48    }
49   
50    my $bself = bless $self, $class;
51
52    $bself->setup_gsdl();
53
54    return $bself;
55}
56
57
58sub new {
59    my $class = shift @_;
60   
61    my $self;
62   
63    # We'll determine the correct config file in this constructor itself
64    # and use it to determine the Greenstone server's version.
65    # Perhaps later, another test can be used for finding out what version
66    # of the Greenstone server we are working with.
67    my $version;
68    if (-e "gsdl3site.cfg") {
69    $version = 3;
70    } else {
71    $version = 2;
72    }
73
74    # POST that is URL-encoded (like a GET) is a line that needs to be read from STDIN
75    if ((defined $ENV{'CONTENT_TYPE'}) && ($ENV{'CONTENT_TYPE'} =~ m/form-urlencoded/)) {
76    my $line = <STDIN>;
77    if ((defined $line) && ($line ne "")) {
78        $self = new CGI($line);
79    }
80    }
81   
82    # If the conditions above did not hold, then self=new CGI(@_)
83    if (!defined $self) {
84    # It's a GET, or else a POST with Multi-part body
85    $self = new CGI(@_);
86    }
87
88
89    if ($version == 2) {
90    $self->{'site_filename'} = "gsdlsite.cfg";
91    $self->{'greenstone_version'} = 2;
92    }
93    elsif ($version == 3) {
94    $self->{'site_filename'} = "gsdl3site.cfg";
95    $self->{'greenstone_version'} = 3;
96    }
97   
98    return bless $self, $class;
99}
100
101
102sub parse_cgi_args
103{
104    my $self = shift @_;
105    my $xml = (defined $self->param("xml")) ? 1 : 0;
106
107    $self->{'xml'} = $xml;
108
109    my @var_names = $self->param;
110    my @arg_list = ();
111    foreach my $n ( @var_names ) {
112    my $arg = "$n=";
113    my $val =  $self->param($n);
114    $arg .= $val if (defined $val);
115    push(@arg_list,$arg);
116    }
117   
118    $self->{'args'} = join("&",@arg_list);
119}
120
121
122sub clean_param
123{
124    my $self = shift @_;
125    my ($param) = @_;
126
127    my $val = $self->SUPER::param($param);
128    $val =~ s/[\r\n]+$// if (defined $val);
129
130    return $val;
131}
132
133sub safe_val
134{
135    my $self = shift @_;
136    my ($val) = @_;
137
138    # convert any encoded entities to true form
139    $val =~ s/&amp;/&/osg;
140    $val =~ s/&lt;/</osg;
141    $val =~ s/&gt;/>/osg;
142    $val =~ s/&quot;/\"/osg;
143    $val =~ s/&nbsp;/ /osg;
144
145
146    # ensure only alpha-numeric plus a few other special chars remain
147
148    $val =~ s/[^[:alnum:]@\.\/\- :_]//g if (defined $val);
149
150    return $val;
151}
152
153sub generate_message
154{
155    my $self = shift @_;
156    my ($message) = @_;
157
158
159    binmode(STDOUT,":utf8");   
160    print STDOUT "Content-type:text/plain\n\n$message";
161}
162
163sub generate_error
164{
165    my $self = shift @_;
166    my ($mess) = @_;
167   
168    my $xml = $self->{'xml'};
169
170    my $full_mess;
171    my $args = $self->{'args'};
172
173    if ($xml) {
174    # Make $args XML safe
175    my $args_xml_safe = $args;
176    $args_xml_safe =~ s/&/&amp;/g;
177
178    $full_mess =  "<Error>\n";
179    $full_mess .= "  $mess\n";
180    $full_mess .= "  CGI args were: $args_xml_safe\n";
181    $full_mess .= "</Error>\n";
182    }
183    else {
184    $full_mess = "ERROR: $mess\n  ($args)\n";
185    }
186
187    $self->generate_message($full_mess);
188
189    die $full_mess;
190}
191
192sub generate_warning
193{
194    my $self = shift @_;
195    my ($mess) = @_;
196   
197    my $xml = $self->{'xml'};
198
199    my $full_mess;
200    my $args = $self->{'args'};
201
202    if ($xml) {
203    # Make $args XML safe
204    my $args_xml_safe = $args;
205    $args_xml_safe =~ s/&/&amp;/g;
206
207    $full_mess =  "<Warning>\n";
208    $full_mess .= "  $mess\n";
209    $full_mess .= "  CGI args were: $args_xml_safe\n";
210    $full_mess .= "</Warning>\n";
211    }
212    else {
213    $full_mess = "Warning: $mess ($args)\n";
214    }
215
216    $self->generate_message($full_mess);
217
218    print STDERR $full_mess;
219}
220
221
222sub generate_ok_message
223{
224    my $self = shift @_;
225    my ($mess) = @_;
226   
227    my $xml = $self->{'xml'};
228
229    my $full_mess;
230
231    if ($xml) {
232    $full_mess =  "<Accepted>\n";
233    $full_mess .= "  $mess\n";
234    $full_mess .= "</Accepted>\n";
235    }
236    else {
237    $full_mess = "$mess";
238    }
239 
240    $self->generate_message($full_mess);
241}
242
243
244
245sub get_config_info {
246    my $self = shift @_;
247    my ($infotype, $optional) = @_;
248
249    my $site_filename = $self->{'site_filename'};
250    open (FILEIN, "<$site_filename")
251    || $self->generate_error("Could not open $site_filename");
252
253    my $config_content = "";
254    while(defined (my $line = <FILEIN>)) {
255    $config_content .= $line;
256    }
257    close(FILEIN);
258
259    my ($loc) = ($config_content =~ m/^$infotype\s+((\".+\")|(\S+))\s*\n/m);
260    $loc =~ s/\"//g if defined $loc;
261
262    if ((!defined $loc) || ($loc =~ m/^\s*$/)) {
263    if((!defined $optional) || (!$optional)) {
264        $self->generate_error("$infotype is not set in $site_filename");
265    }
266    }
267
268    return $loc;
269}
270
271sub get_gsdl3_src_home{
272    my $self = shift @_;
273    if (defined $self->{'gsdl3srchome'}) {
274    return $self->{'gsdl3srchome'};
275    }
276
277    my $gsdl3srchome = $self->get_config_info("gsdl3srchome");
278
279    if(defined $gsdl3srchome) {
280    $gsdl3srchome =~ s/(\/|\\)$//; # remove trailing slash
281    }
282    $self->{'gsdl3srchome'} = $gsdl3srchome;
283
284    return $gsdl3srchome;
285}
286
287
288sub get_gsdl_home {
289    my $self = shift @_;
290   
291    if (defined $self->{'gsdlhome'}) {
292    return $self->{'gsdlhome'};
293    }
294
295    my $gsdlhome = $self->get_config_info("gsdlhome");
296
297    $gsdlhome =~ s/(\/|\\)$//; # remove trailing slash
298
299    $self->{'gsdlhome'} = $gsdlhome;
300
301    return $gsdlhome;
302}
303
304sub get_gsdl3_home {
305    my $self = shift @_;
306    my ($optional) = @_;
307   
308    if (defined $self->{'gsdl3home'}) {
309    return $self->{'gsdl3home'};
310    }
311
312    my $gsdl3home = $self->get_config_info("gsdl3home", $optional);
313
314    if(defined $gsdl3home) {
315    $gsdl3home =~ s/(\/|\\)$//; # remove trailing slash
316    $self->{'gsdl3home'} = $gsdl3home;
317    }
318    return $gsdl3home;
319}
320
321sub get_java_home {
322    my $self = shift @_;
323    my ($optional) = @_;
324   
325    if (defined $self->{'javahome'}) {
326    return $self->{'javahome'};
327    }
328
329    my $javahome = $self->get_config_info("javahome", $optional);
330    if(defined $javahome) {
331    $javahome =~ s/(\/|\\)$//; # remove trailing slash
332    $self->{'javahome'} = $javahome;
333    }
334    return $javahome;
335}
336
337sub get_perl_path {
338    my $self = shift @_;
339    my ($optional) = @_;
340   
341    if (defined $self->{'perlpath'}) {
342    return $self->{'perlpath'};
343    }
344
345    my $perlpath = $self->get_config_info("perlpath", $optional);
346
347    if(defined $perlpath) {
348    $perlpath =~ s/(\/|\\)$//; # remove trailing slash
349    $self->{'perlpath'} = $perlpath;
350    }
351    return $perlpath;
352}
353
354sub get_gsdl_os {
355    my $self = shift @_;
356   
357    my $os = $^O;
358
359    if ($os =~ m/linux/i) {
360    return "linux";
361    }
362    elsif ($os =~ m/mswin/i) {
363    return "windows";
364    }
365    elsif ($os =~ m/macos/i) {
366    return "darwin";
367    }
368    else {
369    # return as is.
370    return $os;
371    }
372}
373
374sub get_library_url_suffix {
375    my $self = shift @_;
376   
377    if (defined $self->{'library_url_suffix'}) {
378    return $self->{'library_url_suffix'};
379    }
380
381    my $optional = 1; # ignore absence of gwcgi if not found
382    my $library_url = $self->get_config_info("gwcgi", $optional);
383    if(defined $library_url) {
384    $library_url =~ s/(\/|\\)$//; # remove trailing slash
385    }
386    else {
387
388    if($self->{'greenstone_version'} == 2) {
389        $library_url = $self->get_config_info("httpprefix", $optional);
390        $library_url = "/greenstone" unless defined $library_url;
391        $library_url = "$library_url/cgi-bin/library.cgi"; # same extension for linux and windows
392    }
393    else { # greenstone 3 or later and gwcgi not defined
394        $library_url = "/greenstone3"; #"/greenstone3/library";
395    }
396    }
397
398    $self->{'library_url_suffix'} = $library_url;
399    return $library_url;
400}
401
402sub setup_fedora_homes {
403    my $self = shift @_;
404    my ($optional) = @_;
405
406    # The following will still allow the FEDORA_HOME and FEDORA_VERSION environment
407    # variables to have been set outside the gsdlsite.cfg file. Existing env vars
408    # are only overwritten if they've *also* been defined in gsdlsite.cfg.
409
410    if (!defined $self->{'fedora_home'}) # Don't need to go through it all again if we'd already done this before
411    {
412    # First look in the gsdlsite.cfg file for the fedora properties to be defined
413    # and set $ENV{FEDORA_HOME} and $ENV{FEDORA_VERSION} if values were provided
414    $self->{'fedora_home'} = $self->get_config_info("fedorahome", $optional);
415   
416    if (defined $self->{'fedora_home'}) {
417        $ENV{'FEDORA_HOME'} = $self->{'fedora_home'};
418    }
419    elsif (defined $ENV{'FEDORA_HOME'}) { # check environment variable
420        $self->{'fedora_home'} = $ENV{'FEDORA_HOME'};
421    }
422   
423    # if FEDORA_HOME is now defined, we can look for the fedora version that is being used
424    if (defined $ENV{'FEDORA_HOME'})
425    {
426        # first look in the file
427        $self->{'fedora_version'} = $self->get_config_info("fedoraversion", $optional);
428
429        if (defined $self->{'fedora_version'}) {
430        $ENV{'FEDORA_VERSION'} = $self->{'fedora_version'};
431        }
432        elsif (defined $ENV{'FEDORA_VERSION'}) { # then check environment variable
433        $self->{'fedora_version'} = $ENV{'FEDORA_VERSION'};
434        }
435        else { # finally, default to version 3 and warn the user
436        $ENV{'FEDORA_VERSION'} = "3";
437        $self->{'fedora_version'} = $ENV{'FEDORA_VERSION'};
438        #$self->generate_ok_message("FEDORA_HOME is set, but not FEDORA_VERSION, defaulted to: 3.");
439        }
440    }
441    }
442}
443
444# sets optional customisable values to do with Open Office
445sub setup_openoffice {
446    my $self = shift @_;
447    my ($optional) = @_;
448
449    if (!defined $self->{'soffice_home'}) # Don't need to go through it all again if we'd already done this before
450    {
451        # Look in gsdlsite.cfg for whether the openoffice
452        # and jodconverter properties have been defined
453        $self->{'soffice_home'} = $self->get_config_info("soffice_home", $optional);
454        $self->{'soffice_host'} = $self->get_config_info("soffice_host", $optional);
455        $self->{'soffice_port'} = $self->get_config_info("soffice_port", $optional);
456        $self->{'jodconverter_port'} = $self->get_config_info("jodconverter_port", $optional);
457       
458        if (defined $self->{'soffice_home'}) {
459            $ENV{'SOFFICE_HOME'} = $self->{'soffice_home'};
460        }   
461        if (defined $self->{'soffice_host'}) {
462            $ENV{'SOFFICE_HOST'} = $self->{'soffice_host'};
463        }
464        if (defined $self->{'soffice_port'}) {
465            $ENV{'SOFFICE_PORT'} = $self->{'soffice_port'};
466        }
467        if (defined $self->{'jodconverter_port'}) {
468            $ENV{'JODCONVERTER_PORT'} = $self->{'jodconverter_port'};
469        }
470    }
471}
472
473sub setup_gsdl {
474    my $self = shift @_;
475    my $optional = 1; # ignore absence of specified properties in gsdl(3)site.cfg if not found
476
477    my $gsdlhome = $self->get_gsdl_home();
478    my $gsdlos = $self->get_gsdl_os();
479    $ENV{'GSDLHOME'} = $gsdlhome;
480    $ENV{'GSDLOS'} = $gsdlos;
481
482    if (defined $server_software) {
483    if ($server_software =~ m/^Microsoft-IIS/) {
484        # Printing to STDERR, by default, goes to the web page in IIS
485        # Send it instead to Greenstone's error.txt
486       
487        my $error_filename = "$gsdlhome/etc/error.txt"; # OK for Windows
488        open STDERR, ">> $error_filename"
489        or  die "Can't write to $error_filename: $!\n";
490        binmode STDERR;
491    }
492    }
493
494    my $library_url = $self->get_library_url_suffix(); # best to have GSDLOS set beforehand
495    $self->{'library_url_suffix'} = $library_url;
496
497    my $cgibin = "cgi-bin/$ENV{'GSDLOS'}";
498    $cgibin = $cgibin.$ENV{'GSDLARCH'} if defined $ENV{'GSDLARCH'};
499
500    unshift(@INC, "$ENV{'GSDLHOME'}/$cgibin"); # This is OK on Windows
501    unshift(@INC, "$ENV{'GSDLHOME'}/perllib");
502    unshift(@INC, "$ENV{'GSDLHOME'}/perllib/cpan");
503    unshift(@INC, "$ENV{'GSDLHOME'}/perllib/cgiactions");
504
505    require util;
506
507    if($self->{'greenstone_version'} == 3) {
508    my $gsdl3srchome = $self->get_gsdl3_src_home();
509    $ENV{'GSDL3SRCHOME'} = $gsdl3srchome;
510
511    my $gsdl3home = $self->get_gsdl3_home($optional);
512    # if a specific location for GS3's web folder is not provided,
513    # assume the GS3 web folder is in the default location
514    if(!defined $gsdl3home) {
515        $gsdl3home = &FileUtils::filenameConcatenate($ENV{'GSDL3SRCHOME'}, "web");
516        $self->{'gsdl3home'} = $gsdl3home;
517    }
518    $ENV{'GSDL3HOME'} = $gsdl3home;
519    }
520   
521    my $gsdl_bin_script = &FileUtils::filenameConcatenate($gsdlhome,"bin","script");
522    &util::envvar_prepend("PATH",$gsdl_bin_script);
523   
524    my $gsdl_bin_os = &FileUtils::filenameConcatenate($gsdlhome,"bin",$gsdlos);
525    &util::envvar_prepend("PATH",$gsdl_bin_os);
526   
527    # set up ImageMagick for the remote server in parallel to what setup.bash does
528    my $magick_home = &FileUtils::filenameConcatenate($gsdl_bin_os,"imagemagick");
529    if(-e $magick_home) {
530    &util::envvar_prepend("PATH", $magick_home);
531
532    # Doesn't look like 'bin' and 'lib' are used for Windows version anymore,
533    # but that might just be one particular installation pattern, and there's
534    # no harm (that I can see) in keeping them in
535
536    my $magick_bin = &FileUtils::filenameConcatenate($magick_home,"bin");
537    my $magick_lib = &FileUtils::filenameConcatenate($magick_home,"lib");
538
539    &util::envvar_prepend("PATH", $magick_bin);
540
541    if(!defined $ENV{'MAGICK_HOME'} || $ENV{'MAGICK_HOME'} eq "") {
542        $ENV{'MAGICK_HOME'} = $magick_home;
543    }
544   
545    if($gsdlos eq "linux") {
546        &util::envvar_prepend("LD_LIBRARY_PATH", $magick_lib);
547    } elsif ($gsdlos eq "darwin") {
548        &util::envvar_prepend("DYLD_LIBRARY_PATH", $magick_lib);
549    }
550
551    }
552
553    # set up GhostScript for the remote server in parallel to what setup.bash does
554    my $ghostscript_home = &FileUtils::filenameConcatenate($gsdl_bin_os,"ghostscript");
555    if(-e $ghostscript_home) {
556    my $ghostscript_bin = &FileUtils::filenameConcatenate($ghostscript_home,"bin");
557    &util::envvar_prepend("PATH", $ghostscript_bin);
558
559    if(!defined $ENV{'GS_LIB'} || $ENV{'GS_LIB'} eq "") {
560        $ENV{'GS_LIB'} = &FileUtils::filenameConcatenate($ghostscript_home,"share","ghostscript","8.63","lib");     
561    }
562    if(!defined $ENV{'GS_FONTPATH'} || $ENV{'GS_FONTPATH'} eq "") {
563        $ENV{'GS_FONTPATH'} = &FileUtils::filenameConcatenate($ghostscript_home,"share","ghostscript","8.63","Resource","Font");
564    }
565    }
566
567    # If the "perlpath" property is set in the gsdl(3)site.cfg config file, it is
568    # prepended to PATH only if the same perl bin dir path is not already on PATH env
569    my $perl_bin_dir = $self->get_perl_path($optional);
570    if(defined $perl_bin_dir)
571    {
572    &util::envvar_prepend("PATH", $perl_bin_dir);
573
574    #my ($perl_home) = ($perl_bin_dir =~ m/(.*)[\\|\/]bin[\\|\/]?$/);
575    my ($tailname,$perl_home) = File::Basename::fileparse($perl_bin_dir, "\\.(?:[^\\.]+?)\$");
576    $ENV{'PERL5LIB'} = &FileUtils::filenameConcatenate($perl_home, "lib");
577
578    # add vendor\lib if it exists to PERL5LIB
579    # Strawberry Perl has a perl\vendor\lib folder. Check for it, if it exists add it to PATH for windows
580    # (Windows adds paths to library/dll files to PATH)
581    my $vendor_lib = &FileUtils::filenameConcatenate($perl_home, "vendor", "lib");
582    if(FileUtils::fileExists($vendor_lib)) {
583        &util::envvar_prepend("PATH", $vendor_lib) if $gsdlos eq "windows";
584        &util::envvar_append("PERL5LIB", $vendor_lib);
585    }
586
587    if($gsdlos eq "darwin") {
588        &util::envvar_prepend("DYLD_LIBRARY_PATH", &FileUtils::filenameConcatenate($perl_home,"5.8.9","darwin-thread-multi-2level","CORE"));
589    } elsif($gsdlos eq "linux") {
590        &util::envvar_prepend("LD_LIBRARY_PATH", &FileUtils::filenameConcatenate($perl_home,"5.8.9","i686-linux-thread-multi","CORE"));
591    }
592    }
593    elsif ($gsdlos eq "windows")
594    {
595    # Perl comes installed with the GS Windows Release Kit. However, note that if GS
596    # is from SVN, the user must have their own Perl and put it on the PATH or set
597    # perlpath in the gsdl site config file.
598    $perl_bin_dir = &FileUtils::filenameConcatenate($gsdlhome, "bin", "windows", "perl", "bin");
599    if(-e $perl_bin_dir) {
600        &util::envvar_append("PATH", $perl_bin_dir);
601
602        my ($tailname,$perl_home) = File::Basename::fileparse($perl_bin_dir, "\\.(?:[^\\.]+?)\$");
603        my $vendor_lib = &FileUtils::filenameConcatenate($perl_home, "vendor", "lib");
604        if(FileUtils::fileExists($vendor_lib)) {
605        &util::envvar_prepend("PATH", $vendor_lib) if $gsdlos eq "windows";
606        &util::envvar_append("PERL5LIB", $vendor_lib);
607        }
608    }
609    }
610   
611    # If javahome is explicitly set in the gsdl site config file then it will override
612    # any env variable JAVA_HOME. A GS2 server does not set JAVA_HOME, though java is on
613    # the path. Therefore, if Fedora is being used for FLI with GS2, then javahome must
614    # be set in gsdlsite.cfg or the JAVA_HOME env var must be explicitly set by the user.
615    my $java_home = $self->get_java_home($optional);
616    if(defined $java_home) {
617    $ENV{'JAVA_HOME'} = $java_home;
618    }
619
620
621    # Process any extension setup.pl files
622    my @ext_homes = ();
623
624    my $gsdl_ext_home = &FileUtils::filenameConcatenate($gsdlhome,"ext");
625    push(@ext_homes,$gsdl_ext_home);
626
627    if ($self->{'greenstone_version'} == 3) {
628    my $gsdl3srchome = $self->get_gsdl3_src_home();
629    my $gsdl3_ext_home = &FileUtils::filenameConcatenate($gsdl3srchome,"ext");
630    push(@ext_homes,$gsdl3_ext_home);
631    }
632
633    # Don't pass the arguments to gliserver.pl (e.g. cmd=check-installation) to Greenstone extensions' setup files
634    print STDERR "Args: " . join(",", @ARGV)."\n";
635    my @saved_args = @ARGV;
636    if (scalar(@ARGV>0)) {
637    @ARGV=();
638    }
639
640    foreach my $ext_home (@ext_homes) {
641    # Should really think about making this a subroutine
642
643    if (opendir(EXTDIR,$ext_home) ) {
644        my @pot_ext_dir = grep { $_ !~ m/^\./ } readdir(EXTDIR);
645       
646        closedir(EXTDIR);
647       
648        foreach my $ed (@pot_ext_dir) {
649        my $full_ext_dir = &FileUtils::filenameConcatenate($ext_home,$ed);
650
651        if (-d $full_ext_dir) {
652
653            my $full_ext_perllib_dir = &FileUtils::filenameConcatenate($full_ext_dir,"perllib");
654            if (-d $full_ext_perllib_dir) {
655            unshift (@INC, $full_ext_perllib_dir);
656            }
657
658            my $full_inc_file = &FileUtils::filenameConcatenate($full_ext_dir,
659                                "$ed-setup.pl");
660            if (-f $full_inc_file) {
661           
662            my $store_cwd = Cwd::cwd();
663           
664            chdir($full_ext_dir);
665            require "./$ed-setup.pl";
666            chdir($store_cwd);
667            }
668        }
669        }
670    }
671    }
672
673    # restore the args to gliserver.pl
674    @ARGV = @saved_args;
675    print STDERR "Args: " . join(",", @ARGV)."\n";
676
677    # FEDORA_HOME and FEDORA_VERSION are needed (by scripts g2f-import and g2f-buildcol).
678    $self->setup_fedora_homes($optional);
679
680
681    # Check for any customisations to Open-Office if on Windows
682    if ($gsdlos eq "windows") {
683    $self->setup_openoffice($optional);
684    }
685
686    # If perl_perturb_keys isn't set, then search results with remote GS
687    # return different documents from the ones that should be returned
688    $ENV{'PERL_PERTURB_KEYS'}=0;
689    $ENV{'WGETRC'}=&FileUtils::filenameConcatenate($gsdlhome,"bin",$gsdlos,"wgetrc");
690}
691
692sub greenstone_version {
693    my $self = shift @_;
694    return $self->{'greenstone_version'};
695}
696
697sub library_url_suffix {
698    my $self = shift @_;
699    return $self->{'library_url_suffix'};
700}
701
702# Only useful to call this after calling setup_gsdl, as it uses some environment variables
703# Returns the Greenstone collect directory, or a specific collection directory inside collect
704sub get_collection_dir {
705    my $self = shift @_;
706    my ($site, $collection) = @_; # both may be undefined
707   
708    my $collection_directory;
709    if($self->{'greenstone_version'} == 2 && defined $ENV{'GSDLHOME'}) {
710    if(defined $collection) {
711        $collection_directory = &FileUtils::filenameConcatenate($ENV{'GSDLHOME'}, "collect", $collection);
712    } else {
713        $collection_directory = &FileUtils::filenameConcatenate($ENV{'GSDLHOME'}, "collect");
714    }
715    }
716    elsif($self->{'greenstone_version'} == 3) {
717    if(defined $ENV{'GSDL3HOME'}) {
718        if(defined $collection) {
719        $collection_directory = &FileUtils::filenameConcatenate($ENV{'GSDL3HOME'}, "sites", $site, "collect", $collection);
720        } else {
721        $collection_directory = &FileUtils::filenameConcatenate($ENV{'GSDL3HOME'}, "sites", $site, "collect");
722        }
723    }
724    elsif(defined $ENV{'GSDL3SRCHOME'}) {
725        if(defined $collection) {
726        $collection_directory = &FileUtils::filenameConcatenate($ENV{'GSDL3SRCHOME'}, "web", "sites", $site, "collect", $collection);
727        } else {
728        $collection_directory = &FileUtils::filenameConcatenate($ENV{'GSDL3SRCHOME'}, "web", "sites", $site, "collect");
729        }
730    }
731    }
732    return $collection_directory;
733}
734
735sub local_rm_r
736{
737    my $self = shift @_;
738    my ($local_dir) = @_;
739
740    my $prefix_dir = getcwd();
741    my $full_path = &FileUtils::filenameConcatenate($prefix_dir,$local_dir);
742   
743    if ($prefix_dir !~ m/collect/) {
744    $self->generate_error("Trying to delete outside of Greenstone collect: $full_path");
745    }
746
747    # Delete recursively
748    if (!-e $full_path) {
749    $self->generate_error("File/Directory does not exist: $full_path");
750    }
751
752    &FileUtils::removeFilesRecursive($full_path);
753}
754
755
756sub get_java_path()
757{
758    # Check the JAVA_HOME environment variable first
759    if (defined $ENV{'JAVA_HOME'}) {
760    my $java_home = $ENV{'JAVA_HOME'};
761    $java_home =~ s/\/$//;  # Remove trailing slash if present (Unix specific)
762    return &FileUtils::filenameConcatenate($java_home, "bin", "java");
763    }
764
765    elsif (defined $ENV{'JRE_HOME'}) {
766    my $jre_home = $ENV{'JRE_HOME'};
767    $jre_home =~ s/\/$//;  # Remove trailing slash if present (Unix specific)
768    return &FileUtils::filenameConcatenate($jre_home, "bin", "java");
769    }
770
771    # Hope that Java is on the PATH
772    return "java";
773}
774
775
776sub check_java_home()
777{
778    # Return a warning unless the JAVA_HOME environment variable is set
779    if (!defined $ENV{'JAVA_HOME'}) {
780    return "JAVA_HOME environment variable not set. Might not be able to find Java unless in PATH (" . $ENV{'PATH'} . ")";
781    }
782
783    return "";
784}
785
786
787sub checked_chdir
788{
789    my $self = shift @_;
790    my ($dir) = @_;
791
792    if (!-e $dir) {
793    $self->generate_error("Directory '$dir' does not exist");
794    }
795
796    chdir $dir
797    || $self->generate_error("Unable to change to directory: $dir");
798}
799
800# used with old GS3 authentication
801sub rot13()
802{
803    my $self = shift @_;
804    my ($password)=@_;
805    my @password_arr=split(//,$password);
806   
807    my @encrypt_password;
808    foreach my $str (@password_arr){
809    my $char=unpack("c",$str);
810    if ($char>=97 && $char<=109){
811        $char+=13;
812    }elsif ($char>=110 && $char<=122){
813        $char-=13;
814    }elsif ($char>=65 && $char<=77){
815        $char+=13;
816    }elsif ($char>=78 && $char<=90){
817        $char-=13;
818    }
819    $char=pack("c",$char);
820    push(@encrypt_password,$char);
821    }
822    return join("",@encrypt_password);
823}
824
825# used along with new GS3 authentication
826sub hash_pwd()
827{
828    my $self = shift @_;
829    my ($password)=@_;
830
831    my $gsdl3srchome = $ENV{'GSDL3SRCHOME'};
832   
833    my $java = get_java_path();
834    my $java_gsdl3_classpath = &FileUtils::filenameConcatenate($gsdl3srchome, "web", "WEB-INF", "lib", "gsdl3.jar");
835    my $java_remaining_classpath = &FileUtils::filenameConcatenate($gsdl3srchome, "web", "WEB-INF", "lib", "*"); # log4j etc
836    my $java_classpath;
837    my $gsdlos = $ENV{'GSDLOS'};
838    if ($gsdlos !~ m/windows/){
839    $java_classpath = $java_gsdl3_classpath . ":" . $java_remaining_classpath;
840    }else{
841    $java_classpath = $java_gsdl3_classpath . ";" . $java_remaining_classpath;
842    } # can't use util::envvar_prepend(), since the $java_classpath here is not a $ENV type env variable
843   
844    my $java_command="\"$java\" -classpath \"$java_classpath\" org.greenstone.gsdl3.service.Authentication \"$password\""; # 2>&1";
845    my $hashedpwd = `$java_command`;
846
847    return $hashedpwd;
848}
849
850sub encrypt_key
851{
852    my $self = shift @_;
853
854    # I think the encryption method used on the key may be the same for GS3 and GS2
855    # (The encryption method used on the pw definitely differs between the two GS versions)
856    if (defined $self->param("ky")) {
857    require "$self->{'gsdlhome'}/perllib/cpan/Crypt/UnixCrypt.pm";  # This is OK on Windows
858    $self->param('-name' => "ky", '-value' => &Crypt::UnixCrypt::crypt($self->clean_param("ky"), "Tp"));
859    }
860}
861
862sub encrypt_password
863{
864    my $self = shift @_;
865   
866    if (defined $self->param("pw")) { ##
867    if ($self->{'greenstone_version'} == 3) { # GS3 is in Java, so needs different encryption
868        #$self->param('-name' => "pw", '-value' => $self->rot13($self->clean_param("pw"))); ## when using old GS3 authentication
869
870        my $hashedPwd = $self->hash_pwd($self->clean_param("pw")); # for GS3's new Authentication
871        $self->param('-name' => "pw", '-value' => $hashedPwd);
872    }
873    else { # GS2 (and versions of GS other than 3?)
874        #require "$self->{'gsdlhome'}/perllib/util.pm";  # This is OK on Windows
875        require "$self->{'gsdlhome'}/perllib/cpan/Crypt/UnixCrypt.pm";  # This is OK on Windows
876        $self->param('-name' => "pw", '-value' => &Crypt::UnixCrypt::crypt($self->clean_param("pw"), "Tp"));
877    }
878    }
879}
880
881
882sub decode {
883    my ($self, $text) = @_;
884    $text =~ s/\+/ /g;
885    $text = &MIME::Base64::decode_base64($text);
886
887    return $text;
888}
889
8901;
891
Note: See TracBrowser for help on using the browser.