[ back to toc ]

cgi script error

Date: 2002/06/18 11:02

Q:
Script error 500.

Affiliate signup program.

Was working flawlessly, attempted a minor change and now can't get it
working, and can't see an error.

Script follows:

#!/usr/bin/perl
##########################################################################
##
# Simple Affiliate 2.0 - Simple Mail 2.0

# Disclaimer
#
# By using the script(s), you agree and understand that
# the writers are not responsible for any damages caused under any
# conditions due to the malfunction or bugs from the script(s). Please
# use at your own risk.
#
##########################################################################
##

### Location of sendmail on your server.
$mailprog = "/usr/sbin/sendmail";

### List of referers this script will accept
@referers = ('bizmaxusa.net');

### Add your email address below leaving the "\"
$youremail = "affilates\@bizmaxusa.net";

#####################################################
### DO NOT EDIT ANYTHING BELOW THIS LINE ###
#####################################################

## Check the Refering URL
&CheckReferer;

## Parse the Form Contents
&ParseForm;

## Assign an Order Number
&AssignOrder;

## Get the Current Time
&GetTime;

## Send E-Mail
&SendMail;

## Send Reply
&SendReply;

## Redirect User
&Redirect;

#####################################################
### Check Referring URL ###
#####################################################

sub CheckReferer {
$x = 0;
if ($ENV{'HTTP_REFERER'}) {
foreach $referers (@referers) {
if ($ENV{'HTTP_REFERER'} =~ /$referer/g) { $x = 1; }
} }
else { $x = 1; }

if ($x ne 1) { &Error('Refering URL Not In List'); }

}

#####################################################
### PARSE THE FORM CONTENTS ###
#####################################################

sub ParseForm {

read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
@pairs = split(/&/, $buffer);

foreach $pair (@pairs) {
($name, $value) = split(/=/, $pair);
$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$value =~ s/~!/ ~!/g;
if ($in{$name}) { $value = $in{$name}.", ".$value; }
$in{$name} = $value;
}

foreach $key (keys (%in)) {
if (($key =~ /^req-/i) && ($in{$key} eq '')) { &Error('Field '.$key.' is
required'); }
elsif ($key =~ /^mailto/g) { push (@mailto, $in{$key}); }
}

if ($in{'req-email'} eq '') { $im{'req-email'} = "$youremail"; }
if ($in{'req-name'} eq '') { $in{'req-name'} = "Affiliate Program"; }
if ($in{'req-subject'} eq '') { $in{'req-subject'} = "New Simple
Affiliate"; }
if ($in{'template'} eq '') { &Error('No template file specified'); }
if ($in{'mailto'} eq '') { &Error('No recipient e-mail address
specified'); }

}

#####################################################
### ASSIGN AN ORDER NUMBER ###
#####################################################

sub AssignOrder {
if (-e, 'counter.dat') {
open (FILE, 'counter.dat');
$count = <FILE>; close (FILE);
}

$count = 0 if $count eq '';
$count++; $order = $count;

open (FILE, ">counter.dat");
print FILE $count;
close (FILE);
}

#####################################################
### GET THE CURRENT TIME ###
#####################################################

sub GetTime {

($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime
(time);
@rtime = ($hour, $min, $mon, $mday, $year);
$rtime[2]++;

if (length($rtime[0]) < 2) { $rtime[0] = '0' . $rtime[0]; }
if (length($rtime[1]) < 2) { $rtime[1] = '0' . $rtime[1]; }

%time_month = ('1'=>'January', '2'=>'February', '3'=>'March',
'4'=>'April', '5'=>'May', '6'=>'June', '7'=>'July',
'8'=>'August', '9'=>'September', '10'=>'October',
'11'=>'November', '12'=>'December');

$rtime[4] += 1900;

$time = "$rtime[0]:$rtime[1], on $time_month{$rtime[2]} $rtime[3],
$rtime[4]";

}

#####################################################
### SEND THE MESSAGE ###
#####################################################

sub SendMail {
if (!-e $in{'template'}) { &Error('Unable to open template file'); }
open (FILE, $in{'template'});
while (<FILE>) { $template .= $_; }
close (FILE);

foreach $key (keys (%in)) {
my $svar = '\['.$key.'\]';
my $rvar = $in{$key};
$template =~ s/$svar/$rvar/g;
}
$template =~ s/\[order]/$order/g;

foreach $addr (@mailto) {
next if $addr !~ /.*\@.*\..*/;
open (MAIL, "|$mailprog -t") || &Error('Unable to open sendmail');
print MAIL "To: $addr\n";
print MAIL "From: $in{'req-email'} ($in{'req-name'})\n";
print MAIL "Subject: $in{'req-subject'}\n\n";

print MAIL "This form was submitted at $time by $in{'req-name'}
($in{'req-email'}).";
print MAIL "Their IP Address at the time of submission was
$ENV{'REMOTE_ADDR'}\n";
print MAIL
"------------------------------------------------------------\n\n";
print MAIL "Order Number \= $order\n\n";
print MAIL $template;
close (MAIL);
}

}

#####################################################
### SEND THE USER A REPLY ###
#####################################################

sub SendReply {
if ($in{'rtemplate'}) {
open (REPLY, $in{'rtemplate'});
while (<REPLY>) { $reply .= $_; }
close (REPLY);

foreach $key (keys (%in)) {
my $svar = '\['.$key.'\]';
my $rvar = $in{$key};
$reply =~ s/$svar/$rvar/g;
}
$reply =~ s/\[order]/$order/g;
open (MAIL, "|$mailprog -t") || &Error('Unable to open sendmail');
print MAIL "To: $in{'req-email'}\n";
print MAIL $reply;
close (MAIL);

}
}

#####################################################
### REDIRECT THE USER ###
#####################################################

sub Redirect {
if ($in{'success'}) {
# print "Location: $in{'success'}\n\n";
if (!-e $in{'success'}) { &Error('Unable to open success file'); }
open (FILE, $in{'success'});
while (<FILE>) { $success .= $_; }
close (FILE);
foreach $key (keys (%in)) {
my $svar = '\['.$key.'\]';
my $rvar = $in{$key};
$success =~ s/$svar/$rvar/g;
}
$success =~ s/\[order]/$order/g;
print "Content-type: text/html\n\n";
print "$success";
}
else {
print "Content-type: text/html\n\n";
print qq!
<html>
<head>
<title>Thank You</title>
</head>

<body>
<h3>Thank You For Your Submission. <br>
Your message has been sent successfully</h3>

</body>
</html>!;
}

}

#####################################################
### ERROR HANDELING SUB ###
#####################################################

sub Error {
my ($err) = @_;

print "Content-type: text/html\n\n";
print qq!
<html>
<head>
<title>Error</title>
</head>

<body>
<font face="arial" size=4><b>Error</b></font><br>
<font face="arial" size=2><b>$err</b></font>

</body>
</html>!;

exit;
}
## END
A:
First of all I recommend that you read

http://peter.verhas.com/tutorials/InternalServerError.html

to see the possible reasons for the error 500 and debug tricks for this
type of error.

Other than that:

Sorry, but I can not take the task to debug all your code. If you could
point out what the change was I could help you probably.

regards,
Peter

[ back to toc ]