Changeset 16467
- Timestamp:
- 2008-07-18T15:47:37+12:00 (15 years ago)
- Location:
- gsdl/trunk/cgi-bin
- Files:
-
- 3 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(); -
gsdl/trunk/cgi-bin/gsdlCGI.pm
r14973 r16467 1 2 1 package gsdlCGI; 3 2 4 3 # This file merges Michael Dewsnip's gsdlCGI.pm for GS2 and Quan Qiu's gsdlCGI4gs3.pm (GS3) 4 5 use strict; 6 no strict 'subs'; 7 no strict 'refs'; # allow filehandles to be variables and viceversa 5 8 6 9 use CGI; 7 10 use Cwd; 8 11 9 @ ISA = ('CGI');12 @gsdlCGI::ISA = ( 'CGI' ); 10 13 11 14 sub new { 12 15 my $class = shift @_; 13 16 14 17 my $self; 18 19 # We'll determine the correct config file in this constructor itself 20 # and use it to determine the Greenstone server's version. 21 # Perhaps later, another test can be used for finding out what version 22 # of the Greenstone server we are working with. 23 my $version; 24 if (-e "gsdl3site.cfg") { 25 $version = 3; 26 } else { 27 $version = 2; 28 } 29 15 30 if ((defined $ENV{'REQUEST_METHOD'}) && ($ENV{'REQUEST_METHOD'} eq "POST")) { 16 my $line = <STDIN>; 17 if ((defined $line) && ($line ne "")) { 18 $self = new CGI($line); 19 } 20 else { 21 $self = new CGI(); 22 } 23 } 24 else { 31 32 # Check if we're dealing with the upload-coll-file cmd. Because it will be a 33 # multipart POST message and must be dealt with by the default CGI() constructor 34 if((defined $ENV{'QUERY_STRING'}) && ($ENV{'QUERY_STRING'} =~ m/upload-collection-file/)) { 35 $self = new CGI(); 36 } 37 38 else { # all other POST commands processed using CGI($line) 39 my $line = <STDIN>; 40 if ((defined $line) && ($line ne "")) { 41 $self = new CGI($line); 42 } 43 } 44 45 } 46 47 # If one of the conditions above did not hold, then self=new CGI() 48 if (!defined $self) { 25 49 $self = new CGI(); 26 50 } 27 51 52 if ($version == 2) { 53 $self->{'site_filename'} = "gsdlsite.cfg"; 54 $self->{'greenstone_version'} = 2; 55 } 56 elsif ($version == 3) { 57 $self->{'site_filename'} = "gsdl3site.cfg"; 58 $self->{'greenstone_version'} = 3; 59 } 60 28 61 return bless $self, $class; 29 62 } … … 73 106 } 74 107 108 sub generate_message 109 { 110 my $self = shift @_; 111 my ($message) = @_; 112 113 #if($self->{'greenstone_version'} == 2) { # plain text, for IIS 6 114 print STDOUT "Content-type:text/plain\n\n$message"; 115 #} else { 116 #print "Content-type:text/html\n\n"; 117 #print "<pre>"; 118 #print STDOUT $message; 119 #print "</pre>"; 120 #} 121 } 75 122 76 123 sub generate_error … … 98 145 } 99 146 100 print STDOUT "Content-type:text/plain\n\n"; 101 print STDOUT $full_mess; 102 103 exit 0; 147 $self->generate_message($full_mess); 148 149 die $full_mess; 104 150 } 105 151 … … 128 174 } 129 175 130 print STDOUT "Content-type:text/plain\n\n"; 131 print STDOUT $full_mess; 176 $self->generate_message($full_mess); 132 177 133 178 print STDERR $full_mess; … … 152 197 $full_mess = "$mess\n"; 153 198 } 154 155 print STDOUT "Content-type:text/plain\n\n"; 156 print STDOUT $full_mess; 199 200 $self->generate_message($full_mess); 157 201 } 158 202 … … 161 205 sub get_config_info { 162 206 my $self = shift @_; 163 my ($infotype ) = @_;164 165 my $site_filename = "gsdlsite.cfg";207 my ($infotype, $optional) = @_; 208 209 my $site_filename = $self->{'site_filename'}; 166 210 open (FILEIN, "<$site_filename") 167 || $self->generate_error("Could not open gsdlsite.cfg");211 || $self->generate_error("Could not open $site_filename"); 168 212 169 213 my $config_content = ""; … … 174 218 175 219 my ($loc) = ($config_content =~ m/^$infotype\s+((\".+\")|(\S+))\s*\n/m); 176 $loc =~ s/\"//g ;220 $loc =~ s/\"//g if defined $loc; 177 221 178 222 if ((!defined $loc) || ($loc =~ m/^\s*$/)) { 179 $self->generate_error("$infotype is not set in gsdlsite.cfg"); 223 if((!defined $optional) || (!$optional)) { 224 $self->generate_error("$infotype is not set in $site_filename"); 225 } 180 226 } 181 227 182 228 return $loc; 229 } 230 231 sub get_gsdl3_src_home{ 232 my $self = shift @_; 233 if (defined $self->{'gsdl3srchome'}) { 234 return $self->{'gsdl3srchome'}; 235 } 236 237 my $gsdl3srchome = $self->get_config_info("gsdl3srchome"); 238 239 if(defined $gsdl3srchome) { 240 $gsdl3srchome =~ s/(\/|\\)$//; # remove trailing slash 241 } 242 $self->{'gsdl3srchome'} = $gsdl3srchome; 243 244 return $gsdl3srchome; 183 245 } 184 246 … … 200 262 } 201 263 264 sub get_gsdl3_home { 265 my $self = shift @_; 266 my ($optional) = @_; 267 268 if (defined $self->{'gsdl3home'}) { 269 return $self->{'gsdl3home'}; 270 } 271 272 my $gsdl3home = $self->get_config_info("gsdl3home", $optional); 273 274 if(defined $gsdl3home) { 275 $gsdl3home =~ s/(\/|\\)$//; # remove trailing slash 276 $self->{'gsdl3home'} = $gsdl3home; 277 } 278 return $gsdl3home; 279 } 280 281 sub get_java_home { 282 my $self = shift @_; 283 my ($optional) = @_; 284 285 if (defined $self->{'javahome'}) { 286 return $self->{'javahome'}; 287 } 288 289 my $javahome = $self->get_config_info("javahome", $optional); 290 if(defined $javahome) { 291 $javahome =~ s/(\/|\\)$//; # remove trailing slash 292 $self->{'javahome'} = $javahome; 293 } 294 return $javahome; 295 } 296 297 sub get_perl_path { 298 my $self = shift @_; 299 300 if (defined $self->{'perlpath'}) { 301 return $self->{'perlpath'}; 302 } 303 304 my $perlpath = $self->get_config_info("perlpath"); 305 306 if(defined $perlpath) { 307 $perlpath =~ s/(\/|\\)$//; # remove trailing slash 308 $self->{'perlpath'} = $perlpath; 309 } 310 return $perlpath; 311 } 312 202 313 sub get_gsdl_os { 203 314 my $self = shift @_; … … 208 319 return "linux"; 209 320 } 210 elsif ($os =~ /mswin/i) {321 elsif ($os =~ m/mswin/i) { 211 322 return "windows"; 212 323 } 213 elsif ($os =~ /macos/i) {324 elsif ($os =~ m/macos/i) { 214 325 return "darwin"; 215 326 } … … 220 331 } 221 332 333 sub get_library_url_suffix { 334 my $self = shift @_; 335 336 if (defined $self->{'library_url_suffix'}) { 337 return $self->{'library_url_suffix'}; 338 } 339 340 my $optional = 1; # ignore absence of gwcgi if not found 341 my $library_url = $self->get_config_info("gwcgi", $optional); 342 if(defined $library_url) { 343 $library_url =~ s/(\/|\\)$//; # remove trailing slash 344 } 345 else { 346 347 if($self->{'greenstone_version'} == 2) { 348 $library_url = $self->get_config_info("httpprefix"); 349 $library_url = "$library_url/cgi-bin/library"; 350 351 my $gsdlos = (defined $ENV{'GSDLOS'}) ? $ENV{'GSDLOS'} : $self->get_gsdl_os(); 352 if($gsdlos =~ m/windows/) { # remote GS2 server on Windows uses "library.exe" 353 $library_url .= ".exe"; 354 } 355 } 356 else { # greenstone 3 or later and gwcgi not defined 357 $library_url = "/greenstone3"; #"/greenstone3/library"; 358 } 359 } 360 361 $self->{'library_url_suffix'} = $library_url; 362 return $library_url; 363 } 364 365 sub setup_fedora_homes { 366 my $self = shift @_; 367 my ($optional) = @_; 368 369 # The following will still allow the FEDORA_HOME and FEDORA_VERSION environment 370 # variables to have been set outside the gsdlsite.cfg file. Existing env vars 371 # are only overwritten if they've *also* been defined in gsdlsite.cfg. 372 373 if (!defined $self->{'fedora_home'}) # Don't need to go through it all again if we'd already done this before 374 { 375 # First look in the gsdlsite.cfg file for the fedora properties to be defined 376 # and set $ENV{FEDORA_HOME} and $ENV{FEDORA_VERSION} if values were provided 377 $self->{'fedora_home'} = $self->get_config_info("fedorahome", $optional); 378 379 if (defined $self->{'fedora_home'}) { 380 $ENV{'FEDORA_HOME'} = $self->{'fedora_home'}; 381 } 382 elsif (defined $ENV{'FEDORA_HOME'}) { # check environment variable 383 $self->{'fedora_home'} = $ENV{'FEDORA_HOME'}; 384 } 385 386 # if FEDORA_HOME is now defined, we can look for the fedora version that is being used 387 if (defined $ENV{'FEDORA_HOME'}) 388 { 389 # first look in the file 390 $self->{'fedora_version'} = $self->get_config_info("fedoraversion", $optional); 391 392 if (defined $self->{'fedora_version'}) { 393 $ENV{'FEDORA_VERSION'} = $self->{'fedora_version'}; 394 } 395 elsif (defined $ENV{'FEDORA_VERSION'}) { # then check environment variable 396 $self->{'fedora_version'} = $ENV{'FEDORA_VERSION'}; 397 } 398 else { # finally, default to version 3 and warn the user 399 $ENV{'FEDORA_VERSION'} = "3"; 400 $self->{'fedora_version'} = $ENV{'FEDORA_VERSION'}; 401 #$self->generate_ok_message("FEDORA_HOME is set, but not FEDORA_VERSION, defaulted to: 3."); 402 } 403 } 404 } 405 } 406 222 407 sub setup_gsdl { 223 408 my $self = shift @_; 409 my $optional = 1; # ignore absence of specified properties in gsdl(3)site.cfg if not found 224 410 225 411 my $gsdlhome = $self->get_gsdl_home(); 226 412 my $gsdlos = $self->get_gsdl_os(); 227 228 413 $ENV{'GSDLHOME'} = $gsdlhome; 229 414 $ENV{'GSDLOS'} = $gsdlos; 230 415 416 my $library_url = $self->get_library_url_suffix(); # best to have GSDLOS set beforehand 417 $self->{'library_url_suffix'} = $library_url; 418 231 419 require "$gsdlhome/perllib/util.pm"; 232 420 421 if($self->{'greenstone_version'} == 3) { 422 my $gsdl3srchome = $self->get_gsdl3_src_home(); 423 $ENV{'GSDL3SRCHOME'} = $gsdl3srchome; 424 425 my $gsdl3home = $self->get_gsdl3_home($optional); 426 # if a specific location for GS3's web folder is not provided, 427 # assume the GS3 web folder is in the default location 428 if(!defined $gsdl3home) { 429 $gsdl3home = &util::filename_cat($ENV{'GSDL3SRCHOME'}, "web"); 430 $self->{'gsdl3home'} = $gsdl3home; 431 } 432 $ENV{'GSDL3HOME'} = $gsdl3home; 433 } 434 435 233 436 my $gsdl_bin_script = &util::filename_cat($gsdlhome,"bin","script"); 234 437 &util::envvar_append("PATH",$gsdl_bin_script); 235 438 236 439 my $gsdl_bin_os = &util::filename_cat($gsdlhome,"bin",$gsdlos); 237 440 &util::envvar_append("PATH",$gsdl_bin_os); 238 441 442 # Perl comes installed with the GS Windows Release Kit. 443 # However, if GS is from SVN, the user must have their own Perl and put it on the path. 444 my $perl_bin_dir; # undefined 239 445 if ($gsdlos eq "windows") { 240 my $gsdl_perl_bin_directory = &util::filename_cat($gsdlhome, "bin", "windows", "perl", "bin"); 241 &util::envvar_append("PATH", $gsdl_perl_bin_directory); 242 } 243 } 244 446 $perl_bin_dir = &util::filename_cat($gsdlhome, "bin", "windows", "perl", "bin"); 447 if(-e $perl_bin_dir) { 448 &util::envvar_append("PATH", $perl_bin_dir); 449 } 450 } 451 452 # Uncomment these lines if you want to read the "perlpath" property from 453 # the gsdl(3)site.cfg config file into PATH 454 #if(!defined $perl_bin_dir) { 455 #$perl_bin_dir = $self->get_perl_path(); 456 #&util::envvar_append("PATH", $perl_bin_dir); 457 #} 458 459 # gsdl(3)site.cfg can specify JAVA_HOME and FEDORA_HOME along with Fedora's version. Both 460 # are needed (by scripts g2f-import and g2f-buildcol) when using Greenstone 2 with Fedora. 461 if(!defined $ENV{'JAVA_HOME'}) { 462 $ENV{'JAVA_HOME'} = $self->get_java_home($optional); 463 } 464 465 $self->setup_fedora_homes($optional); 466 } 467 468 sub greenstone_version { 469 my $self = shift @_; 470 return $self->{'greenstone_version'}; 471 } 472 473 sub library_url_suffix { 474 my $self = shift @_; 475 return $self->{'library_url_suffix'}; 476 } 477 478 # Only useful to call this after calling setup_gsdl, as it uses some environment variables 479 # Returns the Greenstone collect directory, or a specific collection directory inside collect 480 sub get_collection_dir { 481 my $self = shift @_; 482 my ($site, $collection) = @_; # both may be undefined 483 484 require "$ENV{'GSDLHOME'}/perllib/util.pm"; 485 my $collection_directory; 486 if($self->{'greenstone_version'} == 2 && defined $ENV{'GSDLHOME'}) { 487 if(defined $collection) { 488 $collection_directory = &util::filename_cat($ENV{'GSDLHOME'}, "collect", $collection); 489 } else { 490 $collection_directory = &util::filename_cat($ENV{'GSDLHOME'}, "collect"); 491 } 492 } 493 elsif($self->{'greenstone_version'} == 3 && defined $ENV{'GSDL3SRCHOME'}) { 494 if(defined $collection) { 495 $collection_directory = &util::filename_cat($ENV{'GSDL3SRCHOME'}, "web", "sites", $site, "collect", $collection); 496 } else { 497 $collection_directory = &util::filename_cat($ENV{'GSDL3SRCHOME'}, "web", "sites", $site, "collect"); 498 } 499 } 500 } 245 501 246 502 sub local_rm_r … … 250 506 251 507 my $prefix_dir = getcwd(); 252 508 my $full_path = &util::filename_cat($prefix_dir,$local_dir); 509 253 510 if ($prefix_dir !~ m/collect/) { 254 $self->generate_error("Trying to delete outside of Greenstone collect: $full_dir"); 255 } 256 257 my $full_dir = &util::filename_cat($prefix_dir,$local_dir); 511 $self->generate_error("Trying to delete outside of Greenstone collect: $full_path"); 512 } 258 513 259 514 # Delete recursively 260 if (!-e $full_ dir) {261 $self->generate_error("File/Directory does not exist: $full_ dir");262 } 263 264 &util::rm_r($full_ dir);515 if (!-e $full_path) { 516 $self->generate_error("File/Directory does not exist: $full_path"); 517 } 518 519 &util::rm_r($full_path); 265 520 } 266 521 … … 282 537 sub check_java_home() 283 538 { 284 # Return a warning unless the JAVA_HOME en rivonmenvariable is set539 # Return a warning unless the JAVA_HOME environment variable is set 285 540 if (!defined $ENV{'JAVA_HOME'}) { 286 541 return "JAVA_HOME environment variable not set. Might not be able to find Java unless in PATH (" . $ENV{'PATH'} . ")"; … … 304 559 } 305 560 561 sub rot13() 562 { 563 my $self = shift @_; 564 my ($password)=@_; 565 my @password_arr=split(//,$password); 566 567 my @encrypt_password; 568 foreach my $str (@password_arr){ 569 my $char=unpack("c",$str); 570 if ($char>=97 && $char<=109){ 571 $char+=13; 572 }elsif ($char>=110 && $char<=122){ 573 $char-=13; 574 }elsif ($char>=65 && $char<=77){ 575 $char+=13; 576 }elsif ($char>=78 && $char<=90){ 577 $char-=13; 578 } 579 $char=pack("c",$char); 580 push(@encrypt_password,$char); 581 } 582 return join("",@encrypt_password); 583 } 584 585 sub encrypt_password 586 { 587 my $self = shift @_; 588 589 if (defined $self->param("pw")) { ## 590 if ($self->{'greenstone_version'} == 3) { # GS3 is in Java, so needs different encryption 591 $self->param('-name' => "pw", '-value' => $self->rot13($self->clean_param("pw"))); 592 } 593 else { # GS2 (and versions of GS other than 3?) 594 #require "$self->{'gsdlhome'}/perllib/util.pm"; # This is OK on Windows 595 require "$self->{'gsdlhome'}/perllib/cpan/Crypt/UnixCrypt.pm"; # This is OK on Windows 596 $self->param('-name' => "pw", '-value' => &Crypt::UnixCrypt::crypt($self->clean_param("pw"), "Tp")); 597 } 598 } 599 } 600 306 601 1; 307 602 -
gsdl/trunk/cgi-bin/gsdlsite.cfg
r16389 r16467 4 4 5 5 # points to the GSDLHOME directory 6 gsdlhome **GSDLHOME**6 gsdlhome "/research/ak19/gs2PerlUpdates" 7 7 8 8 # this is the http address of GSDLHOME 9 9 # if your webservers DocumentRoot is set to $GSDLHOME 10 10 # then httpprefix can remain commented out 11 #httpprefix /gsdl11 httpprefix /gs2perl 12 12 13 13 # this is the http address of the directory which … … 15 15 # if your webservers DocumentRoot is set to $GSDLHOME 16 16 # then httpimg will be /images 17 httpimg / images17 httpimg /gs2perl/images 18 18 19 19 # should contain the http address of this cgi script. This … … 29 29 maxrequests 10000 30 30 31 # If you wish to use Fedora with Greenstone2's GLI Server, then 32 # you need to set the full paths to JAVA_HOME and FEDORA_HOME 33 # here as well as the major version of fedora 34 #javahome /full/path/to/j2sdk1.4.2_13 35 #fedorahome /full/path/to/fedora 36 #fedoraversion 3 31 # JAVA_HOME and FEDORA_HOME need to be set when using Greenstone 2 32 # with Fedora. 33 # full path to javahome 34 javahome /opt/jdk1.5.0_10/ 35 36 # full path to FEDORA_HOME and the major version number of the 37 # fedora installation 38 fedorahome /research/ak19/fedora 39 fedoraversion 2
Note:
See TracChangeset
for help on using the changeset viewer.