#!/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;

my(@Answers) = (
'User.+not found',
'User not found',
'User unknown',
'Invalid recipient',
'unknown user',
'No such user',
'Recipient unknown',
'No such local user',
'unrouteable address',
'Recipient address rejected',
'This user does not have an account here',
'inactive user',
'E-mail address must exist',
'invalid mail account',
'User not available',
'Requested action not taken',
'mailbox unavailable',
'Account Inactive',
'Unknown local part',
'mailbox.+unavailable',
'There is no such active account'
);

my($debug, $verbose, $log, $check_answer);

GetOptions (
    'debug'		=> \$debug,
    'verbose'		=> \$verbose,
    'log=s'		=> \$log,
    'check-answer'	=> \$check_answer
);

$verbose = 1 if ($debug);

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

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

my($socket, $result, $host);

if (($mailbox) and ($domain)) {
    if ($domain =~ /^localhost$/i) {
	$host = 'localhost';
    } 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)) {
	    		$host = $record->exchange;
			$preference = $record->preference;
		    }
		}
	    }
	}
    }
    if ($host) {
        print_msg("primary MX record is $host\n");
        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");
	} else {
    	    print_msg(" success...\n");
	    $socket->autoflush(1);

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

	    if ($answer =~ /^220\s/) {
	        $answer = print_socket("helo $domain\r\n");

	        if ($answer =~ /^250\s/) {
		    $answer = print_socket("mail from:<>\r\n");

		    if ($answer =~ /^250\s/) {
		        $answer = print_socket("rcpt to:<$mailbox\@$domain>\r\n");

			my($Answer);
    		        foreach $Answer (@Answers) {
			    unless ($result) {
				$result = "error: 5.1.7 Sender unknown" if ($answer =~ /$Answer/i);
				$check_answer = $answer if ($check_answer);
			    }
			}
		    }
		}
	    }
	    print_socket("quit\r\n");
	}
    }
}
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);
    }
}

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);
}
