1#!/usr/bin/perl 2# 3# $Id: SMTP.pm 816 2009-10-07 08:02:41Z calle $ 4# 5# Copyright (c) 2007 .SE (The Internet Infrastructure Foundation). 6# All rights reserved. 7# 8# Redistribution and use in source and binary forms, with or without 9# modification, are permitted provided that the following conditions 10# are met: 11# 1. Redistributions of source code must retain the above copyright 12# notice, this list of conditions and the following disclaimer. 13# 2. Redistributions in binary form must reproduce the above copyright 14# notice, this list of conditions and the following disclaimer in the 15# documentation and/or other materials provided with the distribution. 16# 17# THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR 18# IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 19# WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 20# ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY 21# DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 22# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE 23# GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS 24# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER 25# IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR 26# OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN 27# IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 28# 29###################################################################### 30 31package DNSCheck::Test::SMTP; 32 33require 5.008; 34use warnings; 35use strict; 36 37our $SVN_VERSION = '$Revision: 816 $'; 38 39use base 'DNSCheck::Test::Common'; 40 41use Net::SMTP 2.29; 42 43use IO::Socket::INET; 44use IO::Socket::INET6; 45 46BEGIN { 47 48 # Vile hack to make Net::SMTP work with IPv6. 49 # Hopefully, at some point in the future Perl itself will be upgraded to 50 # handle IPv6 and we can take this abomination out. 51 $::{'IO::'}{'Socket::'}{'INET::'} = $::{'IO::'}{'Socket::'}{'INET6::'}; 52} 53 54###################################################################### 55 56sub test { 57 my $self = shift; 58 my $hostname = shift; 59 my $address = shift; 60 my $email = shift; 61 62 my $parent = $self->parent; 63 my $logger = $parent->logger; 64 my $errors = 0; 65 my $message; 66 67 return unless $parent->config->should_run; 68 69 unless ($parent->config->get("net")->{smtp}) { 70 $logger->auto('SMTP:SKIPPED'); 71 return 0; 72 } 73 74 $logger->module_stack_push(); 75 $logger->auto("SMTP:BEGIN", $hostname, $address, $email); 76 77 my $smtp = Net::SMTP->new( 78 Host => $address, 79 Hello => $parent->config->get("hostname"), 80 Timeout => $parent->config->get("smtp")->{timeout}, 81 ); 82 83 unless ($smtp) { 84 $logger->auto("SMTP:CONNECT_FAILED", $hostname, $address); 85 $errors++; 86 goto DONE; 87 } 88 89 my @extensions = split(/\n/, $smtp->message); 90 shift @extensions; # Toss server name 91 92 $message = $smtp->banner; 93 chomp $message; 94 $logger->auto("SMTP:BANNER", $message, join(',', @extensions)); 95 96 if ($smtp->status == 0) { 97 $logger->auto("SMTP:TIMEOUT"); 98 goto RESET; 99 } 100 101 unless ($smtp->status == 2) { 102 $logger->auto("SMTP:HELLO_FAILED"); 103 $errors++; 104 goto DONE; 105 } 106 107 $logger->auto("SMTP:MAIL_FROM", "<>"); 108 $smtp->mail("<>"); 109 $message = $smtp->message; 110 chomp $message; 111 $logger->auto("SMTP:RAW", $message); 112 113 if ($smtp->status == 0) { 114 $logger->auto("SMTP:TIMEOUT"); 115 goto RESET; 116 } 117 118 unless ($smtp->status == 2) { 119 $logger->auto("SMTP:MAIL_FROM_REJECTED", "<>"); 120 $errors++; 121 goto RESET; 122 } 123 124 $logger->auto("SMTP:RCPT_TO", $email); 125 $smtp->recipient($email); 126 $message = $smtp->message; 127 chomp $message; 128 $logger->auto("SMTP:RAW", $message); 129 130 if ($smtp->status == 0) { 131 $logger->auto("SMTP:TIMEOUT"); 132 goto RESET; 133 } 134 135 # accept 2xx (ok) and 4xx (temporary failure, possible greylisting) 136 unless ($smtp->status == 2 || $smtp->status == 4) { 137 $logger->auto("SMTP:RECIPIENT_REJECTED", $email); 138 $errors++; 139 } 140 141 RESET: 142 $logger->auto("SMTP:RSET"); 143 $smtp->reset; 144 $message = $smtp->message; 145 chomp $message; 146 $logger->auto("SMTP:RAW", $message); 147 148 $logger->auto("SMTP:QUIT"); 149 $smtp->quit; 150 $message = $smtp->message; 151 chomp $message; 152 $logger->auto("SMTP:RAW", $message); 153 154 unless ($errors) { 155 $logger->auto("SMTP:OK", $hostname, $address, $email); 156 } 157 158 DONE: 159 $logger->auto("SMTP:END", $hostname, $address, $email); 160 $logger->module_stack_pop(); 161 162 return $errors; 163} 164 1651; 166 167__END__ 168 169 170=head1 NAME 171 172DNSCheck::Test::SMTP - Test SMTP delivery 173 174=head1 DESCRIPTION 175 176Test if an email address is deliverable using SMTP. 177 178=head1 METHODS 179 180=over 181 182=item ->new($parent) 183 184Inherited from L<DNSCheck::Test::Common> 185 186=item ->test($mailhost, $address, $emailaddress); 187 188=head1 EXAMPLES 189 190=head1 SEE ALSO 191 192L<DNSCheck>, L<DNSCheck::Logger>, L<Net::SMTP> 193 194=cut 195