#!/usr/local/bin/perl
# Copyright (c) 1996 David Muir Sharnoff
#
# This CGI scrip simply mails the results of a html form.
#
# Using hiden variables the behavior can be modifed:
#
# <input type=hidden name=_mailto value="foo@bar">
# Mail the results to foo@bar
# <input type=hidden name=_subject value="A subject">
# Set the Subject header of the mail message
# <input type=hidden name=_skip value="_mailto _subject">
# Do not report the values of the "_mailto" or "_subject"
# fields.
# <input type=hidden name=_env value="HTTP_REFERER HTTP_USER_AGENT">
# Report the referer and user agent (if available)
# <input type=hidden name=_redirect value="http://www....">
# When the mail has been sent, redirect to the following address...
# <input type=hidden name=_passthrough value="name">
# When redirecting, pass along the values listed in _passthrough
# <input type=hidden name=_quoting value="'">
# Quote field values with '
#
use strict;
use CGI;
use CGI::Carp;
use Net::SMTP;
use Sys::Hostname;
my $query = new CGI;
my $username = getpwuid($<);
my @names = $query->param();
my ($mailto, $quoting, $skip, $subject);
my ($env, $redirect, $passthrough);
my @defaults = (
\$mailto, '_mailto', $username,
\$quoting, '_quoting', "'",
\$skip, '_skip', '_mailto _subject _env _redirect _passthrough',
\$subject, '_subject', "Form results from $0",
\$env, '_env', 'HTTP_COOKIE HTTP_REFERER HTTP_HOST HTTP_USER_AGENT
SCRIPT_NAME PATH_TRANSLATED DOCUMENT_ROOT',
\$redirect, '_redirect', '',
\$passthrough, '_passthrough', ''
);
my %fields;
@fields{@names} = (1) x scalar(@names);
while (@defaults) {
my ($ref, $field, $default) = splice(@defaults, 0, 3);
$$ref = (exists $fields{$field}) ? $query->param($field) : $default;
}
my $smtp = new Net::SMTP 'localhost';
$smtp->mail($mailto);
$smtp->to($mailto);
$smtp->data();
$smtp->datasend("To: $mailto\n");
$smtp->datasend("From: $username\n");
$smtp->datasend("Subject: $subject\n");
$smtp->datasend("\n");
sub display_value
{
my($smtp, $value, $nl) = @_;
my @lines;
@lines = split("\n", $value);
for (@lines) {
s/\r$//;
s/\r/\\r/g;
s/\f/\\f/g;
s/([\0-\37\177-\200])/sprintf("\\x%02x",ord($1))/eg;
}
if (@lines > 1) {
$smtp->datasend("$nl\t---- begin\n");
my $line;
for $line (@lines) {
$smtp->datasend("\t$line\n");
}
$smtp->datasend("\t----- end\n");
} else {
$smtp->datasend("$nl\t$quoting$lines[0]$quoting\n");
}
}
$smtp->datasend("Formdata:\n");
my %skip = map(($_, 1), split(' ',$skip));
my $name;
my @values;
for $name (@names) {
next if exists $skip{$name};
@values = $query->param($name);
if (@values > 1) {
$smtp->datasend("$name\n");
my $v;
for $v (@values) {
display_value($smtp, $v, "\n");
}
} else {
$smtp->datasend($name);
display_value($smtp, $values[0]);
}
}
if ($env) {
$smtp->datasend("\n");
$smtp->datasend("cgi variables:\n");
my $e;
for $e (split(' ',$env)) {
next unless exists $ENV{$e};
$smtp->datasend($e);
display_value($smtp, $ENV{$e});
}
}
sub as_url
{
my($s) = @_;
$s =~ s/(\W)/sprintf("%%%02x",unpack('C',$1))/ge;
return $s;
}
my $p;
if ($passthrough) {
croak "Should not define passthrough without redirect"
unless defined $redirect;
my @t;
my $t;
for $name (split(' ', $passthrough)) {
@values = $query->param($name);
next unless @values;
my $v;
$t = '';
for $v (@values) {
$t = as_url($name);
$t .= "=";
$t .= as_url($v);
}
push(@t, $t);
}
if (@t) {
$p = "?" . join("&", @t);
}
}
$smtp->dataend();
$smtp->quit();
if ($redirect) {
print "Location: $redirect$p\n\n";
} else {
print <<END;
Content-type: text/html
<html>
<head>
<title>Data mailed</title>
</head>
<body>
<h1>Mailed</h1>
<p>
The data you just entered has been mailed to $mailto.
</body>
</html>
END
}
exit(0);
1;