package Mail::OpenRelay::Simple;
use 5.008;
use strict;
use warnings;
use base qw(Class::Accessor::Fast);
use Carp;
use Net::Telnet;
our $VERSION = '0.02';
$VERSION = eval $VERSION;
__PACKAGE__->mk_accessors( qw(host port timeout from_email rcpt_email banner debug));
$| = 1;
sub check {
my $self = shift;
my $host = $self->host;
my $port = $self->port;
my $timeout = $self->timeout;
my $from_email = $self->from_email;
my $rcpt_email = $self->rcpt_email;
my $banner = $self->banner;
my $debug = $self->debug;
$banner = $banner ? $banner : 0;
$debug = $debug ? $debug : 0;
$from_email = $from_email ? $from_email : "test\@foobar.com";
$rcpt_email = $rcpt_email ? $rcpt_email : "test\@foobar.com";
print ". Try to connect to $host...\n" if $debug == 2;
my $t = new Net::Telnet(
Host => $host,
Port => $port || '25',
Timeout => $timeout || '8',
Errmode => "return"
);
if ($t){
my $match = $t->getline;
if ($match){
my $Banner = $match;
chomp $Banner; for ($Banner) { s/^220\s//; }
if ($match =~ m/^220/){
print ". HELO foo\n" if $debug == 1;
$t->print("HELO foo");
$match = $t->getline;
if ($match){
if ($match =~ /^250/){
print ". MAIL FROM:<$from_email>\n" if $debug == 1;
$t->print("MAIL FROM:<$from_email>");
$match = $t->getline;
if ($match){
if ($match =~ /^250/){
print ". RCPT TO:<$rcpt_email>\n" if $debug == 1;
$t->print("RCPT TO:<$rcpt_email>");
$match = $t->getline;
if ($match){
if ($match =~ /^250/){
print "$Banner\n" if $banner == 1;
return 1;
} else {
return 0;
}
} else {
print ". can't send email with $host!\n" if $debug == 1;
}
}
}
}
}
}
}
$t->close;
} else {
print ". can't connect to host $host on port $port\n" if $debug == 1;
}
return;
}
1;
__END__
=head1 NAME
Mail::OpenRelay::Simple - check if a mail server runs as an open relay.
=head1 SYNOPSIS
use Mail::OpenRelay::Simple;
my $host = "127.0.0.1";
my $scan = Mail::OpenRelay::Simple->new({
host => $host,
timeout => 5,
from_email => "test\@foobar.com",
rcpt_email => "test\@foobar.com",
banner => 0,
debug => 0
});
print "$host open relay\n" if $scan->check;
=head1 DESCRIPTION
This module permit to check if a mail server runs as an open relay.
B<Note: this module provides only a simple test. No email message is sended.>
=head1 METHODS
=head2 new
The constructor. Given a host returns a L<Mail::OpenRelay::Simple> object:
my $scan = Mail::OpenRelay::Simple->new({ host => "127.0.0.1" });
Optionally, you can also specify :
=over 2
=item B<port>
remote port. Default is 25;
=item B<timeout>
default is 8 seconds;
=item B<from_email>
default is test\@foobar.com;
=item B<rcpt_email>
default is test\@foobar.com;
=item B<banner>
0 (none), 1 (show mail server banner). Default is 0;
=item B<debug>
0 (none), 1 (show all requests). Defualt is 0;
=back
=head2 check
Checks the target.
$scan->check;
=head1 SEE ALSO
http://en.wikipedia.org/wiki/Open_mail_relay
=head1 AUTHOR
Matteo Cantoni, E<lt>mcantoni@cpan.orgE<gt>
=head1 COPYRIGHT AND LICENSE
You may distribute this module under the terms of the Artistic license.
See Copying file in the source distribution archive.
Copyright (c) 2006, Matteo Cantoni
=cut
syntax highlighted by Code2HTML, v. 0.9.1