Beefy Boxes and Bandwidth Generously Provided by pair Networks
laziness, impatience, and hubris

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;
Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://127798]
[Discipulus]: hello crew! marto thanks for the message: but I how can I help? i'm testing cpan Padre atm problem with Client::Debug
[choroba]: I don't happen to have 5.10.0 nor 5.8.5 handy...
[Corion]: Hmm - I would say the 5.8.5 is a broken installation / corrupt tarball download, and the 5.10.0 is really weird, and maybe a bug in that version of Perl
[Corion]: I don't see how my $result = eval q{'abc' =~ ?b?}; could create a "Modification of read-only value" error
[marto]: Discipulus the issue that should be adressed is that the page needs to be updated to reflect modern perl on Windows
[Discipulus]: but is really necessary to support these ancient versions? from 5.14 onward is not enough?
[Discipulus]: yes marto I understood
[Corion]: Discipulus: I'm slowly migrating my code to require 5.8.x ;) Most of my code works on 5.6, but Filter::signatures requires 5.10 I think
[Corion]: 5.14 is also a good target, widely available and fairly stable. Also, over five years old, which doesn't push people into a needless upgrade cycle

How do I use this? | Other CB clients
Other Users?
Others pondering the Monastery: (10)
As of 2018-06-25 08:47 GMT
Find Nodes?
    Voting Booth?
    Should cpanminus be part of the standard Perl release?

    Results (126 votes). Check out past polls.