Initial commit.
[mail/checkmail.git] / checkmail.pl
CommitLineData
0bd5c08c
TH
1#!/usr/bin/perl -w
2#
3# checkmail.pl
4##############
5
6# (c) 2002-2005 Thomas Hochstein <thh@inter.net>
7#
8# This program is free software; you can redistribute it and/or modify it under
9# the terms of the GNU General Public License as published by the Free
10# Software Foundation; either version 2 of the License, or (at your option)
11# any later version.
12# This program is distributed in the hope that it will be useful, but WITHOUT
13# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
14# FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
15# more details.
16
17# Versionsnummer ######################
18$ver = '0.2 beta (20050803)';
19
20# Modules #############################
21use Getopt::Std;
22use Net::DNS;
23use Net::SMTP;
24
25# Konfiguration #######################
26# Hier passende Werte einsetzen! #
27#######################################
28%config=();
29# HELO-/EHLO-Parameter - a valid hostname you own
30$config{'helo'} = 'testhost.domain.example';
31# MAIL FROM:-Parameter - a valid address you control
32$config{'from'} = 'mailtest@testhost.domain.example';
33# Zufaelliger Localpart fuer -r - a valid random localpart
34$config{'rand'} = 'ZOq62fow1i';
35
36################################################################
37# Hauptprogramm #######################
38
39# Konfiguration einlesen
40my %options;
41getopts('hqlrf:m:', \%options);
42
43if ($options{'h'} or (!$options{'f'} and !$ARGV[0])) {
44 print "$0 v $ver\nUsage: $0 [-hqlr] [-m <host>] -f <file>|<address>\n";
45 print "Options: -h display this notice\n";
46 print " -q quiet (no output, just exit with 0/1/2/3)\n";
47 print " -l extended logging\n";
48 print " -r test random address to verify verification\n";
49 print " -m <host> no DNS lookup, just test this host\n";
50 print " -f <file> parse file (one address per line)\n";
51 print " <address> mail address to check\n\n";
52 exit(100);
53};
54
55if ($options{'f'}) {
56 if (-e $options{'f'}) {
57 open FILE, "<$options{'f'}" or die("ERROR: Could not open file $options{'f'} for reading: $!");
58 } else {
59 die("ERROR: File $options{'f'} does not exist!\n");
60 };
61 $log = '';
62 while(<FILE>) {
63 chomp;
64 ($status,$log) = checkdns($_,$log);
65 };
66 close FILE;
67 # force exit(0)
68 $status = 0;
69} else {
70 ($status,$log) = checkdns($ARGV[0]);
71};
72
73print $log if ($options{'l'});
74
75# status 0: valid / batch processing
76# 1: invalid
77# 2: cannot verify
78# 3: temporary (?) failure
79exit($status);
80
81################################################################
82# Subroutinen #########################
83
84sub checkdns {
85 # - fester Host angegeben (-m)?
86 # - sonst: MX-Record ermitteln
87 # - bei Verbindungsproblemen naechsten MX versuchen
88 # - falls kein MX vorhanden, Fallback auf A
89 # -> jeweils Adresse testen via checksmtp()
90 my ($address,$logging) = @_;
91 my ($rr,$mailhost,$status,@mx);
92 my $dnsresult = 'okay';
93 # (my $lp = $address) =~ s/^([^@]+)@.*/$1/;
94 (my $domain = $address) =~ s/[^@]+\@(\S*)$/$1/;
95
96 $logging .= "\n----- BEGIN $address -----\n";
97
98 # DNS-Lookup unterdrueckt?
99 if ($options{'m'}) {
100 print " Connection to $options{'m'} forced by -m.\n";
101 $logging .= "Connection to $options{'m'} forced by -m.\n";
102 ($status,$logging) = checksmtp($options{'m'},$address,$domain,$logging);
103 $logging .= "----- END $address -----\n";
104 return ($status,$logging);
105 };
106
107 # Resolver-Objekt
108 $resolve = Net::DNS::Resolver -> new();
109 $resolve->usevc(1);
110 $resolve->tcp_timeout(15);
111
112 # MX-Record feststellen
113 @mx = mx($resolve,$domain) or $dnsresult = $resolve->errorstring;
114 print " $domain (MX: $dnsresult)\n" if !($options{'q'});
115
116 if (@mx) {
117 WALKMX: foreach $rr (@mx) {
118 $mailhost = $rr->exchange;
119 print " MX: $mailhost / $address\n" if !($options{'q'});
120 $logging .= "Try MX: $mailhost\n";
121 ($status,$logging) = checksmtp($mailhost,$address,$domain,$logging);
122 last WALKMX if ($status < 3);
123 };
124 } elsif ($dnsresult eq 'NXDOMAIN' or $dnsresult eq 'NOERROR' or $dnsresult eq 'REFUSED') {
125 # wenn kein MX-Record: A-Record feststellen
126 $logging .= "MX error: $dnsresult\n";
127 $dnsresult = 'okay';
128 $query = $resolve->search($domain) or $dnsresult = $resolve->errorstring;
129 print " $domain (A: $dnsresult)\n" if !($options{'q'});
130 if ($query) {
131 foreach $rr ($query->answer) {
132 next unless $rr->type eq "A";
133 $mailhost = $rr->address;
134 print " A: $mailhost / $address\n" if !($options{'q'});
135 $logging .= "Try A: $mailhost\n";
136 ($status,$logging) = checksmtp($mailhost,$address,$domain,$logging);
137 };
138 } elsif ($dnsresult eq 'NXDOMAIN' or $dnsresult eq 'NOERROR' or $dnsresult eq 'REFUSED') {
139 # wenn auch kein A-Record: what a pity ...
140 print " > NO DNS-RECORD (MX/A) FOUND.\n" if !($options{'q'});
141 $logging .= "A error: $dnsresult\n";
142 $status = 1;
143 };
144 };
145 $logging .= "----- END $address -----\n";
146 return ($status,$logging);
147};
148
149sub checksmtp {
150 # - zu $mailhost verbinden, $adresse testen (SMTP-Dialog bis RCPT TO)
151 # - ggf. (-r) testen, ob sicher ungueltige Adresse abgelehnt oder
152 # alles angenommen wird
153 my($mailhost,$address,$domain,$logging)=@_;
154 my($smtp,$status,$valid);
155 $logging .= "-------------------------\n";
156 CONNECT: if ($smtp = Net::SMTP->new($mailhost,Hello => $config{'helo'},Timeout => 30)) {
157 $logging .= $smtp->banner;
158 $logging .= "EHLO $config{'helo'}\n";
159 $logging .= parse_reply($smtp->code,$smtp->message);
160 $smtp->mail($config{'from'});
161 $logging .= "MAIL FROM:<$config{'from'}>\n";
162 $logging .= parse_reply($smtp->code,$smtp->message);
163 # wird RCPT TO akzeptiert?
164 $valid = $smtp->to($address);
165 $logging .= "RCPT TO:<$address>\n";
166 if ($smtp->code > 0) {
167 # es kam eine Antwort auf RCPT TO
168 $logging .= parse_reply($smtp->code,$smtp->message);
169 if ($valid) {
170 # RCPT TO akzeptiert
171 $status = 0;
172 if ($options{'r'}) {
173 # werden sicher ungueltige Adressen abgewiesen?
174 $valid = $smtp->to($config{'rand'}.'@'.$domain);
175 $logging .= 'RCPT TO:<'.$config{'rand'}.'@'.$domain.">\n";
176 if ($smtp->code > 0) {
177 # es kam eine Antwort auf RCPT TO (fuer $rand)
178 $logging .= parse_reply($smtp->code,$smtp->message);
179 if ($valid) {
180 # ungueltiges RCPT TO akzeptiert
181 print " > Sorry, cannot verify. You'll have to send a testmail ...\n" if !($options{'q'});
182 $status = 2;
183 };
184 } else {
185 # Timeout nach RCPT TO (fuer $rand)
186 print " > Temporary failure.\n" if !($options{'q'});
187 $logging .= "---Timeout---\n";
188 $smtp->quit;
189 $status = 3;
190 };
191 };
192 print " > Address is valid.\n" if (!$status and !$options{'q'});
193 } else {
194 # RCPT TO nicht akzeptiert
195 print " > Address is INVALID.\n" if !($options{'q'});
196 $status = 1;
197 };
198 # Verbindung beenden
199 $smtp->quit;
200 $logging .= "QUIT\n";
201 $logging .= parse_reply($smtp->code,$smtp->message);
202 } else {
203 # Timeout nach RCPT TO
204 print " > Temporary failure.\n" if !($options{'q'});
205 $logging .= "---Timeout---\n";
206 $smtp->quit;
207 $status = 3;
208 };
209 } else {
210 # Verbindung fehlgeschlagen
211 print " > Temporary failure.\n" if !($options{'q'});
212 $logging .= "---Timeout---\n";
213 $status = 3;
214 };
215 return ($status,$logging);
216};
217
218sub parse_reply {
219 my($code,$message)=@_;
220 my($reply);
221 $reply = $code . ' ' . $message;
222 return $reply;
223}
224
This page took 0.019638 seconds and 4 git commands to generate.