Perl frome processor debug

[quebasic2]

I am sure that I have the right paths to the perl bin and the sendmail, but my form processor does not work. My editor says that the codeing is correct, but the webserver gives me an error. Unfortunately it does not say what line the error is on. Could someone please look over the code and see what they find? Thanks


#!/usr/bin/perl
&CheckReferingURL;
&ParseForm;
&GetDate;
&SendSubmission;
&SendAutoReply;
if ($Country == "United States of America&quot{
$Kissingball_Shipping="2.00";
$Wreath_Shipping="8.50";
}else{
$Kissingball_Shipping="3.50";
$Wreath_Shipping="11.00";
}
$First_Name = param('First_Name');
$Middle_Initial = param('Middle_Initial');
$Last_Name = param('Last_Name');
$Country = param('Country');
$Address = param('Address');
$City = $Config{'City');
$State_or_Province = param('State_or_Province');
$Zip_or_Postal = param('Zip_or_Postal');
$Phone_Number = param('$Phone_Number');
$Email = param('Email');
$Pay_Option = param('Pay_Option');
$Red = param('Red');
$Red_Traditional = param('Red_Traditional');
$Red_Non_Traditional= param('Red_Non_Traditional');
$Blue = param('Blue');
$Blue_Traditional = param('Blue_Traditional');
$Blue_Non_Traditional = param('Blue_Non_Traditional');
$Mauve = param('Mauve');
$Mauve_Traditional = param('Mauve_Traditional');
$Mauve_Non_Traditional = param('Mauve_Non_Traditional');
$Teasel_Teasers = param('Teasel_Teasers');
$Amount_of_Teasel_Teasers = param('Amount_of_Teasel_Teasers');
$Comments = param('Comments');
$Name = "$First_Name $Middle_Initial $Last_Name";
$Wreath_Price="25.00";
$Kissingball_Price="3.00";
$Computer_Name=$ENV{REMOTE_ADDR};
$Browser=$ENV{HTTP_USER_AGENT};
$Referrer=$ENV{HTTP_REFERER};
$email_address="wreath2you\@yahoo.com";
$subject="!!FORM FILLOUT!!";
$autoresponse="yes";
$company_name="Wreath2you";
if ($Red_Traditional == "&quot{$Red_Traditional = "0";}
if ($Red_Non_Traditional == "&quot{$Red_Non_Traditional = "0";}
if ($Blue_Traditional == "&quot{$Blue_Traditional = "0";}
if ($Blue_Non_Traditional == "&quot{$Blue_Non_Traditional = "0";}
if ($Mauve_Traditional == "&quot{$Mauve_Traditional = "0";}
if ($Mauve_Non_Traditional == "&quot{$Mauve_Non_Traditional = "0";}
if ($Amount_of_Teasel_Teasers == "&quot{$Amount_of_Teasel_Teasers = "0";}
$Red_Shipping = ($Red_Traditional+$Red_Non_Traditional)*$Wreath_Shipping;
$Red_Price = ($Red_Traditional+$Red_Non_Traditional)*$Wreath_Price;
$Red_Subtotal_Raw_Data = $Red_Price + $Red_Shipping;
$Red_Subtotal = sprintf("%.2f",$Red_Subtotal_Raw_Data);
1 while $Red_Subtotal =~ s/^(\d+)(\d{3})/$1,$2/;
$Red_Subtotal = "\$" . $Red_Subtotal;
$Red_Subtotal = sprintf("%9s\n", $Red_Subtotal);
$Red_Shipping = sprintf("%.2f",$Red_Shipping);
1 while $Red_Shipping =~ s/^(\d+)(\d{3})/$1,$2/;
$Red_Shipping = "\$" . $Red_Shipping;
$Red_Shipping = sprintf("%9s\n", $Red_Shipping);
$Red_Price = sprintf("%.2f",$Red_Price);
1 while $Red_Price =~ s/^(\d+)(\d{3})/$1,$2/;
$Red_Price = "\$" . $Red_Price;
$Red_Price = sprintf("%9s\n", $Red_Price);
if ($Red == "Yes&quot{
$Order_Red="
Red:
Traditionals: $Red_Traditional
Non-Traditionals: $Red_Non_Traditional
--------------------
Price For Red Wreaths: $Red_Price
Shipping For Red Wreaths: $Red_Shipping
Subtotal: $Red_Subtotal
";
} else {$Order_Red="";}
$Blue_Shipping = ($Blue_Traditional+$Blue_Non_Traditional)*$Wreath_Shipping;
$Blue_Price = ($Blue_Traditional+$Blue_Non_Traditional)*$Wreath_Price;
$Blue_Subtotal_Raw_Data = $Blue_Price + $Blue_Shipping;
$Blue_Subtotal = sprintf("%.2f",$Blue_Subtotal_Raw_Data);
1 while $Blue_Subtotal =~ s/^(\d+)(\d{3})/$1,$2/;
$Blue_Subtotal = "\$" . $Blue_Subtotal;
$Blue_Subtotal = sprintf("%9s\n", $Blue_Subtotal);
$Blue_Shipping = sprintf("%.2f",$Blue_Shipping);
1 while $Blue_Shipping =~ s/^(\d+)(\d{3})/$1,$2/;
$Blue_Shipping = "\$" . $Blue_Shipping;
$Blue_Shipping = sprintf("%9s\n", $Blue_Shipping);
$Blue_Price = sprintf("%.2f",$Blue_Price);
1 while $Blue_Price =~ s/^(\d+)(\d{3})/$1,$2/;
$Blue_Price = "\$" . $Blue_Price;
$Blue_Price = sprintf("%9s\n", $Blue_Price);
if ($Blue == "Yes&quot{
$Order_Blue="
Blue:
Traditionals: $Blue_Traditional
Non-Traditionals: $Blue_Non_Traditional
--------------------
Price For Blue Wreaths: $Blue_Price
Shipping For Blue Wreaths: $Blue_Shipping
Subtotal: $Blue_Subtotal
";
} else {$Order_Blue="";}
$Mauve_Shipping = ($Mauve_Traditional+$Mauve_Non_Traditional)*$Wreath_Shipping;
$Mauve_Price = ($Mauve_Traditional+$Mauve_Non_Traditional)*$Wreath_Price;
$Mauve_Subtotal_Raw_Data = $Mauve_Price + $Mauve_Shipping;
$Mauve_Subtotal = sprintf("%.2f",$Mauve_Subtotal_Raw_Data);
1 while $Mauve_Subtotal =~ s/^(\d+)(\d{3})/$1,$2/;
$Mauve_Subtotal = "\$" . $Mauve_Subtotal;
$Mauve_Subtotal = sprintf("%9s\n", $Mauve_Subtotal);
$Mauve_Shipping = sprintf("%.2f",$Mauve_Shipping);
1 while $Mauve_Shipping =~ s/^(\d+)(\d{3})/$1,$2/;
$Mauve_Shipping = "\$" . $Mauve_Shipping;
$Mauve_Shipping = sprintf("%9s\n", $Mauve_Shipping);
$Mauve_Price = sprintf("%.2f",$Mauve_Price);
1 while $Mauve_Price =~ s/^(\d+)(\d{3})/$1,$2/;
$Mauve_Price = "\$" . $Mauve_Price;
$Mauve_Price = sprintf("%9s\n", $Mauve_Price);
if ($Mauve == "Yes&quot{
$Order_Mauve="
Mauve:
Traditionals: $Mauve_Traditional
Non-Traditionals: $Mauve_Non_Traditional
--------------------
Price For Mauve Wreaths: $Mauve_Price
Shipping For Mauve Wreaths: $Mauve_Shipping
Subtotal: $Mauve_Subtotal
";
} else {$Order_Mauve="";}
$Teaser_Price = $Amount_of_Teasel_Teasers * $Kissingball_Price;
$Teaser_Shipping = $Amount_of_Teasel_Teasers * $Kissingball_Shipping;
$Teaser_Subtotal_Raw_Data = $Teaser_Price + $Teaser_Shipping;
$Teaser_Subtotal = sprintf("%.2f",$Teaser_Subtotal_Raw_Data);
1 while $Teaser_Subtotal =~ s/^(\d+)(\d{3})/$1,$2/;
$Teaser_Subtotal = "\$" . $Teaser_Subtotal;
$Teaser_Subtotal = sprintf("%9s\n", $Teaser_Subtotal);
$Teaser_Shipping = sprintf("%.2f",$Teaser_Shipping);
1 while $Teaser_Shipping =~ s/^(\d+)(\d{3})/$1,$2/;
$Teaser_Shipping = "\$" . $Teaser_Shipping;
$Teaser_Shipping = sprintf("%9s\n", $Teaser_Shipping);
$Teaser_Price = sprintf("%.2f",$Teaser_Price);
1 while $Teaser_Price =~ s/^(\d+)(\d{3})/$1,$2/;
$Teaser_Price = "\$" . $Teaser_Price;
$Teaser_Price = sprintf("%9s\n", $Teaser_Price);
if ($Teasel_Teasers == "Yes&quot{
$Order_Teaser="
Teasel Teasers:
Quantity: $Amount_of_Teasel_Teasers
--------------------
Price For Teasle Teaser: $Teaser_Price
Shipping For Teasle Teaser: $Teaser_Shipping
Subtotal: $Teaser_Subtotal
";
} else {$Order_Teaser="";}
$Cost = $Red_Subtotal_Raw_Data+$Blue_Subtotal_Raw_Data+$Mauve_Subtotal_Raw_Data+$Teaser_Subtotal_Raw_Data;
$Cost = sprintf("%.2f",$Cost);
1 while $Cost =~ s/^(\d+)(\d{3})/$1,$2/;
$Cost = "\$" . $Cost;
$Cost = sprintf("%9s\n", $Cost);
$response_subject="Thank You For Ordering!";
$response_mail="Thank you $First_Name $Middle_Initial, $Last_Name for your order of
$Order_Red $Order_Blue $Order_Mauve $Order_Teaser
------------------------

Total Cost: $Cost

Pay Option: $Pay_Option

We will respond as quickly as we can. We hope that you will enjoy our product.

Wreath2you";
$custom_message="
Name: $First_Name $Middle_Initial, $Last_Name
Address:
$Address
$City, $State_or_Province $Zip_or_Postal
$Country

Phone Number: $Phone_Number
Email: $Email

--------------------------------------------------------------

Order:
$Order_Red $Order_Blue $Order_Mauve $Order_Teaser
------------------------

Total Cost: $Cost

Pay Option: $Pay_Option
--------------------------------------------------------------

Comments:
$Comments

--------------------------------------------------------------

SENDER INFO:
IP: $REMOTE_ADDR
Computer Name: $Computer_Name
Browser Type: $Browser
Page Referer: $Referrer

--------------------------------------------------------------";
print "Location: [my thankyou page is here]\n\n";
exit;
sub SendSubmission {
open (MAIL,"|/usr/lib/sendmail -t"
print MAIL "To: [my email address is here]\n";
print MAIL "From: $Email\n";
print MAIL "Subject: !!FORM FILLOUT!!\n";
print MAIL "$Date\n\n";
print MAIL "E-Mail Message\n\n";
print MAIL "From: $Name\n";
print MAIL "Email: $Email\n\n";
print MAIL "$custom_message";
close (MAIL);
}
sub SendAutoReply {
open (MAIL,"|$MailProgram -t"
print MAIL "To: $Email\n";
print MAIL "From: [my email address is here]\n";
print MAIL "Subject: Thanks for ordering!\n";
print MAIL "$\n";
print MAIL "$Date\n\n";
print MAIL "Thanks for you message!\n\n";
print MAIL "$response_mail";
close (MAIL);
}
sub GetDate {
@days = ('Sunday','Monday','Tuesday','Wednesday','Thursday','Friday','Saturday');
@months = ('01','02','03','04','05','06','07','08','09','10','11','12');
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
$year = $year+1900;
$Date = "$days[$wday] $months[$mon]/$mday/$year";
sub CheckReferingURL {
if ($ENV{'HTTP_REFERER'}) {
if ($ENV{'HTTP_REFERER'} =~ "[my website is here]" /i) {
$check_referer = '1';
}}
else {$check_referer = '1';}
if ($check_referer != 1) {
print "Location: [my webpage is here]\n\n";
exit;
}}
exit;
}

 

[icrf]

What exactly is the error message it is reporting? Try adding this line to the top of the script:
[tt]use CGI::Carp qw(fatalsToBrowser);[/tt]
Especially if you're just getting 500-errors, that will wrap up stderr in enough html to see, and I think reports line numbers, too.

----------------------------------------------------------------------------------
...but I'm just a C man trying to see the light

 

[quebasic2]

Oh, I negelected to say that I chmoded the form processor to 755, so that is not the problem. Even with the line you said to add, the weberver only returns:

Internal Server Error
The server encountered an internal error or misconfiguration and was unable to complete your request.
Please contact the server administrator, support@netfirms.com and inform them of the time the error occurred, and anything you might have done that may have caused the error.

More information about this error may be available in the server error log.

Boy, I must have been drunk when I wrote the title of this post!

 

[missbarbell]

This is possibly a permissions problem with the directory your script is running in. Or the extension has not been set correctly to run Perl in the WebServer. If you're running Apache, check the following line in the httpd.conf file:

AddHandler cgi-script .cgi .pl

If your extension is not listed it won't know to use Perl, despite you setting it in the shebang line.

Also I know this might sound a stupid question, but you did put the line icrf mention as the second line? If it comes before the shebang line (#!) that would also cause problems.

On top of this, I would suggest writing the first two lines thus:

#!/usr/bin/perl -w
use strict;

In order to test your code for robustness the warnings and strict messages can help you spot alot of potential problems. Run the code locally if you can and see what happens. It might not be a CGI error that is the problem.

You don't use 'my' to instatiate your variables, which could potentially mean that they could get overwritten elsewhere in your code, if you accidentally use the same name. Its also good coding practice to limit the scope of variables.

Another thing to bear in mind, is that there are alot of dodgy people out there who love nothing to spam useless messages around the net. As a consequence you have to be very careful when writing mailer programs to ensure you check that multiple email address aren't being used.

If $Email =~ /[;,]/; matches, the chances are you've created a spammers dream. If they find it they will exploit it and cause you much grief. Have a look into tainting. It will be some extra work, but it could save you alot of bother in the long run. I have known of ISPs being blacklisted for having bad html2mail forms.

HTH

Barbie
Leader of Birmingham Perl Mongers

http://birmingham.pm.org

 

[quebasic2]

No I did not put that line before the perl path. I do not have the file you mentioned because the server is UNIX. Also, if you look closely, spamers cannot use my email to spam, because I have a referer list, allowing only my website access. I have no way to run the perl scrip locally, and when I downloaded the latest version of perl, I was to stupid to be able to set it up on my system.

 

[missbarbell]

>No I did not put that line before the perl path

Sorry, I just wanted to make sure, as that line can be extremely helpful, when trying to debug CGI scripts.

>I do not have the file you mentioned because the server is UNIX

If you're refering to the httpd.conf file then you maybe surprised to learn that in all likelihood you do have it. The standard web server on virtually every UNIX/Linux server I've ever worked on is Apache, which will run as a demon as either apache or httpd.

>spamers cannot use my email to spam, because I have a referer list, allowing only my website access

The referer only checks the webpage it came from. What if the spammer did use your page, but entered their own email address as half a dozen other email addresses? In your code you make no checks on the field $Email at all.

I'm sorry if the tone of my post sounded a bit harsh, but with the increase in spam over the last couple of years, it's important you protect yourself. If only to ensure you don't get blacklisted or worse having your hosting service suspending your account.

Please do have a look a tainting, as it can help you in the long run. Have a look at the following article for more information:

http://www.perl.com/pub/a/2002/02/20/css.html

Barbie
Leader of Birmingham Perl Mongers

http://birmingham.pm.org