####################################################################
# 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
#
# --
# Location: primus
####################################################################

use strict;
use Socket;

my $UTIL_VERSION = '0.8002';

sub _Debug ($);

my $TTW = 25; # 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"; # yum install bind-utils

	_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