bicyclesonthemoon.info Git - ott/bsta/blob - oldlogs.1.pl

   1 ###RUN_PERL: #!/usr/bin/perl
   2
   3 # oldlogs is generated from oldlogs.1.pl.
   4 #
   5 # This script renames log files if they are big enough.
   6 # Compresses or removes older log files.
   7 #
   8 # Copyright (C) 2015, 2016, 2023, 2024  Balthasar Szczepański
   9 #
  10 # This program is free software: you can redistribute it and/or modify
  11 # it under the terms of the GNU Affero General Public License as
  12 # published by the Free Software Foundation, either version 3 of the
  13 # License, or (at your option) any later version.
  14 #
  15 # This program is distributed in the hope that it will be useful,
  16 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 # GNU Affero General Public License for more details.
  19 #
  20 # You should have received a copy of the GNU Affero General Public License
  21 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
  22
  23 # TODO: use a real log rotate instead of this tool?
  24
  25 use strict;
  26 use utf8;
  27 use Encode::Locale ('decode_argv');
  28 use Encode ('encode', 'decode');
  29
  30 ###PERL_LIB: use lib /botm/lib/bsta
  31 use botm_common (
  32         'join_path',
  33         'system_encoded',
  34         'opendir_encoded', 'readdir_decoded',
  35         '_x_encoded', 'stat_encoded',
  36         'unlink_encoded', 'rename_encoded'
  37 );
  38
  39 ###PERL_PATH_SEPARATOR:     PATH_SEPARATOR     = /
  40
  41 ###PERL_GZIP:              GZIP              = gzip
  42 ###PERL_LOG_PATH:          LOG_PATH          = /botm/log/bsta/
  43 ###PERL_LOG_SIZE_LIMIT:    LOG_SIZE_LIMIT    = 65536
  44 ###PERL_LOGS_UNCOMPRESSED: LOGS_UNCOMPRESSED = 2
  45 ###PERL_LOGS_TOTAL:        LOGS_TOTAL        = 10
  46
  47 binmode STDIN,  ':encoding(UTF-8)';
  48 binmode STDOUT, ':encoding(UTF-8)';
  49 binmode STDERR, ':encoding(UTF-8)';
  50 decode_argv();
  51
  52 my $log_path          = ($ARGV[0] ne ''        ) ? $ARGV[0]: LOG_PATH();
  53 my $log_size_limit    = ($ARGV[1] =~ /^[0-9]+$/) ? int($&) : LOG_SIZE_LIMIT();
  54 my $logs_total        = ($ARGV[2] =~ /^[0-9]+$/) ? int($&) : LOGS_TOTAL();
  55 my $logs_uncompressed = ($ARGV[3] =~ /^[0-9]+$/) ? int($&) : LOGS_UNCOMPRESSED();
  56
  57 if (opendir_encoded(my $dir, $log_path)) {
  58         while (my $file_name = readdir_decoded($dir)) {
  59                 if ($file_name !~ /\.log$/) {
  60                         next;
  61                 }
  62                 my $full_path = join_path(PATH_SEPARATOR(), $log_path, $file_name);
  63                 unless (_x_encoded('-f', $full_path)) {
  64                         next;
  65                 }
  66                 my @stat;
  67                 unless (@stat = stat_encoded($full_path)) {
  68                         next;
  69                 }
  70                 if ($stat[7] > $log_size_limit) {
  71                         move_log($full_path, 0, 0);
  72                 }
  73         }
  74         closedir($dir);
  75 }
  76 else {
  77         print "fail ";
  78         print $log_path;
  79         print "\n";
  80 }
  81
  82 sub move_log {
  83         (my $path, my $number, my $gz) = @_;
  84         my $next_gz = 0;
  85         my $this_path;
  86         my $next_path;
  87         my $next_number = $number + 1;
  88         my @gzip_arg = (GZIP(), '-q', '-9','-f');
  89
  90         $this_path = $path.(
  91                 ($number != 0) ?
  92                         '.'.$number.($gz ? '.gz' : '') :
  93                         ''
  94                 );
  95         if ($number == $logs_total) {
  96                 if (unlink_encoded($this_path)) {
  97                         return 1;
  98                 }
  99                 else {
 100                         return 0;
 101                 }
 102         }
 103         if ($number == $logs_uncompressed) {
 104                 $next_gz = 1;
 105                 $next_path = $path.'.'.$next_number.'.gz';
 106         }
 107         else {
 108                 $next_path = $path.'.'.$next_number.($gz ? '.gz' : '');
 109         }
 110
 111         # TODO: consider loop instead of recursion?
 112         if (_x_encoded('-e', $next_path)) {
 113                 unless (move_log($path, $next_number, ($next_gz or $gz) ? 1 : 0)) {
 114                         return 0;
 115                 }
 116         }
 117
 118         if ($next_gz) {
 119                 push @gzip_arg, $this_path;
 120                 unless (! system_encoded(GZIP(), @gzip_arg)) {
 121                         return 0;
 122                 }
 123                 $this_path .= '.gz';
 124         }
 125
 126         unless (rename_encoded($this_path, $next_path)) {
 127                 return 0;
 128         }
 129         return 1;
 130 }