root/main/trunk/greenstone2/common-src/cgi-bin/gliserver.pl @ 29730

Revision 29730, 47.6 KB (checked in by ak19, 5 years ago)

The second and final part of the commits to getting GLI running again and parsing web.xml, after the changes to commit r29687, where web.xml was split into two and included server.xml. In this commit: 1. GLI uses an EntityResolver? to resolve entities in web.xml that are defined in the included servlets.xml file. In order to keep XMLTools.java tidy and hopefully make the GLI entity resolver more reusable, the new GLIEntityResolver.java class checks default search paths first when asked to resolve entities. web/WEB-INF, where web.xml and servlets.xml live, has been added to the default search paths, as also the gli user dir where the web.xml and server.xml will be in a client-gli situation. 2. Small tidy up to Greenstone runtime's GSEntityResolver. 3. Remote Greenstone gliserver.pl needs to also transfer the new server.xml file when zipping up web.xml. 4. Minor touchups to the new README on apache.jar.

  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
Line 
1#!/usr/bin/perl -w
2# Need to specify the full path of Perl above
3
4# This file merges Michael Dewsnip's gliserver.pl for GS2 and Quan Qiu's gliserver4gs3.pl (GS3)
5
6use strict;
7no strict 'subs';
8no strict 'refs'; # allow filehandles to be variables and viceversa
9
10BEGIN {
11
12    # Line to stop annoying child DOS CMD windows from appearing
13    Win32::SetChildShowWindow(0)
14    if defined &Win32::SetChildShowWindow;
15
16}
17
18
19# Set this to 1 to work around IIS 6 craziness
20my $iis6_mode = 0;
21
22##
23# IIS 6: for some reason, IIS runs this script with the working directory set to the Greenstone
24#   directory rather than the cgi-bin directory, causing lots of stuff to fail
25if ($iis6_mode)
26{
27    # Change into cgi-bin\<OS> directory - need to ensure it exists, since gliserver deals with both GS2 and GS3
28    if(-e "cgi-bin" && -d "cgi-bin") { # GS2
29    chdir("cgi-bin");
30    if(defined $ENV{'GSDLARCH'}) {
31        chdir($ENV{'GSDLOS'}.$ENV{'GSDLARCH'});
32    } else {
33        chdir($ENV{'GSDLOS'});
34    }
35    } else { # iis6_mode is not applicable for Greenstone 3
36    $iis6_mode = 0;
37    }
38}
39
40
41# We use require and an eval here (instead of "use package") to catch any errors loading the module (for IIS)
42eval("require \"gsdlCGI.pm\"");
43if ($@)
44{
45    print STDOUT "Content-type:text/plain\n\n";
46    print STDOUT "ERROR: $@\n";
47    exit 0;
48}
49
50
51#my $authentication_enabled = 0;
52my $debugging_enabled = 0; # if 1, debugging is enabled and unlinking intermediate files (deleting files) will not happen
53
54my $mail_enabled = 0;
55my $mail_to_address = "user\@server";  # Set this appropriately
56my $mail_from_address = "user\@server";  # Set this appropriately
57my $mail_smtp_server = "smtp.server";  # Set this appropriately
58
59sub main
60{   
61    my $gsdl_cgi = new gsdlCGI();
62
63    # Load the Greenstone modules that we need to use
64    $gsdl_cgi->setup_gsdl();
65    my $gsdlhome = $ENV{'GSDLHOME'};
66
67    $gsdl_cgi->checked_chdir($gsdlhome);
68
69    # Encrypt the password
70    $gsdl_cgi->encrypt_password();
71
72    $gsdl_cgi->parse_cgi_args();
73
74    # We don't want the gsdlCGI module to return errors and warnings in XML
75    $gsdl_cgi->{'xml'} = 0;
76
77    # Retrieve the (required) command CGI argument
78    my $cmd = $gsdl_cgi->clean_param("cmd");
79    if (!defined $cmd) {
80    $gsdl_cgi->generate_error("No command specified.");
81    }
82    $gsdl_cgi->delete("cmd");
83
84    # The check-installation, greenstone-server-version and get-library-url commands have no arguments
85    if ($cmd eq "check-installation") {
86    &check_installation($gsdl_cgi);
87    return;
88    }
89    elsif ($cmd eq "greenstone-server-version") {
90    &greenstone_server_version($gsdl_cgi);
91    return;
92    }
93    elsif ($cmd eq "get-library-url-suffix") {
94    &get_library_url_suffix($gsdl_cgi);
95    return;
96    }
97
98    # All other commands require a username, for locking and authentication
99    my $username = $gsdl_cgi->clean_param("un");
100    if ((!defined $username) || ($username =~ m/^\s*$/)) {
101    $gsdl_cgi->generate_error("No username specified.");
102    }
103    $gsdl_cgi->delete("un");
104
105    # Get then remove the ts (timestamp) argument (since this can mess up other scripts)
106    my $timestamp = $gsdl_cgi->clean_param("ts");
107    if ((!defined $timestamp) || ($timestamp =~ m/^\s*$/)) {
108    $timestamp = time();  # Fall back to using the Perl time() function to generate a timestamp
109    }
110    $gsdl_cgi->delete("ts");
111
112    my $site; # undefined on declaration, see http://perldoc.perl.org/perlsyn.html
113    if($gsdl_cgi->greenstone_version() != 2) { # all GS versions after 2 may define site
114    $site = $gsdl_cgi->clean_param("site");   
115    if (!defined $site) {
116        $gsdl_cgi->generate_error("No site specified.");
117    }
118    $gsdl_cgi->delete("site");
119    }
120
121
122    if ($cmd eq "delete-collection") {
123    &delete_collection($gsdl_cgi, $username, $timestamp, $site);
124    }
125    elsif ($cmd eq "download-collection") {
126    &download_collection($gsdl_cgi, $username, $timestamp, $site);
127    }
128    elsif ($cmd eq "download-collection-archives") {
129    &download_collection_archives($gsdl_cgi, $username, $timestamp, $site);
130    }
131    elsif ($cmd eq "download-collection-configurations") {
132    &download_collection_configurations($gsdl_cgi, $username, $timestamp, $site);
133    }
134    elsif ($cmd eq "download-collection-file") {
135    &download_collection_file($gsdl_cgi, $username, $timestamp, $site);
136    }
137    elsif ($cmd eq "delete-collection-file") {
138    &delete_collection_file($gsdl_cgi, $username, $timestamp, $site);
139    }
140    elsif ($cmd eq "get-script-options") {
141    &get_script_options($gsdl_cgi, $username, $timestamp, $site);
142    }
143    elsif ($cmd eq "move-collection-file") {
144    &move_collection_file($gsdl_cgi, $username, $timestamp, $site);
145    }
146    elsif ($cmd eq "new-collection-directory") {
147    &new_collection_directory($gsdl_cgi, $username, $timestamp, $site);
148    }
149    elsif ($cmd eq "run-script") {
150    &run_script($gsdl_cgi, $username, $timestamp, $site);
151    }
152    elsif ($cmd eq "timeout-test") {
153    while (1) { }
154    }
155    elsif ($cmd eq "upload-collection-file") {
156    &upload_collection_file($gsdl_cgi, $username, $timestamp, $site);
157    }
158    elsif ($cmd eq "file-exists") {
159    &file_exists($gsdl_cgi, $site);
160    }
161    # cmds not in Greenstone 2:
162    elsif ($gsdl_cgi->greenstone_version() != 2) { 
163    if ($cmd eq "download-web-xml-file") {
164        &download_web_xml_file($gsdl_cgi, $username, $timestamp, $site);
165    }
166    elsif ($cmd eq "user-validation") {
167        &user_validation($gsdl_cgi, $username, $timestamp, $site);
168    }
169    elsif ($cmd eq "get-site-names") {
170        &get_site_names($gsdl_cgi, $username, $timestamp, $site);
171    }
172    }
173    else {
174    $gsdl_cgi->generate_error("Unrecognised command: '$cmd'");
175    }
176       
177}
178
179
180sub authenticate_user
181{
182    my $gsdl_cgi = shift(@_);
183    my $username = shift(@_);
184    my $collection = shift(@_);
185    my $site = shift(@_);
186
187    # Even if we're not authenticating remove the un and pw arguments, since these can mess up other scripts
188    my $user_password = $gsdl_cgi->clean_param("pw");
189    $gsdl_cgi->delete("pw");
190
191    # Only authenticate if it is enabled
192    # return "all-collections-editor" if (!$authentication_enabled);
193
194    if ((!defined $user_password) || ($user_password =~ m/^\s*$/)) {
195    $gsdl_cgi->generate_error("Authentication failed: no password specified.");
196    }
197
198    if($gsdl_cgi->greenstone_version() == 2) {
199    my $users_db_content;
200    my $etc_directory = &util::filename_cat($ENV{'GSDLHOME'}, "etc");
201    my $users_db_file_path = &util::filename_cat($etc_directory, "users.gdb");
202   
203    # Use db2txt instead of GDBM_File to get the user accounts information
204    $users_db_content = "";
205    open(USERS_DB, "db2txt \"$users_db_file_path\" |");
206    while (<USERS_DB>) {
207        $users_db_content .= $_;
208    }
209    close(USERS_DB);
210   
211    # Get the user account information from the usersDB database
212    my %users_db_data = ();
213
214    # a line dividing one user entry from another is made up of 70 hyphens for GS2 (37 hyphens for GS3)
215    my $horizontal_divider = q/-{70}/;
216    foreach my $users_db_entry (split($horizontal_divider, $users_db_content)) {   
217    if ($users_db_entry =~ m/\n?\[(.+)\]\n/ || $users_db_entry =~ m/\n?USERNAME = ([^\n]*)\n/) { # GS2 and GS3 formats
218        $users_db_data{$1} = $users_db_entry;
219    }
220    }
221
222    # Check username
223    my $user_data = $users_db_data{$username};
224    if (!defined $user_data) {
225    $gsdl_cgi->generate_error("Authentication failed: no account for user '$username'.");
226    }
227
228    # Check password
229    my $pwdLine = q/\<password\>(.*)/;
230    my ($valid_user_password) = ($user_data =~ m/$pwdLine/);
231    if ($user_password ne $valid_user_password) {
232    $gsdl_cgi->generate_error("Authentication failed: incorrect password.");
233    }
234
235    # Check group
236    my $groupLine = q/\<groups\>(.*)/;
237    my ($user_groups) = ($user_data =~ m/$groupLine/);
238
239    if ($collection eq "") {
240    # If we're not editing a collection then the user doesn't need to be in a particular group
241    return $user_groups;  # Authentication successful
242    }
243
244    foreach my $user_group (split(/\,/, $user_groups)) {
245    # Does this user have access to all collections?
246    if ($user_group eq "all-collections-editor") {
247        return $user_groups;  # Authentication successful
248    }
249    # Does this user have access to personal collections, and is this one?
250    if ($user_group eq "personal-collections-editor" && $collection =~ m/^$username\-/) {
251        return $user_groups;  # Authentication successful
252    }
253    # Does this user have access to this collection
254    if ($user_group eq "$collection-collection-editor") {
255        return $user_groups;  # Authentication successful
256    }
257    }
258    $gsdl_cgi->generate_error("Authentication failed: user is not in the required group.");
259    }
260   
261    # "GS3\web\WEB-INF\lib\gsdl3.jar;GS3\web\WEB-INF\lib\derby.jar"
262    # org.greenstone.gsdl3.util.usersDBRealm2txt "GSDL3SRCHOME" username pwd <col> 2>&1
263    elsif($gsdl_cgi->greenstone_version() == 3) {
264        my $gsdl3srchome = $ENV{'GSDL3SRCHOME'};
265
266        my $java = $gsdl_cgi->get_java_path();
267        my $java_gsdl3_classpath = &util::filename_cat($gsdl3srchome, "web", "WEB-INF", "lib", "gsdl3.jar");
268        my $java_derby_classpath = &util::filename_cat($gsdl3srchome, "web", "WEB-INF", "lib", "derby.jar");
269        my $java_classpath;
270        my $gsdlos = $ENV{'GSDLOS'};
271        if ($gsdlos !~ m/windows/){
272            $java_classpath = $java_gsdl3_classpath . ":" . $java_derby_classpath;
273        }else{
274            $java_classpath = $java_gsdl3_classpath . ";" . $java_derby_classpath;
275        }       
276        my $java_args = "\"$gsdl3srchome\" \"$username\" \"$user_password\"";
277        if ($collection ne "") {
278            $java_args += " \"$collection\"";
279        }
280       
281        $gsdl_cgi->checked_chdir($gsdl3srchome);   
282        my $java_command="\"$java\" -classpath \"$java_classpath\" org.greenstone.gsdl3.util.ServletRealmCheck $java_args 2>&1"; # call it ServletRealmCheck
283        my $java_output = `$java_command`;
284        if ($java_output =~ m/^Authentication failed:/) { # $java_output contains the error message
285            $gsdl_cgi->generate_error($java_output); # "\nJAVA_COMMAND: $java_command\n"
286        }
287        else { # success, $java_output is the user_groups list         
288            return $java_output;
289        }
290    }
291}
292
293
294sub lock_collection
295{
296    my $gsdl_cgi = shift(@_);
297    my $username = shift(@_);
298    my $collection = shift(@_);
299    my $site = shift(@_);
300
301    my $steal_lock = $gsdl_cgi->clean_param("steal_lock");
302    $gsdl_cgi->delete("steal_lock");
303
304    my $collection_directory = $gsdl_cgi->get_collection_dir($site, $collection);
305    $gsdl_cgi->checked_chdir($collection_directory);
306
307    # Check if a lock file already exists for this collection
308    my $lock_file_name = "gli.lck";
309    if (-e $lock_file_name) {
310    # A lock file already exists... check if it's ours
311    my $lock_file_content = "";
312    open(LOCK_FILE, "<$lock_file_name");
313    while (<LOCK_FILE>) {
314        $lock_file_content .= $_;
315    }
316    close(LOCK_FILE);
317
318    # Pick out the owner of the lock file
319    $lock_file_content =~ m/\<User\>(.*?)\<\/User\>/;
320    my $lock_file_owner = $1;
321
322    # The lock file is ours, so there is no problem
323    if ($lock_file_owner eq $username) {
324        return;
325    }
326
327    # The lock file is not ours, so throw an error unless "steal_lock" is set
328    unless (defined $steal_lock) {
329        $gsdl_cgi->generate_error("Collection is locked by: $lock_file_owner");
330    }
331    }
332
333    my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime(time);
334    my $current_time = sprintf("%02d/%02d/%d %02d:%02d:%02d", $mday, $mon + 1, $year + 1900, $hour, $min, $sec);
335
336    # Create a lock file for us (in the same format as the GLI) and we're done
337    open(LOCK_FILE, ">$lock_file_name");
338    print LOCK_FILE "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n";
339    print LOCK_FILE "<LockFile>\n";
340    print LOCK_FILE "    <User>" . $username . "</User>\n";
341    print LOCK_FILE "    <Machine>(Remote)</Machine>\n";
342    print LOCK_FILE "    <Date>" . $current_time . "</Date>\n";
343    print LOCK_FILE "</LockFile>\n";
344    close(LOCK_FILE);
345}
346
347
348# ----------------------------------------------------------------------------------------------------
349#   ACTIONS
350# ----------------------------------------------------------------------------------------------------
351# This routine, which uses the variable site, won't get called by GS2,
352sub user_validation{
353    my ($gsdl_cgi, $username, $timestamp, $site) = @_;
354   
355    # Users can be in any group to perform this action
356    my $user_err = &authenticate_user($gsdl_cgi, $username, "", $site);
357     if (defined $user_err && $user_err!~ m/ERROR/){
358     if ($user_err!~ m/ERROR/){
359         #$gsdl_cgi->generate_error("Authentication failed: $username is not valid");
360         $gsdl_cgi->generate_ok($user_err);
361         #print $user_err;
362     }else{
363         $gsdl_cgi->generate_error($user_err);
364         #print "not valid" . $user_err;
365     }
366     }else{
367     $gsdl_cgi->generate_error("Authentication failed: $username is not valid");     
368     }
369}
370
371sub check_installation
372{
373    my ($gsdl_cgi) = @_;
374
375    my $installation_ok = 1;
376    my $installation_status = "";
377
378    # Check that Java is installed and accessible
379    my $java = $gsdl_cgi->get_java_path();
380    my $java_command = "\"$java\" -version 2>&1";
381   
382    # IIS 6: redirecting output from STDERR to STDOUT just doesn't work, so we have to let it go
383    #   directly out to the page
384    if($iis6_mode && $gsdl_cgi->greenstone_version() == 2) { ##
385    print STDOUT "Content-type:text/plain\n\n";
386    $java_command = "\"$java\" -version";
387    }
388
389    my $java_output = `$java_command`;
390       
391    my $java_status = $?;
392    if ($java_status < 0) {
393    # The Java command failed
394    $installation_status = "Java failed -- do you have the Java run-time installed?\n" . $gsdl_cgi->check_java_home() . "\n";
395    $installation_ok = 0;
396    }
397    else {
398    $installation_status = "Java found: $java_output";
399    }
400
401    # Show the values of some important environment variables
402    $installation_status .= "\n";
403    if($gsdl_cgi->greenstone_version() != 2) {
404    $installation_status .= "GSDL3SRCHOME: " . $ENV{'GSDL3SRCHOME'} . "\n";
405    $installation_status .= "GSDL3HOME: " . $ENV{'GSDL3HOME'} . "\n";
406    }
407    $installation_status .= "GSDLHOME: " . $ENV{'GSDLHOME'} . "\n";
408    $installation_status .= "GSDLOS: " . $ENV{'GSDLOS'} . "\n";
409    $installation_status .= "JAVA_HOME: " . $ENV{'JAVA_HOME'} . "\n" if defined($ENV{'JAVA_HOME'}); # on GS2, Java's only on the PATH
410    $installation_status .= "PATH: " . $ENV{'PATH'} . "\n";
411    if(defined $ENV{'FEDORA_VERSION'}) { # not using FLI unless version set
412    $installation_status .= "FEDORA_HOME: ".$ENV{'FEDORA_HOME'} . "\n";
413    $installation_status .= "FEDORA_VERSION: ".$ENV{'FEDORA_VERSION'};
414    }
415   
416    if ($installation_ok) { ## M. Dewsnip's svn log comment stated that for iis6_mode output needs to go to STDOUT
417    if($iis6_mode && $gsdl_cgi->greenstone_version() == 2) {
418        print STDOUT $installation_status . "\nInstallation OK!";
419    } else {
420        $gsdl_cgi->generate_ok_message($installation_status . "\nInstallation OK!");
421    }
422    }
423    else {
424    if($iis6_mode && $gsdl_cgi->greenstone_version() == 2) {
425        print STDOUT $installation_status;
426    } else {
427        $gsdl_cgi->generate_error($installation_status);
428    }
429    }
430}
431
432
433sub delete_collection
434{
435    my ($gsdl_cgi, $username, $timestamp, $site) = @_;
436
437    my $collection = $gsdl_cgi->clean_param("c");
438    if ((!defined $collection) || ($collection =~ m/^\s*$/)) {
439    $gsdl_cgi->generate_error("No collection specified.");
440    }
441    $collection =~ s/\|/&util::get_dirsep()/eg;  # Convert the '|' characters into whatever is right for this OS
442
443    # Ensure the user is allowed to edit this collection
444    &authenticate_user($gsdl_cgi, $username, $collection, $site);
445
446
447    my $collect_directory = $gsdl_cgi->get_collection_dir($site);
448    $gsdl_cgi->checked_chdir($collect_directory);
449
450    # Check that the collection exists
451    if (!-d $collection) {
452    $gsdl_cgi->generate_error("Collection $collection does not exist.");
453    }
454
455    # Make sure the collection isn't locked by someone else
456    &lock_collection($gsdl_cgi, $username, $collection, $site);
457
458    $gsdl_cgi->checked_chdir($collect_directory);
459    $gsdl_cgi->local_rm_r("$collection");
460
461    # Check that the collection was deleted
462    if (-e $collection) {
463    $gsdl_cgi->generate_error("Could not delete collection $collection.");
464    }
465
466    $gsdl_cgi->generate_ok_message("Collection $collection deleted successfully.");
467}
468
469
470sub delete_collection_file
471{
472    my ($gsdl_cgi, $username, $timestamp, $site) = @_;
473
474    my $collection = $gsdl_cgi->clean_param("c");
475    if ((!defined $collection) || ($collection =~ m/^\s*$/)) {
476    $gsdl_cgi->generate_error("No collection specified.");
477    }
478    $collection =~ s/\|/&util::get_dirsep()/eg;  # Convert the '|' characters into whatever is right for this OS
479
480    my $file = $gsdl_cgi->clean_param("file");
481    if ((!defined $file) || ($file =~ m/^\s*$/)) {
482    $gsdl_cgi->generate_error("No file specified.");
483    }
484    $file = $gsdl_cgi->decode($file);
485    $file =~ s/\|/&util::get_dirsep()/eg;  # Convert the '|' characters into whatever is right for this OS
486
487    # Make sure we don't try to delete anything outside the collection
488    if ($file =~ m/\.\./) {
489    $gsdl_cgi->generate_error("Illegal file specified.");
490    }
491
492    # Ensure the user is allowed to edit this collection
493    &authenticate_user($gsdl_cgi, $username, $collection, $site);
494
495    my $collection_directory = $gsdl_cgi->get_collection_dir($site, $collection);
496    if (!-d $collection_directory){ ## wasn't there in gs2, ok_msg or error_msg?
497    $gsdl_cgi->generate_ok_message("Directory $collection_directory does not exist.");
498    die;
499    }
500
501    $gsdl_cgi->checked_chdir($collection_directory);
502
503    # Make sure the collection isn't locked by someone else
504    &lock_collection($gsdl_cgi, $username, $collection, $site);
505
506    # Check that the collection file exists
507    if (!-e $file) { ## original didn't have 'die', but it was an ok message
508    $gsdl_cgi->generate_ok_message("Collection file $file does not exist.");
509    die;
510    }
511    $gsdl_cgi->local_rm_r("$file");
512
513    # Check that the collection file was deleted
514    if (-e $file) {
515    $gsdl_cgi->generate_error("Could not delete collection file $file.");
516    }
517
518    $gsdl_cgi->generate_ok_message("Collection file $file deleted successfully.");
519}
520
521
522sub download_collection
523{
524    my ($gsdl_cgi, $username, $timestamp, $site) = @_;
525
526    my $collection = $gsdl_cgi->clean_param("c");
527    if ((!defined $collection) || ($collection =~ m/^\s*$/)) {
528    $gsdl_cgi->generate_error("No collection specified.");
529    }
530    $collection =~ s/\|/&util::get_dirsep()/eg;  # Convert the '|' characters into whatever is right for this OS
531   
532    # language and region Environment Variable setting on the client side that was used to zip files.
533    my $lang_env = $gsdl_cgi->clean_param("lr") || "";
534    $gsdl_cgi->delete("lr");
535
536    # Ensure the user is allowed to edit this collection
537    &authenticate_user($gsdl_cgi, $username, $collection, $site);
538
539    my $collect_directory = $gsdl_cgi->get_collection_dir($site);
540    $gsdl_cgi->checked_chdir($collect_directory);
541
542    # Check that the collection exists
543    if (!-d $collection) {
544    $gsdl_cgi->generate_ok_message("Collection $collection does not exist."); ## original had an error msg (from where it would die)
545    die;
546    }
547
548    # Make sure the collection isn't locked by someone else
549    &lock_collection($gsdl_cgi, $username, $collection, $site);
550
551    # Zip up the collection
552    my $java = $gsdl_cgi->get_java_path();
553    my $java_classpath = &util::filename_cat($ENV{'GSDLHOME'}, "bin", "java", "GLIServer.jar");
554    my $zip_file_path = &util::filename_cat($collect_directory, $collection . "-" . $timestamp . ".zip");
555    my $java_args = "\"$zip_file_path\" \"$collect_directory\" \"$collection\"";
556    if($gsdl_cgi->greenstone_version() != 2) {
557    $java_args .= " gsdl3"; ## must this be done elsewhere as well?
558    }
559
560    $ENV{'LANG'} = $lang_env;
561    my $java_command = "\"$java\" -classpath \"$java_classpath\" org.greenstone.gatherer.remote.ZipCollectionShell $java_args";
562
563    my $java_output = `$java_command`;
564    my $java_status = $?;
565    if ($java_status > 0) {
566    $gsdl_cgi->generate_error("Java failed: $java_command\n--\n$java_output\nExit status: " . ($java_status / 256) . "\n" . $gsdl_cgi->check_java_home());
567    }
568
569    # Check that the zip file was created successfully
570    if (!-e $zip_file_path || -z $zip_file_path) {
571    $gsdl_cgi->generate_error("Collection zip file $zip_file_path could not be created.");
572    }
573
574    &put_file($gsdl_cgi, $zip_file_path, "application/zip"); # file is transferred to client
575    unlink("$zip_file_path") unless $debugging_enabled;      # deletes the local intermediate zip file
576}
577
578
579sub download_collection_archives
580{
581    my ($gsdl_cgi, $username, $timestamp, $site) = @_;
582
583    my $collection = $gsdl_cgi->clean_param("c");
584    if ((!defined $collection) || ($collection =~ m/^\s*$/)) {
585    $gsdl_cgi->generate_error("No collection specified.");
586    }
587    $collection =~ s/\|/&util::get_dirsep()/eg;  # Convert the '|' characters into whatever is right for this OS
588
589    # language and region Environment Variable setting on the client side that was used to zip files.
590    my $lang_env = $gsdl_cgi->clean_param("lr") || "";
591    $gsdl_cgi->delete("lr");
592   
593    # Ensure the user is allowed to edit this collection
594    &authenticate_user($gsdl_cgi, $username, $collection, $site);
595
596    my $collect_directory = $gsdl_cgi->get_collection_dir($site);
597    $gsdl_cgi->checked_chdir($collect_directory);
598
599    # Check that the collection archives exist
600    if (!-d &util::filename_cat($collection, "archives")) {
601    $gsdl_cgi->generate_error("Collection archives do not exist.");
602    }
603
604    # Make sure the collection isn't locked by someone else
605    &lock_collection($gsdl_cgi, $username, $collection, $site);
606
607    # Zip up the collection archives
608    my $java = $gsdl_cgi->get_java_path();
609    my $java_classpath = &util::filename_cat($ENV{'GSDLHOME'}, "bin", "java", "GLIServer.jar");
610    my $zip_file_path = &util::filename_cat($collect_directory, $collection . "-archives-" . $timestamp . ".zip");
611    my $java_args = "\"$zip_file_path\" \"$collect_directory\" \"$collection\"";
612    $ENV{'LANG'} = $lang_env;
613    my $java_command = "\"$java\" -classpath \"$java_classpath\" org.greenstone.gatherer.remote.ZipCollectionArchives $java_args";
614
615    my $java_output = `$java_command`;
616    my $java_status = $?;
617    if ($java_status > 0) {
618    $gsdl_cgi->generate_error("Java failed: $java_command\n--\n$java_output\nExit status: " . ($java_status / 256) . "\n" . $gsdl_cgi->check_java_home());
619    }
620
621    # Check that the zip file was created successfully
622    if (!-e $zip_file_path || -z $zip_file_path) {
623    $gsdl_cgi->generate_error("Collection archives zip file $zip_file_path could not be created.");
624    }
625
626    &put_file($gsdl_cgi, $zip_file_path, "application/zip");
627    unlink("$zip_file_path") unless $debugging_enabled;
628}
629
630
631# Collection locking unnecessary because this action isn't related to a particular collection
632sub download_collection_configurations
633{
634    my ($gsdl_cgi, $username, $timestamp, $site) = @_;
635
636    # language and region Environment Variable setting on the client side that was used to zip files.
637    my $lang_env = $gsdl_cgi->clean_param("lr") || "";
638    $gsdl_cgi->delete("lr");
639   
640    # Users can be in any group to perform this action
641    my $user_groups = &authenticate_user($gsdl_cgi, $username, "", $site);
642
643    my $collect_directory = $gsdl_cgi->get_collection_dir($site);
644    $gsdl_cgi->checked_chdir($collect_directory);
645
646    # Zip up the collection configurations
647    my $java = $gsdl_cgi->get_java_path();
648    my $java_classpath = &util::filename_cat($ENV{'GSDLHOME'}, "bin", "java", "GLIServer.jar");
649    my $zip_file_path = &util::filename_cat($collect_directory, "collection-configurations-" . $timestamp . ".zip");
650    my $java_args = "\"$zip_file_path\" \"$collect_directory\" \"$username\" \"$user_groups\"";
651    $ENV{'LANG'} = $lang_env;
652    my $java_command = "\"$java\" -classpath \"$java_classpath\" org.greenstone.gatherer.remote.ZipCollectionConfigurations $java_args";
653    my $java_output = `$java_command`;
654    my $java_status = $?;
655    if ($java_status > 0) {
656    $gsdl_cgi->generate_error("Java failed: $java_command\n--\n$java_output\nExit status: " . ($java_status / 256) . "\n" . $gsdl_cgi->check_java_home());
657    }
658
659    # Check that the zip file was created successfully
660    if (!-e $zip_file_path || -z $zip_file_path) {
661    $gsdl_cgi->generate_error("Collection configurations zip file $zip_file_path could not be created.");
662    }
663   
664    &put_file($gsdl_cgi, $zip_file_path, "application/zip");
665    unlink("$zip_file_path") unless $debugging_enabled;
666}
667
668# Method that will check if the given file exists
669# No error message: all messages generated are OK messages
670# This method will simply state whether the file exists or does not exist.
671sub file_exists
672{
673    my ($gsdl_cgi, $site) = @_;
674
675    my $collection = $gsdl_cgi->clean_param("c");
676    if ((!defined $collection) || ($collection =~ m/^\s*$/)) {
677    $gsdl_cgi->generate_error("No collection specified.");
678    }
679    $collection =~ s/\|/&util::get_dirsep()/eg;  # Convert the '|' characters into whatever is right for this OS
680
681    my $file = $gsdl_cgi->clean_param("file");
682    if ((!defined $file) || ($file =~ m/^\s*$/)) {
683    $gsdl_cgi->generate_error("No file specified.");
684    }
685    $file = "\"$file\"";   # Windows: bookend the relative filepath with quotes in case it contains spaces
686    $file = $gsdl_cgi->decode($file);
687    $file =~ s/\|/&util::get_dirsep()/eg;  # Convert the '|' characters into whatever is right for this OS
688
689    # Not necessary: checking whether the user is authenticated to query existence of the file
690    #&authenticate_user($gsdl_cgi, $username, $collection);
691
692    my $collection_directory = $gsdl_cgi->get_collection_dir($site, $collection);
693    $gsdl_cgi->checked_chdir($collection_directory); # cd into the directory of that collection
694
695    # Check that the collection file exists
696    if (-e $file) {
697    $gsdl_cgi->generate_ok_message("File $file exists.");
698    } else {
699    $gsdl_cgi->generate_ok_message("File $file does not exist.");
700    }
701}
702
703sub download_collection_file
704{
705    my ($gsdl_cgi, $username, $timestamp, $site) = @_;
706
707    my $collection = $gsdl_cgi->clean_param("c");
708    if ((!defined $collection) || ($collection =~ m/^\s*$/)) {
709    $gsdl_cgi->generate_error("No collection specified.");
710    }
711    my $collection_tail_name = $collection;
712    $collection_tail_name =~ s/^(.*\|)//;
713    $collection =~ s/\|/&util::get_dirsep()/eg;  # Convert the '|' characters into whatever is right for this OS
714
715    # language and region Environment Variable setting on the client side that was used to zip files.
716    my $lang_env = $gsdl_cgi->clean_param("lr") || "";
717    $gsdl_cgi->delete("lr");
718    my $file = $gsdl_cgi->clean_param("file");
719    if ((!defined $file) || ($file =~ m/^\s*$/)) {
720    $gsdl_cgi->generate_error("No file specified.");
721    }
722    $file =~ s/\|/&util::get_dirsep()/eg;  # Convert the '|' characters into whatever is right for this OS
723
724    # Make sure we don't try to download anything outside the collection
725    if ($file =~ m/\.\./) {
726    $gsdl_cgi->generate_error("Illegal file specified.");
727    }
728
729    # Ensure the user is allowed to edit this collection
730    &authenticate_user($gsdl_cgi, $username, $collection, $site);
731
732    my $collection_directory = $gsdl_cgi->get_collection_dir($site, $collection);
733    $gsdl_cgi->checked_chdir($collection_directory);
734
735    # Check that the collection file exists
736    if (!-e $file) {
737    $gsdl_cgi->generate_ok_message("Collection file $file does not exist.");
738    die;
739    }
740
741    # Make sure the collection isn't locked by someone else
742    &lock_collection($gsdl_cgi, $username, $collection, $site);
743
744    # Zip up the collection file
745    my $java = $gsdl_cgi->get_java_path();
746    my $java_classpath = &util::filename_cat($ENV{'GSDLHOME'}, "bin", "java", "GLIServer.jar");
747    my $zip_file_path = &util::filename_cat($collection_directory, $collection_tail_name . "-file-" . $timestamp . ".zip");
748    my $java_args = "\"$zip_file_path\" \"$collection_directory\" \"$file\" servlets.xml";
749    $ENV{'LANG'} = $lang_env;
750    my $java_command = "\"$java\" -classpath \"$java_classpath\" org.greenstone.gatherer.remote.ZipFiles $java_args";
751
752    my $java_output = `$java_command`;
753    my $java_status = $?;
754    if ($java_status > 0) {
755    $gsdl_cgi->generate_error("Java failed: $java_command\n--\n$java_output\nExit status: " . ($java_status / 256) . "\n" . $gsdl_cgi->check_java_home());
756    }
757
758    # Check that the zip file was created successfully
759    if (!-e $zip_file_path || -z $zip_file_path) {
760    $gsdl_cgi->generate_error("Collection archives zip file $zip_file_path could not be created.");
761    }
762
763    &put_file($gsdl_cgi, $zip_file_path, "application/zip");
764    unlink("$zip_file_path") unless $debugging_enabled;
765}
766
767# download web.xml from the server
768sub download_web_xml_file
769{
770    my ($gsdl_cgi, $username, $timestamp, $site) = @_;
771
772    # Users can be in any group to perform this action
773    my $user_groups = &authenticate_user($gsdl_cgi, $username, "", $site);
774
775    # language and region Environment Variable setting on the client side that was used to zip files.
776    my $lang_env = $gsdl_cgi->clean_param("lr") || "";
777    $gsdl_cgi->delete("lr");
778    my $file = $gsdl_cgi->clean_param("file");
779    if ((!defined $file) || ($file =~ m/^\s*$/)) {
780    $gsdl_cgi->generate_error("No file specified.");
781    }
782    $file =~ s/\|/&util::get_dirsep()/eg;  # Convert the '|' characters into whatever is right for this OS
783
784    # Make sure we don't try to download anything else
785    if ($file =~ m/\.\./) {
786    $gsdl_cgi->generate_error("Illegal file specified.");
787    }
788
789    my $web_inf_directory = &util::filename_cat($ENV{'GSDL3HOME'}, "WEB-INF");
790    $gsdl_cgi->checked_chdir($web_inf_directory);
791
792    # Check that the collection file exists
793    if (!-e $file) {
794    $gsdl_cgi->generate_error("file $file does not exist.");
795    }
796
797    # Zip up the collection file
798    my $java = $gsdl_cgi->get_java_path();
799    my $java_classpath = &util::filename_cat($ENV{'GSDLHOME'}, "bin", "java", "GLIServer.jar");
800    my $zip_file_path = &util::filename_cat($web_inf_directory, "webxml" . $timestamp . ".zip");
801    my $java_args = "\"$zip_file_path\" \"$web_inf_directory\" \"$file\" servlets.xml";
802    $ENV{'LANG'} = $lang_env;
803    my $java_command = "\"$java\" -classpath \"$java_classpath\" org.greenstone.gatherer.remote.ZipFiles $java_args";
804    my $java_output = `$java_command`;
805
806    my $java_status = $?;
807    if ($java_status > 0) {
808    $gsdl_cgi->generate_error("Java failed: $java_command\n--\n$java_output\nExit status: " . ($java_status / 256) . "\n" . $gsdl_cgi->check_java_home());
809    }
810
811    # Check that the zip file was created successfully
812    if (!-e $zip_file_path || -z $zip_file_path) {
813    $gsdl_cgi->generate_error("web.xml zip file $zip_file_path could not be created.");
814    }
815
816    &put_file($gsdl_cgi, $zip_file_path, "application/zip");
817
818    unlink("$zip_file_path") unless $debugging_enabled;
819}
820
821# Collection locking unnecessary because this action isn't related to a particular collection
822sub get_script_options
823{
824    my ($gsdl_cgi, $username, $timestamp, $site) = @_;
825
826    my $script = $gsdl_cgi->clean_param("script");
827    if ((!defined $script) || ($script =~ m/^\s*$/)) {
828    $gsdl_cgi->generate_error("No script specified.");
829    }
830    $gsdl_cgi->delete("script");
831
832    # Users can be in any group to perform this action
833    &authenticate_user($gsdl_cgi, $username, "", $site);
834    $gsdl_cgi->delete("ts"); ## two lines from GS3 version, doesn't seem to harm GS2
835    $gsdl_cgi->delete("pw");
836   
837
838    my $perl_args = "";
839    if ($script eq "classinfo.pl") {
840    $perl_args = $gsdl_cgi->clean_param("classifier") || "";
841    $gsdl_cgi->delete("classifier");
842    }
843    if ($script eq "pluginfo.pl") {
844    $perl_args = $gsdl_cgi->clean_param("plugin") || "";
845    $perl_args = "-gs_version ".$gsdl_cgi->greenstone_version()." ".$perl_args;
846    $gsdl_cgi->delete("plugin");
847    }
848    if ($script eq "downloadinfo.pl") {
849    $perl_args = $gsdl_cgi->clean_param("downloader") || "";
850    $gsdl_cgi->delete("downloader");
851    }
852
853    foreach my $cgi_arg_name ($gsdl_cgi->param) {
854    my $cgi_arg_value = $gsdl_cgi->clean_param($cgi_arg_name) || "";
855   
856    # When get_script_options is to launch classinfo.pl or pluginfo.pl, one of the args to be passed to the script
857    # is the collection name. This may be a (collectgroup/)coltailname coming in here as (collectgroup|)coltailname.
858    # Since calling safe_val() below on the collection name value will get rid of \ and |, but preserves /, need to
859    # first replace the | with /, then run safe_val, then convert the / to the OS dependent File separator.
860    $cgi_arg_value =~ s@\|@\/@g if ($cgi_arg_name =~ m/^collection/);
861    $cgi_arg_value = $gsdl_cgi->safe_val($cgi_arg_value);
862    $cgi_arg_value =~ s@\/@&util::get_dirsep()@eg if($cgi_arg_name =~ m/^collection/);
863    if ($cgi_arg_value eq "") {
864        $perl_args = "-$cgi_arg_name " . $perl_args;
865    }
866    else {
867        $perl_args = "-$cgi_arg_name \"$cgi_arg_value\" " . $perl_args;
868    }
869    }
870
871
872    # IIS 6: redirecting output from STDERR to STDOUT just doesn't work, so we have to let it go
873    #   directly out to the page
874    print STDOUT "Content-type:text/plain\n\n";
875    my $perl_command;
876    if($iis6_mode && $gsdl_cgi->greenstone_version() == 2)
877    {
878    $perl_command = "perl -S $script $perl_args";
879    } else {
880    $perl_command = "perl -S $script $perl_args 2>&1";
881    }
882
883    my $perl_output = `$perl_command`;
884    my $perl_status = $?;
885    if ($perl_status > 0) {
886    $gsdl_cgi->generate_error("Perl failed: $perl_command\n--\n$perl_output\nExit status: " . ($perl_status / 256));
887    }
888
889    if (defined($perl_output))
890    {
891    print STDOUT $perl_output;
892    }
893}
894
895# get the names of all sites available on the server
896sub get_site_names
897{
898    my ($gsdl_cgi, $username, $timestamp, $site) = @_;
899    my $sites_directory = &util::filename_cat($ENV{'GSDL3SRCHOME'}, "web", "sites");
900
901    my @sites_dir;
902    my @site_dir;
903   
904    $gsdl_cgi->checked_chdir($sites_directory);
905    opendir(DIR, $sites_directory);
906    @sites_dir= readdir(DIR);
907    my $sites_dir;
908    my $sub_dir_file;
909
910    print STDOUT "Content-type:text/plain\n\n";
911    foreach $sites_dir(@sites_dir)
912    {
913    if (!(($sites_dir eq ".") || ($sites_dir eq "..") || ($sites_dir eq "CVS") || ($sites_dir eq ".DS_Store") || ($sites_dir eq "ADDING-A-SITE.txt")))
914    {
915        my $site_dir_path= &util::filename_cat($sites_directory,$sites_dir);
916        $gsdl_cgi->checked_chdir($site_dir_path);
917        opendir(DIR,$site_dir_path);
918        @site_dir=readdir(DIR);
919        closedir(DIR);
920       
921        foreach $sub_dir_file(@site_dir)
922        {
923        if ($sub_dir_file eq "siteConfig.xml"){
924            print STDOUT "$sites_dir" . "-----";
925        }
926        }
927    }
928    }
929
930}
931
932sub move_collection_file
933{
934    my ($gsdl_cgi, $username, $timestamp, $site) = @_;
935
936    my $collection = $gsdl_cgi->clean_param("c");
937    if ((!defined $collection) || ($collection =~ m/^\s*$/)) {
938    $gsdl_cgi->generate_error("No collection specified.");
939    }
940    $collection =~ s/\|/&util::get_dirsep()/eg;  # Convert the '|' characters into whatever is right for this OS
941
942    my $source_file = $gsdl_cgi->clean_param("source");
943    if ((!defined $source_file) || ($source_file =~ m/^\s*$/)) {
944    $gsdl_cgi->generate_error("No source file specified.");
945    }
946    $source_file = $gsdl_cgi->decode($source_file);
947    $source_file =~ s/\|/&util::get_dirsep()/eg;  # Convert the '|' characters into whatever is right for this OS
948    my $target_file = $gsdl_cgi->clean_param("target");
949    if ((!defined $target_file) || ($target_file =~ m/^\s*$/)) {
950    $gsdl_cgi->generate_error("No target file specified.");
951    }
952    $target_file = $gsdl_cgi->decode($target_file);
953    $target_file =~ s/\|/&util::get_dirsep()/eg;  # Convert the '|' characters into whatever is right for this OS
954
955    # Make sure we don't try to move anything outside the collection
956    if ($source_file =~ m/\.\./ || $target_file =~ m/\.\./) {
957    $gsdl_cgi->generate_error("Illegal file specified.");
958    }
959
960    # Ensure the user is allowed to edit this collection
961    &authenticate_user($gsdl_cgi, $username, $collection, $site);
962
963    my $collection_directory = $gsdl_cgi->get_collection_dir($site, $collection);
964    $gsdl_cgi->checked_chdir($collection_directory);
965
966    # Check that the collection source file exists
967    if (!-e $source_file) {
968    $gsdl_cgi->generate_error("Collection file $source_file does not exist.");
969    }
970
971    # Make sure the collection isn't locked by someone else
972    &lock_collection($gsdl_cgi, $username, $collection, $site);
973
974    &util::mv($source_file, $target_file);
975
976    # Check that the collection source file was moved
977    if (-e $source_file || !-e $target_file) {
978    $gsdl_cgi->generate_error("Could not move collection file $source_file to $target_file."); # dies
979    }
980
981    $gsdl_cgi->generate_ok_message("Collection file $source_file moved to $target_file successfully.");
982}
983
984
985sub new_collection_directory
986{
987    my ($gsdl_cgi, $username, $timestamp, $site) = @_;
988
989    my $collection = $gsdl_cgi->clean_param("c");
990    if ((!defined $collection) || ($collection =~ m/^\s*$/)) {
991    $gsdl_cgi->generate_error("No collection specified.");
992    }
993    $collection =~ s/\|/&util::get_dirsep()/eg;  # Convert the '|' characters into whatever is right for this OS
994
995    my $directory = $gsdl_cgi->clean_param("directory");
996    if ((!defined $directory) || ($directory =~ m/^\s*$/)) {
997    $gsdl_cgi->generate_error("No directory specified.");
998    }
999    $directory =~ s/\|/&util::get_dirsep()/eg;  # Convert the '|' characters into whatever is right for this OS
1000
1001    # Make sure we don't try to create anything outside the collection
1002    if ($directory =~ m/\.\./) {
1003    $gsdl_cgi->generate_error("Illegal directory specified.");
1004    }
1005
1006    # Ensure the user is allowed to edit this collection
1007    &authenticate_user($gsdl_cgi, $username, $collection, $site);
1008
1009    my $collection_directory = $gsdl_cgi->get_collection_dir($site, $collection);
1010    $gsdl_cgi->checked_chdir($collection_directory);
1011
1012    # Check that the collection directory doesn't already exist
1013    # ZipTools doesn't zip up empty directories, so this causes an error when downloading a new collection as we explicitly
1014    # try to create the import directory
1015## log -r13497 for GS2's gliserver.pl, Katherine Don explains:
1016# "commented out checking for existence of a directory in new_collection_directory
1017# as it throws an error which we don't want"
1018    #if($gsdl_cgi->greenstone_version() != 2 && -d $directory) {
1019    #$gsdl_cgi->generate_error("Collection directory $directory already exists.");
1020    #}
1021
1022    # Make sure the collection isn't locked by someone else
1023    &lock_collection($gsdl_cgi, $username, $collection, $site);
1024
1025    &util::mk_dir($directory);
1026
1027    # Check that the collection directory was created
1028    if (!-d $directory) {
1029    $gsdl_cgi->generate_error("Could not create collection directory $directory.");
1030    }
1031
1032    $gsdl_cgi->generate_ok_message("Collection directory $directory created successfully.");
1033}
1034
1035
1036sub run_script
1037{
1038    my ($gsdl_cgi, $username, $timestamp, $site) = @_;
1039
1040    my $script = $gsdl_cgi->clean_param("script");
1041    if ((!defined $script) || ($script =~ m/^\s*$/)) {
1042    $gsdl_cgi->generate_error("No script specified.");
1043    }
1044    $gsdl_cgi->delete("script");
1045 
1046    my $collection = $gsdl_cgi->clean_param("c");
1047    if ((!defined $collection) || ($collection =~ m/^\s*$/)) {
1048    $gsdl_cgi->generate_error("No collection specified.");
1049    }
1050    $collection =~ s/\|/&util::get_dirsep()/eg;  # Convert the '|' characters into whatever is right for this OS
1051    $gsdl_cgi->delete("c");
1052
1053    # confuse other, so delete timestamp
1054    $gsdl_cgi->delete("ts");
1055
1056    # Ensure the user is allowed to edit this collection
1057    &authenticate_user($gsdl_cgi, $username, $collection, $site);
1058
1059    # Make sure the collection isn't locked by someone else (unless we're running mkcol.pl, of course)
1060    &lock_collection($gsdl_cgi, $username, $collection, $site) unless ($script eq "mkcol.pl");
1061
1062    # Last argument is the collection name, except for explode_metadata_database.pl and
1063    # replace_srcdoc_with_html (where there's a "file" option followed by the filename. These two preceed the collection name)
1064    my $perl_args = $collection;
1065    if ($script eq "explode_metadata_database.pl" || $script eq "replace_srcdoc_with_html.pl") {
1066    # Last argument is the file to be exploded or it is the file to be replaced with its html version
1067    my $file = $gsdl_cgi->clean_param("file");
1068    if ((!defined $file) || ($file =~ m/^\s*$/)) {
1069        $gsdl_cgi->generate_error("No file specified.");
1070    }
1071    $gsdl_cgi->delete("file"); 
1072    $file = $gsdl_cgi->decode($file);
1073    $file = "\"$file\""; # Windows: bookend the relative filepath with quotes in case it contains spaces
1074    $file =~ s/\|/&util::get_dirsep()/eg;  # Convert the '|' characters into whatever is right for this OS
1075    $perl_args = $file;
1076    }
1077
1078    foreach my $cgi_arg_name ($gsdl_cgi->param) {
1079    my $cgi_arg_value = $gsdl_cgi->safe_val($gsdl_cgi->clean_param($cgi_arg_name));
1080    if ($cgi_arg_value eq "") {
1081        $perl_args = "-$cgi_arg_name " . $perl_args;
1082    }
1083    else {
1084        $perl_args = "-$cgi_arg_name \"$cgi_arg_value\" " . $perl_args;
1085    }
1086    }
1087
1088    # mkcol.pl and import.pl, buildcol.pl, g2f-import.pl, g2f-buildcol.pl all need the -collectdir option passed
1089    my $import_pl = "import.pl"; # import is a reserved word, need to put it in quotes
1090   
1091    if (($script =~ m/$import_pl|buildcol.pl/) || ($script eq "mkcol.pl") || ($script eq "activate.pl")) { # || ($script eq "schedule.pl")
1092    my $collect_directory = $gsdl_cgi->get_collection_dir($site);   
1093    $perl_args = "-collectdir \"$collect_directory\" " . $perl_args;
1094
1095    if($gsdl_cgi->greenstone_version() == 3) {
1096        $perl_args = "-site $site $perl_args";
1097    }
1098    }
1099
1100    my $perl_command = "perl -S $script $perl_args 2>&1";
1101    # IIS 6: redirecting output from STDERR to STDOUT just doesn't work, so we have to let it go
1102    #   directly out to the page
1103    if($gsdl_cgi->greenstone_version() == 2 && $iis6_mode)
1104    {
1105    $perl_command = "perl -S $script $perl_args";
1106    }
1107    if (!open(PIN, "$perl_command |")) {
1108    $gsdl_cgi->generate_error("Unable to execute command: $perl_command");
1109    }
1110
1111    print STDOUT "Content-type:text/plain\n\n";
1112    print "$perl_command  \n";
1113
1114    while (defined (my $perl_output_line = <PIN>)) {
1115    print STDOUT $perl_output_line;
1116    }
1117    close(PIN);
1118
1119    my $perl_status = $?;
1120    if ($perl_status > 0) {
1121    $gsdl_cgi->generate_error("Perl failed: $perl_command\n--\nExit status: " . ($perl_status / 256));
1122    }
1123    elsif ($mail_enabled) {
1124    if ($script eq "buildcol.pl") {
1125        &send_mail($gsdl_cgi, "Remote Greenstone building event", "Build of collection '$collection' complete.");
1126    }
1127    }
1128}
1129
1130sub upload_collection_file
1131{
1132    my ($gsdl_cgi, $username, $timestamp, $site) = @_;
1133   
1134    my $collection = $gsdl_cgi->clean_param("c");
1135    if ((!defined $collection) || ($collection =~ m/^\s*$/)) {
1136    $gsdl_cgi->generate_error("No collection specified.");
1137    }
1138    $collection =~ s/\|/&util::get_dirsep()/eg;  # Convert the '|' characters into whatever is right for this OS
1139
1140    my $file = $gsdl_cgi->clean_param("file");
1141    if ((!defined $file) || ($file =~ m/^\s*$/)) {
1142    $gsdl_cgi->generate_error("No file specified.");
1143    }
1144    my $directory = $gsdl_cgi->clean_param("directory") || "";
1145    $directory =~ s/\|/&util::get_dirsep()/eg;  # Convert the '|' characters into whatever is right for this OS
1146    my $zip = $gsdl_cgi->clean_param("zip");
1147
1148    # language and region Environment Variable setting on the client side that was used to
1149    # zip files. This needs to be consistent on both client and server sides, otherwise zip
1150    # and unzip seem to produce different values.
1151    my $lang_env = $gsdl_cgi->clean_param("lr") || "";
1152    $gsdl_cgi->delete("lr");
1153
1154    # Make sure we don't try to upload anything outside the collection
1155    if ($file =~ m/\.\./) {
1156    $gsdl_cgi->generate_error("Illegal file specified.");
1157    }
1158    if ($directory =~ m/\.\./) {
1159    $gsdl_cgi->generate_error("Illegal directory specified.");
1160    }
1161
1162    # Ensure the user is allowed to edit this collection
1163    if($gsdl_cgi->greenstone_version() == 2) { ## Quan commented this out for GS3 in r14325
1164    &authenticate_user($gsdl_cgi, $username, $collection, $site); # site will be undefined for GS2, of course
1165    }
1166
1167    my $collection_directory = $gsdl_cgi->get_collection_dir($site, $collection);
1168    $gsdl_cgi->checked_chdir($collection_directory);
1169
1170    # Make sure the collection isn't locked by someone else
1171    &lock_collection($gsdl_cgi, $username, $collection, $site);
1172
1173    my $directory_path = &util::filename_cat($collection_directory, $directory);
1174    if (!-d $directory_path) {
1175    &util::mk_dir($directory_path);
1176    if (!-d $directory_path) {
1177        $gsdl_cgi->generate_error("Could not create directory $directory_path.");
1178    }
1179    }
1180
1181    #my $file_path = &util::filename_cat($directory_path, $file . "-" . $timestamp);
1182    my $file_path = "";
1183    if($gsdl_cgi->greenstone_version() == 2) {
1184    $file_path = &util::filename_cat($directory_path, $file . "-" . $timestamp);
1185    } else {
1186    $file_path = &util::filename_cat($directory_path, $file);
1187    }
1188   
1189    if (!open(FOUT, ">$file_path")) {
1190    print STDERR "Unable to write file $file_path\n";
1191    $gsdl_cgi->generate_error("Unable to write file $file_path");
1192    }
1193
1194    # Read the uploaded data and write it out to file
1195    my $buf;
1196    my $num_bytes = 0;
1197    binmode(FOUT);
1198    if($gsdl_cgi->greenstone_version() == 2) { ##
1199    # We have to pass the size of the uploaded data in the "fs" argument because IIS 6 seems to be
1200    #   completely incapable of working this out otherwise (causing the old code to crash)
1201    my $num_bytes_remaining = $gsdl_cgi->clean_param("fs");
1202    my $bytes_to_read = $num_bytes_remaining;
1203    if ($bytes_to_read > 1024) { $bytes_to_read = 1024; }
1204
1205    while (read(STDIN, $buf, $bytes_to_read) > 0) {
1206        print FOUT $buf;
1207        $num_bytes += length($buf);
1208        $num_bytes_remaining -= length($buf);
1209        $bytes_to_read = $num_bytes_remaining;
1210        if ($bytes_to_read > 1024) { $bytes_to_read = 1024; }
1211    }
1212    } else { # GS3 and later
1213        my $bread;
1214    my $fh = $gsdl_cgi->clean_param("uploaded_file");
1215
1216    if (!defined $fh) {
1217        print STDERR "ERROR. Filehandle undefined. No file uploaded onto GS3 server.\n";
1218        $gsdl_cgi->generate_error("ERROR. Filehandle undefined. No file uploaded (GS3 server).");
1219    } else {
1220        while ($bread=read($fh, $buf, 1024)) {
1221        print FOUT $buf;
1222        }
1223    }
1224    }
1225    close(FOUT);
1226       
1227    # If we have downloaded a zip file, unzip it
1228    if (defined $zip) {
1229    my $java = $gsdl_cgi->get_java_path();
1230    my $java_classpath = &util::filename_cat($ENV{'GSDLHOME'}, "bin", "java", "GLIServer.jar");
1231    my $java_args = "\"$file_path\" \"$directory_path\"";
1232    $ENV{'LANG'} = $lang_env;
1233    my $java_command = "\"$java\" -classpath \"$java_classpath\" org.greenstone.gatherer.remote.Unzip $java_args";
1234    my $java_output = `$java_command`;
1235    my $java_status = $?;
1236
1237    # Remove the zip file once we have unzipped it, since it is an intermediate file only
1238    unlink("$file_path") unless $debugging_enabled;
1239   
1240    if ($java_status > 0) {
1241        $gsdl_cgi->generate_error("Java failed: $java_command\n--\n$java_output\nExit status: " . ($java_status / 256) . "\n" . $gsdl_cgi->check_java_home()); # dies
1242    }
1243    }
1244
1245    $gsdl_cgi->generate_ok_message("Collection file $file uploaded successfully.");
1246}
1247
1248sub put_file
1249{
1250    my $gsdl_cgi = shift(@_);
1251    my $file_path = shift(@_);
1252    my $content_type = shift(@_);
1253
1254    if(!defined $content_type) { ##
1255    $content_type = "application/zip";
1256    }
1257   
1258    if (open(PIN, "<$file_path")) {
1259    print STDOUT "Content-type:$content_type\n\n"; ## For GS3: "Content-type:application/zip\n\n";
1260    my $buf;
1261    my $num_bytes = 0;
1262    binmode(PIN);
1263    while (read(PIN, $buf, 1024) > 0) {
1264        print STDOUT $buf;
1265        $num_bytes += length($buf);
1266    }
1267
1268    close(PIN);
1269    }
1270    else {
1271    $gsdl_cgi->generate_error("Unable to read file $file_path\n  $!");
1272    }
1273}
1274
1275sub send_mail
1276{
1277    my $gsdl_cgi = shift(@_);
1278    my $mail_subject = shift(@_);
1279    my $mail_content = shift(@_);
1280
1281    my $sendmail_command = "perl -S sendmail.pl";
1282    $sendmail_command .= " -to \"" . $mail_to_address . "\"";
1283    $sendmail_command .= " -from \"" . $mail_from_address . "\"";
1284    $sendmail_command .= " -smtp \"" . $mail_smtp_server . "\"";
1285    $sendmail_command .= " -subject \"" . $mail_subject . "\"";
1286
1287    if (!open(POUT, "| $sendmail_command")) {
1288    $gsdl_cgi->generate_error("Unable to execute command: $sendmail_command");
1289    }
1290    print POUT $mail_content . "\n";
1291    close(POUT);
1292}
1293
1294sub greenstone_server_version
1295{   
1296    my $gsdl_cgi = shift(@_);
1297    my $version = $gsdl_cgi->greenstone_version();
1298    $gsdl_cgi->generate_ok_message("Greenstone server version is: $version\n");
1299}
1300
1301sub get_library_url_suffix
1302{
1303    my $gsdl_cgi = shift(@_);
1304    my $library_url = $gsdl_cgi->library_url_suffix();
1305    $gsdl_cgi->generate_ok_message("Greenstone library URL suffix is: $library_url\n");
1306}
1307
1308&main();
Note: See TracBrowser for help on using the browser.