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

Last change on this file since 25963 was 25963, checked in by ak19, 12 years ago

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