checkmail/checkmail.pl
Thomas Hochstein 0bd5c08c20 Initial commit.
Signed-off-by: Thomas Hochstein <thh@inter.net>
2010-01-15 09:01:52 +01:00

225 lines
7.1 KiB
Perl

#!/usr/bin/perl -w
#
# checkmail.pl
##############
# (c) 2002-2005 Thomas Hochstein <thh@inter.net>
#
# This program is free software; you can redistribute it and/or modify it under
# the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 2 of the License, or (at your option)
# any later version.
# This program is distributed in the hope that it will be useful, but WITHOUT
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
# FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
# more details.
# Versionsnummer ######################
$ver = '0.2 beta (20050803)';
# Modules #############################
use Getopt::Std;
use Net::DNS;
use Net::SMTP;
# Konfiguration #######################
# Hier passende Werte einsetzen! #
#######################################
%config=();
# HELO-/EHLO-Parameter - a valid hostname you own
$config{'helo'} = 'testhost.domain.example';
# MAIL FROM:-Parameter - a valid address you control
$config{'from'} = 'mailtest@testhost.domain.example';
# Zufaelliger Localpart fuer -r - a valid random localpart
$config{'rand'} = 'ZOq62fow1i';
################################################################
# Hauptprogramm #######################
# Konfiguration einlesen
my %options;
getopts('hqlrf:m:', \%options);
if ($options{'h'} or (!$options{'f'} and !$ARGV[0])) {
print "$0 v $ver\nUsage: $0 [-hqlr] [-m <host>] -f <file>|<address>\n";
print "Options: -h display this notice\n";
print " -q quiet (no output, just exit with 0/1/2/3)\n";
print " -l extended logging\n";
print " -r test random address to verify verification\n";
print " -m <host> no DNS lookup, just test this host\n";
print " -f <file> parse file (one address per line)\n";
print " <address> mail address to check\n\n";
exit(100);
};
if ($options{'f'}) {
if (-e $options{'f'}) {
open FILE, "<$options{'f'}" or die("ERROR: Could not open file $options{'f'} for reading: $!");
} else {
die("ERROR: File $options{'f'} does not exist!\n");
};
$log = '';
while(<FILE>) {
chomp;
($status,$log) = checkdns($_,$log);
};
close FILE;
# force exit(0)
$status = 0;
} else {
($status,$log) = checkdns($ARGV[0]);
};
print $log if ($options{'l'});
# status 0: valid / batch processing
# 1: invalid
# 2: cannot verify
# 3: temporary (?) failure
exit($status);
################################################################
# Subroutinen #########################
sub checkdns {
# - fester Host angegeben (-m)?
# - sonst: MX-Record ermitteln
# - bei Verbindungsproblemen naechsten MX versuchen
# - falls kein MX vorhanden, Fallback auf A
# -> jeweils Adresse testen via checksmtp()
my ($address,$logging) = @_;
my ($rr,$mailhost,$status,@mx);
my $dnsresult = 'okay';
# (my $lp = $address) =~ s/^([^@]+)@.*/$1/;
(my $domain = $address) =~ s/[^@]+\@(\S*)$/$1/;
$logging .= "\n----- BEGIN $address -----\n";
# DNS-Lookup unterdrueckt?
if ($options{'m'}) {
print " Connection to $options{'m'} forced by -m.\n";
$logging .= "Connection to $options{'m'} forced by -m.\n";
($status,$logging) = checksmtp($options{'m'},$address,$domain,$logging);
$logging .= "----- END $address -----\n";
return ($status,$logging);
};
# Resolver-Objekt
$resolve = Net::DNS::Resolver -> new();
$resolve->usevc(1);
$resolve->tcp_timeout(15);
# MX-Record feststellen
@mx = mx($resolve,$domain) or $dnsresult = $resolve->errorstring;
print " $domain (MX: $dnsresult)\n" if !($options{'q'});
if (@mx) {
WALKMX: foreach $rr (@mx) {
$mailhost = $rr->exchange;
print " MX: $mailhost / $address\n" if !($options{'q'});
$logging .= "Try MX: $mailhost\n";
($status,$logging) = checksmtp($mailhost,$address,$domain,$logging);
last WALKMX if ($status < 3);
};
} elsif ($dnsresult eq 'NXDOMAIN' or $dnsresult eq 'NOERROR' or $dnsresult eq 'REFUSED') {
# wenn kein MX-Record: A-Record feststellen
$logging .= "MX error: $dnsresult\n";
$dnsresult = 'okay';
$query = $resolve->search($domain) or $dnsresult = $resolve->errorstring;
print " $domain (A: $dnsresult)\n" if !($options{'q'});
if ($query) {
foreach $rr ($query->answer) {
next unless $rr->type eq "A";
$mailhost = $rr->address;
print " A: $mailhost / $address\n" if !($options{'q'});
$logging .= "Try A: $mailhost\n";
($status,$logging) = checksmtp($mailhost,$address,$domain,$logging);
};
} elsif ($dnsresult eq 'NXDOMAIN' or $dnsresult eq 'NOERROR' or $dnsresult eq 'REFUSED') {
# wenn auch kein A-Record: what a pity ...
print " > NO DNS-RECORD (MX/A) FOUND.\n" if !($options{'q'});
$logging .= "A error: $dnsresult\n";
$status = 1;
};
};
$logging .= "----- END $address -----\n";
return ($status,$logging);
};
sub checksmtp {
# - zu $mailhost verbinden, $adresse testen (SMTP-Dialog bis RCPT TO)
# - ggf. (-r) testen, ob sicher ungueltige Adresse abgelehnt oder
# alles angenommen wird
my($mailhost,$address,$domain,$logging)=@_;
my($smtp,$status,$valid);
$logging .= "-------------------------\n";
CONNECT: if ($smtp = Net::SMTP->new($mailhost,Hello => $config{'helo'},Timeout => 30)) {
$logging .= $smtp->banner;
$logging .= "EHLO $config{'helo'}\n";
$logging .= parse_reply($smtp->code,$smtp->message);
$smtp->mail($config{'from'});
$logging .= "MAIL FROM:<$config{'from'}>\n";
$logging .= parse_reply($smtp->code,$smtp->message);
# wird RCPT TO akzeptiert?
$valid = $smtp->to($address);
$logging .= "RCPT TO:<$address>\n";
if ($smtp->code > 0) {
# es kam eine Antwort auf RCPT TO
$logging .= parse_reply($smtp->code,$smtp->message);
if ($valid) {
# RCPT TO akzeptiert
$status = 0;
if ($options{'r'}) {
# werden sicher ungueltige Adressen abgewiesen?
$valid = $smtp->to($config{'rand'}.'@'.$domain);
$logging .= 'RCPT TO:<'.$config{'rand'}.'@'.$domain.">\n";
if ($smtp->code > 0) {
# es kam eine Antwort auf RCPT TO (fuer $rand)
$logging .= parse_reply($smtp->code,$smtp->message);
if ($valid) {
# ungueltiges RCPT TO akzeptiert
print " > Sorry, cannot verify. You'll have to send a testmail ...\n" if !($options{'q'});
$status = 2;
};
} else {
# Timeout nach RCPT TO (fuer $rand)
print " > Temporary failure.\n" if !($options{'q'});
$logging .= "---Timeout---\n";
$smtp->quit;
$status = 3;
};
};
print " > Address is valid.\n" if (!$status and !$options{'q'});
} else {
# RCPT TO nicht akzeptiert
print " > Address is INVALID.\n" if !($options{'q'});
$status = 1;
};
# Verbindung beenden
$smtp->quit;
$logging .= "QUIT\n";
$logging .= parse_reply($smtp->code,$smtp->message);
} else {
# Timeout nach RCPT TO
print " > Temporary failure.\n" if !($options{'q'});
$logging .= "---Timeout---\n";
$smtp->quit;
$status = 3;
};
} else {
# Verbindung fehlgeschlagen
print " > Temporary failure.\n" if !($options{'q'});
$logging .= "---Timeout---\n";
$status = 3;
};
return ($status,$logging);
};
sub parse_reply {
my($code,$message)=@_;
my($reply);
$reply = $code . ' ' . $message;
return $reply;
}