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

Revision 19172, 44.4 KB (checked in by ak19, 11 years ago)

GLI and gliserver.pl have been updated together to deal with inconsistent Zipping environment. When testing on Linux, LANG variable was set on the GLI (client) side but not set on server side. This resulted in special characters in filenames being unzipped differently from their originals on the client side, or if the LANG env var had been set to be the same on the server end as it was on the client end when the zipping took place. Now the client passes the LANG variable to every upload and download gliserver command. The client gets and stores the LANG variable only once though (on creating the RemoteGreenstoneServer? object) since the System.getenv() method is deprecated.

  • 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 $client_lang = $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 = "\"$java\" -classpath \"$java_classpath\" org.greenstone.gatherer.remote.ZipCollectionShell $java_args";
523    $java_command = "LANG=$client_lang $java_command" if $client_lang;
524
525    my $java_output = `$java_command`;
526    my $java_status = $?;
527    if ($java_status > 0) {
528    $gsdl_cgi->generate_error("Java failed: $java_command\n--\n$java_output\nExit status: " . ($java_status / 256) . "\n" . $gsdl_cgi->check_java_home());
529    }
530
531    # Check that the zip file was created successfully
532    if (!-e $zip_file_path || -z $zip_file_path) {
533    $gsdl_cgi->generate_error("Collection zip file $zip_file_path could not be created.");
534    }
535
536    &put_file($gsdl_cgi, $zip_file_path, "application/zip"); # file is transferred to client
537    unlink("$zip_file_path") unless $debugging_enabled;      # deletes the local intermediate zip file
538}
539
540
541sub download_collection_archives
542{
543    my ($gsdl_cgi, $username, $timestamp, $site) = @_;
544
545    my $collection = $gsdl_cgi->clean_param("c");
546    if ((!defined $collection) || ($collection =~ m/^\s*$/)) {
547    $gsdl_cgi->generate_error("No collection specified.");
548    }
549
550    # language and region Environment Variable setting on the client side that was used to zip files.
551    my $client_lang = $gsdl_cgi->clean_param("lr");
552    $gsdl_cgi->delete("lr");
553   
554    # Ensure the user is allowed to edit this collection
555    &authenticate_user($gsdl_cgi, $username, $collection, $site);
556
557    my $collect_directory = $gsdl_cgi->get_collection_dir($site);
558    $gsdl_cgi->checked_chdir($collect_directory);
559
560    # Check that the collection archives exist
561    if (!-d &util::filename_cat($collection, "archives")) {
562    $gsdl_cgi->generate_error("Collection archives do not exist.");
563    }
564
565    # Make sure the collection isn't locked by someone else
566    &lock_collection($gsdl_cgi, $username, $collection, $site);
567
568    # Zip up the collection archives
569    my $java = $gsdl_cgi->get_java_path();
570    my $java_classpath = &util::filename_cat($ENV{'GSDLHOME'}, "bin", "java", "GLIServer.jar");
571    my $zip_file_path = &util::filename_cat($collect_directory, $collection . "-archives-" . $timestamp . ".zip");
572    my $java_args = "\"$zip_file_path\" \"$collect_directory\" \"$collection\"";
573    my $java_command = "\"$java\" -classpath \"$java_classpath\" org.greenstone.gatherer.remote.ZipCollectionArchives $java_args";
574    $java_command = "LANG=$client_lang $java_command" if $client_lang;
575
576    my $java_output = `$java_command`;
577    my $java_status = $?;
578    if ($java_status > 0) {
579    $gsdl_cgi->generate_error("Java failed: $java_command\n--\n$java_output\nExit status: " . ($java_status / 256) . "\n" . $gsdl_cgi->check_java_home());
580    }
581
582    # Check that the zip file was created successfully
583    if (!-e $zip_file_path || -z $zip_file_path) {
584    $gsdl_cgi->generate_error("Collection archives zip file $zip_file_path could not be created.");
585    }
586
587    &put_file($gsdl_cgi, $zip_file_path, "application/zip");
588    unlink("$zip_file_path") unless $debugging_enabled;
589}
590
591
592# Collection locking unnecessary because this action isn't related to a particular collection
593sub download_collection_configurations
594{
595    my ($gsdl_cgi, $username, $timestamp, $site) = @_;
596
597    # language and region Environment Variable setting on the client side that was used to zip files.
598    my $client_lang = $gsdl_cgi->clean_param("lr");
599    $gsdl_cgi->delete("lr");
600   
601    # Users can be in any group to perform this action
602    my $user_groups = &authenticate_user($gsdl_cgi, $username, "", $site);
603
604    my $collect_directory = $gsdl_cgi->get_collection_dir($site);
605    $gsdl_cgi->checked_chdir($collect_directory);
606
607    # Zip up the collection configurations
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-configurations-" . $timestamp . ".zip");
611    my $java_args = "\"$zip_file_path\" \"$collect_directory\" \"$username\" \"$user_groups\"";
612    my $java_command = "\"$java\" -classpath \"$java_classpath\" org.greenstone.gatherer.remote.ZipCollectionConfigurations $java_args";
613    $java_command = "LANG=$client_lang $java_command" if $client_lang;
614    my $java_output = `$java_command`;
615    my $java_status = $?;
616    if ($java_status > 0) {
617    $gsdl_cgi->generate_error("Java failed: $java_command\n--\n$java_output\nExit status: " . ($java_status / 256) . "\n" . $gsdl_cgi->check_java_home());
618    }
619
620    # Check that the zip file was created successfully
621    if (!-e $zip_file_path || -z $zip_file_path) {
622    $gsdl_cgi->generate_error("Collection configurations zip file $zip_file_path could not be created.");
623    }
624
625    &put_file($gsdl_cgi, $zip_file_path, "application/zip");
626    unlink("$zip_file_path") unless $debugging_enabled;
627}
628
629# Method that will check if the given file exists
630# No error message: all messages generated are OK messages
631# This method will simply state whether the file exists or does not exist.
632sub file_exists
633{
634    my ($gsdl_cgi, $site) = @_;
635
636    my $collection = $gsdl_cgi->clean_param("c");
637    if ((!defined $collection) || ($collection =~ m/^\s*$/)) {
638    $gsdl_cgi->generate_error("No collection specified.");
639    }
640    my $file = $gsdl_cgi->clean_param("file");
641    if ((!defined $file) || ($file =~ m/^\s*$/)) {
642    $gsdl_cgi->generate_error("No file specified.");
643    }
644    $file = "\"$file\"";   # Windows: bookend the relative filepath with quotes in case it contains spaces
645    $file = $gsdl_cgi->decode($file);
646    $file =~ s/\|/&util::get_dirsep()/eg;  # Convert the '|' characters into whatever is right for this OS
647
648    # Not necessary: checking whether the user is authenticated to query existence of the file
649    #&authenticate_user($gsdl_cgi, $username, $collection);
650
651    my $collection_directory = $gsdl_cgi->get_collection_dir($site, $collection);
652    $gsdl_cgi->checked_chdir($collection_directory); # cd into the directory of that collection
653
654    # Check that the collection file exists
655    if (-e $file) {
656    $gsdl_cgi->generate_ok_message("File $file exists.");
657    } else {
658    $gsdl_cgi->generate_ok_message("File $file does not exist.");
659    }
660}
661
662sub download_collection_file
663{
664    my ($gsdl_cgi, $username, $timestamp, $site) = @_;
665
666    my $collection = $gsdl_cgi->clean_param("c");
667    if ((!defined $collection) || ($collection =~ m/^\s*$/)) {
668    $gsdl_cgi->generate_error("No collection specified.");
669    }
670    # language and region Environment Variable setting on the client side that was used to zip files.
671    my $client_lang = $gsdl_cgi->clean_param("lr");
672    $gsdl_cgi->delete("lr");
673    my $file = $gsdl_cgi->clean_param("file");
674    if ((!defined $file) || ($file =~ m/^\s*$/)) {
675    $gsdl_cgi->generate_error("No file specified.");
676    }
677    $file =~ s/\|/&util::get_dirsep()/eg;  # Convert the '|' characters into whatever is right for this OS
678
679    # Make sure we don't try to download anything outside the collection
680    if ($file =~ m/\.\./) {
681    $gsdl_cgi->generate_error("Illegal file specified.");
682    }
683
684    # Ensure the user is allowed to edit this collection
685    &authenticate_user($gsdl_cgi, $username, $collection, $site);
686
687    my $collection_directory = $gsdl_cgi->get_collection_dir($site, $collection);
688    $gsdl_cgi->checked_chdir($collection_directory);
689
690    # Check that the collection file exists
691    if (!-e $file) {
692    $gsdl_cgi->generate_ok_message("Collection file $file does not exist.");
693    die;
694    }
695
696    # Make sure the collection isn't locked by someone else
697    &lock_collection($gsdl_cgi, $username, $collection, $site);
698
699    # Zip up the collection file
700    my $java = $gsdl_cgi->get_java_path();
701    my $java_classpath = &util::filename_cat($ENV{'GSDLHOME'}, "bin", "java", "GLIServer.jar");
702    my $zip_file_path = &util::filename_cat($collection_directory, $collection . "-file-" . $timestamp . ".zip");
703    my $java_args = "\"$zip_file_path\" \"$collection_directory\" \"$file\"";
704    my $java_command = "\"$java\" -classpath \"$java_classpath\" org.greenstone.gatherer.remote.ZipFiles $java_args";
705    $java_command = "LANG=$client_lang $java_command" if $client_lang;
706
707    my $java_output = `$java_command`;
708    my $java_status = $?;
709    if ($java_status > 0) {
710    $gsdl_cgi->generate_error("Java failed: $java_command\n--\n$java_output\nExit status: " . ($java_status / 256) . "\n" . $gsdl_cgi->check_java_home());
711    }
712
713    # Check that the zip file was created successfully
714    if (!-e $zip_file_path || -z $zip_file_path) {
715    $gsdl_cgi->generate_error("Collection archives zip file $zip_file_path could not be created.");
716    }
717
718    &put_file($gsdl_cgi, $zip_file_path, "application/zip");
719    unlink("$zip_file_path") unless $debugging_enabled;
720}
721
722# download web.xml from the server
723sub download_web_xml_file
724{
725    my ($gsdl_cgi, $username, $timestamp, $site) = @_;
726
727    # Users can be in any group to perform this action
728    my $user_groups = &authenticate_user($gsdl_cgi, $username, "", $site);
729
730    # language and region Environment Variable setting on the client side that was used to zip files.
731    my $client_lang = $gsdl_cgi->clean_param("lr");
732    $gsdl_cgi->delete("lr");
733    my $file = $gsdl_cgi->clean_param("file");
734    if ((!defined $file) || ($file =~ m/^\s*$/)) {
735    $gsdl_cgi->generate_error("No file specified.");
736    }
737    $file =~ s/\|/&util::get_dirsep()/eg;  # Convert the '|' characters into whatever is right for this OS
738
739    # Make sure we don't try to download anything else
740    if ($file =~ m/\.\./) {
741    $gsdl_cgi->generate_error("Illegal file specified.");
742    }
743
744    my $web_inf_directory = &util::filename_cat($ENV{'GSDL3SRCHOME'}, "web", "WEB-INF");
745    $gsdl_cgi->checked_chdir($web_inf_directory);
746
747    # Check that the collection file exists
748    if (!-e $file) {
749    $gsdl_cgi->generate_error("file $file does not exist.");
750    }
751
752    # Zip up the collection file
753    my $java = $gsdl_cgi->get_java_path();
754    my $java_classpath = &util::filename_cat($ENV{'GSDLHOME'}, "bin", "java", "GLIServer.jar");
755    my $zip_file_path = &util::filename_cat($web_inf_directory, "webxml" . $timestamp . ".zip");
756    my $java_args = "\"$zip_file_path\" \"$web_inf_directory\" \"$file\"";
757    my $java_command = "\"$java\" -classpath \"$java_classpath\" org.greenstone.gatherer.remote.ZipFiles $java_args";
758    $java_command = "LANG=$client_lang $java_command" if $client_lang;
759    my $java_output = `$java_command`;
760
761    my $java_status = $?;
762    if ($java_status > 0) {
763    $gsdl_cgi->generate_error("Java failed: $java_command\n--\n$java_output\nExit status: " . ($java_status / 256) . "\n" . $gsdl_cgi->check_java_home());
764    }
765
766    # Check that the zip file was created successfully
767    if (!-e $zip_file_path || -z $zip_file_path) {
768    $gsdl_cgi->generate_error("web.xml zip file $zip_file_path could not be created.");
769    }
770
771    &put_file($gsdl_cgi, $zip_file_path, "application/zip");
772
773    unlink("$zip_file_path") unless $debugging_enabled;
774}
775
776# Collection locking unnecessary because this action isn't related to a particular collection
777sub get_script_options
778{
779    my ($gsdl_cgi, $username, $timestamp, $site) = @_;
780
781    my $script = $gsdl_cgi->clean_param("script");
782    if ((!defined $script) || ($script =~ m/^\s*$/)) {
783    $gsdl_cgi->generate_error("No script specified.");
784    }
785    $gsdl_cgi->delete("script");
786
787    # Users can be in any group to perform this action
788    &authenticate_user($gsdl_cgi, $username, "", $site);
789    $gsdl_cgi->delete("ts"); ## two lines from GS3 version, doesn't seem to harm GS2
790    $gsdl_cgi->delete("pw");
791   
792
793    my $perl_args = "";
794    if ($script eq "classinfo.pl") {
795    $perl_args = $gsdl_cgi->clean_param("classifier") || "";
796    $gsdl_cgi->delete("classifier");
797    }
798    if ($script eq "pluginfo.pl") {
799    $perl_args = $gsdl_cgi->clean_param("plugin") || "";
800    $gsdl_cgi->delete("plugin");
801    }
802
803    foreach my $cgi_arg_name ($gsdl_cgi->param) {
804    my $cgi_arg_value = $gsdl_cgi->clean_param($cgi_arg_name) || "";
805    $cgi_arg_value = $gsdl_cgi->safe_val($cgi_arg_value);
806    if ($cgi_arg_value eq "") {
807        $perl_args = "-$cgi_arg_name " . $perl_args;
808    }
809    else {
810        $perl_args = "-$cgi_arg_name \"$cgi_arg_value\" " . $perl_args;
811    }
812    }
813
814
815    # IIS 6: redirecting output from STDERR to STDOUT just doesn't work, so we have to let it go
816    #   directly out to the page
817    print STDOUT "Content-type:text/plain\n\n";
818    my $perl_command;
819    if($iis6_mode && $gsdl_cgi->greenstone_version() == 2)
820    {
821    $perl_command = "perl -S $script $perl_args";
822    } else {
823    $perl_command = "perl -S $script $perl_args 2>&1";
824    }
825
826    my $perl_output = `$perl_command`;
827    my $perl_status = $?;
828    if ($perl_status > 0) {
829    $gsdl_cgi->generate_error("Perl failed: $perl_command\n--\n$perl_output\nExit status: " . ($perl_status / 256));
830    }
831
832    if (defined($perl_output))
833    {
834    print STDOUT $perl_output;
835    }
836}
837
838# get the names of all sites available on the server
839sub get_site_names
840{
841    my ($gsdl_cgi, $username, $timestamp, $site) = @_;
842    my $sites_directory = &util::filename_cat($ENV{'GSDL3SRCHOME'}, "web", "sites");
843
844    my @sites_dir;
845    my @site_dir;
846   
847    $gsdl_cgi->checked_chdir($sites_directory);
848    opendir(DIR, $sites_directory);
849    @sites_dir= readdir(DIR);
850    my $sites_dir;
851    my $sub_dir_file;
852
853    print STDOUT "Content-type:text/plain\n\n";
854    foreach $sites_dir(@sites_dir)
855    {
856    if (!(($sites_dir eq ".") || ($sites_dir eq "..") || ($sites_dir eq "CVS")))
857    {
858        my $site_dir_path= &util::filename_cat($sites_directory,$sites_dir);
859        $gsdl_cgi->checked_chdir($site_dir_path);
860        opendir(DIR,$site_dir_path);
861        @site_dir=readdir(DIR);
862        closedir(DIR);
863       
864        foreach $sub_dir_file(@site_dir)
865        {
866        if ($sub_dir_file eq "siteConfig.xml"){
867            print STDOUT "$sites_dir" . "-----";
868        }
869        }
870    }
871    }
872
873}
874
875sub move_collection_file
876{
877    my ($gsdl_cgi, $username, $timestamp, $site) = @_;
878
879    my $collection = $gsdl_cgi->clean_param("c");
880    if ((!defined $collection) || ($collection =~ m/^\s*$/)) {
881    $gsdl_cgi->generate_error("No collection specified.");
882    }
883    my $source_file = $gsdl_cgi->clean_param("source");
884    if ((!defined $source_file) || ($source_file =~ m/^\s*$/)) {
885    $gsdl_cgi->generate_error("No source file specified.");
886    }
887    $source_file =~ s/\|/&util::get_dirsep()/eg;  # Convert the '|' characters into whatever is right for this OS
888    my $target_file = $gsdl_cgi->clean_param("target");
889    if ((!defined $target_file) || ($target_file =~ m/^\s*$/)) {
890    $gsdl_cgi->generate_error("No target file specified.");
891    }
892    $target_file =~ s/\|/&util::get_dirsep()/eg;  # Convert the '|' characters into whatever is right for this OS
893
894    # Make sure we don't try to move anything outside the collection
895    if ($source_file =~ m/\.\./ || $target_file =~ m/\.\./) {
896    $gsdl_cgi->generate_error("Illegal file specified.");
897    }
898
899    # Ensure the user is allowed to edit this collection
900    &authenticate_user($gsdl_cgi, $username, $collection, $site);
901
902    my $collection_directory = $gsdl_cgi->get_collection_dir($site, $collection);
903    $gsdl_cgi->checked_chdir($collection_directory);
904
905    # Check that the collection source file exists
906    if (!-e $source_file) {
907    $gsdl_cgi->generate_error("Collection file $source_file does not exist.");
908    }
909
910    # Make sure the collection isn't locked by someone else
911    &lock_collection($gsdl_cgi, $username, $collection, $site);
912
913    &util::mv($source_file, $target_file);
914
915    # Check that the collection source file was moved
916    if (-e $source_file || !-e $target_file) {
917    $gsdl_cgi->generate_error("Could not move collection file $source_file to $target_file."); # dies
918    }
919
920    $gsdl_cgi->generate_ok_message("Collection file $source_file moved to $target_file successfully.");
921}
922
923
924sub new_collection_directory
925{
926    my ($gsdl_cgi, $username, $timestamp, $site) = @_;
927
928    my $collection = $gsdl_cgi->clean_param("c");
929    if ((!defined $collection) || ($collection =~ m/^\s*$/)) {
930    $gsdl_cgi->generate_error("No collection specified.");
931    }
932    my $directory = $gsdl_cgi->clean_param("directory");
933    if ((!defined $directory) || ($directory =~ m/^\s*$/)) {
934    $gsdl_cgi->generate_error("No directory specified.");
935    }
936    $directory =~ s/\|/&util::get_dirsep()/eg;  # Convert the '|' characters into whatever is right for this OS
937
938    # Make sure we don't try to create anything outside the collection
939    if ($directory =~ m/\.\./) {
940    $gsdl_cgi->generate_error("Illegal directory specified.");
941    }
942
943    # Ensure the user is allowed to edit this collection
944    &authenticate_user($gsdl_cgi, $username, $collection, $site);
945
946    my $collection_directory = $gsdl_cgi->get_collection_dir($site, $collection);
947    $gsdl_cgi->checked_chdir($collection_directory);
948
949    # Check that the collection directory doesn't already exist
950    # ZipTools doesn't zip up empty directories, so this causes an error when downloading a new collection as we explicitly
951    # try to create the import directory
952## log -r13497 for GS2's gliserver.pl, Katherine Don explains:
953# "commented out checking for existence of a directory in new_collection_directory
954# as it throws an error which we don't want"
955    #if($gsdl_cgi->greenstone_version() != 2 && -d $directory) {
956    #$gsdl_cgi->generate_error("Collection directory $directory already exists.");
957    #}
958
959    # Make sure the collection isn't locked by someone else
960    &lock_collection($gsdl_cgi, $username, $collection, $site);
961
962    &util::mk_dir($directory);
963
964    # Check that the collection directory was created
965    if (!-d $directory) {
966    $gsdl_cgi->generate_error("Could not create collection directory $directory.");
967    }
968
969    $gsdl_cgi->generate_ok_message("Collection directory $directory created successfully.");
970}
971
972
973sub run_script
974{
975    my ($gsdl_cgi, $username, $timestamp, $site) = @_;
976
977    my $script = $gsdl_cgi->clean_param("script");
978    if ((!defined $script) || ($script =~ m/^\s*$/)) {
979    $gsdl_cgi->generate_error("No script specified.");
980    }
981    $gsdl_cgi->delete("script");
982 
983    my $collection = $gsdl_cgi->clean_param("c");
984    if ((!defined $collection) || ($collection =~ m/^\s*$/)) {
985    $gsdl_cgi->generate_error("No collection specified.");
986    }
987    $gsdl_cgi->delete("c");
988
989    # confuse other, so delete timestamp
990    $gsdl_cgi->delete("ts");
991
992    # Ensure the user is allowed to edit this collection
993    &authenticate_user($gsdl_cgi, $username, $collection, $site);
994
995    # Make sure the collection isn't locked by someone else (unless we're running mkcol.pl, of course)
996    &lock_collection($gsdl_cgi, $username, $collection, $site) unless ($script eq "mkcol.pl");
997
998    # Last argument is the collection name, except for explode_metadata_database.pl and
999    # replace_srcdoc_with_html (where there's a "file" option followed by the filename. These two preceed the collection name)
1000    my $perl_args = $collection;
1001    if ($script eq "explode_metadata_database.pl" || $script eq "replace_srcdoc_with_html.pl") {
1002    # Last argument is the file to be exploded or it is the file to be replaced with its html version
1003    my $file = $gsdl_cgi->clean_param("file");
1004    if ((!defined $file) || ($file =~ m/^\s*$/)) {
1005        $gsdl_cgi->generate_error("No file specified.");
1006    }
1007    $gsdl_cgi->delete("file"); 
1008    $file = $gsdl_cgi->decode($file);
1009    $file = "\"$file\""; # Windows: bookend the relative filepath with quotes in case it contains spaces
1010    $perl_args = $file;
1011    }
1012
1013    foreach my $cgi_arg_name ($gsdl_cgi->param) {
1014    my $cgi_arg_value = $gsdl_cgi->safe_val($gsdl_cgi->clean_param($cgi_arg_name));
1015    if ($cgi_arg_value eq "") {
1016        $perl_args = "-$cgi_arg_name " . $perl_args;
1017    }
1018    else {
1019        $perl_args = "-$cgi_arg_name \"$cgi_arg_value\" " . $perl_args;
1020    }
1021    }
1022
1023    # mkcol.pl and import.pl, buildcol.pl, g2f-import.pl, g2f-buildcol.pl all need the -collectdir option passed
1024    my $import_pl = "import.pl"; # import is a reserved word, need to put it in quotes
1025   
1026    if (($script =~ m/$import_pl|buildcol.pl/) || ($script eq "mkcol.pl")) { # || ($script eq "schedule.pl")
1027    my $collect_directory = $gsdl_cgi->get_collection_dir($site);
1028    $perl_args = $perl_args . " -collectdir \"$collect_directory\"";
1029    }
1030
1031    my $perl_command = "perl -S $script $perl_args 2>&1";
1032    # IIS 6: redirecting output from STDERR to STDOUT just doesn't work, so we have to let it go
1033    #   directly out to the page
1034    if($gsdl_cgi->greenstone_version() == 2 && $iis6_mode)
1035    {
1036    $perl_command = "perl -S $script $perl_args";
1037    }
1038    if (!open(PIN, "$perl_command |")) {
1039    $gsdl_cgi->generate_error("Unable to execute command: $perl_command");
1040    }
1041
1042    print STDOUT "Content-type:text/plain\n\n";
1043    print "$perl_command  \n";
1044
1045    while (defined (my $perl_output_line = <PIN>)) {
1046    print STDOUT $perl_output_line;
1047    }
1048    close(PIN);
1049
1050    my $perl_status = $?;
1051    if ($perl_status > 0) {
1052    $gsdl_cgi->generate_error("Perl failed: $perl_command\n--\nExit status: " . ($perl_status / 256));
1053    }
1054    elsif ($mail_enabled) {
1055    if ($script eq "buildcol.pl") {
1056        &send_mail($gsdl_cgi, "Remote Greenstone building event", "Build of collection '$collection' complete.");
1057    }
1058    }
1059}
1060
1061sub upload_collection_file
1062{
1063    my ($gsdl_cgi, $username, $timestamp, $site) = @_;
1064   
1065    my $collection = $gsdl_cgi->clean_param("c");
1066    if ((!defined $collection) || ($collection =~ m/^\s*$/)) {
1067    $gsdl_cgi->generate_error("No collection specified.");
1068    }
1069    my $file = $gsdl_cgi->clean_param("file");
1070    if ((!defined $file) || ($file =~ m/^\s*$/)) {
1071    $gsdl_cgi->generate_error("No file specified.");
1072    }
1073    my $directory = $gsdl_cgi->clean_param("directory") || "";
1074    $directory =~ s/\|/&util::get_dirsep()/eg;  # Convert the '|' characters into whatever is right for this OS
1075    my $zip = $gsdl_cgi->clean_param("zip");
1076
1077    # language and region Environment Variable setting on the client side that was used to
1078    # zip files. This needs to be consistent on both client and server sides, otherwise zip
1079    # and unzip seem to produce different values.
1080    my $client_lang = $gsdl_cgi->clean_param("lr");
1081    $gsdl_cgi->delete("lr");
1082
1083    # Make sure we don't try to upload anything outside the collection
1084    if ($file =~ m/\.\./) {
1085    $gsdl_cgi->generate_error("Illegal file specified.");
1086    }
1087    if ($directory =~ m/\.\./) {
1088    $gsdl_cgi->generate_error("Illegal directory specified.");
1089    }
1090
1091    # Ensure the user is allowed to edit this collection
1092    if($gsdl_cgi->greenstone_version() == 2) { ## Quan commented this out for GS3 in r14325
1093    &authenticate_user($gsdl_cgi, $username, $collection, $site); # site will be undefined for GS2, of course
1094    }
1095
1096    my $collection_directory = $gsdl_cgi->get_collection_dir($site, $collection);
1097    $gsdl_cgi->checked_chdir($collection_directory);
1098
1099    # Make sure the collection isn't locked by someone else
1100    &lock_collection($gsdl_cgi, $username, $collection, $site);
1101
1102    my $directory_path = &util::filename_cat($collection_directory, $directory);
1103    if (!-d $directory_path) {
1104    &util::mk_dir($directory_path);
1105    if (!-d $directory_path) {
1106        $gsdl_cgi->generate_error("Could not create directory $directory_path.");
1107    }
1108    }
1109
1110    #my $file_path = &util::filename_cat($directory_path, $file . "-" . $timestamp);
1111    my $file_path = "";
1112    if($gsdl_cgi->greenstone_version() == 2) {
1113    $file_path = &util::filename_cat($directory_path, $file . "-" . $timestamp);
1114    } else {
1115    $file_path = &util::filename_cat($directory_path, $file);
1116    }
1117   
1118    if (!open(FOUT, ">$file_path")) {
1119    print STDERR "Unable to write file $file_path\n";
1120    $gsdl_cgi->generate_error("Unable to write file $file_path");
1121    }
1122
1123    # Read the uploaded data and write it out to file
1124    my $buf;
1125    my $num_bytes = 0;
1126    binmode(FOUT);
1127    if($gsdl_cgi->greenstone_version() == 2) { ##
1128    # We have to pass the size of the uploaded data in the "fs" argument because IIS 6 seems to be
1129    #   completely incapable of working this out otherwise (causing the old code to crash)
1130    my $num_bytes_remaining = $gsdl_cgi->clean_param("fs");
1131    my $bytes_to_read = $num_bytes_remaining;
1132    if ($bytes_to_read > 1024) { $bytes_to_read = 1024; }
1133
1134    while (read(STDIN, $buf, $bytes_to_read) > 0) {
1135        print FOUT $buf;
1136        $num_bytes += length($buf);
1137        $num_bytes_remaining -= length($buf);
1138        $bytes_to_read = $num_bytes_remaining;
1139        if ($bytes_to_read > 1024) { $bytes_to_read = 1024; }
1140    }
1141    } else { # GS3 and later
1142        my $bread;
1143    my $fh = $gsdl_cgi->clean_param("uploaded_file");
1144
1145    if (!defined $fh) {
1146        print STDERR "ERROR. Filehandle undefined. No file uploaded onto GS3 server.\n";
1147        $gsdl_cgi->generate_error("ERROR. Filehandle undefined. No file uploaded (GS3 server).");
1148    } else {
1149        while ($bread=read($fh, $buf, 1024)) {
1150        print FOUT $buf;
1151        }
1152    }
1153    }
1154    close(FOUT);
1155       
1156    # If we have downloaded a zip file, unzip it
1157    if (defined $zip) {
1158    my $java = $gsdl_cgi->get_java_path();
1159    my $java_classpath = &util::filename_cat($ENV{'GSDLHOME'}, "bin", "java", "GLIServer.jar");
1160    my $java_args = "\"$file_path\" \"$directory_path\"";
1161    my $java_command = "\"$java\" -classpath \"$java_classpath\" org.greenstone.gatherer.remote.Unzip $java_args";
1162    $java_command = "LANG=$client_lang $java_command" if $client_lang;
1163    my $java_output = `$java_command`;
1164    my $java_status = $?;
1165
1166    # Remove the zip file once we have unzipped it, since it is an intermediate file only
1167    unlink("$file_path") unless $debugging_enabled;
1168   
1169    if ($java_status > 0) {
1170        $gsdl_cgi->generate_error("Java failed: $java_command\n--\n$java_output\nExit status: " . ($java_status / 256) . "\n" . $gsdl_cgi->check_java_home()); # dies
1171    }
1172    }
1173
1174    $gsdl_cgi->generate_ok_message("Collection file $file uploaded successfully.");
1175}
1176
1177sub put_file
1178{
1179    my $gsdl_cgi = shift(@_);
1180    my $file_path = shift(@_);
1181    my $content_type = shift(@_);
1182
1183    if(!defined $content_type) { ##
1184    $content_type = "application/zip";
1185    }
1186   
1187    if (open(PIN, "<$file_path")) {
1188    print STDOUT "Content-type:$content_type\n\n"; ## For GS3: "Content-type:application/zip\n\n";
1189    my $buf;
1190    my $num_bytes = 0;
1191    binmode(PIN);
1192    while (read(PIN, $buf, 1024) > 0) {
1193        print STDOUT $buf;
1194        $num_bytes += length($buf);
1195    }
1196
1197    close(PIN);
1198    }
1199    else {
1200    $gsdl_cgi->generate_error("Unable to read file $file_path\n  $!");
1201    }
1202}
1203
1204sub send_mail
1205{
1206    my $gsdl_cgi = shift(@_);
1207    my $mail_subject = shift(@_);
1208    my $mail_content = shift(@_);
1209
1210    my $sendmail_command = "perl -S sendmail.pl";
1211    $sendmail_command .= " -to \"" . $mail_to_address . "\"";
1212    $sendmail_command .= " -from \"" . $mail_from_address . "\"";
1213    $sendmail_command .= " -smtp \"" . $mail_smtp_server . "\"";
1214    $sendmail_command .= " -subject \"" . $mail_subject . "\"";
1215
1216    if (!open(POUT, "| $sendmail_command")) {
1217    $gsdl_cgi->generate_error("Unable to execute command: $sendmail_command");
1218    }
1219    print POUT $mail_content . "\n";
1220    close(POUT);
1221}
1222
1223sub greenstone_server_version
1224{   
1225    my $gsdl_cgi = shift(@_);
1226    my $version = $gsdl_cgi->greenstone_version();
1227    $gsdl_cgi->generate_ok_message("Greenstone server version is: $version\n");
1228}
1229
1230sub get_library_url_suffix
1231{
1232    my $gsdl_cgi = shift(@_);
1233    my $library_url = $gsdl_cgi->library_url_suffix();
1234    $gsdl_cgi->generate_ok_message("Greenstone library URL suffix is: $library_url\n");
1235}
1236
1237&main();
Note: See TracBrowser for help on using the browser.