src/util/ratelimit.pl

   1 #!/usr/bin/perl -wT
   2 # SPDX-License-Identifier: GPL-2.0-only
   3
   4 use strict;
   5
   6 BEGIN { pop @INC if $INC[-1] eq '.' };
   7
   8 sub usage () {
   9   print <<END;
  10 usage: ratelimit.pl [options] <period> <regex> <logfile>
  11
  12 The aim of this script is to compute clients' peak sending rates
  13 from an Exim log file, using the same formula as Exim's ratelimit
  14 ACL condition. This is so that you can get an idea of a reasonable
  15 limit setting before you deploy the restrictions.
  16
  17 options:
  18
  19 -d          Show debugging information to stderr
  20 -p          Show progress of parse the log to stderr
  21
  22 <period>    The smoothing period in seconds, as defined by the
  23             documentation for the ratelimit ACL condition.
  24
  25             This script isn't perfectly accurate, because the time
  26             stamps in Exim's log files are only accurate to a second
  27             whereas internally Exim computes sender rates to the
  28             accuracy of your computer's clock (typically 10ms).
  29
  30 <regex>     The second argument is a regular expression.
  31
  32             Each line is matched against the regular expression.
  33             Lines that do not match are ignored. The regex may
  34             contain 0, 1, or 2 () capturing sub-expressions.
  35
  36             If there are no () sub-expressions, then every line that
  37             matches is used to compute a single rate. Its maximum
  38             value is reported when the script finishes.
  39
  40             If there is one () sub-expression, then the text matched
  41             by the sub-expression is used to identify a rate lookup
  42             key, similar to the lookup key used by the ratelimit
  43             ACL condition. For example, you might write a regex
  44             to match the client IP address, or the authenticated
  45             username. Separate rates are computed for each different
  46             client and the maximum rate for each client is reported
  47             when the script finishes.
  48
  49             If there are two () sub-expressions, then the text matched
  50             by the first sub-expression is used to identify a rate
  51             lookup key as above, and the second is used to match the
  52             message size recorded in the log line, e.g. "S=(\\d+)".
  53             In this case the byte rate is computed instead of the
  54             message rate, similar to the per_byte option of the
  55             ratelimit ACL condition.
  56
  57 <logfile>   The log files to be processed can be specified on the
  58             command line after the other arguments; if no filenames
  59             are specified the script will read from stdin.
  60
  61 examples:
  62
  63 ./ratelimit.pl 1 ' <= .*? \[(.*?)\]' <logfile>
  64
  65             Compute burst sending rate like ACL condition
  66             ratelimit = 0 / 1s / strict / \$sender_host_address
  67
  68 ./ratelimit.pl 3600 '<= (.*?) ' <logfile>
  69
  70             Compute sending rate like ACL condition
  71             ratelimit = 0 / 1h / strict / \$sender_address
  72
  73 END
  74   exit 1;
  75 }
  76
  77 sub iso2unix (@) {
  78   my ($y,$m,$d,$H,$M,$S,$zs,$zh,$zm) = @_;
  79   use integer;
  80   $y -= $m < 3;
  81   $m += $m < 3 ? 10 : -2;
  82   my $z = defined $zs ? "${zs}1" * ($zh * 60 + $zm) : 0;
  83   my $t = $y/400 - $y/100 + $y/4 + $y*365
  84         + $m*367/12 + $d - 719499;
  85   return $t * 86400
  86        + $H * 3600
  87        + $M * 60
  88        + $S
  89        - $z;
  90 }
  91
  92 my $debug = 0;
  93 my $progress = 0;
  94 while (@ARGV && $ARGV[0] =~ /^-\w+$/) {
  95   $debug = 1    if $ARGV[0] =~ s/(-\w*)d(\w*)/$1$2/;
  96   $progress = 1 if $ARGV[0] =~ s/(-\w*)p(\w*)/$1$2/;
  97   shift if $ARGV[0] eq "-";
  98 }
  99
 100 usage if @ARGV < 2;
 101
 102 my $progtime = "";
 103
 104 my $period = shift;
 105
 106 my $re_txt = shift;
 107 my $re = qr{$re_txt}o;
 108
 109 my %time;
 110 my %rate;
 111 my %max;
 112
 113 sub debug ($) {
 114   my $key = shift;
 115   printf STDERR "%s\t%12d %8s %5.2f %5.2f\n",
 116     $_, $time{$key}, $key, $max{$key}, $rate{$key};
 117 }
 118
 119 while (<>) {
 120   next unless $_ =~ $re;
 121   my $key = $1 || "";
 122   my $size = $2 || 1.0;
 123   my $time = iso2unix
 124     ($_ =~ m{^(\d{4})-(\d\d)-(\d\d)[ ]
 125               (\d\d):(\d\d):(\d\d)[ ]
 126               (?:([+-])(\d\d)(\d\d)[ ])?
 127             }x);
 128   if ($progress) {
 129     my $prog_now = substr $_, 0, 14;
 130     if ($progtime ne $prog_now) {
 131       $progtime = $prog_now;
 132       print STDERR "$progtime\n";
 133     }
 134   }
 135   if (not defined $time{$key}) {
 136     $time{$key} = $time;
 137     $rate{$key} = 0.0;
 138     $max{$key} = 0.0;
 139     debug $key if $debug;
 140     next;
 141   }
 142   # see acl_ratelimit() for details of the following
 143   my $interval = $time - $time{$key};
 144   $interval = 1e-9 if $interval <= 0.0;
 145   my $i_over_p = $interval / $period;
 146   my $a = exp(-$i_over_p);
 147   $time{$key} = $time;
 148   $rate{$key} = $size * (1.0 - $a) / $i_over_p + $a * $rate{$key};
 149   $max{$key} = $rate{$key} if $rate{$key} > $max{$key};
 150   debug $key if $debug;
 151 }
 152
 153 print map {
 154   " " x (20 - length) .
 155   "$_ : $max{$_}\n"
 156 } sort {
 157   $max{$a} <=> $max{$b}
 158 } keys %max;
 159
 160 # eof