###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',
my $last_IP;
my $story_id;
my $turn;
+my $status;
+my $allow;
my $message;
my $first_letter;
my $second_letter;
$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);
}
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) ||
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.
($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 {
}
}
else {
+ $status = HTTP_STATUS->{'bad_request'};
$message = 'Please, two words, not more, not less (some punctuation is allowed).';
}
}
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;
}
###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 = /
$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);
{'path' => CGI_PATH()},
{'path' => $file_name}
);
- exit redirect ($method, $file_path, 303);
+ exit redirect ($method, $file_path, HTTP_STATUS->{'see_other'});
}
}
unless ($r) {
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) {
###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',
$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);
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') {
-Subproject commit 8dbd1b461e07f2894c4fcacacd681ab7c34b6bcb
+Subproject commit 54a9ab5889510496f8820da830f46068703aa8d6
###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',
'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 = /
# 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') {
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
);
{
(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
);
{
(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.'"' : '').
{
(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
);
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
);
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,
print $fh html_encode_line("\n".$data->{'content'});
}
-# TODO: previous page preload?
sub print_viewer_page {
(
my $file,
}
-# 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,
###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',
my $password_ok;
my @chat_lines;
my $chat_state;
+my $status;
my $message;
my $chat_id;
my $last_id;
$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);
$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 {
write_data_file($fh, \%chat);
}
else {
+ $status = HTTP_STATUS->{'bad_request'};
$message = 'Invalid username.';
}
}
else {
+ $status = HTTP_STATUS->{'bad_request'};
$message = 'Invalid text.';
}
}
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.';
}
}
}
}
else {
+ $status = HTTP_STATUS->{'bad_request'};
$message = 'Invalid username.';
}
}
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!';
}
}
else {
$chat_state = CHAT_STATE->{'disconnected'};
+ $status = HTTP_STATUS->{'internal_server_error'};
$message='Can\'t open data file!';
}
}
}
}
+if ($status ne '') {
+ print http_header_status($status);
+}
print "Content-type: text/html; charset=UTF-8\n\n";
if($method eq 'HEAD') {
exit;
print ' Connected to server <span class="br">'.$_server.'</span> as user <span class="ni">'.$_username.'</span> (<span class="ni">'.$_abbr.'</span>), public key <span class="br">'.$_key.'</span>.'."\n";
}
else{
- print ' Not connected.';
+ print ' Not connected.'."\n";
}
print ' </div>'."\n";
###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',
$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);
{'path' => CGI_PATH()},
{'path' => $frame_file}
);
- exit redirect ($method, $frame_path, 303);
+ exit redirect ($method, $frame_path, HTTP_STATUS->{'see_other'});
}
}
unless ($r) {
}
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);
$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);
###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',
$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);
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') {
###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',
$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);
}
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 || (
)
);
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);
}
}
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(
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'}) || (
)
) {
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'};
);
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);
$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(
);
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);
}
);
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;
}
);
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;
###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',
$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);
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;
}
bicyclesonthemoon.info / projects / ott / bsta / commitdiff