PERL CGI Beginners - Formmail

Author

Formmail - Help

Angela Parkes

2004-05-22, 11:32 am

Good Morning,

I've developed an order form at
www.bettergolfwithoutpractice.com/orderform.htm. I have used Web Express as
it creates its own .cgi script but can't get it working. I've changed the
perl bin to usr/bin/perl and the sendmail to /usr/sbin/sendmail. It gives
me the following error message:

System Error
The system is not responding, and the form could not be processed. Please
try again later.
Thank you for taking the time to fill out the form. Sorry for the
inconvenience!

This error is generated from the mvforms.cgi script that Web Express
created. Is there anyone out there who can help? I would be glad to pay
for the service. I've inserted the .cgi script below for your information.

Thanks.

Angela Parkes

#!/usr/bin/perl -w
#the perl path may need to be set if your web host is running Un*x

my ($mail_program) = "/usr/sbin/sendmail -t";
#the mail path may also need to be set on Un*x

my ($smtp_server) = "smtp.intra.mvd.com";
# On NT systems the smtp server name needs to be set here.

use Env;

#
# MVForms.cgi - A form response script for use with WebExpress.
# Copyright 1997 MicroVision Development, Inc.
# Special thanks to Selena Sol and Sanford Morton
# for examples and explanations. Thanks to William Mussatto
# for posting the sendmail.pl script on the Win32-Perl-Web list,
# and to C. Mallwitz for writing it.
#
# Permission is granted to use, modify and distribute
# this script, so long as this copyright section is
# included intact.
#

# This script gives the option of using Un*x sendmail on systems that
# have it available. To use the perl sendmail that is built in
# access to an SMTP server is required.

my (%in);

# Instructions page
# Used if the page owner forgets to supply .email_target hidden tag
my $instructions_url =
"http://www.halcyon.com/sanford/cgi/web2mail/index.html";

#
# Program Begins Here
#

# parse the form data
&ReadParse;

#
# Check required fields were filled by the user
#
if ($in{'.required'}) {
&Compulsory;
}

#
# set the current date
#
my $current_date = &get_date;

#
# if it is a redirect menu, jump
#
if ( $in{'.form_type'} eq "jump" )
{
&jump_url;
}

#
# Otherwise, send an email response
#

#
# Check for required hidden fields
#
if ( !$in{'.email_dest'} )
{
&usage("the email desitination field (<I>.email_dest</I> )");
}

if ( ! $in{'.intro'} )
{
&usage("the intro for the response (<I>.intro</I> )");
}

if ( ! $in{'.subject'} )
{
&usage("the subject for the response (<I>.intro</I> )");
}

#
# send the response
#
&send_response;

#
# Redirect to acknowledgement page
#
&send_acknowledgement;

exit;

######################################
# generic acknowledgement page
#
sub send_thanks_page
{
my $thanks_page;

#******************** CUSTOMIZABLE TEXT ********************
$thanks_page = "Content-type: text/html\n\n";
$thanks_page .= "<TITLE>Form Acknowledgement</TITLE>";
$thanks_page .= "<H2>Thank You</H2>";
$thanks_page .= "Your information has been submitted to ";
$thanks_page .= "<A
HREF=\"mailto:$in{'.email_dest'}\">$in{'.email_dest'}</A>.<p>\n";
$thanks_page .= "Thank you for taking the time to fill out the
form!<br>\n";

if ( $in{'.back_to_url'} )
{
$thanks_page .=
"<P>Return to <A
HREF=\"$in{'.back_to_url'}\">$in{'.back_to_url'}</A>";
}

print $thanks_page;

#Debug paw 12/17/97
# foreach $key (sort keys %in) {
# print $key, "=",$in{$key}, "<br>\n";
# }

}

######################################
# Send an acknowledgement
#
sub send_acknowledgement
{
# Get address of page that we came from and strip page name
$ENV{'HTTP_REFERER'} =~ m[(.+/)];
my ($new_url) = $1;

if ( $in{'.thanks_url'} )
{
print "Location: $new_url$in{'.thanks_url'}\n\n";
}
else
{
&send_thanks_page;
}
}

######################################
# general usage routine
#
sub usage
{
my $usage_error = @_;
my $usage_body;

$usage_body = "Content-type: text/html\n\n";
$usage_body .= "<H2> Form Processing Error </H2>";
$usage_body .= "<TITLE> Form Processing Error </TITLE>";
$usage_body .= "You have forgotten to include <B>$usage_error</B> in your
form. ";
$usage_body .= "Please correct the problem in your form, and try again. ";
$usage_body .= "<P>The following fields were included in your form: <OL>";

foreach (keys %in)
{
$usage_body .= "<LI>$_: $in{$_}\n";
}

$usage_body .= "</OL>Press the <B>BACK</B> button to return to the
submitting form.";

print $usage_body;
exit;
}

######################################
# send repsonse
#
sub send_response
{
#my ($email_body, $client_email, $form_name, $item, $ro_elem, $key);
my (@resp_ordr);

$email_body = $in{'.intro'} ? "$in{'.intro'}\n\n"
: "The following data has been submitted:\n\n";

# added functionality to allow users to specify fields and order using the
# .remove_indexing key and the .response_order hidden field.
if (!$in{'.remove_indexing'} and $in{'.response_order'})
{
# split them out of the list in the value field
@resp_ordr = split (/;/, $in{'.response_order'});

foreach $ro_elem (@resp_ordr)
{
# format the text and add it to the mail message
$form_name = &format_text_field("$ro_elem:");
$item = "$form_name $in{$ro_elem}";

# if multiple values, indent them on new lines
$item =~ s/\0/"\n\t".(" "x(2+length($_)))/ge;

$email_body .= "\t $item \n";

# grab the mail address and save it
if ($ro_elem =~ /.*(email).*|.*(e-mail).*/i)
{
$client_email = $in{$ro_elem};
}
}
}
else
{
foreach (sort keys %in)
{
# skip fields beginning with a period (hidden fields)
next if /^\./;

# save client email for return address
if ( $_ eq "zzClientEmail" )
{
$client_email = $in{$_};
}

# don't list the send and clear buttons
if ( $_ eq "xxSend" )
{
next;
}

if ( $_ eq "xxClear" )
{
next;
}

$form_name = &format_text_field("$_:");
$item = "$form_name $in{$_}";

if ( $in{'.remove_indexing'} )
{
$item =~ s/^..//;
}

# if multiple values, indent them on new lines
$item =~ s/\0/"\n\t".(" "x(2+length($_)))/ge;

$email_body .= "\t $item \n";
}
}

#******************** CUSTOMIZABLE TEXT ********************
$email_body .= "\nSubmitted on: $current_date";
$email_body .= "\nForm page: $ENV{HTTP_REFERER}";
$email_body .= "\nUser address: $ENV{REMOTE_ADDR}";
$email_body .= "\nUser host: $ENV{REMOTE_HOST}";

$in{'.email_dest'} =~ s/,.*//;

if ($ENV{OS} eq "Windows_NT") {
&sendmail($client_email,
$client_email,
$in{'.email_dest'},
$smtp_server,
$in{'.subject'},
$email_body);
}
else {
&send_mail ($client_email,
$in{'.email_dest'},
$in{'.subject'},
$email_body);
}
}

######################################
# mail open error message
#
sub print_error_page
{
my $error_page;

#******************** CUSTOMIZABLE TEXT ********************
$error_page = "Content-type: text/html\n\n";
$error_page .= "<TITLE> System Error </TITLE>";
$error_page .= "<H2> System Error </H2>";
$error_page .= "The system is not responding, and the form could not be
processed. ";
$error_page .= "Please try again later.";
$error_page .= "<P>Thank you for taking the time to fill out the form. ";
$error_page .= "Sorry for the inconvenience!";

if ( $in{'.back_to_url'} )
{
$error_page .=
"<P>Return to <A
HREF=\"$in{'.back_to_url'}\">$in{'.back_to_url'}</A>";
}

print $error_page;
}

######################################
# send mail containing the form data
#

sub send_mail
{
my ($mail_program, $fromuser, $email_address, $subject, $message) = @_;

if ( !open(MAIL, "|$mail_program") )
{
&print_error_page;
exit;
}

# $response = "To: $email_address"; # this section
# $response .= "From: $fromuser"; # previously commented out.
# $response .= "Subject: $subject"; #
# $response .= "\n\n$message\n.\n"; #
##
# print MAIL $response; #

print MAIL <<__END_OF_MAIL__;
To: $email_address
From: $fromuser
Subject: $subject

$message

__END_OF_MAIL__

close (MAIL);
}

######################################
# Parse the cgi form data.
# Adapted from cgi-lib.pl by S.E.Brenner@bioc.cam.ac.uk
# Copyright 1994 Steven E. Brenner
#
sub ReadParse {

local (*in) = @_ if @_;
my ($i, $key, $val);

if ( $ENV{'REQUEST_METHOD'} eq "GET" ) { # replaced his MethGet function
## don't accept GET, to make it a little harder to spoof the script
print "Content-type: text/html\n\n";
print "Sorry, this script only accepts METHOD=POST. ";
print "Use that inside your <FORM ...> tag";
exit;
} elsif ($ENV{'REQUEST_METHOD'} eq "POST") {
read(STDIN,$in,$ENV{'CONTENT_LENGTH'});
} else {
# Added for command line debugging
# Supply name/value form data as a command line argument
# Format: name1=value1\&name2=value2\&... (need to escape & for
shell)
# Find the first argument that's not a switch (-)
$in = ( grep( !/^-/, @ARGV )) [0];
$in =~ s/\\&/&/g;
}
@in = split(/&/,$in);

foreach $i (0 .. $#in) {
# Convert plus's to spaces
$in[$i] =~ s/\+/ /g;

# Split into key and value.
($key, $val) = split(/=/,$in[$i],2); # splits on the first =.

# Convert %XX from hex numbers to alphanumeric
$key =~ s/%(..)/pack("c",hex($1))/ge;
$val =~ s/%(..)/pack("c",hex($1))/ge;

# Associate key and value
# \0 is the multiple separator
$in{$key} .= "\0" if (defined($in{$key}));
$in{$key} .= $val;
}
return length($in);
}

#####################################
sub format_text_field
{
my($value) = @_;

return($value . substr((" " x 25), length($value)));
}

######################################
# jump to URL destination
#
sub jump_url
{
my $dest;

# look for destination field
foreach (keys %in)
{
next if /^\./; # skip hidden form data in mail message

if ( $_ eq "Destination" )
{
$dest = $in{$_};
}
}

# could check destination here
print "Location: $dest\n\n";
exit;
}

######################################
sub get_date
{
my ($sec,$min,$hour,$mday,$mon,$year,$wday,
$yday,$isdst
,$date, $current_century);
my (@days, @months);

$current_century = 20;

@days = ('Sunday','Monday','Tuesday','Wednesday'
,'Thursday',
'Friday','Saturday');

@months = ('January','February','March','April','M
ay','June','July',
'August','September','October','November
','December');

($sec,$min,$hour,$mday,$mon,$year,$wday,
$yday,$isdst) = localtime(time);

if ($hour < 10)
{
$hour = "0$hour";
}

if ($min < 10)
{
$min = "0$min";
}

if ($sec < 10)
{
$sec = "0$sec";
}

$year = ($current_century-1) . "$year";
$date = "$days[$wday], $months[$mon] $mday, $year at $hour\:$min\:$sec";

return $date;
}

#---------------------------------------------------------------------------
# sub sendmail()
# Modified 10-20-1997 to not send blank fields.
#
# send/fake email around the world ...
#
# Version : 1.21
# Environment: Hip Perl Build 105 NT 3.51 Server SP4
# Environment: Hip Perl Build 110 NT 4.00
#
# arguments:
#
# $from email address of sender
# $reply email address for replying mails
# $to email address of reciever
# (multiple recievers can be given separated with space)
# $smtp name of smtp server (name or IP)
# $subject subject line
# $message (multiline) message
#
# return codes:
#
# 1 success
# -1 $smtphost unknown
# -2 socket() failed
# -3 connect() failed
# -4 service not available
# -5 unspecified communication error
# -6 local user $to unknown on host $smtp
# -7 transmission of message failed
# -8 argument $to empty
#
# usage examples:
#
# print
# sendmail("Alice <alice\@company.com>",
# "alice\@company.com",
# "joe\@agency.com charlie\@agency.com",
# $smtp, $subject, $message );
#

# or
#
# print
# sendmail($from, $reply, $to, $smtp, $subject, $message );
#
# (sub changes $_)
#
#------------------------------------------------------------
1;

use Socket;
use IO::Handle;

sub sendmail
{
my ($from, $reply, $to, $smtp, $subject, $message) = @_;

my ($fromaddr) = $from;
my ($replyaddr) = $reply;

$to =~ s/[ \t]+/, /g; # pack spaces and add comma
$fromaddr =~ s/.*<([^\s]*?)>/$1/; # get from email address
$replyaddr =~ s/.*<([^\s]*?)>/$1/; # get reply email address
$replyaddr =~ s/^([^\s]+).*/$1/; # use first address
$message =~ s/^\./\.\./gm; # handle . as first character
$message =~ s/\r\n/\n/g; # handle line ending
$message =~ s/\n/\r\n/g;
$smtp =~ s/^\s+//g; # remove spaces around $smtp
$smtp =~ s/\s+$//g;

if (!$to)
{
return(-8);
}

my($proto) = (getprotobyname('tcp'))[2];
my($port) = (getservbyname('smtp', 'tcp'))[2];

my($smtpaddr) = ($smtp =~
/^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/)
? pack('C4',$1,$2,$3,$4)
: (gethostbyname($smtp))[4];

if (!defined($smtpaddr))
{
return(-1);
}

if (!socket(S, AF_INET, SOCK_STREAM, $proto))
{
return(-2);
}

if (!connect(S, pack('Sna4x8', AF_INET, $port, $smtpaddr)))
{
return(-3);
}

S->autoflush(1);

$_ = <S>;
if (/^[45]/)
{
close(S);
return(-4);
}

print S "helo localhost\r\n";
$_ = <S>;
if (/^[45]/)
{
close(S);
return(-5);
}

print S "mail from: <$fromaddr>\r\n";
$_ = <S>;
if (/^[45]/)
{
close(S);
return(-5);
}

foreach (split(/, /, $to))
{
print S "rcpt to: <$_>\r\n";
$_ = <S>;
if (/^[45]/){
close(S);
return(-6);
}
}

print S "data\r\n";
$_ = <S>;
if (/^[45]/){
close S;
return(-5);
}

print S "To: $to\r\n";
print S "From: $from\r\n";
print S "Reply-to: $replyaddr\r\n" if $replyaddr;
print S "X-Mailer: Perl sendmail Version 1.21\r\n";
print S "Subject: $subject\r\n\r\n";
print S "$message";
print S "\r\n.\r\n";

$_ = <S>;
if (/^[45]/){
close(S);
return(-7);
}

print S "quit\r\n";
$_ = <S>;

close(S);
return(1);
}

############################
#
# sub Compulsory
#
# Check that the fields in the form that are required to be
# filled are filled. Compulsory fields are listed in the
# .required hidden field, semi-colon separated.
#
sub Compulsory {
my (@required, $elem, $error, $key);

#split them out of the list in the value field
@required = split (/;/, $in{'.required'});

#check that each required field name keys to data in the input hash
foreach $elem (@required) {
foreach $key (keys %in) {
next if ($key ne $elem);
#the required field and the key match, so check that there is data
if (!$in{$elem}) {
$printkey = $elem;
$printkey =~ s/^..//;
$error .= ("<li>The $printkey field must be filled.<p>\n");
}
}
}

if ($error) {
#kick them to a page telling them what was blank
#use back button to get back to the form.

my ($error_page);

#******************** CUSTOMIZABLE TEXT ********************
$error_page = "Content-type: text/html\n\n";
$error_page .= "<head><TITLE>Form Entries Incomplete or
Invalid</TITLE></head>\n<body><p>\n";
$error_page .= "<hr>\n<H3>Form Entries Incomplete or Invalid</H3>\n";
$error_page .= "One or more problems exist with the data you have
entered.<UL>\n";
$error_page .= $error;
$error_page .= "</UL>Please use the <I>Back</I> button on your web browser
to
return to the form and correct the listed
problems.<P><HR></BODY></HTML>";

print $error_page;
exit;
}
}

Troubador

2004-05-22, 11:32 am

On Sun, 18 Apr 2004 15:14:03 +0000, Angela Parkes wrote:

> Good Morning,

Hello, Angela.

> I've developed an order form at
> www.bettergolfwithoutpractice.com/orderform.htm. I have used Web Express as
> it creates its own .cgi script but can't get it working. I've changed the
> perl bin to usr/bin/perl and the sendmail to /usr/sbin/sendmail. It gives
> me the following error message:
>
> System Error
> The system is not responding, and the form could not be processed. Please
> try again later.
> Thank you for taking the time to fill out the form. Sorry for the
> inconvenience!

The error is coming from the following portion of your code (line 311-319):

=====
sub send_mail
{
my ($mail_program, $fromuser, $email_address, $subject, $message) = @_;

if ( !open(MAIL, "|$mail_program") )#<== here's where your error
occurs
{
&print_error_page; # <== here's where you get the error page
exit;
}
=====

So the problem is coming from $mail_program, which is defined on line 4.
Three things could be the problem here (probably more, but I can think of
three), listed below in order of likeliness.

Make sure that you are using a unix/linux server, which may very
likely be the problem (if you're on Windows, you'll need to look into line
7, which defines $smtp_server). If you _are_ using a *nix server, then you
either don't have permission to access sendmail (you'll need to beg the
administrator to allow you to use it), or sendmail has been moved to
another directory (you'll need to ask the administrator where sendmail is).

Hope that helps!

/troubador

Sponsored Links