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

Last change on this file since 33011 was 33011, checked in by ak19, 5 years ago

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