From 56432c7019363a3261e088066572c290c1f198bb Mon Sep 17 00:00:00 2001 From: b Date: Thu, 4 Jan 2024 13:00:21 +0000 Subject: [PATCH] use encoding aware system functions & rewerked old logs tool --- 2words.1.pl | 28 ++++++------- attach.1.pl | 9 ++-- botm-common | 2 +- bsta_lib.1.pm | 10 ++--- chat.1.pl | 3 +- frame.1.pl | 9 ++-- oldlogs.1.pl | 113 +++++++++++++++++++++++++++----------------------- ong.1.pl | 7 ++-- viewer.1.pl | 5 ++- 9 files changed, 100 insertions(+), 86 deletions(-) diff --git a/2words.1.pl b/2words.1.pl index 24d41e5..6f70306 100644 --- a/2words.1.pl +++ b/2words.1.pl @@ -28,11 +28,11 @@ use Encode ('encode', 'decode'); ###PERL_LIB: use lib /botm/lib/bsta use botm_common ( 'read_data_file', 'write_data_file', - 'join_path', 'merge_url', 'read_header_env', 'html_entity_encode_dec', - 'url_query_decode' + 'url_query_decode', + 'open_encoded' ); use bsta_lib ( 'STATE', 'INTF_STATE', @@ -47,8 +47,6 @@ use bsta_lib ( 'ong' ); -###PERL_PATH_SEPARATOR: PATH_SEPARATOR = / - ###PERL_CGI_PATH: CGI_PATH = /bsta/ ###PERL_CGI_2WORDS_PATH: CGI_2WORDS_PATH = /bsta/2words @@ -93,7 +91,7 @@ my $intf_pass; my $intf_pause; my $intf_mode; my $story_i_path; -my $story_file; +my $fh; my $story_lock; my @story_lines; my $ong_state; @@ -139,12 +137,12 @@ $cmd_clear = $settings{'password'}.' clear'; $cmd_clear_all = $settings{'password'}.' clearall'; $story_lock=0; -if (open ($story_file, "+<:encoding(UTF-8)", encode('locale_fs', DATA_STORY_PATH()))){ +if (open_encoded($fh, "+<:encoding(UTF-8)", DATA_STORY_PATH())) { $story_lock=1; - if (flock($story_file,2)) { + if (flock($fh,2)) { $story_lock=2; } - %story = read_data_file($story_file); + %story = read_data_file($fh); if ($story{'lastip'} =~ /^.+$/) { $last_IP=$&; @@ -193,7 +191,7 @@ if (open ($story_file, "+<:encoding(UTF-8)", encode('locale_fs', DATA_STORY_PATH 0 # pause ); } - write_data_file($story_file, '', '', \%story); + write_data_file($fh, '', '', \%story); } if ($words ne '') { @@ -252,11 +250,11 @@ if (open ($story_file, "+<:encoding(UTF-8)", encode('locale_fs', DATA_STORY_PATH ); } # save new game - write_data_file($story_file, '', '', \%new_story); + write_data_file($fh, '', '', \%new_story); } else { $message = 'To early to finish this wordgame.'; - write_data_file($story_file, '', '', \%story); + write_data_file($fh, '', '', \%story); } } else { @@ -346,7 +344,7 @@ if (open ($story_file, "+<:encoding(UTF-8)", encode('locale_fs', DATA_STORY_PATH } } } - write_data_file($story_file, '', '', \%story); + write_data_file($fh, '', '', \%story); } } } @@ -370,14 +368,14 @@ if (open ($story_file, "+<:encoding(UTF-8)", encode('locale_fs', DATA_STORY_PATH $intf_mode, $intf_pause ); - write_data_file($story_file, '', '', \%story); + write_data_file($fh, '', '', \%story); } @story_lines = split(/\r?\n/, $story{'content'}); if(@story_lines & 1) { $turn = !$turn; } - close($story_file); + close($fh); } print "Content-type: text/html\n\n"; @@ -552,7 +550,7 @@ if ($page == 0) { } print ' '."\n"; print ' '."\n"; - if(@story_lines >= (STORY_LENGTH-1)) { + if (@story_lines >= (STORY_LENGTH-1)) { print ' '."\n"; } print ' '."\n"; diff --git a/attach.1.pl b/attach.1.pl index d680f76..226714f 100644 --- a/attach.1.pl +++ b/attach.1.pl @@ -31,7 +31,8 @@ use botm_common ( 'url_query_decode', 'read_data_file', 'join_path', - 'merge_url' + 'merge_url', + 'open_encoded', 'stat_encoded' ); use bsta_lib ( 'STATE', @@ -144,7 +145,7 @@ else { ); if ($try_onged) { $file_path = join_path(PATH_SEPARATOR(), WWW_PATH(), $file_name); - $r = open($fh, '<' , encode('locale_fs', $file_path)); + $r = open_encoded($fh, '<' , $file_path); if ($r) { close($r); $file_path = merge_url( @@ -156,7 +157,7 @@ else { } unless ($r) { $file_path = join_path(PATH_SEPARATOR(), DATA_PATH(), $file_name); - $r = open($fh,'<', encode('locale_fs', $file_path)); + $r = open_encoded($fh,'<', $file_path); unless ($r) { exit fail_attachment($method, $ID); } @@ -165,7 +166,7 @@ else { close($fh); exit fail_500("Can't switch file to binary mode."); } - if (my @file_info = stat($file_path)) { + if (my @file_info = stat_encoded($file_path)) { print 'Content-length: '.$file_info[7]."\n"; } } diff --git a/botm-common b/botm-common index 3231e70..92789f8 160000 --- a/botm-common +++ b/botm-common @@ -1 +1 @@ -Subproject commit 3231e70f7ba581a5ac018ca4ec2e5f9db100a19a +Subproject commit 92789f87d558991f3b602fcc553ddc37cfe83b5c diff --git a/bsta_lib.1.pm b/bsta_lib.1.pm index c6b244b..b7bcd32 100644 --- a/bsta_lib.1.pm +++ b/bsta_lib.1.pm @@ -69,9 +69,9 @@ use botm_common ( 'merge_url', 'read_header_env', 'read_data_file', 'write_data_file', - 'join_path' + 'join_path', + 'copy_encoded', 'open_encoded' ); -use File::Copy; ###PERL_PATH_SEPARATOR: PATH_SEPARATOR = / @@ -1230,7 +1230,7 @@ sub print_viewer_page { } } else { - unless (open ($fh, ">:encoding(UTF-8)", encode('locale_fs', $file))) { + unless (open_encoded($fh, ">:encoding(UTF-8)", $file)) { return 0; } } @@ -1373,7 +1373,7 @@ sub write_index { my $r = 1; my $ong_state = int($state->{'state'}); - unless (open ($fh, ">:encoding(UTF-8)", encode('locale_fs', WWW_INDEX_PATH()))) { + unless (open_encoded($fh, ">:encoding(UTF-8)", WWW_INDEX_PATH())) { return 0; } @@ -1738,7 +1738,7 @@ sub ong { if ($print) { print $in_path.' -> '.$out_path; } - $r = copy($in_path, $out_path); + $r = copy_encoded($in_path, $out_path); if ($print) { print (($r) ? " OK\n" : " FAIL\n"); } diff --git a/chat.1.pl b/chat.1.pl index a7f4921..51fafdb 100644 --- a/chat.1.pl +++ b/chat.1.pl @@ -33,6 +33,7 @@ use botm_common ( 'url_query_decode', 'url_query_encode', 'merge_url', 'html_entity_encode_dec', + 'open_encoded' ); use bsta_lib ( 'STATE', 'CHAT_STATE', 'CHAT_ACTION', @@ -135,7 +136,7 @@ foreach my $action_id ('join', 'leave', 'nopost', 'file') { # ongoing chat if ($page < 0) { - if (open ($fh, "+<", encode('locale_fs', DATA_CHAT_PATH()))){ + if (open_encoded($fh, "+<", DATA_CHAT_PATH())) { if (flock($fh, 2)) { %chat = read_data_file($fh); diff --git a/frame.1.pl b/frame.1.pl index b8fb99d..360f8ad 100644 --- a/frame.1.pl +++ b/frame.1.pl @@ -31,7 +31,8 @@ use botm_common ( 'url_query_decode', 'read_data_file', 'join_path', - 'merge_url' + 'merge_url', + 'open_encoded', 'stat_encoded' ); use bsta_lib ( 'STATE', 'INTF_STATE', @@ -175,7 +176,7 @@ else { if ($try_onged) { $frame_path = join_path(PATH_SEPARATOR(), WWW_PATH(), $frame_file); - $r = open($fh, '<' , encode('locale_fs', $frame_path)); + $r = open_encoded($fh, '<' , $frame_path); if ($r) { close($r); $frame_path = merge_url( @@ -187,7 +188,7 @@ if ($try_onged) { } unless ($r) { $frame_path = join_path(PATH_SEPARATOR(), DATA_PATH(), $frame_file); - $r = open($fh, '<' , encode('locale_fs', $frame_path)); + $r = open_encoded($fh, '<' , $frame_path); unless ($r) { exit fail_open_file($method, 'image file', $frame_file); } @@ -197,7 +198,7 @@ unless (binmode($fh)) { exit fail_500("Can't switch file to binary mode."); } -if (my @file_info = stat($frame_path)){ +if (my @file_info = stat_encoded($frame_path)){ print 'Content-length: '.$file_info[7]."\n"; } print 'Content-type: '.$frame_data{'content-type'}."\n"; diff --git a/oldlogs.1.pl b/oldlogs.1.pl index d7151b7..0563fd2 100644 --- a/oldlogs.1.pl +++ b/oldlogs.1.pl @@ -5,7 +5,7 @@ # This script renames log files if they are big enough. # Compresses or removes older log files. # -# Copyright (C) 2015, 2016, 2023 Balthasar Szczepański +# Copyright (C) 2015, 2016, 2023, 2024 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 @@ -20,6 +20,23 @@ # You should have received a copy of the GNU Affero General Public License # along with this program. If not, see . +# TODO: use a real log rotate instead of this tool? + +use strict; +use utf8; +use Encode::Locale ('decode_argv'); +use Encode ('encode', 'decode'); + +###PERL_LIB: use lib /botm/lib/bsta +use botm_common ( + 'join_path', + 'system_encoded', + 'opendir_encoded', 'readdir_decoded', + '_x_encoded', 'stat_encoded', + 'unlink_encoded', 'rename_encoded' +); + +###PERL_PATH_SEPARATOR: PATH_SEPARATOR = / ###PERL_GZIP: GZIP = gzip ###PERL_LOG_PATH: LOG_PATH = /botm/log/bsta/ @@ -27,63 +44,56 @@ ###PERL_LOGS_UNCOMPRESSED: LOGS_UNCOMPRESSED = 2 ###PERL_LOGS_TOTAL: LOGS_TOTAL = 10 +binmode STDIN, ':encoding(UTF-8)'; +binmode STDOUT, ':encoding(UTF-8)'; +binmode STDERR, ':encoding(UTF-8)'; +decode_argv(); -if ($ARGV[0] ne '') { - $log_path = $ARGV[0]; -} -else { - $log_path = LOG_PATH; -} -if ($ARGV[1] =~ /^([0-9]+)$/) { - $log_size_limit = $1; -} -else { - $log_size_limit = LOG_SIZE_LIMIT; -} -if ($ARGV[2] =~ /^([0-9]+)$/) { - $logs_total = $1; -} -else { - $logs_total = LOGS_TOTAL; -} -if ($ARGV[3] =~ /^([0-9]+)$/) { - $logs_uncompressed = $1; -} -else { - $logs_uncompressed = LOGS_UNCOMPRESSED; -} +my $log_path = ($ARGV[0] ne '' ) ? $ARGV[0]: LOG_PATH(); +my $log_size_limit = ($ARGV[1] =~ /^[0-9]+$/) ? int($&) : LOG_SIZE_LIMIT(); +my $logs_total = ($ARGV[2] =~ /^[0-9]+$/) ? int($&) : LOGS_TOTAL(); +my $logs_uncompressed = ($ARGV[3] =~ /^[0-9]+$/) ? int($&) : LOGS_UNCOMPRESSED(); -if ( opendir ($dir, $log_path)) { - while ($subpath = readdir $dir) { - if ($subpath !~ /\.log$/) { +if (opendir_encoded(my $dir, $log_path)) { + while (my $file_name = readdir_decoded($dir)) { + if ($file_name !~ /\.logo$/) { next; } - $fullpath=$log_path.$subpath; - unless (-f $fullpath) { + my $full_path = join_path(PATH_SEPARATOR(), $log_path, $file_name); + unless (_x_encoded('-f', $full_path)) { next; } - unless (@stat = stat($fullpath)) { + my @stat; + unless (@stat = stat_encoded($full_path)) { next; } if ($stat[7] > $log_size_limit) { - movelog($fullpath,0,0); + move_log($full_path, 0, 0); } - } closedir($dir); } +else { + print "fail "; + print $log_path; + print "\n"; +} -sub movelog { +sub move_log { (my $path, my $number, my $gz) = @_; - my $nextgz = 0; - my $thispath; - my $nextpath; - my $nextnumber=$number+1; - my @gzip_arg = (GZIP, '-q', '-9','-f'); + my $next_gz = 0; + my $this_path; + my $next_path; + my $next_number = $number + 1; + my @gzip_arg = (GZIP(), '-q', '-9','-f'); - $thispath = $path.(($number != 0)?'.'.$number.($gz?'.gz':''):''); + $this_path = $path.( + ($number != 0) ? + '.'.$number.($gz ? '.gz' : '') : + '' + ); if ($number == $logs_total) { - if (unlink $thispath) { + if (unlink_encoded($this_path)) { return 1; } else { @@ -91,28 +101,29 @@ sub movelog { } } if ($number == $logs_uncompressed) { - $nextgz=1; - $nextpath = $path.'.'.$nextnumber.'.gz'; + $next_gz = 1; + $next_path = $path.'.'.$next_number.'.gz'; } else { - $nextpath = $path.'.'.$nextnumber.($gz?'.gz':''); + $next_path = $path.'.'.$next_number.($gz ? '.gz' : ''); } - if (-e $nextpath) { - unless (movelog($path,$nextnumber,($nextgz or $gz)?1:0)) { + # TODO: consider loop instead of recursion? + if (_x_encoded('-e', $next_path)) { + unless (move_log($path, $next_number, ($next_gz or $gz) ? 1 : 0)) { return 0; } } - if ($nextgz) { - push @gzip_arg, $thispath; - unless (! system (@gzip_arg)) { + if ($next_gz) { + push @gzip_arg, $this_path; + unless (! system_encoded(GZIP(), @gzip_arg)) { return 0; } - $thispath .= '.gz'; + $this_path .= '.gz'; } - unless (rename ($thispath, $nextpath)) { + unless (rename_encoded($this_path, $next_path)) { return 0; } return 1; diff --git a/ong.1.pl b/ong.1.pl index cea6a13..2ad11b8 100644 --- a/ong.1.pl +++ b/ong.1.pl @@ -4,7 +4,7 @@ # # The ONG bot # -# Copyright (C) 2016, 2017, 2023 Balthasar Szczepański +# Copyright (C) 2016, 2017, 2023, 2024 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 @@ -26,7 +26,8 @@ use Encode ('encode', 'decode'); ###PERL_LIB: use lib /botm/lib/bsta use botm_common ( - 'read_data_file', 'write_data_file' + 'read_data_file', 'write_data_file', + 'open_encoded' ); use bsta_lib ( 'STATE', @@ -65,7 +66,7 @@ print $time.' - '.$ongtime."\n"; delete @ENV{qw(IFS CDPATH ENV BASH_ENV)}; ###PERL_SET_PATH: $ENV{'PATH'} = /usr/local/bin:/usr/bin:/bin; -unless (open ($fh, "+<:encoding(UTF-8)", encode('locale_fs', DATA_STATE_PATH()))) { +unless (open_encoded($fh, "+<:encoding(UTF-8)", DATA_STATE_PATH())) { print "NO STATEFILE\n"; } else { diff --git a/viewer.1.pl b/viewer.1.pl index 94bc529..9c5364a 100644 --- a/viewer.1.pl +++ b/viewer.1.pl @@ -30,7 +30,8 @@ use botm_common ( 'read_header_env', 'read_data_file', 'write_data_file', 'url_query_decode', - 'join_path' + 'join_path', + 'open_encoded' ); use bsta_lib ( 'STATE', 'TEXT_MODE', 'INTF_STATE', @@ -122,7 +123,7 @@ if ($frame >= 0) { $password_ok = ($password eq $settings{'password'}); # state & activation logic -if (open ($state_file, "+<:encoding(UTF-8)", DATA_STATE_PATH())) { +if (open_encoded($state_file, "+<:encoding(UTF-8)", DATA_STATE_PATH())) { if (flock($state_file, 2)) { %state = read_data_file($state_file); -- 2.30.2