#!/usr/bin/perl -w use strict; use parselog; use Data::Dumper; use Getopt::Long; use File::Path; my $template = 'out/.html'; GetOptions("template=s" => \$template); for (@ARGV) { parse(\&save, $_); } my @h; # Content of the files: # Key is the recipient's address (as stored in $s->{rcpts}{*}{xrcpts}, # i.e., without <>). # # Second level contains two keys: # t for transactions, # s for statistics. # # For transactions the key is the start date (Hmm, that means if a # recipient gets two mails in the same second, one of them will not be # shown - FIXME) # # For stats there are various keys. my %f; for my $f (keys %f) { my ($local, $domain) = split(/@/, $f); my $ff = $template; $ff =~ s//$local/g; $ff =~ s//$domain/g; $ff =~ s//$f/g; my $d = $ff; $d =~ s/[^\/]*$//; if ($d) { mkpath $d; } open(F, '>:utf8', $ff); print F "\n"; print F "\n"; print F "", $f, "\n"; print F "\n"; print F "\n"; print F "\n"; print F "

", $f, "

\n"; print F "

→Erläuterungen

\n"; print F "\n"; for (sort keys %{ $f{$f}{t} }) { print F $f{$f}{t}{$_}; } print F "

\n"; print F "

Stats

\n"; my %m = (); my $t = 0; for my $r (sort keys %{ $f{$f}{s} }) { my $res = $f{$f}{s}{$r}; for my $c (sort keys %$res) { for my $k (sort keys %{$res->{$c}}) { $m{$c}{$k} += $res->{$c}{$k}; $t += $res->{$c}{$k}; } } } print F "\n"; print F ""; print F ""; for my $c (sort keys %m) { print F ""; } print F "\n"; print F ""; for my $c (sort keys %m) { for my $k (sort keys %{$m{$c}}) { print F ""; } } print F "\n"; for my $r (sort keys %{ $f{$f}{s} }) { print F ""; print F ""; my $res = $f{$f}{s}{$r}; my $s = 0; for my $c (sort keys %m) { for my $k (sort keys %{$m{$c}}) { no warnings 'uninitialized'; print F ""; $s += $res->{$c}{$k}; } } print F ""; print F "\n"; } print F ""; print F ""; for my $c (sort keys %m) { for my $k (sort keys %{$m{$c}}) { print F ""; } } print F ""; print F "\n"; print F "

	$c
	", escape($k), "
", escape($r), "	", $res->{$c}{$k}, "	", $s, "
	", $m{$c}{$k}, "	", $t, "

\n"; print F "\n"; print F "\n"; close(F); } sub save { my ($s) = @_; for my $r (keys %{$s->{rcpts}}) { my $rv = $s->{rcpts}{$r}; #print STDERR "$r\n"; for my $xr ( @{$rv->{xrcpts}}) { #print "\t$xr\n"; my $f = $xr; $f =~ s/\+.*\@/\@/; $f =~ tr/-+a-zA-Z0-9@./_/c; $f{$f}{t}{$s->{start}} .= dump_transaction($s, $r); #$f{$f}{s}{substr($rv->{finalresult}, 0, 1)}++; #$f{$f}{s}{msg2key($rv->{finalresult})}++; $f{$f}{s}{$r}{substr($rv->{finalresult}, 0, 1)}{msg2key($rv->{finalresult})}++; } } #print "\n"; } sub dump_transaction { my ($s, $ra) = @_; my $t = "\n"; $t .= "time" . escape($s->{start}) . " ... " . escape($s->{end}) . "\n"; $t .= "server" . escape($s->{server}) . "\n"; $t .= "client" . escape($s->{hostname}) . " [" . escape($s->{ipaddr}) . "]\n"; $t .= "HELO" . escape($s->{helo}) . "\n" if ($s->{helo}); $t .= "EHLO" . escape($s->{ehlo}) . "\n" if ($s->{ehlo}); $t .= "MAIL FROM" . escape($s->{mail}) . "" . result($s->{mailresult}) . "\n"; for my $r (keys %{$s->{rcpts}}) { my $class = $r eq $ra ? "active recipient" : "recipient"; $t .= "RCPT TO " . escape($r) . "" . result($s->{rcpts}{$r}{rcptresult}) . "\n"; } $t .= "DATA" . result($s->{dataresult}) . "\n"; if ($s->{spamassassin}) { $t .= "spamassassin" . join('
', map { s/,/, /g; escape($_) } @{$s->{spamassassin}}) . "\n"; } $t .= "\n"; $t .= "\n"; } sub result { my ($msg) = @_; $msg = '' unless (defined $msg); my $color = '#FFFFFF'; $color = '#00FF00' if (substr($msg, 0, 1) eq '2'); $color = '#FFFF00' if (substr($msg, 0, 1) eq '4'); $color = '#FF0000' if (substr($msg, 0, 1) eq '5'); return "" . escape($msg) . ""; } sub escape { my ($s) = @_; $s = '' unless (defined $s); $s =~ s/\&/\&/g; $s =~ s/\/\>/g; return $s; }