Commit | Line | Data |
---|---|---|
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 ############################# | |
21 | use Getopt::Std; | |
22 | use Net::DNS; | |
23 | use 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 | |
40 | my %options; | |
41 | getopts('hqlrf:m:', \%options); | |
42 | ||
43 | if ($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 | ||
55 | if ($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 | ||
73 | print $log if ($options{'l'}); | |
74 | ||
75 | # status 0: valid / batch processing | |
76 | # 1: invalid | |
77 | # 2: cannot verify | |
78 | # 3: temporary (?) failure | |
79 | exit($status); | |
80 | ||
81 | ################################################################ | |
82 | # Subroutinen ######################### | |
83 | ||
84 | sub 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 | ||
149 | sub 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 | ||
218 | sub parse_reply { | |
219 | my($code,$message)=@_; | |
220 | my($reply); | |
221 | $reply = $code . ' ' . $message; | |
222 | return $reply; | |
223 | } | |
224 |