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