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

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

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