package gsdlCGI4gs3; use CGI; use Cwd; @ISA = ('CGI'); sub new { my $class = shift @_; my $self; if ((defined $ENV{'REQUEST_METHOD'}) && ($ENV{'REQUEST_METHOD'} eq "POST")) { my $line = ; if ((defined $line) && ($line ne "") && ($line !~ /upload-collection-file/)) { $self = new CGI($line); } else { $self = new CGI(); } } else { $self = new CGI(); } return bless $self, $class; } sub parse_cgi_args { my $self = shift @_; my $xml = (defined $self->param("xml")) ? 1 : 0; $self->{'xml'} = $xml; my @var_names = $self->param; my @arg_list = (); foreach my $n ( @var_names ) { my $arg = "$n="; my $val = $self->param($n); $arg .= $val if (defined $val); push(@arg_list,$arg); } $self->{'args'} = join("&",@arg_list); } sub clean_param { my $self = shift @_; my ($param) = @_; my $val = $self->SUPER::param($param); $val =~ s/[\r\n]+$// if (defined $val); return $val; } sub safe_val { my $self = shift @_; my ($val) = @_; # ensure only alpha-numeric plus a few other special chars remain $val =~ s/[^[:alnum:]@\.\/\- :_]//g if (defined $val); return $val; } sub generate_error { my $self = shift @_; my ($mess) = @_; my $xml = $self->{'xml'}; my $full_mess; my $args = $self->{'args'}; if ($xml) { # Make $args XML safe my $args_xml_safe = $args; $args_xml_safe =~ s/&/&/g; $full_mess = "\n"; $full_mess .= " $mess\n"; $full_mess .= " CGI args were: $args_xml_safe\n"; $full_mess .= "\n"; } else { $full_mess = "ERROR: $mess\n ($args)\n"; } print STDOUT "Content-type:text/plain\n\n"; print STDOUT $full_mess; die $full_mess; } sub generate_warning { my $self = shift @_; my ($mess) = @_; my $xml = $self->{'xml'}; my $full_mess; my $args = $self->{'args'}; if ($xml) { # Make $args XML safe my $args_xml_safe = $args; $args_xml_safe =~ s/&/&/g; $full_mess = "\n"; $full_mess .= " $mess\n"; $full_mess .= " CGI args were: $args_xml_safe\n"; $full_mess .= "\n"; } else { $full_mess = "Warning: $mess ($args)\n"; } print STDOUT "Content-type:text/plain\n\n"; print STDOUT $full_mess; print STDERR $full_mess; } sub generate_ok_message { my $self = shift @_; my ($mess) = @_; my $xml = $self->{'xml'}; my $full_mess; if ($xml) { $full_mess = "\n"; $full_mess .= " $mess\n"; $full_mess .= "\n"; } else { $full_mess = "$mess\n"; } print "
";
    print STDOUT $full_mess;
    print "
"; } sub get_config_info { my $self = shift @_; my ($infotype) = @_; my $site_filename = "gsdl3site.cfg"; open (FILEIN, "<$site_filename") || $self->generate_error("Could not open gsdl3site.cfg"); my $config_content = ""; while(defined (my $line = )) { $config_content .= $line; } close(FILEIN); my ($loc) = ($config_content =~ m/^$infotype\s+((\".+\")|(\S+))\s*\n/m); $loc =~ s/\"//g; if ((!defined $loc) || ($loc =~ m/^\s*$/)) { $self->generate_error("$infotype is not set in gsdl3site.cfg"); } return $loc; } sub get_gsdl3_src_home{ my $self = shift @_; if (defined $self->{'gsdl3srchome'}) { return $self->{'gsdl3srchome'}; } my $gsdl3srchome = $self->get_config_info("gsdl3srchome"); $gsdl3srchome =~ s/(\/|\\)$//; # remove trailing slash $self->{'gsdl3srchome'} = $gsdl3srchome; return $gsdl3srchome; } sub get_gsdl_home { my $self = shift @_; if (defined $self->{'gsdlhome'}) { return $self->{'gsdlhome'}; } my $gsdlhome = $self->get_config_info("gsdlhome"); #require "$gsdlhome/perllib/util.pm"; $gsdlhome =~ s/(\/|\\)$//; # remove trailing slash $self->{'gsdlhome'} = $gsdlhome; return $gsdlhome; } sub get_gsdl_os { my $self = shift @_; my $os = $^O; if ($os =~ m/linux/i) { return "linux"; } elsif ($os =~ /mswin/i) { return "windows"; } elsif ($os =~ /macos/i) { return "darwin"; } else { # return as is. return $os; } } sub setup_gsdl { my $self = shift @_; my $gsdl3srchome = $self->get_gsdl3_src_home(); my $gsdlhome = $self->get_gsdl_home(); my $gsdlos = $self->get_gsdl_os(); $ENV{'GSDL3SRCHOME'} = $gsdl3srchome; $ENV{'GSDLHOME'} = $gsdlhome; $ENV{'GSDLOS'} = $gsdlos; require "$gsdlhome/perllib/util.pm"; my $gsdl_bin_script = &util::filename_cat($gsdlhome,"bin","script"); &util::envvar_append("PATH",$gsdl_bin_script); my $gsdl_bin_os = &util::filename_cat($gsdlhome,"bin",$gsdlos); &util::envvar_append("PATH",$gsdl_bin_os); if ($gsdlos eq "windows") { my $gsdl_perl_bin_directory = &util::filename_cat($gsdlhome, "bin", "windows", "perl", "bin"); &util::envvar_append("PATH", $gsdl_perl_bin_directory); } } sub local_rm_r { my $self = shift @_; my ($local_dir) = @_; my $prefix_dir = getcwd(); if ($prefix_dir !~ m/collect/) { $self->generate_error("Trying to delete outside of Greenstone collect: $full_dir"); } my $full_dir = &util::filename_cat($prefix_dir,$local_dir); # Delete recursively if (!-e $full_dir) { $self->generate_error("File/Directory does not exist: $full_dir"); } &util::rm_r($full_dir); } sub get_java_path() { # Check the JAVA_HOME environment variable first if (defined $ENV{'JAVA_HOME'}) { my $java_home = $ENV{'JAVA_HOME'}; $java_home =~ s/\/$//; # Remove trailing slash if present (Unix specific) return &util::filename_cat($java_home, "bin", "java"); } # Hope that Java is on the PATH return "java"; } sub check_java_home() { # Return a warning unless the JAVA_HOME enrivonmen variable is set if (!defined $ENV{'JAVA_HOME'}) { return "JAVA_HOME environment variable not set. Might not be able to find Java unless in PATH (" . $ENV{'PATH'} . ")"; } return ""; } sub checked_chdir { my $self = shift @_; my ($dir) = @_; if (!-e $dir) { $self->generate_error("Directory '$dir' does not exist"); } chdir $dir || $self->generate_error("Unable to change to directory: $dir"); } sub rot13() { my $self = shift @_; my ($password)=@_; my @password_arr=split(//,$password); my @encrypt_password; foreach my $str (@password_arr){ my $char=unpack("c",$str); if ($char>=97 && $char<=109){ $char+=13; }elsif ($char>=110 && $char<=122){ $char-=13; }elsif ($char>=65 && $char<=77){ $char+=13; }elsif ($char>=78 && $char<=90){ $char-=13; } $char=pack("c",$char); push(@encrypt_password,$char); } return join("",@encrypt_password); } 1;