astu...
#!/usr/bin/perl
### web2mail -- An anonymous CGI mailer.
### See
http://www.pobox.com/~cgires/web2mail/
### for usage and description.
### Copyright 1995-97, Sanford Morton <smorton@pobox.com>
### Thanks to Michael Grobe <grobe@ukans.edu> for a multiple values fix.
###
### Configuration Variables
###
### The local mail program
### You may need to change the path to sendmail.
### If you don't have sendmail, you'll need to revise &send_mail
$mail_program = "/usr/sbin/sendmail -t";
### Instructions page
### Used if the page owner forgets to supply .email_target hidden tag
$instructions_url = "http://www.pobox.com/~cgires/web2mail/";
###
### Main body of script
###
### parse the form data
&ReadParse;
### is required email address supplied
if ( ! $in{'.email_target'} ) {
print &instructions_page;
exit;
}
### any required data? if so, has user supplied it?
if ( $in{'.required_data'} && &missing_data ) {
print &incomplete_page;
exit;
}
### prepare first line of mail message
$message = $in{'.mail_intro'} ? "$in{'.mail_intro'}\n\n"
: "Form data submitted to $ENV{'HTTP_REFERER'}:\n\n";
### write the form data to the mail message
foreach (sort keys %in) {
next if /^\./; # skip hidden form data in mail message
$item = "$_: $in{$_}";
$item =~ s/^..// if $in{'.remove_indexing'};
# if multiple values, indent them on new lines
$item =~ s/\0/"\n\t".(" "x(2+length($_)))/ge;
$message .= "\t$item\n";
}
## do you want the environment variables?
if ( $in{'.environment'} ) {
$message .= "\nThe environment variables are:\n\n";
foreach (keys %ENV) {
$message .= "\t$_: $ENV{$_}\n";
}
} else {
## let's at least report a few
$message .= "\nReferring page: $ENV{HTTP_REFERER}";
$message .= "\nUser address: $ENV{REMOTE_ADDR}";
$message .= "\nUser host: $ENV{REMOTE_HOST}";
}
## prepare subject line in mail message
$subject_line = $in{'.mail_subject'} ? "$in{'.mail_subject'}"
: "Form data submitted to $ENV{'HTTP_REFERER'}";
## remove everything after the first comma in .email_target to
## prevent multiple recipients, eg, spam broadcasts
$in{'.email_target'} =~ s/,.*//;
## mail it (or web it if in test mode)
&send_mail ($mail_program, $in{'.email_target'}, $subject_line, $message);
## Return an acknowledgement page
&acknowledge_page;
###
### End of main body of script.
### Subroutines below.
###
###
### Return an acknowledgement page.
### Look first for a matching custom response url,
### then for a thanks page, or send the default acknowledgement page.
###
sub acknowledge_page {
local($i, @triples);
## search for a match among custom responses
if ( $in{'.custom_response_url'} ) {
## for each custom response, the triple is:
## form tag name :: triggering value :: response url
@triples = split( /::/, $in{'.custom_response_url'} );
for ($i=0; $i < $#triples; $i+=3) {
## if name matches value
if ( $in{"$triples[$i]"} eq $triples[$i+1] ) {
## print URL
if ( $in{'.test'} ) { # test mode
print "The acknowledgement page that would be returned is:
<A HREF=\"$triples[$i+2]\">$triples[$i+2]</A>";
} else {
print "Location: $triples[$i+2]\n\n";
}
exit;
}
}
}
## if no custom response matches, return the supplied
## base thanks page, if any
if ( $in{'.thanks_url'} ) {
if ( $in{'.test'} ) { # test mode
print "The acknowledgement page that would be returned is:
<A HREF=\"$in{'.thanks_url'}\">$in{'.thanks_url'}</A>";
} else {
print "Location: $in{'.thanks_url'}\n\n";
}
## or just return the built-in default
} else {
print &thanks_page;
}
}
###
### .email_target form data is missing, return an instruction page
###
sub instructions_page {
local ($page_source) = <<"INSTRUCTIONS_PAGE";
Content-type: text/html\n\n
<TITLE>Oops, .email_target is missing</TITLE>
<H1>Oops, .email_target is missing</H1>
You must include a hidden form tag called <CODE>.email_target</CODE>
whose value is the email address to which you want to mail the form data.
Something like<PRE>
<INPUT TYPE="hidden" NAME=".email_target" VALUE="user\@site.com">
</PRE>For your information, the form elements and their values that
actually were supplied in this page were:<UL>
INSTRUCTIONS_PAGE
foreach (keys %in) {
$page_source .= "<LI>$_: $in{$_}\n";
}
$page_source .= <<"LAST_PART";
</UL>You can return to the
<A HREF="$instructions_url">instructions page</A>
describing the use of this mailing script, or press your <STRONG>BACK</STRONG>
button to return to the web form.
LAST_PART
return $page_source;
}
###
### send mail containing the form data
###
sub send_mail {
local ($mail_program, $email_address, $subject, $message) = @_;
if ($in{'.test'}) { # test mode. Send mail to web page
print <<"TEST";
Content-type: text/html\n\n
<H1>Here is the letter that would be mailed:</H1><PRE>
To: $email_address
Subject: $subject
\n\n$message\n</PRE>
<H1>The rest of this page is the Thanks page</H1><HR>
TEST
} else { # production mode. Send mail to mail.
if ( !open(MAIL, "|$mail_program") ) {
print &error_page ($message);
exit;
}
print MAIL <<"EOM";
To: $email_address
Subject: $subject
\n\n$message
\n.\n
EOM
close (MAIL);
}
}
###
### Return the html source for an incomplete submission page
###
sub incomplete_page {
local ($page_source) = <<"FIRST_HALF";
Content-type: text/html\n\n
<TITLE>Thanks, but oops ...</TITLE>
<H2>Thanks, but oops ...</H2>
Your information is important to us, and the following items
on the form were not filled in:
<UL>
FIRST_HALF
foreach ( @missing_fields ) {
$page_source .= "<LI>$_\n";
}
$page_source .= <<"SECOND_HALF";
</UL>
Please click your <STRONG>BACK</STRONG> button to return to the form
and add that information. Your other answers should still be there.
SECOND_HALF
return $page_source;
}
###
### Return an array of missing fields among the Company data, or undef
### Need to name the fields descriptively so users will know what
### form data they are missing.
###
sub missing_data {
local ($result) = 0;
foreach ( split (/::/, $in{'.required_data'} ) ) {
unless ($in{$_}) {
s/^..// if $in{'.remove_indexing'};
push (@missing_fields, $_);
$result = 1;
}
}
return $result;
}
###
### Return the html source for an error page following a
### mail error. Includes the text of the mail.
###
sub error_page {
local ($message) = @_;
local ($page_source) = <<"ERROR_PAGE";
Content-type: text/html\n\n
<TITLE>System Form Error</TITLE>
<H2>Thanks, but oops ...</H2>
The system seems a bit confused right now, so your form
was not processed. You can try again a little later, or you can
mail us directly at
<A HREF="mailto:$in{'.email_target'}">$in{'.email_target'}</A>.
You can simply quote this page, since the following is the message
that would have been sent: <P><PRE>$message</PRE>
ERROR_PAGE
return $page_source;
}
###
### Return the html source for the acknowledgement page.
###
sub thanks_page {
local ($page_source) = <<"THANKS_PAGE";
Content-type: text/html\n\n
<TITLE>Form Acknowledgement</TITLE>
<H2>Thank You</H2>
Your form data have been submitted to
<A HREF="mailto:$in{'.email_target'}">$in{'.email_target'}</A>.
Thank you for taking the time to fill out the form.
THANKS_PAGE
if ( $in{'.back_to_url'} ) {
$page_source .=
"<P>Return to <A HREF=\"$in{'.back_to_url'}\">$in{'.back_to_url'}</A>";
}
return $page_source;
}
###
### 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 @_;
local ($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);
}