src/util/ratelimit.pl

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