File Coverage

blib/lib/Mail/Transport/SMTP.pm
Criterion Covered Total %
statement 15 92 16.3
branch 0 46 0.0
condition 0 14 0.0
subroutine 5 9 55.5
pod 3 4 75.0
total 23 165 13.9


line stmt bran cond sub pod time code
1             # Copyrights 2001-2020 by [Mark Overmeer].
2             # For other contributors see ChangeLog.
3             # See the manual pages for details on the licensing terms.
4             # Pod stripped from pm file by OODoc 2.02.
5             # This code is part of distribution Mail-Transport. Meta-POD processed with
6             # OODoc into POD and HTML manual-pages. See README.md
7             # Copyright Mark Overmeer. Licensed under the same terms as Perl itself.
8              
9             package Mail::Transport::SMTP;
10 1     1   1296 use vars '$VERSION';
  1         3  
  1         53  
11             $VERSION = '3.005';
12              
13 1     1   6 use base 'Mail::Transport::Send';
  1         1  
  1         104  
14              
15 1     1   47 use strict;
  1         5  
  1         31  
16 1     1   7 use warnings;
  1         2  
  1         47  
17              
18 1     1   586 use Net::SMTP;
  1         94679  
  1         1104  
19              
20              
21             sub init($)
22 0     0 0   { my ($self, $args) = @_;
23              
24 0           my $hosts = $args->{hostname};
25 0 0         unless($hosts)
26 0           { require Net::Config;
27 0           $hosts = $Net::Config::NetConfig{smtp_hosts};
28 0 0         undef $hosts unless @$hosts;
29 0           $args->{hostname} = $hosts;
30             }
31              
32 0   0       $args->{via} ||= 'smtp';
33 0   0       $args->{port} ||= '25';
34              
35 0 0         $self->SUPER::init($args) or return;
36              
37             my $helo = $args->{helo}
38             || eval { require Net::Config; $Net::Config::NetConfig{inet_domain} }
39 0   0       || eval { require Net::Domain; Net::Domain::hostfqdn() };
40              
41             $self->{MTS_net_smtp_opts} =
42             +{ Hello => $helo
43 0   0       , Debug => ($args->{smtp_debug} || 0)
44             };
45 0           $self->{MTS_esmtp_options} = $args->{esmtp_options};
46 0           $self->{MTS_from} = $args->{from};
47 0           $self;
48             }
49              
50              
51             sub trySend($@)
52 0     0 1   { my ($self, $message, %args) = @_;
53              
54             my %send_options =
55 0 0         ( %{$self->{MTS_esmtp_options} || {}}
56 0 0         , %{$args{esmtp_options} || {}}
  0            
57             );
58              
59             # From whom is this message.
60 0   0       my $from = $args{from} || $self->{MTS_from} || $message->sender || '<>';
61 0 0 0       $from = $from->address if ref $from && $from->isa('Mail::Address');
62              
63             # Which are the destinations.
64             ! defined $args{To}
65 0 0         or $self->log(WARNING =>
66             "Use option `to' to overrule the destination: `To' refers to a field");
67              
68 0           my @to = map $_->address, $self->destinations($message, $args{to});
69              
70 0 0         unless(@to)
71 0           { $self->log(NOTICE =>
72             'No addresses found to send the message to, no connection made');
73 0           return 1;
74             }
75              
76             # Prepare the header
77 0           my @headers;
78 0           require IO::Lines;
79 0           my $lines = IO::Lines->new(\@headers);
80 0           $message->head->printUndisclosed($lines);
81              
82             #
83             # Send
84             #
85              
86 0 0         if(wantarray)
87             { # In LIST context
88 0           my $server;
89 0 0         return (0, 500, "Connection Failed", "CONNECT", 0)
90             unless $server = $self->contactAnyServer;
91              
92 0 0         return (0, $server->code, $server->message, 'FROM', $server->quit)
93             unless $server->mail($from, %send_options);
94              
95 0           foreach (@to)
96 0 0         { next if $server->to($_);
97             # must we be able to disable this?
98             # next if $args{ignore_erroneous_destinations}
99 0           return (0, $server->code, $server->message,"To $_",$server->quit);
100             }
101              
102 0           my $bodydata = $message->body->file;
103              
104 0           $server->data;
105 0           $server->datasend(\@headers);
106 0 0         $server->datasend( [ ref $bodydata eq 'GLOB' ? <$bodydata> : $bodydata->getlines ] );
107 0 0         $server->dataend
108             or return (0, $server->code, $server->message,'DATA',$server->quit);
109              
110 0           my $accept = ($server->message)[-1];
111 0           chomp $accept;
112              
113 0           my $rc = $server->quit;
114 0           return ($rc, $server->code, $server->message, 'QUIT', $rc, $accept);
115             }
116              
117             # in SCALAR context
118 0           my $server;
119 0 0         return 0 unless $server = $self->contactAnyServer;
120              
121 0 0         $server->quit, return 0
122             unless $server->mail($from, %send_options);
123              
124 0           foreach (@to)
125             {
126 0 0         next if $server->to($_);
127             # must we be able to disable this?
128             # next if $args{ignore_erroneous_destinations}
129 0           $server->quit;
130 0           return 0;
131             }
132              
133 0           my $bodydata = $message->body->file;
134              
135 0           $server->data;
136 0           $server->datasend(\@headers);
137 0 0         $server->datasend( [ ref $bodydata eq 'GLOB' ? <$bodydata> : $bodydata->getlines ] );
138              
139 0 0         $server->quit, return 0
140             unless $server->dataend;
141              
142 0           $server->quit;
143             }
144              
145             #------------------------------------------
146              
147             sub contactAnyServer()
148 0     0 1   { my $self = shift;
149              
150 0           my ($enterval, $count, $timeout) = $self->retry;
151 0           my ($host, $port, $username, $password) = $self->remoteHost;
152 0 0         my @hosts = ref $host ? @$host : $host;
153              
154 0           foreach my $host (@hosts)
155             { my $server = $self->tryConnectTo
156             ( $host, Port => $port,
157 0           , %{$self->{MTS_net_smtp_opts}}, Timeout => $timeout
  0            
158             );
159              
160 0 0         defined $server or next;
161              
162 0           $self->log(PROGRESS => "Opened SMTP connection to $host.");
163              
164 0 0         if(defined $username)
165 0 0         { if($server->auth($username, $password))
166 0           { $self->log(PROGRESS => "$host: Authentication succeeded.");
167             }
168             else
169 0           { $self->log(ERROR => "Authentication failed.");
170 0           return undef;
171             }
172             }
173              
174 0           return $server;
175             }
176              
177 0           undef;
178             }
179              
180              
181             sub tryConnectTo($@)
182 0     0 1   { my ($self, $host) = (shift, shift);
183 0           Net::SMTP->new($host, @_);
184             }
185              
186             1;