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

Last change on this file since 30625 was 30625, checked in by ak19, 8 years ago

Switch to including Strawberry Perl (v5.18) which has a vendor folder with a lib subfolder. In gsdlCGI.pm, add perl\vendor\lib to PERL5LIB (for linux) and additionally into PATH for windows, since DLL paths go into PATH for windows as there's no LIBRARY_PATH. Not sure if this is needed as it works on the cmdline without adding perl\vendor\lib or any other lib subfolder to the PATH. At that point it finds vendor, as GLI or building through GLI fails if the vendor subfolder didn.
  • Property svn:keywords set to Author Date Id Revision
File size: 23.9 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 foreach my $ext_home (@ext_homes) {
634 # Should really think about making this a subroutine
635
636 if (opendir(EXTDIR,$ext_home) ) {
637 my @pot_ext_dir = grep { $_ !~ m/^\./ } readdir(EXTDIR);
638
639 closedir(EXTDIR);
640
641 foreach my $ed (@pot_ext_dir) {
642 my $full_ext_dir = &FileUtils::filenameConcatenate($ext_home,$ed);
643
644 if (-d $full_ext_dir) {
645
646 my $full_ext_perllib_dir = &FileUtils::filenameConcatenate($full_ext_dir,"perllib");
647 if (-d $full_ext_perllib_dir) {
648 unshift (@INC, $full_ext_perllib_dir);
649 }
650
651 my $full_inc_file = &FileUtils::filenameConcatenate($full_ext_dir,
652 "$ed-setup.pl");
653 if (-f $full_inc_file) {
654
655 my $store_cwd = Cwd::cwd();
656
657 chdir($full_ext_dir);
658 require "./$ed-setup.pl";
659 chdir($store_cwd);
660 }
661 }
662 }
663 }
664 }
665
666 # FEDORA_HOME and FEDORA_VERSION are needed (by scripts g2f-import and g2f-buildcol).
667 $self->setup_fedora_homes($optional);
668
669
670 # Check for any customisations to Open-Office if on Windows
671 if ($gsdlos eq "windows") {
672 $self->setup_openoffice($optional);
673 }
674}
675
676sub greenstone_version {
677 my $self = shift @_;
678 return $self->{'greenstone_version'};
679}
680
681sub library_url_suffix {
682 my $self = shift @_;
683 return $self->{'library_url_suffix'};
684}
685
686# Only useful to call this after calling setup_gsdl, as it uses some environment variables
687# Returns the Greenstone collect directory, or a specific collection directory inside collect
688sub get_collection_dir {
689 my $self = shift @_;
690 my ($site, $collection) = @_; # both may be undefined
691
692 my $collection_directory;
693 if($self->{'greenstone_version'} == 2 && defined $ENV{'GSDLHOME'}) {
694 if(defined $collection) {
695 $collection_directory = &FileUtils::filenameConcatenate($ENV{'GSDLHOME'}, "collect", $collection);
696 } else {
697 $collection_directory = &FileUtils::filenameConcatenate($ENV{'GSDLHOME'}, "collect");
698 }
699 }
700 elsif($self->{'greenstone_version'} == 3) {
701 if(defined $ENV{'GSDL3HOME'}) {
702 if(defined $collection) {
703 $collection_directory = &FileUtils::filenameConcatenate($ENV{'GSDL3HOME'}, "sites", $site, "collect", $collection);
704 } else {
705 $collection_directory = &FileUtils::filenameConcatenate($ENV{'GSDL3HOME'}, "sites", $site, "collect");
706 }
707 }
708 elsif(defined $ENV{'GSDL3SRCHOME'}) {
709 if(defined $collection) {
710 $collection_directory = &FileUtils::filenameConcatenate($ENV{'GSDL3SRCHOME'}, "web", "sites", $site, "collect", $collection);
711 } else {
712 $collection_directory = &FileUtils::filenameConcatenate($ENV{'GSDL3SRCHOME'}, "web", "sites", $site, "collect");
713 }
714 }
715 }
716 return $collection_directory;
717}
718
719sub local_rm_r
720{
721 my $self = shift @_;
722 my ($local_dir) = @_;
723
724 my $prefix_dir = getcwd();
725 my $full_path = &FileUtils::filenameConcatenate($prefix_dir,$local_dir);
726
727 if ($prefix_dir !~ m/collect/) {
728 $self->generate_error("Trying to delete outside of Greenstone collect: $full_path");
729 }
730
731 # Delete recursively
732 if (!-e $full_path) {
733 $self->generate_error("File/Directory does not exist: $full_path");
734 }
735
736 &FileUtils::removeFilesRecursive($full_path);
737}
738
739
740sub get_java_path()
741{
742 # Check the JAVA_HOME environment variable first
743 if (defined $ENV{'JAVA_HOME'}) {
744 my $java_home = $ENV{'JAVA_HOME'};
745 $java_home =~ s/\/$//; # Remove trailing slash if present (Unix specific)
746 return &FileUtils::filenameConcatenate($java_home, "bin", "java");
747 }
748
749 # Hope that Java is on the PATH
750 return "java";
751}
752
753
754sub check_java_home()
755{
756 # Return a warning unless the JAVA_HOME environment variable is set
757 if (!defined $ENV{'JAVA_HOME'}) {
758 return "JAVA_HOME environment variable not set. Might not be able to find Java unless in PATH (" . $ENV{'PATH'} . ")";
759 }
760
761 return "";
762}
763
764
765sub checked_chdir
766{
767 my $self = shift @_;
768 my ($dir) = @_;
769
770 if (!-e $dir) {
771 $self->generate_error("Directory '$dir' does not exist");
772 }
773
774 chdir $dir
775 || $self->generate_error("Unable to change to directory: $dir");
776}
777
778# used with old GS3 authentication
779sub rot13()
780{
781 my $self = shift @_;
782 my ($password)=@_;
783 my @password_arr=split(//,$password);
784
785 my @encrypt_password;
786 foreach my $str (@password_arr){
787 my $char=unpack("c",$str);
788 if ($char>=97 && $char<=109){
789 $char+=13;
790 }elsif ($char>=110 && $char<=122){
791 $char-=13;
792 }elsif ($char>=65 && $char<=77){
793 $char+=13;
794 }elsif ($char>=78 && $char<=90){
795 $char-=13;
796 }
797 $char=pack("c",$char);
798 push(@encrypt_password,$char);
799 }
800 return join("",@encrypt_password);
801}
802
803# used along with new GS3 authentication
804sub hash_pwd()
805{
806 my $self = shift @_;
807 my ($password)=@_;
808
809 my $gsdl3srchome = $ENV{'GSDL3SRCHOME'};
810
811 my $java = get_java_path();
812 my $java_gsdl3_classpath = &FileUtils::filenameConcatenate($gsdl3srchome, "web", "WEB-INF", "lib", "gsdl3.jar");
813 my $java_remaining_classpath = &FileUtils::filenameConcatenate($gsdl3srchome, "web", "WEB-INF", "lib", "*"); # log4j etc
814 my $java_classpath;
815 my $gsdlos = $ENV{'GSDLOS'};
816 if ($gsdlos !~ m/windows/){
817 $java_classpath = $java_gsdl3_classpath . ":" . $java_remaining_classpath;
818 }else{
819 $java_classpath = $java_gsdl3_classpath . ";" . $java_remaining_classpath;
820 } # can't use util::envvar_prepend(), since the $java_classpath here is not a $ENV type env variable
821
822 my $java_command="\"$java\" -classpath \"$java_classpath\" org.greenstone.gsdl3.service.Authentication \"$password\""; # 2>&1";
823 my $hashedpwd = `$java_command`;
824
825 return $hashedpwd;
826}
827
828sub encrypt_key
829{
830 my $self = shift @_;
831
832 # I think the encryption method used on the key may be the same for GS3 and GS2
833 # (The encryption method used on the pw definitely differs between the two GS versions)
834 if (defined $self->param("ky")) {
835 require "$self->{'gsdlhome'}/perllib/cpan/Crypt/UnixCrypt.pm"; # This is OK on Windows
836 $self->param('-name' => "ky", '-value' => &Crypt::UnixCrypt::crypt($self->clean_param("ky"), "Tp"));
837 }
838}
839
840sub encrypt_password
841{
842 my $self = shift @_;
843
844 if (defined $self->param("pw")) { ##
845 if ($self->{'greenstone_version'} == 3) { # GS3 is in Java, so needs different encryption
846 #$self->param('-name' => "pw", '-value' => $self->rot13($self->clean_param("pw"))); ## when using old GS3 authentication
847
848 my $hashedPwd = $self->hash_pwd($self->clean_param("pw")); # for GS3's new Authentication
849 $self->param('-name' => "pw", '-value' => $hashedPwd);
850 }
851 else { # GS2 (and versions of GS other than 3?)
852 #require "$self->{'gsdlhome'}/perllib/util.pm"; # This is OK on Windows
853 require "$self->{'gsdlhome'}/perllib/cpan/Crypt/UnixCrypt.pm"; # This is OK on Windows
854 $self->param('-name' => "pw", '-value' => &Crypt::UnixCrypt::crypt($self->clean_param("pw"), "Tp"));
855 }
856 }
857}
858
859
860sub decode {
861 my ($self, $text) = @_;
862 $text =~ s/\+/ /g;
863 $text = &MIME::Base64::decode_base64($text);
864
865 return $text;
866}
867
8681;
869
Note: See TracBrowser for help on using the repository browser.