#!/usr/bin/perl -w use strict; use Data::Dumper; use HTTP::Date; # 2003-09-09T09:34:42 9988 denysoft_greylist plugin: key 143.130.50.18:Majordomo-Owner@wsr.ac.at:hjp@wsr.ac.at black DENYSOFT - 1 failed connections # 2003-09-09T09:34:42 9992 denysoft_greylist plugin: key 143.130.50.18:Majordomo-Owner@wsr.ac.at:hjp@wsr.ac.at initial DENYSOFT, unknown # 2003-09-09T09:35:03 10004 denysoft_greylist plugin: key 143.130.50.18:Majordomo-Owner@wsr.ac.at:hjp@wsr.ac.at black DENYSOFT - 2 failed connections # 2003-09-09T09:35:03 10000 denysoft_greylist plugin: key 143.130.50.18:Majordomo-Owner@wsr.ac.at:hjp@wsr.ac.at black DENYSOFT - 3 failed connections # 2003-09-09T10:03:51 10279 denysoft_greylist plugin: key 143.130.50.18:Majordomo-Owner@wsr.ac.at:hjp@wsr.ac.at updated grey->white # 2003-09-09T10:04:22 10285 denysoft_greylist plugin: key 143.130.50.18:Majordomo-Owner@wsr.ac.at:hjp@wsr.ac.at is white, 2 deliveries # 2003-09-09T10:04:34 10293 denysoft_greylist plugin: key 143.130.50.18:Majordomo-Owner@wsr.ac.at:hjp@wsr.ac.at is white, 3 deliveries my $entries; my $states; my $perday; my $perhour; while (<>) { if (/^(\d+-\d+-\d+T\d+:\d+:\d+) \d+ denysoft_greylist plugin: key (\S+) (.+)/) { my ($ts, $key, $state) = ($1, $2, $3); unless ($entries->{$key}) { $entries->{$key}{start} = $ts; } if ($state =~ /.* DENYSOFT|is white/) { $state = $&; } $entries->{$key}{states}{$state}{num}++; $entries->{$key}{states}{$state}{start} = $ts unless ($entries->{$key}{states}{$state}{start}); $entries->{$key}{states}{$state}{end} = $ts; if ($state eq 'has timed out (grey)') { push (@{$entries->{$key}{states}{$state}{idle}}, str2time($ts) - str2time($entries->{$key}{last})); } $entries->{$key}{last} = $ts; $states->{$state}++; my $h = $ts; $h =~ s/:.*//; $perhour->{$h}{$state}++; my $d = $h; $d =~ s/T.*//; $perday->{$d}{$state}++; } } # print Data::Dumper->Dump ([$entries], ['entries']); print inR(), ""; print inR(), ""; print in_(), "Qpsmtpd greylisting statistics"; print inR(), ""; print inL(), ""; print inR(), ""; print in_(), "

Qpsmtpd greylisting statistics

"; #print Data::Dumper->Dump ([$states], ['states']); tabsort($states, 'Delivery attempts by state'); my $tstates; for (values %$entries) { my @s = sort keys %{$_->{states}}; $tstates->{"@s"}++; } # print Data::Dumper->Dump ([$tstates], ['tstates']); tabsort($tstates, 'Keys by state history'); my $whitehist; my $mintime = 1E100; my $maxtime = 0; for (values %$entries) { if ($_->{states}{'updated grey->white'}) { my $start = str2time($_->{start}); my $end = str2time($_->{states}{'updated grey->white'}{start}); my $time = $end - $start; next if ($time == 0); # orphaned record $whitehist->[$time]++; $mintime = $time if ($time < $mintime); $maxtime = $time if ($time > $maxtime); } } print in_(), "

Time from initial submission to whitelist (raw)

"; my $s; open (GP, "|gnuplot"); #open (GP, ">gnuplot.cmd"); print GP "set data style lines\n"; print GP "set term png color\n"; print GP "set log x\n"; print GP "set xtics (900, 1800, 3600, 7200, 43200, 86400)\n"; print GP "set grid\n"; print GP "set output 'whitedelaycum.png'\n"; print GP "plot '-'\n"; print inR(), ""; for (0..$#$whitehist) { my $v = $whitehist->[$_]; if ($v) { $s += $v; print GP $_, "\t", $s, "\n"; print in_(), ""; } } print GP "e\n"; print inL(), "
", $_, "", $v, "", $s, "
"; print in_(), ""; smoothhist($whitehist, 'Time from initial submission to whitelist (histogram)', 'whitedelayhist.png'); timestates($perday, 'day'); timestates($perhour, 'hour'); print in_(), "

Time from last entry to timeout (per key)

"; my $idle = []; print inR(), ""; for my $k (sort keys %$entries) { next unless ($entries->{$k}{states}{'has timed out (grey)'}{idle}); my $n = @{$entries->{$k}{states}{'has timed out (grey)'}{idle}}; for my $i (0 .. $n-1) { print inR(), ""; print in_(), "" unless ($i); print in_(), ""; $idle->[$entries->{$k}{states}{'has timed out (grey)'}{idle}[$i]]++; } } print inL(), "
$k", $entries->{$k}{states}{'has timed out (grey)'}{idle}[$i], "
"; smoothhist($idle, 'Time from last entry to timeout (histogram)', 'timeoutgrey.png'); print inL(), ""; print inL(), ""; my $ilvl = 0; =head2 inL, in_, inR functions for indenting. Each of these functions returns a string containing a newline followed by a number of spaces proportional to the indentation level. inL indents left, i.e. it decrements the current indentation level before computing the number of spaces, inR indents right, i.e. it decrements the current indentation level after computing the number of spaces, and in_ doesn't change the indentation level. =cut sub inL { return "\n" . (' ' x --$ilvl); } sub in_ { return "\n" . (' ' x $ilvl); } sub inR { return "\n" . (' ' x $ilvl++); } sub tabsort { my ($tab, $title) = @_; print in_(), "

$title

"; print inR(), ""; my $total = 0; for (keys %$tab) { $total += $tab->{$_}; } for (sort { $tab->{$b} <=> $tab->{$a} } keys %$tab) { print inR(), ""; print in_(), ""; print in_(), ""; print in_(), ""; print inL(), ""; } print inL(), "
$_", $tab->{$_}, "", sprintf('%.1f%%', $tab->{$_} * 100 / $total), "
"; } sub timestates { my ($tab, $p) = @_; print in_(), "

States per $p

"; print inR(), ""; print inR(), ""; print in_(), ""; for my $s (sort keys %$states) { print in_(), ""; } print inL(), ""; for my $t (sort keys %$tab) { print inR(), ""; print in_(), ""; for my $s (sort keys %$states) { print in_(), ""; } print inL(), ""; } print inL(), "
$p$s
$t", $tab->{$t}{$s} || 0, "
"; print GP "set nolog x\n"; print GP "set xtics autofreq\n"; print GP "set output 'statesper$p.png'\n"; print GP "plot "; my $comma = 0; for my $s (sort keys %$states) { print GP ($comma++ ? ',' : ''), "'-' title '$s'"; } print GP "\n"; for my $s (sort keys %$states) { for my $t (sort keys %$tab) { print GP $tab->{$t}{$s} || 0, "\n"; } print GP "e\n"; } print in_(), ""; } sub smoothhist { my ($tab, $title, $filename) = @_; print in_(), "

$title

"; # print smoothed histogram my $int = 0.1; print GP "set log x\n"; print GP "set xtics (14400, 28800, 43200, 57600, 72000, 86400)\n"; print GP "set output '$filename'\n"; print GP "plot '-'\n"; print inR(), ""; for my $v (0 .. $#$tab) { next unless ($tab->[$v]); my $w0 = int($v * (1-$int)); my $w1 = int($v * (1+$int)); my $s = 0; for ($w0 .. $w1) { $s += ($tab->[$_] || 0); } print GP "$v\t$s\n"; print in_() . ""; } print GP "e\n"; print inL(), "
$v$s
"; print in_(), ""; }