source: main/trunk/greenstone2/cgi-bin/gliserver.pl@ 22078

Last change on this file since 22078 was 20959, checked in by ak19, 14 years ago

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