Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl-Sensitive Sunglasses
 
PerlMonks  

Attempted mail relay reporting

by rob_au (Abbot)
on Nov 27, 2001 at 18:52 UTC ( [id://127798]=sourcecode: print w/replies, xml ) Need Help??
Category: E-Mail Programs
Author/Contact Info rob_au
Description: In attempting to track down and report a number of attempted mail relays through some of my mail servers, I decided to employ Perl to perform a bit of log analysis for me. The result was the following code which parses through the server sendmail log, identifying questionable ruleset checks, extracts the originating relay host and performs a network lookup on the host. This information, with the relevant log extracts, is then reported via email to a predefined email address for further action.

An edited example of the email output follows:

Query: 200.XXX.XXX.XXX Registry: whois.arin.net Results: Example Inc. (NET-EXAMPLE-BAD) EXAMPLE-BAD 200.XXX.XXX.XXX - 200.XXX.XXX.XXX Results brought to you by the GeekTools WHOIS Proxy Server results may be copyrighted and are used with permission. Tue Nov 27 21:08:39 2001 budapest sendmail[2679]: fARA8Gh02679: rulese +t=check_rcpt, arg1=<example@msn.com>, relay=[200.XXX.XXX.XXX], reject +=550 5.7.1 <example@msn.com>... Relaying denied Tue Nov 27 21:08:39 2001 budapest sendmail[2679]: fARA8Gh02679: rulese +t=check_rcpt, arg1=<example@hotmail.com>, relay=[200.XXX.XXX.XXX], re +ject=550 5.7.1 <example@hotmail.com>... Relaying denied . . .
Please note that this code does not directly contact the administrator of the network from which the mail relay was attempted, a discretionary exercise left for the mail server administrator.
#!/usr/bin/perl -wT

use IO::Socket::INET;
use Mail::Mailer;
use Parse::Syslog;

use strict;


my %mail = (
    'To'        =>  'rob@cowsnet.com.au',
    'From'      =>  'root@cowsnet.com.au',
    'Server'    =>  '127.0.0.1'
);

my %hosts;
my $syslog = Parse::Syslog->new('/var/log/mail.log', arrayref => 1);
while (my $line = $syslog->next) {
    next unless $line->[2] =~ /^sendmail$/i;
    next unless $line->[4] =~ /ruleset=check_(rcpt|relay)/i;
    my ($relay) = $line->[4] =~ m/relay=\[?([\w\d\.\-\@]+)\]?/i;
    next unless defined $relay;
    push @{$hosts{$relay}}, $line;
}

foreach my $host (keys %hosts) {
    my $whois = eval {
        my $sock = IO::Socket::INET->new(
            PeerAddr    =>  "whois.geektools.com",
            PeerPort    =>  43,
            Timeout     =>  30
        ) || die $!;
        $sock->print("$host\r\n");
        my @response = <$sock>;
        $sock->close;
        return join "", @response;
    };
    my $smtp = Mail::Mailer->new("smtp", Server => $mail{'Server'});
    $smtp->open({
        'To'        =>  $mail{'To'},
        'From'      =>  $mail{'From'},
        'Subject'   =>  "[MAIL ADMIN] Attempted mail relay from $host"
    });
    print $smtp $whois, "\n";
    foreach my $line (@{$hosts{$host}}) {
        my $time = localtime($line->[0]);
        print $smtp
            $time, " ",
            $line->[1], " ",
            $line->[2], "[", $line->[3], "]: ",
            $line->[4], "\n\n";
    }
    $smtp->close;
}

exit 0;

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: sourcecode [id://127798]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others admiring the Monastery: (3)
As of 2024-03-29 06:15 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found