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

Last change on this file since 31811 was 31811, checked in by ak19, 7 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
File size: 24.5 KB
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 repository browser.