195 lines
5.4 KiB
Perl
Executable file
195 lines
5.4 KiB
Perl
Executable file
#! /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;
|