Initial commit.
[mail/checkmail.git] / checkmail.pl
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
This page took 0.015103 seconds and 3 git commands to generate.