# Selima Website Content Management System
# HTTP.pm: The various HTTP status processors.

#  Copyright (c) 2003-2018 imacat.
#
#  Licensed under the Apache License, Version 2.0 (the "License");
#  you may not use this file except in compliance with the License.
#  You may obtain a copy of the License at
#
#      http://www.apache.org/licenses/LICENSE-2.0
#
#  Unless required by applicable law or agreed to in writing, software
#  distributed under the License is distributed on an "AS IS" BASIS,
#  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
#  See the License for the specific language governing permissions and
#  limitations under the License.

# Author: imacat <imacat@mail.imacat.idv.tw>
# First written: 2003-03-26

package Selima::HTTP;
use 5.008;
use strict;
use warnings;
use base qw(Exporter);
use vars qw(@EXPORT @EXPORT_OK);
BEGIN {
@EXPORT = qw();
push @EXPORT, qw(http_204 http_301 http_303 http_304 http_307);
push @EXPORT, qw(http_400 http_403 http_404 http_405 http_410 http_413 http_500 http_503);
@EXPORT_OK = @EXPORT;
# Prototype declaration
sub need_302();
sub get_custom_status_message($);
sub shall_mail_error();
sub http_204();
sub http_301($);
sub http_303($);
sub http_304();
sub http_307($);
sub http_400(;$);
sub http_403(;$);
sub http_404();
sub http_405(@);
sub http_410();
sub http_413();
sub http_500($);
sub http_503(;$);
}

use CGI qw(header);
use Encode qw(encode);
use HTTP::Date qw(time2str);
use IO::NestedCapture qw(CAPTURE_STDOUT);

BEGIN {
if (exists $ENV{"MOD_PERL_API_VERSION"} && $ENV{"MOD_PERL_API_VERSION"} >= 2) {
    require Apache2::Connection;
    require Apache2::Response;
}
}

use Selima::A2HTML;
use Selima::AbsURI;
use Selima::AltLang;
use Selima::DataVars qw(:env :input :l10n :lastmod :lninfo
    :output :requri :siteconf);
use Selima::DecForm;
use Selima::Format;
use Selima::GeoIP;
use Selima::GetLang;
use Selima::Logging;
use Selima::LogIn;
use Selima::Page2Rel;
use Selima::PageFunc;
use Selima::ShortCut;
use Selima::Unicode;
use Selima::XFileIO;
use Selima::XHTML;

use Selima::Mail;

BEGIN {
# Only import this when mod_perl.
if ($IS_MODPERL) {
    if ($IS_MP2) {
        require Apache2::Const;
        import Apache2::Const qw(:methods);
    } else {
        require Apache::Constants;
        import Apache::Constants qw(:methods);
    }
# Otherwise, set to dummy values to get around strict checking
} else {
    require constant;
    import constant M_OPTIONS => 0;
    import constant M_GET => 0;
    import constant M_HEAD => 0;
    import constant M_POST => 0;
    import constant M_PUT => 0;
    import constant M_DELETE => 0;
    import constant M_TRACE => 0;
    import constant M_CONNECT => 0;
}
}

# need_302: Is this browser capable of HTTP 303 and HTTP 307?
# Currently only older Netscape without Gecko (version <= 4.xx)
# is known of this problem.
# Return:
#   false: Standard behavior to send HTTP 303 or 307.
#   true:  Browser lacks the capability of redirecting
#          HTTP 303 and 307.  Send HTTP 302 instead.
sub need_302() {
    local ($_, %_);
    # User-Agent not sent, default to the standard behavior.
    return 0 unless exists $ENV{"HTTP_USER_AGENT"};
    
    $_ = $ENV{"HTTP_USER_AGENT"};
    # Not Mozilla/Netscape series
    return 0 unless /^Mozilla\//;
    # Mozilla/Netscape compatible
    return 0 if /\bcompatible\b/;
    # Mozilla/Netscape with Gecko (version > 4)
    return 0 if /\bGecko\b/;
    # Mozilla/Netscape without Gecko (version <= 4)
    return 1;
}

# get_custom_status_message: Obtain the custom status message
sub get_custom_status_message($) {
    local ($_, %_);
    my ($html, $status, $langfile, $charset);
    $status = $_[0];
    
    $langfile = getlang(LN_FILENAME);
    
    # Find language specific error message first
    if (-e ($_ = "$DOC_ROOT/errors/$status.html.$langfile.xhtml")) {
        $html = xfread $_;
    } elsif (-e ($_ = "$DOC_ROOT/errors/$status.html.$langfile")) {
        $html = xfread $_;
    } elsif (-e ($_ = "$DOC_ROOT/$langfile/errors/$status.html.xhtml")) {
        $html = xfread $_;
    } elsif (-e ($_ = "$DOC_ROOT/$langfile/errors/$status.html")) {
        $html = xfread $_;
    } elsif (-e ($_ = "$DOC_ROOT/errors/$status.html.xhtml")) {
        $html = xfread $_;
    } elsif (-e ($_ = "$DOC_ROOT/errors/$status.html")) {
        $html = xfread $_;
    }
    # Not found
    return if !defined $html;
    
    # Reserve the character set
    $charset = getlang(LN_CHARSET);
    $html = hcref_decode($charset, $html);
    
    $charset = h($charset);
    $html =~ s/(?<=\bencoding=")$charset(?=")/<!--selima:charset-->/;
    $html =~ s/(?<=\bcontent="text\/html; charset=)$charset(?=")/<!--selima:charset-->/;
    $html =~ s/(?<=\bcontent="application\/xhtml\+xml; charset=)$charset(?=")/<!--selima:charset-->/;
    $html =~ s/(?<=\btype="hidden" name="charset" value=")$charset(?=" \/>)/<!--selima:charset-->/g;
    $html =~ s/(?<=\baccept-charset=")$charset(?=")/<!--selima:charset-->/g;
    return $html;
}

# shall_mail_error: Should we mail the error to the webmaster
sub shall_mail_error() {
    local ($_, %_);
    # Return "no" if not CGI
    return 0 if !$IS_CGI;
    # Return "no" if inside our intranet
    $_ = $IS_MODPERL? ($IS_MP2?
        Apache2::RequestUtil->request->connection->remote_ip:
        Apache->request->connection->remote_ip):
        $ENV{"REMOTE_ADDR"};
    return 0 if /^10\.0\.0\./ || $_ eq "127.0.0.1";
    # Default to yes
    return 1;
}

# http_204: HTTP/1.1 204 No Content
sub http_204() {
    local ($_, %_);
    my ($html, $r, $type, %h);
    
    # Obtain the Apache mod_perl request
    $r = $IS_MP2? Apache2::RequestUtil->request: Apache->request
        if $IS_MODPERL;
    # Clear the STDOUT buffer
    IO::NestedCapture->stop(CAPTURE_STDOUT)
        while   exists IO::NestedCapture->instance->{"STDOUT_current"}
                && @{IO::NestedCapture->instance->{"STDOUT_current"}} > 0;
    # Skip content auto-output
    $NO_AUTO_OUTPUT = 1;
    
    # Only output headers to the CGI interface
    if ($IS_CGI) {
        $type = defined $CONTENT_TYPE? $CONTENT_TYPE: xhtml_content_type;
        # The mod_perl way
        if ($IS_MODPERL) {
            $r->status(204);
            $r->headers_out->set("Content-Length"=>0);
            $r->content_languages([getlang LN_NAME])
                if $type =~ /^text\//;
            # Client cache
            if (defined $LAST_MODIFIED) {
                if (defined get_login_sn) {
                    $r->headers_out->set("Cache-Control"=>"private");
                } else {
                    $r->headers_out->set("Cache-Control"=>"public");
                }
                $r->headers_out->set("Last-Modified"=>time2str($LAST_MODIFIED));
            } else {
                $r->headers_out->set("Cache-Control"=>"no-cache");
            }
            # Content negotiation, see HTTP/1.1 section 13.6
            if (    @ALL_LINGUAS > 1
                    && $r->method ne "POST"
                    && $r->method ne "PUT"
                    && !defined $GET->param("lang")) {
                $r->headers_out->set("Content-Location"=>altlang(getlang, page_param));
                $r->headers_out->set("Vary"=>"accept-language,cookie");
            }
            $r->headers_out->add("Set-Cookie"=>$_)
                foreach values %NEWCOOKIES;
        
        # Ordinary CGI
        } else {
            # Output the status message
            %h = (  -status=>"204 No Content",
                    -Content_Length=>0);
            $h{"-Content_Language"} = getlang LN_NAME
                if $type =~ /^text\//;
            # Content negotiation, see HTTP/1.1 section 13.6
            if (    @ALL_LINGUAS > 1
                    && $ENV{"REQUEST_METHOD"} ne "POST"
                    && $ENV{"REQUEST_METHOD"} ne "PUT"
                    && !defined $GET->param("lang")) {
                $h{"-Content_Location"} = altlang getlang, page_param;
                $h{"-Vary"} = "accept-language,cookie";
            }
            # Client cache
            if (defined $LAST_MODIFIED) {
                if (defined get_login_sn) {
                    $h{"-Cache_Control"} = "private";
                } else {
                    $h{"-Cache_Control"} = "public";
                }
                $h{"-Last_Modified"} = time2str($LAST_MODIFIED);
            } else {
                $h{"-Cache_Control"} = "no-cache";
            }
            $h{"-cookie"} = [values %NEWCOOKIES];
            print header(%h);
        }
    }
    
    # No need to return
    exit;
}

# http_301: HTTP/1.1 301 Moved Permanently
sub http_301($) {
    local ($_, %_);
    my ($html, $r, $type, %h, $url);
    $url = $_[0];
    
    # Obtain the Apache mod_perl request
    $r = $IS_MP2? Apache2::RequestUtil->request: Apache->request
        if $IS_MODPERL;
    # Clear the STDOUT buffer
    IO::NestedCapture->stop(CAPTURE_STDOUT)
        while   exists IO::NestedCapture->instance->{"STDOUT_current"}
                && @{IO::NestedCapture->instance->{"STDOUT_current"}} > 0;
    # Skip content auto-output
    $NO_AUTO_OUTPUT = 1;
    # Make URL absolute
    $url = absuri $url;
    
    # Obtain the status message
    $html = get_custom_status_message(301);
    # Fall back to a simplest default
    if (!defined $html) {
        $html = << "EOT";
<?xml version="1.0" encoding="US-ASCII" ?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN"
    "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en">
<head>
<title>301 Moved Permanently</title>
</head>
<body>
<h1>301 Moved Permanently</h1>
<p>You should refer to <a href="\$url">the new location</a>.</p>
</body>
</html>
EOT
    }
    # Replace the page content
    $html =~ s/\$url/h($url)/ge;
    # Convert the URLs to relative
    $html = page2rel $html, $REQUEST_PATH;
    # Encode the e-mail at-signs (@)
    $html =~ s/@/&#64;/g;
    # Decode the e-mail at-signs (@) of spamtrap
    $html =~ s/spamtrap&#64;/spamtrap@/g;
    
    # Only output headers to the CGI interface
    if ($IS_CGI) {
        # The mod_perl way
        if ($IS_MODPERL) {
            # Error documents can only be output as ISO-8859-1 under mod_perl.
            # It is hardcoded into Apache http_protocol.c ap_send_error_response().
            # See http://www.geocrawler.com/mail/msg.php3?msg_id=6288656
            $html = page_encode($html, "ISO-8859-1");
            $r->custom_response(301, $html);
            $r->status(301);
            $r->err_headers_out->set("Location"=>$url);
            $r->err_headers_out->set("Content-Language"=>getlang LN_NAME);
            $r->err_headers_out->set("Content-Length"=>length $html);
            # Content negotiation, see HTTP/1.1 section 13.6
            if (    @ALL_LINGUAS > 1
                    && $r->method ne "POST"
                    && $r->method ne "PUT"
                    && !defined $GET->param("lang")) {
                $r->err_headers_out->set("Content-Location"=>altlang(getlang, page_param));
                $r->err_headers_out->set("Vary"=>"accept-language,cookie");
            }
            $r->err_headers_out->add("Set-Cookie"=>$_)
                foreach values %NEWCOOKIES;
        
        # Ordinary CGI
        } else {
            $html = page_encode($html, getlang(LN_CHARSET));
            $type = xhtml_content_type . "; charset=" . getlang(LN_CHARSET);
            %h = (  -status=>"301 Moved Permanently",
                    -type=>$type,
                    -Location=>$url,
                    -Content_Language=>getlang(LN_NAME),
                    -Content_Length=>length $html);
            # Content negotiation, see HTTP/1.1 section 13.6
            if (    @ALL_LINGUAS > 1
                    && $ENV{"REQUEST_METHOD"} ne "POST"
                    && $ENV{"REQUEST_METHOD"} ne "PUT"
                    && !defined $GET->param("lang")) {
                $h{"-Content_Location"} = altlang getlang, page_param;
                $h{"-Vary"} = "accept-language,cookie";
            }
            $h{"-cookie"} = [values %NEWCOOKIES];
            print header(%h);
            print $html if $ENV{"REQUEST_METHOD"} ne "HEAD";
        }
    
    # Output the content directly as a console application
    } else {
        print page_encode($html, getlang(LN_CHARSET))
            if $ENV{"REQUEST_METHOD"} ne "HEAD";
    }
    
    # No need to return
    exit;
}

# http_303: HTTP/1.1 303 See Others
sub http_303($) {
    local ($_, %_);
    my ($html, $r, $type, %h, $url);
    $url = $_[0];
    
    # Obtain the Apache mod_perl request
    $r = $IS_MP2? Apache2::RequestUtil->request: Apache->request
        if $IS_MODPERL;
    # Clear the STDOUT buffer
    IO::NestedCapture->stop(CAPTURE_STDOUT)
        while   exists IO::NestedCapture->instance->{"STDOUT_current"}
                && @{IO::NestedCapture->instance->{"STDOUT_current"}} > 0;
    # Skip content auto-output
    $NO_AUTO_OUTPUT = 1;
    # Make URL absolute
    $url = absuri $url;
    
    # Obtain the status message
    $html = get_custom_status_message(303);
    # Fall back to a simplest default
    if (!defined $html) {
        $html = << "EOT";
<?xml version="1.0" encoding="US-ASCII" ?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN"
"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en">
<head>
<title>303 See Others</title>
</head>
<body>
<h1>303 See Others</h1>
<p>Please follow <a href="\$url">this location</a>.</p>
</body>
</html>
EOT
    }
    # Replace the page content
    $html =~ s/\$url/h($url)/ge;
    # Convert the URLs to relative
    $html = page2rel $html, $REQUEST_PATH;
    # Encode the e-mail at-signs (@)
    $html =~ s/@/&#64;/g;
    # Decode the e-mail at-signs (@) of spamtrap
    $html =~ s/spamtrap&#64;/spamtrap@/g;
    
    # Only output headers to the CGI interface
    if ($IS_CGI) {
        # The mod_perl way
        if ($IS_MODPERL) {
            # Error documents can only be output as ISO-8859-1 under mod_perl.
            # It is hardcoded into Apache http_protocol.c ap_send_error_response().
            # See http://www.geocrawler.com/mail/msg.php3?msg_id=6288656
            $html = page_encode($html, "ISO-8859-1");
            if (need_302) {
                $r->custom_response(302, $html);
                $r->status(302);
            } else {
                $r->custom_response(303, $html);
                $r->status(303);
            }
            $r->err_headers_out->set("Location"=>$url);
            $r->err_headers_out->set("Content-Language"=>getlang LN_NAME);
            $r->err_headers_out->set("Content-Length"=>length $html);
            # Content negotiation, see HTTP/1.1 section 13.6
            if (    @ALL_LINGUAS > 1
                    && $r->method ne "POST"
                    && $r->method ne "PUT"
                    && !defined $GET->param("lang")) {
                $r->err_headers_out->set("Content-Location"=>altlang(getlang, page_param));
                $r->err_headers_out->set("Vary"=>"accept-language,cookie");
            }
            $r->err_headers_out->add("Set-Cookie"=>$_)
                foreach values %NEWCOOKIES;
        
        # Ordinary CGI
        } else {
            $html = page_encode($html, getlang(LN_CHARSET));
            $type = xhtml_content_type . "; charset=" . getlang(LN_CHARSET);
            %h = (  -status=>"303 See Others",
                    -type=>$type,
                    -Location=>$url,
                    -Content_Language=>getlang(LN_NAME),
                    -Content_Length=>length $html);
            $h{"-status"} = "302 Found" if need_302;
            # Content negotiation, see HTTP/1.1 section 13.6
            if (    @ALL_LINGUAS > 1
                    && $ENV{"REQUEST_METHOD"} ne "POST"
                    && $ENV{"REQUEST_METHOD"} ne "PUT"
                    && !defined $GET->param("lang")) {
                $h{"-Content_Location"} = altlang getlang, page_param;
                $h{"-Vary"} = "accept-language,cookie";
            }
            $h{"-cookie"} = [values %NEWCOOKIES];
            print header(%h);
            print $html if $ENV{"REQUEST_METHOD"} ne "HEAD";
        }
    
    # Output the content directly as a console application
    } else {
        print page_encode($html, getlang(LN_CHARSET))
            if $ENV{"REQUEST_METHOD"} ne "HEAD";
    }
    
    # No need to return
    exit;
}

# http_304: HTTP/1.1 304 Not Modified
sub http_304() {
    local ($_, %_);
    my ($html, $r, $type, %h);
    
    # Obtain the Apache mod_perl request
    $r = $IS_MP2? Apache2::RequestUtil->request: Apache->request
        if $IS_MODPERL;
    # Clear the STDOUT buffer
    IO::NestedCapture->stop(CAPTURE_STDOUT)
        while   exists IO::NestedCapture->instance->{"STDOUT_current"}
                && @{IO::NestedCapture->instance->{"STDOUT_current"}} > 0;
    # Skip content auto-output
    $NO_AUTO_OUTPUT = 1;
    
    # Only output headers to the CGI interface
    # See HTTP/1.1 sec 10.3.5 for appropriate headers to send
    if ($IS_CGI) {
        # The mod_perl way
        # We must do it in the mod_perl way, since the CGI.pm sends an
        #   excess line break under mod_perl, which breaks the HTTP/304
        #   response for the browser.
        if ($IS_MODPERL) {
            $r->status(304);
            $r->err_headers_out->add("Set-Cookie"=>$_)
                foreach values %NEWCOOKIES;
            # We must send them
            $r->err_headers_out->set("Content-Location"=>altlang(getlang, page_param))
                if @ALL_LINGUAS > 1;
        
        # Ordinary CGI
        } else {
            $type = (defined $CONTENT_TYPE? $CONTENT_TYPE: xhtml_content_type)
                . "; charset=" . getlang(LN_CHARSET);
            # Output the status message
            %h = (  -status=>"304 Not Modified");
            $h{"-Content_Location"} = altlang getlang, page_param
                if @ALL_LINGUAS > 1;
            # Avoid the bug of Apache/CGI that always send the content type
            #   even with HTTP/304
            $h{"-type"} = $type;
            $h{"-cookie"} = [values %NEWCOOKIES];
            print header(%h);
        }
    
    # Output the content directly as a console application
    } else {
        print page_encode($html, getlang(LN_CHARSET))
            if $ENV{"REQUEST_METHOD"} ne "HEAD";
    }
    
    # No need to return
    exit;
}

# http_307: HTTP/1.1 307 Temporary Redirect
sub http_307($) {
    local ($_, %_);
    my ($html, $r, $type, %h, $url);
    $url = $_[0];
    
    # Obtain the Apache mod_perl request
    $r = $IS_MP2? Apache2::RequestUtil->request: Apache->request
        if $IS_MODPERL;
    # Clear the STDOUT buffer
    IO::NestedCapture->stop(CAPTURE_STDOUT)
        while   exists IO::NestedCapture->instance->{"STDOUT_current"}
                && @{IO::NestedCapture->instance->{"STDOUT_current"}} > 0;
    # Skip content auto-output
    $NO_AUTO_OUTPUT = 1;
    # Make URL absolute
    $url = absuri $url;
    
    # Obtain the status message
    $html = get_custom_status_message(307);
    # Fall back to a simplest default
    if (!defined $html) {
        $html = << "EOT";
<?xml version="1.0" encoding="US-ASCII" ?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN"
    "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en">
<head>
<title>307 Temporary Redirect</title>
</head>
<body>
<h1>307 Temporary Redirect</h1>
<p>Please refer to <a href="\$url">the following location</a>.</p>
</body>
</html>
EOT
    }
    # Replace the page content
    $html =~ s/\$url/h($url)/ge;
    # Convert the URLs to relative
    $html = page2rel $html, $REQUEST_PATH;
    # Encode the e-mail at-signs (@)
    $html =~ s/@/&#64;/g;
    # Decode the e-mail at-signs (@) of spamtrap
    $html =~ s/spamtrap&#64;/spamtrap@/g;
    
    # Only output headers to the CGI interface
    if ($IS_CGI) {
        # The mod_perl way
        if ($IS_MODPERL) {
            # Error documents can only be output as ISO-8859-1 under mod_perl.
            # It is hardcoded into Apache http_protocol.c ap_send_error_response().
            # See http://www.geocrawler.com/mail/msg.php3?msg_id=6288656
            $html = page_encode($html, "ISO-8859-1");
            if (need_302) {
                $r->custom_response(302, $html);
                $r->status(302);
            } else {
                $r->custom_response(307, $html);
                $r->status(307);
            }
            $r->err_headers_out->set("Location"=>$url);
            $r->err_headers_out->set("Content-Language"=>getlang LN_NAME);
            $r->err_headers_out->set("Content-Length"=>length $html);
            # Content negotiation, see HTTP/1.1 section 13.6
            if (    @ALL_LINGUAS > 1
                    && $r->method ne "POST"
                    && $r->method ne "PUT"
                    && !defined $GET->param("lang")) {
                $r->err_headers_out->set("Content-Location"=>altlang(getlang, page_param));
                $r->err_headers_out->set("Vary"=>"accept-language,cookie");
            }
            $r->err_headers_out->add("Set-Cookie"=>$_)
                foreach values %NEWCOOKIES;
        
        # Ordinary CGI
        } else {
            $html = page_encode($html, getlang(LN_CHARSET));
            $type = xhtml_content_type . "; charset=" . getlang(LN_CHARSET);
            %h = (  -status=>"307 Temporary Redirect",
                    -type=>$type,
                    -Location=>$url,
                    -Content_Language=>getlang(LN_NAME),
                    -Content_Length=>length $html);
            $h{"-status"} = "302 Found" if need_302;
            # Content negotiation, see HTTP/1.1 section 13.6
            if (    @ALL_LINGUAS > 1
                    && $ENV{"REQUEST_METHOD"} ne "POST"
                    && $ENV{"REQUEST_METHOD"} ne "PUT"
                    && !defined $GET->param("lang")) {
                $h{"-Content_Location"} = altlang getlang, page_param;
                $h{"-Vary"} = "accept-language,cookie";
            }
            $h{"-cookie"} = [values %NEWCOOKIES];
            print header(%h);
            print $html if $ENV{"REQUEST_METHOD"} ne "HEAD";
        }
    
    # Output the content directly as a console application
    } else {
        print page_encode($html, getlang(LN_CHARSET))
            if $ENV{"REQUEST_METHOD"} ne "HEAD";
    }
    
    # No need to return
    exit;
}

# http_400: HTTP/1.1 400 Bad Request
#   0 to disable error page output
sub http_400(;$) {
    local ($_, %_);
    my ($html, $r, $type, %h);
    my $errmsg;
    $errmsg = $_[0];
    
    # Obtain the Apache mod_perl request
    $r = $IS_MP2? Apache2::RequestUtil->request: Apache->request
        if $IS_MODPERL;
    # Clear the STDOUT buffer
    IO::NestedCapture->stop(CAPTURE_STDOUT)
        while   exists IO::NestedCapture->instance->{"STDOUT_current"}
                && @{IO::NestedCapture->instance->{"STDOUT_current"}} > 0;
    # Skip content auto-output
    $NO_AUTO_OUTPUT = 1;
    
    # Obtain the status message
    $html = get_custom_status_message(400)
        unless defined $errmsg && $errmsg eq "0";
    # Fall back to a simplest default
    if (!defined $html) {
        $html = << "EOT";
<?xml version="1.0" encoding="US-ASCII" ?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN"
    "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en">
<head>
<title>400 Bad Request</title>
</head>
<body>
<h1>400 Bad Request</h1>
<!-- errmsg -->
<p>Sorry, the server cannot understand what you are asking for.</p>
</body>
</html>
EOT
    }
    # Replace the page content
    $html =~ s/<!-- errmsg -->/defined $errmsg && $errmsg ne "0"?
        "<p>" . h(F_($errmsg)) . "<\/p>": ""/ge;
    # Convert the URLs to relative
    $html = page2rel $html, $REQUEST_PATH;
    # Encode the e-mail at-signs (@)
    $html =~ s/@/&#64;/g;
    # Decode the e-mail at-signs (@) of spamtrap
    $html =~ s/spamtrap&#64;/spamtrap@/g;
    
    # Only output headers to the CGI interface
    if ($IS_CGI) {
        # The mod_perl way
        if ($IS_MODPERL) {
            # Error documents can only be output as ISO-8859-1 under mod_perl.
            # It is hardcoded into Apache http_protocol.c ap_send_error_response().
            # See http://www.geocrawler.com/mail/msg.php3?msg_id=6288656
            $html = page_encode($html, "ISO-8859-1");
            $r->custom_response(400, $html);
            $r->status(400);
            $r->err_headers_out->set("Content-Language"=>getlang LN_NAME);
            $r->err_headers_out->set("Content-Length"=>length $html);
            # Content negotiation, see HTTP/1.1 section 13.6
            if (    @ALL_LINGUAS > 1
                    && $r->method ne "POST"
                    && $r->method ne "PUT"
                    && !defined $GET->param("lang")) {
                $r->err_headers_out->set("Content-Location"=>altlang(getlang, page_param));
                $r->err_headers_out->set("Vary"=>"accept-language,cookie");
            }
            $r->err_headers_out->add("Set-Cookie"=>$_)
                foreach values %NEWCOOKIES;
        
        # Ordinary CGI
        } else {
            $html = page_encode($html, getlang(LN_CHARSET));
            $type = xhtml_content_type . "; charset=" . getlang(LN_CHARSET);
            %h = (  -status=>"400 Bad Request",
                    -type=>$type,
                    -Content_Language=>getlang(LN_NAME),
                    -Content_Length=>length $html);
            # Content negotiation, see HTTP/1.1 section 13.6
            if (    @ALL_LINGUAS > 1
                    && $ENV{"REQUEST_METHOD"} ne "POST"
                    && $ENV{"REQUEST_METHOD"} ne "PUT"
                    && !defined $GET->param("lang")) {
                $h{"-Content_Location"} = altlang getlang, page_param;
                $h{"-Vary"} = "accept-language,cookie";
            }
            $h{"-cookie"} = [values %NEWCOOKIES];
            print header(%h);
            print $html if $ENV{"REQUEST_METHOD"} ne "HEAD";
        }
    
    # Output the content directly as a console application
    } else {
        print page_encode($html, getlang(LN_CHARSET))
            if $ENV{"REQUEST_METHOD"} ne "HEAD";
    }
    
    # Log the error message to the server error log
    if (!defined $errmsg) {
        log_error "Bad Request: $REQUEST_URI";
    } elsif ($errmsg eq "0") {
        if ($IS_MODPERL) {
            $_ = $r->the_request;
        } else {
            $_ = $ENV{"REQUEST_METHOD"} . " "
                . $ENV{"REQUEST_URI"} . " " . $ENV{"SERVER_PROTOCOL"};
        }
        log_error "Invalid URI in request $_";
    } else {
        log_error "Bad Request: $REQUEST_URI: $errmsg";
    }
    
    # No need to return
    exit 400 if !$IS_CGI;
    exit;
}

# http_403: HTTP/1.1 403 Forbidden
sub http_403(;$) {
    local ($_, %_);
    my ($html, $r, $type, %h);
    my $errmsg;
    $errmsg = $_[0];
    
    # Obtain the Apache mod_perl request
    $r = $IS_MP2? Apache2::RequestUtil->request: Apache->request
        if $IS_MODPERL;
    # Clear the STDOUT buffer
    IO::NestedCapture->stop(CAPTURE_STDOUT)
        while   exists IO::NestedCapture->instance->{"STDOUT_current"}
                && @{IO::NestedCapture->instance->{"STDOUT_current"}} > 0;
    # Skip content auto-output
    $NO_AUTO_OUTPUT = 1;
    
    # Obtain the status message
    $html = get_custom_status_message(403)
        unless defined $errmsg && $errmsg eq "0";
    # Fall back to a simplest default
    if (!defined $html) {
        $html = << "EOT";
<?xml version="1.0" encoding="US-ASCII" ?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN"
    "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en">
<head>
<title>403 Forbidden</title>
</head>
<body>
<h1>403 Forbidden</h1>
<!-- errmsg -->
<p>You are not allowed to enter here.</p>
</body>
</html>
EOT
    }
    # Replace the page content
    $html =~ s/<!-- errmsg -->/defined $errmsg && $errmsg ne "0"?
        "<p>" . h(F_($errmsg)) . "<\/p>": ""/ge;
    # Convert the URLs to relative
    $html = page2rel $html, $REQUEST_PATH;
    # Encode the e-mail at-signs (@)
    $html =~ s/@/&#64;/g;
    # Decode the e-mail at-signs (@) of spamtrap
    $html =~ s/spamtrap&#64;/spamtrap@/g;
    
    # Only output headers to the CGI interface
    if ($IS_CGI) {
        # The mod_perl way
        if ($IS_MODPERL) {
            # Error documents can only be output as ISO-8859-1 under mod_perl.
            # It is hardcoded into Apache http_protocol.c ap_send_error_response().
            # See http://www.geocrawler.com/mail/msg.php3?msg_id=6288656
            $html = page_encode($html, "ISO-8859-1");
            $r->custom_response(403, $html);
            $r->status(403);
            $r->err_headers_out->set("Content-Language"=>getlang LN_NAME);
            $r->err_headers_out->set("Content-Length"=>length $html);
            # Content negotiation, see HTTP/1.1 section 13.6
            if (    @ALL_LINGUAS > 1
                    && $r->method ne "POST"
                    && $r->method ne "PUT"
                    && !defined $GET->param("lang")) {
                $r->err_headers_out->set("Content-Location"=>altlang(getlang, page_param));
                $r->err_headers_out->set("Vary"=>"accept-language,cookie");
            }
            $r->err_headers_out->add("Set-Cookie"=>$_)
                foreach values %NEWCOOKIES;
        
        # Ordinary CGI
        } else {
            $html = page_encode($html, getlang(LN_CHARSET));
            $type = xhtml_content_type . "; charset=" . getlang(LN_CHARSET);
            %h = (  -status=>"403 Forbidden",
                    -type=>$type,
                    -Content_Language=>getlang(LN_NAME),
                    -Content_Length=>length $html);
            # Content negotiation, see HTTP/1.1 section 13.6
            if (    @ALL_LINGUAS > 1
                    && $ENV{"REQUEST_METHOD"} ne "POST"
                    && $ENV{"REQUEST_METHOD"} ne "PUT"
                    && !defined $GET->param("lang")) {
                $h{"-Content_Location"} = altlang getlang, page_param;
                $h{"-Vary"} = "accept-language,cookie";
            }
            $h{"-cookie"} = [values %NEWCOOKIES];
            print header(%h);
            print $html if $ENV{"REQUEST_METHOD"} ne "HEAD";
        }
    
    # Output the content directly as a console application
    } else {
        print page_encode($html, getlang(LN_CHARSET))
            if $ENV{"REQUEST_METHOD"} ne "HEAD";
    }
    
    # Log the error message to the server error log
    if (!defined $errmsg) {
        log_error "Forbidden: $REQUEST_URI";
    } elsif ($errmsg eq "0") {
        if ($IS_MODPERL) {
            $_ = $r->the_request;
        } else {
            $_ = $ENV{"REQUEST_METHOD"} . " "
                . $ENV{"REQUEST_URI"} . " " . $ENV{"SERVER_PROTOCOL"};
        }
        log_error "Suspicious bad robot: $_";
    } else {
        log_error "Forbidden: $REQUEST_URI: $errmsg";
    }
    
    # No need to return
    exit 403 if !$IS_CGI;
    exit;
}

# http_404: HTTP/1.1 404 Not Found
sub http_404() {
    local ($_, %_);
    my ($html, $r, $type, %h);
    
    # Obtain the Apache mod_perl request
    $r = $IS_MP2? Apache2::RequestUtil->request: Apache->request
        if $IS_MODPERL;
    # Clear the STDOUT buffer
    IO::NestedCapture->stop(CAPTURE_STDOUT)
        while   exists IO::NestedCapture->instance->{"STDOUT_current"}
                && @{IO::NestedCapture->instance->{"STDOUT_current"}} > 0;
    # Skip content auto-output
    $NO_AUTO_OUTPUT = 1;
    
    # Obtain the status message
    $html = get_custom_status_message(404);
    # Fall back to a simplest default
    if (!defined $html) {
        $html = << "EOT";
<?xml version="1.0" encoding="US-ASCII" ?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN"
    "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en">
<head>
<title>404 Not Found</title>
</head>
<body>
<h1>404 Not Found</h1>
<p>The document you requested was not found.</p>
</body>
</html>
EOT
    }
    # Convert the URLs to relative
    $html = page2rel $html, $REQUEST_PATH;
    # Encode the e-mail at-signs (@)
    $html =~ s/@/&#64;/g;
    # Decode the e-mail at-signs (@) of spamtrap
    $html =~ s/spamtrap&#64;/spamtrap@/g;
    
    # Only output headers to the CGI interface
    if ($IS_CGI) {
        # The mod_perl way
        if ($IS_MODPERL) {
            # Error documents can only be output as ISO-8859-1 under mod_perl.
            # It is hardcoded into Apache http_protocol.c ap_send_error_response().
            # See http://www.geocrawler.com/mail/msg.php3?msg_id=6288656
            $html = page_encode($html, "ISO-8859-1");
            $r->custom_response(404, $html);
            $r->status(404);
            $r->err_headers_out->set("Content-Language"=>getlang LN_NAME);
            $r->err_headers_out->set("Content-Length"=>length $html);
            # Content negotiation, see HTTP/1.1 section 13.6
            if (    @ALL_LINGUAS > 1
                    && $r->method ne "POST"
                    && $r->method ne "PUT"
                    && !defined $GET->param("lang")) {
                $r->err_headers_out->set("Content-Location"=>altlang(getlang, page_param));
                $r->err_headers_out->set("Vary"=>"accept-language,cookie");
            }
            $r->err_headers_out->add("Set-Cookie"=>$_)
                foreach values %NEWCOOKIES;
        
        # Ordinary CGI
        } else {
            $html = page_encode($html, getlang(LN_CHARSET));
            $type = xhtml_content_type . "; charset=" . getlang(LN_CHARSET);
            %h = (  -status=>"404 Not Found",
                    -type=>$type,
                    -Content_Language=>getlang(LN_NAME),
                    -Content_Length=>length $html);
            # Content negotiation, see HTTP/1.1 section 13.6
            if (    @ALL_LINGUAS > 1
                    && $ENV{"REQUEST_METHOD"} ne "POST"
                    && $ENV{"REQUEST_METHOD"} ne "PUT"
                    && !defined $GET->param("lang")) {
                $h{"-Content_Location"} = altlang getlang, page_param;
                $h{"-Vary"} = "accept-language,cookie";
            }
            $h{"-cookie"} = [values %NEWCOOKIES];
            print header(%h);
            print $html if $ENV{"REQUEST_METHOD"} ne "HEAD";
        }
    
    # Output the content directly as a console application
    } else {
        print page_encode($html, getlang(LN_CHARSET))
            if $ENV{"REQUEST_METHOD"} ne "HEAD";
    }
    
    # Log the error message to the server error log
    log_error "Not Found: $REQUEST_URI";
    
    # No need to return
    exit 404 if !$IS_CGI;
    exit;
}

# http_405: HTTP/1.1 405 Method Not Allowed
sub http_405(@) {
    local ($_, %_);
    my ($html, $r, $type, %h, @allowed);
    @allowed = @_;
    
    # Obtain the Apache mod_perl request
    $r = $IS_MP2? Apache2::RequestUtil->request: Apache->request
        if $IS_MODPERL;
    # Clear the STDOUT buffer
    IO::NestedCapture->stop(CAPTURE_STDOUT)
        while   exists IO::NestedCapture->instance->{"STDOUT_current"}
                && @{IO::NestedCapture->instance->{"STDOUT_current"}} > 0;
    # Skip content auto-output
    $NO_AUTO_OUTPUT = 1;
    
    # Obtain the status message
    $html = get_custom_status_message(405);
    # Fall back to a simplest default
    if (!defined $html) {
        $html = << "EOT";
<?xml version="1.0" encoding="US-ASCII" ?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN"
    "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en">
<head>
<title>405 Method Not Allowed</title>
</head>
<body>
<h1>405 Method Not Allowed</h1>
<p>You should use the following methods: \$allowed.</p>
</body>
</html>
EOT
    }
    # Replace the page content
    $html =~ s/\$allowed/join(", ", map "<samp>" . h($_) . "<\/samp>", @allowed)/ge;
    # Convert the URLs to relative
    $html = page2rel $html, $REQUEST_PATH;
    # Encode the e-mail at-signs (@)
    $html =~ s/@/&#64;/g;
    # Decode the e-mail at-signs (@) of spamtrap
    $html =~ s/spamtrap&#64;/spamtrap@/g;
    
    # Only output headers to the CGI interface
    if ($IS_CGI) {
        # The mod_perl way
        if ($IS_MODPERL) {
            my $allowed_b;
            $allowed_b = 0;
            foreach (@allowed) {
                if ($_ eq "OPTIONS") {
                    $allowed_b |= (1 << M_OPTIONS);
                } elsif ($_ eq "GET") {
                    $allowed_b |= (1 << M_GET);
                # M_HEAD is not defined in Apache.  It is implied by M_GET.
                #} elsif ($_ eq "HEAD") {
                #    $allowed_b |= (1 << M_HEAD);
                } elsif ($_ eq "POST") {
                    $allowed_b |= (1 << M_POST);
                } elsif ($_ eq "PUT") {
                    $allowed_b |= (1 << M_PUT);
                } elsif ($_ eq "DELETE") {
                    $allowed_b |= (1 << M_DELETE);
                } elsif ($_ eq "TRACE") {
                    $allowed_b |= (1 << M_TRACE);
                } elsif ($_ eq "CONNECT") {
                    $allowed_b |= (1 << M_CONNECT);
                }
            }
            # Error documents can only be output as ISO-8859-1 under mod_perl.
            # It is hardcoded into Apache http_protocol.c ap_send_error_response().
            # See http://www.geocrawler.com/mail/msg.php3?msg_id=6288656
            $html = page_encode($html, "ISO-8859-1");
            $r->custom_response(405, $html);
            $r->status(405);
            $r->allowed($allowed_b);
            $r->err_headers_out->set("Content-Language"=>getlang LN_NAME);
            $r->err_headers_out->set("Content-Length"=>length $html);
            # Content negotiation, see HTTP/1.1 section 13.6
            if (    @ALL_LINGUAS > 1
                    && $r->method ne "POST"
                    && $r->method ne "PUT"
                    && !defined $GET->param("lang")) {
                $r->err_headers_out->set("Content-Location"=>altlang(getlang, page_param));
                $r->err_headers_out->set("Vary"=>"accept-language,cookie");
            }
            $r->err_headers_out->add("Set-Cookie"=>$_)
                foreach values %NEWCOOKIES;
        
        # Ordinary CGI
        } else {
            $html = page_encode($html, getlang(LN_CHARSET));
            $type = xhtml_content_type . "; charset=" . getlang(LN_CHARSET);
            %h = (  -status=>"405 Method Not Allowed",
                    -type=>$type,
                    -Allow=>join(", ", @allowed),
                    -Content_Language=>getlang(LN_NAME),
                    -Content_Length=>length $html);
            # Content negotiation, see HTTP/1.1 section 13.6
            if (    @ALL_LINGUAS > 1
                    && $ENV{"REQUEST_METHOD"} ne "POST"
                    && $ENV{"REQUEST_METHOD"} ne "PUT"
                    && !defined $GET->param("lang")) {
                $h{"-Content_Location"} = altlang getlang, page_param;
                $h{"-Vary"} = "accept-language,cookie";
            }
            $h{"-cookie"} = [values %NEWCOOKIES];
            print header(%h);
            print $html if $ENV{"REQUEST_METHOD"} ne "HEAD";
        }
    
    # Output the content directly as a console application
    } else {
        print page_encode($html, getlang(LN_CHARSET))
            if $ENV{"REQUEST_METHOD"} ne "HEAD";
    }
    
    # Log the error message to the server error log
    $_ = $IS_MODPERL? $r->method: $ENV{"REQUEST_METHOD"};
    log_error "$_: Method Not Allowed (" . join(", ", @allowed) . "): $REQUEST_URI\n";
    
    # No need to return
    exit 405 if !$IS_CGI;
    exit;
}

# http_410: HTTP 410 Gone
sub http_410() {
    local ($_, %_);
    my ($html, $r, $type, %h);
    
    # Obtain the Apache mod_perl request
    $r = $IS_MP2? Apache2::RequestUtil->request: Apache->request
        if $IS_MODPERL;
    # Clear the STDOUT buffer
    IO::NestedCapture->stop(CAPTURE_STDOUT)
        while   exists IO::NestedCapture->instance->{"STDOUT_current"}
                && @{IO::NestedCapture->instance->{"STDOUT_current"}} > 0;
    # Skip content auto-output
    $NO_AUTO_OUTPUT = 1;
    
    # Obtain the status message
    $html = get_custom_status_message(410);
    # Fall back to a simplest default
    if (!defined $html) {
        $html = << "EOT";
<?xml version="1.0" encoding="US-ASCII" ?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN"
    "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en">
<head>
<title>410 Gone</title>
</head>
<body>
<h1>410 Gone</h1>
<p>Sorry, this page is removed permanently, and there is no forwarding address available.  Please remove your bookmarks, and stop referring to this page any more.  Thanks.</p>
</body>
</html>
EOT
    }
    # Convert the URLs to relative
    $html = page2rel $html, $REQUEST_PATH;
    # Encode the e-mail at-signs (@)
    $html =~ s/@/&#64;/g;
    # Decode the e-mail at-signs (@) of spamtrap
    $html =~ s/spamtrap&#64;/spamtrap@/g;
    
    # Only output headers to the CGI interface
    if ($IS_CGI) {
        # The mod_perl way
        if ($IS_MODPERL) {
            # Error documents can only be output as ISO-8859-1 under mod_perl.
            # It is hardcoded into Apache http_protocol.c ap_send_error_response().
            # See http://www.geocrawler.com/mail/msg.php3?msg_id=6288656
            $html = page_encode($html, "ISO-8859-1");
            $r->custom_response(410, $html);
            $r->status(410);
            $r->err_headers_out->set("Content-Language"=>getlang LN_NAME);
            $r->err_headers_out->set("Content-Length"=>length $html);
            # Content negotiation, see HTTP/1.1 section 13.6
            if (    @ALL_LINGUAS > 1
                    && $r->method ne "POST"
                    && $r->method ne "PUT"
                    && !defined $GET->param("lang")) {
                $r->err_headers_out->set("Content-Location"=>altlang(getlang, page_param));
                $r->err_headers_out->set("Vary"=>"accept-language,cookie");
            }
            $r->err_headers_out->add("Set-Cookie"=>$_)
                foreach values %NEWCOOKIES;
        
        # Ordinary CGI
        } else {
            $html = page_encode($html, getlang(LN_CHARSET));
            $type = xhtml_content_type . "; charset=" . getlang(LN_CHARSET);
            %h = (  -status=>"410 Gone",
                    -type=>$type,
                    -Content_Language=>getlang(LN_NAME),
                    -Content_Length=>length $html);
            # Content negotiation, see HTTP/1.1 section 13.6
            if (    @ALL_LINGUAS > 1
                    && $ENV{"REQUEST_METHOD"} ne "POST"
                    && $ENV{"REQUEST_METHOD"} ne "PUT"
                    && !defined $GET->param("lang")) {
                $h{"-Content_Location"} = altlang getlang, page_param;
                $h{"-Vary"} = "accept-language,cookie";
            }
            $h{"-cookie"} = [values %NEWCOOKIES];
            print header(%h);
            print $html if $ENV{"REQUEST_METHOD"} ne "HEAD";
        }
    
    # Output the content directly as a console application
    } else {
        print page_encode($html, getlang(LN_CHARSET))
            if $ENV{"REQUEST_METHOD"} ne "HEAD";
    }
    
    # Log the error message to the server error log
    log_error "Gone: $REQUEST_URI";
    
    # No need to return
    exit 410 if !$IS_CGI;
    exit;
}

# http_413: HTTP/1.1 413 Request Entity Too Large
sub http_413() {
    local ($_, %_);
    my ($html, $r, $type, %h);
    
    # Obtain the Apache mod_perl request
    $r = $IS_MP2? Apache2::RequestUtil->request: Apache->request
        if $IS_MODPERL;
    # Clear the STDOUT buffer
    IO::NestedCapture->stop(CAPTURE_STDOUT)
        while   exists IO::NestedCapture->instance->{"STDOUT_current"}
                && @{IO::NestedCapture->instance->{"STDOUT_current"}} > 0;
    # Skip content auto-output
    $NO_AUTO_OUTPUT = 1;
    
    # Obtain the status message
    $html = get_custom_status_message(413);
    # Fall back to a simplest default
    if (!defined $html) {
        $html = << "EOT";
<?xml version="1.0" encoding="US-ASCII" ?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN"
    "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en">
<head>
<title>413 Request Entity Too Large</title>
</head>
<body>
<h1>413 Request Entity Too Large</h1>
<p>The server refuses to process your large submitted data.</p>
</body>
</html>
EOT
    }
    # Convert the URLs to relative
    $html = page2rel $html, $REQUEST_PATH;
    # Encode the e-mail at-signs (@)
    $html =~ s/@/&#64;/g;
    # Decode the e-mail at-signs (@) of spamtrap
    $html =~ s/spamtrap&#64;/spamtrap@/g;
    
    # Only output headers to the CGI interface
    if ($IS_CGI) {
        # The mod_perl way
        if ($IS_MODPERL) {
            # Error documents can only be output as ISO-8859-1 under mod_perl.
            # It is hardcoded into Apache http_protocol.c ap_send_error_response().
            # See http://www.geocrawler.com/mail/msg.php3?msg_id=6288656
            $html = page_encode($html, "ISO-8859-1");
            $r->custom_response(413, $html);
            $r->status(413);
            $r->err_headers_out->set("Content-Language"=>getlang LN_NAME);
            $r->err_headers_out->set("Content-Length"=>length $html);
            # Content negotiation, see HTTP/1.1 section 13.6
            if (    @ALL_LINGUAS > 1
                    && $r->method ne "POST"
                    && $r->method ne "PUT"
                    && !defined $GET->param("lang")) {
                $r->err_headers_out->set("Content-Location"=>altlang(getlang, page_param));
                $r->err_headers_out->set("Vary"=>"accept-language,cookie");
            }
            $r->err_headers_out->add("Set-Cookie"=>$_)
                foreach values %NEWCOOKIES;
        
        # Ordinary CGI
        } else {
            $html = page_encode($html, getlang(LN_CHARSET));
            $type = xhtml_content_type . "; charset=" . getlang(LN_CHARSET);
            %h = (  -status=>"413 Request Entity Too Large",
                    -type=>$type,
                    -Content_Language=>getlang(LN_NAME),
                    -Content_Length=>length $html);
            # Content negotiation, see HTTP/1.1 section 13.6
            if (    @ALL_LINGUAS > 1
                    && $ENV{"REQUEST_METHOD"} ne "POST"
                    && $ENV{"REQUEST_METHOD"} ne "PUT"
                    && !defined $GET->param("lang")) {
                $h{"-Content_Location"} = altlang getlang, page_param;
                $h{"-Vary"} = "accept-language,cookie";
            }
            $h{"-cookie"} = [values %NEWCOOKIES];
            print header(%h);
            print $html if $ENV{"REQUEST_METHOD"} ne "HEAD";
        }
    
    # Output the content directly as a console application
    } else {
        print page_encode($html, getlang(LN_CHARSET))
            if $ENV{"REQUEST_METHOD"} ne "HEAD";
    }
    
    # Log the error message to the server error log
    log_error "Request Entity Too Large: $REQUEST_URI";
    
    # No need to return
    exit 413 if !$IS_CGI;
    exit;
}

# http_500: HTTP/1.1 500 Internet Server Error
sub http_500($) {
    local ($_, %_);
    my ($html, $r, $type, %h);
    my ($errmsg, @callers, $remote);
    $errmsg = $_[0];
    
    # Find out our context
    for (my $i = 0, @callers = qw(); (@_ = caller $i) > 0; $i++) {
        # Avoid recursive calls
        # Not possible.  $SIG{"__DIE__"} is disabled during itself.
        # Context after Apache::Registry is not meaningful
        last if $_[1] =~ /\/Apache\/Registry\.pm$/;
        # Skip if in eval().
        # Apache handler() eval() is not trapped for it is at Apache::Registry
        #   and is skipped by the above rule.
        return if $_[3] eq "(eval)";
        push @callers, [@_];
    }
    
    # Obtain the Apache mod_perl request
    $r = $IS_MP2? Apache2::RequestUtil->request: Apache->request
        if $IS_MODPERL;
    # Clear the STDOUT buffer
    IO::NestedCapture->stop(CAPTURE_STDOUT)
        while   exists IO::NestedCapture->instance->{"STDOUT_current"}
                && @{IO::NestedCapture->instance->{"STDOUT_current"}} > 0;
    # Skip content auto-output
    $NO_AUTO_OUTPUT = 1;
    $remote = $IS_MODPERL? $r->connection->remote_ip:
        $ENV{"REMOTE_ADDR"};
    
    # Variables in the status message
    $errmsg =~ s/ at \S+ line \d+\.\n//;
    # Obtain the status message
    $html = get_custom_status_message(500);
    # Fall back to a simplest default
    if (!defined $html) {
        $html = << "EOT";
<?xml version="1.0" encoding="US-ASCII" ?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN"
    "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en">
<head>
<title>500 Internel Server Error</title>
</head>
<body>
<h1>500 Internel Server Error</h1>
<!-- errmsg -->
</div>
</body>
</html>
</html>
EOT
    }
    # Replace the page content
    $html =~ s/<!-- errmsg -->/
        "<div class=\"errmsg\">\n<samp>" . a2html($errmsg) . "<\/samp><br \/>\n"
        . join("<br \/>\n", map "at <samp>" . h($$_[1]) . "<\/samp> line " . h($$_[2]), @callers)
        . ".\n<\/div>"/ge;
    # Convert the URLs to relative
    $html = page2rel $html, $REQUEST_PATH;
    # Encode the e-mail at-signs (@)
    $html =~ s/@/&#64;/g;
    # Decode the e-mail at-signs (@) of spamtrap
    $html =~ s/spamtrap&#64;/spamtrap@/g;
    
    # Only output headers to the CGI interface
    if ($IS_CGI) {
        # The mod_perl way
        if ($IS_MODPERL) {
            # Error documents can only be output as ISO-8859-1 under mod_perl.
            # It is hardcoded into Apache http_protocol.c ap_send_error_response().
            # See http://www.geocrawler.com/mail/msg.php3?msg_id=6288656
            $html = page_encode($html, "ISO-8859-1");
            $r->custom_response(500, $html);
            $r->status(500);
            $r->err_headers_out->set("Content-Language"=>getlang LN_NAME);
            $r->err_headers_out->set("Content-Length"=>length $html);
            # Content negotiation, see HTTP/1.1 section 13.6
            if (    @ALL_LINGUAS > 1
                    && $r->method ne "POST"
                    && $r->method ne "PUT"
                    && !defined $GET->param("lang")) {
                $r->err_headers_out->set("Content-Location"=>altlang(getlang, page_param));
                $r->err_headers_out->set("Vary"=>"accept-language,cookie");
            }
            $r->err_headers_out->add("Set-Cookie"=>$_)
                foreach values %NEWCOOKIES;
        
        # Ordinary CGI
        } else {
            $html = page_encode($html, getlang(LN_CHARSET));
            $type = xhtml_content_type . "; charset=" . getlang(LN_CHARSET);
            %h = (  -status=>"500 Internel Server Error",
                    -type=>$type,
                    -Content_Language=>getlang(LN_NAME),
                    -Content_Length=>length $html);
            # Content negotiation, see HTTP/1.1 section 13.6
            if (    @ALL_LINGUAS > 1
                    && $ENV{"REQUEST_METHOD"} ne "POST"
                    && $ENV{"REQUEST_METHOD"} ne "PUT"
                    && !defined $GET->param("lang")) {
                $h{"-Content_Location"} = altlang getlang, page_param;
                $h{"-Vary"} = "accept-language,cookie";
            }
            $h{"-cookie"} = [values %NEWCOOKIES];
            print header(%h);
            print $html if $ENV{"REQUEST_METHOD"} ne "HEAD";
        }
    
    # Output the content directly as a console application
    } else {
        print page_encode($html, getlang(LN_CHARSET))
            if $ENV{"REQUEST_METHOD"} ne "HEAD";
    }
    
    # Mail the webmaster on this error
    if (shall_mail_error) {
        my ($mail, $webmaster, $site, $body, $reqline, $reqhdrs, $form);
        # Get the webmaster address to notify to
        if (defined $WEBMASTER) {
            $webmaster = $WEBMASTER;
        } elsif (exists $ENV{"SERVER_ADMIN"}) {
            $webmaster = $ENV{"SERVER_ADMIN"};
        } else {
            $webmaster = "webmaster\@" . $ENV{"SERVER_NAME"};
        }
        # Get the site name
        $site = defined $SITENAME_ABBR? $SITENAME_ABBR:
            defined $PACKAGE? $PACKAGE: $REQUEST_HOST;
        # The request string
        if ($IS_MODPERL) {
            $r->as_string =~ /^([^\n]+)\n((?:[^\n]+\n)*).+?$/s;
            ($reqline, $reqhdrs) = ($1, $2);
            $reqhdrs =~ s/^(.+)$/* $1/gm;
        } else {
            $reqline = sprintf "%s %s%s %s",
                $ENV{"REQUEST_METHOD"}, $ROOT_DIFF, $REQUEST_URI,
                $ENV{"SERVER_PROTOCOL"};
            %_ = qw();
            foreach my $key (grep /^HTTP_/, keys %ENV) {
                $_ = $key;
                s/^HTTP_//;
                s/_/-/g;
                s/(\w)(\w+)/$1 . lc $2/ge;
                $_{$_} = $ENV{$key};
            }
            $reqhdrs = join "", map "* $_: $_{$_}\n", sort keys %_;
        }
        
        $body = "";
        # Basic information
        $_ = << "EOT";
[%s] HTTP 500 Server Error Report %s
==============================
* Time: %s
* URI: %s
* Request: %s
* Error Message:

%s
%s.

EOT
        $body = sprintf $_, $site, fmtdate,
            fmttime, $REQUEST_FULLURI, $reqline,
            $errmsg, join("\n", map " at $$_[1] line $$_[2]", @callers);
        
        # Client headers
        $body .= "Client Headers:\n$reqhdrs\n";
        
        # POSTed form
        if (($IS_MODPERL? $r->method: $ENV{"REQUEST_METHOD"}) eq "POST") {
            $body .= "POST form:\n";
            if (exists $USER_INPUT{"POST_RAW"}) {
                $form = $USER_INPUT{"POST_RAW"};
            } else {
                $form = new CGI;
            }
            $body .= join "", map "* $_: " . $form->param($_) . "\n",
                sort $form->param;
            $body .= "\n";
        }
        
        # CGI metavariables - refer to CGI 1.1
        @_ = qw(AUTH_TYPE CONTENT_LENGTH CONTENT_TYPE GATEWAY_INTERFACE
            PATH_INFO PATH_TRANSLATED QUERY_STRING REMOTE_ADDR REMOTE_HOST
            REMOTE_IDENT REMOTE_USER REQUEST_METHOD SCRIPT_NAME SERVER_PORT
            SERVER_PROTOCOL SERVER_SOFTWARE);
        $body .= "CGI Metavariables:\n";
        $body .= join "", map "* $_: $ENV{$_}\n", grep exists $ENV{$_}, @_;
        $body .= "\n";
        
        # Other information
        $body .= "Other information:\n";
        if (defined get_login_sn) {
            $_ = "";
            $_ .= "* User ID.: " . get_login_id . "\n";
            $_ .= "* User name: " . get_login_name . "\n";
            $_ .= "* User S/N: " . get_login_sn . "\n";
            $_ .= "* User groups: " . join(" ", get_login_groups) . "\n";
            $body .= encode("UTF-8", $_);
        } else {
            $body .= "* User ID.: (not logged in)\n";
        }
        $body .= "* Client country: " . country_lookup . "\n";
        $body .= "\n";
        
        # Compose and send the mail
        $mail = new Selima::Mail;
        $mail->from("HTTP.pm\@" . $ENV{"SERVER_NAME"}, "$site Website");
        $mail->to($webmaster, "$site Webmaster");
        $mail->subject(sprintf("[%s] HTTP 500 Server Error Report %s", $site, fmtdate));
        $mail->body($body);
        $mail->send;
    }
    
    # Log the error message to the server error log
    log_error("$errmsg " . join(" ", map "at $$_[1] line $$_[2]", @callers) . ".");
    
    # No need to return
    exit 500 if !$IS_CGI;
    exit;
}

# http_503: HTTP/1.1 503 Service Unavailable
sub http_503(;$) {
    local ($_, %_);
    my ($html, $r, $type, %h);
    my $errmsg;
    $errmsg = $_[0];
    
    # Obtain the Apache mod_perl request
    $r = $IS_MP2? Apache2::RequestUtil->request: Apache->request
        if $IS_MODPERL;
    # Clear the STDOUT buffer
    IO::NestedCapture->stop(CAPTURE_STDOUT)
        while   exists IO::NestedCapture->instance->{"STDOUT_current"}
                && @{IO::NestedCapture->instance->{"STDOUT_current"}} > 0;
    # Skip content auto-output
    $NO_AUTO_OUTPUT = 1;
    
    # Obtain the status message
    $html = get_custom_status_message(503);
    # Fall back to a simplest default
    if (!defined $html) {
        $html = << "EOT";
<?xml version="1.0" encoding="US-ASCII" ?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN"
    "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en">
<head>
<title>503 Service Unavailable</title>
</head>
<body>
<h1>503 Service Unavailable</h1>
<!-- errmsg -->
<p>Sorry, our service is currently not available.  Please come back later.</p>
</body>
</html>
EOT
    }
    # Replace the page content
    $html =~ s/<!-- errmsg -->/defined $errmsg? "<p>" . h($errmsg) . "<\/p>": ""/ge;
    # Convert the URLs to relative
    $html = page2rel $html, $REQUEST_PATH;
    # Encode the e-mail at-signs (@)
    $html =~ s/@/&#64;/g;
    # Decode the e-mail at-signs (@) of spamtrap
    $html =~ s/spamtrap&#64;/spamtrap@/g;
    
    # Only output headers to the CGI interface
    if ($IS_CGI) {
        # The mod_perl way
        if ($IS_MODPERL) {
            # Error documents can only be output as ISO-8859-1 under mod_perl.
            # It is hardcoded into Apache http_protocol.c ap_send_error_response().
            # See http://www.geocrawler.com/mail/msg.php3?msg_id=6288656
            $html = page_encode($html, "ISO-8859-1");
            $r->custom_response(503, $html);
            $r->status(503);
            $r->err_headers_out->set("Content-Language"=>getlang LN_NAME);
            $r->err_headers_out->set("Content-Length"=>length $html);
            # Content negotiation, see HTTP/1.1 section 13.6
            if (    @ALL_LINGUAS > 1
                    && $r->method ne "POST"
                    && $r->method ne "PUT"
                    && !defined $GET->param("lang")) {
                $r->err_headers_out->set("Content-Location"=>altlang(getlang, page_param));
                $r->err_headers_out->set("Vary"=>"accept-language,cookie");
            }
            $r->err_headers_out->add("Set-Cookie"=>$_)
                foreach values %NEWCOOKIES;
        
        # Ordinary CGI
        } else {
            $html = page_encode($html, getlang(LN_CHARSET));
            $type = xhtml_content_type . "; charset=" . getlang(LN_CHARSET);
            %h = (  -status=>"503 Service Unavailable",
                    -type=>$type,
                    -Content_Language=>getlang(LN_NAME),
                    -Content_Length=>length $html);
            # Content negotiation, see HTTP/1.1 section 13.6
            if (    @ALL_LINGUAS > 1
                    && $ENV{"REQUEST_METHOD"} ne "POST"
                    && $ENV{"REQUEST_METHOD"} ne "PUT"
                    && !defined $GET->param("lang")) {
                $h{"-Content_Location"} = altlang getlang, page_param;
                $h{"-Vary"} = "accept-language,cookie";
            }
            $h{"-cookie"} = [values %NEWCOOKIES];
            print header(%h);
            print $html if $ENV{"REQUEST_METHOD"} ne "HEAD";
        }
    
    # Output the content directly as a console application
    } else {
        print page_encode($html, getlang(LN_CHARSET))
            if $ENV{"REQUEST_METHOD"} ne "HEAD";
    }
    
    # Log the error message to the server error log
    # No logging due to maintainance
    # No need to return
    exit 503 if !$IS_CGI;
    exit;
}

return 1;