Changeset 16467 for gsdl/trunk/cgi-bin/gsdlCGI.pm

Timestamp:

2008-07-18T15:47:37+12:00 (16 years ago)

Author:

ak19

Message:

Merged GS2's gliserver.pl and gsdlCGI.pm with GS3's gliserver4gs3.pl and gsdlCGI4gs3.pm and moved them into gs2's svn trunk (previously still in GS3's svn trunk). Now there's one set of gliserver files that will work for both GS2 and GS3 remote Greenstone servers.

File:

• gsdl/trunk/cgi-bin/gsdlCGI.pm (modified) (13 diffs)

gsdl/trunk/cgi-bin/gsdlCGI.pm

@@ -1 @@
-
 package gsdlCGI;
 
-
+# This file merges Michael Dewsnip's gsdlCGI.pm for GS2 and Quan Qiu's gsdlCGI4gs3.pm (GS3)
+
+use strict; 
+no strict 'subs';
+no strict 'refs'; # allow filehandles to be variables and viceversa
 
 use CGI;
 use Cwd;
 
-@ISA = ('CGI');
+@gsdlCGI::ISA = ( 'CGI' ); 
 
 sub new {
     my $class = shift @_;
-
+    
     my $self;
+   
+    # We'll determine the correct config file in this constructor itself 
+    # and use it to determine the Greenstone server's version. 
+    # Perhaps later, another test can be used for finding out what version 
+    # of the Greenstone server we are working with.
+    my $version;
+    if (-e "gsdl3site.cfg") {
+    $version = 3;
+    } else {
+    $version = 2;
+    }
+
     if ((defined $ENV{'REQUEST_METHOD'}) && ($ENV{'REQUEST_METHOD'} eq "POST")) {
-    my $line = <STDIN>;
-    if ((defined $line) && ($line ne "")) {
-        $self = new CGI($line);
-    }
-    else {
-        $self = new CGI();
-    }
-    }
-    else {
+
+    # Check if we're dealing with the upload-coll-file cmd. Because it will be a 
+    # multipart POST message and must be dealt with by the default CGI() constructor
+    if((defined $ENV{'QUERY_STRING'}) && ($ENV{'QUERY_STRING'} =~ m/upload-collection-file/)) {
+        $self = new CGI(); 
+    } 
+
+    else { # all other POST commands processed using CGI($line)
+        my $line = <STDIN>;
+        if ((defined $line) && ($line ne "")) { 
+        $self = new CGI($line);
+        }
+    }
+    
+    }    
+    
+    # If one of the conditions above did not hold, then self=new CGI() 
+    if (!defined $self) { 
     $self = new CGI();
     }
 
+    if ($version == 2) {
+    $self->{'site_filename'} = "gsdlsite.cfg";
+    $self->{'greenstone_version'} = 2;
+    } 
+    elsif ($version == 3) {
+    $self->{'site_filename'} = "gsdl3site.cfg";
+    $self->{'greenstone_version'} = 3;
+    }
+    
     return bless $self, $class;
 }
@@ -73 +106 @@
 }
 
+sub generate_message
+{
+    my $self = shift @_;
+    my ($message) = @_;
+    
+    #if($self->{'greenstone_version'} == 2) { # plain text, for IIS 6
+    print STDOUT "Content-type:text/plain\n\n$message";
+    #} else {
+    #print "Content-type:text/html\n\n";
+    #print "<pre>";
+    #print STDOUT $message;
+    #print "</pre>";
+    #}
+}
 
 sub generate_error
@@ -98 +145 @@
     }
 
-    print STDOUT "Content-type:text/plain\n\n";
-    print STDOUT $full_mess;
-
-    exit 0;
+    $self->generate_message($full_mess);
+
+    die $full_mess;
 }
 
@@ -128 +174 @@
     }
 
-    print STDOUT "Content-type:text/plain\n\n";
-    print STDOUT $full_mess;
+    $self->generate_message($full_mess);
 
     print STDERR $full_mess;
@@ -152 +197 @@
     $full_mess = "$mess\n";
     }
-
-    print STDOUT "Content-type:text/plain\n\n";
-    print STDOUT $full_mess;
+ 
+    $self->generate_message($full_mess);
 }
 
@@ -161 +205 @@
 sub get_config_info {
     my $self = shift @_;
-    my ($infotype) = @_;
-
-    my $site_filename = "gsdlsite.cfg";
+    my ($infotype, $optional) = @_;
+
+    my $site_filename = $self->{'site_filename'};
     open (FILEIN, "<$site_filename") 
-    || $self->generate_error("Could not open gsdlsite.cfg");
+    || $self->generate_error("Could not open $site_filename");
 
     my $config_content = "";
@@ -174 +218 @@
 
     my ($loc) = ($config_content =~ m/^$infotype\s+((\".+\")|(\S+))\s*\n/m);
-    $loc =~ s/\"//g;
+    $loc =~ s/\"//g if defined $loc;
 
     if ((!defined $loc) || ($loc =~ m/^\s*$/)) {
-    $self->generate_error("$infotype is not set in gsdlsite.cfg");
+    if((!defined $optional) || (!$optional)) {
+        $self->generate_error("$infotype is not set in $site_filename");
+    }
     }
 
     return $loc;
+}
+
+sub get_gsdl3_src_home{
+    my $self = shift @_;
+    if (defined $self->{'gsdl3srchome'}) {
+    return $self->{'gsdl3srchome'};
+    }
+
+    my $gsdl3srchome = $self->get_config_info("gsdl3srchome");
+
+    if(defined $gsdl3srchome) {
+    $gsdl3srchome =~ s/(\/|\\)$//; # remove trailing slash
+    }
+    $self->{'gsdl3srchome'} = $gsdl3srchome;
+
+    return $gsdl3srchome;
 }
 
@@ -200 +262 @@
 }
 
+sub get_gsdl3_home {
+    my $self = shift @_;
+    my ($optional) = @_;
+    
+    if (defined $self->{'gsdl3home'}) {
+    return $self->{'gsdl3home'};
+    }
+
+    my $gsdl3home = $self->get_config_info("gsdl3home", $optional);
+
+    if(defined $gsdl3home) {
+    $gsdl3home =~ s/(\/|\\)$//; # remove trailing slash
+    $self->{'gsdl3home'} = $gsdl3home;
+    }
+    return $gsdl3home;
+}
+
+sub get_java_home {
+    my $self = shift @_;
+    my ($optional) = @_;
+    
+    if (defined $self->{'javahome'}) {
+    return $self->{'javahome'};
+    }
+
+    my $javahome = $self->get_config_info("javahome", $optional);
+    if(defined $javahome) {
+    $javahome =~ s/(\/|\\)$//; # remove trailing slash
+    $self->{'javahome'} = $javahome;
+    }
+    return $javahome;
+}
+
+sub get_perl_path {
+    my $self = shift @_;
+    
+    if (defined $self->{'perlpath'}) {
+    return $self->{'perlpath'};
+    }
+
+    my $perlpath = $self->get_config_info("perlpath");
+
+    if(defined $perlpath) {
+    $perlpath =~ s/(\/|\\)$//; # remove trailing slash
+    $self->{'perlpath'} = $perlpath;
+    }
+    return $perlpath;
+}
+
 sub get_gsdl_os {
     my $self = shift @_;
@@ -208 +319 @@
     return "linux";
     }
-    elsif ($os =~ /mswin/i) {
+    elsif ($os =~ m/mswin/i) {
     return "windows";
     }
-    elsif ($os =~ /macos/i) {
+    elsif ($os =~ m/macos/i) {
     return "darwin";
     }
@@ -220 +331 @@
 }
 
+sub get_library_url_suffix {
+    my $self = shift @_;
+    
+    if (defined $self->{'library_url_suffix'}) {
+    return $self->{'library_url_suffix'};
+    }
+
+    my $optional = 1; # ignore absence of gwcgi if not found
+    my $library_url = $self->get_config_info("gwcgi", $optional);
+    if(defined $library_url) {
+    $library_url =~ s/(\/|\\)$//; # remove trailing slash
+    }
+    else {
+
+    if($self->{'greenstone_version'} == 2) {
+        $library_url = $self->get_config_info("httpprefix");
+        $library_url = "$library_url/cgi-bin/library";
+
+        my $gsdlos = (defined $ENV{'GSDLOS'}) ? $ENV{'GSDLOS'} : $self->get_gsdl_os();
+        if($gsdlos =~ m/windows/) { # remote GS2 server on Windows uses "library.exe"
+        $library_url .= ".exe";
+        }
+    } 
+    else { # greenstone 3 or later and gwcgi not defined
+        $library_url = "/greenstone3"; #"/greenstone3/library";
+    }
+    }
+
+    $self->{'library_url_suffix'} = $library_url;
+    return $library_url;
+}
+
+sub setup_fedora_homes {
+    my $self = shift @_;
+    my ($optional) = @_;
+
+    # The following will still allow the FEDORA_HOME and FEDORA_VERSION environment 
+    # variables to have been set outside the gsdlsite.cfg file. Existing env vars 
+    # are only overwritten if they've *also* been defined in gsdlsite.cfg.
+
+    if (!defined $self->{'fedora_home'}) # Don't need to go through it all again if we'd already done this before
+    {
+    # First look in the gsdlsite.cfg file for the fedora properties to be defined
+    # and set $ENV{FEDORA_HOME} and $ENV{FEDORA_VERSION} if values were provided
+    $self->{'fedora_home'} = $self->get_config_info("fedorahome", $optional);
+    
+    if (defined $self->{'fedora_home'}) {
+        $ENV{'FEDORA_HOME'} = $self->{'fedora_home'}; 
+    } 
+    elsif (defined $ENV{'FEDORA_HOME'}) { # check environment variable
+        $self->{'fedora_home'} = $ENV{'FEDORA_HOME'};
+    }
+    
+    # if FEDORA_HOME is now defined, we can look for the fedora version that is being used
+    if (defined $ENV{'FEDORA_HOME'}) 
+    {
+        # first look in the file
+        $self->{'fedora_version'} = $self->get_config_info("fedoraversion", $optional);
+
+        if (defined $self->{'fedora_version'}) {
+        $ENV{'FEDORA_VERSION'} = $self->{'fedora_version'};
+        } 
+        elsif (defined $ENV{'FEDORA_VERSION'}) { # then check environment variable
+        $self->{'fedora_version'} = $ENV{'FEDORA_VERSION'};
+        } 
+        else { # finally, default to version 3 and warn the user
+        $ENV{'FEDORA_VERSION'} = "3";
+        $self->{'fedora_version'} = $ENV{'FEDORA_VERSION'};
+        #$self->generate_ok_message("FEDORA_HOME is set, but not FEDORA_VERSION, defaulted to: 3.");
+        }
+    }
+    }
+}
+
 sub setup_gsdl {
     my $self = shift @_;
+    my $optional = 1; # ignore absence of specified properties in gsdl(3)site.cfg if not found
 
     my $gsdlhome = $self->get_gsdl_home();
     my $gsdlos = $self->get_gsdl_os();
-
     $ENV{'GSDLHOME'} = $gsdlhome;
     $ENV{'GSDLOS'} = $gsdlos;
 
+    my $library_url = $self->get_library_url_suffix(); # best to have GSDLOS set beforehand
+    $self->{'library_url_suffix'} = $library_url;
+
     require "$gsdlhome/perllib/util.pm";
 
+    if($self->{'greenstone_version'} == 3) {
+    my $gsdl3srchome = $self->get_gsdl3_src_home();
+    $ENV{'GSDL3SRCHOME'} = $gsdl3srchome;
+
+    my $gsdl3home = $self->get_gsdl3_home($optional);
+    # if a specific location for GS3's web folder is not provided,
+    # assume the GS3 web folder is in the default location
+    if(!defined $gsdl3home) { 
+        $gsdl3home = &util::filename_cat($ENV{'GSDL3SRCHOME'}, "web");
+        $self->{'gsdl3home'} = $gsdl3home;
+    } 
+    $ENV{'GSDL3HOME'} = $gsdl3home;
+    } 
+   
+    
     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);
-
+    
+    # Perl comes installed with the GS Windows Release Kit. 
+    # However, if GS is from SVN, the user must have their own Perl and put it on the path.
+    my $perl_bin_dir; # undefined
     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);
-    }
-}
-
+    $perl_bin_dir = &util::filename_cat($gsdlhome, "bin", "windows", "perl", "bin");
+    if(-e $perl_bin_dir) {
+        &util::envvar_append("PATH", $perl_bin_dir);
+    }
+    }
+
+    # Uncomment these lines if you want to read the "perlpath" property from
+    # the gsdl(3)site.cfg config file into PATH
+    #if(!defined $perl_bin_dir) {
+    #$perl_bin_dir = $self->get_perl_path();
+    #&util::envvar_append("PATH", $perl_bin_dir);
+    #}
+    
+    # gsdl(3)site.cfg can specify JAVA_HOME and FEDORA_HOME along with Fedora's version. Both
+    # are needed (by scripts g2f-import and g2f-buildcol) when using Greenstone 2 with Fedora.
+    if(!defined $ENV{'JAVA_HOME'}) {
+    $ENV{'JAVA_HOME'} = $self->get_java_home($optional);
+    }
+
+    $self->setup_fedora_homes($optional);
+}
+
+sub greenstone_version {
+    my $self = shift @_;
+    return $self->{'greenstone_version'};
+}
+
+sub library_url_suffix {
+    my $self = shift @_;
+    return $self->{'library_url_suffix'};
+}
+
+# Only useful to call this after calling setup_gsdl, as it uses some environment variables
+# Returns the Greenstone collect directory, or a specific collection directory inside collect
+sub get_collection_dir {
+    my $self = shift @_;
+    my ($site, $collection) = @_; # both may be undefined
+
+    require "$ENV{'GSDLHOME'}/perllib/util.pm";
+    my $collection_directory;
+    if($self->{'greenstone_version'} == 2 && defined $ENV{'GSDLHOME'}) {
+    if(defined $collection) {
+        $collection_directory = &util::filename_cat($ENV{'GSDLHOME'}, "collect", $collection);
+    } else {
+        $collection_directory = &util::filename_cat($ENV{'GSDLHOME'}, "collect");
+    }
+    }
+    elsif($self->{'greenstone_version'} == 3 && defined $ENV{'GSDL3SRCHOME'}) {
+    if(defined $collection) {
+        $collection_directory = &util::filename_cat($ENV{'GSDL3SRCHOME'}, "web", "sites", $site, "collect", $collection);
+    } else {
+        $collection_directory = &util::filename_cat($ENV{'GSDL3SRCHOME'}, "web", "sites", $site, "collect");
+    }
+    }
+}
 
 sub local_rm_r
@@ -250 +506 @@
 
     my $prefix_dir = getcwd(); 
-
+    my $full_path = &util::filename_cat($prefix_dir,$local_dir);
+    
     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);
+    $self->generate_error("Trying to delete outside of Greenstone collect: $full_path");
+    }
 
     # Delete recursively
-    if (!-e $full_dir) {
-    $self->generate_error("File/Directory does not exist: $full_dir");
-    }
-
-    &util::rm_r($full_dir);
+    if (!-e $full_path) {
+    $self->generate_error("File/Directory does not exist: $full_path");
+    }
+
+    &util::rm_r($full_path);
 }
 
@@ -282 +537 @@
 sub check_java_home()
 {
-    # Return a warning unless the JAVA_HOME enrivonmen variable is set
+    # Return a warning unless the JAVA_HOME environment 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'} . ")";
@@ -304 +559 @@
 }
 
+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);
+}
+
+sub encrypt_password
+{
+    my $self = shift @_;
+    
+    if (defined $self->param("pw")) { ##
+    if ($self->{'greenstone_version'} == 3) { # GS3 is in Java, so needs different encryption
+        $self->param('-name' => "pw", '-value' => $self->rot13($self->clean_param("pw")));
+    }
+    else { # GS2 (and versions of GS other than 3?)
+        #require "$self->{'gsdlhome'}/perllib/util.pm";  # This is OK on Windows
+        require "$self->{'gsdlhome'}/perllib/cpan/Crypt/UnixCrypt.pm";  # This is OK on Windows
+        $self->param('-name' => "pw", '-value' => &Crypt::UnixCrypt::crypt($self->clean_param("pw"), "Tp"));
+    }
+    } 
+}
+
 1;