File Coverage

blib/lib/Mail/Transport/SMTP.pm
Criterion Covered Total %
statement 15 98 15.3
branch 0 46 0.0
condition 0 14 0.0
subroutine 5 9 55.5
pod 3 4 75.0
total 23 171 13.4


line stmt bran cond sub pod time code
1             # Copyrights 2001-2019 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   1086 use vars '$VERSION';
  1         2  
  1         42  
11             $VERSION = '3.004';
12              
13 1     1   4 use base 'Mail::Transport::Send';
  1         2  
  1         73  
14              
15 1     1   5 use strict;
  1         2  
  1         14  
16 1     1   4 use warnings;
  1         1  
  1         18  
17              
18 1     1   476 use Net::SMTP;
  1         74609  
  1         847  
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           $server->data;
103 0           $server->datasend($_) for @headers;
104 0           my $bodydata = $message->body->file;
105              
106 0 0         if(ref $bodydata eq 'GLOB') {
107 0           $server->datasend($_) while <$bodydata>;
108             }
109             else {
110 0           while(my $l = $bodydata->getline) { $server->datasend($l) }
  0            
111             }
112              
113 0 0         $server->dataend
114             or return (0, $server->code, $server->message,'DATA',$server->quit);
115              
116 0           my $accept = ($server->message)[-1];
117 0           chomp $accept;
118              
119 0           my $rc = $server->quit;
120 0           return ($rc, $server->code, $server->message, 'QUIT', $rc, $accept);
121             }
122              
123             # in SCALAR context
124 0           my $server;
125 0 0         return 0 unless $server = $self->contactAnyServer;
126              
127 0 0         $server->quit, return 0
128             unless $server->mail($from, %send_options);
129              
130 0           foreach (@to)
131             {
132 0 0         next if $server->to($_);
133             # must we be able to disable this?
134             # next if $args{ignore_erroneous_destinations}
135 0           $server->quit;
136 0           return 0;
137             }
138              
139 0           $server->data;
140 0           $server->datasend($_) for @headers;
141 0           my $bodydata = $message->body->file;
142              
143 0 0         if(ref $bodydata eq 'GLOB') { $server->datasend($_) while <$bodydata> }
  0            
144 0           else { while(my $l = $bodydata->getline) { $server->datasend($l) } }
  0            
145              
146 0 0         $server->quit, return 0
147             unless $server->dataend;
148              
149 0           $server->quit;
150             }
151              
152             #------------------------------------------
153              
154             sub contactAnyServer()
155 0     0 1   { my $self = shift;
156              
157 0           my ($enterval, $count, $timeout) = $self->retry;
158 0           my ($host, $port, $username, $password) = $self->remoteHost;
159 0 0         my @hosts = ref $host ? @$host : $host;
160              
161 0           foreach my $host (@hosts)
162             { my $server = $self->tryConnectTo
163             ( $host, Port => $port,
164 0           , %{$self->{MTS_net_smtp_opts}}, Timeout => $timeout
  0            
165             );
166              
167 0 0         defined $server or next;
168              
169 0           $self->log(PROGRESS => "Opened SMTP connection to $host.");
170              
171 0 0         if(defined $username)
172 0 0         { if($server->auth($username, $password))
173 0           { $self->log(PROGRESS => "$host: Authentication succeeded.");
174             }
175             else
176 0           { $self->log(ERROR => "Authentication failed.");
177 0           return undef;
178             }
179             }
180              
181 0           return $server;
182             }
183              
184 0           undef;
185             }
186              
187              
188             sub tryConnectTo($@)
189 0     0 1   { my ($self, $host) = (shift, shift);
190 0           Net::SMTP->new($host, @_);
191             }
192              
193             1;