Changeset 16467 for gsdl/trunk/cgi-bin/gliserver.pl
- Timestamp:
- 2008-07-18T15:47:37+12:00 (16 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
gsdl/trunk/cgi-bin/gliserver.pl
r15928 r16467 1 1 #!/usr/bin/perl -w 2 #!perl -w3 2 # Need to specify the full path of Perl above 4 3 4 # This file merges Michael Dewsnip's gliserver.pl for GS2 and Quan Qiu's gliserver4gs3.pl (GS3) 5 5 6 6 use strict; 7 no strict 'subs'; 8 no strict 'refs'; # allow filehandles to be variables and viceversa 7 9 8 10 … … 10 12 my $iis6_mode = 0; 11 13 12 14 ## 13 15 # IIS 6: for some reason, IIS runs this script with the working directory set to the Greenstone 14 16 # directory rather than the cgi-bin directory, causing lots of stuff to fail 15 17 if ($iis6_mode) 16 18 { 17 # Change into cgi-bin directory 18 chdir("cgi-bin"); 19 } 20 21 22 # We use require and an eval here (instead of "use") to catch any errors loading the module (for IIS) 19 # Change into cgi-bin directory - need to ensure it exists, since gliserver deals with both GS2 and GS3 20 if(-e "cgi-bin" && -d "cgi-bin") { # GS2 21 chdir("cgi-bin"); 22 } else { # iis6_mode is not applicable for Greenstone 3 23 $iis6_mode = 0; 24 } 25 } 26 27 28 # We use require and an eval here (instead of "use package") to catch any errors loading the module (for IIS) 23 29 eval("require \"gsdlCGI.pm\""); 24 30 if ($@) … … 30 36 31 37 32 my $debugging_enabled = 0; 38 #my $authentication_enabled = 0; 39 my $debugging_enabled = 0; # if 1, debugging is enabled and unlinking intermediate files (deleting files) will not happen 33 40 34 41 my $mail_enabled = 0; … … 38 45 39 46 sub main 40 { 47 { 41 48 my $gsdl_cgi = new gsdlCGI(); 42 49 … … 44 51 $gsdl_cgi->setup_gsdl(); 45 52 my $gsdlhome = $ENV{'GSDLHOME'}; 53 46 54 $gsdl_cgi->checked_chdir($gsdlhome); 47 require "$gsdlhome/perllib/util.pm"; # This is OK on Windows48 require "$gsdlhome/perllib/cpan/Crypt/UnixCrypt.pm"; # This is OK on Windows49 55 50 56 # Encrypt the password 51 if (defined $gsdl_cgi->param("pw")) { 52 $gsdl_cgi->param('-name' => "pw", '-value' => &Crypt::UnixCrypt::crypt($gsdl_cgi->clean_param("pw"), "Tp")); 53 } 57 $gsdl_cgi->encrypt_password(); 54 58 55 59 $gsdl_cgi->parse_cgi_args(); … … 65 69 $gsdl_cgi->delete("cmd"); 66 70 67 # The check-installation command hasno arguments71 # The check-installation, greenstone-server-version and get-library-url commands have no arguments 68 72 if ($cmd eq "check-installation") { 69 73 &check_installation($gsdl_cgi); 74 return; 75 } 76 elsif ($cmd eq "greenstone-server-version") { 77 &greenstone_server_version($gsdl_cgi); 78 return; 79 } 80 elsif ($cmd eq "get-library-url-suffix") { 81 &get_library_url_suffix($gsdl_cgi); 70 82 return; 71 83 } … … 76 88 $gsdl_cgi->generate_error("No username specified."); 77 89 } 78 # Remove the un argument (since this can mess up other scripts)79 90 $gsdl_cgi->delete("un"); 80 91 … … 86 97 $gsdl_cgi->delete("ts"); 87 98 99 my $site; # undefined on declaration, see http://perldoc.perl.org/perlsyn.html 100 if($gsdl_cgi->greenstone_version() != 2) { # all GS versions after 2 may define site 101 $site = $gsdl_cgi->clean_param("site"); 102 if (!defined $site) { 103 $gsdl_cgi->generate_error("No site specified."); 104 } 105 $gsdl_cgi->delete("site"); 106 } 107 108 88 109 if ($cmd eq "delete-collection") { 89 &delete_collection($gsdl_cgi, $username, $timestamp );110 &delete_collection($gsdl_cgi, $username, $timestamp, $site); 90 111 } 91 112 elsif ($cmd eq "download-collection") { 92 &download_collection($gsdl_cgi, $username, $timestamp );113 &download_collection($gsdl_cgi, $username, $timestamp, $site); 93 114 } 94 115 elsif ($cmd eq "download-collection-archives") { 95 &download_collection_archives($gsdl_cgi, $username, $timestamp );116 &download_collection_archives($gsdl_cgi, $username, $timestamp, $site); 96 117 } 97 118 elsif ($cmd eq "download-collection-configurations") { 98 &download_collection_configurations($gsdl_cgi, $username, $timestamp );119 &download_collection_configurations($gsdl_cgi, $username, $timestamp, $site); 99 120 } 100 121 elsif ($cmd eq "download-collection-file") { 101 &download_collection_file($gsdl_cgi, $username, $timestamp );122 &download_collection_file($gsdl_cgi, $username, $timestamp, $site); 102 123 } 103 124 elsif ($cmd eq "delete-collection-file") { 104 &delete_collection_file($gsdl_cgi, $username, $timestamp );125 &delete_collection_file($gsdl_cgi, $username, $timestamp, $site); 105 126 } 106 127 elsif ($cmd eq "get-script-options") { 107 &get_script_options($gsdl_cgi, $username, $timestamp );128 &get_script_options($gsdl_cgi, $username, $timestamp, $site); 108 129 } 109 130 elsif ($cmd eq "move-collection-file") { 110 &move_collection_file($gsdl_cgi, $username, $timestamp );131 &move_collection_file($gsdl_cgi, $username, $timestamp, $site); 111 132 } 112 133 elsif ($cmd eq "new-collection-directory") { 113 &new_collection_directory($gsdl_cgi, $username, $timestamp );134 &new_collection_directory($gsdl_cgi, $username, $timestamp, $site); 114 135 } 115 136 elsif ($cmd eq "run-script") { 116 &run_script($gsdl_cgi, $username, $timestamp );137 &run_script($gsdl_cgi, $username, $timestamp, $site); 117 138 } 118 139 elsif ($cmd eq "timeout-test") { … … 120 141 } 121 142 elsif ($cmd eq "upload-collection-file") { 122 &upload_collection_file($gsdl_cgi, $username, $timestamp );123 } 143 &upload_collection_file($gsdl_cgi, $username, $timestamp, $site); 144 } 124 145 elsif ($cmd eq "file-exists") { 125 &file_exists($gsdl_cgi); 126 } 146 &file_exists($gsdl_cgi, $site); 147 } 148 # cmds not in Greenstone 2: 149 elsif ($gsdl_cgi->greenstone_version() != 2) { 150 if ($cmd eq "download-web-xml-file") { 151 &download_web_xml_file($gsdl_cgi, $username, $timestamp, $site); 152 } 153 elsif ($cmd eq "user-validation") { 154 &user_validation($gsdl_cgi, $username, $timestamp, $site); 155 } 156 elsif ($cmd eq "get-site-names") { 157 &get_site_names($gsdl_cgi, $username, $timestamp, $site); 158 } 159 } 127 160 else { 128 161 $gsdl_cgi->generate_error("Unrecognised command: '$cmd'"); 129 162 } 130 } 163 164 } 165 131 166 132 167 sub authenticate_user … … 135 170 my $username = shift(@_); 136 171 my $collection = shift(@_); 137 138 # Remove the pw argument (since this can mess up other scripts) 172 my $site = shift(@_); 173 174 # Even if we're not authenticating remove the un and pw arguments, since these can mess up other scripts 139 175 my $user_password = $gsdl_cgi->clean_param("pw"); 140 176 $gsdl_cgi->delete("pw"); 141 177 178 # Only authenticate if it is enabled 179 # return "all-collections-editor" if (!$authentication_enabled); 180 142 181 if ((!defined $user_password) || ($user_password =~ m/^\s*$/)) { 143 182 $gsdl_cgi->generate_error("Authentication failed: no password specified."); 144 183 } 145 184 146 my $gsdlhome = $ENV{'GSDLHOME'}; 147 my $etc_directory = &util::filename_cat($gsdlhome, "etc"); 148 my $users_db_file_path = &util::filename_cat($etc_directory, "users.db"); 149 150 # Use db2txt instead of GDBM_File to get the user accounts information 151 my $users_db_content = ""; 152 open(USERS_DB, "db2txt \"$users_db_file_path\" |"); 153 while (<USERS_DB>) { 154 $users_db_content .= $_; 155 } 156 157 # Get the user account information from the users.db database 185 my $users_db_content; 186 if($gsdl_cgi->greenstone_version() == 2) { 187 my $etc_directory = &util::filename_cat($ENV{'GSDLHOME'}, "etc"); 188 my $users_db_file_path = &util::filename_cat($etc_directory, "users.db"); 189 190 # Use db2txt instead of GDBM_File to get the user accounts information 191 $users_db_content = ""; 192 open(USERS_DB, "db2txt \"$users_db_file_path\" |"); 193 while (<USERS_DB>) { 194 $users_db_content .= $_; 195 } 196 } 197 elsif($gsdl_cgi->greenstone_version() == 3) { 198 my $gsdl3srchome = $ENV{'GSDL3SRCHOME'}; 199 200 my $java = $gsdl_cgi->get_java_path(); 201 my $java_gsdl3_classpath = &util::filename_cat($gsdl3srchome, "web", "WEB-INF", "lib", "gsdl3.jar"); 202 my $java_derby_classpath = &util::filename_cat($gsdl3srchome, "web", "WEB-INF", "lib", "derby.jar"); 203 my $java_classpath; 204 my $gsdlos = $ENV{'GSDLOS'}; 205 if ($gsdlos !~ m/windows/){ 206 $java_classpath = $java_gsdl3_classpath . ":" . $java_derby_classpath; 207 }else{ 208 $java_classpath = $java_gsdl3_classpath . ";" . $java_derby_classpath; 209 } 210 my $java_args = &util::filename_cat($gsdl3srchome, "web", "sites", $site, "etc", "usersDB"); 211 $gsdl_cgi->checked_chdir($java_args); 212 my $java_command="\"$java\" -classpath \"$java_classpath\" org.greenstone.gsdl3.util.usersDB2txt \"$java_args\" 2>&1"; 213 $users_db_content = `$java_command`; 214 } 215 216 # Get the user account information from the usersDB database 158 217 my %users_db_data = (); 159 218 foreach my $users_db_entry (split(/-{70}/, $users_db_content)) { 160 if ($users_db_entry =~ /\n?\[(.+)\]\n/) {219 if ($users_db_entry =~ m/\n?\[(.+)\]\n/) { 161 220 $users_db_data{$1} = $users_db_entry; 162 221 } … … 170 229 171 230 # Check password 172 my ($valid_user_password) = ($user_data =~ /\<password\>(.*)/);231 my ($valid_user_password) = ($user_data =~ m/\<password\>(.*)/); 173 232 if ($user_password ne $valid_user_password) { 174 233 $gsdl_cgi->generate_error("Authentication failed: incorrect password."); … … 176 235 177 236 # Check group 178 my ($user_groups) = ($user_data =~ /\<groups\>(.*)/); 237 my ($user_groups) = ($user_data =~ m/\<groups\>(.*)/); 238 179 239 if ($collection eq "") { 180 240 # If we're not editing a collection then the user doesn't need to be in a particular group 181 241 return $user_groups; # Authentication successful 182 242 } 243 183 244 foreach my $user_group (split(/\,/, $user_groups)) { 184 245 # Does this user have access to all collections? … … 187 248 } 188 249 # Does this user have access to personal collections, and is this one? 189 if ($user_group eq "personal-collections-editor" && $collection =~ /^$username\-/) {250 if ($user_group eq "personal-collections-editor" && $collection =~ m/^$username\-/) { 190 251 return $user_groups; # Authentication successful 191 252 } … … 195 256 } 196 257 } 197 198 258 $gsdl_cgi->generate_error("Authentication failed: user is not in the required group."); 199 259 } … … 205 265 my $username = shift(@_); 206 266 my $collection = shift(@_); 267 my $site = shift(@_); 207 268 208 269 my $steal_lock = $gsdl_cgi->clean_param("steal_lock"); 209 270 $gsdl_cgi->delete("steal_lock"); 210 271 211 my $gsdlhome = $ENV{'GSDLHOME'}; 212 my $collection_directory = &util::filename_cat($gsdlhome, "collect", $collection); 272 my $collection_directory = $gsdl_cgi->get_collection_dir($site, $collection); 213 273 $gsdl_cgi->checked_chdir($collection_directory); 214 274 … … 225 285 226 286 # Pick out the owner of the lock file 227 $lock_file_content =~ /\<User\>(.*?)\<\/User\>/;287 $lock_file_content =~ m/\<User\>(.*?)\<\/User\>/; 228 288 my $lock_file_owner = $1; 229 289 … … 257 317 # ACTIONS 258 318 # ---------------------------------------------------------------------------------------------------- 259 319 # This routine, which uses the variable site, won't get called by GS2, 320 sub user_validation{ 321 my ($gsdl_cgi, $username, $timestamp, $site) = @_; 322 323 # Users can be in any group to perform this action 324 my $user_err = &authenticate_user($gsdl_cgi, $username, "", $site); 325 if (defined $user_err && $user_err!~ m/ERROR/){ 326 if ($user_err!~ m/ERROR/){ 327 #$gsdl_cgi->generate_error("Authentication failed: $username is not valid"); 328 $gsdl_cgi->generate_ok($user_err); 329 #print $user_err; 330 }else{ 331 $gsdl_cgi->generate_error($user_err); 332 #print "not valid" . $user_err; 333 } 334 }else{ 335 $gsdl_cgi->generate_error("Authentication failed: $username is not valid"); 336 } 337 } 260 338 261 339 sub check_installation … … 266 344 my $installation_status = ""; 267 345 268 print STDOUT "Content-type:text/plain\n\n";269 270 346 # Check that Java is installed and accessible 271 347 my $java = $gsdl_cgi->get_java_path(); 272 my $java_command = " $java-version 2>&1";273 348 my $java_command = "\"$java\" -version 2>&1"; 349 274 350 # IIS 6: redirecting output from STDERR to STDOUT just doesn't work, so we have to let it go 275 351 # directly out to the page 276 if ($iis6_mode)277 { 278 $java_command = " java-version";352 if($iis6_mode && $gsdl_cgi->greenstone_version() == 2) { ## 353 print STDOUT "Content-type:text/plain\n\n"; 354 $java_command = "\"$java\" -version"; 279 355 } 280 356 281 357 my $java_output = `$java_command`; 358 282 359 my $java_status = $?; 283 360 if ($java_status < 0) { … … 292 369 # Show the values of some important environment variables 293 370 $installation_status .= "\n"; 371 if($gsdl_cgi->greenstone_version() != 2) { 372 $installation_status .= "GSDL3SRCHOME: " . $ENV{'GSDL3SRCHOME'} . "\n"; 373 $installation_status .= "GSDL3HOME: " . $ENV{'GSDL3HOME'} . "\n"; 374 } 294 375 $installation_status .= "GSDLHOME: " . $ENV{'GSDLHOME'} . "\n"; 295 376 $installation_status .= "GSDLOS: " . $ENV{'GSDLOS'} . "\n"; 377 $installation_status .= "JAVA_HOME: " . $ENV{'JAVA_HOME'} . "\n" if defined($ENV{'JAVA_HOME'}); # on GS2, Java's only on the PATH 296 378 $installation_status .= "PATH: " . $ENV{'PATH'} . "\n"; 297 298 if ($installation_ok) { 299 print STDOUT $installation_status . "\nInstallation OK!"; 379 if(defined $ENV{'FEDORA_VERSION'}) { # not using FLI unless version set 380 $installation_status .= "FEDORA_HOME: ".$ENV{'FEDORA_HOME'} . "\n"; 381 $installation_status .= "FEDORA_VERSION: ".$ENV{'FEDORA_VERSION'}; 382 } 383 384 if ($installation_ok) { ## M. Dewsnip's svn log comment stated that for iis6_mode output needs to go to STDOUT 385 if($iis6_mode && $gsdl_cgi->greenstone_version() == 2) { 386 print STDOUT $installation_status . "\nInstallation OK!"; 387 } else { 388 $gsdl_cgi->generate_ok_message($installation_status . "\nInstallation OK!"); 389 } 300 390 } 301 391 else { 302 print STDOUT $installation_status; 392 if($iis6_mode && $gsdl_cgi->greenstone_version() == 2) { 393 print STDOUT $installation_status; 394 } else { 395 $gsdl_cgi->generate_error($installation_status); 396 } 303 397 } 304 398 } … … 307 401 sub delete_collection 308 402 { 309 my ($gsdl_cgi, $username, $timestamp ) = @_;403 my ($gsdl_cgi, $username, $timestamp, $site) = @_; 310 404 311 405 my $collection = $gsdl_cgi->clean_param("c"); … … 315 409 316 410 # Ensure the user is allowed to edit this collection 317 &authenticate_user($gsdl_cgi, $username, $collection );318 319 my $gsdlhome = $ENV{'GSDLHOME'}; 320 my $collect_directory = &util::filename_cat($gsdlhome, "collect");411 &authenticate_user($gsdl_cgi, $username, $collection, $site); 412 413 414 my $collect_directory = $gsdl_cgi->get_collection_dir($site); 321 415 $gsdl_cgi->checked_chdir($collect_directory); 322 416 … … 327 421 328 422 # Make sure the collection isn't locked by someone else 329 &lock_collection($gsdl_cgi, $username, $collection );423 &lock_collection($gsdl_cgi, $username, $collection, $site); 330 424 331 425 $gsdl_cgi->checked_chdir($collect_directory); … … 343 437 sub delete_collection_file 344 438 { 345 my ($gsdl_cgi, $username, $timestamp ) = @_;439 my ($gsdl_cgi, $username, $timestamp, $site) = @_; 346 440 347 441 my $collection = $gsdl_cgi->clean_param("c"); … … 356 450 357 451 # Make sure we don't try to delete anything outside the collection 358 if ($file =~ /\.\./) {452 if ($file =~ m/\.\./) { 359 453 $gsdl_cgi->generate_error("Illegal file specified."); 360 454 } 361 455 362 456 # Ensure the user is allowed to edit this collection 363 &authenticate_user($gsdl_cgi, $username, $collection); 364 365 my $gsdlhome = $ENV{'GSDLHOME'}; 366 my $collection_directory = &util::filename_cat($gsdlhome, "collect", $collection); 457 &authenticate_user($gsdl_cgi, $username, $collection, $site); 458 459 my $collection_directory = $gsdl_cgi->get_collection_dir($site, $collection); 460 if (!-d $collection_directory){ ## wasn't there in gs2, ok_msg or error_msg? 461 $gsdl_cgi->generate_ok_message("Directory $collection_directory does not exist."); 462 die; 463 } 464 367 465 $gsdl_cgi->checked_chdir($collection_directory); 368 466 369 467 # Make sure the collection isn't locked by someone else 370 &lock_collection($gsdl_cgi, $username, $collection );468 &lock_collection($gsdl_cgi, $username, $collection, $site); 371 469 372 470 # Check that the collection file exists 373 if (!-e $file) { 471 if (!-e $file) { ## original didn't have 'die', but it was an ok message 374 472 $gsdl_cgi->generate_ok_message("Collection file $file does not exist."); 473 die; 375 474 } 376 475 $gsdl_cgi->local_rm_r("$file"); … … 387 486 sub download_collection 388 487 { 389 my ($gsdl_cgi, $username, $timestamp ) = @_;488 my ($gsdl_cgi, $username, $timestamp, $site) = @_; 390 489 391 490 my $collection = $gsdl_cgi->clean_param("c"); … … 395 494 396 495 # Ensure the user is allowed to edit this collection 397 &authenticate_user($gsdl_cgi, $username, $collection); 398 399 my $gsdlhome = $ENV{'GSDLHOME'}; 400 my $collect_directory = &util::filename_cat($gsdlhome, "collect"); 496 &authenticate_user($gsdl_cgi, $username, $collection, $site); 497 498 my $collect_directory = $gsdl_cgi->get_collection_dir($site); 401 499 $gsdl_cgi->checked_chdir($collect_directory); 402 500 403 501 # Check that the collection exists 404 502 if (!-d $collection) { 405 $gsdl_cgi->generate_error("Collection $collection does not exist."); 503 $gsdl_cgi->generate_ok_message("Collection $collection does not exist."); ## original had an error msg (from where it would die) 504 die; 406 505 } 407 506 408 507 # Make sure the collection isn't locked by someone else 409 &lock_collection($gsdl_cgi, $username, $collection );508 &lock_collection($gsdl_cgi, $username, $collection, $site); 410 509 411 510 # Zip up the collection 412 511 my $java = $gsdl_cgi->get_java_path(); 413 my $java_classpath = &util::filename_cat($ gsdlhome, "bin", "java", "GLIServer.jar");512 my $java_classpath = &util::filename_cat($ENV{'GSDLHOME'}, "bin", "java", "GLIServer.jar"); 414 513 my $zip_file_path = &util::filename_cat($collect_directory, $collection . "-" . $timestamp . ".zip"); 415 514 my $java_args = "\"$zip_file_path\" \"$collect_directory\" \"$collection\""; 416 my $java_command = "$java -classpath \"$java_classpath\" org.greenstone.gatherer.remote.ZipCollectionShell $java_args"; 515 if($gsdl_cgi->greenstone_version() != 2) { 516 $java_args .= " gsdl3"; ## must this be done elsewhere as well? 517 } 518 my $java_command = "\"$java\" -classpath \"$java_classpath\" org.greenstone.gatherer.remote.ZipCollectionShell $java_args"; 417 519 418 520 my $java_output = `$java_command`; … … 427 529 } 428 530 429 &put_file($gsdl_cgi, $zip_file_path, "application/zip"); 430 unlink("$zip_file_path") unless $debugging_enabled; 531 &put_file($gsdl_cgi, $zip_file_path, "application/zip"); # file is transferred to client 532 unlink("$zip_file_path") unless $debugging_enabled; # deletes the local intermediate zip file 431 533 } 432 534 … … 434 536 sub download_collection_archives 435 537 { 436 my ($gsdl_cgi, $username, $timestamp ) = @_;538 my ($gsdl_cgi, $username, $timestamp, $site) = @_; 437 539 438 540 my $collection = $gsdl_cgi->clean_param("c"); … … 442 544 443 545 # Ensure the user is allowed to edit this collection 444 &authenticate_user($gsdl_cgi, $username, $collection); 445 446 my $gsdlhome = $ENV{'GSDLHOME'}; 447 my $collect_directory = &util::filename_cat($gsdlhome, "collect"); 546 &authenticate_user($gsdl_cgi, $username, $collection, $site); 547 548 my $collect_directory = $gsdl_cgi->get_collection_dir($site); 448 549 $gsdl_cgi->checked_chdir($collect_directory); 449 550 … … 454 555 455 556 # Make sure the collection isn't locked by someone else 456 &lock_collection($gsdl_cgi, $username, $collection );557 &lock_collection($gsdl_cgi, $username, $collection, $site); 457 558 458 559 # Zip up the collection archives 459 560 my $java = $gsdl_cgi->get_java_path(); 460 my $java_classpath = &util::filename_cat($ gsdlhome, "bin", "java", "GLIServer.jar");561 my $java_classpath = &util::filename_cat($ENV{'GSDLHOME'}, "bin", "java", "GLIServer.jar"); 461 562 my $zip_file_path = &util::filename_cat($collect_directory, $collection . "-archives-" . $timestamp . ".zip"); 462 563 my $java_args = "\"$zip_file_path\" \"$collect_directory\" \"$collection\""; 463 my $java_command = " $java-classpath \"$java_classpath\" org.greenstone.gatherer.remote.ZipCollectionArchives $java_args";564 my $java_command = "\"$java\" -classpath \"$java_classpath\" org.greenstone.gatherer.remote.ZipCollectionArchives $java_args"; 464 565 465 566 my $java_output = `$java_command`; … … 482 583 sub download_collection_configurations 483 584 { 484 my ($gsdl_cgi, $username, $timestamp ) = @_;485 585 my ($gsdl_cgi, $username, $timestamp, $site) = @_; 586 486 587 # Users can be in any group to perform this action 487 my $user_groups = &authenticate_user($gsdl_cgi, $username, ""); 488 489 my $gsdlhome = $ENV{'GSDLHOME'}; 490 my $collect_directory = &util::filename_cat($gsdlhome, "collect"); 588 my $user_groups = &authenticate_user($gsdl_cgi, $username, "", $site); 589 590 my $collect_directory = $gsdl_cgi->get_collection_dir($site); 491 591 $gsdl_cgi->checked_chdir($collect_directory); 492 592 493 593 # Zip up the collection configurations 494 594 my $java = $gsdl_cgi->get_java_path(); 495 my $java_classpath = &util::filename_cat($ gsdlhome, "bin", "java", "GLIServer.jar");595 my $java_classpath = &util::filename_cat($ENV{'GSDLHOME'}, "bin", "java", "GLIServer.jar"); 496 596 my $zip_file_path = &util::filename_cat($collect_directory, "collection-configurations-" . $timestamp . ".zip"); 497 597 my $java_args = "\"$zip_file_path\" \"$collect_directory\" \"$username\" \"$user_groups\""; 498 my $java_command = "$java -classpath \"$java_classpath\" org.greenstone.gatherer.remote.ZipCollectionConfigurations $java_args"; 499 598 my $java_command = "\"$java\" -classpath \"$java_classpath\" org.greenstone.gatherer.remote.ZipCollectionConfigurations $java_args"; 500 599 my $java_output = `$java_command`; 501 600 my $java_status = $?; … … 518 617 sub file_exists 519 618 { 520 my ($gsdl_cgi ) = @_;619 my ($gsdl_cgi, $site) = @_; 521 620 522 621 my $collection = $gsdl_cgi->clean_param("c"); … … 530 629 $file =~ s/\|/&util::get_dirsep()/eg; # Convert the '|' characters into whatever is right for this OS 531 630 532 # Not necessary: checking whether the user is authenticated to query exist ance of the file631 # Not necessary: checking whether the user is authenticated to query existence of the file 533 632 #&authenticate_user($gsdl_cgi, $username, $collection); 534 633 535 my $gsdlhome = $ENV{'GSDLHOME'}; 536 my $collection_directory = &util::filename_cat($gsdlhome, "collect", $collection); 537 $gsdl_cgi->checked_chdir($collection_directory); 634 my $collection_directory = $gsdl_cgi->get_collection_dir($site, $collection); 635 $gsdl_cgi->checked_chdir($collection_directory); # cd into the directory of that collection 538 636 539 637 # Check that the collection file exists … … 547 645 sub download_collection_file 548 646 { 549 my ($gsdl_cgi, $username, $timestamp ) = @_;647 my ($gsdl_cgi, $username, $timestamp, $site) = @_; 550 648 551 649 my $collection = $gsdl_cgi->clean_param("c"); … … 560 658 561 659 # Make sure we don't try to download anything outside the collection 562 if ($file =~ /\.\./) {660 if ($file =~ m/\.\./) { 563 661 $gsdl_cgi->generate_error("Illegal file specified."); 564 662 } 565 663 566 664 # Ensure the user is allowed to edit this collection 567 &authenticate_user($gsdl_cgi, $username, $collection); 568 569 my $gsdlhome = $ENV{'GSDLHOME'}; 570 my $collection_directory = &util::filename_cat($gsdlhome, "collect", $collection); 665 &authenticate_user($gsdl_cgi, $username, $collection, $site); 666 667 my $collection_directory = $gsdl_cgi->get_collection_dir($site, $collection); 571 668 $gsdl_cgi->checked_chdir($collection_directory); 572 669 573 670 # Check that the collection file exists 574 671 if (!-e $file) { 575 $gsdl_cgi->generate_error("Collection file $file does not exist."); 672 $gsdl_cgi->generate_ok_message("Collection file $file does not exist."); 673 die; 576 674 } 577 675 578 676 # Make sure the collection isn't locked by someone else 579 &lock_collection($gsdl_cgi, $username, $collection );677 &lock_collection($gsdl_cgi, $username, $collection, $site); 580 678 581 679 # Zip up the collection file 582 680 my $java = $gsdl_cgi->get_java_path(); 583 my $java_classpath = &util::filename_cat($ gsdlhome, "bin", "java", "GLIServer.jar");681 my $java_classpath = &util::filename_cat($ENV{'GSDLHOME'}, "bin", "java", "GLIServer.jar"); 584 682 my $zip_file_path = &util::filename_cat($collection_directory, $collection . "-file-" . $timestamp . ".zip"); 585 683 my $java_args = "\"$zip_file_path\" \"$collection_directory\" \"$file\""; 586 my $java_command = " $java-classpath \"$java_classpath\" org.greenstone.gatherer.remote.ZipFiles $java_args";684 my $java_command = "\"$java\" -classpath \"$java_classpath\" org.greenstone.gatherer.remote.ZipFiles $java_args"; 587 685 588 686 my $java_output = `$java_command`; … … 601 699 } 602 700 701 # download web.xml from the server 702 sub download_web_xml_file 703 { 704 my ($gsdl_cgi, $username, $timestamp, $site) = @_; 705 706 # Users can be in any group to perform this action 707 my $user_groups = &authenticate_user($gsdl_cgi, $username, "", $site); 708 709 my $file = $gsdl_cgi->clean_param("file"); 710 if ((!defined $file) || ($file =~ m/^\s*$/)) { 711 $gsdl_cgi->generate_error("No file specified."); 712 } 713 $file =~ s/\|/&util::get_dirsep()/eg; # Convert the '|' characters into whatever is right for this OS 714 715 # Make sure we don't try to download anything else 716 if ($file =~ m/\.\./) { 717 $gsdl_cgi->generate_error("Illegal file specified."); 718 } 719 720 my $web_inf_directory = &util::filename_cat($ENV{'GSDL3SRCHOME'}, "web", "WEB-INF"); 721 $gsdl_cgi->checked_chdir($web_inf_directory); 722 723 # Check that the collection file exists 724 if (!-e $file) { 725 $gsdl_cgi->generate_error("file $file does not exist."); 726 } 727 728 # Zip up the collection file 729 my $java = $gsdl_cgi->get_java_path(); 730 my $java_classpath = &util::filename_cat($ENV{'GSDLHOME'}, "bin", "java", "GLIServer.jar"); 731 my $zip_file_path = &util::filename_cat($web_inf_directory, "webxml" . $timestamp . ".zip"); 732 my $java_args = "\"$zip_file_path\" \"$web_inf_directory\" \"$file\""; 733 my $java_command = "\"$java\" -classpath \"$java_classpath\" org.greenstone.gatherer.remote.ZipFiles $java_args"; 734 my $java_output = `$java_command`; 735 736 my $java_status = $?; 737 if ($java_status > 0) { 738 $gsdl_cgi->generate_error("Java failed: $java_command\n--\n$java_output\nExit status: " . ($java_status / 256) . "\n" . $gsdl_cgi->check_java_home()); 739 } 740 741 # Check that the zip file was created successfully 742 if (!-e $zip_file_path || -z $zip_file_path) { 743 $gsdl_cgi->generate_error("web.xml zip file $zip_file_path could not be created."); 744 } 745 746 &put_file($gsdl_cgi, $zip_file_path, "application/zip"); 747 748 unlink("$zip_file_path") unless $debugging_enabled; 749 } 603 750 604 751 # Collection locking unnecessary because this action isn't related to a particular collection 605 752 sub get_script_options 606 753 { 607 my ($gsdl_cgi, $username, $timestamp ) = @_;754 my ($gsdl_cgi, $username, $timestamp, $site) = @_; 608 755 609 756 my $script = $gsdl_cgi->clean_param("script"); … … 614 761 615 762 # Users can be in any group to perform this action 616 &authenticate_user($gsdl_cgi, $username, ""); 763 &authenticate_user($gsdl_cgi, $username, "", $site); 764 $gsdl_cgi->delete("ts"); ## two lines from GS3 version, doesn't seem to harm GS2 765 $gsdl_cgi->delete("pw"); 766 617 767 618 768 my $perl_args = ""; … … 637 787 } 638 788 639 print STDOUT "Content-type:text/plain\n\n";640 641 my $perl_command = "perl -S $script $perl_args 2>&1";642 789 643 790 # IIS 6: redirecting output from STDERR to STDOUT just doesn't work, so we have to let it go 644 791 # directly out to the page 645 if ($iis6_mode) 792 print STDOUT "Content-type:text/plain\n\n"; 793 my $perl_command; 794 if($iis6_mode && $gsdl_cgi->greenstone_version() == 2) 646 795 { 647 796 $perl_command = "perl -S $script $perl_args"; 797 } else { 798 $perl_command = "perl -S $script $perl_args 2>&1"; 648 799 } 649 800 … … 660 811 } 661 812 813 # get the names of all sites available on the server 814 sub get_site_names 815 { 816 my ($gsdl_cgi, $username, $timestamp, $site) = @_; 817 my $sites_directory = &util::filename_cat($ENV{'GSDL3SRCHOME'}, "web", "sites"); 818 819 my @sites_dir; 820 my @site_dir; 821 822 $gsdl_cgi->checked_chdir($sites_directory); 823 opendir(DIR, $sites_directory); 824 @sites_dir= readdir(DIR); 825 my $sites_dir; 826 my $sub_dir_file; 827 828 print STDOUT "Content-type:text/plain\n\n"; 829 foreach $sites_dir(@sites_dir) 830 { 831 if (!(($sites_dir eq ".") || ($sites_dir eq "..") || ($sites_dir eq "CVS"))) 832 { 833 my $site_dir_path= &util::filename_cat($sites_directory,$sites_dir); 834 $gsdl_cgi->checked_chdir($site_dir_path); 835 opendir(DIR,$site_dir_path); 836 @site_dir=readdir(DIR); 837 closedir(DIR); 838 839 foreach $sub_dir_file(@site_dir) 840 { 841 if ($sub_dir_file eq "siteConfig.xml"){ 842 print STDOUT "$sites_dir" . "-----"; 843 } 844 } 845 } 846 } 847 848 } 662 849 663 850 sub move_collection_file 664 851 { 665 my ($gsdl_cgi, $username, $timestamp ) = @_;852 my ($gsdl_cgi, $username, $timestamp, $site) = @_; 666 853 667 854 my $collection = $gsdl_cgi->clean_param("c"); … … 681 868 682 869 # Make sure we don't try to move anything outside the collection 683 if ($source_file =~ /\.\./ || $target_file =~/\.\./) {870 if ($source_file =~ m/\.\./ || $target_file =~ m/\.\./) { 684 871 $gsdl_cgi->generate_error("Illegal file specified."); 685 872 } 686 873 687 874 # Ensure the user is allowed to edit this collection 688 &authenticate_user($gsdl_cgi, $username, $collection); 689 690 my $gsdlhome = $ENV{'GSDLHOME'}; 691 my $collection_directory = &util::filename_cat($gsdlhome, "collect", $collection); 875 &authenticate_user($gsdl_cgi, $username, $collection, $site); 876 877 my $collection_directory = $gsdl_cgi->get_collection_dir($site, $collection); 692 878 $gsdl_cgi->checked_chdir($collection_directory); 693 879 … … 698 884 699 885 # Make sure the collection isn't locked by someone else 700 &lock_collection($gsdl_cgi, $username, $collection );886 &lock_collection($gsdl_cgi, $username, $collection, $site); 701 887 702 888 &util::mv($source_file, $target_file); … … 704 890 # Check that the collection source file was moved 705 891 if (-e $source_file || !-e $target_file) { 706 $gsdl_cgi->generate_error("Could not move collection file $source_file to $target_file."); 892 $gsdl_cgi->generate_error("Could not move collection file $source_file to $target_file."); # dies 707 893 } 708 894 … … 713 899 sub new_collection_directory 714 900 { 715 my ($gsdl_cgi, $username, $timestamp ) = @_;901 my ($gsdl_cgi, $username, $timestamp, $site) = @_; 716 902 717 903 my $collection = $gsdl_cgi->clean_param("c"); … … 726 912 727 913 # Make sure we don't try to create anything outside the collection 728 if ($directory =~ /\.\./) {914 if ($directory =~ m/\.\./) { 729 915 $gsdl_cgi->generate_error("Illegal directory specified."); 730 916 } 731 917 732 918 # Ensure the user is allowed to edit this collection 733 &authenticate_user($gsdl_cgi, $username, $collection); 734 735 my $gsdlhome = $ENV{'GSDLHOME'}; 736 my $collection_directory = &util::filename_cat($gsdlhome, "collect", $collection); 919 &authenticate_user($gsdl_cgi, $username, $collection, $site); 920 921 my $collection_directory = $gsdl_cgi->get_collection_dir($site, $collection); 737 922 $gsdl_cgi->checked_chdir($collection_directory); 738 923 739 924 # Check that the collection directory doesn't already exist 740 # ZipTools doesn't zip up empty directories, so this causes an error when downloading a new collection as we explicit y925 # ZipTools doesn't zip up empty directories, so this causes an error when downloading a new collection as we explicitly 741 926 # try to create the import directory 742 # if (-d $directory) { 743 # $gsdl_cgi->generate_error("Collection directory $directory already exists."); 744 # } 927 ## log -r13497 for GS2's gliserver.pl, Katherine Don explains: 928 # "commented out checking for existence of a directory in new_collection_directory 929 # as it throws an error which we don't want" 930 #if($gsdl_cgi->greenstone_version() != 2 && -d $directory) { 931 #$gsdl_cgi->generate_error("Collection directory $directory already exists."); 932 #} 745 933 746 934 # Make sure the collection isn't locked by someone else 747 &lock_collection($gsdl_cgi, $username, $collection );935 &lock_collection($gsdl_cgi, $username, $collection, $site); 748 936 749 937 &util::mk_dir($directory); … … 760 948 sub run_script 761 949 { 762 my ($gsdl_cgi, $username, $timestamp ) = @_;950 my ($gsdl_cgi, $username, $timestamp, $site) = @_; 763 951 764 952 my $script = $gsdl_cgi->clean_param("script"); … … 767 955 } 768 956 $gsdl_cgi->delete("script"); 957 769 958 my $collection = $gsdl_cgi->clean_param("c"); 770 959 if ((!defined $collection) || ($collection =~ m/^\s*$/)) { … … 773 962 $gsdl_cgi->delete("c"); 774 963 964 # confuse other, so delete timestamp 965 $gsdl_cgi->delete("ts"); 966 775 967 # Ensure the user is allowed to edit this collection 776 &authenticate_user($gsdl_cgi, $username, $collection );968 &authenticate_user($gsdl_cgi, $username, $collection, $site); 777 969 778 970 # Make sure the collection isn't locked by someone else (unless we're running mkcol.pl, of course) 779 &lock_collection($gsdl_cgi, $username, $collection ) unless ($script eq "mkcol.pl");971 &lock_collection($gsdl_cgi, $username, $collection, $site) unless ($script eq "mkcol.pl"); 780 972 781 973 # Last argument is the collection name, except for explode_metadata_database.pl and … … 783 975 my $perl_args = $collection; 784 976 if ($script eq "explode_metadata_database.pl" || $script eq "replace_srcdoc_with_html.pl") { 785 # Last argument is the file to be exploded 977 # Last argument is the file to be exploded or it is the file to be replaced with its html version 786 978 my $file = $gsdl_cgi->clean_param("file"); 787 979 if ((!defined $file) || ($file =~ m/^\s*$/)) { … … 789 981 } 790 982 $gsdl_cgi->delete("file"); 791 $file =~ s/ /\\ /g; # escape all spaces in filename with a backslash, i.e. "\ ". 792 $perl_args = $file; 983 #$file =~ s/ /\\ /g; # Works on linux: escape all spaces in filename with a backslash, i.e. "\ ". 984 $file = "\"$file\""; # Windows: bookend the relative filepath with quotes in case it contains spaces 985 $perl_args = $file; 793 986 } 794 987 … … 803 996 } 804 997 805 print STDOUT "Content-type:text/plain\n\n"; 998 # mkcol.pl and import.pl, buildcol.pl, g2f-import.pl, g2f-buildcol.pl all need the -collectdir option passed 999 my $import_pl = "import.pl"; # import is a reserved word, need to put it in quotes 1000 1001 if (($script =~ m/$import_pl|buildcol.pl/) || ($script eq "mkcol.pl")) { # || ($script eq "schedule.pl") 1002 my $collect_directory = $gsdl_cgi->get_collection_dir($site); 1003 $perl_args = $perl_args . " -collectdir \"$collect_directory\""; 1004 } 806 1005 807 1006 my $perl_command = "perl -S $script $perl_args 2>&1"; 808 809 1007 # IIS 6: redirecting output from STDERR to STDOUT just doesn't work, so we have to let it go 810 1008 # directly out to the page 811 if ($iis6_mode)1009 if($gsdl_cgi->greenstone_version() == 2 && $iis6_mode) 812 1010 { 813 1011 $perl_command = "perl -S $script $perl_args"; 814 1012 } 815 816 1013 if (!open(PIN, "$perl_command |")) { 817 1014 $gsdl_cgi->generate_error("Unable to execute command: $perl_command"); 818 1015 } 1016 1017 print STDOUT "Content-type:text/plain\n\n"; 1018 print "$perl_command \n"; 819 1019 820 1020 while (defined (my $perl_output_line = <PIN>)) { … … 834 1034 } 835 1035 836 837 1036 sub upload_collection_file 838 1037 { 839 my ($gsdl_cgi, $username, $timestamp ) = @_;840 1038 my ($gsdl_cgi, $username, $timestamp, $site) = @_; 1039 841 1040 my $collection = $gsdl_cgi->clean_param("c"); 842 1041 if ((!defined $collection) || ($collection =~ m/^\s*$/)) { … … 852 1051 853 1052 # Make sure we don't try to upload anything outside the collection 854 if ($file =~ /\.\./) {1053 if ($file =~ m/\.\./) { 855 1054 $gsdl_cgi->generate_error("Illegal file specified."); 856 1055 } 857 if ($directory =~ /\.\./) {1056 if ($directory =~ m/\.\./) { 858 1057 $gsdl_cgi->generate_error("Illegal directory specified."); 859 1058 } 860 1059 861 1060 # Ensure the user is allowed to edit this collection 862 &authenticate_user($gsdl_cgi, $username, $collection); 863 864 my $gsdlhome = $ENV{'GSDLHOME'}; 865 my $collection_directory = &util::filename_cat($gsdlhome, "collect", $collection); 1061 if($gsdl_cgi->greenstone_version() == 2) { ## Quan commented this out for GS3 in r14325 1062 &authenticate_user($gsdl_cgi, $username, $collection, $site); # site will be undefined for GS2, of course 1063 } 1064 1065 my $collection_directory = $gsdl_cgi->get_collection_dir($site, $collection); 866 1066 $gsdl_cgi->checked_chdir($collection_directory); 867 1067 868 1068 # Make sure the collection isn't locked by someone else 869 &lock_collection($gsdl_cgi, $username, $collection );1069 &lock_collection($gsdl_cgi, $username, $collection, $site); 870 1070 871 1071 my $directory_path = &util::filename_cat($collection_directory, $directory); … … 877 1077 } 878 1078 879 my $file_path = &util::filename_cat($directory_path, $file . "-" . $timestamp); 1079 #my $file_path = &util::filename_cat($directory_path, $file . "-" . $timestamp); 1080 my $file_path = ""; 1081 if($gsdl_cgi->greenstone_version() == 2) { 1082 $file_path = &util::filename_cat($directory_path, $file . "-" . $timestamp); 1083 } else { 1084 $file_path = &util::filename_cat($directory_path, $file); 1085 } 1086 880 1087 if (!open(FOUT, ">$file_path")) { 1088 print STDERR "Unable to write file $file_path\n"; 881 1089 $gsdl_cgi->generate_error("Unable to write file $file_path"); 882 1090 } 883 1091 884 1092 # Read the uploaded data and write it out to file 885 # We have to pass the size of the uploaded data in the "fs" argument because IIS 6 seems to be886 # completely incapable of working this out otherwise (causing the old code to crash)887 1093 my $buf; 888 1094 my $num_bytes = 0; 889 my $num_bytes_remaining = $gsdl_cgi->clean_param("fs");890 my $bytes_to_read = $num_bytes_remaining;891 if ($bytes_to_read > 1024) { $bytes_to_read = 1024; }892 1095 binmode(FOUT); 893 while (read(STDIN, $buf, $bytes_to_read) > 0) {894 print FOUT $buf;895 $num_bytes += length($buf);896 $num_bytes_remaining -= length($buf);897 $bytes_to_read = $num_bytes_remaining;1096 if($gsdl_cgi->greenstone_version() == 2) { ## 1097 # We have to pass the size of the uploaded data in the "fs" argument because IIS 6 seems to be 1098 # completely incapable of working this out otherwise (causing the old code to crash) 1099 my $num_bytes_remaining = $gsdl_cgi->clean_param("fs"); 1100 my $bytes_to_read = $num_bytes_remaining; 898 1101 if ($bytes_to_read > 1024) { $bytes_to_read = 1024; } 1102 1103 while (read(STDIN, $buf, $bytes_to_read) > 0) { 1104 print FOUT $buf; 1105 $num_bytes += length($buf); 1106 $num_bytes_remaining -= length($buf); 1107 $bytes_to_read = $num_bytes_remaining; 1108 if ($bytes_to_read > 1024) { $bytes_to_read = 1024; } 1109 } 1110 } else { # GS3 and later 1111 my $bread; 1112 my $fh = $gsdl_cgi->clean_param("uploaded_file"); 1113 1114 if (!defined $fh) { 1115 print STDERR "ERROR. Filehandle undefined. No file uploaded onto GS3 server.\n"; 1116 $gsdl_cgi->generate_error("ERROR. Filehandle undefined. No file uploaded (GS3 server)."); 1117 } else { 1118 while ($bread=read($fh, $buf, 1024)) { 1119 print FOUT $buf; 1120 } 1121 } 899 1122 } 900 1123 close(FOUT); 901 1124 902 1125 # If we have downloaded a zip file, unzip it 903 1126 if (defined $zip) { 904 1127 my $java = $gsdl_cgi->get_java_path(); 905 my $java_classpath = &util::filename_cat($ gsdlhome, "bin", "java", "GLIServer.jar");1128 my $java_classpath = &util::filename_cat($ENV{'GSDLHOME'}, "bin", "java", "GLIServer.jar"); 906 1129 my $java_args = "\"$file_path\" \"$directory_path\""; 907 my $java_command = " $java-classpath \"$java_classpath\" org.greenstone.gatherer.remote.Unzip $java_args";1130 my $java_command = "\"$java\" -classpath \"$java_classpath\" org.greenstone.gatherer.remote.Unzip $java_args"; 908 1131 909 1132 my $java_output = `$java_command`; … … 911 1134 912 1135 # Remove the zip file once we have unzipped it, since it is an intermediate file only 913 unlink("$file_path") ;914 1136 unlink("$file_path") unless $debugging_enabled; 1137 915 1138 if ($java_status > 0) { 916 $gsdl_cgi->generate_error("Java failed: $java_command\n--\n$java_output\nExit status: " . ($java_status / 256) . "\n" . $gsdl_cgi->check_java_home()); 1139 $gsdl_cgi->generate_error("Java failed: $java_command\n--\n$java_output\nExit status: " . ($java_status / 256) . "\n" . $gsdl_cgi->check_java_home()); # dies 917 1140 } 918 1141 } … … 920 1143 $gsdl_cgi->generate_ok_message("Collection file $file uploaded successfully."); 921 1144 } 922 923 1145 924 1146 sub put_file … … 928 1150 my $content_type = shift(@_); 929 1151 1152 if(!defined $content_type) { ## 1153 $content_type = "application/zip"; 1154 } 1155 930 1156 if (open(PIN, "<$file_path")) { 931 print STDOUT "Content-type:$content_type\n\n"; 932 1157 print STDOUT "Content-type:$content_type\n\n"; ## For GS3: "Content-type:application/zip\n\n"; 933 1158 my $buf; 934 1159 my $num_bytes = 0; … … 966 1191 } 967 1192 1193 sub greenstone_server_version 1194 { 1195 my $gsdl_cgi = shift(@_); 1196 my $version = $gsdl_cgi->greenstone_version(); 1197 $gsdl_cgi->generate_ok_message("Greenstone server version is: $version\n"); 1198 } 1199 1200 sub get_library_url_suffix 1201 { 1202 my $gsdl_cgi = shift(@_); 1203 my $library_url = $gsdl_cgi->library_url_suffix(); 1204 $gsdl_cgi->generate_ok_message("Greenstone library URL suffix is: $library_url\n"); 1205 } 968 1206 969 1207 &main();
Note:
See TracChangeset
for help on using the changeset viewer.