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