Complete rewrite.
- use strict; - modularize code - refactor application logic - more verbose output - test MXes in order of precedence - cope with multi-line responses - slightly change meaning of exit status - batch processing: set exit status to highest generated value Fixes #9. Fixes #10. Signed-off-by: Thomas Hochstein <thh@inter.net>
This commit is contained in:
Thomas Hochstein
parent
dd6d3ea1aa
commit
431fbb1233
459
checkmail.pl
459
checkmail.pl
|
|
@ -1,224 +1,337 @@
|
||||||
#!/usr/bin/perl -w
|
#! /usr/bin/perl -W
|
||||||
#
|
#
|
||||||
# checkmail.pl
|
# checkmail Version 0.3 by Thomas Hochstein
|
||||||
##############
|
|
||||||
|
|
||||||
# (c) 2002-2005 Thomas Hochstein <thh@inter.net>
|
|
||||||
#
|
#
|
||||||
# This program is free software; you can redistribute it and/or modify it under
|
# This script tries to verify the deliverability of (a) mail address(es).
|
||||||
# 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)
|
# Copyright (c) 2002-2010 Thomas Hochstein <thh@inter.net>
|
||||||
# any later version.
|
#
|
||||||
# This program is distributed in the hope that it will be useful, but WITHOUT
|
# It can be redistributed and/or modified under the same terms under
|
||||||
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
|
# which Perl itself is published.
|
||||||
# FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
|
|
||||||
# more details.
|
|
||||||
|
|
||||||
# Versionsnummer ######################
|
our $VERSION = "0.3";
|
||||||
$ver = '0.2 beta (20050803)';
|
|
||||||
|
|
||||||
# Modules #############################
|
################################# Configuration ################################
|
||||||
|
# Please fill in a working configuration!
|
||||||
|
my %config=(
|
||||||
|
# value used for HELO/EHLO - a valid hostname you own
|
||||||
|
helo => 'testhost.domain.example',
|
||||||
|
# value used for MAIL FROM: - a valid address under your control
|
||||||
|
from => 'mailtest@testhost.domain.example',
|
||||||
|
# a syntactically valid "random" - reliably not existing - localpart
|
||||||
|
rand => 'ZOq62fow1i'
|
||||||
|
);
|
||||||
|
|
||||||
|
################################### Modules ####################################
|
||||||
|
use strict;
|
||||||
|
use File::Basename;
|
||||||
use Getopt::Std;
|
use Getopt::Std;
|
||||||
use Net::DNS;
|
use Net::DNS;
|
||||||
use Net::SMTP;
|
use Net::SMTP;
|
||||||
|
|
||||||
# Konfiguration #######################
|
################################# Main program #################################
|
||||||
# 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';
|
|
||||||
|
|
||||||
################################################################
|
$Getopt::Std::STANDARD_HELP_VERSION = 1;
|
||||||
# Hauptprogramm #######################
|
my $myself = basename($0);
|
||||||
|
|
||||||
# Konfiguration einlesen
|
# read commandline options
|
||||||
my %options;
|
my %options;
|
||||||
getopts('hqlrf:m:', \%options);
|
getopts('Vhqlrf:m:', \%options);
|
||||||
|
|
||||||
if ($options{'h'} or (!$options{'f'} and !$ARGV[0])) {
|
# -V: display version
|
||||||
print "$0 v $ver\nUsage: $0 [-hqlr] [-m <host>] -f <file>|<address>\n";
|
if ($options{'V'}) {
|
||||||
print "Options: -h display this notice\n";
|
print "$myself v $VERSION\nCopyright (c) 2010 Thomas Hochstein <thh\@inter.net>\n";
|
||||||
|
print "This program is free software; you may redistribute it and/or modify it under the same terms as Perl itself.\n";
|
||||||
|
exit(100);
|
||||||
|
};
|
||||||
|
|
||||||
|
# -h: feed myself to perldoc
|
||||||
|
if ($options{'h'}) {
|
||||||
|
exec('perldoc', $0);
|
||||||
|
exit(100);
|
||||||
|
};
|
||||||
|
|
||||||
|
# display usage information if neither -f nor an address are present
|
||||||
|
if (!$options{'f'} and !$ARGV[0]) {
|
||||||
|
print "Usage: $myself [-hqlr] [-m <host>] <address>|-f <file>\n";
|
||||||
|
print "Options: -V display copyright and version\n";
|
||||||
|
print " -h show documentation\n";
|
||||||
print " -q quiet (no output, just exit with 0/1/2/3)\n";
|
print " -q quiet (no output, just exit with 0/1/2/3)\n";
|
||||||
print " -l extended logging\n";
|
print " -l extended logging\n";
|
||||||
print " -r test random address to verify verification\n";
|
print " -r test random address to verify verification\n";
|
||||||
print " -m <host> no DNS lookup, just test this host\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";
|
print " <address> mail address to check\n\n";
|
||||||
|
print " -f <file> parse file (one address per line)\n";
|
||||||
exit(100);
|
exit(100);
|
||||||
};
|
};
|
||||||
|
|
||||||
|
# -f: open file and read addresses to @adresses
|
||||||
|
my @addresses;
|
||||||
if ($options{'f'}) {
|
if ($options{'f'}) {
|
||||||
if (-e $options{'f'}) {
|
if (-e $options{'f'}) {
|
||||||
open FILE, "<$options{'f'}" or die("ERROR: Could not open file $options{'f'} for reading: $!");
|
open FILE, "<$options{'f'}" or die("$myself ERROR: Could not open file $options{'f'} for reading: $!");
|
||||||
} else {
|
} else {
|
||||||
die("ERROR: File $options{'f'} does not exist!\n");
|
die("$myself ERROR: File $options{'f'} does not exist!\n");
|
||||||
};
|
};
|
||||||
$log = '';
|
|
||||||
while(<FILE>) {
|
while(<FILE>) {
|
||||||
chomp;
|
chomp;
|
||||||
($status,$log) = checkdns($_,$log);
|
push(@addresses,$_);
|
||||||
};
|
};
|
||||||
close FILE;
|
close FILE;
|
||||||
# force exit(0)
|
# fill @adresses with single address to check
|
||||||
$status = 0;
|
} else {
|
||||||
} else {
|
push(@addresses,$ARGV[0]);
|
||||||
($status,$log) = checkdns($ARGV[0]);
|
};
|
||||||
|
|
||||||
|
# loop over each address and test it
|
||||||
|
my (%targets,$curstat,$status,$log,$message);
|
||||||
|
foreach (@addresses) {
|
||||||
|
my $address = $_;
|
||||||
|
(undef,my $domain) = splitaddress($address);
|
||||||
|
printf(" * Testing %s ...\n",$address) if !($options{'q'});
|
||||||
|
$log .= "\n===== BEGIN $address =====\n";
|
||||||
|
# get list of target hosts or take host forced via -m
|
||||||
|
if (!$options{'m'}) {
|
||||||
|
%targets = %{gettargets($domain,\$log)};
|
||||||
|
} else {
|
||||||
|
$message = sprintf("Connection to %s forced by -m.\n",$options{'m'});
|
||||||
|
$log .= $message;
|
||||||
|
print " $message" if !($options{'q'});
|
||||||
|
# just one target host with preference 0
|
||||||
|
$targets{$options{'m'}} = 0;
|
||||||
|
};
|
||||||
|
if (%targets) {
|
||||||
|
$curstat = checkaddress($address,\%targets,\$log);
|
||||||
|
} else {
|
||||||
|
$curstat = 2;
|
||||||
|
$message = 'DNS lookup failure';
|
||||||
|
printf(" > Address is INVALID (%s).\n",$message) if !($options{'q'});
|
||||||
|
$log .= $message . '.';
|
||||||
|
};
|
||||||
|
$log .= "====== END $address ======\n";
|
||||||
|
$status = $curstat if (!defined($status) or $curstat > $status);
|
||||||
};
|
};
|
||||||
|
|
||||||
print $log if ($options{'l'});
|
print $log if ($options{'l'});
|
||||||
|
|
||||||
# status 0: valid / batch processing
|
# status 0: valid / batch processing
|
||||||
# 1: invalid
|
# 1: connection failed or temporary failure
|
||||||
# 2: cannot verify
|
# 2: invalid
|
||||||
# 3: temporary (?) failure
|
# 3: cannot verify
|
||||||
|
#D print "\n-> EXIT $status\n";
|
||||||
exit($status);
|
exit($status);
|
||||||
|
|
||||||
################################################################
|
################################## gettargets ##################################
|
||||||
# Subroutinen #########################
|
# get mail exchanger(s) or A record(s) for a domain
|
||||||
|
# IN : $domain: domain to query the DNS for
|
||||||
|
# OUT: \%targets: reference to a hash containing a list of target hosts
|
||||||
|
sub gettargets {
|
||||||
|
my ($domain,$logr) = @_;
|
||||||
|
# resolver objekt
|
||||||
|
my $resolver = Net::DNS::Resolver->new(udp_timeout => 15, tcp_timeout => 15);
|
||||||
|
|
||||||
sub checkdns {
|
my %targets;
|
||||||
# - fester Host angegeben (-m)?
|
# get MX record(s) as a list sorted by preference
|
||||||
# - sonst: MX-Record ermitteln
|
if (my @mxrr = mx($resolver,$domain)) {
|
||||||
# - bei Verbindungsproblemen naechsten MX versuchen
|
print_dns_result($domain,'MX',scalar(@mxrr),undef,$logr);
|
||||||
# - falls kein MX vorhanden, Fallback auf A
|
foreach my $rr (@mxrr) {
|
||||||
# -> jeweils Adresse testen via checksmtp()
|
$targets{$rr->exchange} = $rr->preference;
|
||||||
my ($address,$logging) = @_;
|
$$logr .= sprintf("(%d) %s\n",$rr->preference,$rr->exchange);
|
||||||
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);
|
|
||||||
};
|
};
|
||||||
|
# no MX record found; log and try A record(s)
|
||||||
# Resolver-Objekt
|
} else {
|
||||||
$resolve = Net::DNS::Resolver -> new();
|
print_dns_result($domain,'MX',undef,$resolver->errorstring,$logr);
|
||||||
$resolve->usevc(1);
|
print(" Falling back to A record ...\n") if !($options{'q'});
|
||||||
$resolve->tcp_timeout(15);
|
# get A record(s)
|
||||||
|
if (my $query = $resolver->query($domain,'A','IN')) {
|
||||||
# MX-Record feststellen
|
print_dns_result($domain,'A',$query->header->ancount,undef,$logr);
|
||||||
@mx = mx($resolve,$domain) or $dnsresult = $resolve->errorstring;
|
foreach my $rr ($query->answer) {
|
||||||
print " $domain (MX: $dnsresult)\n" if !($options{'q'});
|
$targets{$rr->address} = 0;
|
||||||
|
$$logr .= sprintf("- %s\n",$rr->address);
|
||||||
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') {
|
# no A record found either; log and fail
|
||||||
# wenn kein MX-Record: A-Record feststellen
|
} else {
|
||||||
$logging .= "MX error: $dnsresult\n";
|
print_dns_result($domain,'A',undef,$resolver->errorstring,$logr);
|
||||||
$dnsresult = 'okay';
|
printf(" %s has neither MX nor A records - mail cannot be delivered.\n",$domain) if !($options{'q'});
|
||||||
$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 \%targets;
|
||||||
return ($status,$logging);
|
|
||||||
};
|
};
|
||||||
|
|
||||||
|
################################# checkaddress #################################
|
||||||
|
# test address for deliverability
|
||||||
|
# IN : $address: adress to be tested
|
||||||
|
# \%targets: reference to a hash containing a list of MX hosts
|
||||||
|
# \$log : reference to the log (to be printed out via -l)
|
||||||
|
# OUT: ---
|
||||||
|
# \$log will be changed
|
||||||
|
sub checkaddress {
|
||||||
|
my ($address,$targetsr,$logr) = @_;
|
||||||
|
my %targets = %{$targetsr};
|
||||||
|
my $status;
|
||||||
|
# walk %targets in order of preference
|
||||||
|
foreach my $host (sort { $targets{$a} <=> $targets{$b} } keys %targets) {
|
||||||
|
printf(" / Trying %s (%s) with %s\n",$host,$targets{$host} || 'A',$address) if !($options{'q'});
|
||||||
|
$$logr .= sprintf("%s:\n%s\n",$host,"-" x (length($host)+1));
|
||||||
|
$status = checksmtp($address,$host,$logr);
|
||||||
|
last if ($status != 1);
|
||||||
|
};
|
||||||
|
return $status;
|
||||||
|
};
|
||||||
|
|
||||||
|
################################### checksmtp ##################################
|
||||||
|
# connect to a remote machine on port 25 and test deliverability of a mail
|
||||||
|
# address by doing the SMTP dialog until RCPT TO stage
|
||||||
|
# IN : $address: address to test
|
||||||
|
# $target : target host
|
||||||
|
# \$log : reference to the log (to be printed out via -l)
|
||||||
|
# OUT: .........: reference to a hash containing a list of target hosts
|
||||||
|
# \$log will be changed
|
||||||
sub checksmtp {
|
sub checksmtp {
|
||||||
# - zu $mailhost verbinden, $adresse testen (SMTP-Dialog bis RCPT TO)
|
my ($address,$target,$logr) = @_;
|
||||||
# - ggf. (-r) testen, ob sicher ungueltige Adresse abgelehnt oder
|
my ($status);
|
||||||
# alles angenommen wird
|
# start SMTP connection
|
||||||
my($mailhost,$address,$domain,$logging)=@_;
|
if (my $smtp = Net::SMTP->new($target,Hello => $config{'helo'},Timeout => 30)) {
|
||||||
my($smtp,$status,$valid);
|
$$logr .= $smtp->banner; # Net::SMTP doesn't seem to support multiline greetings.
|
||||||
$logging .= "-------------------------\n";
|
$$logr .= "EHLO $config{'helo'}\n";
|
||||||
CONNECT: if ($smtp = Net::SMTP->new($mailhost,Hello => $config{'helo'},Timeout => 30)) {
|
log_smtp_reply($logr,$smtp->code,$smtp->message);
|
||||||
$logging .= $smtp->banner;
|
|
||||||
$logging .= "EHLO $config{'helo'}\n";
|
|
||||||
$logging .= parse_reply($smtp->code,$smtp->message);
|
|
||||||
$smtp->mail($config{'from'});
|
$smtp->mail($config{'from'});
|
||||||
$logging .= "MAIL FROM:<$config{'from'}>\n";
|
$$logr .= "MAIL FROM:<$config{'from'}>\n";
|
||||||
$logging .= parse_reply($smtp->code,$smtp->message);
|
log_smtp_reply($logr,$smtp->code,$smtp->message);
|
||||||
# wird RCPT TO akzeptiert?
|
# test address
|
||||||
$valid = $smtp->to($address);
|
my ($success,$code,@message) = try_rcpt_to(\$smtp,$address,$logr);
|
||||||
$logging .= "RCPT TO:<$address>\n";
|
# connection failure?
|
||||||
if ($smtp->code > 0) {
|
if ($success < 0) {
|
||||||
# es kam eine Antwort auf RCPT TO
|
$status = connection_failed();
|
||||||
$logging .= parse_reply($smtp->code,$smtp->message);
|
# delivery attempt was successful?
|
||||||
if ($valid) {
|
} elsif ($success) {
|
||||||
# RCPT TO akzeptiert
|
# -r: try random address (which should be guaranteed to be invalid)
|
||||||
$status = 0;
|
|
||||||
if ($options{'r'}) {
|
if ($options{'r'}) {
|
||||||
# werden sicher ungueltige Adressen abgewiesen?
|
(undef,my $domain) = splitaddress($address);
|
||||||
$valid = $smtp->to($config{'rand'}.'@'.$domain);
|
my ($success,$code,@message) = try_rcpt_to(\$smtp,$config{'rand'}.'@'.$domain,$logr);
|
||||||
$logging .= 'RCPT TO:<'.$config{'rand'}.'@'.$domain.">\n";
|
# connection failure?
|
||||||
if ($smtp->code > 0) {
|
if ($success < 0) {
|
||||||
# es kam eine Antwort auf RCPT TO (fuer $rand)
|
$status = connection_failed();
|
||||||
$logging .= parse_reply($smtp->code,$smtp->message);
|
# verification impossible?
|
||||||
if ($valid) {
|
} elsif ($success) {
|
||||||
# ungueltiges RCPT TO akzeptiert
|
$status = 3;
|
||||||
print " > Sorry, cannot verify. You'll have to send a testmail ...\n" if !($options{'q'});
|
print " > Address verificaton impossible. You'll have to send a test mail ...\n" if !($options{'q'});
|
||||||
|
}
|
||||||
|
}
|
||||||
|
# if -r is not set or status was not set to 3: valid address
|
||||||
|
if (!defined($status)) {
|
||||||
|
$status = 0;
|
||||||
|
print " > Address is valid.\n" if !($options{'q'});
|
||||||
|
};
|
||||||
|
# delivery attempt failed?
|
||||||
|
} else {
|
||||||
$status = 2;
|
$status = 2;
|
||||||
};
|
print " > Address is INVALID:\n" if !($options{'q'});
|
||||||
} else {
|
print ' ' . join(' ',@message) if !($options{'q'});
|
||||||
# Timeout nach RCPT TO (fuer $rand)
|
}
|
||||||
print " > Temporary failure.\n" if !($options{'q'});
|
# terminate SMTP connection
|
||||||
$logging .= "---Timeout---\n";
|
|
||||||
$smtp->quit;
|
$smtp->quit;
|
||||||
$status = 3;
|
$$logr .= "QUIT\n";
|
||||||
};
|
log_smtp_reply($logr,$smtp->code,$smtp->message);
|
||||||
};
|
|
||||||
print " > Address is valid.\n" if (!$status and !$options{'q'});
|
|
||||||
} else {
|
} else {
|
||||||
# RCPT TO nicht akzeptiert
|
# SMTP connection failed / timeout
|
||||||
print " > Address is INVALID.\n" if !($options{'q'});
|
$status = connection_failed();
|
||||||
$status = 1;
|
$$logr .= "---Connection failure---\n";
|
||||||
};
|
};
|
||||||
# Verbindung beenden
|
return $status;
|
||||||
$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;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
|
################################# splitaddress #################################
|
||||||
|
# split mail address into local and domain part
|
||||||
|
# IN : $address: a mail address
|
||||||
|
# OUT: $local : local part
|
||||||
|
# $domain: domain part
|
||||||
|
sub splitaddress {
|
||||||
|
my($address)=@_;
|
||||||
|
(my $lp = $address) =~ s/^([^@]+)@.*/$1/;
|
||||||
|
(my $domain = $address) =~ s/[^@]+\@(\S*)$/$1/;
|
||||||
|
return ($lp,$domain);
|
||||||
|
};
|
||||||
|
|
||||||
|
################################ parse_dns_reply ###############################
|
||||||
|
# parse DNS response codes and return code and description
|
||||||
|
# IN : $response: a DNS response code
|
||||||
|
# OUT: "$response ($desciption)"
|
||||||
|
sub parse_dns_reply {
|
||||||
|
my($response)=@_;
|
||||||
|
my %dnsrespcodes = (NOERROR => 'empty response',
|
||||||
|
NXDOMAIN => 'non-existent domain',
|
||||||
|
SERVFAIL => 'DNS server failure',
|
||||||
|
REFUSED => 'DNS query refused',
|
||||||
|
FORMERR => 'format error',
|
||||||
|
NOTIMP => 'not implemented');
|
||||||
|
if(defined($dnsrespcodes{$response})) {
|
||||||
|
return sprintf('%s (%s)',$response,$dnsrespcodes{$response});
|
||||||
|
} else {
|
||||||
|
return $response;
|
||||||
|
};
|
||||||
|
};
|
||||||
|
|
||||||
|
############################### print_dns_result ###############################
|
||||||
|
# print and log result of DNS query
|
||||||
|
# IN : $domain: domain the DNS was queried for
|
||||||
|
# $type : record type (MX, A, ...)
|
||||||
|
# $count : number of records found
|
||||||
|
# $error : DNS response code
|
||||||
|
# \$log : reference to the log (to be printed out via -l)
|
||||||
|
# OUT: ---
|
||||||
|
# \$log will be changed
|
||||||
|
sub print_dns_result {
|
||||||
|
my ($domain,$type,$count,$error,$logr) = @_;
|
||||||
|
if (defined($count)) {
|
||||||
|
printf(" %d %s record(s) found for %s\n",$count,$type,$domain) if !($options{'q'});
|
||||||
|
$$logr .= sprintf("%s DNS record(s):\n",$type);
|
||||||
|
} else {
|
||||||
|
printf(" No %s records found for %s: %s\n",$type,$domain,parse_dns_reply($error)) if !($options{'q'});
|
||||||
|
$$logr .= sprintf("No %s records found: %s\n",$type,parse_dns_reply($error));
|
||||||
|
};
|
||||||
|
return;
|
||||||
|
};
|
||||||
|
|
||||||
|
################################## try_rcpt_to #################################
|
||||||
|
# send RCPT TO and return replies
|
||||||
|
# IN : \$smtp : a reference to an SMTP object
|
||||||
|
# $recipient: a mail address
|
||||||
|
# \$log : reference to the log (to be printed out via -l)
|
||||||
|
# OUT: $success: true or false
|
||||||
|
# $code : SMTP status code
|
||||||
|
# $message: SMTP status message
|
||||||
|
# \$log will be changed
|
||||||
|
sub try_rcpt_to {
|
||||||
|
my($smtpr,$recipient,$logr)=@_;
|
||||||
|
$$logr .= sprintf("RCPT TO:<%s>\n",$recipient);
|
||||||
|
my $success = $$smtpr->to($recipient);
|
||||||
|
if ($$smtpr->code) {
|
||||||
|
log_smtp_reply($logr,$$smtpr->code,$$smtpr->message);
|
||||||
|
} else {
|
||||||
|
$success = -1;
|
||||||
|
$$logr .= "---Connection failure---\n";
|
||||||
|
};
|
||||||
|
return ($success,$$smtpr->code,$$smtpr->message);
|
||||||
|
};
|
||||||
|
|
||||||
|
################################ log_smtp_reply ################################
|
||||||
|
# log result of SMTP command
|
||||||
|
# IN : \$log : reference to the log (to be printed out via -l)
|
||||||
|
# $code : SMTP status code
|
||||||
|
# @message : SMTP status message
|
||||||
|
# OUT: ---
|
||||||
|
# \$log will be changed
|
||||||
|
sub log_smtp_reply {
|
||||||
|
my($logr,$code,@message)=@_;
|
||||||
|
$$logr .= sprintf('%s %s',$code,join('- ',@message));
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
|
||||||
|
############################## connection_failed ###############################
|
||||||
|
# print failure message and return status 1
|
||||||
|
# OUT: 1
|
||||||
|
sub connection_failed {
|
||||||
|
print " > Connection failure.\n" if !($options{'q'});
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
|
||||||
Loading…
Reference in a new issue