#!/usr/bin/perl
######################
# General Mail Form To Work With Any Fields
# Created 6/9/95 Last Modified 28/Oct/00
# Version 1.0
# Define Variables
$mailprog = '/bin/sendmail';
$date = `/bin/date`; chop ($date);
######################
# Necessary Fields in HTML Form:
# recipient = specifies who mail is sent to
# username = specifies the remote users email address for replies
# realname = specifies the remote users real identity
# subject = specifies what you want the subject of your mail to be
# Print the Initial Output Heading
print "Content-type: text/html\n\n";
# Get the input
read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
# Split the name-value pairs
@pairs = split(/&/, $buffer);
foreach $pair (@pairs)
{
($name, $value) = split(/=/, $pair);
# Un-Webify plus signs and %-encoding
$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$name =~ tr/+/ /;
$name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
# Stop people from using subshells to execute commands
# Not a big deal when using sendmail, but very important
# when using UCB mail (aka mailx).
# $value =~ s/~!/ ~!/g;
# Uncomment for debugging purposes
# print "Setting $name to $value";
$FORM{$name} = $value;
}
# Print Return HTML
print "
Thank You\n";
print "ご注文ありがとうございました
\n";
print "今後ともよろしくお願い致します。
";
print " on $date
\n";
# Open The Mail
open (MAIL, "|$mailprog $FORM{'recipient'}") || die "Can't open $mailprog!\n";
print MAIL "From: $FORM{'username'} ($FORM{'realname'})\n";
print MAIL "Reply-To: $FORM{'username'} ($FORM{'realname'})\n";
print MAIL "To: $FORM{'recipient'}\n";
print MAIL "Subject: $FORM{'subject'}\n\n";
print MAIL "Below is the result of your feedback form. It was submitted by $FORM{'realname'} ($FORM{'username'} on $date\n";
print MAIL "--------------------------------------------------------------\n";
foreach $pair (@pairs)
{
($name, $value) = split(/=/, $pair);
# Un-Webify plus signs and %-encoding
$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$name =~ tr/+/ /;
$name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
# Stop people from using subshells to execute commands
# Not a big deal when using sendmail, but very important
# when using UCB mail (aka mailx).
# $value =~ s/~!/ ~!/g;
# Uncomment for debugging purposes
# print "Setting $name to $value";
$FORM{$name} = $value;
# Print the MAIL for each name value pair
print MAIL "$name: $value\n";
print MAIL "____________________________________________\n\n";
}
close (MAIL);
print "";