Changeset 14270 for gsdl/branches/gsdl-2.74/cgi-bin/gliserver.pl
- Timestamp:
- 2007-07-25T13:37:52+12:00 (17 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
gsdl/branches/gsdl-2.74/cgi-bin/gliserver.pl
r14025 r14270 1 1 #!perl -w 2 3 2 # Need to specify the full path of Perl above 4 3 5 4 6 use gsdlCGI;7 5 use strict; 6 7 8 # Set this to 1 to work around IIS 6 craziness 9 my $iis6_mode = 0; 10 11 12 # IIS 6: for some reason, IIS runs this script with the working directory set to the Greenstone 13 # directory rather than the cgi-bin directory, causing lots of stuff to fail 14 if ($iis6_mode) 15 { 16 # Change into cgi-bin directory 17 chdir("cgi-bin"); 18 } 19 20 21 # We use require and an eval here (instead of "use") to catch any errors loading the module (for IIS) 22 eval("require \"gsdlCGI.pm\""); 23 if ($@) 24 { 25 print STDOUT "Content-type:text/plain\n\n"; 26 print STDOUT "ERROR: $@\n"; 27 exit 0; 28 } 8 29 9 30 … … 109 130 sub authenticate_user 110 131 { 111 112 132 my $gsdl_cgi = shift(@_); 113 133 my $username = shift(@_); … … 244 264 my $installation_status = ""; 245 265 266 print STDOUT "Content-type:text/plain\n\n"; 267 246 268 # Check that Java is installed and accessible 247 269 my $java = $gsdl_cgi->get_java_path(); 248 270 my $java_command = "$java -version 2>&1"; 271 272 # IIS 6: redirecting output from STDERR to STDOUT just doesn't work, so we have to let it go 273 # directly out to the page 274 if ($iis6_mode) 275 { 276 $java_command = "java -version"; 277 } 278 249 279 my $java_output = `$java_command`; 250 280 my $java_status = $?; … … 265 295 266 296 if ($installation_ok) { 267 $gsdl_cgi->generate_ok_message($installation_status . "\nInstallation OK!");297 print STDOUT $installation_status . "\nInstallation OK!"; 268 298 } 269 299 else { 270 $gsdl_cgi->generate_error($installation_status);300 print STDOUT $installation_status; 271 301 } 272 302 } … … 563 593 } 564 594 565 print STDOUT "Content-type:text/plain\n\n";566 595 foreach my $cgi_arg_name ($gsdl_cgi->param) { 567 596 my $cgi_arg_value = $gsdl_cgi->clean_param($cgi_arg_name) || ""; … … 575 604 } 576 605 606 print STDOUT "Content-type:text/plain\n\n"; 607 577 608 my $perl_command = "perl -S $script $perl_args 2>&1"; 609 610 # IIS 6: redirecting output from STDERR to STDOUT just doesn't work, so we have to let it go 611 # directly out to the page 612 if ($iis6_mode) 613 { 614 $perl_command = "perl -S $script $perl_args"; 615 } 616 578 617 my $perl_output = `$perl_command`; 579 618 my $perl_status = $?; … … 582 621 } 583 622 584 print STDOUT "Content-type:text/plain\n\n"; 585 print STDOUT $perl_output; 586 623 if (defined($perl_output)) 624 { 625 print STDOUT $perl_output; 626 } 587 627 } 588 628 … … 728 768 } 729 769 770 print STDOUT "Content-type:text/plain\n\n"; 771 730 772 my $perl_command = "perl -S $script $perl_args 2>&1"; 773 774 # IIS 6: redirecting output from STDERR to STDOUT just doesn't work, so we have to let it go 775 # directly out to the page 776 if ($iis6_mode) 777 { 778 $perl_command = "perl -S $script $perl_args"; 779 } 780 731 781 if (!open(PIN, "$perl_command |")) { 732 782 $gsdl_cgi->generate_error("Unable to execute command: $perl_command"); 733 783 } 734 784 735 print STDOUT "Content-type:text/plain\n\n";736 785 while (defined (my $perl_output_line = <PIN>)) { 737 786 print STDOUT $perl_output_line; … … 799 848 800 849 # Read the uploaded data and write it out to file 850 # We have to pass the size of the uploaded data in the "fs" argument because IIS 6 seems to be 851 # completely incapable of working this out otherwise (causing the old code to crash) 801 852 my $buf; 802 853 my $num_bytes = 0; 854 my $num_bytes_remaining = $gsdl_cgi->clean_param("fs"); 855 my $bytes_to_read = $num_bytes_remaining; 856 if ($bytes_to_read > 1024) { $bytes_to_read = 1024; } 803 857 binmode(FOUT); 804 while (read(STDIN, $buf, 1024) > 0) {858 while (read(STDIN, $buf, $bytes_to_read) > 0) { 805 859 print FOUT $buf; 806 860 $num_bytes += length($buf); 861 $num_bytes_remaining -= length($buf); 862 $bytes_to_read = $num_bytes_remaining; 863 if ($bytes_to_read > 1024) { $bytes_to_read = 1024; } 807 864 } 808 865 close(FOUT);
Note:
See TracChangeset
for help on using the changeset viewer.