From dda1d592c170ca0fcf811d68af16a47438fe5b46 Mon Sep 17 00:00:00 2001 From: b Date: Tue, 17 Oct 2023 23:34:33 +0000 Subject: [PATCH] start rework of 2words --- 2words.1.pl | 385 +++++++++++++++++++++++++++----------------------- bsta_lib.1.pm | 13 +- viewer.1.pl | 4 +- 3 files changed, 220 insertions(+), 182 deletions(-) diff --git a/2words.1.pl b/2words.1.pl index 03ef99f..c00ee4f 100644 --- a/2words.1.pl +++ b/2words.1.pl @@ -21,9 +21,32 @@ # 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 urlencode bb2ht); +use botm_common ( + 'read_data_file', 'write_data_file' +); +use bsta_lib ( + 'STATE', 'INTF_STATE', + 'fail_method', 'fail_content_type', + 'read_header_env', + 'url_query_decode', + + + + # to replace + 'failpage', + 'gethttpheader', + 'getcgi', + 'entityencode', + 'readdatafile', + 'writedatafile', + 'urlencode', + 'bb2ht' +); use File::Copy; ###PERL_CGI_PATH: CGI_PATH = /bsta/ @@ -54,14 +77,18 @@ use File::Copy; ###PERL_PAGE_LENGTH: PAGE_LENGTH = 16 ###PERL_FIRSTPAGE_LENGTH: FIRSTPAGE_LENGTH = 4 +binmode STDIN, ':encoding(UTF-8)'; +binmode STDOUT, ':encoding(UTF-8)'; +binmode STDERR, ':encoding(UTF-8)'; +# decode_argv(); my %http; my %cgi; my %story; -my %newstory; +my %new_story; my %settings; my %state; -my %gotolist; +my %goto_list; my $time = time(); srand ($time-$$); @@ -70,218 +97,218 @@ my $method; my $IP; my $words; my $color2; -my $lastip; -my $storyid; +my $last_IP; +my $story_id; my $turn; my $message; -my $firstletter; -my $secondletter; -my $intfstate; -my $intfpass; -my $intfpause; -my $intfmode; -my $storypath; -my $storyfile; -my $storylock; +my $first_letter; +my $second_letter; +my $intf_state; +my $intf_pass; +my $intf_pause; +my $intf_mode; +my $story_path; +my $story_file; +my $story_lock; my @storylines; -my $ongstate; +my $ong_state; my $page; +my $cmd_clear; +my $cmd_clear_all; delete @ENV{qw(IFS CDPATH ENV BASH_ENV)}; ###PERL_SET_PATH: $ENV{'PATH'} = /usr/local/bin:/usr/bin:/bin; if ($ENV{'REQUEST_METHOD'} =~ /^(HEAD|GET|POST)$/) { - $method=$1; + $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') { - my %cgipost=getcgi( ); - foreach my $ind (keys %cgipost) { - $cgi{$ind}=$cgipost{$ind}; + my %cgi_post=url_query_decode( ); + foreach my $ind (keys %cgi_post) { + $cgi{$ind} = $cgi_post{$ind}; } } # 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); } } - +$IP = get_remote_addr(); if ($ENV{'PATH_INFO'} =~ /^\/(.+)$/) { $page=int($1); } else { $page=0; } - -if ($ENV{'HTTP_X_FORWARDED_FOR'} =~ /^([0-9]+\.[0-9]+\.[0-9]+\.[0-9]+)$/) { - $IP=$1; -} -elsif ($ENV{'REMOTE_ADDR'} =~ /^([0-9]+\.[0-9]+\.[0-9]+\.[0-9]+)$/) { - $IP=$1; -} -else { - $IP='0.0.0.0'; -} - if ($cgi{'words'} ne '') { $words=$cgi{'words'}; } -%settings=readdatafile(DATA_SETTINGS_PATH); -%state=readdatafile(DATA_STATE_PATH); -$ongstate=int($state{'state'}); - -$storylock=0; -if (open ($storyfile,"+<",DATA_STORY_PATH)){ - $storylock=1; - if (flock($storyfile,2)) { - $storylock=2; +%settings = read_data_file(DATA_SETTINGS_PATH()); +%state = read_data_file(DATA_STATE_PATH()); +$ong_state = int($state{'state'}); +$cmd_clear = settings{'password'}.' clear'; +$cmd_clear_all = settings{'password'}.' clearall'; + +$story_lock=0; +if (open ($story_file,"+<:encoding(UTF-8)",DATA_STORY_PATH())){ + $story_lock=1; + if (flock($story_file,2)) { + $story_lock=2; } - %story=readdatafile($storyfile); + %story = $read_data_file($story_file); - if ($story{'lastip'} =~ /^([0-9]+\.[0-9]+\.[0-9]+\.[0-9]+)$/) { - $lastip=$1; + if ($story{'lastip'} =~ /^.+$/) { + $last_IP=$&; } else { - $lastip='0.0.0.0'; + $last_IP='0.0.0.0'; } - $storyid = int($story{'id'}); - $intfpass = int($story{'pass'}); - $intfstate = int($story{'state'}); - $intfmode = $intfstate; - $intfpause = $intfstate & 1; - if ($intfpause) { - $intfmode -= 1; + $last_letter = lc($story{'letter'}); + $story_id = int($story{'id'}); + $intf_pass = int($story{'pass'}); + $intf_state = int($story{'state'}); + $intf_mode = $intf_state; + $intf_pause = $intf_state & 0x01; + if ($intf_pause) { + $intf_mode &= 0xFE; } - if ($IP ne $lastip) { + if ($IP ne $last_IP) { $turn = 1; } else { $turn = 0 ; } - if($words =~ /^bstaaaclear(all)?$/ || $intfstate < 0) { - if($words eq 'bstaaaclearall' || $intfstate < -1) { - $story{'id'}=0; + if ( + ($words eq $cmd_clear) || + ($words eq $cmd_clear_all) || + ($intf_state < 0) + ) { + if ( + ($words eq $cmd_clear_all) || + ($intf_state < -1) + ) { + $story{'id'} = 0; } - $story{'content'}=''; - $story{'lastip'}='0.0.0.0'; - $story{'letter'}=''; - $story{'pass'}='0'; - $story{'state'}='0'; - $turn=0; - if($ongstate == 0) { - writeindex(WWW_INDEX_PATH,0,0,0); + $story{'content'} = ''; + $story{'lastip' } = '0.0.0.0'; + $story{'letter' } = ''; + $story{'pass' } = 0; + $story{'state' } = INTF_STATE->{'X'}; + $turn = 0; + if($ong_state == STATE->{'inactive'}) { + writeindex(WWW_INDEX_PATH,0,0,0); # TO REPLACE } - writedatafile($storyfile,%story); + write_data_file($story_file, '', '', \%story); } if ($words ne '') { if (!$turn) { $message = "It's not your turn."; } - else { - if ($words =~ /^([!"\(\),\.:;\?][ \t]*)?([A-Za-z][A-Za-z'\-]*[A-Za-z']?)([!"\(\),\.:;\? \t][ \t]*)([A-Za-z][A-Za-z'\-]*[A-Za-z']?)([!"\(\),\.:;\?]?[ \t]*)$/) { + # TODO: consider allowing non-ASCII letters in words. + # (not very important in English language) + elsif ($words =~ /^([!"\(\),\.:;\?][ \t]*)?([A-Za-z][A-Za-z'\-]*[A-Za-z']?)([!"\(\),\.:;\? \t][ \t]*)([A-Za-z][A-Za-z'\-]*[A-Za-z']?)([!"\(\),\.:;\?]?[ \t]*)$/) { + $first_letter = lc(substr($2, 0, 1)); + $second_letter = lc(substr($4, 0, 1)); + if ( + ($first_letter ne $last_letter) && + ($last_letter ne '') + ) { + $message = 'The first word must start with '.uc($last_letter).'.'; + } + elsif ($first_letter eq $second_letter) { + $message = 'The second word can\'t also start with '.uc($first_letter).'.'; + } + else { + $story{'content'} = $story{'content'} . $words."\n"; + $turn = 0; + $story{'lastip'} = $IP; + $story{'letter'} = $second_letter; - $firstletter = lc(substr($2,0,1)); - $secondletter = lc(substr($4,0,1)); - if (($firstletter ne $story{'letter'})&&($story{'letter'} ne '')) { - $message = 'The first word must start with '.uc($story{'letter'}).'.'; - } - elsif ($firstletter eq $secondletter) { - $message = 'The second word can\'t also start with '.uc($firstletter).'.'; + if ($cgi{'next'} ne '') { + if (split(/\r?\n/,$story{'content'}) >= (STORY_LENGTH-1)) { + $story_path = DATA_STORY_PATH.$story_id; + write_data_file($story_path, '', '', \%story); + $new_story{'id' } = $story_id + 1; + $new_story{'letter' } = ''; + $new_story{'lastip' } = $IP; + $new_story{'content'} = ''; + $new_story{'pass' } = 0; + $new_story{'state' } = INTF_STATE->{'X'}; + $intf_state = INTF_STATE->{'X'}; + $intf_pass = 0; + $intf_mode = INTF_STATE->{'X'}; + $intf_pause= 0; + if($ong_state == STATE->{'inactive'}) { + writeindex(WWW_INDEX_PATH,0,0,0); # TO REPLACE + } + write_data_file($story_file, '', '', \%new_story); + } + else { + $message = 'To early to finish this wordgame.'; + write_data_file($story_file, '', '', \%story); + } } else { - $story{'content'} = $story{'content'} . $words."\n"; - $turn = 0; - $story{'lastip'} = $IP; - $story{'letter'} = $secondletter; - - if ($cgi{'next'} ne '') { - if (split(/\r?\n/,$story{'content'}) >= (STORY_LENGTH-1)) { - $storypath = DATA_STORY_PATH.$storyid; - writedatafile($storypath,%story); - $newstory{'id'} = $storyid + 1; - $newstory{'letter'}=''; - $newstory{'lastip'}=$IP; - $newstory{'content'}=''; - $newstory{'pass'}='0'; - $newstory{'state'}='0'; - $intfstate=0; - $intfpass=0; - $intfmode=0; - $intfpause=0; - if($ongstate == 0) { - writeindex(WWW_INDEX_PATH,0,0,0); - } - writedatafile($storyfile,%newstory); - } - else { - $message = 'To early to finish this wordgame.'; - writedatafile($storyfile,%story); + if ($intf_pass == 1) { + $intf_pass = 2; + $story{'pass'} = 2; + if($ong_state == STATE->{'inactive'}) { + writeindex(WWW_INDEX_PATH,2,0,0); # TO REPLACE } } - else { - if ($intfpass == 1){ - $intfpass = 2; - $story{'pass'} = '2'; - if($ongstate == 0) { - writeindex(WWW_INDEX_PATH,2,0,0); - } + elsif(lc($2).' '.lc($4) eq $settings{'unlock'}) { + if ($intf_pass != 0) { + $message = 'The password has already been used in this story.'; } - elsif(lc($2).' '.lc($4) eq $settings{'unlock'}) { - if ($intfpass == 0) { - if($ongstate == 0) { - my %framedata = readdatafile(DATA_PATH.0); - my %default = readdatafile(DATA_DEFAULT_PATH); - my $inpath; - my $outpath; - - $framedata{'ongtime'} = $time; - $gotolist{'title-0'} = $framedata{'title'}; - $gotolist{'ongtime-0'} = $framedata{'ongtime'}; - writedatafile(DATA_PATH.0,%framedata); - writedatafile(DATA_LIST_PATH,%gotolist); - - foreach my $ind (keys %default) { - unless(defined($framedata{$ind})){ - $framedata{$ind}=$default{$ind}; - } - } - - $inpath = DATA_PATH.sprintf($settings{'frame'},0,$framedata{'ext'}); - $outpath = WWW_PATH.sprintf($settings{'frame'},0,$framedata{'ext'}); - - if(copy ($inpath, $outpath)) { - $intfpass = 1; - $intfstate = 0; - $intfmode=0; - $intfpause=0; - $story{'pass'} = '1'; - $story{'state'} = '0'; - writeindex(WWW_INDEX_PATH,1,0,0); - } - } - else { - $message = "???"; + elsif ($ong_state != STATE->{'inactive'}) { + $message = "???"; + } + else { + my %frame_data = read_data_file(DATA_PATH.0); + my %default = read_data_file(DATA_DEFAULT_PATH()); + my $in_path; + my $out_path; + + $frame_data{'ongtime'} = $time; + $goto_list{'title-0'} = $frame_data{'title'}; + $goto_list{'ongtime-0'} = $frame_data{'ongtime'}; + writedatafile(DATA_PATH.0,%frame_data); + writedatafile(DATA_LIST_PATH,%goto_list); + + foreach my $ind (keys %default) { + unless(defined($frame_data{$ind})){ + $frame_data{$ind}=$default{$ind}; } } - else { - $message = 'The password has already been used in this story.'; + + $inpath = DATA_PATH.sprintf($settings{'frame'},0,$frame_data{'ext'}); + $outpath = WWW_PATH.sprintf($settings{'frame'},0,$frame_data{'ext'}); + + if(copy ($inpath, $outpath)) { + $intf_pass = 1; + $intf_state = 0; + $intf_mode=0; + $intf_pause=0; + $story{'pass'} = '1'; + $story{'state'} = '0'; + writeindex(WWW_INDEX_PATH,1,0,0); } } - writedatafile($storyfile,%story); } + writedatafile($story_file,%story); } } else { @@ -289,26 +316,26 @@ if (open ($storyfile,"+<",DATA_STORY_PATH)){ } } } - elsif (($cgi{'s'} ne '') && ($intfpass==1) && ($ongstate == 0)) { - $intfstate = int($cgi{'s'}); - if($intfstate > 63 || $intfstate <0) { - $intfstate = 0; + elsif (($cgi{'s'} ne '') && ($intf_pass==1) && ($ong_state == 0)) { + $intf_state = int($cgi{'s'}); + if($intf_state > 63 || $intf_state <0) { + $intf_state = 0; } - $intfmode = $intfstate; - $intfpause = $intfstate & 1; - if ($intfpause) { - $intfmode -= 1; + $intf_mode = $intf_state; + $intf_pause = $intf_state & 1; + if ($intf_pause) { + $intf_mode -= 1; } - $story{'state'} = $intfstate; - writeindex(WWW_INDEX_PATH,1,$intfmode,$intfpause); - writedatafile($storyfile,%story); + $story{'state'} = $intf_state; + writeindex(WWW_INDEX_PATH,1,$intf_mode,$intf_pause); + writedatafile($story_file,%story); } @storylines = split(/\r?\n/,$story{'content'}); if(@storylines & 1) { $turn = !$turn; } - close($storyfile); + close($story_file); } print "Content-type: text/html\n\n"; @@ -375,51 +402,51 @@ elsif ($message ne '') { print ''."\n"; } -if(($intfpass == 1) && ($ongstate == 0)) { +if(($intf_pass == 1) && ($ong_state == 0)) { print '
'."\n"; print ''."\n"; print ''."\n"; print ''."\n"; print ''."\n"; - print ''."\n"; - print ''."\n"; - print ''."\n"; - print ''."\n"; - print ''."\n"; + print ''."\n"; + print ''."\n"; + print ''."\n"; + print ''."\n"; + print ''."\n"; print '
o><<>>^||><<>>^||
'."\n"; } print '
'."\n"; print '
'."\n"; -for (my $i = $storyid-1-(($page!=0)?((($page-1)*PAGE_LENGTH)+FIRSTPAGE_LENGTH):0); $i > ($storyid-1-($page*PAGE_LENGTH)- FIRSTPAGE_LENGTH) && $i >= 0; --$i) { - $storypath = DATA_STORY_PATH.$i; - %newstory = readdatafile($storypath); - print '

'.entityencode($newstory{'content'}).'

'."\n"; +for (my $i = $story_id-1-(($page!=0)?((($page-1)*PAGE_LENGTH)+FIRSTPAGE_LENGTH):0); $i > ($story_id-1-($page*PAGE_LENGTH)- FIRSTPAGE_LENGTH) && $i >= 0; --$i) { + $story_path = DATA_STORY_PATH.$i; + %new_story = readdatafile($story_path); + print '

'.entityencode($new_story{'content'}).'

'."\n"; } print '
'."\n"; print '