#!/usr/bin/perl

#
# usage: mail_from_check.pl mailbox@domain [--verbose] [--log logfile] [--check-answer]
#

use strict;

use IO::Socket;
use Net::DNS;
use Getopt::Long;
use Net::Domain qw(hostname hostfqdn hostdomain);
use Sys::Syslog qw(:DEFAULT setlogsock);
use File::Basename;

my($script_name) = File::Basename::basename($0);

##### configuration #####
my($default_max_attempts) = 1;

my(%syslog_param) = (
    'socket' => 'unix',
    'ident' => $script_name,
    'options' => 'cons,pid',
#    'facility' => 'local4',
    'facility' => 'mail',
    'priority' => 'notice',
# в logformat можно применять:
# %mailbox	- проверяемый mailbox
# %domain	- проверяемый домен
# %SMTP_host	- primary MX
# %SMTP_command	- команда, вливаемая MTA через сокет
# %SMTP_answer	- ответ MTA
# %check_result	- окончательный результат проверки
#    'logformat' => 'check %mailbox@%domain: %SMTP_command: %SMTP_answer; %check_result'
#    'logformat' => '%check_result (%mailbox@%domain: %SMTP_command => %SMTP_answer)'
    'logformat' => '%check_result (%mailbox@%domain: %SMTP_host => %SMTP_command => %SMTP_answer)'
);

my(@excluded) = (
"550 ukr.net . R u jokin' .",
"550 .* Relaying denied",
"Administrative prohibition"
);

my(%alternative_mx) = (
#    'ukr.net' => 'freemail.ukr.net',
    'localhost' => 'localhost'
);
##### /configuration #####

my($help, $debug, $verbose, $log, $check_answer, $use_vrfy, $max_attempts, $host);

GetOptions (
    'help'		=> \$help,
    'debug'		=> \$debug,
    'verbose'		=> \$verbose,
    'log=s'		=> \$log,
    'check-answer'	=> \$check_answer,
    'use-vrfy'		=> \$use_vrfy,
    'max-attempts=i'	=> \$max_attempts
);

if ($help) {
    print("e-mail address checker

usage:
\t$script_name --help
\t$script_name --check-answer
\t$script_name <mail_addr> [--verbose|--debug] [--log=<logfile>] [--use-vrfy]
");
    exit();
}

$verbose = 1 if ($debug);

my($address) = lc(shift(@ARGV));
my($mailbox, $domain) = ($address =~ /\s*(.+)\@(.+)\s*$/);

$max_attempts = $default_max_attempts unless ($max_attempts);

if ($log) {
    unless (open(LOG, ">>$log")) {
	$log = '';
	print_msg("couldn't open file '$log' for writing\n");
    }
}

my($use_syslog) =
    ($syslog_param{'socket'}) &&
    ($syslog_param{'facility'}) &&
    ($syslog_param{'priority'}) &&
    (!$verbose);

if ($use_syslog) {
    setlogsock($syslog_param{'socket'});
    openlog($syslog_param{'ident'}, $syslog_param{'options'}, $syslog_param{'facility'});
}

my($socket, $result);

if (($mailbox) and ($domain)) {
    my(@tmp) = get_mx_records($domain);

    my(@hosts);
    $max_attempts = 1 if ($max_attempts < 1);
    my($i);
    for ($i = 0; $i < $max_attempts; $i++) {
	@hosts = (@hosts, @tmp);
    }

    while ((@hosts) and (!$result)) {
	$host = pop(@hosts);
        print_msg("connect to $host:25...");
        $socket = IO::Socket::INET->new(
    	    PeerAddr => $host, PeerPort => 25, Proto => 'tcp', Type => SOCK_STREAM);
        unless ($socket) {
    	    print_msg(" failed:".$@."...\n");
	    print_syslog("couldn't connect to $host:25", $@, "check passed");
	} else {
    	    print_msg(" success...\n");
	    $socket->autoflush(1);

	    my($answer);
	    $answer = print_socket("");

	    if ($answer !~ /^220\s/) {
		print_syslog("try to get MTA prompt", $answer, "check passed");
	    } else {
		my($hostname) = hostfqdn();
		$hostname = $domain unless ($hostname);
	        $answer = print_socket("helo $hostname\r\n");

	        if ($answer !~ /^250\s/) {
		    print_syslog("helo $hostname", $answer, "check passed");
		} else {
		    $answer = '';
		    if ($use_vrfy) {
		        $answer = print_socket("vrfy $mailbox\@$domain\r\n");
			if ($answer =~ /^550\s/) {
		    	    $result = "error: 5.1.7 Sender unknown";
			    print_syslog("vrfy $mailbox\@$domain", $answer, "sender unknown");
		    	    $check_answer = $answer if ($check_answer);
			} elsif ($answer !~ /^250\s/) {
			    $answer = '';
			}
		    }
	    	    unless ($answer) {
			$answer = print_socket("mail from:<>\r\n");
			if ($answer !~ /^250\s/) {
			    print_syslog("mail from:<>", $answer, "check passed");
			} else {
		    	    $answer = print_socket("rcpt to:<$mailbox\@$domain>\r\n");

			    if ($answer =~ /^55\d\s/) {

				$result = 0;
				foreach (@excluded) {
				    $result++ if ($answer =~ /^$_$/);
				}
				if ($result) {
				    $result = '';
				    print_syslog("rcpt to:<$mailbox\@$domain>", $answer, "excluded");
				} else {
				    $result = "error: 5.1.7 Sender unknown";
				    print_syslog("rcpt to:<$mailbox\@$domain>", $answer, "user unknown");
				    $check_answer = $answer if ($check_answer);
				}
			    } else {
				$result = 'OK';
				print_syslog("rcpt to:<$mailbox\@$domain>", $answer, "user ok");
			    }
			}
		    }
		}
	    }
	    print_socket("quit\r\n");
	}
    }
}

$result = '' if ($result eq 'OK');
if ($check_answer) {
    print($check_answer);
} else {
    if ($result) {
	print($result);
    } elsif ($verbose) {
	print_msg("Sender OK");
    }
    print("\n") if ($verbose);
}

if ($log) {
    unless (close(LOG)) {
	print("couldn't close file '$log'\n") if ($debug);
    }
}

closelog() if ($use_syslog);

######################################################################

sub get_mx_records() {
    my($domain) = @_;
    my(@hosts);

    if ($alternative_mx{$domain}) {
	@hosts = ($alternative_mx{$domain});
	if (scalar(@hosts) == 1) {
    	    print_msg("use alternative host '".$hosts[0]."' for checking address $mailbox\@$domain\n");
	} elsif (scalar(@hosts) > 1) {
    	    print_msg("use folowing alternative hosts for checking address $mailbox\@$domain:\n");
	    foreach (@hosts) {
		print_msg("$_\n");
	    }
	}
    } else {
        print_msg("connect to resolver...");
        my($res) = Net::DNS::Resolver->new();
        if (!$res) {
	    print_msg(" failed...\n");
	} else {
	    print_msg(" success...\n");
	    print_msg("check MX records for domain '$domain'...");
    	    my(@mx) = mx($res, $domain);
    	    if (!@mx) {
	        print_msg(" no MX records found\n");
	    } else {
	        print_msg(" ".scalar(@mx)." records found\n");
    	        my($record);
	        my($preference) = -1;
	        foreach $record (@mx) {
		    print_msg("MX record found: ".$record->exchange.", pri=".$record->preference."\n");
	    	    if (($preference == -1) or ($preference > $record->preference)) {
	    	        @hosts = ($record->exchange);
		        $preference = $record->preference;
		    } elsif ($preference == $record->preference) {
			push(@hosts, $record->exchange);
		    }
		}
		if (scalar(@hosts) == 1) {
    		    print_msg("primary MX record is ".$hosts[0]."\n");
		} elsif (scalar(@hosts) > 1) {
    		    print_msg("primary MX records are:\n");
		    foreach (@hosts) {
    			print_msg("$_\n");
		    }
		}
	    }
	}
    }
    return(@hosts);
}

sub print_socket() {
    my($msg) = @_;
    
    my($answer);
    if ($msg) {
	print($socket $msg);
#	$socket->send($msg) ;
	print_msg($msg);
    }

    $answer = <$socket>;
#    $socket->recv($answer, 2048);
    print_msg($answer);
    while (($answer) and ($answer !~ /^\d\d\d /)) {
	$answer = <$socket>;
#        $socket->recv($answer, 2048);
	print_msg($answer);
    }
    return($answer);
}

sub print_msg() {
    my($msg) = @_;
    print($msg) if ($verbose);
    print(LOG $msg) if ($log);
}

sub print_syslog() {
    if ($use_syslog) {
	my($SMTP_command, $SMTP_answer, $check_result) = @_;
        $SMTP_answer =~ s/[\r\n]$//g;
	my($msg) = $syslog_param{'logformat'};
	$msg =~ s/\%mailbox/$mailbox/;
	$msg =~ s/\%domain/$domain/;
	$msg =~ s/\%SMTP_host/$host/;
	$msg =~ s/\%SMTP_command/$SMTP_command/;
	$msg =~ s/\%SMTP_answer/$SMTP_answer/;
	$msg =~ s/\%check_result/$check_result/;
	syslog($syslog_param{'priority'}, $msg);
    }
}
