From 4aaccd4cc4ffc1f86d1215e2090133ad241de939 Mon Sep 17 00:00:00 2001 From: b Date: Thu, 18 Jan 2024 22:04:13 +0000 Subject: [PATCH] improve HTTP headers; can't post with GET request --- 2words.1.pl | 28 +++++++++++++--- attach.1.pl | 17 ++++++---- bbcode.1.pl | 8 +++-- botm-common | 2 +- bsta_lib.1.pm | 89 +++++++++++++++++++++++++++++---------------------- chat.1.pl | 36 ++++++++++++++++++--- frame.1.pl | 15 ++++++--- goto.1.pl | 2 +- info.1.pl | 6 ++-- opomba.1.pl | 43 +++++++++++++------------ reset.1.pl | 1 - viewer.1.pl | 13 ++++---- 12 files changed, 165 insertions(+), 95 deletions(-) diff --git a/2words.1.pl b/2words.1.pl index b69ea40..3b8bdfa 100644 --- a/2words.1.pl +++ b/2words.1.pl @@ -27,6 +27,8 @@ use Encode ('encode', 'decode'); ###PERL_LIB: use lib /botm/lib/bsta use botm_common ( + 'HTTP_STATUS', + 'http_header_status', 'http_header_allow', 'read_data_file', 'write_data_file', 'merge_url', 'read_header_env', @@ -82,6 +84,8 @@ my $color2; my $last_IP; my $story_id; my $turn; +my $status; +my $allow; my $message; my $first_letter; my $second_letter; @@ -107,7 +111,7 @@ if ($ENV{'REQUEST_METHOD'} =~ /^(HEAD|GET|POST)$/) { $method = $1; } else { - exit fail_method($ENV{'REQUEST_METHOD'}, 'GET, POST, HEAD'); + exit fail_method($ENV{'REQUEST_METHOD'}, ['GET','POST', 'HEAD']); } %http = read_header_env(\%ENV); @@ -166,9 +170,12 @@ if (open_encoded($fh, "+<:encoding(UTF-8)", DATA_STORY_PATH())) { } if ( - ($words eq $cmd_clear) || - ($words eq $cmd_clear_all) || - ($intf_state < 0) + ($intf_state < 0) || ( + ($method eq 'POST') && ( + ($words eq $cmd_clear) || + ($words eq $cmd_clear_all) + ) + ) ) { if ( ($words eq $cmd_clear_all) || @@ -194,8 +201,9 @@ if (open_encoded($fh, "+<:encoding(UTF-8)", DATA_STORY_PATH())) { write_data_file($fh, \%story); } - if ($words ne '') { + if (($words ne '') && ($method eq 'POST')) { if (!$turn) { + $status = HTTP_STATUS->{'forbidden'}; $message = "It's not your turn."; } # TODO: consider allowing non-ASCII letters in words. @@ -208,9 +216,11 @@ if (open_encoded($fh, "+<:encoding(UTF-8)", DATA_STORY_PATH())) { ($first_letter ne $last_letter) && ($last_letter ne '') ) { + $status = HTTP_STATUS->{'bad_request'}; $message = 'The first word must start with '.uc($last_letter).'.'; } elsif ($first_letter eq $second_letter) { + $status = HTTP_STATUS->{'bad_request'}; $message = 'The second word can\'t also start with '.uc($first_letter).'.'; } else { @@ -349,6 +359,7 @@ if (open_encoded($fh, "+<:encoding(UTF-8)", DATA_STORY_PATH())) { } } else { + $status = HTTP_STATUS->{'bad_request'}; $message = 'Please, two words, not more, not less (some punctuation is allowed).'; } } @@ -378,7 +389,14 @@ if (open_encoded($fh, "+<:encoding(UTF-8)", DATA_STORY_PATH())) { close($fh); } +if ($status ne '') { + print http_header_status($status); +} +if ($allow ne '') { + print http_header_allow($allow); +} print "Content-type: text/html; charset=UTF-8\n\n"; + if($method eq 'HEAD') { exit; } diff --git a/attach.1.pl b/attach.1.pl index f2a124a..151dddc 100644 --- a/attach.1.pl +++ b/attach.1.pl @@ -27,18 +27,21 @@ use Encode ('encode', 'decode'); ###PERL_LIB: use lib /botm/lib/bsta use botm_common ( + 'HTTP_STATUS', 'read_header_env', 'url_query_decode', 'read_data_file', 'join_path', 'merge_url', - 'open_encoded', 'stat_encoded' + 'open_encoded', 'stat_encoded', + 'http_header_line', 'http_header_content_length', 'http_header_content_disposition' ); use bsta_lib ( 'STATE', 'merge_settings', 'get_id', 'get_password', - 'fail_attachment', 'fail_500', 'redirect' + 'fail_method', 'fail_content_type', 'fail_attachment', 'fail_500', + 'redirect' ); ###PERL_PATH_SEPARATOR: PATH_SEPARATOR = / @@ -89,7 +92,7 @@ if ($ENV{'REQUEST_METHOD'} =~ /^(HEAD|GET|POST)$/) { $method = $1; } else{ - exit fail_method($ENV{'REQUEST_METHOD'}, 'GET, POST, HEAD'); + exit fail_method($ENV{'REQUEST_METHOD'}, ['GET', 'POST', 'HEAD']); } %http = read_header_env(\%ENV); @@ -150,7 +153,7 @@ else { {'path' => CGI_PATH()}, {'path' => $file_name} ); - exit redirect ($method, $file_path, 303); + exit redirect ($method, $file_path, HTTP_STATUS->{'see_other'}); } } unless ($r) { @@ -165,14 +168,14 @@ else { exit fail_500("Can't switch file to binary mode."); } if (my @file_info = stat_encoded($file_path)) { - print 'Content-length: '.$file_info[7]."\n"; + print http_header_content_length($file_info[7]); } } if ($file_data{'content-type'} ne '') { - print 'Content-type: '.$file_data{'content-type'}."\n"; + print http_header_line('content-type', $file_data{'content-type'}); } if ($file_name ne '') { - print 'Content-disposition: inline; filename="'.$file_name.'"'."\n"; + print http_header_content_disposition('inline', $file_name); } unless ($direct) { unless (binmode STDOUT) { diff --git a/bbcode.1.pl b/bbcode.1.pl index a478cdc..ee88ab1 100644 --- a/bbcode.1.pl +++ b/bbcode.1.pl @@ -27,11 +27,13 @@ use Encode ('encode', 'decode'); ###PERL_LIB: use lib /botm/lib/bsta use botm_common ( + 'HTTP_STATUS', 'read_header_env', 'read_data_file', 'url_query_decode', 'join_path', - 'merge_url' + 'merge_url', + 'http_header_status' ); use bsta_lib ( 'STATE', @@ -88,7 +90,7 @@ if ($ENV{'REQUEST_METHOD'} =~ /^(HEAD|GET|POST)$/) { $method = $1; } else{ - exit fail_method($ENV{'REQUEST_METHOD'}, 'GET, POST, HEAD'); + exit fail_method($ENV{'REQUEST_METHOD'}, ['GET', 'POST', 'HEAD']); } %http = read_header_env(\%ENV); @@ -150,7 +152,7 @@ else { print "Content-type: text/plain; charset=UTF-8\n"; if(!$access) { - print "Status: 403 Forbidden\n"; + print http_header_status(HTTP_STATUS->{'forbidden'}); } print "\n"; if($method eq 'HEAD') { diff --git a/botm-common b/botm-common index 8dbd1b4..54a9ab5 160000 --- a/botm-common +++ b/botm-common @@ -1 +1 @@ -Subproject commit 8dbd1b461e07f2894c4fcacacd681ab7c34b6bcb +Subproject commit 54a9ab5889510496f8820da830f46068703aa8d6 diff --git a/bsta_lib.1.pm b/bsta_lib.1.pm index fe1f349..9774a2d 100644 --- a/bsta_lib.1.pm +++ b/bsta_lib.1.pm @@ -53,6 +53,7 @@ our @EXPORT_OK = ( ###PERL_LIB: use lib /botm/lib/bsta use botm_common ( + 'HTTP_STATUS', 'url_query_decode', 'url_query_encode', 'url_decode', 'url_encode', 'html_entity_encode_dec', @@ -60,7 +61,9 @@ use botm_common ( 'read_header_env', 'read_data_file', 'write_data_file', 'join_path', - 'copy_encoded', 'open_encoded' + 'copy_encoded', 'open_encoded', + 'http_header_line', 'http_status', + 'http_header_status', 'http_header_allow', 'http_header_location' ); ###PERL_PATH_SEPARATOR: PATH_SEPARATOR = / @@ -218,7 +221,13 @@ use constant tags_html => { # 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($header ne ''){ + + 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') { @@ -260,13 +269,14 @@ sub failpage { sub fail_method { (my $method, my $allowed) = @_; - my $header = "Status: 405 Method Not Allowed\n"; - if ($allowed ne '') { - $header .= "Allow: $allowed\n"; - } + my $status = http_status(HTTP_STATUS->{'method_not_allowed'}); + my $header = + http_header_line('status', $status) . + http_header_allow($allowed); + return failpage( $header, - "405 Method Not Allowed", + $status, "The interface does not support the $method method.", $method ); @@ -276,9 +286,12 @@ 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( - "Status: 415 Unsupported Media Type\n", - "415 Unsupported Media Type", + $header, + $status, "Unsupported Content-type: $content_type.", $method ); @@ -288,9 +301,12 @@ 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( - "Status: 404 Not Found\n", - "404 Not Found", + $header, + $status, "Can't open ". ($type ne '' ? $type : 'file'). ($path ne '' ? ': "'.$path.'"' : ''). @@ -303,9 +319,12 @@ sub fail_attachment { (my $method, my $ID) = @_; + my $status = http_status(HTTP_STATUS->{'not_found'}); + my $header = http_header_line('status', $status); + return failpage( - "Status: 404 Not Found\n", - "404 Not Found", + $header, + $status, "Attachment $ID not found.", $method ); @@ -314,9 +333,13 @@ sub fail_attachment 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( - "Status: 500 Internal Server Error\n", - "500 Internal Server Error", + $header, + $status, $text, $method ); @@ -325,31 +348,22 @@ sub fail_500 sub redirect { (my $method, my $uri, my $code) = @_; + my $header; my $status; if ($code eq '') { - $code = 302 - } - $code = int($code); - if ($code == 301) { - $status = '301 Moved Permanently'; - } - elsif ($code == 302) { - $status = '302 Found'; - } - elsif ($code == 303) { - $status = '303 See Other'; - } - elsif ($code == 307) { - $status = '307 Temporary Redirect'; - } - elsif ($code == 308) { - $status = '308 Permanent Redirect'; - } - else{ - $status = "$code Redirect"; + $code = HTTP_STATUS->{'found'}; } + # 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( - "Status: $status\nLocation: $uri\n", + $header, $status, '', $method, @@ -857,7 +871,6 @@ sub print_html_data { print $fh html_encode_line("\n".$data->{'content'}); } -# TODO: previous page preload? sub print_viewer_page { ( my $file, @@ -1804,7 +1817,7 @@ sub write_index { } -# ONG the frame + attachment & stiff. NOT update state file. +# ONG the frame + attachment & stuff. NOT update state file. sub ong { ( my $ID, my $ongtime, my $timer, my $update, my $print, diff --git a/chat.1.pl b/chat.1.pl index bf764ee..1fd8073 100644 --- a/chat.1.pl +++ b/chat.1.pl @@ -28,12 +28,14 @@ use Encode ('encode', 'decode'); ###PERL_LIB: use lib /botm/lib/bsta use botm_common ( + 'HTTP_STATUS', 'read_data_file', 'write_data_file', 'read_header_env', 'url_query_decode', 'url_query_encode', 'merge_url', 'html_entity_encode_dec', - 'open_encoded' + 'open_encoded', + 'http_header_status' ); use bsta_lib ( 'STATE', 'CHAT_STATE', 'CHAT_ACTION', @@ -83,6 +85,7 @@ my $state; my $password_ok; my @chat_lines; my $chat_state; +my $status; my $message; my $chat_id; my $last_id; @@ -94,7 +97,7 @@ if ($ENV{'REQUEST_METHOD'} =~ /^(HEAD|GET|POST)$/) { $method = $1; } else { - exit fail_method($ENV{'REQUEST_METHOD'}, 'GET, POST, HEAD'); + exit fail_method($ENV{'REQUEST_METHOD'}, ['GET', 'POST', 'HEAD']); } %http = read_header_env(\%ENV); @@ -144,8 +147,16 @@ if ($page < 0) { $chat_id = int($chat{'id'}); $last_id = $chat_id; - if (($action == CHAT_ACTION->{'none'}) && ($words ne '')) { + if ($method ne 'POST') { + # + } + + elsif ( + ($action == CHAT_ACTION->{'none'}) && + ($words ne '') + ) { if (($chat_state < CHAT_STATE->{'ready'}) && !$password_ok) { + $status = HTTP_STATUS->{'forbidden'}; $message = 'Not connected.'; } else { @@ -159,10 +170,12 @@ if ($page < 0) { write_data_file($fh, \%chat); } else { + $status = HTTP_STATUS->{'bad_request'}; $message = 'Invalid username.'; } } else { + $status = HTTP_STATUS->{'bad_request'}; $message = 'Invalid text.'; } } @@ -183,16 +196,20 @@ if ($page < 0) { write_data_file($fh, \%chat); } elsif ($words eq '') { + $status = HTTP_STATUS->{'bad_request'}; $message = 'Server ID missing.'; } elsif ($words !~ /^[0-9]+$/) { + $status = HTTP_STATUS->{'bad_request'}; $message = 'Invalid server ID.'; } else { + $status = HTTP_STATUS->{'not_found'}; $message = 'No active Coincidence server with this ID.'; } } else { + $status = HTTP_STATUS->{'bad_request'}; $message = 'Invalid username.'; } } @@ -223,6 +240,7 @@ if ($page < 0) { } } else { + $status = HTTP_STATUS->{'bad_request'}; $message = 'Invalid username.'; } } @@ -244,17 +262,21 @@ if ($page < 0) { write_data_file($fh, \%chat); } else { + $status = HTTP_STATUS->{'bad_request'}; $message = 'Invalid username.'; } } else { + $status = HTTP_STATUS->{'bad_request'}; $message = 'Invalid text.'; } } + @chat_lines = split(/\r?\n/, $chat{'content'}); } - else{ + else { $chat_state = CHAT_STATE->{'disconnected'}; + $status = HTTP_STATUS->{'internal_server_error'}; $message = 'Can\'t lock data file!'; } @@ -262,6 +284,7 @@ if ($page < 0) { } else { $chat_state = CHAT_STATE->{'disconnected'}; + $status = HTTP_STATUS->{'internal_server_error'}; $message='Can\'t open data file!'; } } @@ -277,6 +300,9 @@ else { } } +if ($status ne '') { + print http_header_status($status); +} print "Content-type: text/html; charset=UTF-8\n\n"; if($method eq 'HEAD') { exit; @@ -349,7 +375,7 @@ elsif ($chat_state > CHAT_STATE->{'disconnected'}) { print ' Connected to server '.$_server.' as user '.$_username.' ('.$_abbr.'), public key '.$_key.'.'."\n"; } else{ - print ' Not connected.'; + print ' Not connected.'."\n"; } print ' '."\n"; diff --git a/frame.1.pl b/frame.1.pl index 92485f3..9bea1c2 100644 --- a/frame.1.pl +++ b/frame.1.pl @@ -27,12 +27,14 @@ use Encode ('encode', 'decode'); ###PERL_LIB: use lib /botm/lib/bsta use botm_common ( + 'HTTP_STATUS', 'read_header_env', 'url_query_decode', 'read_data_file', 'join_path', 'merge_url', - 'open_encoded', 'stat_encoded' + 'open_encoded', 'stat_encoded', + 'http_header_line', 'http_header_content_length', 'http_header_content_disposition' ); use bsta_lib ( 'STATE', 'INTF_STATE', @@ -92,7 +94,7 @@ if ($ENV{'REQUEST_METHOD'} =~ /^(HEAD|GET|POST)$/) { $method = $1; } else{ - exit fail_method($ENV{'REQUEST_METHOD'}, 'GET, POST, HEAD'); + exit fail_method($ENV{'REQUEST_METHOD'}, ['GET', 'POST', 'HEAD']); } %http = read_header_env(\%ENV); @@ -183,7 +185,7 @@ if ($try_onged) { {'path' => CGI_PATH()}, {'path' => $frame_file} ); - exit redirect ($method, $frame_path, 303); + exit redirect ($method, $frame_path, HTTP_STATUS->{'see_other'}); } } unless ($r) { @@ -199,10 +201,13 @@ unless (binmode($fh)) { } if (my @file_info = stat_encoded($frame_path)){ - print 'Content-length: '.$file_info[7]."\n"; + print http_header_content_length($file_info[7]); } if ($frame_data{'content-type'} ne '') { - print 'Content-type: '.$frame_data{'content-type'}."\n"; + print http_header_line('content-type', $frame_data{'content-type'}); +} +if ($frame_file ne '') { + print http_header_content_disposition('inline', $frame_file); } unless (binmode STDOUT) { close($fh); diff --git a/goto.1.pl b/goto.1.pl index 3fc45cd..a126160 100644 --- a/goto.1.pl +++ b/goto.1.pl @@ -87,7 +87,7 @@ if ($ENV{'REQUEST_METHOD'} =~ /^(HEAD|GET|POST)$/) { $method = $1; } else{ - exit fail_method($ENV{'REQUEST_METHOD'}, 'GET, POST, HEAD'); + exit fail_method($ENV{'REQUEST_METHOD'}, ['GET', 'POST', 'HEAD']); } %http = read_header_env(\%ENV); diff --git a/info.1.pl b/info.1.pl index d712acb..fc23668 100644 --- a/info.1.pl +++ b/info.1.pl @@ -27,6 +27,8 @@ use Encode ('encode', 'decode'); ###PERL_LIB: use lib /botm/lib/bsta use botm_common ( + 'HTTP_STATUS', + 'http_header_status', 'read_header_env', 'read_data_file', 'write_data_file', 'url_query_decode', @@ -87,7 +89,7 @@ if ($ENV{'REQUEST_METHOD'} =~ /^(HEAD|GET|POST)$/) { $method = $1; } else{ - exit fail_method($ENV{'REQUEST_METHOD'}, 'GET, POST, HEAD'); + exit fail_method($ENV{'REQUEST_METHOD'}, ['GET', 'POST', 'HEAD']); } %http = read_header_env(\%ENV); @@ -249,7 +251,7 @@ if ( print "Content-type: text/plain; charset=UTF-8\n"; if (!$access) { - print "Status: 403 Forbidden\n"; + print http_header_status(HTTP_STATUS->{'forbidden'}); } print "\n"; if($method eq 'HEAD') { diff --git a/opomba.1.pl b/opomba.1.pl index 3b2adb5..d437ba5 100644 --- a/opomba.1.pl +++ b/opomba.1.pl @@ -27,13 +27,15 @@ use Encode ('encode', 'decode'); ###PERL_LIB: use lib /botm/lib/bsta use botm_common ( + 'HTTP_STATUS', 'read_header_env', 'url_query_decode', 'read_data_file', 'write_data_file', 'html_entity_encode_dec', 'open_encoded', 'join_path', 'merge_url', - 'make_id' + 'make_id', + 'http_header_status' ); use bsta_lib ( 'TEXT_MODE', 'STATE', @@ -111,7 +113,7 @@ if ($ENV{'REQUEST_METHOD'} =~ /^(HEAD|GET|POST)$/) { $method = $1; } else { - exit fail_method($ENV{'REQUEST_METHOD'}, 'GET, POST, HEAD'); + exit fail_method($ENV{'REQUEST_METHOD'}, ['GET', 'POST', 'HEAD']); } %http = read_header_env(\%ENV); @@ -180,7 +182,7 @@ if ($ID ne '') { } unless ($frame ne '') { - exit output(0, '400 Bad Request', 'Frame ID not specified.'); + exit output(0, HTTP_STATUS->{'bad_request'}, 'Frame ID not specified.'); } $access = ( $password_ok || ( @@ -189,7 +191,7 @@ $access = ( ) ); unless ($access) { - exit output(0, '403 Forbidden', 'Not allowed to post this here now'); + exit output(0, HTTP_STATUS->{'forbidden'}, 'Not allowed to post this here now'); } $words_data_path = join_path(PATH_SEPARATOR(), DATA_WORDS_PATH(), $frame); @@ -200,7 +202,7 @@ unless (open_encoded($fh, "+<:encoding(UTF-8)", $words_data_path)) { } } unless (flock($fh, 2)) { - exit output(0, '500 Internal Server Error', 'Failed locking data file.', 1); + exit output(0, HTTP_STATUS->{'internal_server_error'}, 'Failed locking data file.', 1); } %words_data = read_data_file( @@ -224,44 +226,44 @@ for (my $i=0; $i< scalar(@post_list); $i +=1) { if ($remove || ($ID ne '')) { unless ($index ne '') { close($fh); - exit output(0, '404 Not Found', $remove ? 'Nothing to remove.' : 'No such message.'); + exit output(0, HTTP_STATUS->{'not_found'}, $remove ? 'Nothing to remove.' : 'No such message.'); } unless ($cgi{'key'} eq $post_data{'key'}) { close($fh); - exit output(0, '400 Bad Request', 'Invalid request.'); + exit output(0, HTTP_STATUS->{'bad_request'}, 'Invalid request.'); } } if ($remove) { - if ($cgi{'i'} eq '') { # followed a link, not confirmed yet + unless (($method eq 'POST') && ($cgi{'i'} ne '')) { # followed a link, not confirmed yet close($fh); exit output(0, '', '', 1); } } else { - unless ($post) { # followed a link, not confirmed yet + unless (($method eq 'POST') && $post) { # followed a link, not confirmed yet close($fh); exit output(0, '', '', 1); } } if (!$remove) { unless ($cgi{'words'} ne '') { - exit output(0, '400 Bad Request', 'Where are your words?', 1); + exit output(0, HTTP_STATUS->{'bad_request'}, 'Where are your words?', 1); } } unless ($cgi{'username'} ne '') { close($fh); - exit output(0, '400 Bad Request', 'Missing user name.', 1); + exit output(0, HTTP_STATUS->{'bad_request'}, 'Missing user name.', 1); } if ($remove || ($ID ne '')) { unless ($cgi{'username'} eq $post_data{'name'}) { close($fh); - exit output(0, '403 Forbidden', 'Wrong user name.', 1); + exit output(0, HTTP_STATUS->{'forbidden'}, 'Wrong user name.', 1); } } if ($remove || ($ID ne '')) { unless ($cgi{'password'} ne '') { close($fh); - exit output(0, '400 Bad Request', 'Missing password.', 1); + exit output(0, HTTP_STATUS->{'bad_request'}, 'Missing password.', 1); } unless ( ($cgi{'password'} eq $post_data{'password'}) || ( @@ -270,7 +272,7 @@ if ($remove || ($ID ne '')) { ) ) { close($fh); - exit output(0, '403 Forbidden', 'Wrong password.', 1); + exit output(0, HTTP_STATUS->{'forbidden'}, 'Wrong password.', 1); } if ($password_ok) { $cgi{'password'} = $post_data{'password'}; @@ -315,7 +317,7 @@ if ($remove) { ); unless ($r) { close($fh); - exit output(0, '500 Internal Server Error', 'Failed writing data file.'); + exit output(0, HTTP_STATUS->{'internal_server_error'}, 'Failed writing data file.'); } close ($fh); @@ -385,7 +387,7 @@ $post_data{'content'} = $cgi{'words'}; $r = write_data_file($post_data_path, \%post_data); unless ($r) { close($fh); - exit output(0, '500 Internal Server Error', 'Failed writing post file.', 1, 0); + exit output(0, HTTP_STATUS->{'internal_server_error'}, 'Failed writing post file.', 1, 0); } $r = write_data_file( @@ -398,7 +400,7 @@ $r = write_data_file( ); unless ($r) { close($fh); - exit output(0, '500 Internal Server Error', 'Failed writing data file.', 1, 0); + exit output(0, HTTP_STATUS->{'internal_server_error'}, 'Failed writing data file.', 1, 0); } close($fh); @@ -438,14 +440,13 @@ sub output { } ); if ($done) { - return redirect ($method, $return_url, 303); + return redirect($method, $return_url, HTTP_STATUS->{'see_other'}); } - print "Content-type: text/html; charset=UTF-8\n"; if ($status ne '') { - print 'Status: '.$status."\n"; + print http_header_status($status); } - print "\n"; + print "Content-type: text/html; charset=UTF-8\n\n"; if ($method eq 'HEAD') { return; } diff --git a/reset.1.pl b/reset.1.pl index bfe5dda..9e2dfcc 100644 --- a/reset.1.pl +++ b/reset.1.pl @@ -110,7 +110,6 @@ write_index( ); if (opendir_encoded(my $dir, DATA_WORDS_PATH())) { - print DATA_WORDS_PATH()."\n"; while (my $file_name = readdir_decoded($dir)) { if ($file_name !~ /^[0-9]+$/) { next; diff --git a/viewer.1.pl b/viewer.1.pl index c62a0f7..33c90ed 100644 --- a/viewer.1.pl +++ b/viewer.1.pl @@ -27,11 +27,13 @@ use Encode ('encode', 'decode'); ###PERL_LIB: use lib /botm/lib/bsta use botm_common ( + 'HTTP_STATUS', 'read_header_env', 'read_data_file', 'write_data_file', 'url_query_decode', 'join_path', - 'open_encoded' + 'open_encoded', + 'http_header_status', ); use bsta_lib ( 'STATE', 'TEXT_MODE', 'INTF_STATE', @@ -97,7 +99,7 @@ if ($ENV{'REQUEST_METHOD'} =~ /^(HEAD|GET|POST)$/) { $method = $1; } else{ - exit fail_method($ENV{'REQUEST_METHOD'}, 'GET, POST, HEAD'); + exit fail_method($ENV{'REQUEST_METHOD'}, ['GET', 'POST', 'HEAD']); } %http = read_header_env(\%ENV); @@ -297,11 +299,10 @@ $words_data_path = join_path(PATH_SEPARATOR(), DATA_WORDS_PATH(), $frame); 1, # as list ); -print "Content-type: text/html; charset=UTF-8\n"; -if(!$access) { - print "Status: 403 Forbidden\n"; +if (!$access) { + print http_header_status(HTTP_STATUS->{'forbidden'}); } -print "\n"; +print "Content-type: text/html; charset=UTF-8\n\n"; if($method eq 'HEAD') { exit; } -- 2.30.2