Here is the whole script, which is the basic FormMail.pl I just posted the above because I thought it was the only pertinate segment. I fought with this all weekend to no avail. I am needing sme help, can't get it to work for anything. I think I have tried every combination that I can think of. Any help will be greatly appreciated....
__________________________________________________ _
#!/usr/bin/perl -wT
#
# $Id: FormMail.pl,v 1.91 2002/06/16 07:32:08 nickjc Exp $
#
use strict;
use POSIX qw(locale_h strftime);
use Socket; # for the inet_aton()
use CGI qw(:standard);
use vars qw(
$DEBUGGING $emulate_matts_code $secure
$allow_empty_ref $max_recipients $mailprog @referers
@allow_mail_to @recipients %recipient_alias
@valid_ENV $date_fmt $style $send_confirmation_mail
$confirmation_text $locale $charset
);
# PROGRAM INFORMATION
# -------------------
# FormMail.pl $Revision: 1.91 $
#
# This program is licensed in the same way as Perl
# itself. You are free to choose between the GNU Public
# License <
http://www.gnu.org/licenses/gpl.html> or
# the Artistic License
# <
http://www.perl.com/pub/a/language/misc/Artistic.html>
#
# For help on configuration or installation see the
# README file or the POD documentation at the end of
# this file.
# USER CONFIGURATION SECTION
# --------------------------
# Modify these to your own settings. You might have to
# contact your system administrator if you do not run
# your own web server. If the purpose of these
# parameters seems unclear, please see the README file.
#
BEGIN
{
$DEBUGGING = 1;
$emulate_matts_code= 0;
$secure = 1;
$allow_empty_ref = 1;
$max_recipients = 1;
$mailprog = '/usr/lib/sendmail -oi -t';
@referers = qw(streettuners.com 64.246.15.28 localhost);
@allow_mail_to = qw(editor@streettuners.com localhost);
@recipients = ();
%recipient_alias = ();
@valid_ENV = qw(REMOTE_HOST REMOTE_ADDR REMOTE_USER HTTP_USER_AGENT);
$locale = '';
$charset = 'iso-8859-1';
$date_fmt = '%A, %B %d, %Y at %H:%M:%S';
$style = '0';
$send_confirmation_mail = 0;
$confirmation_text = <<'END_OF_CONFIRMATION';
From:
editor@streettuners.com
Subject: form submission
Thank you for your form submission.
END_OF_CONFIRMATION
#
# USER CONFIGURATION << END >>
# ----------------------------
# (no user serviceable parts beyond here)
use vars qw($VERSION);
$VERSION = substr q$Revision: 1.91 $, 10, -1;
# Merge @allow_mail_to and @recipients into a single list of regexps,
# automatically adding any recipients in %recipient_alias.
push @allow_mail_to,
grep( /@/, split(/\s*,\s*/, join ',', values %recipient_alias) );
push @recipients, map { /\@/ ? "^\Q$_\E\$" : "\@\Q$_\E\$" } @allow_mail_to;
$secure = 0 if $emulate_matts_code;
use vars qw(%valid_ENV);
@valid_ENV{@valid_ENV} = (1) x @valid_ENV;
use vars qw($style_element);
$style_element = $style ?
qq%<link rel="stylesheet" type="text/css" href="$style" />%
: '';
}
use vars qw($done_headers $hide_recipient $debug_warnings);
$done_headers = 0;
$hide_recipient = 0;
$debug_warnings = '';
# We need finer control over what gets to the browser and the CGI::Carp
# set_message() is not available everywhere
# This is basically the same as what CGI::Carp does inside but simplified
# for our purposes here.
BEGIN
{
sub fatalsToBrowser
{
my ( $message ) = @_;
if ( $DEBUGGING )
{
$message =~ s/</</g;
$message =~ s/>/>/g;
}
else
{
$message = '';
}
my ( $pack, $file, $line, $sub ) = caller(1);
my ($id ) = $file =~ m%([^/]+)$%;
return undef if $file =~ /^\(eval/;
print "Content-Type: text/html; charset=$charset\n\n" unless $done_headers;
print <<EOERR;
<?xml version="1.0" encoding="$charset"?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<title>Error</title>
</head>
<body>
<h1>Application Error</h1>
<p>
An error has occurred in the program
</p>
<p>
$message
</p>
</body>
</html>
EOERR
die @_;
};
# Don't stomp on global SIG{__DIE__} if we're sharing an
# interpreter under Apache::Registry
unless (exists $ENV{MOD_PERL}) {
$SIG{__DIE__} = \&fatalsToBrowser;
}
}
local $SIG{__DIE__} = \&fatalsToBrowser;
# We don't need file uploads or very large POST requests.
# Annoying locution to shut up 'used only once' warning in
# older perl. Localize these to avoid stomping on other
# scripts that need file uploads under Apache::Registry.
local ($CGI:
ISABLE_UPLOADS, $CGI::POST_MAX);
$CGI:
ISABLE_UPLOADS = 1;
$CGI::POST_MAX = 1000000;
# Empty the environment of potentially harmful variables,
# and detaint the path. We accept anything in the path
# because $ENV{PATH} is trusted for a CGI script, and in
# general we have no way to tell what should be there.
delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
$ENV{PATH} =~ /(.*)/ and $ENV{PATH} = $1;
use vars qw(%Config %Form);
%Config = ();
%Form = ();
check_url();
eval
{
setlocale(LC_TIME, $locale) if $locale;
};
my $date = strftime($date_fmt, localtime);
my @Field_Order = parse_form();
check_required();
send_mail($date, [@Field_Order]);
return_html($date, [@Field_Order]);
sub check_url {
my $check_referer = check_referer(referer());
error('bad_referer') unless $check_referer;
}
sub check_referer
{
my $check_referer;
my ($referer) = @_;
unless ($referer) {
return 1 if $allow_empty_ref or !$secure;
}
if ($referer && ($referer =~ m!^https?://([^/]*\@)?([\w\-\.]+)!i)) {
my $refHost;
$refHost = $2;
foreach my $test_ref (@referers) {
if ($refHost =~ m|\Q$test_ref\E$|i) {
$check_referer = 1;
last;
}
elsif ( $secure && $test_ref =~ /\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}/ ) {
if ( my $ref_host = inet_aton($refHost) ) {
$ref_host = unpack "l", $ref_host;
if ( my $test_ref_ip = inet_aton($test_ref) ) {
$test_ref_ip = unpack "l", $test_ref_ip;
if ( $test_ref_ip == $ref_host ) {
$check_referer = 1;
last;
}
}
}
}
}
} else {
return 0;
}
return $check_referer;
};
sub parse_form {
my @fields = qw(
recipient
subject
email
realname
redirect
bgcolor
background
link_color
vlink_color
text_color
alink_color
title
sort
print_config
required
env_report
return_link_title
return_link_url
print_blank_fields
missing_fields_redirect
);
@Config{@fields} = (undef) x @fields; # make it undef rather than empty string
my @field_order;
foreach (param()) {
if (exists $Config{$_}) {
my $val = strip_nonprintable(param($_));
next if /redirect$/ and not check_url_valid($val);
next if /^return_link_url$/ and $secure and not check_url_valid($val);
$Config{$_} = $val;
} else {
my @vals = map {strip_nonprintable($_)} param($_);
my $key = strip_nonprintable($_);
$Form{$key} = join ' ', @vals;
push @field_order, $key;
}
}
foreach (qw(required env_report print_config)) {
if ($Config{$_}) {
$Config{$_} =~ s/(\s+|\n)?,(\s+|\n)?/,/g;
$Config{$_} =~ s/(\s+)?\n+(\s+)?//g;
$Config{$_} = [split(/,/, $Config{$_})];
} else {
$Config{$_} = [];
}
}
$Config{env_report} = [ grep { $valid_ENV{$_} } @{$Config{env_report}} ];
if (defined $Config{'sort'}) {
if ($Config{'sort'} eq 'alphabetic') {
@field_order = sort @field_order;
} elsif ($Config{'sort'} =~ /^\s*order:\s*(.*)$/s) {
@field_order = split /\s*,\s*/, $1;
}
}
return @field_order;
}
sub check_required {
my ($require, @error);
defined $Config{subject} or $Config{subject} = '';
defined $Config{recipient} or $Config{recipient} = '';
$Config{subject} =~ s/[\r\n]+/ /g;
$Config{recipient} =~ s/[\r\n]+/ /g;
if (length $Config{recipient}) {
my @valid;
if (exists $recipient_alias{$Config{recipient}}) {
$Config{recipient} = $recipient_alias{$Config{recipient}};
$hide_recipient = 1;
}
foreach (split /,/, $Config{recipient}) {
next unless check_email($_);
if (check_recipient($_)) {
push @valid, $_;
}
}
error('no_recipient') unless scalar @valid;
if ($max_recipients > 0 and not $emulate_matts_code) {
error('too_many_recipients') if scalar @valid > $max_recipients;
}
$Config{recipient} = join ',', @valid;
} else {
my @allow = grep {/\@/} @allow_mail_to;
if (scalar @allow > 0 and not $emulate_matts_code) {
$Config{recipient} = $allow[0];
$hide_recipient = 1;
} else {
error('no_recipient')
}
}
if ($secure and request_method() ne 'POST') {
error('bad_method');
}
foreach (@{$Config{required}}) {
if ($_ eq 'email' && !check_email($Config{$_})) {
push(@error, $_);
} elsif (defined($Config{$_})) {
push(@error, $_) unless length $Config{$_};
} else {
push(@error,$_) unless defined $Form{$_} and length $Form{$_};
}
}
error('missing_fields', @error) if @error;
}
sub check_recipient {
my ($recip) = @_;
foreach my $r (@recipients) {
if ( ($recip =~ /(?:$r)$/) or $emulate_matts_code and ($recip =~ /$r/i) ) {
return(1);
}
}
warn_bad_email($recip, "script not configured to allow this address");
return(0);
}
sub return_html {
my ($date, $Field_Order) = @_;
if ($Config{'redirect'}) {
print redirect $Config{'redirect'};
} else {
print "Content-Type: text/html; charset=$charset\n\n";
$done_headers++;
my $title = escape_html( $Config{'title'} || 'Thank You' );
my $torecipient = 'to ' . escape_html($Config{'recipient'});
$torecipient = '' if $hide_recipient;
my $attr = body_attributes(); # surely this should be done with CSS
print <<EOHTML;
<?xml version="1.0" encoding="$charset"?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<title>$title</title>
$style_element
<style>
h1.title {
text-align : center;
}
</style>
</head>
<body $attr>$debug_warnings
<h1 class="title">$title</h1>
<p>Below is what you submitted $torecipient on $date</p>
<p><hr size="1" width="75%" /></p>
EOHTML
foreach (@$Field_Order) {
my $val = (defined $Form{$_} ? $Form{$_} : '');
if ($Config{print_blank_fields} || $val !~ /^\s*$/) {
print '<p><b>', escape_html($_), ':</b> ',
escape_html($val), "</p>\n";
}
}
print qq{<p><hr size="1" width="75%" /></p>\n};
if ($Config{return_link_url} && $Config{return_link_title}) {
print "<ul>\n";
print '<li><a href="', escape_html($Config{return_link_url}),
'">', escape_html($Config{return_link_title}), "</a>\n";
print "</li>\n</ul>\n";
}
print <<END_HTML_FOOTER;
<hr size="1" width="75%" />
<p align="center">
<font size="-1">
<a href="http://nms-cgi.sourceforge.net/">FormMail</a>
© 2001 London Perl Mongers
</font>
</p>
</body>
</html>
END_HTML_FOOTER
}
}
sub send_mail {
my ($date, $Field_Order) = @_;
my $dashes = '-' x 75;
my $realname = $Config{realname};
if (defined $realname) {
$realname = ' (' . cleanup_realname($realname) . ')';
} else {
$realname = $Config{realname} = '';
}
my $subject = $Config{subject} || 'WWW Form Submission';
if ($secure) {
$subject = substr($subject, 0, 256);
}
my $email = $Config{email};
unless (defined $email and check_email($email)) {
$email = 'nobody';
}
if ("$Config{recipient}$email$realname$subject" =~ /\r|\n/) {
die 'multiline variable in mail header, unsafe to continue';
}
my $xheader = '';
# This is more lenient than that in check_referer() because we
# want to know how people got this far if they are faking it
# however it is probably prudent to restrict to the characters
# valid in a URL - or what ?
if ( $secure and defined (my $referer = referer()) ) {
if ( $referer =~ /([\d\w.:@&%\/;?,-]{1,128})/ ) {
$xheader .= "X-HTTP-Referer: [$1]\n";
}
}
# however if remote_addr() is not pukka then something
# really bad is going on here.
if ( $secure and defined (my $addr = remote_addr()) ) {
$addr =~ /^\[?([\d\.]+)\]?$/ or die "bad remote addr [$addr]";
# The actual name of the program could be useful if there is
# more than one FormMail on the machine with different names.
my ( $realagent ) = $0 =~ m%([\d\w.]+)$%;
$realagent = defined $realagent ? "($realagent)" : '';
$xheader .= "X-HTTP-Client: [$1]\n"
. "X-Generated-By: NMS FormMail.pl $realagent v$VERSION\n";
}
if ( $send_confirmation_mail ) {
open_sendmail_pipe(\*CMAIL, $mailprog);
print CMAIL $xheader, "To: $email$realname\n$confirmation_text";
close CMAIL;
}
open_sendmail_pipe(\*MAIL, $mailprog);
print MAIL $xheader, <<EOMAIL;
To: $Config{recipient}
From: $email$realname
Subject: $subject
Below is the result of your feedback form. It was submitted by
$Config{realname} (${\( $Config{email}||'' )}) on $date
$dashes
EOMAIL
if ($Config{print_config}) {
foreach (@{$Config{print_config}}) {
print MAIL "$_: $Config{$_}\n\n" if $Config{$_};
}
}
foreach (@$Field_Order) {
my $val = (defined $Form{$_} ? $Form{$_} : '');
if ($Config{'print_blank_fields'} || $val !~ /^\s*$/) {
print MAIL "$_: $val\n\n";
}
}
print MAIL "$dashes\n\n";
foreach (@{$Config{env_report}}) {
print MAIL "$_: ", strip_nonprintable($ENV{$_}), "\n" if $ENV{$_};
}
close (MAIL) || die "close mailprog: \$?=$?,\$!=$!";
}
sub open_sendmail_pipe {
my ($fh, $mailprog) = @_;
my $result;
eval { local $SIG{__DIE__};
$result = open $fh, "| $mailprog"
};
if ($@) {
die $@ unless $@ =~ /Insecure directory/;
delete $ENV{PATH};
$result = open $fh, "| $mailprog";
}
die "Can't open $mailprog\n" unless $result;
}
sub cleanup_realname {
my ($realname) = @_;
return '' unless defined $realname;
$realname =~ s#\s+# #g;
if ($secure) {
# Allow no unusual characters and impose a length limit. We
# need to allow extended ASCII characters because they can
# occur in non-English names.
$realname =~ tr# a-zA-Z0-9_\-,./'\200-377##dc;
$realname = substr $realname, 0, 128;
} else {
# Be as generous as possible without opening any known or
# strongly suspected relaying holes.
$realname =~ tr#()\\#{}/#;
}
return $realname;
}
sub check_email {
my ($email) = @_;
return 0 if $email =~ /^\s*$/;
unless ($email =~ /^(.+)\@([a-z0-9_\.\-\[\]]+)$/is) {
warn_bad_email($email, "malformed email address");
return 0;
}
my ($user, $host) = ($1, $2);
if ($host =~ /\.\./) {
warn_bad_email($email, "hostname $host contains '..'");
return 0;
} elsif ($host =~ /^\./) {
warn_bad_email($email, "hostname $host starts with '.'");
return 0;
} elsif ($host =~ /\.$/) {
warn_bad_email($email, "hostname $host ends with '.'");
return 0;
}
if ($emulate_matts_code and not $secure) {
# Be as generous as possible without opening any known or strongly
# suspected relaying holes.
if ($user =~ /([^a-z0-9_\-\.\#\$\&\'\*\+\/\=\?\^\`\{\|\}\~\200-\377])/i) {
my $c = sprintf '%s (ASCII 0x%.2X)', $1, unpack('C',$1);
warn_bad_email($email, "bad character $c");
return 0;
} else {
return 1;
}
} else {
# Only allow reasonable email addresses.
if ($user =~ /([^a-z0-9_\-\.\*\+\=])/i) {
my $c = sprintf '%s (ASCII 0x%.2X)', $1, unpack('C',$1);
warn_bad_email($email, "bad character $c");
return 0;
} elsif (length $user > 100) {
warn_bad_email($email, "username part too long");
return 0;
}
if (length $host > 100) {
warn_bad_email($email, "hostname too long");
return 0;
}
return 1 if $host =~ /^\[\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}\]$/;
return 1 if $host =~ /^[a-z0-9\-\.]+$/i;
warn_bad_email($email, "invalid hostname $host");
return 0;
}
# not reached
return 0;
}
sub warn_bad_email {
my ($email, $whybad) = @_;
$debug_warnings .= <<END if $DEBUGGING;
<p>
<font color="red">Warning:</font>
The email address <tt>${\( escape_html($email) )}</tt> was rejected
for the following reason: ${\( escape_html($whybad) )}
</p>
END
}
# check the validity of a URL.
sub check_url_valid {
my $url = shift;
# allow relative URLs with sane values
return 1 if $url =~ m#^[a-z0-9_\-\.\,\+\/]+$#i;
$url =~ m< ^ (?:ftp|http|https):// [\w\-\.]+ (?:\:\d+)?
(?: / [\w\-.!~*'(|);/\@+\$,%#]* )?
(?: \? [\w\-.!~*'(|);/\@&=+\$,%#]* )?
$
>x ? 1 : 0;
}
sub strip_nonprintable {
my $text = shift;
return '' unless defined $text;
if ($charset =~ /^iso-8859/i)
{
# None of the the iso-8859-* charsets have printable
# characters between \200 and \241. See
#
http://czyborra.com/charsets/iso8859.html
$text=~ tr#\t\n\040-\176\241-\377# #cs;
}
elsif ($charset =~ /^utf-8$/i)
{
# The bytes 0xFE and 0xFF are illegal in UTF-8, see
#
http://www.cl.cam.ac.uk/~mgk25/unicode.html#utf-8
$text=~ tr#\t\n\040-\176\200-\375# #cs;
}
else
{
$text=~ tr#\t\n\040-\176\200-\377# #cs;
}
return $text;
}
sub body_attributes {
my %attrs = (bgcolor => 'bgcolor',
background => 'background',
link_color => 'link',
vlink_color => 'vlink',
alink_color => 'alink',
text_color => 'text');
my $attr = '';
foreach (keys %attrs) {
next unless $Config{$_};
if (/color$/) {
next unless $Config{$_} =~ /^(?:#[0-9a-z]{6}|[\w\-]{2,50})$/i;
} elsif ($_ eq 'background') {
next unless check_url_valid($Config{$_});
} else {
die "no check defined for body attribute [$_]";
}
$attr .= qq( $attrs{$_}=") . escape_html($Config{$_}) . '"' if $Config{$_};
}
return $attr;
}
sub error {
my ($error, @error_fields) = @_;
my ($host, $missing_field, $missing_field_list);
my ($title, $error_body);
if ($error eq 'bad_referer') {
my $referer = referer();
$referer = '' if ! defined( $referer );
my $escaped_referer = escape_html($referer);
if ( $referer =~ m|^https?://([\w\.\-]+)|i) {
$host = $1;
$title = 'Bad Referrer - Access Denied';
$error_body =<<EOBODY;
<p>
The form attempting to use FormMail resides at <tt>$escaped_referer</tt>,
which is not allowed to access this program.
</p>
<p>
If you are attempting to configure FormMail to run with this form,
you need to add the following to \@referers, explained in detail in the
README file.
</p>
<p>
Add <tt>'$host'</tt> to your <tt><b>\@referers</b></tt> array.
</p>
EOBODY
} elsif (length $referer) {
$title = 'Malformed Referrer - Access Denied';
$error_body =<<EOBODY;
<p>
The referrer value <tt>$escaped_referer</tt> cannot be parsed, so
it is not possible to check that the referring page is allowed to
access this program.
</p>
EOBODY
} else {
$title = 'Missing Referrer - Access Denied';
$error_body =<<EOBODY;
<p>
Your browser did not send a <tt>Referer</tt> header with this
request, so it is not possible to check that the referring page
is allowed to access this program.
</p>
EOBODY
}
}
elsif ($error eq 'bad_method') {
my $ref = referer();
if (defined $ref and $ref =~ m#^https?://#) {
$ref = 'at <tt>' . escape_html($ref) . '</tt>';
} else {
$ref = 'that you just filled in';
}
$title = 'Error: GET request';
$error_body =<<EOBODY;
<p>
The form $ref fails to specify the POST method, so it would not
be correct for this script to take any action in response to
your request.
</p>
<p>
If you are attempting to configure this form to run with FormMail,
you need to set the request method to POST in the opening form tag,
like this:
<tt><form action="/cgi-bin/FormMail.pl" method="post"></tt>
</p>
EOBODY
} elsif ($error eq 'no_recipient') {
my $recipient = escape_html($Config{recipient});
$title = 'Error: Bad or Missing Recipient';
$error_body =<<EOBODY;
<p>
There was no recipient or an invalid recipient specified in the
data sent to FormMail. Please make sure you have filled in the
<tt>recipient</tt> form field with an e-mail address that has
been configured in <tt>\@recipients</tt> or <tt>\@allow_mail_to</tt>.
More information on filling in <tt>recipient/allow_mail_to</tt>
form fields and variables can be found in the README file.
</p>
<hr size="1" />
<p>
The recipient was: [ $recipient ]
</p>
EOBODY
}
elsif ( $error eq 'too_many_recipients' ) {
$title = 'Error: Too many Recipients';
$error_body =<<EOBODY;
<p>
The number of recipients configured in the form exceeds the
maximum number of recipients configured in the script. If
you are attempting to configure FormMail to run with this form
then you will need to increase the <tt>\$max_recipients</tt>
configuration setting in the script.
</p>
EOBODY
}
elsif ( $error eq 'missing_fields' ) {
if ( $Config{'missing_fields_redirect'} ) {
print redirect($Config{'missing_fields_redirect'});
exit;
}
else {
my $missing_field_list = join '',
map { '<li>' . escape_html($_) . "</li>\n" }
@error_fields;
$title = 'Error: Blank Fields';
$error_body =<<EOBODY;
<p>
The following fields were left blank in your submission form:
</p>
<div class="c2">
<ul>
$missing_field_list
</ul>
</div>
<p>
These fields must be filled in before you can successfully
submit the form.
</p>
<p>
Please use your back button to return to the form and
try again.
</p>
EOBODY
}
}
print header();
$done_headers++;
print <<END_ERROR_HTML;
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<title>$title</title>
$style_element
<style type="text/css">
<!--
body {
background-color: #FFFFFF;
color: #000000;
}
p.c2 {
font-size: 80%;
text-align: center;
}
th.c1 {
font-size: 143%;
}
p.c3 {font-size: 80%; text-align: center}
div.c2 {margin-left: 2em}
-->
</style>
</head>
<body>$debug_warnings
<table border="0" width="600" bgcolor="#9C9C9C" align="center" summary="">
<tr>
<th class="c1">$title</th>
</tr>
</table>
<table border="0" width="600" bgcolor="#CFCFCF">
<tr>
<td>
$error_body
<hr size="1" />
<p class="c3">
<a href="http://nms-cgi.sourceforge.net/">FormMail</a>
© 2001 London Perl Mongers
</p>
</td>
</tr>
</table>
</body>
</html>
END_ERROR_HTML
exit;
}
use vars qw(%escape_html_map);
BEGIN
{
%escape_html_map = ( '&' => '&',
'<' => '<',
'>' => '>',
'"' => '"',
"'" => ''',
);
}
sub escape_html {
my $str = shift;
my $chars = join '', keys %escape_html_map;
if (defined($str))
{
$str =~ s/([\Q$chars\E])/$escape_html_map{$1}/g;
}
return $str;
}
# No __END__ here because that breaks under Apache::Registry
=head1 COPYRIGHT
FormMail $Revision: 1.91 $
Copyright 2001 London Perl Mongers, All rights reserved
=head1 LICENSE
This script is free software; you are free to redistribute it
and/or modify it under the same terms as Perl itself.
=head1 URL
The most up to date version of this script is available from the nms
script archive at E<lt>
http://nms-cgi.sourceforge.net/E<gt>
=head1 SUMMARY
formmail is a script which allows you to receive the results of an
HTML form submission via an email message.
=head1 FILES
In this distribution, you will find the following files:
=over
=item FormMail.pl
The main Perl script
=item README
This documentation. Instructions on how to install and use
formmail
=item EXAMPLES
Some worked examples of ways to set up formmail
=item ChangeLog
The change history of these files
=item MANIFEST
List of files
=back
=head1 CONFIGURATION
