-r: Create a really random localpart.
[mail/checkmail.git] / checkmail.pl
CommitLineData
431fbb12 1#! /usr/bin/perl -W
0bd5c08c 2#
431fbb12
TH
3# checkmail Version 0.3 by Thomas Hochstein
4#
5# This script tries to verify the deliverability of (a) mail address(es).
6#
7# Copyright (c) 2002-2010 Thomas Hochstein <thh@inter.net>
0bd5c08c 8#
431fbb12
TH
9# It can be redistributed and/or modified under the same terms under
10# which Perl itself is published.
11
12our $VERSION = "0.3";
13
14################################# Configuration ################################
15# Please fill in a working configuration!
16my %config=(
17 # value used for HELO/EHLO - a valid hostname you own
18 helo => 'testhost.domain.example',
19 # value used for MAIL FROM: - a valid address under your control
9fc0e927 20 from => 'mailtest@testhost.domain.example'
431fbb12
TH
21 );
22
23################################### Modules ####################################
24use strict;
25use File::Basename;
0bd5c08c
TH
26use Getopt::Std;
27use Net::DNS;
28use Net::SMTP;
29
431fbb12
TH
30################################# Main program #################################
31
32$Getopt::Std::STANDARD_HELP_VERSION = 1;
33my $myself = basename($0);
34
35# read commandline options
0bd5c08c 36my %options;
431fbb12
TH
37getopts('Vhqlrf:m:', \%options);
38
39# -V: display version
40if ($options{'V'}) {
41 print "$myself v $VERSION\nCopyright (c) 2010 Thomas Hochstein <thh\@inter.net>\n";
42 print "This program is free software; you may redistribute it and/or modify it under the same terms as Perl itself.\n";
43 exit(100);
44};
45
46# -h: feed myself to perldoc
47if ($options{'h'}) {
48 exec('perldoc', $0);
49 exit(100);
50};
51
52# display usage information if neither -f nor an address are present
53if (!$options{'f'} and !$ARGV[0]) {
54 print "Usage: $myself [-hqlr] [-m <host>] <address>|-f <file>\n";
55 print "Options: -V display copyright and version\n";
56 print " -h show documentation\n";
57 print " -q quiet (no output, just exit with 0/1/2/3)\n";
58 print " -l extended logging\n";
59 print " -r test random address to verify verification\n";
60 print " -m <host> no DNS lookup, just test this host\n";
61 print " <address> mail address to check\n\n";
62 print " -f <file> parse file (one address per line)\n";
63 exit(100);
0bd5c08c
TH
64};
65
431fbb12
TH
66# -f: open file and read addresses to @adresses
67my @addresses;
0bd5c08c
TH
68if ($options{'f'}) {
69 if (-e $options{'f'}) {
431fbb12 70 open FILE, "<$options{'f'}" or die("$myself ERROR: Could not open file $options{'f'} for reading: $!");
0bd5c08c 71 } else {
431fbb12 72 die("$myself ERROR: File $options{'f'} does not exist!\n");
0bd5c08c 73 };
0bd5c08c
TH
74 while(<FILE>) {
75 chomp;
431fbb12 76 push(@addresses,$_);
0bd5c08c
TH
77 };
78 close FILE;
431fbb12
TH
79# fill @adresses with single address to check
80 } else {
81 push(@addresses,$ARGV[0]);
82};
83
84# loop over each address and test it
85my (%targets,$curstat,$status,$log,$message);
86foreach (@addresses) {
87 my $address = $_;
88 (undef,my $domain) = splitaddress($address);
89 printf(" * Testing %s ...\n",$address) if !($options{'q'});
90 $log .= "\n===== BEGIN $address =====\n";
91 # get list of target hosts or take host forced via -m
92 if (!$options{'m'}) {
93 %targets = %{gettargets($domain,\$log)};
94 } else {
95 $message = sprintf("Connection to %s forced by -m.\n",$options{'m'});
96 $log .= $message;
97 print " $message" if !($options{'q'});
98 # just one target host with preference 0
99 $targets{$options{'m'}} = 0;
100 };
101 if (%targets) {
102 $curstat = checkaddress($address,\%targets,\$log);
103 } else {
104 $curstat = 2;
105 $message = 'DNS lookup failure';
106 printf(" > Address is INVALID (%s).\n",$message) if !($options{'q'});
107 $log .= $message . '.';
108 };
109 $log .= "====== END $address ======\n";
110 $status = $curstat if (!defined($status) or $curstat > $status);
0bd5c08c
TH
111};
112
113print $log if ($options{'l'});
114
115# status 0: valid / batch processing
431fbb12
TH
116# 1: connection failed or temporary failure
117# 2: invalid
118# 3: cannot verify
119#D print "\n-> EXIT $status\n";
0bd5c08c
TH
120exit($status);
121
431fbb12
TH
122################################## gettargets ##################################
123# get mail exchanger(s) or A record(s) for a domain
124# IN : $domain: domain to query the DNS for
125# OUT: \%targets: reference to a hash containing a list of target hosts
126sub gettargets {
127 my ($domain,$logr) = @_;
128 # resolver objekt
129 my $resolver = Net::DNS::Resolver->new(udp_timeout => 15, tcp_timeout => 15);
0bd5c08c 130
431fbb12
TH
131 my %targets;
132 # get MX record(s) as a list sorted by preference
133 if (my @mxrr = mx($resolver,$domain)) {
134 print_dns_result($domain,'MX',scalar(@mxrr),undef,$logr);
135 foreach my $rr (@mxrr) {
136 $targets{$rr->exchange} = $rr->preference;
137 $$logr .= sprintf("(%d) %s\n",$rr->preference,$rr->exchange);
138 };
139 # no MX record found; log and try A record(s)
140 } else {
141 print_dns_result($domain,'MX',undef,$resolver->errorstring,$logr);
142 print(" Falling back to A record ...\n") if !($options{'q'});
143 # get A record(s)
144 if (my $query = $resolver->query($domain,'A','IN')) {
145 print_dns_result($domain,'A',$query->header->ancount,undef,$logr);
146 foreach my $rr ($query->answer) {
147 $targets{$rr->address} = 0;
148 $$logr .= sprintf("- %s\n",$rr->address);
149 };
150 # no A record found either; log and fail
151 } else {
152 print_dns_result($domain,'A',undef,$resolver->errorstring,$logr);
153 printf(" %s has neither MX nor A records - mail cannot be delivered.\n",$domain) if !($options{'q'});
154 };
0bd5c08c 155 };
431fbb12
TH
156 return \%targets;
157};
158
159################################# checkaddress #################################
160# test address for deliverability
161# IN : $address: adress to be tested
162# \%targets: reference to a hash containing a list of MX hosts
163# \$log : reference to the log (to be printed out via -l)
164# OUT: ---
165# \$log will be changed
166sub checkaddress {
167 my ($address,$targetsr,$logr) = @_;
168 my %targets = %{$targetsr};
169 my $status;
170 # walk %targets in order of preference
171 foreach my $host (sort { $targets{$a} <=> $targets{$b} } keys %targets) {
172 printf(" / Trying %s (%s) with %s\n",$host,$targets{$host} || 'A',$address) if !($options{'q'});
173 $$logr .= sprintf("%s:\n%s\n",$host,"-" x (length($host)+1));
174 $status = checksmtp($address,$host,$logr);
175 last if ($status != 1);
0bd5c08c 176 };
431fbb12 177 return $status;
0bd5c08c
TH
178};
179
431fbb12
TH
180################################### checksmtp ##################################
181# connect to a remote machine on port 25 and test deliverability of a mail
182# address by doing the SMTP dialog until RCPT TO stage
183# IN : $address: address to test
184# $target : target host
185# \$log : reference to the log (to be printed out via -l)
186# OUT: .........: reference to a hash containing a list of target hosts
187# \$log will be changed
0bd5c08c 188sub checksmtp {
431fbb12
TH
189 my ($address,$target,$logr) = @_;
190 my ($status);
191 # start SMTP connection
192 if (my $smtp = Net::SMTP->new($target,Hello => $config{'helo'},Timeout => 30)) {
193 $$logr .= $smtp->banner; # Net::SMTP doesn't seem to support multiline greetings.
194 $$logr .= "EHLO $config{'helo'}\n";
195 log_smtp_reply($logr,$smtp->code,$smtp->message);
196 $smtp->mail($config{'from'});
197 $$logr .= "MAIL FROM:<$config{'from'}>\n";
198 log_smtp_reply($logr,$smtp->code,$smtp->message);
199 # test address
200 my ($success,$code,@message) = try_rcpt_to(\$smtp,$address,$logr);
201 # connection failure?
202 if ($success < 0) {
f18dc26f 203 $status = connection_failed(@message);
431fbb12
TH
204 # delivery attempt was successful?
205 } elsif ($success) {
206 # -r: try random address (which should be guaranteed to be invalid)
207 if ($options{'r'}) {
208 (undef,my $domain) = splitaddress($address);
9fc0e927 209 my ($success,$code,@message) = try_rcpt_to(\$smtp,create_rand_addr($domain),$logr);
431fbb12
TH
210 # connection failure?
211 if ($success < 0) {
f18dc26f 212 $status = connection_failed(@message);
431fbb12
TH
213 # verification impossible?
214 } elsif ($success) {
215 $status = 3;
216 print " > Address verificaton impossible. You'll have to send a test mail ...\n" if !($options{'q'});
217 }
218 }
219 # if -r is not set or status was not set to 3: valid address
220 if (!defined($status)) {
221 $status = 0;
222 print " > Address is valid.\n" if !($options{'q'});
0bd5c08c 223 };
431fbb12
TH
224 # delivery attempt failed?
225 } else {
226 $status = 2;
227 print " > Address is INVALID:\n" if !($options{'q'});
228 print ' ' . join(' ',@message) if !($options{'q'});
229 }
230 # terminate SMTP connection
231 $smtp->quit;
232 $$logr .= "QUIT\n";
233 log_smtp_reply($logr,$smtp->code,$smtp->message);
0bd5c08c 234 } else {
431fbb12
TH
235 # SMTP connection failed / timeout
236 $status = connection_failed();
237 $$logr .= "---Connection failure---\n";
0bd5c08c 238 };
431fbb12
TH
239 return $status;
240}
241
242################################# splitaddress #################################
243# split mail address into local and domain part
244# IN : $address: a mail address
245# OUT: $local : local part
246# $domain: domain part
247sub splitaddress {
248 my($address)=@_;
249 (my $lp = $address) =~ s/^([^@]+)@.*/$1/;
250 (my $domain = $address) =~ s/[^@]+\@(\S*)$/$1/;
251 return ($lp,$domain);
252};
253
9fc0e927
TH
254############################### create_rand_addr ###############################
255# create a random mail address
256# IN : $domain: the domain part
257# OUT: $address: the address
258sub create_rand_addr {
259 my($domain)=@_;
260 my $allowed = 'ABCDEFGHJKLMNPQRSTUVWXYZabcdefghjkmnpqrstuvwxyz23456789-+_=';
261 my $address = '';
262 while (length($address) < 15) {
263 $address .= substr($allowed, (int(rand(length($allowed)))),1);
264 };
265 return ($address.'@'.$domain);
266};
267
431fbb12
TH
268################################ parse_dns_reply ###############################
269# parse DNS response codes and return code and description
270# IN : $response: a DNS response code
271# OUT: "$response ($desciption)"
272sub parse_dns_reply {
273 my($response)=@_;
274 my %dnsrespcodes = (NOERROR => 'empty response',
275 NXDOMAIN => 'non-existent domain',
276 SERVFAIL => 'DNS server failure',
277 REFUSED => 'DNS query refused',
278 FORMERR => 'format error',
279 NOTIMP => 'not implemented');
280 if(defined($dnsrespcodes{$response})) {
281 return sprintf('%s (%s)',$response,$dnsrespcodes{$response});
282 } else {
283 return $response;
284 };
285};
286
287############################### print_dns_result ###############################
288# print and log result of DNS query
289# IN : $domain: domain the DNS was queried for
290# $type : record type (MX, A, ...)
291# $count : number of records found
292# $error : DNS response code
293# \$log : reference to the log (to be printed out via -l)
294# OUT: ---
295# \$log will be changed
296sub print_dns_result {
297 my ($domain,$type,$count,$error,$logr) = @_;
298 if (defined($count)) {
299 printf(" %d %s record(s) found for %s\n",$count,$type,$domain) if !($options{'q'});
300 $$logr .= sprintf("%s DNS record(s):\n",$type);
301 } else {
302 printf(" No %s records found for %s: %s\n",$type,$domain,parse_dns_reply($error)) if !($options{'q'});
303 $$logr .= sprintf("No %s records found: %s\n",$type,parse_dns_reply($error));
304 };
305 return;
0bd5c08c
TH
306};
307
431fbb12
TH
308################################## try_rcpt_to #################################
309# send RCPT TO and return replies
310# IN : \$smtp : a reference to an SMTP object
311# $recipient: a mail address
312# \$log : reference to the log (to be printed out via -l)
f18dc26f 313# OUT: $success: exit code (0 for false, 1 for true, -1 for tempfail)
431fbb12
TH
314# $code : SMTP status code
315# $message: SMTP status message
316# \$log will be changed
317sub try_rcpt_to {
318 my($smtpr,$recipient,$logr)=@_;
319 $$logr .= sprintf("RCPT TO:<%s>\n",$recipient);
f18dc26f
TH
320 my $success;
321 $$smtpr->to($recipient);
431fbb12
TH
322 if ($$smtpr->code) {
323 log_smtp_reply($logr,$$smtpr->code,$$smtpr->message);
f18dc26f 324 $success = analyze_smtp_reply($$smtpr->code,$$smtpr->message);
431fbb12
TH
325 } else {
326 $success = -1;
327 $$logr .= "---Connection failure---\n";
328 };
329 return ($success,$$smtpr->code,$$smtpr->message);
330};
331
332################################ log_smtp_reply ################################
333# log result of SMTP command
334# IN : \$log : reference to the log (to be printed out via -l)
335# $code : SMTP status code
336# @message : SMTP status message
337# OUT: ---
338# \$log will be changed
339sub log_smtp_reply {
340 my($logr,$code,@message)=@_;
341 $$logr .= sprintf('%s %s',$code,join('- ',@message));
342 return;
0bd5c08c
TH
343}
344
f18dc26f
TH
345############################### analyze_smtp_reply ##############################
346# analyze SMTP response codes and messages
347# IN : $code : SMTP status code
348# @message : SMTP status message
349# OUT: exit code (0 for false, 1 for true, -1 for tempfail)
350sub analyze_smtp_reply {
351 my($code,@message)=@_;
352 my $type = substr($code, 0, 1);
353 if ($type == 2) {
354 return 1;
355 } elsif ($type == 5) {
356 return 0;
357 } elsif ($type == 4) {
358 return -1;
359 };
360 return -1;
361}
362
431fbb12
TH
363############################## connection_failed ###############################
364# print failure message and return status 1
f18dc26f 365# IN : @message : SMTP status message
431fbb12
TH
366# OUT: 1
367sub connection_failed {
f18dc26f
TH
368 my(@message)=@_;
369 print " ! Connection failed or other temporary failure.\n" if !($options{'q'});
370 printf(" %s\n",join(' ',@message)) if @message;
431fbb12
TH
371 return 1;
372}
32301d53
TH
373
374__END__
375
376################################ Documentation #################################
377
378=head1 NAME
379
380checkmail - check deliverability of a mail address
381
382=head1 SYNOPSIS
383
384B<checkmail> [B<-Vhqlr>] [B<-m> I<host>] I<address>|B<-f> I<file>
385
386=head1 REQUIREMENTS
387
388=over 2
389
390=item -
391
392Perl 5.8 or later
393
394=item -
395
396File::Basename
397
398=item -
399
400Getopt::Std
401
402=item -
403
404Net::DNS I<(CPAN)>
405
406=item -
407
408Net::SMTP
409
410=back
411
412Furthermore you'll need a working DNS installation.
413
414=head1 DESCRIPTION
415
416checkmail checks the vailidity / deliverability of a mail address.
417You may submit just one address as the last argument or a file
418containing one address on each line using the B<-f> option.
419
420=head2 Configuration
421
422For the time being, all configuration is done in the script. You have
423to set the following elements of the %config hash:
424
425=over 4
426
427=item B<$config{'helo'}>
428
429The hostname to be used for I<HELO> or I<EHLO> in the SMTP dialog.
430
431=item B<$config{'from'}>
432
433The sender address to be used for I<MAIL FROM> while testing.
434
32301d53
TH
435=back
436
437=head2 Usage
438
439After configuring the script you may run your first test with
440
441 checkmail user@example.org
442
443B<checkmail> will try to determine the mail exchanger(s) (MX)
444responsible for I<example.org> by querying the DNS for the respective
445MX records and then try to connect via SMTP (on port 25) to each of
446them in order of precedence (if necessary). It will run through the
447SMTP dialog until just before the I<DATA> stage, i.e. doing I<EHLO>,
448I<MAIL FROM> and I<RCPT TO>. If no MX is defined, B<checkmail> will
449fall back to the I<example.org> host itself, provided there is at
450least one A record defined in the DNS. If there are neither MX nor A
451records for I<example.org>, mail is not deliverable and B<checkmail>
452will fail accordingly. If no host can be reached, B<checkmail> will
453fail, too. Finally B<checkmail> will fail if mail to the given
454recipient is not accepted by the respective host.
455
456If B<checkmail> fails, you'll not be able to deliver mail to that
457address - at least not using the configured sender address and from
458the host you're testing from. However, the opposite is not true: a
459mail you send may still not be delivered even if a test via
460B<checkmail> succeeds. The receiving entity may reject your mail after
461the I<DATA> stage, due to content checking or without any special
462reason, or it may even drop, filter or bounce your mail after finally
463accepting it. There is no way to be sure a mail will be accepted short
464of sending a real mail to the address in question.
465
466You may, however, try to detect hosts that will happily accept any and
467all recipient in the SMTP dialog and just reject your mail later on,
468for example to defeat exactly the kind of check you try to do.
469B<checkmail> will do that by submitting a recipient address that is
470known to be invalid; if that address is accepted, too, you'll know
471that you can't reliably check the validity of any address on that
472host. You can force that check by using the B<-r> option.
473
474If you don't want to see just the results of your test, you can get a
475B<complete log> of the SMTP dialog by using the B<-l> option. That may be
476helpful to test for temporary failure conditions.
477
478On the other hand you may use the B<-q> option to suppress all output;
479B<checkmail> will then terminate with one of the following B<exit
480status>:
481
482=over 4
483
484=item B<0>
485
486address(es) seem/seems to be valid
487
488=item B<1>
489
490temporary error (connection failure or temporary failure)
491
492=item B<2>
493
494address is invalid
495
496=item B<3>
497
498address cannot reliably be checked (test using B<-r> failed)
499
500=back
501
502You can do B<batch processing> using B<-f> and submitting a file with
503one address on each line. In that case the exit status is set to the
504highest value generated by testing all addresses, i.e. it is set to
505B<0> if and only if no adress failed, but to B<2> if even one address
506failed and to B<3> if even one addresses couldn't reliably be checked.
507
508And finally you can B<suppress DNS lookups> for MX and A records and
509just force B<checkmail> to connect to a particular host using the
510B<-m> option.
511
512B<Please note:> You shouldn't try to validate addresses while working
513from a dial-up or blacklisted host. If in doubt, use the B<-l> option
514to have a closer look on the SMTP dialog yourself.
515
516=head1 OPTIONS
517
518=over 3
519
520=item B<-V> (version)
521
522Print out version and copyright information on B<checkmail> and exit.
523
524=item B<-h> (help)
525
526Print this man page and exit.
527
528=item B<-q> (quit)
529
530Suppress output and just terminate with a specific exit status.
531
532=item B<-l> (log)
533
534Log and print out the whole SMTP dialog.
535
536=item B<-r> (random address)
537
9fc0e927
TH
538Also try a reliably invalid address to catch hosts that try undermine
539address verification.
32301d53
TH
540
541=item B<-m> I<host> (MX to use)
542
543Force a connection to I<host> to check deliverability to that
544particular host irrespective of DNS entries. For example:
545
546 checkmail -m test.host.example user@domain.example
547
548=item B<-f> I<file> (file)
549
550Process all addresses from I<file> (one on each line).
551
552=back
553
554=head1 INSTALLATION
555
556Just copy checkmail to some directory and get started.
557
558You can run your first test with
559
560 checkmail user@example.org
561
562=head1 ENVIRONMENT
563
564See documentation of I<Net::DNS::Resolver>.
565
566=head1 FILES
567
568=over 4
569
570=item F<checkmail.pl>
571
572The script itself.
573
574=back
575
576=head1 BUGS
577
578Please report any bugs or feature request to the author or use the
579bug tracker at L<http://bugs.th-h.de/>!
580
581=head1 SEE ALSO
582
583L<http://th-h.de/download/scripts.php> will have the current
584version of this program.
585
586This program is maintained using the Git version control system. You
587may clone L<git://code.th-h.de/mail/checkmail.git> to check out the
588current development tree or browse it on the web via
589L<http://code.th-h.de/?p=mail/checkmail.git>.
590
591=head1 AUTHOR
592
593Thomas Hochstein <thh@inter.net>
594
595=head1 COPYRIGHT AND LICENSE
596
597Copyright (c) 2002-2010 Thomas Hochstein <thh@inter.net>
598
599This program is free software; you may redistribute it and/or modify it
600under the same terms as Perl itself.
601
602=cut
This page took 0.040666 seconds and 4 git commands to generate.