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

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

Fix to comment
  • 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 local dir separator slash
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.