source: main/tags/2.84rc2/greenstone2/cgi-bin/gsdlCGI.pm@ 24230

Last change on this file since 24230 was 23734, checked in by ak19, 13 years ago

First part of allowing user to set which port Jodconverter uses to communicate with soffice. By default this is set to 2002 internal to jodconverter, but it conflicts with programs (like logmein) which use this port, so that jodconverter can fail unless the user is given the ability to change the port it uses.
  • Property svn:keywords set to Author Date Id Revision
File size: 20.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_message
154{
155 my $self = shift @_;
156 my ($message) = @_;
157
158 #if($self->{'greenstone_version'} == 2) { # plain text, for IIS 6
159 print STDOUT "Content-type:text/plain\n\n$message";
160 #} else {
161 #print "Content-type:text/html\n\n";
162 #print "<pre>";
163 #print STDOUT $message;
164 #print "</pre>";
165 #}
166}
167
168sub generate_error
169{
170 my $self = shift @_;
171 my ($mess) = @_;
172
173 my $xml = $self->{'xml'};
174
175 my $full_mess;
176 my $args = $self->{'args'};
177
178 if ($xml) {
179 # Make $args XML safe
180 my $args_xml_safe = $args;
181 $args_xml_safe =~ s/&/&amp;/g;
182
183 $full_mess = "<Error>\n";
184 $full_mess .= " $mess\n";
185 $full_mess .= " CGI args were: $args_xml_safe\n";
186 $full_mess .= "</Error>\n";
187 }
188 else {
189 $full_mess = "ERROR: $mess\n ($args)\n";
190 }
191
192 $self->generate_message($full_mess);
193
194 die $full_mess;
195}
196
197sub generate_warning
198{
199 my $self = shift @_;
200 my ($mess) = @_;
201
202 my $xml = $self->{'xml'};
203
204 my $full_mess;
205 my $args = $self->{'args'};
206
207 if ($xml) {
208 # Make $args XML safe
209 my $args_xml_safe = $args;
210 $args_xml_safe =~ s/&/&amp;/g;
211
212 $full_mess = "<Warning>\n";
213 $full_mess .= " $mess\n";
214 $full_mess .= " CGI args were: $args_xml_safe\n";
215 $full_mess .= "</Warning>\n";
216 }
217 else {
218 $full_mess = "Warning: $mess ($args)\n";
219 }
220
221 $self->generate_message($full_mess);
222
223 print STDERR $full_mess;
224}
225
226
227sub generate_ok_message
228{
229 my $self = shift @_;
230 my ($mess) = @_;
231
232 my $xml = $self->{'xml'};
233
234 my $full_mess;
235
236 if ($xml) {
237 $full_mess = "<Accepted>\n";
238 $full_mess .= " $mess\n";
239 $full_mess .= "</Accepted>\n";
240 }
241 else {
242 $full_mess = "$mess";
243 }
244
245 $self->generate_message($full_mess);
246}
247
248
249
250sub get_config_info {
251 my $self = shift @_;
252 my ($infotype, $optional) = @_;
253
254 my $site_filename = $self->{'site_filename'};
255 open (FILEIN, "<$site_filename")
256 || $self->generate_error("Could not open $site_filename");
257
258 my $config_content = "";
259 while(defined (my $line = <FILEIN>)) {
260 $config_content .= $line;
261 }
262 close(FILEIN);
263
264 my ($loc) = ($config_content =~ m/^$infotype\s+((\".+\")|(\S+))\s*\n/m);
265 $loc =~ s/\"//g if defined $loc;
266
267 if ((!defined $loc) || ($loc =~ m/^\s*$/)) {
268 if((!defined $optional) || (!$optional)) {
269 $self->generate_error("$infotype is not set in $site_filename");
270 }
271 }
272
273 return $loc;
274}
275
276sub get_gsdl3_src_home{
277 my $self = shift @_;
278 if (defined $self->{'gsdl3srchome'}) {
279 return $self->{'gsdl3srchome'};
280 }
281
282 my $gsdl3srchome = $self->get_config_info("gsdl3srchome");
283
284 if(defined $gsdl3srchome) {
285 $gsdl3srchome =~ s/(\/|\\)$//; # remove trailing slash
286 }
287 $self->{'gsdl3srchome'} = $gsdl3srchome;
288
289 return $gsdl3srchome;
290}
291
292
293sub get_gsdl_home {
294 my $self = shift @_;
295
296 if (defined $self->{'gsdlhome'}) {
297 return $self->{'gsdlhome'};
298 }
299
300 my $gsdlhome = $self->get_config_info("gsdlhome");
301
302 $gsdlhome =~ s/(\/|\\)$//; # remove trailing slash
303
304 $self->{'gsdlhome'} = $gsdlhome;
305
306 return $gsdlhome;
307}
308
309sub get_gsdl3_home {
310 my $self = shift @_;
311 my ($optional) = @_;
312
313 if (defined $self->{'gsdl3home'}) {
314 return $self->{'gsdl3home'};
315 }
316
317 my $gsdl3home = $self->get_config_info("gsdl3home", $optional);
318
319 if(defined $gsdl3home) {
320 $gsdl3home =~ s/(\/|\\)$//; # remove trailing slash
321 $self->{'gsdl3home'} = $gsdl3home;
322 }
323 return $gsdl3home;
324}
325
326sub get_java_home {
327 my $self = shift @_;
328 my ($optional) = @_;
329
330 if (defined $self->{'javahome'}) {
331 return $self->{'javahome'};
332 }
333
334 my $javahome = $self->get_config_info("javahome", $optional);
335 if(defined $javahome) {
336 $javahome =~ s/(\/|\\)$//; # remove trailing slash
337 $self->{'javahome'} = $javahome;
338 }
339 return $javahome;
340}
341
342sub get_perl_path {
343 my $self = shift @_;
344 my ($optional) = @_;
345
346 if (defined $self->{'perlpath'}) {
347 return $self->{'perlpath'};
348 }
349
350 my $perlpath = $self->get_config_info("perlpath", $optional);
351
352 if(defined $perlpath) {
353 $perlpath =~ s/(\/|\\)$//; # remove trailing slash
354 $self->{'perlpath'} = $perlpath;
355 }
356 return $perlpath;
357}
358
359sub get_gsdl_os {
360 my $self = shift @_;
361
362 my $os = $^O;
363
364 if ($os =~ m/linux/i) {
365 return "linux";
366 }
367 elsif ($os =~ m/mswin/i) {
368 return "windows";
369 }
370 elsif ($os =~ m/macos/i) {
371 return "darwin";
372 }
373 else {
374 # return as is.
375 return $os;
376 }
377}
378
379sub get_library_url_suffix {
380 my $self = shift @_;
381
382 if (defined $self->{'library_url_suffix'}) {
383 return $self->{'library_url_suffix'};
384 }
385
386 my $optional = 1; # ignore absence of gwcgi if not found
387 my $library_url = $self->get_config_info("gwcgi", $optional);
388 if(defined $library_url) {
389 $library_url =~ s/(\/|\\)$//; # remove trailing slash
390 }
391 else {
392
393 if($self->{'greenstone_version'} == 2) {
394 $library_url = $self->get_config_info("httpprefix", $optional);
395 $library_url = "/greenstone" unless defined $library_url;
396 $library_url = "$library_url/cgi-bin/library.cgi"; # same extension for linux and windows
397 }
398 else { # greenstone 3 or later and gwcgi not defined
399 $library_url = "/greenstone3"; #"/greenstone3/library";
400 }
401 }
402
403 $self->{'library_url_suffix'} = $library_url;
404 return $library_url;
405}
406
407sub setup_fedora_homes {
408 my $self = shift @_;
409 my ($optional) = @_;
410
411 # The following will still allow the FEDORA_HOME and FEDORA_VERSION environment
412 # variables to have been set outside the gsdlsite.cfg file. Existing env vars
413 # are only overwritten if they've *also* been defined in gsdlsite.cfg.
414
415 if (!defined $self->{'fedora_home'}) # Don't need to go through it all again if we'd already done this before
416 {
417 # First look in the gsdlsite.cfg file for the fedora properties to be defined
418 # and set $ENV{FEDORA_HOME} and $ENV{FEDORA_VERSION} if values were provided
419 $self->{'fedora_home'} = $self->get_config_info("fedorahome", $optional);
420
421 if (defined $self->{'fedora_home'}) {
422 $ENV{'FEDORA_HOME'} = $self->{'fedora_home'};
423 }
424 elsif (defined $ENV{'FEDORA_HOME'}) { # check environment variable
425 $self->{'fedora_home'} = $ENV{'FEDORA_HOME'};
426 }
427
428 # if FEDORA_HOME is now defined, we can look for the fedora version that is being used
429 if (defined $ENV{'FEDORA_HOME'})
430 {
431 # first look in the file
432 $self->{'fedora_version'} = $self->get_config_info("fedoraversion", $optional);
433
434 if (defined $self->{'fedora_version'}) {
435 $ENV{'FEDORA_VERSION'} = $self->{'fedora_version'};
436 }
437 elsif (defined $ENV{'FEDORA_VERSION'}) { # then check environment variable
438 $self->{'fedora_version'} = $ENV{'FEDORA_VERSION'};
439 }
440 else { # finally, default to version 3 and warn the user
441 $ENV{'FEDORA_VERSION'} = "3";
442 $self->{'fedora_version'} = $ENV{'FEDORA_VERSION'};
443 #$self->generate_ok_message("FEDORA_HOME is set, but not FEDORA_VERSION, defaulted to: 3.");
444 }
445 }
446 }
447}
448
449# sets optional customisable values to do with Open Office
450sub setup_openoffice {
451 my $self = shift @_;
452 my ($optional) = @_;
453
454 if (!defined $self->{'soffice_home'}) # Don't need to go through it all again if we'd already done this before
455 {
456 # Look in gsdlsite.cfg for whether the openoffice
457 # and jodconverter properties have been defined
458 $self->{'soffice_home'} = $self->get_config_info("soffice_home", $optional);
459 $self->{'soffice_host'} = $self->get_config_info("soffice_host", $optional);
460 $self->{'soffice_port'} = $self->get_config_info("soffice_port", $optional);
461 $self->{'jodconverter_port'} = $self->get_config_info("jodconverter_port", $optional);
462
463 if (defined $self->{'soffice_home'}) {
464 $ENV{'SOFFICE_HOME'} = $self->{'soffice_home'};
465 }
466 if (defined $self->{'soffice_host'}) {
467 $ENV{'SOFFICE_HOST'} = $self->{'soffice_host'};
468 }
469 if (defined $self->{'soffice_port'}) {
470 $ENV{'SOFFICE_PORT'} = $self->{'soffice_port'};
471 }
472 if (defined $self->{'jodconverter_port'}) {
473 $ENV{'JODCONVERTER_PORT'} = $self->{'jodconverter_port'};
474 }
475 }
476}
477
478sub setup_gsdl {
479 my $self = shift @_;
480 my $optional = 1; # ignore absence of specified properties in gsdl(3)site.cfg if not found
481
482 my $gsdlhome = $self->get_gsdl_home();
483 my $gsdlos = $self->get_gsdl_os();
484 $ENV{'GSDLHOME'} = $gsdlhome;
485 $ENV{'GSDLOS'} = $gsdlos;
486
487 if (defined $server_software) {
488 if ($server_software =~ m/^Microsoft-IIS/) {
489 # Printing to STDERR, by default, goes to the web page in IIS
490 # Send it instead to Greenstone's error.txt
491
492 my $error_filename = "$gsdlhome/etc/error.txt"; # OK for Windows
493 open STDERR, ">> $error_filename"
494 or die "Can't write to $error_filename: $!\n";
495 binmode STDERR;
496 }
497 }
498
499 my $library_url = $self->get_library_url_suffix(); # best to have GSDLOS set beforehand
500 $self->{'library_url_suffix'} = $library_url;
501
502 unshift(@INC, "$ENV{'GSDLHOME'}/cgi-bin"); # This is OK on Windows
503 unshift(@INC, "$ENV{'GSDLHOME'}/perllib");
504 unshift(@INC, "$ENV{'GSDLHOME'}/perllib/cpan");
505 unshift(@INC, "$ENV{'GSDLHOME'}/perllib/cgiactions");
506
507 require util;
508
509 if($self->{'greenstone_version'} == 3) {
510 my $gsdl3srchome = $self->get_gsdl3_src_home();
511 $ENV{'GSDL3SRCHOME'} = $gsdl3srchome;
512
513 my $gsdl3home = $self->get_gsdl3_home($optional);
514 # if a specific location for GS3's web folder is not provided,
515 # assume the GS3 web folder is in the default location
516 if(!defined $gsdl3home) {
517 $gsdl3home = &util::filename_cat($ENV{'GSDL3SRCHOME'}, "web");
518 $self->{'gsdl3home'} = $gsdl3home;
519 }
520 $ENV{'GSDL3HOME'} = $gsdl3home;
521 }
522
523
524 my $gsdl_bin_script = &util::filename_cat($gsdlhome,"bin","script");
525 &util::envvar_prepend("PATH",$gsdl_bin_script);
526
527 my $gsdl_bin_os = &util::filename_cat($gsdlhome,"bin",$gsdlos);
528 &util::envvar_prepend("PATH",$gsdl_bin_os);
529
530 # set up ImageMagick for the remote server in parallel to what setup.bash does
531 my $magick_home = &util::filename_cat($gsdl_bin_os,"imagemagick");
532 if(-e $magick_home) {
533 my $magick_bin = &util::filename_cat($magick_home,"bin");
534 my $magick_lib = &util::filename_cat($magick_home,"lib");
535
536 &util::envvar_append("PATH", $magick_bin);
537
538 if(!defined $ENV{'MAGICK_HOME'} || $ENV{'MAGICK_HOME'} eq "") {
539 $ENV{'MAGICK_HOME'} = $magick_home;
540 }
541
542 if($gsdlos eq "linux") {
543 &util::envvar_prepend("LD_LIBRARY_PATH", $magick_lib);
544 } elsif ($gsdlos eq "linux") {
545 &util::envvar_prepend("DYLD_LIBRARY_PATH", $magick_lib);
546 }
547
548 }
549
550 # set up GhostScript for the remote server in parallel to what setup.bash does
551 my $ghostscript_home = &util::filename_cat($gsdl_bin_os,"ghostscript");
552 if(-e $ghostscript_home) {
553 my $ghostscript_bin = &util::filename_cat($ghostscript_home,"bin");
554 &util::envvar_prepend("PATH", $ghostscript_bin);
555
556 if(!defined $ENV{'GS_LIB'} || $ENV{'GS_LIB'} eq "") {
557 $ENV{'GS_LIB'} = &util::filename_cat($ghostscript_home,"share","ghostscript","8.63","lib");
558 }
559 if(!defined $ENV{'GS_FONTPATH'} || $ENV{'GS_FONTPATH'} eq "") {
560 $ENV{'GS_FONTPATH'} = &util::filename_cat($ghostscript_home,"share","ghostscript","8.63","Resource","Font");
561 }
562 }
563
564 # If the "perlpath" property is set in the gsdl(3)site.cfg config file, it is
565 # prepended to PATH only if the same perl bin dir path is not already on PATH env
566 my $perl_bin_dir = $self->get_perl_path($optional);
567 if(defined $perl_bin_dir)
568 {
569 &util::envvar_prepend("PATH", $perl_bin_dir);
570
571 #my ($perl_home) = ($perl_bin_dir =~ m/(.*)[\\|\/]bin[\\|\/]?$/);
572 my ($tailname,$perl_home) = File::Basename::fileparse($perl_bin_dir, "\\.(?:[^\\.]+?)\$");
573 $ENV{'PERL5LIB'} = &util::filename_cat($perl_home, "lib");
574
575 if($gsdlos eq "darwin") {
576 &util::envvar_prepend("DYLD_LIBRARY_PATH", &util::filename_cat($perl_home,"5.8.9","darwin-thread-multi-2level","CORE"));
577 } elsif($gsdlos eq "linux") {
578 &util::envvar_prepend("LD_LIBRARY_PATH", &util::filename_cat($perl_home,"5.8.9","i686-linux-thread-multi","CORE"));
579 }
580 }
581 elsif ($gsdlos eq "windows")
582 {
583 # Perl comes installed with the GS Windows Release Kit. However, note that if GS
584 # is from SVN, the user must have their own Perl and put it on the PATH or set
585 # perlpath in the gsdl site config file.
586 $perl_bin_dir = &util::filename_cat($gsdlhome, "bin", "windows", "perl", "bin");
587 if(-e $perl_bin_dir) {
588 &util::envvar_append("PATH", $perl_bin_dir);
589 }
590 }
591
592 # If javahome is explicitly set in the gsdl site config file then it will override
593 # any env variable JAVA_HOME. A GS2 server does not set JAVA_HOME, though java is on
594 # the path. Therefore, if Fedora is being used for FLI with GS2, then javahome must
595 # be set in gsdlsite.cfg or the JAVA_HOME env var must be explicitly set by the user.
596 my $java_home = $self->get_java_home($optional);
597 if(defined $java_home) {
598 $ENV{'JAVA_HOME'} = $java_home;
599 }
600
601 # Process any extension setup.pl files
602 my $ext_home = &util::filename_cat($gsdlhome,"ext");
603
604 if (opendir(EXTDIR,$ext_home) ) {
605 my @pot_ext_dir = grep { $_ !~ m/^\./ } readdir(EXTDIR);
606
607 closedir(EXTDIR);
608
609 foreach my $ed (@pot_ext_dir) {
610 my $full_ext_dir = &util::filename_cat($ext_home,$ed);
611 if (-d $full_ext_dir) {
612 my $full_inc_file = &util::filename_cat($full_ext_dir,
613 "$ed-setup.pl");
614 if (-f $full_inc_file) {
615
616 my $store_cwd = Cwd::cwd();
617
618 chdir($full_ext_dir);
619 require "./$ed-setup.pl";
620 chdir($store_cwd);
621 }
622 }
623 }
624 }
625
626 # FEDORA_HOME and FEDORA_VERSION are needed (by scripts g2f-import and g2f-buildcol).
627 $self->setup_fedora_homes($optional);
628
629
630 # Check for any customisations to Open-Office if on Windows
631 if ($gsdlos eq "windows") {
632 $self->setup_openoffice($optional);
633 }
634}
635
636sub greenstone_version {
637 my $self = shift @_;
638 return $self->{'greenstone_version'};
639}
640
641sub library_url_suffix {
642 my $self = shift @_;
643 return $self->{'library_url_suffix'};
644}
645
646# Only useful to call this after calling setup_gsdl, as it uses some environment variables
647# Returns the Greenstone collect directory, or a specific collection directory inside collect
648sub get_collection_dir {
649 my $self = shift @_;
650 my ($site, $collection) = @_; # both may be undefined
651
652 my $collection_directory;
653 if($self->{'greenstone_version'} == 2 && defined $ENV{'GSDLHOME'}) {
654 if(defined $collection) {
655 $collection_directory = &util::filename_cat($ENV{'GSDLHOME'}, "collect", $collection);
656 } else {
657 $collection_directory = &util::filename_cat($ENV{'GSDLHOME'}, "collect");
658 }
659 }
660 elsif($self->{'greenstone_version'} == 3 && defined $ENV{'GSDL3SRCHOME'}) {
661 if(defined $collection) {
662 $collection_directory = &util::filename_cat($ENV{'GSDL3SRCHOME'}, "web", "sites", $site, "collect", $collection);
663 } else {
664 $collection_directory = &util::filename_cat($ENV{'GSDL3SRCHOME'}, "web", "sites", $site, "collect");
665 }
666 }
667}
668
669sub local_rm_r
670{
671 my $self = shift @_;
672 my ($local_dir) = @_;
673
674 my $prefix_dir = getcwd();
675 my $full_path = &util::filename_cat($prefix_dir,$local_dir);
676
677 if ($prefix_dir !~ m/collect/) {
678 $self->generate_error("Trying to delete outside of Greenstone collect: $full_path");
679 }
680
681 # Delete recursively
682 if (!-e $full_path) {
683 $self->generate_error("File/Directory does not exist: $full_path");
684 }
685
686 &util::rm_r($full_path);
687}
688
689
690sub get_java_path()
691{
692 # Check the JAVA_HOME environment variable first
693 if (defined $ENV{'JAVA_HOME'}) {
694 my $java_home = $ENV{'JAVA_HOME'};
695 $java_home =~ s/\/$//; # Remove trailing slash if present (Unix specific)
696 return &util::filename_cat($java_home, "bin", "java");
697 }
698
699 # Hope that Java is on the PATH
700 return "java";
701}
702
703
704sub check_java_home()
705{
706 # Return a warning unless the JAVA_HOME environment variable is set
707 if (!defined $ENV{'JAVA_HOME'}) {
708 return "JAVA_HOME environment variable not set. Might not be able to find Java unless in PATH (" . $ENV{'PATH'} . ")";
709 }
710
711 return "";
712}
713
714
715sub checked_chdir
716{
717 my $self = shift @_;
718 my ($dir) = @_;
719
720 if (!-e $dir) {
721 $self->generate_error("Directory '$dir' does not exist");
722 }
723
724 chdir $dir
725 || $self->generate_error("Unable to change to directory: $dir");
726}
727
728sub rot13()
729{
730 my $self = shift @_;
731 my ($password)=@_;
732 my @password_arr=split(//,$password);
733
734 my @encrypt_password;
735 foreach my $str (@password_arr){
736 my $char=unpack("c",$str);
737 if ($char>=97 && $char<=109){
738 $char+=13;
739 }elsif ($char>=110 && $char<=122){
740 $char-=13;
741 }elsif ($char>=65 && $char<=77){
742 $char+=13;
743 }elsif ($char>=78 && $char<=90){
744 $char-=13;
745 }
746 $char=pack("c",$char);
747 push(@encrypt_password,$char);
748 }
749 return join("",@encrypt_password);
750}
751
752sub encrypt_password
753{
754 my $self = shift @_;
755
756 if (defined $self->param("pw")) { ##
757 if ($self->{'greenstone_version'} == 3) { # GS3 is in Java, so needs different encryption
758 $self->param('-name' => "pw", '-value' => $self->rot13($self->clean_param("pw")));
759 }
760 else { # GS2 (and versions of GS other than 3?)
761 #require "$self->{'gsdlhome'}/perllib/util.pm"; # This is OK on Windows
762 require "$self->{'gsdlhome'}/perllib/cpan/Crypt/UnixCrypt.pm"; # This is OK on Windows
763 $self->param('-name' => "pw", '-value' => &Crypt::UnixCrypt::crypt($self->clean_param("pw"), "Tp"));
764 }
765 }
766}
767
768
769sub decode {
770 my ($self, $text) = @_;
771 $text =~ s/\+/ /g;
772 $text = &MIME::Base64::decode_base64($text);
773
774 return $text;
775}
776
7771;
778
Note: See TracBrowser for help on using the repository browser.