root/gsdl/trunk/cgi-bin/gliserver.pl @ 19189

Revision 19189, 44.2 KB (checked in by ak19, 11 years ago)

1. Changes made together with related changes in gliserver.pl for making the DownloadPane? available in the remote client-gli. DownloadInfo?.pl is called and gliserver now expects a downloader argument with the name of the downloader. 2. Variable client_lang now renamed to lang_env and some changes to tidy this up. More importantly, when lang_env is the empty string (signifying that the LANG env var on the client side was not set and the Java zip tools were run in that environment) this empty LANG environment is reused by the server to run the ziptools as well, to ensure consistency in this special case.

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