From 1847a2f28af2392a03a828e8f10eb58c22c1cc2c Mon Sep 17 00:00:00 2001 From: b Date: Fri, 29 Dec 2023 23:07:24 +0000 Subject: [PATCH] reworked frame --- 2words.1.pl | 2 +- bsta_lib.1.pm | 87 +++++++++++++++++++-- frame.1.pl | 212 +++++++++++++++++++++++++++++++------------------- viewer.1.pl | 2 +- 4 files changed, 215 insertions(+), 88 deletions(-) diff --git a/2words.1.pl b/2words.1.pl index 2c1cca6..b001298 100644 --- a/2words.1.pl +++ b/2words.1.pl @@ -128,7 +128,7 @@ if ($method eq 'POST') { } # multipart not supported else{ - exit fail_content_type($http{'content-type'}, $method); + exit fail_content_type($method, $http{'content-type'}); } } $IP = get_remote_addr(); diff --git a/bsta_lib.1.pm b/bsta_lib.1.pm index ee800e5..d0e3df7 100644 --- a/bsta_lib.1.pm +++ b/bsta_lib.1.pm @@ -37,7 +37,8 @@ our @ISA = qw(Exporter); our @EXPORT = (); our @EXPORT_OK = ( 'STATE', 'TEXT_MODE', 'INTF_STATE', - 'failpage', 'fail_method', 'fail_content_type', + 'failpage', 'fail_method', 'fail_content_type', 'fail_open_file', 'fail_500', + 'redirect', 'get_remote_addr', 'get_frame', 'get_password', 'merge_settings', 'print_html_start', 'print_html_end', @@ -188,7 +189,7 @@ use constant tags_html => { # 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, my $hyperlink) = @_; if($header ne ''){ print $header; } @@ -196,6 +197,10 @@ sub failpage { 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"; @@ -203,15 +208,22 @@ sub failpage { print ' '."\n"; print ' '."\n"; if ($title ne '') { - print ' '.html_entity_encode_dec($title, 1).''."\n"; + print ' '.$_title.''."\n"; } print ' '."\n"; print ' '."\n"; if ($title ne '') { - print '

'.html_entity_encode_dec($title, 1).'

'."\n"; + print '

'.$_title.'

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

'.html_entity_encode_dec($message, 1).'

'."\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"; @@ -234,7 +246,7 @@ sub fail_method { sub fail_content_type { - (my $content_type, my $method) = @_; + (my $method, my $content_type) = @_; return failpage( "Status: 415 Unsupported Media Type\n", @@ -244,6 +256,67 @@ sub fail_content_type ); } +sub fail_open_file +{ + (my $method, my $type, my $path) = @_; + + return failpage( + "Status: 404 Not Found\n", + "404 Not Found", + "Can't open ". + ($type ne '' ? $type : 'file'). + ($path ne '' ? ': "'.$path.'"' : ''). + '.', + $method + ); +} + +sub fail_500 +{ + (my $method, my $text) = @_; + return failpage( + "Status: 500 Internal Server Error\n", + "500 Internal Server Error", + $text, + $method + ); +} + +sub redirect +{ + (my $method, my $uri, my $code) = @_; + 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"; + } + return failpage( + "Status: $status\nLocation: $uri\n", + $status, + '', + $method, + $uri + ); +} + # function to obtain address of remote agent sub get_remote_addr { if ($ENV{'HTTP_X_FORWARDED_FOR'} =~ /^.+$/) { diff --git a/frame.1.pl b/frame.1.pl index 2541bd7..b175644 100644 --- a/frame.1.pl +++ b/frame.1.pl @@ -5,7 +5,7 @@ # # The frame interface # -# Copyright (C) 2016, 2023 Balthasar Szczepañski +# Copyright (C) 2016, 2023 Balthasar SzczepaÅski # # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU Affero General Public License as @@ -21,10 +21,28 @@ # along with this program. If not, see . use strict; -#use warnings; -###PERL_LIB: use lib /botm/lib/bsta +use utf8; +# use Encode::Locale ('decode_argv'); +use Encode ('encode', 'decode'); -use bsta_lib qw(failpage gethttpheader getcgi readdatafile); +###PERL_LIB: use lib /botm/lib/bsta +use botm_common ( + 'read_header_env', + 'url_query_decode', + 'read_data_file', + 'join_path', + 'merge_url' +); +use bsta_lib ( + 'STATE', 'INTF_STATE', + 'fail_method', 'fail_content_type', 'fail_open_file', 'fail_500', 'redirect', + 'get_frame', 'get_password', + 'merge_settings' +); + +###PERL_PATH_SEPARATOR: PATH_SEPARATOR = / + +###PERL_CGI_PATH: CGI_PATH = /bsta/ ###PERL_DATA_PATH: DATA_PATH = /botm/data/bsta ###PERL_DATA_DEFAULT_PATH: DATA_DEFAULT_PATH = /botm/data/bsta/default @@ -33,131 +51,167 @@ use bsta_lib qw(failpage gethttpheader getcgi readdatafile); ###PERL_DATA_STATE_PATH: DATA_STATE_PATH = /botm/data/bsta/state ###PERL_DATA_STORY_PATH: DATA_STORY_PATH = /botm/data/bsta/story +###PERL_WWW_PATH: WWW_PATH = /botm/www/1190/bsta/ + +binmode STDIN, ':encoding(UTF-8)'; +binmode STDOUT, ':encoding(UTF-8)'; +binmode STDERR, ':encoding(UTF-8)'; +# decode_argv(); + +my $time = time(); +srand ($time-$$); + my %http; my %cgi; -my %framedata; +my %frame_data; my %default; my %settings; my %state; -my $time = time(); -srand ($time-$$); - my $method; my $frame; my $password; -my $passwordOK; +my $password_ok; my $IP; my $access; -my $framepath; -my $framefile; +my $frame_indirect; +my $frame_path; +my $frame_data_path; +my $frame_file; +my $fh; my $buffer; -my @fileinfo; +my $ong_state; +my $last_frame; +my $r = 0; 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($method, $http{'content-type'}); } } -if ($cgi{'f'} =~ /^(.+)$/) { - $frame=int($1); -} -elsif ($ENV{'PATH_INFO'} =~ /^\/(.+)$/) { - $frame=int($1); -} -else { - $frame = 0; -} +$frame = get_frame(\%cgi); +$password = get_password(\%cgi); -if ($cgi{'p'} =~ /^(.+)$/) { - $password=$1; -} -else { - $password=''; -} +%settings = read_data_file(DATA_SETTINGS_PATH()); +%default = read_data_file(DATA_DEFAULT_PATH()); +%state = read_data_file(DATA_STATE_PATH()); + +$ong_state = int($state{'state'}); +$last_frame = int($state{'last'}); -%settings=readdatafile(DATA_SETTINGS_PATH); -%default=readdatafile(DATA_DEFAULT_PATH); -%state=readdatafile(DATA_STATE_PATH); -if($frame<0) { +if ($frame < 0) { $frame = $state{'last'} + $frame +1; } -%framedata=readdatafile(DATA_PATH.$frame); -foreach my $ind (keys %default) { - unless(defined($framedata{$ind})){ - $framedata{$ind}=$default{$ind}; + +$password_ok = ($password eq $settings{'password'}); + +$access = 0; +if ( + $password_ok || ( + ($ong_state >= STATE->{'waiting'}) && + ($frame <= $last_frame) && + ($frame >= 0) + ) + ) { + $access = 1; +} +elsif ( + ($ong_state == STATE->{'inactive'}) && + ($frame == 0) +) { + my %story = read_data_file(DATA_STORY_PATH()); + if ( + (int($story{'pass'}) == 1) && + (int($story{'state'}) == INTF_STATE->{'>|'}) + ) { + $access = 1; } } -if($password eq $settings{'password'}){ - $passwordOK = 1; -} -else{ - $passwordOK = 0; -} -if ($passwordOK || (int($state{'state'}) >= 1 && $frame <= int($state{'last'}) && $frame >= 0)) { - $access=1; +$frame_indirect = !( + (!$access) || ( + ($frame <= $last_frame) && + ($ong_state > STATE->{'inactive'}) + ) +); + +if ($access) { + $frame_data_path = join_path(PATH_SEPARATOR(), DATA_PATH(), $frame); + %frame_data = read_data_file($frame_data_path); + %frame_data = merge_settings(\%default, \%frame_data); } else { - $access=0; - if(int($state{'state'}) == 0) { - my %story=readdatafile(DATA_STORY_PATH); - if ( - (int($story{'pass'}) == 1) && - (int($story{'state'}) == 17) - ) { - $access = 1; - } - } + %frame_data = read_data_file(DATA_NOACCESS_PATH()); + %frame_data = merge_settings(\%default, \%frame_data); } - -if($access){ - $framepath=DATA_PATH.sprintf($settings{'frame'},$frame,$framedata{'ext'}); +if ($frame_data{'frame'} ne '') { + $frame_file = $frame_data{'frame'}; } else { - %framedata = readdatafile(DATA_NOACCESS_PATH); - foreach my $ind (keys %default) { - unless(defined($framedata{$ind})){ - $framedata{$ind}=$default{$ind}; - } + $frame_file = sprintf( + $settings{'frame'}, + $frame, $frame_data{'ext'} + ); +} + +unless ($frame_indirect) { + $frame_path = join_path(PATH_SEPARATOR(), WWW_PATH(), $frame_file); + $r = open($fh, '<' , encode('locale_fs', $frame_path)); + if ($r) { + close($r); + $frame_path = merge_url( + {'path' => CGI_PATH()}, + {'path' => $frame_file} + ); + exit redirect ($method, $frame_path, 303); } - $framepath=DATA_PATH.$framedata{'frame'}; +} +unless ($r) { + $frame_path = join_path(PATH_SEPARATOR(), DATA_PATH(), $frame_file); + $r = open($fh, '<' , encode('locale_fs', $frame_path)); + unless ($r) { + exit fail_open_file($method, 'image file', $frame_file); + } +} +unless (binmode($fh)) { + close($fh); + exit fail_500("Can't switch file to binary mode."); } -open($framefile,'<',$framepath) or exit failpage("Status: 404 Not Found\n","404 Not Found"," Can't open image file."); -unless(binmode($framefile)) { - close($framefile); - exit failpage("Status: 500 Internal Server Error\n","500 Internal Server Error"," Can't switch to binary mode."); +if (my @file_info = stat($frame_path)){ + print 'Content-length: '.$file_info[7]."\n"; } -if (my @fileinfo = stat($framepath)){ - print 'Content-length: '.$fileinfo[7]."\n"; +print 'Content-type: '.$frame_data{'content-type'}."\n"; +unless (binmode STDOUT) { + close($fh); + exit fail_500("Can't switch output to binary mode."); } -print 'Content-type: '.$framedata{'content-type'}."\n"; print "\n"; + if($method ne 'HEAD'){ - while (read ($framefile,$buffer,1024)) { + while (read ($fh, $buffer, 1024)) { print (STDOUT $buffer); } } -close($framefile); +close($fh); diff --git a/viewer.1.pl b/viewer.1.pl index 7eb559c..9a21dd8 100644 --- a/viewer.1.pl +++ b/viewer.1.pl @@ -107,7 +107,7 @@ if ($method eq 'POST') { } # multipart not supported else{ - exit fail_content_type($http{'content-type'}, $method); + exit fail_content_type($method, $http{'content-type'}); } } $IP = get_remote_addr(); -- 2.30.2