#!/usr/bin/perl -w
#
#   errors 2.8 / 13 Aug 2017 / Miles O'Neal / miels.oneal@gmail.com
#   version 1.x by Brandon Long at NCSA/UIUC
#
#   See README & INSTALL for details.

# COPYRIGHT, WARRANTY, ETC
#
# (Version 1.x)
# This script is in the Public Domain.  NCSA and the author offer no
# guarantees nor claim any responsibility for it.  That's as pseudo-legalise
# as I get.
#
# (Version 2.0 through 2.3)
# This script is still in the Public Domain.  RRU, Net Ads, and the
# author neither offer any guarantee nor claim any responsibility for
# its actions, lack thereof, side effects, or anything else.  If you
# can't deal with these terms, don't use this script.
#
# (Version 2.4 through current)
# This script is still free to use with only slight restrictions. See
# the LEGALSTUFF file for details; the intent is to keep the code freely
# available. RRU, Net Ads, and the author neither offer any guarantee nor
# claim any responsibility for its actions, lack thereof, side effects, or
# anything else. If you can't deal with these terms, don't use the software.

#########################################################################
#### VARIABLES

# BE SURE to set the $err_lib variable!
#
# See the INSTALL file regarding changes required to your
# Server Resource Configuration file (srm.conf, httpd.conf,
# etc.)

$err_lib = "./Errors";

$version = "2.8";
$extra = 0;       # forces dump of environment vars - useful for debugging
$debug_only = 0;  # no error messages - just HTTP headers and whatever
                  # comes out.

#
# $has_dir - whether a supported message sends HTTP directives
#
# format: key (http code) and 1 if server sends directive, else 0
%has_dir = (
    302 => 1,
    400 => 0,
    401 => 1,
    403 => 0,
    404 => 0,
    408 => 0,
    410 => 0,
    413 => 0,
    500 => 0,
    501 => 0,
    503 => 0
);

%rm = (
    302 => "Temporary Redirect",
    400 => "Bad Request",
    401 => "Unauthorized (Requires Authentication)",
    403 => "Forbidden (Unspecified Reason)",
    404 => "Not Found",
    408 => "Request Timeout",
    410 => "Page No Longer AVailable",
    413 => "Request Entity Too Large",
    500 => "Internal Server Error",
    501 => "Not Implemented",
    503 => "Service Temporarily Unavailable",
);

#########################################################################
#### FUNCTIONS

#   http() - output any special HTTP headers for this code

sub http($) {
    local($key) = @_;
    printf($http{$key});
}


#   Html() - output the common HTML stuff and the customized response
#       for this code

$html{99999} = "This hash gets defined in the EML";

sub Html($) {
    local($key) = @_;
    common_html();
    printf('<FONT SIZE="+1">'.$html{$key}.'</FONT>');
}


#   htmlUnknown() - What to output when you can't make sense of the
#       error code.  Usually caused by calling error script with
#       unexpected parameters.

### This should get redefined in the chosen EML.
$unknown_msg = "666 The server appears to have lost its mind. We apologize for the inconvenience.";

sub htmlUnknown () {
    common_html();
    printf($unknown_msg);
}

#########################################################################
#### MAIN PROGRAM

$error = $ENV{'QUERY_STRING'};
$error =~ s/error=//;

#$redirect_request = $ENV{'REDIRECT_REQUEST'};
$redirect_status = $ENV{'REDIRECT_STATUS'};
$redirect_method = $ENV{'REQUEST_METHOD'};
$request_url = ((defined($ENV{'$PATH_INFO'}) && ($ENV{'$PATH_INFO'} ne "")) ?
    $ENV{'$PATH_INFO'} :
    ((defined($ENV{'$REQUEST_URI'}) && ($ENV{'$REQUEST_URI'} ne "")) ?
        $ENV{'$REQUEST_URI'} : "unknown path"));
#($redirect_method,$request_url,$redirect_protocol) =
#    split(' ',$redirect_request);

if (!defined($redirect_status)) {
  $redirect_status = "200 Ok";
}
($redirect_number,$redirect_message) = split(' ',$redirect_status);
if (!defined($redirect_message) || $redirect_message eq "") {
    $redirect_message = "$redirect_number ".$rm{$redirect_number};
}

if ($redirect_method eq "HEAD") {
    $head_only = 1;
} else {
    $head_only = 0;
}

# <DANGER, WILL ROBINSON!>
#
# DO NOT EDIT THIS SECTION UNLESS YOU
# KNOW EXACTLY WHAT YOU ARE DOING!
#
# Output the HTTP headers.
#
# (Note - no blank line is included here because
# some errors require extra HTTP headers.  The
# blank line is output just before the HTML tag.)
#
#$ENV{'SERVER_PROTOCOL'} $redirect_status
$port = ($ENV{'SERVER_PORT'} == 80) ? "" : ":$ENV{'SERVER_PORT'}";
print << "__EOD__";
Server: $ENV{'SERVER_SOFTWARE'}
Content-type: text/html
__EOD__

# </DANGER, WILL ROBINSON!>

if ($debug_only) {
    printf("<BODY>web-errors version: $version</BODY>\n");
    exit (1);
}


# Here we include the appropriate module for the SERVER_NAME.  If there's
# not a module for that, go with the default.  If the default is missing,
# we have a problem!

if ($error =~ /http:/) {
    $myLoc = $error;
} else {
    $myLoc = "\"http://$ENV{'SERVER_NAME'}$port$error\"";
}

if ( -e "$err_lib/err-$ENV{'SERVER_NAME'}.plinc") {
    require "$err_lib/err-$ENV{'SERVER_NAME'}.plinc";
} else {
    require "$err_lib/err-default.plinc";
}


# COMMON HTML HEADER - standard top of page stuff
#
#   This is the default <BODY> tag.  It will get used only if there
#   is not one defined in the ELM require'd above.

if (! defined($body_tag) || $body_tag eq "") {
    $body_tag = '<BODY BGCOLOR="#ffffff" TEXT="#000000"
    LINK="#ff0000" ALINK="#00cc00" VLINK="#ff0000">';
}

#   check for various other required info; if missing, supply defaults.

if (! defined($title_tag) || $title_tag eq "") {
    $title_tag = $redirect_message;
}
if (! defined($h1_tag) || $h1_tag eq "") {
    $h1_tag = $redirect_message;
}
if (! open FOO, "site_maps") {
    $goto_url = "\"http://$ENV{'SERVER_NAME'}$port/" .
       ($1 ? "$1/" : "") . "\"";
    $logo_img = "";
} else {
    $found = "";
    @logo_data = <FOO>;
    foreach $line (@logo_data) {
        if ($line !~ /^\s*#/ && $line !~ /^$/ && $line !~ /^\s*$/) {
            ($logo_re, $logo_url, $goto_url) = split(/::/, $line);
            if ($ENV{'REDIRECT_URL'} =~ $logo_re) {
                $foo = $1;
                $found = 1;
                if ($logo_url ne "") {
                    $logo_img = "<IMG SRC=\"" . $logo_url .
                        "\" ALIGN=\"right\">\n";
                } else {
                    $logo_img = "";
                }
                if ($goto_url eq "") {
                    $goto_url = "\"http://$ENV{'SERVER_NAME'}$port/" .
                        ($foo ? "$foo" : "") . "\"";
                }
                last;
            }
        }
    }
    close FOO;

    if (! $found) {
        $goto_url = "\"http://$ENV{'SERVER_NAME'}$port/" .
       ($1 ? "$1/" : "") . "\"";
    $logo_img = "";
    }
}

sub common_html {
    print << "__EOD__";

<HTML>
<HEAD>
<TITLE>$title_tag</TITLE>
</HEAD>
$body_tag
<BLOCKQUOTE>

$logo_img
<H1><IMG ALT="" WIDTH=28 HEIGHT=28 SRC="/icons/warning.gif">
    $h1_tag</H1>
__EOD__
}

$found = 0;

foreach $key (keys %has_dir) {
    if ($redirect_number == $key) {
        if ($has_dir{$key}) {
            http($key);
        }
        if (! $head_only) {
            Html($key);
        }
        $found = 1;
        last;
    }
}

if (! $found && ! $head_only) {
    htmlUnknown();
}


# If we are sending HTML, see whether they want the environment dumped.
# If so, dump it.  In either case, if we are sending HTML, send the
# trailer stuff and end things.

if (!$head_only) {
    if ($extra) {
        printf("\r\n<P>\r\nThe following might be useful in" .
        " determining the problem:\r\n");
        printf("<PRE>\r\n");
        open(ENV,"env|");
        while (<ENV>) {
            printf("$_");
        }
        close(ENV);
        printf("</PRE>\r\n<HR>\r\n");
    }
    print <<__EOD__;

<P>
<A HREF=$goto_url><IMG ALT="[Back to Top]" BORDER=0
    WIDTH=40 HEIGHT=40 SRC="/icons/home_red.gif">
Go to the server's home page</A>

<P>

If you believe you have really found a broken link or other problem,
please send details to
<I><A HREF="mailto:$ENV{'SERVER_ADMIN'}">$ENV{'SERVER_ADMIN'}</A></I>
including:
<UL>
<LI>The URL you attempted to access
<LI>Where you got the link from
<LI>The time and date of the failed attempt
</UL>
Thank you for letting us know about this.

</BLOCKQUOTE>
</BODY>
</HTML>
__EOD__
}

# keeps perl from generating warnings about sunused variables.
# If you use them, you can get rid of these.

$fred = $redirect_message;
$fred = $request_url;
