source: main/trunk/greenstone2/common-src/cgi-bin/gliserver.pl@ 32168

Last change on this file since 32168 was 32168, checked in by ak19, 6 years ago

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