line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Log::Saftpresse::Plugin::Postfix::Rejects; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
849
|
use Moose::Role; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
5
|
|
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
# ABSTRACT: plugin to gather postfix reject statistics |
6
|
|
|
|
|
|
|
our $VERSION = '1.5'; # VERSION |
7
|
|
|
|
|
|
|
|
8
|
1
|
|
|
1
|
|
3363
|
use Log::Saftpresse::Plugin::Postfix::Utils qw(gimme_domain verp_mung string_trimmer ); |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
994
|
|
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
requires 'message_detail'; |
11
|
|
|
|
|
|
|
requires 'reject_detail'; |
12
|
|
|
|
|
|
|
requires 'ignore_case'; |
13
|
|
|
|
|
|
|
requires 'rej_add_from'; |
14
|
|
|
|
|
|
|
requires 'verp_mung'; |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
sub process_rejects { |
17
|
0
|
|
|
0
|
0
|
|
my ( $self, $stash ) = @_; |
18
|
0
|
|
|
|
|
|
my $service = $stash->{'service'}; |
19
|
0
|
|
|
|
|
|
my $message = $stash->{'message'}; |
20
|
|
|
|
|
|
|
|
21
|
0
|
0
|
0
|
|
|
|
if( $service eq 'cleanup' && |
22
|
|
|
|
|
|
|
( my($rejSubTyp, $rejReas, $rejRmdr) = $message =~ |
23
|
|
|
|
|
|
|
/.*?\b(reject|warning|hold|discard): (header|body) (.*)$/ ) ) { |
24
|
|
|
|
|
|
|
|
25
|
0
|
|
|
|
|
|
$stash->{'reject_type'} = $rejSubTyp; |
26
|
0
|
|
|
|
|
|
$stash->{'reject_reason'} = $rejReas; |
27
|
|
|
|
|
|
|
|
28
|
0
|
0
|
|
|
|
|
$rejRmdr =~ s/( from \S+?)?; from=<.*$// |
29
|
|
|
|
|
|
|
unless( $self->message_detail ); |
30
|
0
|
|
|
|
|
|
$rejRmdr = string_trimmer($rejRmdr, 64, $self->message_detail); |
31
|
|
|
|
|
|
|
|
32
|
0
|
0
|
|
|
|
|
if( $self->{'reject_detail'} != 0 ) { |
33
|
0
|
|
|
|
|
|
$self->incr_host_one( $stash, 'reject', $rejSubTyp, $service, $rejReas, $rejRmdr); |
34
|
|
|
|
|
|
|
} |
35
|
0
|
|
|
|
|
|
$self->incr_host_one( $stash, $stash, 'reject', 'total', $rejSubTyp ); |
36
|
0
|
0
|
|
|
|
|
if( $self->saftsumm_mode ) { |
37
|
0
|
|
|
|
|
|
$self->incr_per_time_one( $stash ); |
38
|
|
|
|
|
|
|
} |
39
|
|
|
|
|
|
|
} |
40
|
|
|
|
|
|
|
|
41
|
0
|
0
|
|
|
|
|
if( my ($type, $reject_message) = $message |
42
|
|
|
|
|
|
|
=~ /^(reject|reject_warning|proxy-reject|hold|discard): (.*)$/ ) { |
43
|
0
|
|
|
|
|
|
$stash->{'reject_type'} = $type; |
44
|
0
|
|
|
|
|
|
$self->proc_smtpd_reject($stash, $type, $reject_message); |
45
|
|
|
|
|
|
|
} |
46
|
|
|
|
|
|
|
|
47
|
0
|
|
|
|
|
|
return; |
48
|
|
|
|
|
|
|
} |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
sub incr_per_time_one { |
51
|
0
|
|
|
0
|
0
|
|
my ( $self, $stash ) = @_; |
52
|
0
|
|
|
|
|
|
my $time = $stash->{'time'}; |
53
|
0
|
|
|
|
|
|
$self->incr_host_one( $stash, 'reject', 'per_hr', $time->hour ); |
54
|
0
|
|
|
|
|
|
$self->incr_host_one( $stash, 'reject', 'per_mday', $time->mday ); |
55
|
0
|
|
|
|
|
|
$self->incr_host_one( $stash, 'reject', 'per_wday', $time->wday ); |
56
|
0
|
|
|
|
|
|
$self->incr_host_one( $stash, 'reject', 'per_day', $time->ymd ); |
57
|
0
|
|
|
|
|
|
return; |
58
|
|
|
|
|
|
|
} |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
sub proc_smtpd_reject { |
61
|
0
|
|
|
0
|
0
|
|
my ( $self, $stash, $type, $message ) = @_; |
62
|
|
|
|
|
|
|
#my ($logLine, $rejects, $msgsRjctd, $rejPerHr, $msgsPerDay) = @_; |
63
|
0
|
|
|
|
|
|
my ($rejTyp, $rejFrom, $rejRmdr, $rejReas); |
64
|
0
|
|
|
|
|
|
my ($from, $to); |
65
|
0
|
|
|
|
|
|
my $rejAddFrom = 0; |
66
|
|
|
|
|
|
|
|
67
|
0
|
|
|
|
|
|
$self->incr_host_one( $stash, 'reject', 'total', $type ); |
68
|
0
|
0
|
|
|
|
|
if( $self->saftsumm_mode ) { |
69
|
0
|
|
|
|
|
|
$self->incr_per_time_one( $stash ); |
70
|
|
|
|
|
|
|
} |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
# Hate the sub-calling overhead if we're not doing reject details |
73
|
|
|
|
|
|
|
# anyway, but this is the only place we can do this. |
74
|
0
|
0
|
|
|
|
|
return if( $self->reject_detail == 0); |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
# This could get real ugly! |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
# First: get everything following the "reject: ", etc. token |
79
|
|
|
|
|
|
|
# Was an IPv6 problem here |
80
|
0
|
|
|
|
|
|
($rejTyp, $rejFrom, $rejRmdr) = $message =~ /^(\S+) from (\S+?): (.*)$/; |
81
|
0
|
0
|
|
|
|
|
if( ! defined $rejTyp ) { return; } |
|
0
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
# Next: get the reject "reason" |
84
|
0
|
|
|
|
|
|
$rejReas = $rejRmdr; |
85
|
0
|
0
|
|
|
|
|
unless( $self->message_detail ) { |
86
|
0
|
0
|
0
|
|
|
|
if($rejTyp eq "RCPT" || $rejTyp eq "DATA" || $rejTyp eq "CONNECT") { # special treatment :-( |
|
|
0
|
0
|
|
|
|
|
87
|
|
|
|
|
|
|
# If there are "<>"s immediately following the reject code, that's |
88
|
|
|
|
|
|
|
# an email address or HELO string. There can be *anything* in |
89
|
|
|
|
|
|
|
# those--incl. stuff that'll screw up subsequent parsing. So just |
90
|
|
|
|
|
|
|
# get rid of it right off. |
91
|
0
|
|
|
|
|
|
$rejReas =~ s/^(\d{3} <).*?(>:)/$1$2/; |
92
|
0
|
|
|
|
|
|
$rejReas =~ s/^(?:.*?[:;] )(?:\[[^\]]+\] )?([^;,]+)[;,].*$/$1/; |
93
|
0
|
|
|
|
|
|
$rejReas =~ s/^((?:Sender|Recipient) address rejected: [^:]+):.*$/$1/; |
94
|
0
|
|
|
|
|
|
$rejReas =~ s/(Client host|Sender address) .+? blocked/blocked/; |
95
|
|
|
|
|
|
|
} elsif($rejTyp eq "MAIL") { # *more* special treatment :-( grrrr... |
96
|
0
|
|
|
|
|
|
$rejReas =~ s/^\d{3} (?:<.+>: )?([^;:]+)[;:]?.*$/$1/; |
97
|
|
|
|
|
|
|
} else { |
98
|
0
|
|
|
|
|
|
$rejReas =~ s/^(?:.*[:;] )?([^,]+).*$/$1/; |
99
|
|
|
|
|
|
|
} |
100
|
|
|
|
|
|
|
} |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
# Snag recipient address |
103
|
|
|
|
|
|
|
# Second expression is for unknown recipient--where there is no |
104
|
|
|
|
|
|
|
# "to=<mumble>" field, third for pathological case where recipient |
105
|
|
|
|
|
|
|
# field is unterminated, forth when all else fails. |
106
|
0
|
0
|
0
|
|
|
|
(($to) = $rejRmdr =~ /to=<([^>]+)>/) || |
|
|
|
0
|
|
|
|
|
107
|
|
|
|
|
|
|
(($to) = $rejRmdr =~ /\d{3} <([^>]+)>: User unknown /) || |
108
|
|
|
|
|
|
|
(($to) = $rejRmdr =~ /to=<(.*?)(?:[, ]|$)/) || |
109
|
|
|
|
|
|
|
($to = "<>"); |
110
|
0
|
0
|
|
|
|
|
$to = lc($to) if($self->{'ignore_case'}); |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
# Snag sender address |
113
|
0
|
0
|
|
|
|
|
(($from) = $rejRmdr =~ /from=<([^>]+)>/) || ($from = "<>"); |
114
|
|
|
|
|
|
|
|
115
|
0
|
0
|
|
|
|
|
if(defined($from)) { |
116
|
0
|
|
|
|
|
|
$rejAddFrom = $self->rej_add_from; |
117
|
0
|
|
|
|
|
|
$from = verp_mung( $self->verp_mung, $from); |
118
|
0
|
0
|
|
|
|
|
$from = lc($from) if($self->ignore_case); |
119
|
|
|
|
|
|
|
} |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
# stash in "triple-subscripted-array" |
122
|
0
|
0
|
|
|
|
|
if($rejReas =~ m/^Sender address rejected:/) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
123
|
|
|
|
|
|
|
# Sender address rejected: Domain not found |
124
|
|
|
|
|
|
|
# Sender address rejected: need fully-qualified address |
125
|
0
|
|
|
|
|
|
$self->incr_host_one( $stash, 'reject', $type, $rejTyp, $rejReas, $from); |
126
|
|
|
|
|
|
|
} elsif($rejReas =~ m/^(Recipient address rejected:|User unknown( |$))/) { |
127
|
|
|
|
|
|
|
# Recipient address rejected: Domain not found |
128
|
|
|
|
|
|
|
# Recipient address rejected: need fully-qualified address |
129
|
|
|
|
|
|
|
# User unknown (in local/relay recipient table) |
130
|
|
|
|
|
|
|
#++$rejects->{$rejTyp}{$rejReas}{$to}; |
131
|
0
|
|
|
|
|
|
my $rejData = $to; |
132
|
0
|
0
|
|
|
|
|
if($rejAddFrom) { |
133
|
0
|
0
|
|
|
|
|
$rejData .= " (" . ($from? $from : gimme_domain($rejFrom)) . ")"; |
134
|
|
|
|
|
|
|
} |
135
|
0
|
|
|
|
|
|
$self->incr_host_one( $stash, 'reject', $type, $rejTyp, $rejReas, $rejData); |
136
|
|
|
|
|
|
|
} elsif($rejReas =~ s/^.*?\d{3} (Improper use of SMTP command pipelining);.*$/$1/) { |
137
|
|
|
|
|
|
|
# Was an IPv6 problem here |
138
|
0
|
|
|
|
|
|
my ($src) = $message =~ /^.+? from (\S+?):.*$/; |
139
|
0
|
|
|
|
|
|
$self->incr_host_one( $stash, 'reject', $type, $rejTyp, $rejReas, $src); |
140
|
|
|
|
|
|
|
} elsif($rejReas =~ s/^.*?\d{3} (Message size exceeds fixed limit);.*$/$1/) { |
141
|
0
|
|
|
|
|
|
my $rejData = gimme_domain($rejFrom); |
142
|
0
|
0
|
|
|
|
|
$rejData .= " ($from)" if($rejAddFrom); |
143
|
0
|
|
|
|
|
|
$self->incr_host_one( $stash, 'reject', $type, $rejTyp, $rejReas, $rejData); |
144
|
|
|
|
|
|
|
} elsif($rejReas =~ s/^.*?\d{3} (Server configuration (?:error|problem));.*$/(Local) $1/) { |
145
|
0
|
|
|
|
|
|
my $rejData = gimme_domain($rejFrom); |
146
|
0
|
0
|
|
|
|
|
$rejData .= " ($from)" if($rejAddFrom); |
147
|
0
|
|
|
|
|
|
$self->incr_host_one( $stash, 'reject', $type, $rejTyp, $rejReas, $rejData); |
148
|
|
|
|
|
|
|
} else { |
149
|
|
|
|
|
|
|
# print STDERR "dbg: unknown reject reason $rejReas !\n\n"; |
150
|
0
|
|
|
|
|
|
my $rejData = gimme_domain($rejFrom); |
151
|
0
|
0
|
|
|
|
|
$rejData .= " ($from)" if($rejAddFrom); |
152
|
0
|
|
|
|
|
|
$self->incr_host_one( $stash, 'reject', $type, $rejTyp, $rejReas, $rejData); |
153
|
|
|
|
|
|
|
} |
154
|
|
|
|
|
|
|
} |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
1; |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
__END__ |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
=pod |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
=encoding UTF-8 |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
=head1 NAME |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
Log::Saftpresse::Plugin::Postfix::Rejects - plugin to gather postfix reject statistics |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
=head1 VERSION |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
version 1.5 |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
=head1 AUTHOR |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
Markus Benning <ich@markusbenning.de> |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
This software is Copyright (c) 1998 by James S. Seymour, 2015 by Markus Benning. |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
This is free software, licensed under: |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
The GNU General Public License, Version 2, June 1991 |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
=cut |