Replace splitaddress() by Mail::Address.
[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 26use Getopt::Std;
fd1fe450 27use Mail::Address;
0bd5c08c
TH
28use Net::DNS;
29use Net::SMTP;
30
431fbb12
TH
31################################# Main program #################################
32
33$Getopt::Std::STANDARD_HELP_VERSION = 1;
34my $myself = basename($0);
35
36# read commandline options
0bd5c08c 37my %options;
431fbb12
TH
38getopts('Vhqlrf:m:', \%options);
39
40# -V: display version
41if ($options{'V'}) {
42 print "$myself v $VERSION\nCopyright (c) 2010 Thomas Hochstein <thh\@inter.net>\n";
43 print "This program is free software; you may redistribute it and/or modify it under the same terms as Perl itself.\n";
44 exit(100);
45};
46
47# -h: feed myself to perldoc
48if ($options{'h'}) {
49 exec('perldoc', $0);
50 exit(100);
51};
52
53# display usage information if neither -f nor an address are present
54if (!$options{'f'} and !$ARGV[0]) {
55 print "Usage: $myself [-hqlr] [-m <host>] <address>|-f <file>\n";
56 print "Options: -V display copyright and version\n";
57 print " -h show documentation\n";
58 print " -q quiet (no output, just exit with 0/1/2/3)\n";
59 print " -l extended logging\n";
60 print " -r test random address to verify verification\n";
61 print " -m <host> no DNS lookup, just test this host\n";
62 print " <address> mail address to check\n\n";
63 print " -f <file> parse file (one address per line)\n";
64 exit(100);
0bd5c08c
TH
65};
66
431fbb12
TH
67# -f: open file and read addresses to @adresses
68my @addresses;
0bd5c08c
TH
69if ($options{'f'}) {
70 if (-e $options{'f'}) {
431fbb12 71 open FILE, "<$options{'f'}" or die("$myself ERROR: Could not open file $options{'f'} for reading: $!");
0bd5c08c 72 } else {
431fbb12 73 die("$myself ERROR: File $options{'f'} does not exist!\n");
0bd5c08c 74 };
0bd5c08c
TH
75 while(<FILE>) {
76 chomp;
431fbb12 77 push(@addresses,$_);
0bd5c08c
TH
78 };
79 close FILE;
431fbb12
TH
80# fill @adresses with single address to check
81 } else {
82 push(@addresses,$ARGV[0]);
83};
84
85# loop over each address and test it
86my (%targets,$curstat,$status,$log,$message);
87foreach (@addresses) {
88 my $address = $_;
fd1fe450 89 my $domain = Mail::Address->new('',$address)->host;
431fbb12
TH
90 printf(" * Testing %s ...\n",$address) if !($options{'q'});
91 $log .= "\n===== BEGIN $address =====\n";
92 # get list of target hosts or take host forced via -m
93 if (!$options{'m'}) {
94 %targets = %{gettargets($domain,\$log)};
95 } else {
96 $message = sprintf("Connection to %s forced by -m.\n",$options{'m'});
97 $log .= $message;
98 print " $message" if !($options{'q'});
99 # just one target host with preference 0
100 $targets{$options{'m'}} = 0;
101 };
102 if (%targets) {
103 $curstat = checkaddress($address,\%targets,\$log);
104 } else {
105 $curstat = 2;
106 $message = 'DNS lookup failure';
107 printf(" > Address is INVALID (%s).\n",$message) if !($options{'q'});
108 $log .= $message . '.';
109 };
110 $log .= "====== END $address ======\n";
111 $status = $curstat if (!defined($status) or $curstat > $status);
0bd5c08c
TH
112};
113
114print $log if ($options{'l'});
115
116# status 0: valid / batch processing
431fbb12
TH
117# 1: connection failed or temporary failure
118# 2: invalid
119# 3: cannot verify
120#D print "\n-> EXIT $status\n";
0bd5c08c
TH
121exit($status);
122
431fbb12
TH
123################################## gettargets ##################################
124# get mail exchanger(s) or A record(s) for a domain
125# IN : $domain: domain to query the DNS for
126# OUT: \%targets: reference to a hash containing a list of target hosts
127sub gettargets {
128 my ($domain,$logr) = @_;
129 # resolver objekt
130 my $resolver = Net::DNS::Resolver->new(udp_timeout => 15, tcp_timeout => 15);
0bd5c08c 131
431fbb12
TH
132 my %targets;
133 # get MX record(s) as a list sorted by preference
134 if (my @mxrr = mx($resolver,$domain)) {
135 print_dns_result($domain,'MX',scalar(@mxrr),undef,$logr);
136 foreach my $rr (@mxrr) {
137 $targets{$rr->exchange} = $rr->preference;
138 $$logr .= sprintf("(%d) %s\n",$rr->preference,$rr->exchange);
139 };
140 # no MX record found; log and try A record(s)
141 } else {
142 print_dns_result($domain,'MX',undef,$resolver->errorstring,$logr);
143 print(" Falling back to A record ...\n") if !($options{'q'});
144 # get A record(s)
145 if (my $query = $resolver->query($domain,'A','IN')) {
146 print_dns_result($domain,'A',$query->header->ancount,undef,$logr);
147 foreach my $rr ($query->answer) {
148 $targets{$rr->address} = 0;
149 $$logr .= sprintf("- %s\n",$rr->address);
150 };
151 # no A record found either; log and fail
152 } else {
153 print_dns_result($domain,'A',undef,$resolver->errorstring,$logr);
154 printf(" %s has neither MX nor A records - mail cannot be delivered.\n",$domain) if !($options{'q'});
155 };
0bd5c08c 156 };
431fbb12
TH
157 return \%targets;
158};
159
160################################# checkaddress #################################
161# test address for deliverability
162# IN : $address: adress to be tested
163# \%targets: reference to a hash containing a list of MX hosts
164# \$log : reference to the log (to be printed out via -l)
165# OUT: ---
166# \$log will be changed
167sub checkaddress {
168 my ($address,$targetsr,$logr) = @_;
169 my %targets = %{$targetsr};
170 my $status;
171 # walk %targets in order of preference
172 foreach my $host (sort { $targets{$a} <=> $targets{$b} } keys %targets) {
173 printf(" / Trying %s (%s) with %s\n",$host,$targets{$host} || 'A',$address) if !($options{'q'});
174 $$logr .= sprintf("%s:\n%s\n",$host,"-" x (length($host)+1));
175 $status = checksmtp($address,$host,$logr);
176 last if ($status != 1);
0bd5c08c 177 };
431fbb12 178 return $status;
0bd5c08c
TH
179};
180
431fbb12
TH
181################################### checksmtp ##################################
182# connect to a remote machine on port 25 and test deliverability of a mail
183# address by doing the SMTP dialog until RCPT TO stage
184# IN : $address: address to test
185# $target : target host
186# \$log : reference to the log (to be printed out via -l)
187# OUT: .........: reference to a hash containing a list of target hosts
188# \$log will be changed
0bd5c08c 189sub checksmtp {
431fbb12
TH
190 my ($address,$target,$logr) = @_;
191 my ($status);
192 # start SMTP connection
193 if (my $smtp = Net::SMTP->new($target,Hello => $config{'helo'},Timeout => 30)) {
194 $$logr .= $smtp->banner; # Net::SMTP doesn't seem to support multiline greetings.
195 $$logr .= "EHLO $config{'helo'}\n";
196 log_smtp_reply($logr,$smtp->code,$smtp->message);
197 $smtp->mail($config{'from'});
198 $$logr .= "MAIL FROM:<$config{'from'}>\n";
199 log_smtp_reply($logr,$smtp->code,$smtp->message);
200 # test address
201 my ($success,$code,@message) = try_rcpt_to(\$smtp,$address,$logr);
202 # connection failure?
203 if ($success < 0) {
f18dc26f 204 $status = connection_failed(@message);
431fbb12
TH
205 # delivery attempt was successful?
206 } elsif ($success) {
207 # -r: try random address (which should be guaranteed to be invalid)
208 if ($options{'r'}) {
fd1fe450 209 my ($success,$code,@message) = try_rcpt_to(\$smtp,create_rand_addr(Mail::Address->new('',$address)->host),$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
9fc0e927
TH
242############################### create_rand_addr ###############################
243# create a random mail address
244# IN : $domain: the domain part
245# OUT: $address: the address
246sub create_rand_addr {
247 my($domain)=@_;
248 my $allowed = 'ABCDEFGHJKLMNPQRSTUVWXYZabcdefghjkmnpqrstuvwxyz23456789-+_=';
249 my $address = '';
250 while (length($address) < 15) {
251 $address .= substr($allowed, (int(rand(length($allowed)))),1);
252 };
253 return ($address.'@'.$domain);
254};
255
431fbb12
TH
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
fd1fe450
TH
392Mail::Address I<(CPAN)>
393
394=item -
395
32301d53
TH
396Net::DNS I<(CPAN)>
397
398=item -
399
400Net::SMTP
401
402=back
403
404Furthermore you'll need a working DNS installation.
405
406=head1 DESCRIPTION
407
408checkmail checks the vailidity / deliverability of a mail address.
409You may submit just one address as the last argument or a file
410containing one address on each line using the B<-f> option.
411
412=head2 Configuration
413
414For the time being, all configuration is done in the script. You have
415to set the following elements of the %config hash:
416
417=over 4
418
419=item B<$config{'helo'}>
420
421The hostname to be used for I<HELO> or I<EHLO> in the SMTP dialog.
422
423=item B<$config{'from'}>
424
425The sender address to be used for I<MAIL FROM> while testing.
426
32301d53
TH
427=back
428
429=head2 Usage
430
431After configuring the script you may run your first test with
432
433 checkmail user@example.org
434
435B<checkmail> will try to determine the mail exchanger(s) (MX)
436responsible for I<example.org> by querying the DNS for the respective
437MX records and then try to connect via SMTP (on port 25) to each of
438them in order of precedence (if necessary). It will run through the
439SMTP dialog until just before the I<DATA> stage, i.e. doing I<EHLO>,
440I<MAIL FROM> and I<RCPT TO>. If no MX is defined, B<checkmail> will
441fall back to the I<example.org> host itself, provided there is at
442least one A record defined in the DNS. If there are neither MX nor A
443records for I<example.org>, mail is not deliverable and B<checkmail>
444will fail accordingly. If no host can be reached, B<checkmail> will
445fail, too. Finally B<checkmail> will fail if mail to the given
446recipient is not accepted by the respective host.
447
448If B<checkmail> fails, you'll not be able to deliver mail to that
449address - at least not using the configured sender address and from
450the host you're testing from. However, the opposite is not true: a
451mail you send may still not be delivered even if a test via
452B<checkmail> succeeds. The receiving entity may reject your mail after
453the I<DATA> stage, due to content checking or without any special
454reason, or it may even drop, filter or bounce your mail after finally
455accepting it. There is no way to be sure a mail will be accepted short
456of sending a real mail to the address in question.
457
458You may, however, try to detect hosts that will happily accept any and
459all recipient in the SMTP dialog and just reject your mail later on,
460for example to defeat exactly the kind of check you try to do.
461B<checkmail> will do that by submitting a recipient address that is
462known to be invalid; if that address is accepted, too, you'll know
463that you can't reliably check the validity of any address on that
464host. You can force that check by using the B<-r> option.
465
466If you don't want to see just the results of your test, you can get a
467B<complete log> of the SMTP dialog by using the B<-l> option. That may be
468helpful to test for temporary failure conditions.
469
470On the other hand you may use the B<-q> option to suppress all output;
471B<checkmail> will then terminate with one of the following B<exit
472status>:
473
474=over 4
475
476=item B<0>
477
478address(es) seem/seems to be valid
479
480=item B<1>
481
482temporary error (connection failure or temporary failure)
483
484=item B<2>
485
486address is invalid
487
488=item B<3>
489
490address cannot reliably be checked (test using B<-r> failed)
491
492=back
493
494You can do B<batch processing> using B<-f> and submitting a file with
495one address on each line. In that case the exit status is set to the
496highest value generated by testing all addresses, i.e. it is set to
497B<0> if and only if no adress failed, but to B<2> if even one address
498failed and to B<3> if even one addresses couldn't reliably be checked.
499
500And finally you can B<suppress DNS lookups> for MX and A records and
501just force B<checkmail> to connect to a particular host using the
502B<-m> option.
503
504B<Please note:> You shouldn't try to validate addresses while working
505from a dial-up or blacklisted host. If in doubt, use the B<-l> option
506to have a closer look on the SMTP dialog yourself.
507
508=head1 OPTIONS
509
510=over 3
511
512=item B<-V> (version)
513
514Print out version and copyright information on B<checkmail> and exit.
515
516=item B<-h> (help)
517
518Print this man page and exit.
519
520=item B<-q> (quit)
521
522Suppress output and just terminate with a specific exit status.
523
524=item B<-l> (log)
525
526Log and print out the whole SMTP dialog.
527
528=item B<-r> (random address)
529
9fc0e927
TH
530Also try a reliably invalid address to catch hosts that try undermine
531address verification.
32301d53
TH
532
533=item B<-m> I<host> (MX to use)
534
535Force a connection to I<host> to check deliverability to that
536particular host irrespective of DNS entries. For example:
537
538 checkmail -m test.host.example user@domain.example
539
540=item B<-f> I<file> (file)
541
542Process all addresses from I<file> (one on each line).
543
544=back
545
546=head1 INSTALLATION
547
548Just copy checkmail to some directory and get started.
549
550You can run your first test with
551
552 checkmail user@example.org
553
554=head1 ENVIRONMENT
555
556See documentation of I<Net::DNS::Resolver>.
557
558=head1 FILES
559
560=over 4
561
562=item F<checkmail.pl>
563
564The script itself.
565
566=back
567
568=head1 BUGS
569
570Please report any bugs or feature request to the author or use the
571bug tracker at L<http://bugs.th-h.de/>!
572
573=head1 SEE ALSO
574
575L<http://th-h.de/download/scripts.php> will have the current
576version of this program.
577
578This program is maintained using the Git version control system. You
579may clone L<git://code.th-h.de/mail/checkmail.git> to check out the
580current development tree or browse it on the web via
581L<http://code.th-h.de/?p=mail/checkmail.git>.
582
583=head1 AUTHOR
584
585Thomas Hochstein <thh@inter.net>
586
587=head1 COPYRIGHT AND LICENSE
588
589Copyright (c) 2002-2010 Thomas Hochstein <thh@inter.net>
590
591This program is free software; you may redistribute it and/or modify it
592under the same terms as Perl itself.
593
594=cut
This page took 0.040744 seconds and 4 git commands to generate.