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

Last change on this file since 34159 was 34159, checked in by ak19, 4 years ago

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