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

Revision 31811, 24.5 KB (checked in by ak19, 2 years ago)

Cmdline testing of gliserver.pl revealed that gliserver's args (like cmd=check-installation) were being passed to the GS3 extensions and resulting in confusing and unnecessary error messages being printed from there. So now gsdlCGI.pm does gliserver's args are stored and emptied before calling the extension setup files and then restored thereafter.

  • 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
687sub greenstone_version {
688    my $self = shift @_;
689    return $self->{'greenstone_version'};
690}
691
692sub library_url_suffix {
693    my $self = shift @_;
694    return $self->{'library_url_suffix'};
695}
696
697# Only useful to call this after calling setup_gsdl, as it uses some environment variables
698# Returns the Greenstone collect directory, or a specific collection directory inside collect
699sub get_collection_dir {
700    my $self = shift @_;
701    my ($site, $collection) = @_; # both may be undefined
702   
703    my $collection_directory;
704    if($self->{'greenstone_version'} == 2 && defined $ENV{'GSDLHOME'}) {
705    if(defined $collection) {
706        $collection_directory = &FileUtils::filenameConcatenate($ENV{'GSDLHOME'}, "collect", $collection);
707    } else {
708        $collection_directory = &FileUtils::filenameConcatenate($ENV{'GSDLHOME'}, "collect");
709    }
710    }
711    elsif($self->{'greenstone_version'} == 3) {
712    if(defined $ENV{'GSDL3HOME'}) {
713        if(defined $collection) {
714        $collection_directory = &FileUtils::filenameConcatenate($ENV{'GSDL3HOME'}, "sites", $site, "collect", $collection);
715        } else {
716        $collection_directory = &FileUtils::filenameConcatenate($ENV{'GSDL3HOME'}, "sites", $site, "collect");
717        }
718    }
719    elsif(defined $ENV{'GSDL3SRCHOME'}) {
720        if(defined $collection) {
721        $collection_directory = &FileUtils::filenameConcatenate($ENV{'GSDL3SRCHOME'}, "web", "sites", $site, "collect", $collection);
722        } else {
723        $collection_directory = &FileUtils::filenameConcatenate($ENV{'GSDL3SRCHOME'}, "web", "sites", $site, "collect");
724        }
725    }
726    }
727    return $collection_directory;
728}
729
730sub local_rm_r
731{
732    my $self = shift @_;
733    my ($local_dir) = @_;
734
735    my $prefix_dir = getcwd();
736    my $full_path = &FileUtils::filenameConcatenate($prefix_dir,$local_dir);
737   
738    if ($prefix_dir !~ m/collect/) {
739    $self->generate_error("Trying to delete outside of Greenstone collect: $full_path");
740    }
741
742    # Delete recursively
743    if (!-e $full_path) {
744    $self->generate_error("File/Directory does not exist: $full_path");
745    }
746
747    &FileUtils::removeFilesRecursive($full_path);
748}
749
750
751sub get_java_path()
752{
753    # Check the JAVA_HOME environment variable first
754    if (defined $ENV{'JAVA_HOME'}) {
755    my $java_home = $ENV{'JAVA_HOME'};
756    $java_home =~ s/\/$//;  # Remove trailing slash if present (Unix specific)
757    return &FileUtils::filenameConcatenate($java_home, "bin", "java");
758    }
759
760    elsif (defined $ENV{'JRE_HOME'}) {
761    my $jre_home = $ENV{'JRE_HOME'};
762    $jre_home =~ s/\/$//;  # Remove trailing slash if present (Unix specific)
763    return &FileUtils::filenameConcatenate($jre_home, "bin", "java");
764    }
765
766    # Hope that Java is on the PATH
767    return "java";
768}
769
770
771sub check_java_home()
772{
773    # Return a warning unless the JAVA_HOME environment variable is set
774    if (!defined $ENV{'JAVA_HOME'}) {
775    return "JAVA_HOME environment variable not set. Might not be able to find Java unless in PATH (" . $ENV{'PATH'} . ")";
776    }
777
778    return "";
779}
780
781
782sub checked_chdir
783{
784    my $self = shift @_;
785    my ($dir) = @_;
786
787    if (!-e $dir) {
788    $self->generate_error("Directory '$dir' does not exist");
789    }
790
791    chdir $dir
792    || $self->generate_error("Unable to change to directory: $dir");
793}
794
795# used with old GS3 authentication
796sub rot13()
797{
798    my $self = shift @_;
799    my ($password)=@_;
800    my @password_arr=split(//,$password);
801   
802    my @encrypt_password;
803    foreach my $str (@password_arr){
804    my $char=unpack("c",$str);
805    if ($char>=97 && $char<=109){
806        $char+=13;
807    }elsif ($char>=110 && $char<=122){
808        $char-=13;
809    }elsif ($char>=65 && $char<=77){
810        $char+=13;
811    }elsif ($char>=78 && $char<=90){
812        $char-=13;
813    }
814    $char=pack("c",$char);
815    push(@encrypt_password,$char);
816    }
817    return join("",@encrypt_password);
818}
819
820# used along with new GS3 authentication
821sub hash_pwd()
822{
823    my $self = shift @_;
824    my ($password)=@_;
825
826    my $gsdl3srchome = $ENV{'GSDL3SRCHOME'};
827   
828    my $java = get_java_path();
829    my $java_gsdl3_classpath = &FileUtils::filenameConcatenate($gsdl3srchome, "web", "WEB-INF", "lib", "gsdl3.jar");
830    my $java_remaining_classpath = &FileUtils::filenameConcatenate($gsdl3srchome, "web", "WEB-INF", "lib", "*"); # log4j etc
831    my $java_classpath;
832    my $gsdlos = $ENV{'GSDLOS'};
833    if ($gsdlos !~ m/windows/){
834    $java_classpath = $java_gsdl3_classpath . ":" . $java_remaining_classpath;
835    }else{
836    $java_classpath = $java_gsdl3_classpath . ";" . $java_remaining_classpath;
837    } # can't use util::envvar_prepend(), since the $java_classpath here is not a $ENV type env variable
838   
839    my $java_command="\"$java\" -classpath \"$java_classpath\" org.greenstone.gsdl3.service.Authentication \"$password\""; # 2>&1";
840    my $hashedpwd = `$java_command`;
841
842    return $hashedpwd;
843}
844
845sub encrypt_key
846{
847    my $self = shift @_;
848
849    # I think the encryption method used on the key may be the same for GS3 and GS2
850    # (The encryption method used on the pw definitely differs between the two GS versions)
851    if (defined $self->param("ky")) {
852    require "$self->{'gsdlhome'}/perllib/cpan/Crypt/UnixCrypt.pm";  # This is OK on Windows
853    $self->param('-name' => "ky", '-value' => &Crypt::UnixCrypt::crypt($self->clean_param("ky"), "Tp"));
854    }
855}
856
857sub encrypt_password
858{
859    my $self = shift @_;
860   
861    if (defined $self->param("pw")) { ##
862    if ($self->{'greenstone_version'} == 3) { # GS3 is in Java, so needs different encryption
863        #$self->param('-name' => "pw", '-value' => $self->rot13($self->clean_param("pw"))); ## when using old GS3 authentication
864
865        my $hashedPwd = $self->hash_pwd($self->clean_param("pw")); # for GS3's new Authentication
866        $self->param('-name' => "pw", '-value' => $hashedPwd);
867    }
868    else { # GS2 (and versions of GS other than 3?)
869        #require "$self->{'gsdlhome'}/perllib/util.pm";  # This is OK on Windows
870        require "$self->{'gsdlhome'}/perllib/cpan/Crypt/UnixCrypt.pm";  # This is OK on Windows
871        $self->param('-name' => "pw", '-value' => &Crypt::UnixCrypt::crypt($self->clean_param("pw"), "Tp"));
872    }
873    }
874}
875
876
877sub decode {
878    my ($self, $text) = @_;
879    $text =~ s/\+/ /g;
880    $text = &MIME::Base64::decode_base64($text);
881
882    return $text;
883}
884
8851;
886
Note: See TracBrowser for help on using the browser.