#!/usr/bin/perl5
#==============================================================================
# $Id: postcard.cgi,v 1.13 1999/09/12 00:30:15 peters Exp $
#
# Name:         postcard.cgi (Postcard Direct)
#
# Written:      Peter Sundstrom (peters@ginini.com.au)
#
# Created:      Feb 1999
#
# Source:       http://www.ginini.com.au/tools/postcard-direct/
#
# Description:  Emails a postcard to the specified user.
#
# Copyright:    (c)1999 Peter Sundstrom.
#
#		See http://www.ginini.com.au/tools/postcard-direct/ for licence
#		details.
#
# Version:	2.2.0
#
#==============================================================================

# require 5.004;

# use Time::localtime;
use File::Basename;

# Full directory path to where mimelite.pm is located.
use lib "/cgi-bin/postais";
use mimelite;

# Mail program for sending the postcard.  On most Unix systems this will be
# sendmail.  Typical locations are /usr/lib/sendmail, /usr/bin/sendmail and
# /usr/sbin/sendmail.
#
# On Win/NT systems you will need a sendmail equivalent like "blat".
# You can obtain blat from http://gepasi.dbs.aber.ac.uk/softw/Blat.html
$Mail='/usr/lib/sendmail -t -oi -oem';

# Relative URL to this script
$CGI='/cgi-bin/postais/postcard.cgi';

# Full directory path where the configuration file/s are kept
$ConfigDir="config";

# Name of the default configuration filename if none is specified;
$DefaultCfg="$ConfigDir/default.cfg";

#------------------------------------------------------------------------
# END OF CONFIGURABLE OPTIONS
#------------------------------------------------------------------------

undef %Data;

$Method = $ENV{'REQUEST_METHOD'};

if ($Method eq 'GET') {
	$Query = $ENV{'QUERY_STRING'};
}
else {
	read(STDIN,$Query,$ENV{'CONTENT_LENGTH'});
}

Error("Called without any parameters.  Need at least an image URL") if (! "$Query");

foreach (split(/[&;]/, $Query)) {
	s/\+/ /g;
	($key, $value) = split('=', $_);
	$key =~ s/%([A-Fa-f0-9]{2})/pack("c",hex($1))/ge;
	$value =~ s/%([A-Fa-f0-9]{2})/pack("c",hex($1))/ge;
	$Data{$key} = $value;                
}

#
# Unbuffer output
#
$|=1;

#
# Check to see what configuration to use
#
$Config="$Data{config}";

if ($Config) {
	Error("Invalid Configuration file format") if ($Config !~ m#^([\w.-]+)$#); 
        Error("Configuration file $ConfigDir/$Config does not exist") if ( ! -f "$ConfigDir/$Config");
        require "$ConfigDir/$Config";
}
else {
        Error("Default configuration file $DefaultCfg does not exist") if (! -f "$DefaultCfg");
        require "$DefaultCfg";
	$Config=basename("$DefaultCfg");
}

#
# Check what action has been specified
#
if ($Data{send}) {
	CheckBadData();
	SendPostcard();
}
elsif ($Data{preview}) {
	CheckBadData();
	PreviewPostcard();
}
else {
	DisplayForm();
}

#--------------------------------------------------------------------
sub DisplayForm {

	Error("No postcard image specified") unless $Data{image};

	open(FORM,"$Form") or Error("Can not open postcard form template: $Form");

	$ImagePath=ImageLocation("$Data{image}");
	Error("Postcard image not found <P>URL: $Data{image}<BR>Directory path: $ImagePath") if (! -f $ImagePath);

	undef $Output;

	while (<FORM>) {
		next if (/^#/);
		s!%CGI%!$CGI!;
		s!%CONFIG%!$Config!g;
		s!%IMAGE%!$Data{image}!g;
		s!%TITLE%!$Data{title}!g;
		s!%HELP%!$Help!g;

		if (/%DESIGNS%/) {
			open(LIST,"$DesignList") or Error("Can not open Design list: $DesignList");

			while (<LIST>) {
				next if (/^#/ or /^$/);
				($File,$Description)=split(/\|/);
				$Output .= "<OPTION VALUE=$File>$Description\n";
			}

			close(LIST);
			s/%DESIGNS%//;
		}

		if (/%MIDI%/) {
			open(LIST,"$MidiList") or Error("Can not open Midi list: $MidiList");

			$Output .= "<OPTION VALUE=\"none\">No Music\n";

			while (<LIST>) {
				next if (/^#/ or /^$/);
				($File,$Description)=split(/\|/);
				$Output .= "<OPTION VALUE=$File>$Description\n";
			}

			close(LIST);

			s/%MIDI%//;
		}

		$Output .= $_;
	}
	
	close(FORM);

	print "Content-type: text/html\n\n";
	print $Output;
}

#--------------------------------------------------------------------
sub PreviewPostcard {

	ValidateForm();

	if ($Data{method} eq 'plain') {
		ReadPlain();
		print "Content-type: text/html\n\n";
		print "<HTML><BODY BGCOLOR=#ffffff>\n";
		print "<PRE>$Text</PRE>\n";
		print "<P><HR>\n";
		print "Picture Attachment<P>\n";
		print "<IMG SRC=$Data{image}>\n";
		print "</BODY></HTML>\n";
	}
	else {
		ReadHTML();
		print "Content-type: text/html\n\n";
		print "$Text\n";
	}


}

#--------------------------------------------------------------------
sub SendPostcard {

	ValidateForm();

	# Convert image URL to path
	$ImagePath=ImageLocation("$Data{image}");

	# Determine image type
	$ImageType=ImageType("$ImagePath");

	# Determine whether to use default sender or user supplied sender
	if ("$Data{s_email}") {
		if ($Data{s_name}) {
			$Sender="$Data{s_name} <$Data{s_email}>";
		}
		else {
			$Sender="$Data{s_email}";
		}
	}
	else {
		$Sender="$From";
	}

	# Send the postcard either as an HTML file with image included
	# or HTML with just the URL of the image, or plain text with
	# the image attached.

	if ($Data{method} eq 'plain') {
		SendPlain();
	}
	elsif ($Data{method} eq 'web') {
		$Data{message} =~ s/\n/<BR>/g;
		SendWeb();
	}
	else {
		$Data{message} =~ s/\n/<BR>/g;
		SendHTML();
	}

	MIME::Lite->send('sendmail', "$Mail");

	$msg->send or Error("Mailer error.  Can not send the postcard.  Please try again later");

	# Display the final page notifying the user that
	# the postcard is successfully on its way.

	$Subject="$Data{subject}" if ("$Data{subject}");

	open(SENT,"$Sent") or Error("Can not open $Sent");

	print "Content-type: text/html\n\n";

	while (<SENT>) {
		next if /^#/;
		s/%TITLE%/$Data{title}/g;
		s/%SENDER%/$Data{s_name}/g;
		s/%SENDER_EMAIL%/$Data{s_email}/g;
		s/%RECIPIENT%/$Data{r_name}/g;
		s/%RECIPIENT_EMAIL%/$Data{r_email}/g;
		s/%SUBJECT%/$Subject/g;
		s/%MESSAGE%/$Data{message}/g;
		print;
	}

	close(SENT);

	PostcardLog() unless $DisableLogging;
}

#-----------------------------------------------------------------------------
# Validate Form

sub ValidateForm {
	InputError("You MUST include an email address for the person you are sending to") unless $Data{r_email};

	InputError("Recipient email address: $Data{r_email} <I>$Result</I>") if ($Result=CheckAddress("$Data{r_email}"));

	InputError("You need to include a message") unless $Data{message};

	InputError("You need to include the name of the person you are sending the postcard to") if (! $Data{r_name} and $RequireReceiverName);

	InputError("You need to include your email address as the sender") if (! $Data{s_email} and $RequireSenderEmail);

 	InputError("You need to include your name as the sender") if (! $Data{s_name} and $RequireSenderName);	

	InputError("Your email address: $Data{s_email} $Result") if ($Result=CheckAddress("$Data{s_email}"));

}

#-----------------------------------------------------------------------------
# Read plain design template

sub ReadPlain {
	open(POSTCARD,"$Postcard/plain.design") or Error("Can not open postcard design: $Postcard/plain.design");

	$Subject="$Data{subject}" if ("$Data{subject}");

	while (<POSTCARD>) {
		next if (/^#/);

		s/%TITLE%/$Data{title}/g;
		s/%SENDER%/$Data{s_name}/g;
		s/%SENDER_EMAIL%/$Data{s_email}/g;
		s/%RECIPIENT%/$Data{r_name}/g;
		s/%RECIPIENT_EMAIL%/$Data{r_email}/g;
		s/%SUBJECT%/$Subject/g;
		s/%MESSAGE%/$Data{message}/g;

		
		# Include the back to form button in preview mode
		if (/%BACK%/) {
			if ($Data{preview}) {
				s!%BACK%!<FORM><INPUT TYPE=BUTTON VALUE="Return to Form" onClick="history.go(-1);return true"></FORM>!g;
			}
			else {
				s/%BACK%//;
			}
		}
		
		if (/%SEND%/) {
			if ($Data{preview}) {
				$SendText .= SendFromPreview();
				s!%SEND%!$SendText!g;
			}
		}
		else {
			s/%SEND%//g;
		}

		$Text .= "$_";
	}

	close(POSTCARD);
}

#-----------------------------------------------------------------------------
# Send postcard as plain text with the image attached

sub SendPlain {
	ReadPlain();

	$msg = new MIME::Lite
		From	=> "$Sender",
		To	=> "$Data{r_email}",
		Subject => "$Subject",
		Type    => 'TEXT',
		Data	=> "$Text";

	attach $msg
		Type		=> "image/$ImageType",
		Encoding	=> 'base64',
		Path		=> "$ImagePath",
		Filename	=> "postcard.$ImageType";
}

#-----------------------------------------------------------------------------
# Reads the appropriate html template and substitutes the appropriate values
# for the variables. 
# 
# If the message is being sent, then we must look for any additional images
# in the template and generate a CID for each one and keep track of the 
# names of each one.

sub ReadHTML {
	open(POSTCARD,"$Postcard/$Data{design}") or Error("Can not open postcard design: $Postcard/$Data{design}");

	$Subject="$Data{subject}" if ("$Data{subject}");

	$CID=GenerateCID();

	$Data{message} =~ s/\n/<BR>/g;

	while (<POSTCARD>) {
		next if (/^#/);

		if ($Data{preview}) {
			s/%IMAGE%/$Data{image}/g;
			s!%BACK%!<FORM><INPUT TYPE=BUTTON VALUE="Return to Form" onClick="history.go(-1);return true"></FORM>!g;

			if (/%SEND%/) {
				$SendText .= SendFromPreview();
				s!%SEND%!$SendText!g;
			}

			if (/%MIDI%/) {
				if ($Data{midi} ne 'none') {
					Error("Midi file not found: $MidiDir/$Data{midi}") if (! -f "$MidiDir/$Data{midi}");
					$Text .= "<BGSOUND src=$MidiURL/$Data{midi} AUTOSTART=true>\n";
					$Text .="<EMBED SRC=$MidiURL/$Data{midi} HIDDEN=TRUE AUTOSTART=TRUE>\n";
					next;
				}
			}
		}
		else {
			s/%BACK%//g;
			s/%SEND%//g;

			if (/%MIDI%/) {
				if ($Data{midi} ne 'none') {
					Error("Midi file not found: $MidiDir/$Data{midi}") if (! -f "$MidiDir/$Data{midi}");
					$MidiCID=GenerateCID();
					s!%MIDI%!<BGSOUND src=cid:$MidiCID AUTOSTART=true> <EMBED SRC=cid:$MidiCID HIDDEN=true AUTOSTART=TRUE!;
				}
			}

			if (/img src/i and ! /%IMAGE%/) {
				$ImageCID[$ExtraImages]=GenerateCID();
				s/(.*<img src=)\"*//i;
				$Startline = $1;

				if (/\"*\s+.*?>/) {
					s/\"*(\s+.*?>)(.*$)// && ($Attributes=$1,$Extra=$2);
				}
				else {
					s/(\"*>)(.*$)// && ($Attributes=$1,$Extra=$2);
				}

				$ImageURL = $_;
				$ExtraImagePath[$ExtraImages]=ImageLocation("$ImageURL");
				$ExtraImageType[$ExtraImages]=ImageType("$ExtraImagePath[$ExtraImages]");
				$Text .= "${Startline}\"cid:$ImageCID[$ExtraImages]\" $Attributes\n";
				$ExtraImages++;
				s/.*//;
			}
			elsif (/body.*background/i) {
				$ImageCID[$ExtraImages]=GenerateCID();
				s/(.*background=)\"*//i;
				$Startline = $1;

				if (/\"*\s+.*?>/) {
					s/\"*(\s+.*?>)(.*$)// && ($Attributes=$1,$Extra=$2);
				}
				else {
					s/(\"*>)(.*$)// && ($Attributes=$1,$Extra=$2);
				}

				$ImageURL = $_;
				$ExtraImagePath[$ExtraImages]=ImageLocation("$ImageURL");
				$ExtraImageType[$ExtraImages]=ImageType("$ExtraImagePath[$ExtraImages]");
				$Text .= "${Startline}\"cid:$ImageCID[$ExtraImages]\" $Attributes\n";
				$ExtraImages++;
				s/.*//;
			}
			else {
				s/%IMAGE%/cid:$CID/g;
			}
		}

		s/%SEND%//g;
		s/%MIDI%//g;
		s/%TITLE%/$Data{title}/g;
		s/%SENDER%/$Data{s_name}/g;
		s/%SENDER_EMAIL%/$Data{s_email}/g;
		s/%RECIPIENT%/$Data{r_name}/g;
		s/%RECIPIENT_EMAIL%/$Data{r_email}/g;
		s/%SUBJECT%/$Subject/g;
		s/%MESSAGE%/$Data{message}/g;

		$Text .= "$_";
	}

	close(POSTCARD);

}

#-----------------------------------------------------------------------------
# Send postcard as an HTML file

sub SendHTML {
	my $i=0;

	$ExtraImages=0;

	ReadHTML();

	$msg = new MIME::Lite
		From	=> "$Sender",
		To	=> "$Data{r_email}",
		Subject => "$Subject",
		Type    => 'multipart/related';

	attach $msg
		Type	=> 'text/html',
		Data	=> "$Text";

	$part = build MIME::Lite
		Type		=> "image/$ImageType",
		Encoding	=> 'base64',
		Path		=> "$ImagePath";

	$part->attr("Content-ID" => "<$CID>");
	$msg->attach($part);


	#
	# Attach the midi file (if chosen)
	#
	if ($Data{midi} ne 'none') {
		Error("Midi file not found: $MidiDir/$Data{midi}") if (! -f "$MidiDir/$Data{midi}");

		$part = build MIME::Lite
			Type		=> "audio/mid",
			Encoding	=> 'base64',
			Path		=> "$MidiDir/$Data{midi}";

		$part->attr("Content-ID" => "<$MidiCID>");
		$msg->attach($part);
	}

	#
	# Attach any additional images
	#
	if ($ExtraImages > 0) {
		foreach ($i=0; $i < $ExtraImages; $i++) {
			$part = build MIME::Lite
			Type		=> "image/$ExtraImageType[$i]",
			Encoding	=> 'base64',
			Path		=> "$ExtraImagePath[$i]";

			$part->attr("Content-ID" => "<$ImageCID[$i]>");
			$msg->attach($part);
		}
	}

}

#-----------------------------------------------------------------------------
#
# Sends the postcard in HTML design, but doesn't include the image in the
# mail, just the URL to the image.  

sub SendWeb {
	open(POSTCARD,"$Postcard/$Data{design}") or Error("Can not open postcard design: $Postcard/$Data{design}");

	$Subject="$Data{subject}" if ("$Data{subject}");


	while (<POSTCARD>) {
		next if (/^#/);

		s!%IMAGE%!$WebRoot/$Data{image}!g;

		if ($Data{preview}) {
			s!%BACK%!<FORM><INPUT TYPE=BUTTON VALUE="Return to Form" onClick="history.go(-1);return true"></FORM>!g;
		}

		if (/%MIDI%/ and $Data{midi} ne 'none') {
			Error("Midi file not found: $MidiDir/$Data{midi}") if (! -f "$MidiDir/$Data{midi}");
			s!%MIDI%!<BGSOUND src=$WebRoot/$MidiURL/$Data{midi} AUTOSTART=TRUE> <EMBED SRC=$WebRoot/$MidiURL/$Data{midi} HIDDEN=true AUTOSTART=TRUE>!;
		}
		else {
			s/%MIDI%//g;
		}

		s/%BACK%//g;
		s/%SEND%//g;
		s/%TITLE%/$Data{title}/g;
		s/%SENDER%/$Data{s_name}/g;
		s/%SENDER_EMAIL%/$Data{s_email}/g;
		s/%RECIPIENT%/$Data{r_name}/g;
		s/%RECIPIENT_EMAIL%/$Data{r_email}/g;
		s/%SUBJECT%/$Subject/g;
		s/%MESSAGE%/$Data{message}/g;

		$Text .= "$_";
	}

	close(POSTCARD);

	# Now create the mail structure
	
	$msg = new MIME::Lite
		From	=> "$Sender",
		To	=> "$Data{r_email}",
		Subject => "$Subject",
		Type	=> 'text/html',
		Data	=> "$Text";

}

#-----------------------------------------------------------------------------
# Logs the postcard details
#
# Order is Date (YYYY-MM-DD), Time, Method, Design, Image URL, Midi,
# Remote Host, Subject, Sender email, Sender Name, Receiver email, 
# Receiver Name and the Message. 

sub PostcardLog {
	my $tm=localtime;

	open (LOG,">>$Logfile") or Error("Can not open or write to log: $Logfile");

	LockFile(LOG);

	$RemoteHost=$ENV{'REMOTE_HOST'} || 'Unknown';

	printf LOG ("%04d-%02d-%02d|%02d:%02d|",$tm->year+1900,($tm->mon)+1, $tm->mday, $tm->hour, $tm->min);

	print LOG "$Data{method}|";

	if ($Data{method} eq 'plain') {
		print LOG "Plain design|";
	}
	else {
		print LOG "$Data{design}|";
	}

	$Data{message} =~ s// /g;

	print LOG "$Data{midi}|$Data{image}|$RemoteHost|$Subject|$Data{s_email}|$Data{s_name}|$Data{r_email}|$Data{r_name}|$Data{message}\n";
	close (LOG);
	UnlockFile(LOG);
}
	
#-----------------------------------------------------------------------------
# Converts the URL of an image to corresponding pathname.

sub ImageLocation {
	my ($Image) = @_;

	return("$WebDocs/$Image") unless %URLMappings;
	return("$Image") if ($Image =~ /http:/);

	while (($Key,$Value) = each %URLMappings) {
		$Key =~ s%/%\\/%g;
		if ($Image =~ /$Key/) {
			($ImagePath=$Image) =~ s%$Key%$Value%;
			last;
		}
	}

	if ($ImagePath) {
		return("$ImagePath");
	}
	else {
		return("$WebDocs/$Image");
	}
}

#-----------------------------------------------------------------------------
# Generates a Content ID

sub GenerateCID {
	srand();
	return(int(time).rand().rand());
}

#-----------------------------------------------------------------------------
# Returns a very primative determination of the image type

sub ImageType {
	my ($Image) = @_;
  
	if ($Image =~ /\.jpg$/i || $Image =~ /\.jpeg$/i) {
		return("jpeg");
    	} 
	elsif ($Image =~ /\.gif$/i) {
		return("gif");	
	} 
	elsif ($Image =~ /\.bmp$/i) {
		return("bmp");
	}
	elsif ($Image =~ /\.png$/i) {
		return("png");
	}
	else {
		Error("Image: $Image does not appear to be gif, jpg, bmp or png");
	}
}

#-----------------------------------------------------------------------------
sub SendFromPreview {
	return <<EOF
<FORM METHOD="POST" ACTION="$CGI">
<INPUT TYPE=HIDDEN NAME=image VALUE="$Data{image}">
<INPUT TYPE=HIDDEN NAME=title VALUE="$Data{title}">
<INPUT TYPE=HIDDEN NAME=config VALUE="$Data{config}">
<INPUT TYPE=HIDDEN NAME=method VALUE="$Data{method}">
<INPUT TYPE=HIDDEN NAME=design VALUE="$Data{design}">
<INPUT TYPE=HIDDEN NAME=message VALUE="$Data{message}">
<INPUT TYPE=HIDDEN NAME=midi VALUE="$Data{midi}">
<INPUT TYPE=HIDDEN NAME=s_email VALUE="$Data{s_email}">
<INPUT TYPE=HIDDEN NAME=r_email VALUE="$Data{r_email}">
<INPUT TYPE=HIDDEN NAME=r_name VALUE="$Data{r_name}">
<INPUT TYPE=HIDDEN NAME=s_name VALUE="$Data{s_name}">
<INPUT TYPE=HIDDEN NAME=subject VALUE="$Subject">

<INPUT TYPE=SUBMIT NAME=send VALUE="Send Postcard">
</FORM>
EOF
}


#-----------------------------------------------------------------------------
# Lock a file

sub LockFile {
	my ($FH) = @_;
	my $Status=0;
	my $Tries=0;

	while ($Status != 0) {
		$Status = flock($FH,2);
		($Tries == 4) && last;
		$Status && sleep(1);
		$Tries++;
	}
}

#-----------------------------------------------------------------------------
# Unlock a file

sub UnlockFile {
	my ($FH) = @_;

	flock($FH,8);
}

#-----------------------------------------------------------------------------
# Display any input errors from the form

sub InputError {
	my ($Text)=@_;

	open (INPUTERROR,"$InputError") or Error("Can not open $InputError");

	print "Content-type: text/html\n\n";

	while (<INPUTERROR>) {
		next if (/^#/);
		s/%MESSAGE%/$Text/g;
		s!%BACK%!<FORM><INPUT TYPE=BUTTON VALUE="Return to Form" onClick="history.go(-1);return true"></FORM>!g;
		print;
	}

	close(INPUTERROR);

	exit;
}


#-----------------------------------------------------------------------------
# Check for possible security hacks
sub CheckBadData {
	Error("Invalid design name") if ($Data{design} !~ m#^([\w.-]+)$#); 
	Error("Invalid midi name") if ($Data{midi} !~ m#^([\w.-]+)$#); 
}

#-----------------------------------------------------------------------------
# Display any errors using the template

sub Error {
	my ($Text)=@_;

	print "Content-type: text/html\n\n";

	ErrorStandard("$Text") if (! -f $Error);

	open (ERROR,"$Error") or ErrorStandard("$Text");


	while (<ERROR>) {	
		next if (/^#/);
		s/%MESSAGE%/$Text/g;
		print;
	}

	close(ERROR);
	exit;
}

#-----------------------------------------------------------------------------
# Foolproof way to display errors if the error template doesn't exist.
sub ErrorStandard {
	my ($Text)=@_;

	print <<HTML;
<HTML>
<HEAD>
<TITLE>Postcard Direct Error</TITLE>
</HEAD>

<BODY BGCOLOR="#ffffff">
<CENTER>
<H1>Postcard Direct Error</H1>
</CENTER>

<P>
$Text
<P>

</BODY>
</HTML>
HTML

	exit;
}


#-----------------------------------------------------------------------------
# Check for a valid email address format.  Adapted from Tom Christianson
# ckaddr script
#
sub CheckAddress {
	my($address)=@_;

	return "Incomplete email address" if ($address !~ /\@./);

	for ($address) {
		s/^-+//;
		tr/A-Z/a-z/;
	}

	($user, $domain) = split /\@/, $address;

	return "$Result" if ($Result=rfc822($address));

	if ($StrictEmailCheck) {
		return "$Result" if ($Result=CheckUser($user));
		return "$Result" if ($Result=CheckDomain($domain));
	}

}


#-----------------------------------------------------------------------------
sub CheckUser {  
	my $user = shift;

	return("Username: contains only a single character") if length($user) == 1;

	study $user;

	return("Username: duplicate letters") if $user =~ /(\w)\1{3,}/;

	return("Username: contains whitespace") if $user =~ /\s/;

	return("Username: contains invalid characters") if $user =~ /[;,\/#^*]/;

	return("Username: contains duplicate letters") if $user =~ /^(.)\1+$/;

	return("Username: contains no valid characters") unless $user =~ /[a-z0-9]/;

	return("Username: backspace") if $user =~ /[\010\177]/;

	$letters = "qwertyuiopasdfghjklzxcvbnmmnbvcxzlkjhgfrdsapoiuytrewq";

	return("Username: contains consecutive letters") if 
		length($user) > 2 &&
		( index($letters, $user) != -1
		    ||
		  ($user =~ /^(\w+)\1$/ && length($1) > 2
		    && index($letters, $1) != -1)
		);
}

#-----------------------------------------------------------------------------
sub CheckDomain {
	my $domain = shift;

	return("incomplete domain name") unless index($domain, '.') >= 0;

	study $domain;

	return("Domain name: contains whitespace") if $domain =~ /\s/;

	return("Domain name: contains invalid characters") if $domain =~ /[;,\/#^*]/;

	return("Domain name: must contain letters") unless $domain =~ /[a-z]/;

	return("Domain name: contains backspace") if $domain =~ /[\010\177]/;

}

#-----------------------------------------------------------------------------
sub rfc822 { 

	# rfc822 -- check whether address is valid rfc 822 address
	# tchrist@perl.com
	#
	# pattern developed in program by jfriedl; 
	# see "Mastering Regular Expressions" from ORA for details


	my $address = shift;
	local $_;

	undef $RFC822PAT;

	while (<DATA>) {
		chomp;
		$RFC822PAT .= $_;
	} 

	return($address =~ /^$RFC822PAT$/o ? 0 : "Invalid email address format");

}

# don't touch this stuff down here or you'll break the rfc822 matcher.
__END__
(?:[\040\t]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff]|\((?:[^\\\x80-\xff\n
\015()]|\\[^\x80-\xff])*\))*\))*(?:(?:[^(\040)<>@,;:".\\\[\]\000-\037\x80-\
xff]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff])|"(?:[^\\\x80-\xff\n\015"
]|\\[^\x80-\xff])*")(?:(?:[\040\t]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xf
f]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff])*\))*\))*\.(?:[\040\t]|\((?:[
^\\\x80-\xff\n\015()]|\\[^\x80-\xff]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\
xff])*\))*\))*(?:[^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,;
:".\\\[\]\000-\037\x80-\xff])|"(?:[^\\\x80-\xff\n\015"]|\\[^\x80-\xff])*"))
*(?:[\040\t]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff]|\((?:[^\\\x80-\xff\
n\015()]|\\[^\x80-\xff])*\))*\))*@(?:[\040\t]|\((?:[^\\\x80-\xff\n\015()]|\
\[^\x80-\xff]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff])*\))*\))*(?:[^(\04
0)<>@,;:".\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x80-
\xff])|\[(?:[^\\\x80-\xff\n\015\[\]]|\\[^\x80-\xff])*\])(?:(?:[\040\t]|\((?
:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80
-\xff])*\))*\))*\.(?:[\040\t]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff]|\(
(?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff])*\))*\))*(?:[^(\040)<>@,;:".\\\[\]
\000-\037\x80-\xff]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff])|\[(?:[^\\
\x80-\xff\n\015\[\]]|\\[^\x80-\xff])*\]))*|(?:[^(\040)<>@,;:".\\\[\]\000-\0
37\x80-\xff]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff])|"(?:[^\\\x80-\xf
f\n\015"]|\\[^\x80-\xff])*")(?:[^()<>@,;:".\\\[\]\x80-\xff\000-\010\012-\03
7]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff]|\((?:[^\\\x80-\xff\n\015()]|\
\[^\x80-\xff])*\))*\)|"(?:[^\\\x80-\xff\n\015"]|\\[^\x80-\xff])*")*<(?:[\04
0\t]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff]|\((?:[^\\\x80-\xff\n\015()]
|\\[^\x80-\xff])*\))*\))*(?:@(?:[\040\t]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x
80-\xff]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff])*\))*\))*(?:[^(\040)<>@
,;:".\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff]
)|\[(?:[^\\\x80-\xff\n\015\[\]]|\\[^\x80-\xff])*\])(?:(?:[\040\t]|\((?:[^\\
\x80-\xff\n\015()]|\\[^\x80-\xff]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff
])*\))*\))*\.(?:[\040\t]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff]|\((?:[^
\\\x80-\xff\n\015()]|\\[^\x80-\xff])*\))*\))*(?:[^(\040)<>@,;:".\\\[\]\000-
\037\x80-\xff]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff])|\[(?:[^\\\x80-
\xff\n\015\[\]]|\\[^\x80-\xff])*\]))*(?:(?:[\040\t]|\((?:[^\\\x80-\xff\n\01
5()]|\\[^\x80-\xff]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff])*\))*\))*,(?
:[\040\t]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff]|\((?:[^\\\x80-\xff\n\0
15()]|\\[^\x80-\xff])*\))*\))*@(?:[\040\t]|\((?:[^\\\x80-\xff\n\015()]|\\[^
\x80-\xff]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff])*\))*\))*(?:[^(\040)<
>@,;:".\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x80-\xf
f])|\[(?:[^\\\x80-\xff\n\015\[\]]|\\[^\x80-\xff])*\])(?:(?:[\040\t]|\((?:[^
\\\x80-\xff\n\015()]|\\[^\x80-\xff]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\x
ff])*\))*\))*\.(?:[\040\t]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff]|\((?:
[^\\\x80-\xff\n\015()]|\\[^\x80-\xff])*\))*\))*(?:[^(\040)<>@,;:".\\\[\]\00
0-\037\x80-\xff]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff])|\[(?:[^\\\x8
0-\xff\n\015\[\]]|\\[^\x80-\xff])*\]))*)*:(?:[\040\t]|\((?:[^\\\x80-\xff\n\
015()]|\\[^\x80-\xff]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff])*\))*\))*)
?(?:[^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,;:".\\\[\]\000
-\037\x80-\xff])|"(?:[^\\\x80-\xff\n\015"]|\\[^\x80-\xff])*")(?:(?:[\040\t]
|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff]|\((?:[^\\\x80-\xff\n\015()]|\\[
^\x80-\xff])*\))*\))*\.(?:[\040\t]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xf
f]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff])*\))*\))*(?:[^(\040)<>@,;:".\
\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff])|"(?:
[^\\\x80-\xff\n\015"]|\\[^\x80-\xff])*"))*(?:[\040\t]|\((?:[^\\\x80-\xff\n\
015()]|\\[^\x80-\xff]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff])*\))*\))*@
(?:[\040\t]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff]|\((?:[^\\\x80-\xff\n
\015()]|\\[^\x80-\xff])*\))*\))*(?:[^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff
]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff])|\[(?:[^\\\x80-\xff\n\015\[\
]]|\\[^\x80-\xff])*\])(?:(?:[\040\t]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\
xff]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff])*\))*\))*\.(?:[\040\t]|\((?
:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80
-\xff])*\))*\))*(?:[^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@
,;:".\\\[\]\000-\037\x80-\xff])|\[(?:[^\\\x80-\xff\n\015\[\]]|\\[^\x80-\xff
])*\]))*(?:[\040\t]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff]|\((?:[^\\\x8
0-\xff\n\015()]|\\[^\x80-\xff])*\))*\))*>)(?:[\040\t]|\((?:[^\\\x80-\xff\n\
015()]|\\[^\x80-\xff]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff])*\))*\))*