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

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

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