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