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

Last change on this file since 28958 was 28958, checked in by davidb, 10 years ago

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