From: b Date: Tue, 26 Mar 2024 09:37:32 +0000 (+0000) Subject: error pages and redirection (imported from BSTA) X-Git-Tag: v1.1.6^2 X-Git-Url: http://bicyclesonthemoon.info/git-projects/?a=commitdiff_plain;h=0b054ae5148019bb077830eca4da8f294f2b3d09;p=botm%2Fcommon-perl error pages and redirection (imported from BSTA) --- 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 ## ###########