From 0b054ae5148019bb077830eca4da8f294f2b3d09 Mon Sep 17 00:00:00 2001 From: b Date: Tue, 26 Mar 2024 09:37:32 +0000 Subject: [PATCH] error pages and redirection (imported from BSTA) --- botm_common.pm | 168 ++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 166 insertions(+), 2 deletions(-) diff --git a/botm_common.pm b/botm_common.pm index 33572f3..4a9e784 100644 --- a/botm_common.pm +++ b/botm_common.pm @@ -26,7 +26,7 @@ use File::Copy; use Exporter; -our $VERSION = '1.1.3'; +our $VERSION = '1.1.4'; our @ISA = qw(Exporter); our @EXPORT = (); our @EXPORT_OK = ( @@ -44,7 +44,10 @@ our @EXPORT_OK = ( 'opendir_encoded', 'readdir_decoded', 'env_pwd_decoded', '_x_encoded', 'stat_encoded', 'unlink_encoded', 'rename_encoded', 'copy_encoded', - 'open_encoded' + 'open_encoded', + 'failpage', + 'fail_method', 'fail_content_type', 'fail_open_file', 'fail_attachment', 'fail_500', + 'redirect' ); @@ -1140,6 +1143,167 @@ sub read_header_env { return %data; } + +##################################### +## HTTP ERROR PAGE & REDIRECTION ## +##################################### + +# 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 ''."\n"; + print ' '."\n"; + print ' '."\n"; + print ' '."\n"; + if ($title ne '') { + print ' '.$_title.''."\n"; + } + print ' '."\n"; + print ' '."\n"; + if ($title ne '') { + print '

'.$_title.'

'."\n"; + } + if (($message ne '') || ($hyperlink ne '')) { + print "

\n"; + if ($message ne '') { + print ' '.$_message.($hyperlink ne '' ? '
' : '')."\n"; + } + if ($hyperlink ne '') { + print ' '.$_hyperlink."\n"; + } + print "

\n"; + } + print ' '."\n"; + print ''."\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 + ); +} + + ########### ## URL ## ########### -- 2.30.2