#! /usr/bin/perl -w
#
# This script connects to a mail server and issues MAIL and RCPT
# commands.  It's a good way to check whether an address exists --
# many modern mail servers actually respond usefully to RCPT, even
# if they ignore VRFY and EXPN.  It's also convenient for testing
# whether a server allows relaying.
#
# usage: rcpt [options] email-address [mailserver]
#	 rcpt [options] -n [hostname] [mailserver]
#
#   -n
#	nonexistent: Make up an email address that probably doesn't
#	    exist at the specified hostname.  For example,
#	    "rcpt -n foobar.com" will use an address like
#	    <vsMAWCGul96-nonexistent@foobar.com>.  If you don't
#	    specify a hostname, it'll make up a local address.
#	    (If you specify an email address instead of a hostname,
#	    it's treated as if you just gave the hostname part.)
#
#   -v
#	verbose: Show the entire SMTP exchange.
#
#   -f ADDR
#	from: Specify the address you're sending mail from.
#	    By default, the script uses its best guess at your
#	    email address, constructed from your username and
#	    the local host name.
#
#   -h HOSTNAME
#	helo: Specify the hostname to send in the HELO command.
#	    By default, the script uses its best guess at the
#	    fully-qualified domain name of the local host.
#
# By default, the script connects to the first MX listed for the
# email address you're testing.  If that's not what you want, you
# can specify a mail server explicitly; you can even give a mail
# server of the form "mx:hostname", which means the first MX listed
# for "hostname".
#
# For example:
#
#   rcpt user@foobar.com
#	Connect to the first MX for foobar.com, and try the
#	address <user@foobar.com>.
#
#   rcpt user@foobar.com mail.baz.com
#	Connect to mail.baz.com, and try the address <user@foobar.com>.
#
#   rcpt user@foobar.com mx:baz.com
#	Connect to the first MX for baz.com, and try the address
#	<user@foobar.com>.
#
#   rcpt user
#	Connect to localhost, and try the address <user>.
#
#   rcpt -n foobar.com
#	Connect to the first MX for foobar.com, and try an
#	address like <vsMAWCGul96-nonexistent@foobar.com>.
#
#   rcpt -n
#	Connect to localhost, and try an address like
#	<vsMAWCGul96-nonexistent>.
#
# The script outputs the name of the server it connects to, followed
# by the response to the RCPT command.  It returns success if the
# server accepts the address.
#
# $Id: rcpt,v 1.3 2006-10-12 01:37:51-07 mconst Exp mconst $


use IO::Socket;
use Email::Address;
use Net::DNS;
use Net::SMTP;
use Sys::Hostname::Long;
use Getopt::Std;
use String::Random;

$0 =~ s|.*/||;


# Return the first MX for the specified host.
sub get_mx {
    my ($host) = @_;

    my @mx = mx($host) or die "$0: can't find MX for $host\n";
    return $mx[0]->exchange;
}


sub Net::SMTP::debug_print {
    my ($self, $dir, @text) = @_;
    return unless $self =~ /GLOB/;

    $arrows = $dir ? ">>> " : "";
    print $arrows, @text;
}


getopts "nvf:h:", \my %options;
my $verbose = $options{v};
my $nonexistent = $options{n};
my $helo_hostname = $options{h} || hostname_long;

my $from_address = $options{f};
if (!defined($from_address)) {
    my $my_username = $ENV{USER} || getpwuid $<
	|| die "$0: can't find local username\n";

    $from_address = "$my_username\@" . hostname_long;
}


my ($address, $server) = @ARGV;
@ARGV == 1 || @ARGV == 2 || (@ARGV == 0 && $nonexistent)
    or die "usage: $0 email-address [mailserver]\n";

if ($nonexistent) {
    my $nonexistent_user = String::Random::random_regex '[a-z]\w{10}'
	. "-nonexistent";

    if (!defined($address)) {
	# The user didn't give us anything.  Make up a local address.

	$address = $nonexistent_user;
    } elsif ($address =~ /\@/) {
	# The user gave us an entire email address -- we'll assume
	# they want us to replace the user part with a made-up
	# nonexistent username.

	$address = "$nonexistent_user\@$'";
    } else {
	# The user gave us a hostname.  Make up an address at that
	# host.

	$address = "$nonexistent_user\@$address";
    }
}


if (!defined($server)) {
    # The user didn't specify what mail server to connect to; try to
    # figure it out from the address.

    my @addr_objects = Email::Address->parse($address);

    if (@addr_objects) {
	# We found an address.  Look up the MX for that host.

	die "$0: we only handle one address at a time for now\n"
	    if @addr_objects > 1;
	my $addr_object = $addr_objects[0];
 
	$server = get_mx($addr_object->host);
    } else {
	# We couldn't parse the address, so assume it's local.
	# Local delivery is potentially a lot more complicated than
	# this, but let's ignore that for now.

	$server = "localhost";
    }
} elsif ($server =~ /^mx:/i) {
    # The user has explicitly requested that we look up the MX for
    # a particular host, and use that as our server.

    $server = get_mx($');
}


print "Connecting to $server...\n" if $verbose;
my $exit_code = 0;

my $smtp = Net::SMTP->new($server, Hello => $helo_hostname,
	ExactAddresses => 1, Debug => $verbose)
    or die "$0: can't connect to $server\n";

if ($smtp->mail($from_address)) {
    # The server accepted our MAIL command; go ahead and try the RCPT.

    $smtp->to($address) or $exit_code = 1;
    $output = "$server: " . $smtp->code . " " . $smtp->message;
} else {
    # The server rejected out MAIL command.  We're done here.

    $exit_code = 2;
    $output = "server rejected our From address of <$from_address>:\n"
	. "$server: " . $smtp->code . " " . $smtp->message;
}

$smtp->quit;

print $output unless $verbose;

exit $exit_code;