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

Last change on this file was 37213, checked in by davidb, 15 months ago

Added in new function to output a native binary file + minetype, as output from the CGI script

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