#!/usr/bin/perl
# Mail Form data
# mi\x40alma.ch, 18.03.03, revision 29.07.03

=head1 NAME

sendform.cgi - Email web form data

=head1 SYNOPSIS

  <form method="post" action="/cgi-bin/sendform.cgi" name="my_form_name">
  <input type="hidden"
	name="mail_to" value="webmaster_at_domain.com">
  <input type="hidden"
	name="mail_from" value='hostmaster_at_domain.com'>
  <input type="hidden"
	name="mail_subject" value="domain_._com web form submission">
  <input type="hidden"
	name="success_page" value="http://www.domain.com/mailsuccess.html">
  <input type="hidden" name="skip_fields"
	value="mail_to, mail_from, mail_subject, success_page, skip_fields, submit">

  <input type="text" name="some_field" size="17">
  ...
  </form>

=cut

BEGIN {
    use CGI::Carp qw(fatalsToBrowser);
}

my $VERSION = 0.43;

$Text::Wrap::columns = 55; # for fields which are too long to fit on a line
my $page_title = "Error";
my $style_sheet = param('error_css') || 'http://almanet.ch/styles/sendform.css';
my $http_host = $ENV{'HTTP_HOST'};

my %recipients = (
	'mydomain.tld' => 1,
);

use strict;
use Socket;
use CGI::Pretty qw(:cgi :html);
use Mail::Sendmail;
use Text::Wrap;


#my $send_confirmation = 0; # send confirmation mail to submitter?
#my $banner_file = "";
#my $reply_to_address = ""; # used only if $send_confirmation

my $adr_rx = $Mail::Sendmail::address_rx;

my $mail_from = param('mail_from');
$mail_from =~ s/_at_/@/;
my $mail_to   = param('mail_to');
$mail_to =~ s/_at_/@/;
my $mail_subject = param('mail_subject') || "Web form data";
my $success_page = param('success_page');

my $cgi = new CGI;

unless ($mail_from) {
	&form_error("The form is missing the required configuration field 'mail_from'");
}
unless ($mail_to) {
	&form_error("The form is missing the required configuration field 'mail_to'");
}
unless ($success_page) {
	&form_error("The form is missing the required configuration field 'success_page'");
}
unless ($mail_from =~ /$adr_rx/) {
	&form_error("Invalid 'mail_from' field:
the sender email address '$mail_from' is not valid.");
}
if ($mail_to =~ /$adr_rx/) {
	my ($adr, $dom) = (lc($1), lc($3));
	unless ( $http_host =~ /$dom$/i
			 || exists($recipients{$adr})
			 || exists($recipients{$dom})
		   ) {
		&form_error("Invalid 'mail_to' field:
the recipient email address '$mail_to' must be registered in the system for security reasons.
Contact the webmaster to have it registered.");
	}
} else {
	&form_error("Invalid 'mail_to' field:
the recipient email address '$mail_to' is not valid.");
}

my %mail = (
    From       => $mail_from,
    To         => $mail_to,
    Subject    => $mail_subject,
    'X-Script' => "$0 v. $VERSION",
    'X-Mailer' => "Mail::Sendmail v. $Mail::Sendmail::VERSION",
);



# Try to get hostname to add it to the mailed info

my $client_IP = remote_host();
my $iaddr = inet_aton($client_IP);
my $client_host = gethostbyaddr($iaddr, AF_INET) || "<unknown>";
my $referrer = referer;

my %skip_fields;
my @param_skips = split /[^\w]+/, param('skip_fields');
@skip_fields{@param_skips} = (1) x scalar(@param_skips);

my $max_field_name; # for formatting of mail later
foreach my $field (param()) {
	$max_field_name = length($field)
		if ( (length($field)>$max_field_name) and (not exists $skip_fields{$field}) );
}

# Prepare the mail
$mail{Message} = "";
foreach my $field (param()) {
	next if exists $skip_fields{$field};
	my $val = param($field);
	$val = wrap("", " "x($max_field_name+4), $val) if (length($val) > $Text::Wrap::columns or $val =~ /\n/);
	$val =~ s/^\s+//;
	$val =~ s/\s+$//;
	$mail{Message} .= sprintf('%-'.$max_field_name.'s = ', $field)
				   .  join(", ", $val)
				   . "\n";
	# used join(), in case a field contains multiple values
}

$mail{Message}  .= "\nHost  = $client_host ($client_IP)\n"
				. "Referrer = $referrer\n"
				. "\n";
                ;

# Send the mail
if (sendmail %mail) {
	# sendmail returns true on success
	print $cgi->redirect($success_page);
}
else {
	# there was an error sending the mail
	$mail{To} =~ s/<|>//g;
	form_error("Could not send mail to '$mail{To}'");
}

sub form_error {
	# Start HTML (headers etc...)
	print header;
	print start_html(
		-title=>$page_title,
	    -style=>({-rel=>'stylesheet', -src=>$style_sheet, -type=>'text/css'}),
	    -head=>[meta({-http_equiv => 'Content-Type', -content => 'text/html; charset=iso-8859-1'})]
	);

	print h1("Error"),
		p("Sorry, your data could not be processed. The error returned was:"),
		pre(join("\n", @_)),
		p("Please retry later or let the webmaster know about this problem by copying
           this text into a mail and sending it to webmaster&#64;$http_host"),
		p("Thank you"),
		$cgi->Dump,
		p(a({-href=>referer()}, "Back to previous page...")),
		hr,
		p({class=>"footer"}, "$0 version $VERSION"),
		end_html
		;
	exit;
}

__END__


=head1 DESCRIPTION

B<sendform.cgi> mails the data submited through a web form. It uses hidden form fields for
configuration.

The email addresses used in the hidden fields can be written with "_at_" instead of "@",
so it is a bit more difficult for email harvesting robots to catch the addresses.

The recipient addresses must be registered with the system to avoid spammer abuse.

=head1 REQUIRED FIELDS

The following configuration fields are required:

=head2 mail_to

Address(es) to send the results to. You can have multiple addresses, and you can use real names.

By default, you can use any address in your website's domain. To use an outside address, it must
first be registered in the script. This avoids the well-known mail form security problem.

=head2 mail_from

The email From: address. It can contain a real name. It must be a valid email address, preferrably different
than the mail_to address, so in case of errors, someone gets them.

=head2 success_page

The web page to redirect to on success.

=head1 OPTIONAL FIELDS

The following configuration fields are optional:

=head2 mail_subject

The subject to use in the mail.

=head2 skip_fields

The form fields to skip in the sent mail. Usually just these configuration fields, and your submit button.

=head2 error_css

URL of CSS style sheet to use for error pages.

The default is 'http://--yourdomain--/styles/sendform.css'.

The generated error page uses the tags H1, P, PRE, HR and the class "footer".

=head1 AUTHOR and COPYRIGHT

C<  perl -e "print qq(mi.perl\x40alma.ch\n)"  >

=head1 LICENSE

Same as Perl itself.

=cut