source: main/trunk/greenstone2/cgi-bin/gliserver.pl@ 22472

Last change on this file since 22472 was 22472, checked in by ak19, 14 years ago

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