#!/usr/local/bin/perl -- -*-perl-*-

#

#  Copy to your site and modify as you like, but leave these comments:
#
#        See http://www.ualberta.ca/GEO/MailENV.html  for details.
#
#        George Carmichael, Univ of Alberta  Feb 13/96
#        Send comments/suggestions to George.Carmichael@ualberta.ca
#


# Someone asked how to automatically mail Environment Variables.
#  This ought to do it.
#
#  ... uses the "trojan horse" technique to automatically send into
#      to the specified recipient  -- So it will only work from
#      graphical browsers.
#
#      After it does the trojan horse, it redirects to a gif image
#      as specified
#
# Embed into your HTML document like this:
#
#    <img alt=" " src="http://www.ualberta.ca/htbin/MailENV?yourid@yoursite.edu&http://yoursite.edu/whatever/somepicture.gif">

do "/www/htbin/change_machine";		## This kludge neccesary
&run_on_BUZZ;				## because of the temporary
					## www.ualberta.ca proxy being run


# Set global identifiers...

chop($date = `date`);
chop($hostname = `hostname`);
chop($thisID=`whoami`);
$thisID='root' if (!$thisID);
$thisID="$thisID@$hostname";



#######################################################
##
## S Y S  A D M I N S  C H A N G E   T H E S E
##        T O  M A T C H  Y O U R  S I T E
##

## Restrict the recipients to on-campus addresses.
## Remove to allow unlim sending, which will be a security breach,
## or stupidity, because then every web user in the world can attach
## this script.

	$restricted_pattern = "ualberta.ca";	## <-- change to your site.


# $administrator should be tagged onto the bottom of the email message
# so that if messages go astray, the innocent bystander who gets the
# mail has a contact person to call...

	$administrator = "webmaster\@ualberta.ca";	## <-- change to you.


# Change this to who should normally get the mail if nothing specified.
#
#  root@$hostname 	will send to the root of the machine running this daemon.
#  $thidID 		should be the normal default
#  "nobody"		will cause the Mail component to be ignored. 

	$DEFAULT_recipient 	= $thisID ;


# This should match the mail program on your system.

	$mailprog = '/usr/lib/sendmail';

# A default gif URL to send if none specified

	$DEFAULT_gifURL 	= "http://www.ualberta.ca/icons/Finger.gif";


#   %% Blacklist...
#      Add recipients that would normally pass the "restricted_pattern",
#      but are abusing the system.
#      These are usually people who should be using a COUNTER/logging
#      program, but were too stupid.
#      MailENV should be used to alert people of OBSCURE web pages that
#      are hit -- not several times an hour.
#
	$blacklist{'someone@ee.ualberta.ca'}='2002Jan31: 20 hits per day';
	$blacklist{'someone_else@ualberta.ca'}='2002Feb2: 10 hits per day';
	$blacklist{'another.guy@ualberta.ca'}='2002Mar14: 10 hits per day';



##
##
#######################################################





$buffer = $ARGV[0];						# Get the input

($recipient,$gifURL) = split(/&/, $buffer);			# Only 2 params


$recipient =~ s/\\//ig;		# Sometimes, spurious "\" get attached to the recipient.


$recipient = $DEFAULT_recipient	if (! $recipient =~ /@/);  	# EMail must have @
$gifURL = $DEFAULT_gifURL	if (! $gifURL);			# Anything goes for gif

$gifURL =~ s/\\//g;	# De-escapize any backslashes on the gif line.



&do_mail;		# Opens Mail prog, sends mail

&do_redirect;		# Redirects the input to specified URL

exit;





# ------------------------------------------------------------

sub do_mail
{
# Filter security holes:

$recipient =~ s/~!/ ~!/g;
$recipient =~ s/;//g;
$recipient =~ s/\`//g;
$recipient =~ s/\|//g;
$recipient =~ s#\/##g;


return if ((!$recipient) | ($recipient eq 'nobody'));

   
## Check for REMOTE_HOST
## Need to do this if your server daemon isn't checking/nslookup-ing host names...
##
     if ((!$ENV{'REMOTE_HOST'}) || ($ENV{'REMOTE_HOST'} eq $ENV{'REMOTE_ADDR'})) {
                $ENV{'REMOTE_HOST'} = &host($ENV{'REMOTE_ADDR'});
        }




## Check to see if the $recipient includes 
## the substring $restricted_pattern
## This curtails everyone in the planet from using your machine as
## a mailer.

if ($restricted_pattern){

	@recips = split(',',$recipient);

	foreach $tmp1 (@recips) {

		#$tmp1 = $recipient;
		$tmp1 =~ tr/[A-Z]/[a-z]/;
		$restricted_pattern =~ tr/[A-Z]/[a-z]/;
		&restricted_error unless ( $tmp1 =~ /$restricted_pattern/);   ## Also Exits

		&blacklist_error if $blacklist{$tmp1};	## Also Exits

	}
}


# That's it.  Ready to EMail the $ENV stuff.
# A Full list of Enviromnent variables is at 
#             http://www.ualberta.ca/GEO/EchoPost.html


open (MAIL, "|$mailprog $recipient") || die "Can't open $mailprog!\n";

print MAIL <<EOF
To: $recipient 
Date: $date 
From: $0 <$thisID>  
Reply-to: $thisID ($0)  
Subject: $ENV{'REMOTE_HOST'} accessed $ENV{'HTTP_REFERER'}  

------------------------------------------------------------
               Date: $date
        Remote host: $ENV{'REMOTE_HOST'}
  Remote IP address: $ENV{'REMOTE_ADDR'}
  Accessed this URL: $ENV{'HTTP_REFERER'}

------------------------------------------------------------

Sent via  $0 from $hostname
Contact $administrator if there are problems

EOF
;

close (MAIL);

}

# ------------------------------------------------------------



sub do_redirect
{

			print "Location: $gifURL\n\n";
    
}




# ------------------------------------------------------------
sub restricted_error
{
	print STDERR "[$date] $0: $ENV{'HTTP_REFERER'} Request to mail outside the restricted pattern\n";
	print STDERR "[$date] $0: ... '$recipient':  '$tmp1' not in '$restricted_pattern'\n";

	# If you REALLY wanted to get fancy, you could spew an error gif.
	# We'll just redirect like nothing happened.

	$gifURL="http://www.ualberta.ca/icons/MailENVRestricted.gif";

	&do_redirect;
	
	exit;
	
}

# ------------------------------------------------------------
sub blacklist_error
{
        chop($date = `date`);
        $date =~ s/MST //i;
        $date =~ s/MDT //i;
        print STDERR "[$date] [info] $ENV{'REMOTE_ADDR'} $ENV{'HTTP_REFERER'} $0 blacklisted recipient: '$tmp1'  \n"   ;

        # If you REALLY wanted to get fancy, you could spew an error gif.
        # We'll just redirect like nothing happened.

        ## $gifURL="http://www.ualberta.ca/icons/MailENVRestricted.gif";

        &do_redirect;

        exit;

}




# This subroutine simulates the AIX "host" command.
#
#  GC Aug 29/96
#
sub host {
local($checkme)=@_;
local($Rhn,$aliases,$type,$len,@Ripp,$Rip,$temp,$junk);
if ($checkme) {

        if ($checkme =~ /[^0-9\.]/) {

                ($Rhn, $aliases, $type, $len, @Ripp) = gethostbyname($checkme);
                foreach $temp (@Ripp){
                        $Rip = join('.', unpack('C4', $temp));
                        # print "<br>debug: ip is       '$Rip' \n";
                }

                        # print "<br>debug: checkme is     '$checkme' \n";
                        # print "<br>debug: hostname is '$Rhn' \n";
                        # print "<br>debug: aliases is    '$aliases' \n";

        } else {
                $junk = pack("C4", split(/\./,$checkme));
                ($Rhn, $aliases, $type, $len, @Ripp) = gethostbyaddr($junk,2);
                foreach $temp (@Ripp){
                        $Rip = join('.', unpack('C4', $temp));
                        # print "<br>debug: ip is       '$Rip' \n";
                }
                        # print "<br>debug: checkme is     '$DEST' \n";
                        # print "<br>debug: hostname is '$Rhn' \n";
                        # print "<br>debug: aliases is    '$aliases' \n";
        }

        $Rhn = $checkme  if ($Rhn eq '');


        $aliases =~ s/\s/, /g;


        $temp = "$Rhn is $Rip";
        $temp = $temp . ", Aliases: $aliases"  if ($aliases);
        $temp = $temp . "\n";
        $Rhn;
}
}