our @EXPORT = ();
our @EXPORT_OK = (
'STATE', 'TEXT_MODE', 'INTF_STATE', 'CHAT_STATE', 'CHAT_ACTION',
- 'failpage',
- 'fail_method', 'fail_content_type', 'fail_open_file', 'fail_attachment', 'fail_500',
- 'redirect',
'get_remote_addr', 'get_id', 'get_frame', 'get_password',
'merge_settings',
'print_html_start', 'print_html_end',
};
-# Function to return an error page
-# arguments: 1 - header fields, 2 - page title, 3 - error message, 4 method
-sub failpage {
- (my $header, my $title, my $message, my $method, my $hyperlink) = @_;
-
- if (ref($header)) {
- foreach my $header_name (keys %$header) {
- print http_header_line($header_name, $header->{$header_name});
- }
- }
- elsif($header ne '') {
- print $header;
- }
- if($method eq 'HEAD') {
- print "\n";
- return;
- }
- my $_title = html_entity_encode_dec($title , 1);
- my $_message = html_entity_encode_dec($message , 1);
- my $_hyperlink = html_entity_encode_dec($hyperlink, 1);
-
- print "Content-type: text/html; charset=UTF-8\n\n";
-
- print '<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "">'."\n";
- print ' <html lang="en">'."\n";
- print ' <head>'."\n";
- print ' <meta http-equiv="Content-type" content="text/html; charset=UTF-8">'."\n";
- if ($title ne '') {
- print ' <title>'.$_title.'</title>'."\n";
- }
- print ' </head>'."\n";
- print ' <body>'."\n";
- if ($title ne '') {
- print ' <h1>'.$_title.'</h1>'."\n";
- }
- if (($message ne '') || ($hyperlink ne '')) {
- print " <p>\n";
- if ($message ne '') {
- print ' '.$_message.($hyperlink ne '' ? '<br>' : '')."\n";
- }
- if ($hyperlink ne '') {
- print ' <a href="'.$_hyperlink.'">'.$_hyperlink."</a>\n";
- }
- print " </p>\n";
- }
- print ' </body>'."\n";
- print '</html>'."\n";
-}
-
-sub fail_method {
- (my $method, my $allowed) = @_;
-
- my $status = http_status(HTTP_STATUS->{'method_not_allowed'});
- my $header =
- http_header_line('status', $status) .
- http_header_allow($allowed);
-
- return failpage(
- $header,
- $status,
- "The interface does not support the $method method.",
- $method
- );
-}
-
-sub fail_content_type
-{
- (my $method, my $content_type) = @_;
-
- my $status = http_status(HTTP_STATUS->{'unsupported_media_type'});
- my $header = http_header_line('status', $status);
-
- return failpage(
- $header,
- $status,
- "Unsupported Content-type: $content_type.",
- $method
- );
-}
-
-sub fail_open_file
-{
- (my $method, my $type, my $path) = @_;
-
- my $status = http_status(HTTP_STATUS->{'not_found'});
- my $header = http_header_line('status', $status);
-
- return failpage(
- $header,
- $status,
- "Can't open ".
- ($type ne '' ? $type : 'file').
- ($path ne '' ? ': "'.$path.'"' : '').
- '.',
- $method
- );
-}
-
-sub fail_attachment
-{
- (my $method, my $ID) = @_;
-
- my $status = http_status(HTTP_STATUS->{'not_found'});
- my $header = http_header_line('status', $status);
-
- return failpage(
- $header,
- $status,
- "Attachment $ID not found.",
- $method
- );
-}
-
-sub fail_500
-{
- (my $method, my $text) = @_;
-
- my $status = http_status(HTTP_STATUS->{'internal_server_error'});
- my $header = http_header_line('status', $status);
-
- return failpage(
- $header,
- $status,
- $text,
- $method
- );
-}
-
-sub redirect
-{
- (my $method, my $uri, my $code) = @_;
- my $header;
- my $status;
- if ($code eq '') {
- $code = HTTP_STATUS->{'found'};
- }
- # https://insanecoding.blogspot.com/2014/02/http-308-incompetence-expected.html
- # 301 Moved Permanently
- # 302 Found
- # 303 See Other
- # 307 Temporary Redirect
- # 308 Permanent Redirect
- $status = http_status($code);
- $header = http_header_line('status', $status);
- $header .= http_header_location($uri);
-
- return failpage(
- $header,
- $status,
- '',
- $method,
- $uri
- );
-}
-
# function to obtain address of remote agent
sub get_remote_addr {
bicyclesonthemoon.info / projects / ott / bsta / blobdiff