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

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

get_collection_dir was never returning anything, but was expected to return the collection dir. And for GS3, the web folder can be located outside GSDL3SRCHOME, in which case it will be stored in GSDL3HOME.

  • Property svn:keywords set to Author Date Id Revision
File size: 22.2 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 = &util::filename_cat($ENV{'GSDL3SRCHOME'}, "web");
516 $self->{'gsdl3home'} = $gsdl3home;
517 }
518 $ENV{'GSDL3HOME'} = $gsdl3home;
519 }
520
521 my $gsdl_bin_script = &util::filename_cat($gsdlhome,"bin","script");
522 &util::envvar_prepend("PATH",$gsdl_bin_script);
523
524 my $gsdl_bin_os = &util::filename_cat($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 = &util::filename_cat($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 = &util::filename_cat($magick_home,"bin");
537 my $magick_lib = &util::filename_cat($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 = &util::filename_cat($gsdl_bin_os,"ghostscript");
555 if(-e $ghostscript_home) {
556 my $ghostscript_bin = &util::filename_cat($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'} = &util::filename_cat($ghostscript_home,"share","ghostscript","8.63","lib");
561 }
562 if(!defined $ENV{'GS_FONTPATH'} || $ENV{'GS_FONTPATH'} eq "") {
563 $ENV{'GS_FONTPATH'} = &util::filename_cat($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'} = &util::filename_cat($perl_home, "lib");
577
578 if($gsdlos eq "darwin") {
579 &util::envvar_prepend("DYLD_LIBRARY_PATH", &util::filename_cat($perl_home,"5.8.9","darwin-thread-multi-2level","CORE"));
580 } elsif($gsdlos eq "linux") {
581 &util::envvar_prepend("LD_LIBRARY_PATH", &util::filename_cat($perl_home,"5.8.9","i686-linux-thread-multi","CORE"));
582 }
583 }
584 elsif ($gsdlos eq "windows")
585 {
586 # Perl comes installed with the GS Windows Release Kit. However, note that if GS
587 # is from SVN, the user must have their own Perl and put it on the PATH or set
588 # perlpath in the gsdl site config file.
589 $perl_bin_dir = &util::filename_cat($gsdlhome, "bin", "windows", "perl", "bin");
590 if(-e $perl_bin_dir) {
591 &util::envvar_append("PATH", $perl_bin_dir);
592 }
593 }
594
595 # If javahome is explicitly set in the gsdl site config file then it will override
596 # any env variable JAVA_HOME. A GS2 server does not set JAVA_HOME, though java is on
597 # the path. Therefore, if Fedora is being used for FLI with GS2, then javahome must
598 # be set in gsdlsite.cfg or the JAVA_HOME env var must be explicitly set by the user.
599 my $java_home = $self->get_java_home($optional);
600 if(defined $java_home) {
601 $ENV{'JAVA_HOME'} = $java_home;
602 }
603
604
605 # Process any extension setup.pl files
606 my @ext_homes = ();
607
608 my $gsdl_ext_home = &util::filename_cat($gsdlhome,"ext");
609 push(@ext_homes,$gsdl_ext_home);
610
611 if ($self->{'greenstone_version'} == 3) {
612 my $gsdl3srchome = $self->get_gsdl3_src_home();
613 my $gsdl3_ext_home = &util::filename_cat($gsdl3srchome,"ext");
614 push(@ext_homes,$gsdl3_ext_home);
615 }
616
617 foreach my $ext_home (@ext_homes) {
618 # Should really think about making this a subroutine
619
620 if (opendir(EXTDIR,$ext_home) ) {
621 my @pot_ext_dir = grep { $_ !~ m/^\./ } readdir(EXTDIR);
622
623 closedir(EXTDIR);
624
625 foreach my $ed (@pot_ext_dir) {
626 my $full_ext_dir = &util::filename_cat($ext_home,$ed);
627
628 if (-d $full_ext_dir) {
629
630 my $full_ext_perllib_dir = &util::filename_cat($full_ext_dir,"perllib");
631 if (-d $full_ext_perllib_dir) {
632 unshift (@INC, $full_ext_perllib_dir);
633 }
634
635 my $full_inc_file = &util::filename_cat($full_ext_dir,
636 "$ed-setup.pl");
637 if (-f $full_inc_file) {
638
639 my $store_cwd = Cwd::cwd();
640
641 chdir($full_ext_dir);
642 require "./$ed-setup.pl";
643 chdir($store_cwd);
644 }
645 }
646 }
647 }
648 }
649
650 # FEDORA_HOME and FEDORA_VERSION are needed (by scripts g2f-import and g2f-buildcol).
651 $self->setup_fedora_homes($optional);
652
653
654 # Check for any customisations to Open-Office if on Windows
655 if ($gsdlos eq "windows") {
656 $self->setup_openoffice($optional);
657 }
658}
659
660sub greenstone_version {
661 my $self = shift @_;
662 return $self->{'greenstone_version'};
663}
664
665sub library_url_suffix {
666 my $self = shift @_;
667 return $self->{'library_url_suffix'};
668}
669
670# Only useful to call this after calling setup_gsdl, as it uses some environment variables
671# Returns the Greenstone collect directory, or a specific collection directory inside collect
672sub get_collection_dir {
673 my $self = shift @_;
674 my ($site, $collection) = @_; # both may be undefined
675
676 my $collection_directory;
677 if($self->{'greenstone_version'} == 2 && defined $ENV{'GSDLHOME'}) {
678 if(defined $collection) {
679 $collection_directory = &util::filename_cat($ENV{'GSDLHOME'}, "collect", $collection);
680 } else {
681 $collection_directory = &util::filename_cat($ENV{'GSDLHOME'}, "collect");
682 }
683 }
684 elsif($self->{'greenstone_version'} == 3) {
685 if(defined $ENV{'GSDL3HOME'}) {
686 if(defined $collection) {
687 $collection_directory = &util::filename_cat($ENV{'GSDL3HOME'}, "sites", $site, "collect", $collection);
688 } else {
689 $collection_directory = &util::filename_cat($ENV{'GSDL3HOME'}, "sites", $site, "collect");
690 }
691 }
692 elsif(defined $ENV{'GSDL3SRCHOME'}) {
693 if(defined $collection) {
694 $collection_directory = &util::filename_cat($ENV{'GSDL3SRCHOME'}, "web", "sites", $site, "collect", $collection);
695 } else {
696 $collection_directory = &util::filename_cat($ENV{'GSDL3SRCHOME'}, "web", "sites", $site, "collect");
697 }
698 }
699 }
700 return $collection_directory;
701}
702
703sub local_rm_r
704{
705 my $self = shift @_;
706 my ($local_dir) = @_;
707
708 my $prefix_dir = getcwd();
709 my $full_path = &util::filename_cat($prefix_dir,$local_dir);
710
711 if ($prefix_dir !~ m/collect/) {
712 $self->generate_error("Trying to delete outside of Greenstone collect: $full_path");
713 }
714
715 # Delete recursively
716 if (!-e $full_path) {
717 $self->generate_error("File/Directory does not exist: $full_path");
718 }
719
720 &util::rm_r($full_path);
721}
722
723
724sub get_java_path()
725{
726 # Check the JAVA_HOME environment variable first
727 if (defined $ENV{'JAVA_HOME'}) {
728 my $java_home = $ENV{'JAVA_HOME'};
729 $java_home =~ s/\/$//; # Remove trailing slash if present (Unix specific)
730 return &util::filename_cat($java_home, "bin", "java");
731 }
732
733 # Hope that Java is on the PATH
734 return "java";
735}
736
737
738sub check_java_home()
739{
740 # Return a warning unless the JAVA_HOME environment variable is set
741 if (!defined $ENV{'JAVA_HOME'}) {
742 return "JAVA_HOME environment variable not set. Might not be able to find Java unless in PATH (" . $ENV{'PATH'} . ")";
743 }
744
745 return "";
746}
747
748
749sub checked_chdir
750{
751 my $self = shift @_;
752 my ($dir) = @_;
753
754 if (!-e $dir) {
755 $self->generate_error("Directory '$dir' does not exist");
756 }
757
758 chdir $dir
759 || $self->generate_error("Unable to change to directory: $dir");
760}
761
762# used with old GS3 authentication
763sub rot13()
764{
765 my $self = shift @_;
766 my ($password)=@_;
767 my @password_arr=split(//,$password);
768
769 my @encrypt_password;
770 foreach my $str (@password_arr){
771 my $char=unpack("c",$str);
772 if ($char>=97 && $char<=109){
773 $char+=13;
774 }elsif ($char>=110 && $char<=122){
775 $char-=13;
776 }elsif ($char>=65 && $char<=77){
777 $char+=13;
778 }elsif ($char>=78 && $char<=90){
779 $char-=13;
780 }
781 $char=pack("c",$char);
782 push(@encrypt_password,$char);
783 }
784 return join("",@encrypt_password);
785}
786
787# used along with new GS3 authentication
788sub hash_pwd()
789{
790 my $self = shift @_;
791 my ($password)=@_;
792
793 my $gsdl3srchome = $ENV{'GSDL3SRCHOME'};
794
795 my $java = get_java_path();
796 my $java_gsdl3_classpath = &util::filename_cat($gsdl3srchome, "web", "WEB-INF", "lib", "gsdl3.jar");
797 my $java_remaining_classpath = &util::filename_cat($gsdl3srchome, "web", "WEB-INF", "lib", "*"); # log4j etc
798 my $java_classpath;
799 my $gsdlos = $ENV{'GSDLOS'};
800 if ($gsdlos !~ m/windows/){
801 $java_classpath = $java_gsdl3_classpath . ":" . $java_remaining_classpath;
802 }else{
803 $java_classpath = $java_gsdl3_classpath . ";" . $java_remaining_classpath;
804 }
805
806 my $java_command="\"$java\" -classpath \"$java_classpath\" org.greenstone.gsdl3.service.Authentication \"$password\""; # 2>&1";
807 my $hashedpwd = `$java_command`;
808
809 return $hashedpwd;
810}
811
812sub encrypt_password
813{
814 my $self = shift @_;
815
816 if (defined $self->param("pw")) { ##
817 if ($self->{'greenstone_version'} == 3) { # GS3 is in Java, so needs different encryption
818 #$self->param('-name' => "pw", '-value' => $self->rot13($self->clean_param("pw"))); ## when using old GS3 authentication
819
820 my $hashedPwd = $self->hash_pwd($self->clean_param("pw")); # for GS3's new Authentication
821 $self->param('-name' => "pw", '-value' => $hashedPwd);
822 }
823 else { # GS2 (and versions of GS other than 3?)
824 #require "$self->{'gsdlhome'}/perllib/util.pm"; # This is OK on Windows
825 require "$self->{'gsdlhome'}/perllib/cpan/Crypt/UnixCrypt.pm"; # This is OK on Windows
826 $self->param('-name' => "pw", '-value' => &Crypt::UnixCrypt::crypt($self->clean_param("pw"), "Tp"));
827 }
828 }
829}
830
831
832sub decode {
833 my ($self, $text) = @_;
834 $text =~ s/\+/ /g;
835 $text = &MIME::Base64::decode_base64($text);
836
837 return $text;
838}
839
8401;
841
Note: See TracBrowser for help on using the repository browser.