From Code to Community: Sponsoring The Perl and Raku Conference 2025 Learn more

MUIR / SyslogScan-Daemon-SpamDetector-0.53 / lib / SyslogScan / Daemon / SpamDetector / BadAddr / Sendmail.pm 

            

              
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
—
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166

              
package SyslogScan::Daemon::SpamDetector::BadAddr::Sendmail;
use strict;
use warnings;
use SyslogScan::Daemon::SpamDetector::BadAddr::Plugin;
use Plugins::SimpleConfig;
use Tie::Cache::LRU;
our(@ISA) = qw(SyslogScan::Daemon::SpamDetector::BadAddr::Plugin);
our $msgcachesize = 3_000;
my %defaults = (
        rx_extra        => '.',
        rx_month        => '(?:Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec)',
        rx_date         => '',
        logfile         => '/var/log/mail.log',
        debug           => 0,
        msgcachesize    => sub {
                my ($pkgself, $key, $value) = @_;
                if (ref($pkgself)) {
                        $pkgself->{msgcachesize} = $value;
                        if ($pkgself->{msgcache}) {
                                my $t = tied(%{$pkgself->{msgcache}});
                                $t->max_size($value);
                        }
                } else {
                        $msgcachesize = $value;
                }
        },
);
sub config_prefix { 'badsendmail_' }
sub parse_config_line { simple_config_line(\%defaults, @_); }
sub new 
{
        my $self = simple_new(\%defaults, @_); 
        $self->{msgcache} = {};
        die if ref($self->{msgcachesize});
        tie %{$self->{msgcache}}, 'Tie::Cache::LRU', $self->{msgcachesize} || $msgcachesize;
        return $self;
}
our $Mon;
our $Date;
our $iprx;
sub preconfig
{
        my $self = shift;
        $self->{Mon} = qr/$self->{rx_month}/;
        $self->{Date} = $self->{rx_date} ? qr/$self->{rx_date}/ : qr/$self->{Mon} [ 1-3][0-9] \d\d:\d\d:\d\d/;
        $self->{Extra} = qr/$self->{rx_extra}/;
}
sub get_logs
{
        my $self = shift;
        my $Date = $self->{Date};
        return (
                $self->{logfile}     => [
#1st                    Oct 31 09:44:04 idiom sm-mta[48031]: k9VHi04a048031: <reineant@design-universe.com>... User unknown
#2nd                    Oct 20 00:00:12 idiom sm-mta[16655]: k9K6xf1f016655: from=<declarator@embrace.org.uk>, size=771, class=0, nrcpts=1, msgid=<46600514770495.39A8A178A2@SLDS5JHS>, proto=ESMTP, daemon=Daemon0, relay=pool-151-205-120-16.ny325.east.verizon.net [151.205.120.16]
                        qr{^$Date (\S+) sm-mta\[\d+\]: (\w+): from=<(.*?)>, size=\d+, class=\d+, nrcpts=\d+, (msgid)=<(.*?)>, proto=\S+, daemon=\S+, relay=(\S+) \[([\d\.]{8,40})\]},
                        qr{^$Date (\S+) sm-mta\[\d+\]: (\w+): <(\S+?)>\.\.\. User (unknown)},
                ],
        );
}
sub parse_logs
{
        my ($self, $logfile, $rx) = @_;
        my $debug = $self->{debug};
        my $logline = $_;
        my ($host, $qid, $fromto, $what, $id, $relayname, $relayip) = ($1, $2, $3, $4, $5, $6, $7);
        print "Matched $logline\n" if $debug >= 3;
        my $queueid = "$host/$qid";
        if ($self->{Extra} && ! /$self->{Extra}/) {
                # ignore
        } elsif ($what eq 'unknown') {
                push(@{$self->{msgcache}{$queueid}}, $fromto);
                print "Unknown user: $queueid: $fromto\n" if $debug >= 2;
        } elsif ($what eq 'msgid') {
                for my $to (@{$self->{msgcache}{$queueid}}) {
                        print "Will report $queueid: $fromto -> $to from $relayip\n" if $debug;
                        $self->process_badaddr_match(
                                id              => $id,
                                ip              => $relayip,
                                from            => $fromto,
                                relayname       => $relayname,
                                match           => 'BadAddr::Sendmail',
                                to              => $to,
                                host            => $host,
                        );
                }
                delete $self->{msgcache}{$queueid};
        } else {
                warn "This should not happen";
        }
        return;
}
1;
=head1 NAME
 SyslogScan::Daemon::SpamDetector::BadAddr::Sendmail - notice bad email addresses in sendmail log files
=head1 SYNOPSIS
 plugin SyslogScan::Daemon::SpamDetector as sd_
 sd_plugin SyslogScan::Daemon::SpamDetector::BadAddr as bad_
 bad_plugin SyslogScan::Daemon::SpamDetector::BadAddr::Sendmail
        debug           1
        logfile         /var/log/mail.info
        msgcachesize    3000
=head1 DESCRIPTION
Read Sendmail logs and notice attempts to send to addresses that don't exist.
=head1 CONFIGURATION PARAMETERS
The following configuration parameters are supported:
=over 4
=item debug
Debugging on (1) or off (0).
=item logfile
Which logfile to watch (default: C</var/log/mail.log>).
=item msgcachesize
To do this mapping, multiple log lines must be matched.  Partial
matches will be stored in a cache.  This parameter sets the
size of the cache (default: 3000).
=back
=head1 SEE ALSO
L<SyslogScan::Daemon::SpamDetector>
L<SyslogScan::Daemon::SpamDetector::BadAddr>
L<SyslogScan::Daemon::SpamDetector::BadAddr::Postfix>
=head1 THANK THE AUTHOR
If you need high-speed internet services (T1, T3, OC3 etc), please 
send me your request-for-quote.  I have access to very good pricing:
you'll save money and get a great service.
=head1 LICENSE
Copyright(C) 2006 David Muir Sharnoff <muir@idiom.com>. 
This module may be used and distributed on the same terms
as Perl itself.