From 668ebd2511ee7397dcf7b20877a0508f4b27f687 Mon Sep 17 00:00:00 2001 From: b Date: Sun, 24 Sep 2023 22:28:49 +0000 Subject: [PATCH] the rest of today's changes --- botm-common | 2 +- bsta_lib.1.pm | 88 ++++++++++++++++++++++++++++++++------ makefile.1.mak | 1 + viewer.1.pl | 113 +++++++++++++++++++++++++++++++------------------ 4 files changed, 149 insertions(+), 55 deletions(-) diff --git a/botm-common b/botm-common index 6b789b4..22fdeb5 160000 --- a/botm-common +++ b/botm-common @@ -1 +1 @@ -Subproject commit 6b789b4bd0ac1d87d3a2d8598ad229298e2c4777 +Subproject commit 22fdeb550fd5ea8fce3836b157ed671cccb0b9d5 diff --git a/bsta_lib.1.pm b/bsta_lib.1.pm index 741634f..a6b53bc 100644 --- a/bsta_lib.1.pm +++ b/bsta_lib.1.pm @@ -21,9 +21,12 @@ package bsta_lib; use strict; #use warnings + +use utf8; use Exporter; use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); +# TO REMOVE use constant entitycode => { 'amp' => '&', 'gt' => '>', @@ -279,6 +282,12 @@ use constant entitycode => { 'loz' => 'â', }; +use constant STATE => { + 'inactive' => 0, + 'waiting' => 1, + 'ready' => 2 +}; + use constant tagsbb => { 'ht' => '', '/ht' => '', @@ -345,13 +354,29 @@ use constant tagsht => { ###PERL_EXPORT_VERSION: our $VERSION = 'x.x.x'; our @ISA = qw(Exporter); our @EXPORT = (); -our @EXPORT_OK = qw(entityencode failpage gethttpheader getcgi urldecode readdatafile writedatafile printdatafile printdatafileht urlencode linehtml bb2ht bb2bb); -our %EXPORT_TAGS = (); +our @EXPORT_OK = ( + 'STATE', + 'entityencode' # TO REMOVE + 'failpage', 'fail_method', 'fail_content_type', + 'gethttpheader', 'getcgi', # TO REMOVE + 'urldecode', # TO REMOVE + 'readdatafile', 'writedatafile', 'printdatafile', + 'printdatafileht', # TO REMOVE ??? + 'urlencode', # TO REMOVE + 'linehtml', + 'bb2ht', 'bb2bb' +); + +###PERL_LIB: use lib /botm/lib/bsta +use botm_common ( + 'html_entity_encode_dec' +); -# Function to show an error page + +# 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 $header, my $title, my $message, my $method) = @_; if($header ne ''){ print $header; } @@ -359,23 +384,53 @@ sub failpage { print "\n"; return; } - print "Content-type: text/html\n\n"; + print "Content-type: text/html; charset=UTF-8\n\n"; + print ''."\n"; print ''."\n"; - if($title ne ''){ - print ''.entityencode($title).''."\n"; - } print ''."\n"; + if ($title ne '') { + print ''.html_entity_encode_dec($title, 1).''."\n"; + } print ''."\n"; - if($title ne ''){ - print '

'.entityencode($title).'

'."\n"; + if ($title ne '') { + print '

'.html_entity_encode_dec($title, 1).'

'."\n"; } - if($message ne ''){ - print '

'.entityencode($message).'

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

'.html_entity_encode_dec($message, 1).'

'."\n"; } print ''."\n"; } +sub fail_method { + (my $method, my $allowed) = @_; + + my $header = "Status: 405 Method Not Allowed\n"; + if ($allowed ne '') { + $header .= "Allow: $allowed\n"; + } + return failpage( + $header, + "405 Method Not Allowed", + "The interface does not support the $method method.", + $method + ); +} + +sub fail_content_type +{ + (my $content_type, $method) = @_ + + return failpage( + "Status: 415 Unsupported Media Type\n", + "415 Unsupported Media Type", + "Unsupported Content-type: $content_type.", + $method + ); +} + + +# TO REMOVE # function to encode entities, decimal, sub entityencode { (my $t, my $all) = @_; @@ -388,6 +443,7 @@ sub entityencode { return $t; } +# TO REMOVE # function to get values of http header fields. Returns a hash. names of header # fields are lowercase sub gethttpheader { @@ -421,6 +477,7 @@ sub gethttpheader { return %http; } +# TO REMOVE # The function to get CGI parameters from string. # Format is: name=url_encoded_value&name=url_encoded_value& ... &name=url_encoded_value sub getcgi { @@ -437,6 +494,7 @@ sub getcgi { return %cgi; } +# TO REMOVE # Function for decoding URL-encoded text sub urldecode { my $t = $_[0]; @@ -445,6 +503,7 @@ sub urldecode { return $t; } +# TO REMOVE # Function to read data from datafiles. # Very similar to http header file reading. (function readheaderfile() in proxy # library) @@ -546,6 +605,7 @@ sub readdatafile { return %data; } +# TO REMOVE # the function to write data to datafiles (see readdatafile() description) # # First argument can be a path or a file handle. In case of a file handle it @@ -592,6 +652,7 @@ sub writedatafile { return 1; } +# TO REMOVE # the function to print data to stdout (see readdatafile() description) # # On success returns 1. @@ -613,6 +674,7 @@ sub printdatafile { return 1; } +# TO REMOVE ??? # the function to print data to stdout as html (see readdatafile() description) # # On success returns 1. @@ -635,6 +697,7 @@ sub printdatafileht { } +# TO REMOVE sub urlencode { (my $t, my $all) = @_; if ($all) { @@ -1279,6 +1342,7 @@ sub linehtml { return $esc; } +# TO REMOVE ??? sub debug { (my $print, my $text) = @_; diff --git a/makefile.1.mak b/makefile.1.mak index 6477e36..5884acc 100644 --- a/makefile.1.mak +++ b/makefile.1.mak @@ -135,6 +135,7 @@ $(EXEC)\ $(PERL_WRAP_EXEC) LIB=\ +botm_common/botm_common.pm bsta_lib.pm WWW=\ diff --git a/viewer.1.pl b/viewer.1.pl index 8932569..527bab8 100644 --- a/viewer.1.pl +++ b/viewer.1.pl @@ -21,9 +21,23 @@ # along with this program. If not, see . use strict; -#use warnings; +use utf8; +# use Encode::Locale ('decode_argv'); +use Encode ('encode', 'decode'); + ###PERL_LIB: use lib /botm/lib/bsta -use bsta_lib qw(failpage gethttpheader getcgi entityencode readdatafile writedatafile printdatafileht urlencode bb2ht bb2bb linehtml); +use botm_common ( + 'read-header_env', + 'read_data_file', 'write_data_file' +); +use bsta_lib ( + 'STATE', + 'fail_method', 'fail_content_type', + 'entityencode', + 'printdatafileht' + 'urlencode', + 'bb2ht', 'bb2bb', 'linehtml' +); use File::Copy; ###PERL_CGI_PATH: CGI_PATH = /bsta/ @@ -52,6 +66,11 @@ use File::Copy; ###PERL_WEBSITE_NAME: WEBSITE_NAME = Bicycles on the Moon ###PERL_FAVICON_PATH: FAVICON_PATH = /img/favicon.png +binmode STDIN, ':encoding(UTF-8)'; +binmode STDOUT, ':encoding(UTF-8)'; +binmode STDERR, ':encoding(UTF-8)'; +# decode_argv(); + my %http; my %cgi; my %framedata; @@ -67,6 +86,7 @@ srand ($time-$$); my $method; my $frame; +my $framedata_path; my $password; my $passwordOK; my $IP; @@ -86,11 +106,11 @@ if ($ENV{'REQUEST_METHOD'} =~ /^(HEAD|GET|POST)$/) { $method=$1; } else{ - exit failpage("Status: 405 Method Not Allowed\nAllow: GET, POST, HEAD\n","405 Method Not Allowed","The interface does not support the $ENV{'REQUEST_METHOD'} method.",$method); + exit fail_method($ENV{'REQUEST_METHOD'}, 'GET, POST, HEAD'); } -%http = gethttpheader (\%ENV); -%cgi = getcgi($ENV{'QUERY_STRING'}); +%http = read_header_env (\%ENV); +%cgi = url_query_decode($ENV{'QUERY_STRING'}); if ($method eq 'POST') { if ($http{'content-type'} eq 'application/x-www-form-urlencoded') { @@ -101,7 +121,7 @@ if ($method eq 'POST') { } # multipart not supported else{ - exit failpage("Status: 415 Unsupported Media Type\n","415 Unsupported Media Type","Unsupported Content-type: $http{'content-type'}."); + exit fail_content_type($http{'content-type'}, $method); } } @@ -116,75 +136,83 @@ else { } if ($cgi{'f'} =~ /^(.+)$/) { - $frame=int($1); + $frame = int($1); } elsif ($ENV{'PATH_INFO'} =~ /^\/(.+)$/) { - $frame=int($1); + $frame = int($1); } else { $frame = 0; } +$frame_data_path = join_path('/', DATA_PATH, $frame); if ($cgi{'p'} =~ /^(.+)$/) { - $password=$1; + $password = $1; } else { - $password=''; + $password = ''; } # print "Content-type: text/plain\n\n"; -%settings=readdatafile(DATA_SETTINGS_PATH); -%default=readdatafile(DATA_DEFAULT_PATH); -%framedata=readdatafile(DATA_PATH.$frame); -if($password eq $settings{'password'}){ +%settings = read_data_file(DATA_SETTINGS_PATH); +%default = read_data_file(DATA_DEFAULT_PATH); +%framedata= read_data_file($frame_data_path); +if ($password eq $settings{'password'}) { $passwordOK = 1; } else{ $passwordOK = 0; } -if (open ($statefile,"+<",DATA_STATE_PATH)){ - if (flock($statefile,2)) { +if (open ($statefile, "+<:encoding(UTF-8)", DATA_STATE_PATH)) { + if (flock($statefile, 2)) { - %state=readdatafile($statefile); + %state = read_data_file($statefile); - if($frame<0) { + if ($frame < 0) { $frame = int($state{'last'}) + $frame +1; - %framedata=readdatafile(DATA_PATH.$frame); + $frame_data_path = join_path('/', DATA_PATH, $frame); + %framedata = read_data_file($frame_data_path); } - if(int($state{'state'})==1 && $frame == int($state{'last'}) && $method ne 'HEAD' && !$passwordOK){ - my %newstate=%state; - if($state{'ip1'} ne $IP) { + if ( + int($state{'state'}) == STATE->{'waiting'} && + $frame == int($state{'last'}) && + $method ne 'HEAD' && + !$passwordOK + ) { + my %newstate = %state; + if ($state{'ip1'} ne $IP) { if ($state{'ip1'} eq '') { $newstate{'ip1'} = $IP; - writedatafile($statefile,%newstate); + write_data_file($statefile, '', '', \%newstate); } - elsif($state{'ip2'} ne $IP) { + elsif ($state{'ip2'} ne $IP) { if ($state{'ip2'} eq '') { $newstate{'ip2'} = $IP; - writedatafile($statefile,%newstate); + write_data_file($statefile, '', '', \%newstate); } else { - $newstate{'state'}=2; + $newstate{'state'} = STATE->{'ready'}; $newstate{'ip3'} = $IP; - writedatafile($statefile,%newstate); + write_data_file($statefile, '', '', \%newstate); } } } } - elsif(int($state{'state'})==0 && $frame == 1) { + elsif (int($state{'state'}) == STATE->{'inactive'} && $frame == 1) { my %story; + my $framefilename; my $inpath; my $outpath; - %story = readdatafile(DATA_STORY_PATH); - %gotolist=readdatafile(DATA_LIST_PATH); - if(int($story{'state'}) == 17 && int($story{'pass'}) == 1) { + %story = read_data_file(DATA_STORY_PATH); + %gotolist = read_data_file(DATA_LIST_PATH); + if (int($story{'state'}) == 0x11 && int($story{'pass'}) == 1) { #ACTIVATE! $framedata{'ongtime'} = $time; - writedatafile(DATA_PATH.$frame,%framedata); + write_data_file($framedata_path, '', '', \%framedata); $state{'state'} = 1; $state{'last'} = 1; $state {'ip1'} = '0.0.0.0'; @@ -193,23 +221,24 @@ if (open ($statefile,"+<",DATA_STATE_PATH)){ $state {'nextong'} = (int($time / 3600) + int($settings{'firstongtime'})) * 3600 ; $state{'ongtime'} = int($settings{'firstongtime'}); - unless(defined($framedata{'ext'})){ - $framedata{'ext'}=$default{'ext'}; + unless (defined($framedata{'ext'})){ + $framedata{'ext'} = $default{'ext'}; } - $inpath = DATA_PATH.sprintf($settings{'frame'},$frame,$framedata{'ext'}); - $outpath = WWW_PATH.sprintf($settings{'frame'},$frame,$framedata{'ext'}); + $framefilename = sprintf($settings{'frame'}, $frame, $framedata{'ext'}); + $inpath = join_path('/', DATA_PATH, $framefilename); + $outpath = join_path('/', WWW_PATH, $framefilename); - $gotolist{'title-1'}=$framedata{'title'}; - $gotolist{'ongtime-1'}=$framedata{'ongtime'}; + $gotolist{'title-1'} = $framedata{'title'}; + $gotolist{'ongtime-1'} = $framedata{'ongtime'}; - if(copy ($inpath, $outpath)) { + if (copy ($inpath, $outpath)) { writeindex(WWW_INDEX_PATH); - writedatafile($statefile,%state); - writedatafile(DATA_LIST_PATH,%gotolist); + write_data_file($statefile, '', '', \%state); + write_data_file(DATA_LIST_PATH, '', '', \%gotolist); } else { - $state{'state'} = 0; + $state{'state'} = STATE->{'inactive'}; } } } -- 2.30.2