Mail::Audit::MAPS - Mail::Audit plugin for RBL checking

Mail-Audit documentation Contained in the Mail-Audit distribution.

Index

Code Index:

NAME

Top

Mail::Audit::MAPS - Mail::Audit plugin for RBL checking

SYNOPSIS

Top

    use Mail::Audit qw(MAPS);
	my $mail = Mail::Audit->new;
    ...
	if ($mail->rblcheck) {
        ...
    }

DESCRIPTION

Top

This is a Mail::Audit plugin which provides a method for checking messages against the Relay Black List.

METHODS

rblcheck([$timeout])

Attempts to check the mail headers with the Relay Blackhole List. Returns false if the headers check out fine or the query times out, returns a reason if the mail is considered spam.

AUTHOR

Top

Simon Cozens <simon@cpan.org>

SEE ALSO

Top

Mail::Audit

Mail-Audit documentation Contained in the Mail-Audit distribution. 
package Mail::Audit::MAPS;
use Mail::Audit;
use vars q(@VERSION);
$VERSION = '2.225';
$host    = '.blackholes.mail-abuse.org';
1;

package Mail::Audit;

use strict;
use Net::SMTP;
use Mail::Internet;
use Sys::Hostname;

sub myALRM { die "alarm\n" }

sub rblcheck {
  my ($self, $timeout) = (shift, shift);
  $self->_log(1, "Performing RBL check");
  my @recieved = $self->received;
  my $rcvcount = 0;
  $timeout = 10 unless defined $timeout;

  # Catch ALRM signals so we can timeout DNS lookups
  $SIG{ALRM} = 'myALRM';
  &myALRM() if 0;  # make -w shut up
  for (@recieved) {
    my $x = _checkit($rcvcount, $_, $timeout);
    if ($x) {
      $self->_log(2,
        "Check returned $x after " . (1 + $rcvcount) . " recieved headers");
      return $x;
    }
    $rcvcount++;   # Any further Received lines won't be the first.
  }
  $self->_log(2, "Check was fine");
  return '';
}

sub _checkit {
  my $OK           = '';
  my $InvalidIP    = '1 Invalid IP address ';
  my $RcvBlackHole = '2 Received from RBL-registered spam site ';
  my $RlyBlackHole = '3 Relayed through RBL-registered spam site ';

  my ($relay, $rcvd, $timeout) = @_;
  my ($IP, @IP) = $rcvd =~ /((\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3}))/;
  my ($name, $x);

  # We can't complain if there's no IP address in this Received header.
  return ($OK) unless defined $IP;

  # Outer limits lose
  return ($InvalidIP . $IP) if $IP eq '0.0.0.0';
  return ($InvalidIP . $IP) if $IP eq '255.255.255.255';

  # All @IP components must be >= 0 and <= 255
  foreach $x (@IP) {
    return ($InvalidIP . $IP) if $x > 255;
    return ($InvalidIP . $IP) if $x =~ /^0\d/;  # no leading zeroes allowed
  }

  #
  # Wrap the gethostbyname call with eval in case it times out.
  #
  eval {
    alarm($timeout);
    ($name) = gethostbyname(join('.', reverse @IP) . $Mail::Audit::MAPS::host);
    alarm(0);
  };
  return ($OK) if $@ =~ /^alarm/;  # Timed out.  Let it through.
  return ($OK) unless $name;       # If it's ok with MAPS, it's OK with us.
  return ($relay ? $RlyBlackHole . $IP : $RcvBlackHole . $IP);
}

1;
__END__