Beefy Boxes and Bandwidth Generously Provided by pair Networks
good chemistry is complicated,
and a little bit messy -LW

Attempted mail relay reporting

by rob_au (Abbot)
on Nov 27, 2001 at 18:52 UTC ( #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: 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=<>, relay=[200.XXX.XXX.XXX], reject +=550 5.7.1 <>... Relaying denied Tue Nov 27 21:08:39 2001 budapest sendmail[2679]: fARA8Gh02679: rulese +t=check_rcpt, arg1=<>, relay=[200.XXX.XXX.XXX], re +ject=550 5.7.1 <>... 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'        =>  '',
    'From'      =>  '',
    'Server'    =>  ''

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    =>  "",
            PeerPort    =>  43,
            Timeout     =>  30
        ) || die $!;
        my @response = <$sock>;
        return join "", @response;
    my $smtp = Mail::Mailer->new("smtp", Server => $mail{'Server'});
        '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";

exit 0;

Comment on Attempted mail relay reporting
Download Code

Back to Code Catacombs

Log In?

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

How do I use this? | Other CB clients
Other Users?
Others musing on the Monastery: (3)
As of 2015-10-07 01:05 GMT
Find Nodes?
    Voting Booth?

    Does Humor Belong in Programming?

    Results (168 votes), past polls