[Date Prev][Date Next][Thread Prev][Thread Next] [Search] [Date Index] [Thread Index]
[MacPerl-AnyPerl] Mailer CGI

To: <macperl-anyperl@macperl.org>
Subject: [MacPerl-AnyPerl] Mailer CGI
From: Joel Rees <joel_rees@sannet.ne.jp>
Date: Sat, 10 Jun 00 00:32:40 +0900
Yes, I was stupid enough to try to roll my own CGI mailer. I wrote it 
using bare Perl as an exercise for myself and as study material for my 
group; it was written and syntax checked on a Mac, and uploaded and 
web-debugged via a Mac. 

Perhaps I might get some critique here and some pointers to information 
as to why it would CC the form contents (lots of shift-JIS characters) to 
my office intact, but deliver the thing to our customer with the eighth 
bit stripped? The customer's provider is running on NT, and my guess is 
that may have something to do with it.

I plan to re-write it with CGI.pm, but I want to get a handle on the 
eighth bit problem before I try to confuse myself with objects. 

#!perl -wT

# The first line (the shebang line) tells the shell this is a perl 
script, 
# shows the location of the interpreter to use,
# and specifies run-time options (warn and TAINT).

# Joel Rees, Fuji Computer Sales, Kakogawa, Japan, May 2000

# This doesn't really make much use of the CGI library, because it is a 
teaching tool.
# The next version will make more use of the CGI library.
# Not using the antique :cgi-lib or :standard, so let's not use it.
# use CGI qw( :cgi-lib :standard );  # perl module CGI.pm

# Let's use debugging controls:
my( $debug, $detail ) = ( 0, 0 );


# The list of permitted addresses (as a hash for easy lookup, but don't 
use zero):
my( %goodSends ) =
(	'udit@udit.gr.jp', 1,
	'webmaster@fujicomp.co.jp', 1,
	'customer@customer.co.jp', 1,
	'webmaster@customer.co.jp', 0	
);


# Now tell the web server (apache, probably) that we are outputting html 
source:
# The web server _requires_ one empty line between type and content;
# "\r\n" should be wrong, even if the server is on MS-Windows (or some 
other hard drug).
# CGI.pm would make us machine-independent, 
# but we would have to use new implicitly. 
# So we can't use print() yet. So, what good does CGI.pm do us?
# print header();
print "Content-type: text/html\n\n";

# Starting the body here allows us to debug freely.
# Building this by hand because I don't want to use code I can't explain.
print qq( 
<html> 
<head> 
<title>Sending Your Mail!</title> 
</head> 
<body bgcolor="#ffffff"> 
);


# Clear out the path, so we don't forget it is TAINTed (might be hacked):
# (but save it first)
my( $originalPath ) = $ENV{ 'PATH' };
if ( $debug ) { print "<p>Path passed in=$originalPath<br>\n</p>\n"; }
$ENV{ 'PATH' } = "";
# (A malicious user might write his own web page with the environment 
#  variables deliberately altered, then call our CGI.
#  Our CGI should have its permissions set properly, 
#  but we should NOT assume that a malicious program can never get onto 
our server.
#  It's a matter of 'safe hex'.)


my( $input_by_get ) = $ENV{ "QUERY_STRING" };
my( $request_method ) = $ENV{ "REQUEST_METHOD" };
my( $input_by_post ) = "";

if ( $debug ) { print 
"<p>method:$request_method<br>\nget:$input_by_get<br>\n"; }

if ( $request_method && $request_method eq 'POST' )
{
	# A limit on input, to try to prevent certain denial-of-service attacks.
	# Since STDIN never gives us an EOF, we must have some way to read the 
length,
	# but we don't want it hacked large enough to stop our server.
	my( $content_length ) = $ENV{ 'CONTENT_LENGTH' };
	if ( $debug ) { print "initial $content_length:$input_by_post<br>\n"; }
	if ( $content_length && $content_length > 16000 )
	{	$content_length = 16000; 
		print "*** Warning! input forcibly shortened! ***";
		# Probably should log this, instead, once I've practiced logging.
	}
	# Get the form text from standard input,
	# This grabs all of the input at once, in one big string, with no line 
breaks.
	if ( $content_length && $content_length > 0 )
	{	if ( $debug ) { print "intermediate $content_length bytes before 
read<br>\n"; }
		$content_length = read( STDIN, $input_by_post, $content_length );
	}
	if ( $debug ) { print "final $content_length:$input_by_post<br>\n"; }
}

# Now split out the variable pairs and UUDECODE the form data.
# This is probably not complete, but should be sufficient for now.
# Pairs are separated by "&".
my( %form_variables );
{	my( @form_pairs ) = ( split( /&/, $input_by_get ), split( /&/, 
$input_by_post ) );
	my( $entry, $name, $value );
	if ( $debug ) { print "@form_pairs<br>\n"; }
	foreach $entry ( @form_pairs )
	{
		if ( $debug ) { print "$entry: "; }
		# "+" was substituted for space, restore it:
		$entry =~ s/\+/ /g;

		# Restore characters that were translated to hexadecimal:
		$entry =~ s/%(..)/pack("c",hex($1))/ge;

		# Now associate the name with its declaration:
		( $name, $value ) = split( /=/, $entry, 2 );
		if ( $debug ) { print "\&lt;$name\&gt;, \&lt;$value\&gt;<br>\n"; }
		# and keep it in a content-addressable array (hash) called 
%form_variables:
		$form_variables{ $name } = $value;
	}
}


sub nonEmptyAssign
{	return $_[ 0 ] ? $_[ 0 ] : $_[ 1 ];
}


# This could also be hacked, for social engineering, I suppose, but to 
what purpose? 
my( $thanksUrl ) = 
	nonEmptyAssign( $form_variables{ 'thanksURL' }, '/thanks.html' );

# I wanted this in the header, but we can't put it in until we get it 
from the %ENV hash.
# Since this needs to be easily debugged, we settle for putting it here 
(this time).
# Let qq do its magic.
print qq( <META HTTP-EQUIV = "refresh" CONTENT = "1;URL=$thanksUrl"> );

# Can't use Japanese directly in the source without encoding it, as I 
understand things.
# We could reference an HTML page which contains Japanese, 
# but let's do it the easy way for now, and use English.
print "<h1>Sending Your Request!</h1>\n";
# UNICODE claims it will take care of this problem.

open(MAIL, "| /usr/lib/sendmail -t") || die "Can\'t connect to mail 
program!";
# -t get recipient addresses from header
# -f send from specified address

# *****
# If executable from anywhere, 
# these variables could open this script up to spoofing spammers!
# So we check the target addresses against a good list.
{
	my( $webmaster ) = 'webmaster@fujicomp.co.jp';	# hardwire this one.
	my( $sendfrom ) = nonEmptyAssign( $form_variables{ 'sendfrom' }, 
$webmaster );
	my( $sendto ) = $form_variables{ 'sendto' };
	if ( ! $goodSends{ $sendto } ) 
	{	$form_variables{ 'BADsendto' } = $sendto;
		$sendto = $webmaster; 
	}
	my( $sendCCto ) = $form_variables{ 'sendCCto' };
	if ( defined( $sendCCto ) && ! $goodSends{ $sendCCto } ) 
	{	$form_variables{ 'BADsendCCto' } = $sendCCto;
		$sendCCto = $webmaster; 
	}

	my( $pagename ) = nonEmptyAssign( $form_variables{ 'pagename' }, 
'???.html' );

	print( MAIL "From: $sendfrom\n" );
	if ( $debug ) { print "From: $sendfrom<br>\n" }
	print( MAIL "To: $sendto\n" );
	if ( $debug ) { print "To: $sendto<br>\n" }
	if ( defined( $sendCCto ) )
	{	print( MAIL "Cc: $sendCCto\n" );
		if ( $debug ) { print "Cc: $sendCCto<br>\n" }
	}
	print( MAIL "Subject: $pagename\n" );
	if ( $debug ) { print "Subject: $pagename<br>\n" }
# Reply-To: $form_variables{ 'e-mail_address' };		# maybe do this later? 
# Need to search the keys, because we will have things like 
a01_e-mail_address.
	print( MAIL "MIME-Version: 1.0\n" );
	print( MAIL "Content-Type: text/plain;	charset=\"Shift_JIS\"\n" );
	print( MAIL "Content-Transfer-Encoding: 8bit\n\n" );

	print ( MAIL "Form Responses:\n" );
	if ( $debug ) { print "Form Responses:<br>\n" }
	{	my( $name );
		foreach $name (sort keys( %form_variables ) )
		{	print MAIL "$name=$form_variables{ $name }\n"; 
			if ( $debug ) {	print "$name=$form_variables{ $name }\n"; }
		}
	}
}

# Remember that all %ENV variables can be spoofed! 
# (Do not rely on these values for anything dangerous or valuable!!!)
{	# For a record,
	my( $http_referrer ) = 
		nonEmptyAssign( $ENV{ 'HTTP_REFERER'}, 'Referrer Unspecified!!' );
	my( $previous_page ) = 
		nonEmptyAssign( $form_variables{ 'previousPage' }, 'Previous page 
unknown.' );
	my( $remote_host ) = 
		nonEmptyAssign( $ENV{ 'REMOTE_HOST' }, 'Host Unspecified!!' );
	my( $remote_addr ) = 
		nonEmptyAssign( $ENV{ 'REMOTE_ADDR' }, 'Address Unspecified!!' );
	my( $user_agent ) = 
		nonEmptyAssign( $ENV{ 'HTTP_USER_AGENT' }, 'User Agent Unspecified!!' );
	print MAIL qq(
	Remote Host=$remote_host
	Remote Addr=$remote_addr
	User Agent=$user_agent 
	HTTP Referrer=$http_referrer
	);
}


if ( $detail )
{
	print MAIL "****Environment listing (for programmers only):****\n";
	foreach $env_var ( keys %ENV )
	{	if ( $env_var )
		{
			if ( $debug ) { print "$env_var= "; }
			print MAIL "$env_var=";
			if ( $ENV{ $env_var } ) 
			{	if ( $debug ) { print "$ENV{ $env_var }<br>\n"; }
				print MAIL "\{$ENV{ $env_var }\}\n";
			} 
			else
			{	if ( $debug ) { print "Variable unspecified<br>\n"; }
				print MAIL "Variable unspecified\n";
			}
		} 
		else
		{
			if ( $debug ) { print "Where do we get an undefined key?<br>\n"; }
			print MAIL "Where do we get an undefined key?\n";
		}
	}
} # end if ( $detail )


close(MAIL);

# end the html, too
print qq( </body> </html> );


Joel Rees
----------------------------------------
                       Keeping the Faith
<joel_rees@sannet.ne.jp>
<http://www.page.sannet.ne.jp/joel_rees>
(free account:) <reiisi@nettaxi.com>
<http://www.nettaxi.com/citizens/reiisi>
----------------------------------------


==== Want to unsubscribe from this list?
==== Send mail with body "unsubscribe" to macperl-anyperl-request@macperl.org
Prev by Date: Re: [MacPerl-AnyPerl] perl whine
Next by Date: Re: [MacPerl-AnyPerl] mental block: pack/unpack
Prev by thread: [MacPerl-AnyPerl] Electronic Signatures
Next by thread: Re: [MacPerl-AnyPerl] Mailer CGI
Navigation: Date Index | Thread Index | Search | Other lists at bumppo.net