rlindomph
User
Jul 18, 2004, 12:30 AM
Post #4 of 4
(16154 views)
Shortcut
|
|
Re: [Luke] GoForum shows No Output
[In reply to]
|
Can't Post
|
|
I have spend 4 hours today painstakingly troubleshoot through each lines of the goforum.cgi script.
It appears that ever time the GetPage subroutine is called, the script freezes and after 10 minutes gives a 500 error.
I have GoForum 1.09. My server is hypermart. I wonder if the script is not compatible with my webserver since GetPage calls from webserver. I have the same version of yabbse as ThomasK and he seems to get it to work just fine at http://www.motorcyclesearchengine.com/Articles/
HAS ANYONE GET GOFORUM TO WORK WITH HYPERMART?
Version of Perl: 5.6
Version of PHP: 4.3.3
MySQL version 3.23.49
Article manager 1.38
GoForum 1.09
HELP!!! Thanks.
# ----------------------------------------------------------------------------
# Function : GetPage
# Description : Retrieve a page from a webserver and return it
# Usage : $html = &GetPage("www.host.com/index.html");
# ($headers, $html) = &GetPage("http://www.host.com:8080/detail.html?test=1", {
# 'Referer' => 'http://www.host.com:8080/index.html',
# }, %postdata);
# ----------------------------------------------------------------------------
sub GetPage {
my ($url, $send_headers, $post) = @_;
if ($post && ref($post) ne "HASH") { die("Optional third argument must be a hash ref!"); }
### Parse out hostname, optional port, and file
$url =~ s|\w+://||g; # remove http://
my ($host, $port, $file) = $url =~ m|^(.*?)(?::(\d+))?([/?].*)?$|;
$file ||= '/';
### Headers to send
$send_headers->{'User-Agent'} ||= "Mozilla/4.0 (compatible; MSIE 5.0; Windows NT; DigExt)";
$send_headers->{'Host'} ||= $host;
### For post methods get query info
my($query,$query_length,$method,$postdata);
if ($post) {
$postdata = join '&', map { &URL_Encode($_) .'='. &URL_Encode($post->{$_}) } keys %$post;
$send_headers->{'Content-Type'} ||= 'application/x-www-form-urlencoded';
$send_headers->{'Content-Length'} ||= length $postdata;
$method = 'POST';
} else {
$method = 'GET';
}
my($remote, $html, $get_headers);
$remote = IO::Socket::INET->new( Proto => 'tcp', PeerAddr => $host, PeerPort => $port || 80);
unless ($remote) { die 'Can\'t connect to '.$host; } # display error message
$remote->autoflush(1); # unbuffer socket output
print $remote $method.' '.$file.' HTTP/1.0'."\n"; # set http request (just like a browser)
foreach (keys %{$send_headers}) {
print $remote $_ . ': ' . $send_headers->{$_} . "\n"; # send headers
print STDOUT $_ . ': ' . $send_headers->{$_} . "\n"; # send headers
}
print $remote "\n"; # we've finished sending our headers
print $remote $postdata . "\n\n" if $post; # and send our post data if necessary
while (<$remote>) { $html .= $_; } # read socket data
close($remote);
print STDOUT "Postdata: $postdata\n\n";
### Separate headers from HTML, if there's no \n\n, everything ends up in $html
($get_headers, $html) = $html =~ /^(.*?(?:\r\n|\n)(?:\r\n|\n))?(.*)$/s;
$html =~ s/\r\n/\n/sgo; # remove return chars (\r)
if (wantarray) { return ($get_headers, $html); } # return headers and page content
else { return $html; } # return page content
}
# ----------------------------------------------------------------------------
# URL : URL encoding/decoding Perl routines. URL encoding is an common
# encoding scheme where non A-Za-z0-9+*.@_- characters are replaced
# with a character triplet of "%" followed by the two hex digits.
#
# Usage : $URL_encoded = &URL_Encode("$plaintext");
# : $plaintext = &URL_Decode("$URL_encoded");
# ----------------------------------------------------------------------------
sub URL_Encode {
my($text) = $_[0]; # text to URL encode
$text =~ s/([^A-Za-z0-9\*\.\@\_\-])/ # replace odd chars
uc sprintf('%%%02x',ord($1))/egx; # with %hex value
$text =~ tr/ /+/; # replace " " with "+"
return $text; # return URL encoded text
}
sub URL_Decode {
my($text) = $_[0]; # URL encoded text to decode
$text =~ tr/+/ /; # replace "+" with " "
$text =~ s/%([A-F0-9]{2})/pack('C', hex($1))/egi; # replace %hex with chars
return $text; # return decoded plain text
}
# ----------------------------------------------------------------------------
# ReadForm : Read input from CGI form. Parse input from a
# GET or POST form and return a hash of form names and values.
#
# Usage : %in = &ReadForm();
# ----------------------------------------------------------------------------
sub ReadForm {
my($name,$value,$pair,@pairs,$buffer,%hash); # localize variables
my($file,$path,$ext); # localize variables
binmode(STDIN); # for windows systems
### Read GET or POST form into $buffer (for regular forms)
if ($ENV{'REQUEST_METHOD'} eq 'POST') { read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'}); }
elsif ($ENV{'REQUEST_METHOD'} eq 'GET') { $buffer = $ENV{'QUERY_STRING'}; }
@pairs = split(/&/, $buffer); # Split into name/value pairs
foreach $pair (@pairs) { # foreach pair
($name, $value) = split(/=/, $pair); # split into $name and $value
$name =~ tr/+/ /; # replace "+" with " "
$value =~ tr/+/ /; # replace "+" with " "
$name =~ s/%([A-F0-9]{2})/pack('C', hex($1))/egi; # replace %hex with char
$value =~ s/%([A-F0-9]{2})/pack('C', hex($1))/egi; # replace %hex with char
$name =~ s/\r\n/\n/g; # replace \r\n with \n
$value =~ s/\r\n/\n/g; # replace \r\n with \n
$name =~ s/\x00//g; # remove null bytes
$value =~ s/\x00//g; # remove null bytes
$hash{$name} = $value;
}
return %hash;
}
# prevent artman_db from displaying "Undefined subroutine" error messages
sub _error {
die($@);
}
# ------------------------------------------------------------------------
# Function : INI_Load
# Description : load an ini file into a multilevel ini hash
# Usage : %ini = &INI_Load("$cgidir/file.ini");
# ------------------------------------------------------------------------
sub INI_Load {
### Define values
local(*FILE); # localize filehandle
my($file) = $_[0]; # ini file
my(@lines,$ref,%hash); # scope vars
$ref = \%hash; # reference to hash
### Check for errors
if (!$_[0]) { die "INI_Load : No ini file was specified!\n"; }
if (!-e $_[0]) { die "INI_Load : The ini file '$_[0]' could not be found!\n"; }
# Load file
open(FILE,"<$file") || die("INI_Load : Could open ini file! $!\n");
@lines = <FILE>;
close(FILE);
# parse content and create hash
foreach (@lines) {
/^\s*#/m && next; # skip comments
if (/^\s*\[/m) { # process section heading
$ref = \%hash; # reset ref to hash root
foreach (/\[(.+?)\]/g) { # keep moving deeper in multilevel hash
$ref = \%{$ref->{$_}};
}
next;
}
# load keys and value for section
my $pos = index($_,'='); # get name, value
if ($pos > 0) {
my $name = substr($_,0,$pos); # get name
my $value = substr($_,$pos+1); # get value
# added for goforum 1.09 ini file
$value =~ s/#.*//; # next line added to remove righthand comments (like this one)
foreach ($name,$value) { s/^\s+//; s/\s+$//; } # remove leading/trailing whitespace
# added for goforum 1.09 ini file: removes surrounding single / double quotes.
if (index($value, "'")==0 || index($value, "\"")==0) {
$value = substr($value, 1, length($value)-1);
}
if (index($value, "'")==length($value)-1 || index($value, "\"")==length($value)-1) {
$value = substr($value, 0, length($value)-1);
}
$name =~ /[^a-zA-Z\/0-9_\-]/ && die("INI_Load : Invalid key '$name' in ini file '$file'!\n");
defined $ref->{$name} && die("INI_Load : Key '$name' defined twice in ini file '$file'!\n");
$ref->{$name} = $value; # add to hash
}
elsif ($pos == -1) { # assume value of 1 if no value assigned
my $name = $_;
for ($name) { s/^\s+//; s/\s+$//; } # remove leading/trailing whitespace
if (!length $name) { next; }
#`new` - chris - 28/05/2001 3:49PM - we can allow alternate characters in lists, no?
#$name =~ /[^\w]/ && die("INI_Load : Invalid key '$name' in ini file '$file'!\n");
defined $ref->{$name} && die("INI_Load : Key '$name' defined twice in ini file '$file'!\n");
$ref->{$name} = 1; # add to hash
}
}
return %hash; # return hash of ini values
}
# ----------------------------------------------------------------------------
|
