Changeset 16467

Show
Ignore:
Timestamp:
18.07.2008 15:47:37 (12 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.

Location:
gsdl/trunk/cgi-bin
Files:
3 modified

Legend:

Unmodified
Added
Removed
  • gsdl/trunk/cgi-bin/gliserver.pl

    r15928 r16467  
    11#!/usr/bin/perl -w 
    2 #!perl -w 
    32# Need to specify the full path of Perl above 
    43 
     4# This file merges Michael Dewsnip's gliserver.pl for GS2 and Quan Qiu's gliserver4gs3.pl (GS3) 
    55 
    66use strict; 
     7no strict 'subs'; 
     8no strict 'refs'; # allow filehandles to be variables and viceversa 
    79 
    810 
     
    1012my $iis6_mode = 0; 
    1113 
    12  
     14## 
    1315# IIS 6: for some reason, IIS runs this script with the working directory set to the Greenstone 
    1416#   directory rather than the cgi-bin directory, causing lots of stuff to fail 
    1517if ($iis6_mode) 
    1618{ 
    17     # Change into cgi-bin directory 
    18     chdir("cgi-bin"); 
    19 } 
    20  
    21  
    22 # We use require and an eval here (instead of "use") to catch any errors loading the module (for IIS) 
     19    # Change into cgi-bin directory - need to ensure it exists, since gliserver deals with both GS2 and GS3 
     20    if(-e "cgi-bin" && -d "cgi-bin") { # GS2 
     21    chdir("cgi-bin"); 
     22    } else { # iis6_mode is not applicable for Greenstone 3 
     23    $iis6_mode = 0; 
     24    } 
     25} 
     26 
     27 
     28# We use require and an eval here (instead of "use package") to catch any errors loading the module (for IIS) 
    2329eval("require \"gsdlCGI.pm\""); 
    2430if ($@) 
     
    3036 
    3137 
    32 my $debugging_enabled = 0; 
     38#my $authentication_enabled = 0; 
     39my $debugging_enabled = 0; # if 1, debugging is enabled and unlinking intermediate files (deleting files) will not happen 
    3340 
    3441my $mail_enabled = 0; 
     
    3845 
    3946sub main 
    40 { 
     47{    
    4148    my $gsdl_cgi = new gsdlCGI(); 
    4249 
     
    4451    $gsdl_cgi->setup_gsdl(); 
    4552    my $gsdlhome = $ENV{'GSDLHOME'}; 
     53 
    4654    $gsdl_cgi->checked_chdir($gsdlhome); 
    47     require "$gsdlhome/perllib/util.pm";  # This is OK on Windows 
    48     require "$gsdlhome/perllib/cpan/Crypt/UnixCrypt.pm";  # This is OK on Windows 
    4955 
    5056    # Encrypt the password 
    51     if (defined $gsdl_cgi->param("pw")) { 
    52     $gsdl_cgi->param('-name' => "pw", '-value' => &Crypt::UnixCrypt::crypt($gsdl_cgi->clean_param("pw"), "Tp")); 
    53     } 
     57    $gsdl_cgi->encrypt_password(); 
    5458 
    5559    $gsdl_cgi->parse_cgi_args(); 
     
    6569    $gsdl_cgi->delete("cmd"); 
    6670 
    67     # The check-installation command has no arguments 
     71    # The check-installation, greenstone-server-version and get-library-url commands have no arguments 
    6872    if ($cmd eq "check-installation") { 
    6973    &check_installation($gsdl_cgi); 
     74    return; 
     75    } 
     76    elsif ($cmd eq "greenstone-server-version") { 
     77    &greenstone_server_version($gsdl_cgi); 
     78    return; 
     79    } 
     80    elsif ($cmd eq "get-library-url-suffix") { 
     81    &get_library_url_suffix($gsdl_cgi); 
    7082    return; 
    7183    } 
     
    7688    $gsdl_cgi->generate_error("No username specified."); 
    7789    } 
    78     # Remove the un argument (since this can mess up other scripts) 
    7990    $gsdl_cgi->delete("un"); 
    8091 
     
    8697    $gsdl_cgi->delete("ts"); 
    8798 
     99    my $site; # undefined on declaration, see http://perldoc.perl.org/perlsyn.html 
     100    if($gsdl_cgi->greenstone_version() != 2) { # all GS versions after 2 may define site 
     101    $site = $gsdl_cgi->clean_param("site");    
     102    if (!defined $site) { 
     103        $gsdl_cgi->generate_error("No site specified."); 
     104    } 
     105    $gsdl_cgi->delete("site"); 
     106    } 
     107 
     108 
    88109    if ($cmd eq "delete-collection") { 
    89     &delete_collection($gsdl_cgi, $username, $timestamp); 
     110    &delete_collection($gsdl_cgi, $username, $timestamp, $site); 
    90111    } 
    91112    elsif ($cmd eq "download-collection") { 
    92     &download_collection($gsdl_cgi, $username, $timestamp); 
     113    &download_collection($gsdl_cgi, $username, $timestamp, $site); 
    93114    } 
    94115    elsif ($cmd eq "download-collection-archives") { 
    95     &download_collection_archives($gsdl_cgi, $username, $timestamp); 
     116    &download_collection_archives($gsdl_cgi, $username, $timestamp, $site); 
    96117    } 
    97118    elsif ($cmd eq "download-collection-configurations") { 
    98     &download_collection_configurations($gsdl_cgi, $username, $timestamp); 
     119    &download_collection_configurations($gsdl_cgi, $username, $timestamp, $site); 
    99120    } 
    100121    elsif ($cmd eq "download-collection-file") { 
    101     &download_collection_file($gsdl_cgi, $username, $timestamp); 
     122    &download_collection_file($gsdl_cgi, $username, $timestamp, $site); 
    102123    } 
    103124    elsif ($cmd eq "delete-collection-file") { 
    104     &delete_collection_file($gsdl_cgi, $username, $timestamp); 
     125    &delete_collection_file($gsdl_cgi, $username, $timestamp, $site); 
    105126    } 
    106127    elsif ($cmd eq "get-script-options") { 
    107     &get_script_options($gsdl_cgi, $username, $timestamp); 
     128    &get_script_options($gsdl_cgi, $username, $timestamp, $site); 
    108129    } 
    109130    elsif ($cmd eq "move-collection-file") { 
    110     &move_collection_file($gsdl_cgi, $username, $timestamp); 
     131    &move_collection_file($gsdl_cgi, $username, $timestamp, $site); 
    111132    } 
    112133    elsif ($cmd eq "new-collection-directory") { 
    113     &new_collection_directory($gsdl_cgi, $username, $timestamp); 
     134    &new_collection_directory($gsdl_cgi, $username, $timestamp, $site); 
    114135    } 
    115136    elsif ($cmd eq "run-script") { 
    116     &run_script($gsdl_cgi, $username, $timestamp); 
     137    &run_script($gsdl_cgi, $username, $timestamp, $site); 
    117138    } 
    118139    elsif ($cmd eq "timeout-test") { 
     
    120141    } 
    121142    elsif ($cmd eq "upload-collection-file") { 
    122     &upload_collection_file($gsdl_cgi, $username, $timestamp); 
    123     }  
     143    &upload_collection_file($gsdl_cgi, $username, $timestamp, $site); 
     144    } 
    124145    elsif ($cmd eq "file-exists") {  
    125     &file_exists($gsdl_cgi); 
    126     }    
     146    &file_exists($gsdl_cgi, $site); 
     147    } 
     148    # cmds not in Greenstone 2: 
     149    elsif ($gsdl_cgi->greenstone_version() != 2) {   
     150    if ($cmd eq "download-web-xml-file") { 
     151        &download_web_xml_file($gsdl_cgi, $username, $timestamp, $site); 
     152    }  
     153    elsif ($cmd eq "user-validation") { 
     154        &user_validation($gsdl_cgi, $username, $timestamp, $site); 
     155    } 
     156    elsif ($cmd eq "get-site-names") { 
     157        &get_site_names($gsdl_cgi, $username, $timestamp, $site); 
     158    } 
     159    } 
    127160    else { 
    128161    $gsdl_cgi->generate_error("Unrecognised command: '$cmd'"); 
    129162    } 
    130 } 
     163         
     164} 
     165 
    131166 
    132167sub authenticate_user 
     
    135170    my $username = shift(@_); 
    136171    my $collection = shift(@_); 
    137  
    138     # Remove the pw argument (since this can mess up other scripts) 
     172    my $site = shift(@_); 
     173 
     174    # Even if we're not authenticating remove the un and pw arguments, since these can mess up other scripts 
    139175    my $user_password = $gsdl_cgi->clean_param("pw"); 
    140176    $gsdl_cgi->delete("pw"); 
    141177 
     178    # Only authenticate if it is enabled 
     179    # return "all-collections-editor" if (!$authentication_enabled); 
     180 
    142181    if ((!defined $user_password) || ($user_password =~ m/^\s*$/)) { 
    143182    $gsdl_cgi->generate_error("Authentication failed: no password specified."); 
    144183    } 
    145184 
    146     my $gsdlhome = $ENV{'GSDLHOME'}; 
    147     my $etc_directory = &util::filename_cat($gsdlhome, "etc"); 
    148     my $users_db_file_path = &util::filename_cat($etc_directory, "users.db"); 
    149  
    150     # Use db2txt instead of GDBM_File to get the user accounts information 
    151     my $users_db_content = ""; 
    152     open(USERS_DB, "db2txt \"$users_db_file_path\" |"); 
    153     while (<USERS_DB>) { 
    154     $users_db_content .= $_; 
    155     } 
    156  
    157     # Get the user account information from the users.db database 
     185    my $users_db_content; 
     186    if($gsdl_cgi->greenstone_version() == 2) { 
     187    my $etc_directory = &util::filename_cat($ENV{'GSDLHOME'}, "etc"); 
     188    my $users_db_file_path = &util::filename_cat($etc_directory, "users.db"); 
     189     
     190    # Use db2txt instead of GDBM_File to get the user accounts information 
     191    $users_db_content = ""; 
     192    open(USERS_DB, "db2txt \"$users_db_file_path\" |"); 
     193    while (<USERS_DB>) { 
     194        $users_db_content .= $_; 
     195    } 
     196    } 
     197    elsif($gsdl_cgi->greenstone_version() == 3) { 
     198    my $gsdl3srchome = $ENV{'GSDL3SRCHOME'}; 
     199 
     200    my $java = $gsdl_cgi->get_java_path(); 
     201    my $java_gsdl3_classpath = &util::filename_cat($gsdl3srchome, "web", "WEB-INF", "lib", "gsdl3.jar"); 
     202    my $java_derby_classpath = &util::filename_cat($gsdl3srchome, "web", "WEB-INF", "lib", "derby.jar"); 
     203    my $java_classpath; 
     204    my $gsdlos = $ENV{'GSDLOS'}; 
     205    if ($gsdlos !~ m/windows/){ 
     206        $java_classpath = $java_gsdl3_classpath . ":" . $java_derby_classpath; 
     207    }else{ 
     208        $java_classpath = $java_gsdl3_classpath . ";" . $java_derby_classpath; 
     209    } 
     210    my $java_args = &util::filename_cat($gsdl3srchome, "web", "sites", $site, "etc", "usersDB"); 
     211    $gsdl_cgi->checked_chdir($java_args); 
     212    my $java_command="\"$java\" -classpath \"$java_classpath\" org.greenstone.gsdl3.util.usersDB2txt \"$java_args\" 2>&1"; 
     213    $users_db_content = `$java_command`; 
     214    } 
     215     
     216    # Get the user account information from the usersDB database 
    158217    my %users_db_data = (); 
    159218    foreach my $users_db_entry (split(/-{70}/, $users_db_content)) { 
    160     if ($users_db_entry =~ /\n?\[(.+)\]\n/) { 
     219    if ($users_db_entry =~ m/\n?\[(.+)\]\n/) { 
    161220        $users_db_data{$1} = $users_db_entry; 
    162221    } 
     
    170229 
    171230    # Check password 
    172     my ($valid_user_password) = ($user_data =~ /\<password\>(.*)/); 
     231    my ($valid_user_password) = ($user_data =~ m/\<password\>(.*)/); 
    173232    if ($user_password ne $valid_user_password) { 
    174233    $gsdl_cgi->generate_error("Authentication failed: incorrect password."); 
     
    176235 
    177236    # Check group 
    178     my ($user_groups) = ($user_data =~ /\<groups\>(.*)/); 
     237    my ($user_groups) = ($user_data =~ m/\<groups\>(.*)/); 
     238 
    179239    if ($collection eq "") { 
    180240    # If we're not editing a collection then the user doesn't need to be in a particular group 
    181241    return $user_groups;  # Authentication successful 
    182242    } 
     243 
    183244    foreach my $user_group (split(/\,/, $user_groups)) { 
    184245    # Does this user have access to all collections? 
     
    187248    } 
    188249    # Does this user have access to personal collections, and is this one? 
    189     if ($user_group eq "personal-collections-editor" && $collection =~ /^$username\-/) { 
     250    if ($user_group eq "personal-collections-editor" && $collection =~ m/^$username\-/) { 
    190251        return $user_groups;  # Authentication successful 
    191252    } 
     
    195256    } 
    196257    } 
    197  
    198258    $gsdl_cgi->generate_error("Authentication failed: user is not in the required group."); 
    199259} 
     
    205265    my $username = shift(@_); 
    206266    my $collection = shift(@_); 
     267    my $site = shift(@_); 
    207268 
    208269    my $steal_lock = $gsdl_cgi->clean_param("steal_lock"); 
    209270    $gsdl_cgi->delete("steal_lock"); 
    210271 
    211     my $gsdlhome = $ENV{'GSDLHOME'}; 
    212     my $collection_directory = &util::filename_cat($gsdlhome, "collect", $collection); 
     272    my $collection_directory = $gsdl_cgi->get_collection_dir($site, $collection); 
    213273    $gsdl_cgi->checked_chdir($collection_directory); 
    214274 
     
    225285 
    226286    # Pick out the owner of the lock file 
    227     $lock_file_content =~ /\<User\>(.*?)\<\/User\>/; 
     287    $lock_file_content =~ m/\<User\>(.*?)\<\/User\>/; 
    228288    my $lock_file_owner = $1; 
    229289 
     
    257317#   ACTIONS 
    258318# ---------------------------------------------------------------------------------------------------- 
    259  
     319# This routine, which uses the variable site, won't get called by GS2,  
     320sub user_validation{ 
     321    my ($gsdl_cgi, $username, $timestamp, $site) = @_; 
     322    
     323    # Users can be in any group to perform this action 
     324    my $user_err = &authenticate_user($gsdl_cgi, $username, "", $site); 
     325     if (defined $user_err && $user_err!~ m/ERROR/){ 
     326     if ($user_err!~ m/ERROR/){ 
     327         #$gsdl_cgi->generate_error("Authentication failed: $username is not valid"); 
     328         $gsdl_cgi->generate_ok($user_err); 
     329         #print $user_err; 
     330     }else{ 
     331         $gsdl_cgi->generate_error($user_err); 
     332         #print "not valid" . $user_err; 
     333     } 
     334     }else{ 
     335     $gsdl_cgi->generate_error("Authentication failed: $username is not valid");      
     336     } 
     337} 
    260338 
    261339sub check_installation 
     
    266344    my $installation_status = ""; 
    267345 
    268     print STDOUT "Content-type:text/plain\n\n"; 
    269  
    270346    # Check that Java is installed and accessible 
    271347    my $java = $gsdl_cgi->get_java_path(); 
    272     my $java_command = "$java -version 2>&1"; 
    273  
     348    my $java_command = "\"$java\" -version 2>&1"; 
     349     
    274350    # IIS 6: redirecting output from STDERR to STDOUT just doesn't work, so we have to let it go 
    275351    #   directly out to the page 
    276     if ($iis6_mode) 
    277     { 
    278     $java_command = "java -version"; 
     352    if($iis6_mode && $gsdl_cgi->greenstone_version() == 2) { ## 
     353    print STDOUT "Content-type:text/plain\n\n"; 
     354    $java_command = "\"$java\" -version"; 
    279355    } 
    280356 
    281357    my $java_output = `$java_command`; 
     358         
    282359    my $java_status = $?; 
    283360    if ($java_status < 0) { 
     
    292369    # Show the values of some important environment variables 
    293370    $installation_status .= "\n"; 
     371    if($gsdl_cgi->greenstone_version() != 2) { 
     372    $installation_status .= "GSDL3SRCHOME: " . $ENV{'GSDL3SRCHOME'} . "\n"; 
     373    $installation_status .= "GSDL3HOME: " . $ENV{'GSDL3HOME'} . "\n"; 
     374    } 
    294375    $installation_status .= "GSDLHOME: " . $ENV{'GSDLHOME'} . "\n"; 
    295376    $installation_status .= "GSDLOS: " . $ENV{'GSDLOS'} . "\n"; 
     377    $installation_status .= "JAVA_HOME: " . $ENV{'JAVA_HOME'} . "\n" if defined($ENV{'JAVA_HOME'}); # on GS2, Java's only on the PATH 
    296378    $installation_status .= "PATH: " . $ENV{'PATH'} . "\n"; 
    297  
    298     if ($installation_ok) { 
    299     print STDOUT $installation_status . "\nInstallation OK!"; 
     379    if(defined $ENV{'FEDORA_VERSION'}) { # not using FLI unless version set 
     380    $installation_status .= "FEDORA_HOME: ".$ENV{'FEDORA_HOME'} . "\n"; 
     381    $installation_status .= "FEDORA_VERSION: ".$ENV{'FEDORA_VERSION'}; 
     382    } 
     383     
     384    if ($installation_ok) { ## M. Dewsnip's svn log comment stated that for iis6_mode output needs to go to STDOUT 
     385    if($iis6_mode && $gsdl_cgi->greenstone_version() == 2) { 
     386        print STDOUT $installation_status . "\nInstallation OK!"; 
     387    } else { 
     388        $gsdl_cgi->generate_ok_message($installation_status . "\nInstallation OK!"); 
     389    } 
    300390    } 
    301391    else { 
    302     print STDOUT $installation_status; 
     392    if($iis6_mode && $gsdl_cgi->greenstone_version() == 2) { 
     393        print STDOUT $installation_status; 
     394    } else { 
     395        $gsdl_cgi->generate_error($installation_status); 
     396    } 
    303397    } 
    304398} 
     
    307401sub delete_collection 
    308402{ 
    309     my ($gsdl_cgi, $username, $timestamp) = @_; 
     403    my ($gsdl_cgi, $username, $timestamp, $site) = @_; 
    310404 
    311405    my $collection = $gsdl_cgi->clean_param("c"); 
     
    315409 
    316410    # Ensure the user is allowed to edit this collection 
    317     &authenticate_user($gsdl_cgi, $username, $collection); 
    318  
    319     my $gsdlhome = $ENV{'GSDLHOME'}; 
    320     my $collect_directory = &util::filename_cat($gsdlhome, "collect"); 
     411    &authenticate_user($gsdl_cgi, $username, $collection, $site); 
     412 
     413 
     414    my $collect_directory = $gsdl_cgi->get_collection_dir($site); 
    321415    $gsdl_cgi->checked_chdir($collect_directory); 
    322416 
     
    327421 
    328422    # Make sure the collection isn't locked by someone else 
    329     &lock_collection($gsdl_cgi, $username, $collection); 
     423    &lock_collection($gsdl_cgi, $username, $collection, $site); 
    330424 
    331425    $gsdl_cgi->checked_chdir($collect_directory); 
     
    343437sub delete_collection_file 
    344438{ 
    345     my ($gsdl_cgi, $username, $timestamp) = @_; 
     439    my ($gsdl_cgi, $username, $timestamp, $site) = @_; 
    346440 
    347441    my $collection = $gsdl_cgi->clean_param("c"); 
     
    356450 
    357451    # Make sure we don't try to delete anything outside the collection 
    358     if ($file =~ /\.\./) { 
     452    if ($file =~ m/\.\./) { 
    359453    $gsdl_cgi->generate_error("Illegal file specified."); 
    360454    } 
    361455 
    362456    # Ensure the user is allowed to edit this collection 
    363     &authenticate_user($gsdl_cgi, $username, $collection); 
    364  
    365     my $gsdlhome = $ENV{'GSDLHOME'}; 
    366     my $collection_directory = &util::filename_cat($gsdlhome, "collect", $collection); 
     457    &authenticate_user($gsdl_cgi, $username, $collection, $site); 
     458 
     459    my $collection_directory = $gsdl_cgi->get_collection_dir($site, $collection); 
     460    if (!-d $collection_directory){ ## wasn't there in gs2, ok_msg or error_msg? 
     461    $gsdl_cgi->generate_ok_message("Directory $collection_directory does not exist.");  
     462    die; 
     463    } 
     464 
    367465    $gsdl_cgi->checked_chdir($collection_directory); 
    368466 
    369467    # Make sure the collection isn't locked by someone else 
    370     &lock_collection($gsdl_cgi, $username, $collection); 
     468    &lock_collection($gsdl_cgi, $username, $collection, $site); 
    371469 
    372470    # Check that the collection file exists 
    373     if (!-e $file) { 
     471    if (!-e $file) { ## original didn't have 'die', but it was an ok message 
    374472    $gsdl_cgi->generate_ok_message("Collection file $file does not exist."); 
     473    die; 
    375474    } 
    376475    $gsdl_cgi->local_rm_r("$file"); 
     
    387486sub download_collection 
    388487{ 
    389     my ($gsdl_cgi, $username, $timestamp) = @_; 
     488    my ($gsdl_cgi, $username, $timestamp, $site) = @_; 
    390489 
    391490    my $collection = $gsdl_cgi->clean_param("c"); 
     
    395494 
    396495    # Ensure the user is allowed to edit this collection 
    397     &authenticate_user($gsdl_cgi, $username, $collection); 
    398  
    399     my $gsdlhome = $ENV{'GSDLHOME'}; 
    400     my $collect_directory = &util::filename_cat($gsdlhome, "collect"); 
     496    &authenticate_user($gsdl_cgi, $username, $collection, $site); 
     497 
     498    my $collect_directory = $gsdl_cgi->get_collection_dir($site); 
    401499    $gsdl_cgi->checked_chdir($collect_directory); 
    402500 
    403501    # Check that the collection exists 
    404502    if (!-d $collection) { 
    405     $gsdl_cgi->generate_error("Collection $collection does not exist."); 
     503    $gsdl_cgi->generate_ok_message("Collection $collection does not exist."); ## original had an error msg (from where it would die) 
     504    die; 
    406505    } 
    407506 
    408507    # Make sure the collection isn't locked by someone else 
    409     &lock_collection($gsdl_cgi, $username, $collection); 
     508    &lock_collection($gsdl_cgi, $username, $collection, $site); 
    410509 
    411510    # Zip up the collection 
    412511    my $java = $gsdl_cgi->get_java_path(); 
    413     my $java_classpath = &util::filename_cat($gsdlhome, "bin", "java", "GLIServer.jar"); 
     512    my $java_classpath = &util::filename_cat($ENV{'GSDLHOME'}, "bin", "java", "GLIServer.jar"); 
    414513    my $zip_file_path = &util::filename_cat($collect_directory, $collection . "-" . $timestamp . ".zip"); 
    415514    my $java_args = "\"$zip_file_path\" \"$collect_directory\" \"$collection\""; 
    416     my $java_command = "$java -classpath \"$java_classpath\" org.greenstone.gatherer.remote.ZipCollectionShell $java_args";  
     515    if($gsdl_cgi->greenstone_version() != 2) { 
     516    $java_args .= " gsdl3"; ## must this be done elsewhere as well? 
     517    } 
     518    my $java_command = "\"$java\" -classpath \"$java_classpath\" org.greenstone.gatherer.remote.ZipCollectionShell $java_args";  
    417519 
    418520    my $java_output = `$java_command`; 
     
    427529    } 
    428530 
    429     &put_file($gsdl_cgi, $zip_file_path, "application/zip"); 
    430     unlink("$zip_file_path") unless $debugging_enabled; 
     531    &put_file($gsdl_cgi, $zip_file_path, "application/zip"); # file is transferred to client 
     532    unlink("$zip_file_path") unless $debugging_enabled;      # deletes the local intermediate zip file 
    431533} 
    432534 
     
    434536sub download_collection_archives 
    435537{ 
    436     my ($gsdl_cgi, $username, $timestamp) = @_; 
     538    my ($gsdl_cgi, $username, $timestamp, $site) = @_; 
    437539 
    438540    my $collection = $gsdl_cgi->clean_param("c"); 
     
    442544 
    443545    # Ensure the user is allowed to edit this collection 
    444     &authenticate_user($gsdl_cgi, $username, $collection); 
    445  
    446     my $gsdlhome = $ENV{'GSDLHOME'}; 
    447     my $collect_directory = &util::filename_cat($gsdlhome, "collect"); 
     546    &authenticate_user($gsdl_cgi, $username, $collection, $site); 
     547 
     548    my $collect_directory = $gsdl_cgi->get_collection_dir($site); 
    448549    $gsdl_cgi->checked_chdir($collect_directory); 
    449550 
     
    454555 
    455556    # Make sure the collection isn't locked by someone else 
    456     &lock_collection($gsdl_cgi, $username, $collection); 
     557    &lock_collection($gsdl_cgi, $username, $collection, $site); 
    457558 
    458559    # Zip up the collection archives 
    459560    my $java = $gsdl_cgi->get_java_path(); 
    460     my $java_classpath = &util::filename_cat($gsdlhome, "bin", "java", "GLIServer.jar"); 
     561    my $java_classpath = &util::filename_cat($ENV{'GSDLHOME'}, "bin", "java", "GLIServer.jar"); 
    461562    my $zip_file_path = &util::filename_cat($collect_directory, $collection . "-archives-" . $timestamp . ".zip"); 
    462563    my $java_args = "\"$zip_file_path\" \"$collect_directory\" \"$collection\""; 
    463     my $java_command = "$java -classpath \"$java_classpath\" org.greenstone.gatherer.remote.ZipCollectionArchives $java_args";  
     564    my $java_command = "\"$java\" -classpath \"$java_classpath\" org.greenstone.gatherer.remote.ZipCollectionArchives $java_args";  
    464565 
    465566    my $java_output = `$java_command`; 
     
    482583sub download_collection_configurations 
    483584{ 
    484     my ($gsdl_cgi, $username, $timestamp) = @_; 
    485  
     585    my ($gsdl_cgi, $username, $timestamp, $site) = @_; 
     586    
    486587    # Users can be in any group to perform this action 
    487     my $user_groups = &authenticate_user($gsdl_cgi, $username, ""); 
    488  
    489     my $gsdlhome = $ENV{'GSDLHOME'}; 
    490     my $collect_directory = &util::filename_cat($gsdlhome, "collect"); 
     588    my $user_groups = &authenticate_user($gsdl_cgi, $username, "", $site); 
     589 
     590    my $collect_directory = $gsdl_cgi->get_collection_dir($site); 
    491591    $gsdl_cgi->checked_chdir($collect_directory); 
    492592 
    493593    # Zip up the collection configurations 
    494594    my $java = $gsdl_cgi->get_java_path(); 
    495     my $java_classpath = &util::filename_cat($gsdlhome, "bin", "java", "GLIServer.jar"); 
     595    my $java_classpath = &util::filename_cat($ENV{'GSDLHOME'}, "bin", "java", "GLIServer.jar"); 
    496596    my $zip_file_path = &util::filename_cat($collect_directory, "collection-configurations-" . $timestamp . ".zip"); 
    497597    my $java_args = "\"$zip_file_path\" \"$collect_directory\" \"$username\" \"$user_groups\""; 
    498     my $java_command = "$java -classpath \"$java_classpath\" org.greenstone.gatherer.remote.ZipCollectionConfigurations $java_args";  
    499  
     598    my $java_command = "\"$java\" -classpath \"$java_classpath\" org.greenstone.gatherer.remote.ZipCollectionConfigurations $java_args";  
    500599    my $java_output = `$java_command`; 
    501600    my $java_status = $?; 
     
    518617sub file_exists 
    519618{ 
    520     my ($gsdl_cgi) = @_; 
     619    my ($gsdl_cgi, $site) = @_; 
    521620 
    522621    my $collection = $gsdl_cgi->clean_param("c"); 
     
    530629    $file =~ s/\|/&util::get_dirsep()/eg;  # Convert the '|' characters into whatever is right for this OS 
    531630    
    532     # Not necessary: checking whether the user is authenticated to query existance of the file 
     631    # Not necessary: checking whether the user is authenticated to query existence of the file 
    533632    #&authenticate_user($gsdl_cgi, $username, $collection); 
    534633 
    535     my $gsdlhome = $ENV{'GSDLHOME'}; 
    536     my $collection_directory = &util::filename_cat($gsdlhome, "collect", $collection); 
    537     $gsdl_cgi->checked_chdir($collection_directory); 
     634    my $collection_directory = $gsdl_cgi->get_collection_dir($site, $collection); 
     635    $gsdl_cgi->checked_chdir($collection_directory); # cd into the directory of that collection 
    538636 
    539637    # Check that the collection file exists 
     
    547645sub download_collection_file 
    548646{ 
    549     my ($gsdl_cgi, $username, $timestamp) = @_; 
     647    my ($gsdl_cgi, $username, $timestamp, $site) = @_; 
    550648 
    551649    my $collection = $gsdl_cgi->clean_param("c"); 
     
    560658 
    561659    # Make sure we don't try to download anything outside the collection 
    562     if ($file =~ /\.\./) { 
     660    if ($file =~ m/\.\./) { 
    563661    $gsdl_cgi->generate_error("Illegal file specified."); 
    564662    } 
    565663 
    566664    # Ensure the user is allowed to edit this collection 
    567     &authenticate_user($gsdl_cgi, $username, $collection); 
    568  
    569     my $gsdlhome = $ENV{'GSDLHOME'}; 
    570     my $collection_directory = &util::filename_cat($gsdlhome, "collect", $collection); 
     665    &authenticate_user($gsdl_cgi, $username, $collection, $site); 
     666 
     667    my $collection_directory = $gsdl_cgi->get_collection_dir($site, $collection); 
    571668    $gsdl_cgi->checked_chdir($collection_directory); 
    572669 
    573670    # Check that the collection file exists 
    574671    if (!-e $file) { 
    575     $gsdl_cgi->generate_error("Collection file $file does not exist."); 
     672    $gsdl_cgi->generate_ok_message("Collection file $file does not exist."); 
     673    die; 
    576674    } 
    577675 
    578676    # Make sure the collection isn't locked by someone else 
    579     &lock_collection($gsdl_cgi, $username, $collection); 
     677    &lock_collection($gsdl_cgi, $username, $collection, $site); 
    580678 
    581679    # Zip up the collection file 
    582680    my $java = $gsdl_cgi->get_java_path(); 
    583     my $java_classpath = &util::filename_cat($gsdlhome, "bin", "java", "GLIServer.jar"); 
     681    my $java_classpath = &util::filename_cat($ENV{'GSDLHOME'}, "bin", "java", "GLIServer.jar"); 
    584682    my $zip_file_path = &util::filename_cat($collection_directory, $collection . "-file-" . $timestamp . ".zip"); 
    585683    my $java_args = "\"$zip_file_path\" \"$collection_directory\" \"$file\""; 
    586     my $java_command = "$java -classpath \"$java_classpath\" org.greenstone.gatherer.remote.ZipFiles $java_args";  
     684    my $java_command = "\"$java\" -classpath \"$java_classpath\" org.greenstone.gatherer.remote.ZipFiles $java_args";  
    587685 
    588686    my $java_output = `$java_command`; 
     
    601699} 
    602700 
     701# download web.xml from the server 
     702sub download_web_xml_file 
     703{ 
     704    my ($gsdl_cgi, $username, $timestamp, $site) = @_; 
     705 
     706    # Users can be in any group to perform this action 
     707    my $user_groups = &authenticate_user($gsdl_cgi, $username, "", $site); 
     708 
     709    my $file = $gsdl_cgi->clean_param("file"); 
     710    if ((!defined $file) || ($file =~ m/^\s*$/)) { 
     711    $gsdl_cgi->generate_error("No file specified."); 
     712    } 
     713    $file =~ s/\|/&util::get_dirsep()/eg;  # Convert the '|' characters into whatever is right for this OS 
     714 
     715    # Make sure we don't try to download anything else 
     716    if ($file =~ m/\.\./) { 
     717    $gsdl_cgi->generate_error("Illegal file specified."); 
     718    } 
     719 
     720    my $web_inf_directory = &util::filename_cat($ENV{'GSDL3SRCHOME'}, "web", "WEB-INF"); 
     721    $gsdl_cgi->checked_chdir($web_inf_directory); 
     722 
     723    # Check that the collection file exists 
     724    if (!-e $file) { 
     725    $gsdl_cgi->generate_error("file $file does not exist."); 
     726    } 
     727 
     728    # Zip up the collection file 
     729    my $java = $gsdl_cgi->get_java_path(); 
     730    my $java_classpath = &util::filename_cat($ENV{'GSDLHOME'}, "bin", "java", "GLIServer.jar"); 
     731    my $zip_file_path = &util::filename_cat($web_inf_directory, "webxml" . $timestamp . ".zip"); 
     732    my $java_args = "\"$zip_file_path\" \"$web_inf_directory\" \"$file\""; 
     733    my $java_command = "\"$java\" -classpath \"$java_classpath\" org.greenstone.gatherer.remote.ZipFiles $java_args";  
     734    my $java_output = `$java_command`; 
     735 
     736    my $java_status = $?; 
     737    if ($java_status > 0) { 
     738    $gsdl_cgi->generate_error("Java failed: $java_command\n--\n$java_output\nExit status: " . ($java_status / 256) . "\n" . $gsdl_cgi->check_java_home()); 
     739    } 
     740 
     741    # Check that the zip file was created successfully 
     742    if (!-e $zip_file_path || -z $zip_file_path) { 
     743    $gsdl_cgi->generate_error("web.xml zip file $zip_file_path could not be created."); 
     744    } 
     745 
     746    &put_file($gsdl_cgi, $zip_file_path, "application/zip"); 
     747 
     748    unlink("$zip_file_path") unless $debugging_enabled; 
     749} 
    603750 
    604751# Collection locking unnecessary because this action isn't related to a particular collection 
    605752sub get_script_options 
    606753{ 
    607     my ($gsdl_cgi, $username, $timestamp) = @_; 
     754    my ($gsdl_cgi, $username, $timestamp, $site) = @_; 
    608755 
    609756    my $script = $gsdl_cgi->clean_param("script"); 
     
    614761 
    615762    # Users can be in any group to perform this action 
    616     &authenticate_user($gsdl_cgi, $username, ""); 
     763    &authenticate_user($gsdl_cgi, $username, "", $site); 
     764    $gsdl_cgi->delete("ts"); ## two lines from GS3 version, doesn't seem to harm GS2 
     765    $gsdl_cgi->delete("pw");  
     766     
    617767 
    618768    my $perl_args = ""; 
     
    637787    } 
    638788 
    639     print STDOUT "Content-type:text/plain\n\n"; 
    640  
    641     my $perl_command = "perl -S $script $perl_args 2>&1"; 
    642789 
    643790    # IIS 6: redirecting output from STDERR to STDOUT just doesn't work, so we have to let it go 
    644791    #   directly out to the page 
    645     if ($iis6_mode) 
     792    print STDOUT "Content-type:text/plain\n\n"; 
     793    my $perl_command; 
     794    if($iis6_mode && $gsdl_cgi->greenstone_version() == 2) 
    646795    { 
    647796    $perl_command = "perl -S $script $perl_args"; 
     797    } else { 
     798    $perl_command = "perl -S $script $perl_args 2>&1"; 
    648799    } 
    649800 
     
    660811} 
    661812 
     813# get the names of all sites available on the server 
     814sub get_site_names 
     815{ 
     816    my ($gsdl_cgi, $username, $timestamp, $site) = @_; 
     817    my $sites_directory = &util::filename_cat($ENV{'GSDL3SRCHOME'}, "web", "sites"); 
     818 
     819    my @sites_dir; 
     820    my @site_dir; 
     821     
     822    $gsdl_cgi->checked_chdir($sites_directory); 
     823    opendir(DIR, $sites_directory); 
     824    @sites_dir= readdir(DIR); 
     825    my $sites_dir; 
     826    my $sub_dir_file; 
     827 
     828    print STDOUT "Content-type:text/plain\n\n"; 
     829    foreach $sites_dir(@sites_dir) 
     830    { 
     831    if (!(($sites_dir eq ".") || ($sites_dir eq "..") || ($sites_dir eq "CVS"))) 
     832    { 
     833        my $site_dir_path= &util::filename_cat($sites_directory,$sites_dir); 
     834        $gsdl_cgi->checked_chdir($site_dir_path); 
     835        opendir(DIR,$site_dir_path); 
     836        @site_dir=readdir(DIR); 
     837        closedir(DIR); 
     838         
     839        foreach $sub_dir_file(@site_dir) 
     840        { 
     841        if ($sub_dir_file eq "siteConfig.xml"){ 
     842            print STDOUT "$sites_dir" . "-----"; 
     843        } 
     844        } 
     845    } 
     846    } 
     847 
     848} 
    662849 
    663850sub move_collection_file 
    664851{ 
    665     my ($gsdl_cgi, $username, $timestamp) = @_; 
     852    my ($gsdl_cgi, $username, $timestamp, $site) = @_; 
    666853 
    667854    my $collection = $gsdl_cgi->clean_param("c"); 
     
    681868 
    682869    # Make sure we don't try to move anything outside the collection 
    683     if ($source_file =~ /\.\./ || $target_file =~ /\.\./) { 
     870    if ($source_file =~ m/\.\./ || $target_file =~ m/\.\./) { 
    684871    $gsdl_cgi->generate_error("Illegal file specified."); 
    685872    } 
    686873 
    687874    # Ensure the user is allowed to edit this collection 
    688     &authenticate_user($gsdl_cgi, $username, $collection); 
    689  
    690     my $gsdlhome = $ENV{'GSDLHOME'}; 
    691     my $collection_directory = &util::filename_cat($gsdlhome, "collect", $collection); 
     875    &authenticate_user($gsdl_cgi, $username, $collection, $site); 
     876 
     877    my $collection_directory = $gsdl_cgi->get_collection_dir($site, $collection); 
    692878    $gsdl_cgi->checked_chdir($collection_directory); 
    693879 
     
    698884 
    699885    # Make sure the collection isn't locked by someone else 
    700     &lock_collection($gsdl_cgi, $username, $collection); 
     886    &lock_collection($gsdl_cgi, $username, $collection, $site); 
    701887 
    702888    &util::mv($source_file, $target_file); 
     
    704890    # Check that the collection source file was moved 
    705891    if (-e $source_file || !-e $target_file) { 
    706     $gsdl_cgi->generate_error("Could not move collection file $source_file to $target_file."); 
     892    $gsdl_cgi->generate_error("Could not move collection file $source_file to $target_file."); # dies 
    707893    } 
    708894 
     
    713899sub new_collection_directory 
    714900{ 
    715     my ($gsdl_cgi, $username, $timestamp) = @_; 
     901    my ($gsdl_cgi, $username, $timestamp, $site) = @_; 
    716902 
    717903    my $collection = $gsdl_cgi->clean_param("c"); 
     
    726912 
    727913    # Make sure we don't try to create anything outside the collection 
    728     if ($directory =~ /\.\./) { 
     914    if ($directory =~ m/\.\./) { 
    729915    $gsdl_cgi->generate_error("Illegal directory specified."); 
    730916    } 
    731917 
    732918    # Ensure the user is allowed to edit this collection 
    733     &authenticate_user($gsdl_cgi, $username, $collection); 
    734  
    735     my $gsdlhome = $ENV{'GSDLHOME'}; 
    736     my $collection_directory = &util::filename_cat($gsdlhome, "collect", $collection); 
     919    &authenticate_user($gsdl_cgi, $username, $collection, $site); 
     920 
     921    my $collection_directory = $gsdl_cgi->get_collection_dir($site, $collection); 
    737922    $gsdl_cgi->checked_chdir($collection_directory); 
    738923 
    739924    # Check that the collection directory doesn't already exist 
    740     # ZipTools doesn't zip up empty directories, so this causes an error when downloading a new collection as we explicity 
     925    # ZipTools doesn't zip up empty directories, so this causes an error when downloading a new collection as we explicitly 
    741926    # try to create the import directory 
    742 #    if (-d $directory) { 
    743 #   $gsdl_cgi->generate_error("Collection directory $directory already exists."); 
    744 #    } 
     927## log -r13497 for GS2's gliserver.pl, Katherine Don explains: 
     928# "commented out checking for existence of a directory in new_collection_directory  
     929# as it throws an error which we don't want" 
     930    #if($gsdl_cgi->greenstone_version() != 2 && -d $directory) { 
     931    #$gsdl_cgi->generate_error("Collection directory $directory already exists."); 
     932    #} 
    745933 
    746934    # Make sure the collection isn't locked by someone else 
    747     &lock_collection($gsdl_cgi, $username, $collection); 
     935    &lock_collection($gsdl_cgi, $username, $collection, $site); 
    748936 
    749937    &util::mk_dir($directory); 
     
    760948sub run_script 
    761949{ 
    762     my ($gsdl_cgi, $username, $timestamp) = @_; 
     950    my ($gsdl_cgi, $username, $timestamp, $site) = @_; 
    763951 
    764952    my $script = $gsdl_cgi->clean_param("script"); 
     
    767955    } 
    768956    $gsdl_cgi->delete("script"); 
     957  
    769958    my $collection = $gsdl_cgi->clean_param("c"); 
    770959    if ((!defined $collection) || ($collection =~ m/^\s*$/)) { 
     
    773962    $gsdl_cgi->delete("c"); 
    774963 
     964    # confuse other, so delete timestamp 
     965    $gsdl_cgi->delete("ts"); 
     966 
    775967    # Ensure the user is allowed to edit this collection 
    776     &authenticate_user($gsdl_cgi, $username, $collection); 
     968    &authenticate_user($gsdl_cgi, $username, $collection, $site); 
    777969 
    778970    # Make sure the collection isn't locked by someone else (unless we're running mkcol.pl, of course) 
    779     &lock_collection($gsdl_cgi, $username, $collection) unless ($script eq "mkcol.pl"); 
     971    &lock_collection($gsdl_cgi, $username, $collection, $site) unless ($script eq "mkcol.pl"); 
    780972 
    781973    # Last argument is the collection name, except for explode_metadata_database.pl and 
     
    783975    my $perl_args = $collection; 
    784976    if ($script eq "explode_metadata_database.pl" || $script eq "replace_srcdoc_with_html.pl") { 
    785     # Last argument is the file to be exploded 
     977    # Last argument is the file to be exploded or it is the file to be replaced with its html version 
    786978    my $file = $gsdl_cgi->clean_param("file"); 
    787979    if ((!defined $file) || ($file =~ m/^\s*$/)) { 
     
    789981    } 
    790982    $gsdl_cgi->delete("file"); 
    791     $file =~ s/ /\\ /g; # escape all spaces in filename with a backslash, i.e. "\ ". 
    792     $perl_args = $file;  
     983    #$file =~ s/ /\\ /g; # Works on linux: escape all spaces in filename with a backslash, i.e. "\ ". 
     984    $file = "\"$file\""; # Windows: bookend the relative filepath with quotes in case it contains spaces  
     985    $perl_args = $file; 
    793986    } 
    794987 
     
    803996    } 
    804997 
    805     print STDOUT "Content-type:text/plain\n\n"; 
     998    # mkcol.pl and import.pl, buildcol.pl, g2f-import.pl, g2f-buildcol.pl all need the -collectdir option passed 
     999    my $import_pl = "import.pl"; # import is a reserved word, need to put it in quotes 
     1000     
     1001    if (($script =~ m/$import_pl|buildcol.pl/) || ($script eq "mkcol.pl")) { # || ($script eq "schedule.pl") 
     1002    my $collect_directory = $gsdl_cgi->get_collection_dir($site);  
     1003    $perl_args = $perl_args . " -collectdir \"$collect_directory\""; 
     1004    } 
    8061005 
    8071006    my $perl_command = "perl -S $script $perl_args 2>&1"; 
    808  
    8091007    # IIS 6: redirecting output from STDERR to STDOUT just doesn't work, so we have to let it go 
    8101008    #   directly out to the page 
    811     if ($iis6_mode) 
     1009    if($gsdl_cgi->greenstone_version() == 2 && $iis6_mode) 
    8121010    { 
    8131011    $perl_command = "perl -S $script $perl_args"; 
    8141012    } 
    815  
    8161013    if (!open(PIN, "$perl_command |")) { 
    8171014    $gsdl_cgi->generate_error("Unable to execute command: $perl_command"); 
    8181015    } 
     1016 
     1017    print STDOUT "Content-type:text/plain\n\n"; 
     1018    print "$perl_command  \n"; 
    8191019 
    8201020    while (defined (my $perl_output_line = <PIN>)) { 
     
    8341034} 
    8351035 
    836  
    8371036sub upload_collection_file 
    8381037{ 
    839     my ($gsdl_cgi, $username, $timestamp) = @_; 
    840  
     1038    my ($gsdl_cgi, $username, $timestamp, $site) = @_; 
     1039    
    8411040    my $collection = $gsdl_cgi->clean_param("c"); 
    8421041    if ((!defined $collection) || ($collection =~ m/^\s*$/)) { 
     
    8521051 
    8531052    # Make sure we don't try to upload anything outside the collection 
    854     if ($file =~ /\.\./) { 
     1053    if ($file =~ m/\.\./) { 
    8551054    $gsdl_cgi->generate_error("Illegal file specified."); 
    8561055    } 
    857     if ($directory =~ /\.\./) { 
     1056    if ($directory =~ m/\.\./) { 
    8581057    $gsdl_cgi->generate_error("Illegal directory specified."); 
    8591058    } 
    8601059 
    8611060    # Ensure the user is allowed to edit this collection 
    862     &authenticate_user($gsdl_cgi, $username, $collection); 
    863  
    864     my $gsdlhome = $ENV{'GSDLHOME'}; 
    865     my $collection_directory = &util::filename_cat($gsdlhome, "collect", $collection); 
     1061    if($gsdl_cgi->greenstone_version() == 2) { ## Quan commented this out for GS3 in r14325 
     1062    &authenticate_user($gsdl_cgi, $username, $collection, $site); # site will be undefined for GS2, of course 
     1063    } 
     1064 
     1065    my $collection_directory = $gsdl_cgi->get_collection_dir($site, $collection); 
    8661066    $gsdl_cgi->checked_chdir($collection_directory); 
    8671067 
    8681068    # Make sure the collection isn't locked by someone else 
    869     &lock_collection($gsdl_cgi, $username, $collection); 
     1069    &lock_collection($gsdl_cgi, $username, $collection, $site); 
    8701070 
    8711071    my $directory_path = &util::filename_cat($collection_directory, $directory); 
     
    8771077    } 
    8781078 
    879     my $file_path = &util::filename_cat($directory_path, $file . "-" . $timestamp); 
     1079    #my $file_path = &util::filename_cat($directory_path, $file . "-" . $timestamp);  
     1080    my $file_path = ""; 
     1081    if($gsdl_cgi->greenstone_version() == 2) { 
     1082    $file_path = &util::filename_cat($directory_path, $file . "-" . $timestamp);  
     1083    } else { 
     1084    $file_path = &util::filename_cat($directory_path, $file);  
     1085    } 
     1086    
    8801087    if (!open(FOUT, ">$file_path")) { 
     1088    print STDERR "Unable to write file $file_path\n"; 
    8811089    $gsdl_cgi->generate_error("Unable to write file $file_path"); 
    8821090    } 
    8831091 
    8841092    # Read the uploaded data and write it out to file 
    885     # We have to pass the size of the uploaded data in the "fs" argument because IIS 6 seems to be 
    886     #   completely incapable of working this out otherwise (causing the old code to crash) 
    8871093    my $buf; 
    8881094    my $num_bytes = 0; 
    889     my $num_bytes_remaining = $gsdl_cgi->clean_param("fs"); 
    890     my $bytes_to_read = $num_bytes_remaining; 
    891     if ($bytes_to_read > 1024) { $bytes_to_read = 1024; } 
    8921095    binmode(FOUT); 
    893     while (read(STDIN, $buf, $bytes_to_read) > 0) { 
    894     print FOUT $buf; 
    895     $num_bytes += length($buf); 
    896     $num_bytes_remaining -= length($buf); 
    897     $bytes_to_read = $num_bytes_remaining; 
     1096    if($gsdl_cgi->greenstone_version() == 2) { ## 
     1097    # We have to pass the size of the uploaded data in the "fs" argument because IIS 6 seems to be 
     1098    #   completely incapable of working this out otherwise (causing the old code to crash) 
     1099    my $num_bytes_remaining = $gsdl_cgi->clean_param("fs"); 
     1100    my $bytes_to_read = $num_bytes_remaining; 
    8981101    if ($bytes_to_read > 1024) { $bytes_to_read = 1024; } 
     1102 
     1103    while (read(STDIN, $buf, $bytes_to_read) > 0) { 
     1104        print FOUT $buf; 
     1105        $num_bytes += length($buf); 
     1106        $num_bytes_remaining -= length($buf); 
     1107        $bytes_to_read = $num_bytes_remaining; 
     1108        if ($bytes_to_read > 1024) { $bytes_to_read = 1024; } 
     1109    } 
     1110    } else { # GS3 and later 
     1111        my $bread; 
     1112    my $fh = $gsdl_cgi->clean_param("uploaded_file"); 
     1113 
     1114    if (!defined $fh) { 
     1115        print STDERR "ERROR. Filehandle undefined. No file uploaded onto GS3 server.\n"; 
     1116        $gsdl_cgi->generate_error("ERROR. Filehandle undefined. No file uploaded (GS3 server)."); 
     1117    } else { 
     1118        while ($bread=read($fh, $buf, 1024)) { 
     1119        print FOUT $buf; 
     1120        } 
     1121    } 
    8991122    } 
    9001123    close(FOUT); 
    901  
     1124        
    9021125    # If we have downloaded a zip file, unzip it 
    9031126    if (defined $zip) { 
    9041127    my $java = $gsdl_cgi->get_java_path(); 
    905     my $java_classpath = &util::filename_cat($gsdlhome, "bin", "java", "GLIServer.jar"); 
     1128    my $java_classpath = &util::filename_cat($ENV{'GSDLHOME'}, "bin", "java", "GLIServer.jar"); 
    9061129    my $java_args = "\"$file_path\" \"$directory_path\""; 
    907     my $java_command = "$java -classpath \"$java_classpath\" org.greenstone.gatherer.remote.Unzip $java_args";  
     1130    my $java_command = "\"$java\" -classpath \"$java_classpath\" org.greenstone.gatherer.remote.Unzip $java_args";  
    9081131 
    9091132    my $java_output = `$java_command`; 
     
    9111134 
    9121135    # Remove the zip file once we have unzipped it, since it is an intermediate file only 
    913     unlink("$file_path"); 
    914  
     1136    unlink("$file_path") unless $debugging_enabled; 
     1137     
    9151138    if ($java_status > 0) { 
    916         $gsdl_cgi->generate_error("Java failed: $java_command\n--\n$java_output\nExit status: " . ($java_status / 256) . "\n" . $gsdl_cgi->check_java_home()); 
     1139        $gsdl_cgi->generate_error("Java failed: $java_command\n--\n$java_output\nExit status: " . ($java_status / 256) . "\n" . $gsdl_cgi->check_java_home()); # dies 
    9171140    } 
    9181141    } 
     
    9201143    $gsdl_cgi->generate_ok_message("Collection file $file uploaded successfully."); 
    9211144} 
    922  
    9231145 
    9241146sub put_file 
     
    9281150    my $content_type = shift(@_); 
    9291151 
     1152    if(!defined $content_type) { ## 
     1153    $content_type = "application/zip"; 
     1154    } 
     1155     
    9301156    if (open(PIN, "<$file_path")) { 
    931     print STDOUT "Content-type:$content_type\n\n"; 
    932  
     1157    print STDOUT "Content-type:$content_type\n\n"; ## For GS3: "Content-type:application/zip\n\n"; 
    9331158    my $buf; 
    9341159    my $num_bytes = 0; 
     
    9661191} 
    9671192 
     1193sub greenstone_server_version 
     1194{    
     1195    my $gsdl_cgi = shift(@_); 
     1196    my $version = $gsdl_cgi->greenstone_version(); 
     1197    $gsdl_cgi->generate_ok_message("Greenstone server version is: $version\n"); 
     1198} 
     1199 
     1200sub get_library_url_suffix 
     1201{ 
     1202    my $gsdl_cgi = shift(@_); 
     1203    my $library_url = $gsdl_cgi->library_url_suffix(); 
     1204    $gsdl_cgi->generate_ok_message("Greenstone library URL suffix is: $library_url\n"); 
     1205} 
    9681206 
    9691207&main(); 
  • gsdl/trunk/cgi-bin/gsdlCGI.pm

    r14973 r16467  
    1  
    21package gsdlCGI; 
    32 
    4  
     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 
    58 
    69use CGI; 
    710use Cwd; 
    811 
    9 @ISA = ('CGI'); 
     12@gsdlCGI::ISA = ( 'CGI' );  
    1013 
    1114sub new { 
    1215    my $class = shift @_; 
    13  
     16     
    1417    my $self; 
     18    
     19    # We'll determine the correct config file in this constructor itself  
     20    # and use it to determine the Greenstone server's version.  
     21    # Perhaps later, another test can be used for finding out what version  
     22    # of the Greenstone server we are working with. 
     23    my $version; 
     24    if (-e "gsdl3site.cfg") { 
     25    $version = 3; 
     26    } else { 
     27    $version = 2; 
     28    } 
     29 
    1530    if ((defined $ENV{'REQUEST_METHOD'}) && ($ENV{'REQUEST_METHOD'} eq "POST")) { 
    16     my $line = <STDIN>; 
    17     if ((defined $line) && ($line ne "")) { 
    18         $self = new CGI($line); 
    19     } 
    20     else { 
    21         $self = new CGI(); 
    22     } 
    23     } 
    24     else { 
     31 
     32    # Check if we're dealing with the upload-coll-file cmd. Because it will be a  
     33    # multipart POST message and must be dealt with by the default CGI() constructor 
     34    if((defined $ENV{'QUERY_STRING'}) && ($ENV{'QUERY_STRING'} =~ m/upload-collection-file/)) { 
     35        $self = new CGI();  
     36    }  
     37 
     38    else { # all other POST commands processed using CGI($line) 
     39        my $line = <STDIN>; 
     40        if ((defined $line) && ($line ne "")) {  
     41        $self = new CGI($line); 
     42        } 
     43    } 
     44     
     45    }     
     46     
     47    # If one of the conditions above did not hold, then self=new CGI()  
     48    if (!defined $self) {  
    2549    $self = new CGI(); 
    2650    } 
    2751 
     52    if ($version == 2) { 
     53    $self->{'site_filename'} = "gsdlsite.cfg"; 
     54    $self->{'greenstone_version'} = 2; 
     55    }  
     56    elsif ($version == 3) { 
     57    $self->{'site_filename'} = "gsdl3site.cfg"; 
     58    $self->{'greenstone_version'} = 3; 
     59    } 
     60     
    2861    return bless $self, $class; 
    2962} 
     
    73106} 
    74107 
     108sub generate_message 
     109{ 
     110    my $self = shift @_; 
     111    my ($message) = @_; 
     112     
     113    #if($self->{'greenstone_version'} == 2) { # plain text, for IIS 6 
     114    print STDOUT "Content-type:text/plain\n\n$message"; 
     115    #} else { 
     116    #print "Content-type:text/html\n\n"; 
     117    #print "<pre>"; 
     118    #print STDOUT $message; 
     119    #print "</pre>"; 
     120    #} 
     121} 
    75122 
    76123sub generate_error 
     
    98145    } 
    99146 
    100     print STDOUT "Content-type:text/plain\n\n"; 
    101     print STDOUT $full_mess; 
    102  
    103     exit 0; 
     147    $self->generate_message($full_mess); 
     148 
     149    die $full_mess; 
    104150} 
    105151 
     
    128174    } 
    129175 
    130     print STDOUT "Content-type:text/plain\n\n"; 
    131     print STDOUT $full_mess; 
     176    $self->generate_message($full_mess); 
    132177 
    133178    print STDERR $full_mess; 
     
    152197    $full_mess = "$mess\n"; 
    153198    } 
    154  
    155     print STDOUT "Content-type:text/plain\n\n"; 
    156     print STDOUT $full_mess; 
     199  
     200    $self->generate_message($full_mess); 
    157201} 
    158202 
     
    161205sub get_config_info { 
    162206    my $self = shift @_; 
    163     my ($infotype) = @_; 
    164  
    165     my $site_filename = "gsdlsite.cfg"; 
     207    my ($infotype, $optional) = @_; 
     208 
     209    my $site_filename = $self->{'site_filename'}; 
    166210    open (FILEIN, "<$site_filename")  
    167     || $self->generate_error("Could not open gsdlsite.cfg"); 
     211    || $self->generate_error("Could not open $site_filename"); 
    168212 
    169213    my $config_content = ""; 
     
    174218 
    175219    my ($loc) = ($config_content =~ m/^$infotype\s+((\".+\")|(\S+))\s*\n/m); 
    176     $loc =~ s/\"//g; 
     220    $loc =~ s/\"//g if defined $loc; 
    177221 
    178222    if ((!defined $loc) || ($loc =~ m/^\s*$/)) { 
    179     $self->generate_error("$infotype is not set in gsdlsite.cfg"); 
     223    if((!defined $optional) || (!$optional)) { 
     224        $self->generate_error("$infotype is not set in $site_filename"); 
     225    } 
    180226    } 
    181227 
    182228    return $loc; 
     229} 
     230 
     231sub get_gsdl3_src_home{ 
     232    my $self = shift @_; 
     233    if (defined $self->{'gsdl3srchome'}) { 
     234    return $self->{'gsdl3srchome'}; 
     235    } 
     236 
     237    my $gsdl3srchome = $self->get_config_info("gsdl3srchome"); 
     238 
     239    if(defined $gsdl3srchome) { 
     240    $gsdl3srchome =~ s/(\/|\\)$//; # remove trailing slash 
     241    } 
     242    $self->{'gsdl3srchome'} = $gsdl3srchome; 
     243 
     244    return $gsdl3srchome; 
    183245} 
    184246 
     
    200262} 
    201263 
     264sub get_gsdl3_home { 
     265    my $self = shift @_; 
     266    my ($optional) = @_; 
     267     
     268    if (defined $self->{'gsdl3home'}) { 
     269    return $self->{'gsdl3home'}; 
     270    } 
     271 
     272    my $gsdl3home = $self->get_config_info("gsdl3home", $optional); 
     273 
     274    if(defined $gsdl3home) { 
     275    $gsdl3home =~ s/(\/|\\)$//; # remove trailing slash 
     276    $self->{'gsdl3home'} = $gsdl3home; 
     277    } 
     278    return $gsdl3home; 
     279} 
     280 
     281sub get_java_home { 
     282    my $self = shift @_; 
     283    my ($optional) = @_; 
     284     
     285    if (defined $self->{'javahome'}) { 
     286    return $self->{'javahome'}; 
     287    } 
     288 
     289    my $javahome = $self->get_config_info("javahome", $optional); 
     290    if(defined $javahome) { 
     291    $javahome =~ s/(\/|\\)$//; # remove trailing slash 
     292    $self->{'javahome'} = $javahome; 
     293    } 
     294    return $javahome; 
     295} 
     296 
     297sub get_perl_path { 
     298    my $self = shift @_; 
     299     
     300    if (defined $self->{'perlpath'}) { 
     301    return $self->{'perlpath'}; 
     302    } 
     303 
     304    my $perlpath = $self->get_config_info("perlpath"); 
     305 
     306    if(defined $perlpath) { 
     307    $perlpath =~ s/(\/|\\)$//; # remove trailing slash 
     308    $self->{'perlpath'} = $perlpath; 
     309    } 
     310    return $perlpath; 
     311} 
     312 
    202313sub get_gsdl_os { 
    203314    my $self = shift @_; 
     
    208319    return "linux"; 
    209320    } 
    210     elsif ($os =~ /mswin/i) { 
     321    elsif ($os =~ m/mswin/i) { 
    211322    return "windows"; 
    212323    } 
    213     elsif ($os =~ /macos/i) { 
     324    elsif ($os =~ m/macos/i) { 
    214325    return "darwin"; 
    215326    } 
     
    220331} 
    221332 
     333sub get_library_url_suffix { 
     334    my $self = shift @_; 
     335     
     336    if (defined $self->{'library_url_suffix'}) { 
     337    return $self->{'library_url_suffix'}; 
     338    } 
     339 
     340    my $optional = 1; # ignore absence of gwcgi if not found 
     341    my $library_url = $self->get_config_info("gwcgi", $optional); 
     342    if(defined $library_url) { 
     343    $library_url =~ s/(\/|\\)$//; # remove trailing slash 
     344    } 
     345    else { 
     346 
     347    if($self->{'greenstone_version'} == 2) { 
     348        $library_url = $self->get_config_info("httpprefix"); 
     349        $library_url = "$library_url/cgi-bin/library"; 
     350 
     351        my $gsdlos = (defined $ENV{'GSDLOS'}) ? $ENV{'GSDLOS'} : $self->get_gsdl_os(); 
     352        if($gsdlos =~ m/windows/) { # remote GS2 server on Windows uses "library.exe" 
     353        $library_url .= ".exe"; 
     354        } 
     355    }  
     356    else { # greenstone 3 or later and gwcgi not defined 
     357        $library_url = "/greenstone3"; #"/greenstone3/library"; 
     358    } 
     359    } 
     360 
     361    $self->{'library_url_suffix'} = $library_url; 
     362    return $library_url; 
     363} 
     364 
     365sub setup_fedora_homes { 
     366    my $self = shift @_; 
     367    my ($optional) = @_; 
     368 
     369    # The following will still allow the FEDORA_HOME and FEDORA_VERSION environment  
     370    # variables to have been set outside the gsdlsite.cfg file. Existing env vars  
     371    # are only overwritten if they've *also* been defined in gsdlsite.cfg. 
     372 
     373    if (!defined $self->{'fedora_home'}) # Don't need to go through it all again if we'd already done this before 
     374    { 
     375    # First look in the gsdlsite.cfg file for the fedora properties to be defined 
     376    # and set $ENV{FEDORA_HOME} and $ENV{FEDORA_VERSION} if values were provided 
     377    $self->{'fedora_home'} = $self->get_config_info("fedorahome", $optional); 
     378     
     379    if (defined $self->{'fedora_home'}) { 
     380        $ENV{'FEDORA_HOME'} = $self->{'fedora_home'};  
     381    }  
     382    elsif (defined $ENV{'FEDORA_HOME'}) { # check environment variable 
     383        $self->{'fedora_home'} = $ENV{'FEDORA_HOME'}; 
     384    } 
     385     
     386    # if FEDORA_HOME is now defined, we can look for the fedora version that is being used 
     387    if (defined $ENV{'FEDORA_HOME'})  
     388    { 
     389        # first look in the file 
     390        $self->{'fedora_version'} = $self->get_config_info("fedoraversion", $optional); 
     391 
     392        if (defined $self->{'fedora_version'}) { 
     393        $ENV{'FEDORA_VERSION'} = $self->{'fedora_version'}; 
     394        }  
     395        elsif (defined $ENV{'FEDORA_VERSION'}) { # then check environment variable 
     396        $self->{'fedora_version'} = $ENV{'FEDORA_VERSION'}; 
     397        }  
     398        else { # finally, default to version 3 and warn the user 
     399        $ENV{'FEDORA_VERSION'} = "3"; 
     400        $self->{'fedora_version'} = $ENV{'FEDORA_VERSION'}; 
     401        #$self->generate_ok_message("FEDORA_HOME is set, but not FEDORA_VERSION, defaulted to: 3."); 
     402        } 
     403    } 
     404    } 
     405} 
     406 
    222407sub setup_gsdl { 
    223408    my $self = shift @_; 
     409    my $optional = 1; # ignore absence of specified properties in gsdl(3)site.cfg if not found 
    224410 
    225411    my $gsdlhome = $self->get_gsdl_home(); 
    226412    my $gsdlos = $self->get_gsdl_os(); 
    227  
    228413    $ENV{'GSDLHOME'} = $gsdlhome; 
    229414    $ENV{'GSDLOS'} = $gsdlos; 
    230415 
     416    my $library_url = $self->get_library_url_suffix(); # best to have GSDLOS set beforehand 
     417    $self->{'library_url_suffix'} = $library_url; 
     418 
    231419    require "$gsdlhome/perllib/util.pm"; 
    232420 
     421    if($self->{'greenstone_version'} == 3) { 
     422    my $gsdl3srchome = $self->get_gsdl3_src_home(); 
     423    $ENV{'GSDL3SRCHOME'} = $gsdl3srchome; 
     424 
     425    my $gsdl3home = $self->get_gsdl3_home($optional); 
     426    # if a specific location for GS3's web folder is not provided, 
     427    # assume the GS3 web folder is in the default location 
     428    if(!defined $gsdl3home) {  
     429        $gsdl3home = &util::filename_cat($ENV{'GSDL3SRCHOME'}, "web"); 
     430        $self->{'gsdl3home'} = $gsdl3home; 
     431    }  
     432    $ENV{'GSDL3HOME'} = $gsdl3home; 
     433    }  
     434    
     435     
    233436    my $gsdl_bin_script = &util::filename_cat($gsdlhome,"bin","script"); 
    234437    &util::envvar_append("PATH",$gsdl_bin_script); 
    235  
     438     
    236439    my $gsdl_bin_os = &util::filename_cat($gsdlhome,"bin",$gsdlos); 
    237440    &util::envvar_append("PATH",$gsdl_bin_os); 
    238  
     441     
     442    # Perl comes installed with the GS Windows Release Kit.  
     443    # However, if GS is from SVN, the user must have their own Perl and put it on the path. 
     444    my $perl_bin_dir; # undefined 
    239445    if ($gsdlos eq "windows") { 
    240     my $gsdl_perl_bin_directory = &util::filename_cat($gsdlhome, "bin", "windows", "perl", "bin"); 
    241     &util::envvar_append("PATH", $gsdl_perl_bin_directory); 
    242     } 
    243 } 
    244  
     446    $perl_bin_dir = &util::filename_cat($gsdlhome, "bin", "windows", "perl", "bin"); 
     447    if(-e $perl_bin_dir) { 
     448        &util::envvar_append("PATH", $perl_bin_dir); 
     449    } 
     450    } 
     451 
     452    # Uncomment these lines if you want to read the "perlpath" property from 
     453    # the gsdl(3)site.cfg config file into PATH 
     454    #if(!defined $perl_bin_dir) { 
     455    #$perl_bin_dir = $self->get_perl_path(); 
     456    #&util::envvar_append("PATH", $perl_bin_dir); 
     457    #} 
     458     
     459    # gsdl(3)site.cfg can specify JAVA_HOME and FEDORA_HOME along with Fedora's version. Both 
     460    # are needed (by scripts g2f-import and g2f-buildcol) when using Greenstone 2 with Fedora. 
     461    if(!defined $ENV{'JAVA_HOME'}) { 
     462    $ENV{'JAVA_HOME'} = $self->get_java_home($optional); 
     463    } 
     464 
     465    $self->setup_fedora_homes($optional); 
     466} 
     467 
     468sub greenstone_version { 
     469    my $self = shift @_; 
     470    return $self->{'greenstone_version'}; 
     471} 
     472 
     473sub library_url_suffix { 
     474    my $self = shift @_; 
     475    return $self->{'library_url_suffix'}; 
     476} 
     477 
     478# Only useful to call this after calling setup_gsdl, as it uses some environment variables 
     479# Returns the Greenstone collect directory, or a specific collection directory inside collect 
     480sub get_collection_dir { 
     481    my $self = shift @_; 
     482    my ($site, $collection) = @_; # both may be undefined 
     483 
     484    require "$ENV{'GSDLHOME'}/perllib/util.pm"; 
     485    my $collection_directory; 
     486    if($self->{'greenstone_version'} == 2 && defined $ENV{'GSDLHOME'}) { 
     487    if(defined $collection) { 
     488        $collection_directory = &util::filename_cat($ENV{'GSDLHOME'}, "collect", $collection); 
     489    } else { 
     490        $collection_directory = &util::filename_cat($ENV{'GSDLHOME'}, "collect"); 
     491    } 
     492    } 
     493    elsif($self->{'greenstone_version'} == 3 && defined $ENV{'GSDL3SRCHOME'}) { 
     494    if(defined $collection) { 
     495        $collection_directory = &util::filename_cat($ENV{'GSDL3SRCHOME'}, "web", "sites", $site, "collect", $collection); 
     496    } else { 
     497        $collection_directory = &util::filename_cat($ENV{'GSDL3SRCHOME'}, "web", "sites", $site, "collect"); 
     498    } 
     499    } 
     500} 
    245501 
    246502sub local_rm_r 
     
    250506 
    251507    my $prefix_dir = getcwd();  
    252  
     508    my $full_path = &util::filename_cat($prefix_dir,$local_dir); 
     509     
    253510    if ($prefix_dir !~ m/collect/) { 
    254     $self->generate_error("Trying to delete outside of Greenstone collect: $full_dir"); 
    255     } 
    256  
    257     my $full_dir = &util::filename_cat($prefix_dir,$local_dir); 
     511    $self->generate_error("Trying to delete outside of Greenstone collect: $full_path"); 
     512    } 
    258513 
    259514    # Delete recursively 
    260     if (!-e $full_dir) { 
    261     $self->generate_error("File/Directory does not exist: $full_dir"); 
    262     } 
    263  
    264     &util::rm_r($full_dir); 
     515    if (!-e $full_path) { 
     516    $self->generate_error("File/Directory does not exist: $full_path"); 
     517    } 
     518 
     519    &util::rm_r($full_path); 
    265520} 
    266521 
     
    282537sub check_java_home() 
    283538{ 
    284     # Return a warning unless the JAVA_HOME enrivonmen variable is set 
     539    # Return a warning unless the JAVA_HOME environment variable is set 
    285540    if (!defined $ENV{'JAVA_HOME'}) { 
    286541    return "JAVA_HOME environment variable not set. Might not be able to find Java unless in PATH (" . $ENV{'PATH'} . ")"; 
     
    304559} 
    305560 
     561sub rot13() 
     562{ 
     563    my $self = shift @_; 
     564    my ($password)=@_; 
     565    my @password_arr=split(//,$password); 
     566     
     567    my @encrypt_password; 
     568    foreach my $str (@password_arr){ 
     569    my $char=unpack("c",$str); 
     570    if ($char>=97 && $char<=109){ 
     571        $char+=13; 
     572    }elsif ($char>=110 && $char<=122){ 
     573        $char-=13; 
     574    }elsif ($char>=65 && $char<=77){ 
     575        $char+=13; 
     576    }elsif ($char>=78 && $char<=90){ 
     577        $char-=13; 
     578    } 
     579    $char=pack("c",$char); 
     580    push(@encrypt_password,$char); 
     581    } 
     582    return join("",@encrypt_password); 
     583} 
     584 
     585sub encrypt_password 
     586{ 
     587    my $self = shift @_; 
     588     
     589    if (defined $self->param("pw")) { ## 
     590    if ($self->{'greenstone_version'} == 3) { # GS3 is in Java, so needs different encryption 
     591        $self->param('-name' => "pw", '-value' => $self->rot13($self->clean_param("pw"))); 
     592    } 
     593    else { # GS2 (and versions of GS other than 3?) 
     594        #require "$self->{'gsdlhome'}/perllib/util.pm";  # This is OK on Windows 
     595        require "$self->{'gsdlhome'}/perllib/cpan/Crypt/UnixCrypt.pm";  # This is OK on Windows 
     596        $self->param('-name' => "pw", '-value' => &Crypt::UnixCrypt::crypt($self->clean_param("pw"), "Tp")); 
     597    } 
     598    }  
     599} 
     600 
    3066011; 
    307602 
  • gsdl/trunk/cgi-bin/gsdlsite.cfg

    r16389 r16467  
    44 
    55# points to the GSDLHOME directory 
    6 gsdlhome    **GSDLHOME** 
     6gsdlhome    "/research/ak19/gs2PerlUpdates" 
    77 
    88# this is the http address of GSDLHOME 
    99# if your webservers DocumentRoot is set to $GSDLHOME 
    1010# then httpprefix can remain commented out 
    11 #httpprefix  /gsdl 
     11httpprefix  /gs2perl 
    1212 
    1313# this is the http address of the directory which 
     
    1515# if your webservers DocumentRoot is set to $GSDLHOME 
    1616# then httpimg will be /images 
    17 httpimg     /images 
     17httpimg     /gs2perl/images 
    1818 
    1919# should contain the http address of this cgi script. This  
     
    2929maxrequests 10000 
    3030 
    31 # If you wish to use Fedora with Greenstone2's GLI Server, then 
    32 # you need to set the full paths to JAVA_HOME and FEDORA_HOME  
    33 # here as well as the major version of fedora 
    34 #javahome /full/path/to/j2sdk1.4.2_13 
    35 #fedorahome /full/path/to/fedora 
    36 #fedoraversion 3 
     31# JAVA_HOME and FEDORA_HOME need to be set when using Greenstone 2 
     32# with Fedora. 
     33# full path to javahome 
     34javahome /opt/jdk1.5.0_10/ 
     35 
     36# full path to FEDORA_HOME and the major version number of the 
     37# fedora installation 
     38fedorahome /research/ak19/fedora 
     39fedoraversion 2