#!/usr/bin/perl
$|=1;                                                              
################################################################## 
#  (C)1999 Bignosebird.com                                         
#  This software is FREEWARE! Do with it as you wish. It is yours  
#  to share and enjoy. Modify it, improve it, and have fun with it!
#  It is distributed strictly as a learning aid and bignosebird.com
#  disclaims all warranties- including but not limited to:         
#  fitness for a particular purpose, merchantability, loss of      
#  business, harm to your system, etc... ALWAYS BACK UP YOUR       
#  SYSTEM BEFORE INSTALLING ANY SCRIPT OR PROGRAM FROM ANY         
#  SOURCE!                                                         
################################################################## 

$result=$ENV{'QUERY_STRING'};

&set_params;


if ($logem{$result} eq "Y")
  {&notification("L");}
if ($email{$result} eq "Y")
  {&notification("M");}

print "Content-type: text/html\n\n";
print "$msg{$result}\n";

sub set_params
{
##################################################################
#
# This is where all of the various parameters for the script are
# set.
#
#The full path to your error log (not server log!) file.
    $errorlog="/home/perlarchive/data/birdtrap.dat";


# TPA Addition - Added Browser based log viewing
if ($result eq "viewlog"){
	print "Content-type: text/plain\n\n";
	open(FILE, "< $errorlog")|| die $!;
	while (<FILE>) {
		print $_;
	}
	close(FILE);
	exit;
}


#The e-mail address of the person to notify when an error occurs.
#Be sure to put the \ backslash before the \@ at sign!!!
   $notify="errors\@perlarchive.com";

#The name of your site
   $sitename="The Perl Archive";

#The link the reader should follow home.
   $returnlink="http://www.perlarchive.com/";

#This is the URL to the directory holding your images.
   $imageurl="http://www.perlarchive.com/images";

#The name of your sendmail program, one of the two below should work.
#Make sure you always use the -t option or the script will fail.
   $mailprog="/usr/sbin/sendmail -t";
#    $mailprog="/usr/lib/sendmail -t";

#This is just a link back to BigNoseBird.Com. Leaving it in is
#always appreciated. ;-)
$cpr=<<_CPR_;
<P><CENTER><FONT SIZE=1>BirdTrap Server Error Handler, another free script
from <A HREF="http://bignosebird.com/">BigNoseBird.Com</A></FONT></CENTER>
_CPR_

#By default, e-mail is turned off for all errors. 
#Windows APACHE users MUST leave the mail feature off.
#Change the N to Y if you want to receive e-mail when a particular
#error occurs.
%email=('000','N',
        '400','N',
        '401','N',
        '403','N',
        '404','N',
        '500','N');

#By default, all errors are saved to the log file.
#Change the Y to N if you do not wish to log a particular type of
#error.
%logem=('000','Y',
        '400','Y',
        '401','Y',
        '403','Y',
        '404','Y',
        '500','Y');

#These are the Subject Lines for the e-mail notification
#You can modify these without causing any problems.
%sbjct=( '000', 'UNKNOWN ERROR',
         '400', 'BAD REQUEST',
         '401', 'NO AUTHORIZATION',
         '403', 'FORBIDDEN URL',
         '404', 'MISSING URL',
         '500', 'CONFIGURATION ERROR');


# TPA Addition - Added Header

$header = qq~
$font
<BASEFONT SIZE=2>
<A HREF="http://www.perlarchive.com/">The Perl Archive</A> : 
<FONT COLOR=RED>Error</B></TD>

<DIV ALIGN=CENTER><P><TABLE BORDER=0 CELLSPACING=0 WIDTH=97%><TR>
	<TD WIDTH=77% VALIGN=TOP><TABLE BORDER=0 CELLPADDING=0 CELLSPACING=0 WIDTH=100%>
	<TR><TD VALIGN=TOP>${font}&nbsp;${font}<FONT SIZE=4><B>Error...</B></FONT></FONT></TD></TR>
	<TR><TD BGCOLOR=#FFCC66 HEIGHT=3><TABLE BORDER=0 CELLPADDING=1 CELLSPACING=0 WIDTH=100%><TR><TD></TD></TR></TABLE></TD>
</TR></TABLE><BR><BLOCKQUOTE>$font~;

# TPA Addition - Added Footer

$footer = qq~
<P>&nbsp;
</FONT></TD>
</TR></TABLE>
</BODY></HTML>
~;


###################################################################
# Leave the next 3 lines alone!
if ($result ne "400" && $result ne "401" 
      && $result ne "403" && $result ne "404" && $result ne "500")
   {$result="000";}
###################################################################
#
# EDIT THE HTML ERROR MESSAGES BELOW TO SUITE YOUR NEEDS. DO NOT
# CHANGE OR MOVE THE OPENING AND CLOSING TAGS SUCH AS __40X__
#
#HTML CODE TO APPEAR WHEN A BAD REQUEST OCCURS
$msg{'400'} =<<__400__;
<HTML>
<TITLE>The Perl Archive: Bad Request</TITLE>

$header

<FONT SIZE=4><B>ERROR $result</B></FONT>
<P>The URL that you requested, $ENV{'REDIRECT_URL'}
was a bad request.
<P>
Please <A HREF="$returnlink">Click Here</A> to Return to our Home Page.
<P>&nbsp;<P>&nbsp;
$cpr
$footer
__400__

################################################################## 
#HTML CODE TO APPEAR WHEN AN UNAUTHORIZED PAGE ACCESS ATTEMP OCCURS
$msg{'401'} =<<__401__;
<HTML>
<TITLE>The Perl Archive: Access Forbidden</TITLE>

$header

<FONT SIZE=4><B>ERROR $result</B></FONT>
<P>The URL that you requested, $ENV{'REDIRECT_URL'}
requires preauthorization to access.
<P>
Please <A HREF="$returnlink">Click Here</A> to Return to our Home Page.
<P>&nbsp;<P>&nbsp;
$cpr
$footer
__401__


################################################################## 
#HTML CODE TO APPEAR WHEN A FORBIDDEN ATTEMPT IS MADE
$msg{'403'} =<<__403__;
<HTML>
<TITLE>The Perl Archive: Forbidden</TITLE>

$header

<FONT SIZE=4><B>ERROR $result</B></FONT>
<P>Access to the URL that you requested, $ENV{'REDIRECT_URL'},
is forbidden.
<P>
Please <A HREF="$returnlink">Click Here</A> to Return to our Home Page.
<P>&nbsp;<P>&nbsp;
$cpr
$footer
__403__


################################################################## 
#HTML CODE TO APPEAR WHEN A DOCUMENT NOT FOUND HAPPENS
$msg{'404'} =<<__404__;
<HTML>
<TITLE>The Perl Archive: File Not Found</TITLE>

$header

<FONT SIZE=4><B>ERROR $result</B></FONT>
<P>The URL that you requested, $ENV{'REDIRECT_URL'}
could not be found. Perhaps you either mistyped the 
URL or we have a broken link. 
<P>
We have logged this error and will correct the
problem if it is a broken link, and notify you
after the webmaster has been flogged.
<P>
Please <A HREF="$returnlink">Click Here</A> to Return to our Home Page.
<P>&nbsp;<P>&nbsp;
$cpr
$footer
__404__

################################################################## 
#HTML CODE TO APPEAR WHEN A SERVER CONFIGURATION ERROR OCCURS
$msg{'500'} =<<__500__;
<HTML>
<TITLE>The Perl Archive: Internal Server Error</TITLE>

$header

<FONT SIZE=4><B>ERROR $result</B></FONT>
<P>The URL that you requested, $ENV{'REDIRECT_URL'}
resulted in a server configuration error. It is 
possible that the condition causing the problem will
be gone by the time you finish reading this.
<P>
We have logged this error and will correct the
problem.
<P>
Please <A HREF="$returnlink">Click Here</A> to Return to our Home Page.
<BR>&nbsp;
<P>&nbsp;<P>&nbsp;
$cpr
$footer
__500__

################################################################## 
#HTML CODE TO APPEAR WHEN AN UNKNOWN ERROR OCCURS
$msg{'000'} =<<__000__;
<HTML>
<TITLE>The Perl Archive: Unknown Error</TITLE>

$header

<FONT SIZE=4><B>ERROR $result</B></FONT>
<P>The URL that you requested, $ENV{'REDIRECT_URL'}
resulted in an unknown error code.
It is possible that the condition causing the problem will
be gone by the time you finish reading this.
<P>
We have logged this error and will correct the
problem.
<P>
Please <A HREF="$returnlink">Click Here</A> to Return to our Home Page.
<P>&nbsp;<P>&nbsp;
$cpr
$footer
__000__

}


################################################################## 
# this routine either sends e-mail or writes to a log depending
# on whether it was called with an "L" or "M"
sub notification
{
  local($action) = @_;

$date=localtime(time);

if ($action eq "L") 
  { open (BL,">>$errorlog");}
 else 
  {open (BL,"| $mailprog");
   print BL "To: $notify\n";
   print BL "From: $notify\n";
   print BL "Subject: $sbjct{$result}\n";
  }
  
print BL <<_BL_;
Error at:	$sitename
Error Code:	$result $sbjct{$result}
Occurred on:	$date
When the URL	$ENV{'REDIRECT_URL'} was requested
Referring URL:	$ENV{'HTTP_REFERER'}
By User:	$ENV{'REMOTE_ADDR'}
Browser:	$ENV{'HTTP_USER_AGENT'}
------------------------------------------------------------------------------
_BL_

close (BL);

}