File Coverage

blib/lib/Log/Saftpresse/Plugin/Postfix/Rejects.pm
Criterion Covered Total %
statement 6 74 8.1
branch 0 52 0.0
condition 0 15 0.0
subroutine 2 5 40.0
pod 0 3 0.0
total 8 149 5.3


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