This utility starts with a nslookup for related MX servers.
If no MX servers are found, the scripts further checks if a mail server is listening
on port 25 and a HELO command is replied with a successful code 220.
####################################################################
# check_mailserver.pl
#
# Author: Reto Schaer
#
# Usage:
# ------
# require "_util/check_mailserver.pl";
# my $rc = &check_mail_ability(domain => 'example.com', debug => 0);
#
# Returns: 0 on success, 1 on simple error, 2 on timeout
#-------------------------------------------------------------------
#
# Documentation:
# --------------
# http://www.infocopter.com/perl/modules/util-mailcheck.html
####################################################################
use strict;
use Socket;
my $UTIL_VERSION = '0.80.01';
sub _Debug ($);
my $TTW = 2; # seconds to wait
my $mDEBUG = 0;
my $mRC = 0;
$SIG{'ALRM'} = \&alarm_handler; # install signal handler
sub check_mail_ability(%) {
my %args = @_;
$args{'debug'} ||= 0;
alarm($TTW);
$mDEBUG = $args{'debug'}; # globalize
my $cmd = "dig mx $args{'domain'}|grep MX";
_Debug "$cmd" if $args{'debug'};
my @mx_result = split /\n/, `$cmd`;
my $i = 0;
foreach (@mx_result) {
next if /^;/;
$_ = &trim($_);
s/\.$//;
my @token = split / /;
_Debug '== "' . $token[$#token] . "\"" if $args{'debug'};
$i++;
}
my $rc = 0;
if ($i == 0) {
_Debug "No MX records of \"$args{'domain'}\" found, checking as mail server..." if $mDEBUG;
eval {
$rc = &check_mail_server( domain => $args{'domain'} );
};
$rc = 1 if $@;
$rc = 2 if $mRC == 1; # was a timeout
}
$rc;
}
sub trim ($) {
my $t = $_[0];
$t =~ s/\t/, /; # first tab
$t =~ tr/\t/ /;
$t = join " ", grep { $_ } split / /, $t;
$t;
}
sub check_mail_server (%) {
my %args =@_;
_Debug "Connecting to $args{'domain'}" if $mDEBUG;
no strict;
unless (&open_TCP(F, $args{'domain'}, 25)) {
print STDERR "Error\n";
return 1;
}
print F "HELO DUDE\n";
my $ok = 0;
while(<F>) {
chomp;
_Debug "N1000 $_" if $mDEBUG;
if (/^220/) {
$ok = 1;
last;
}
}
close F;
return $ok ? 0 : 1;
}
sub open_TCP (@) {
my ($FS, $dest, $port) = @_;
_Debug "open_TCP..." if $mDEBUG;
my $proto = getprotobyname('tcp');
no strict;
socket($FS, PF_INET, SOCK_STREAM, $proto);
my $sin = sockaddr_in($port, inet_aton($dest));
connect($FS, $sin) || return undef;
my $old_fh = select($FS);
$| = 1;
select($old_fh);
1;
}
sub tstamp() {
my ($y, $m, $d, $H, $M, $S) = (localtime)[5,4,3,2,1,0];
$y += 1900; $m++;
sprintf("%d-%02d-%02d %02d:%02d:%02d", $y, $m, $d, $H, $M, $S);
}
sub alarm_handler () {
print STDERR "alarm catched / timeout!\n";
alarm($TTW);
$mRC = 1;
return;
}
sub _Debug ($) { print "[sub] $_[0]\n"; }
1;
__END__
Next codes:
N1001
[ Download: primus.pgate.net/_pubsource/check_mailserver_pl.txt↑ ]
iC Home > Perl > my Modules >
Utilities > Mail Check