Filename | /usr/local/lib/perl5/5.24/Net/SMTP.pm |
Statements | Executed 39 statements in 12.6ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 7.23ms | 9.40ms | BEGIN@20 | Net::SMTP::
1 | 1 | 1 | 2.31ms | 6.92ms | BEGIN@21 | Net::SMTP::
1 | 1 | 1 | 60µs | 60µs | BEGIN@13 | Net::SMTP::
1 | 1 | 1 | 54µs | 5.57ms | BEGIN@22 | Net::SMTP::
1 | 1 | 1 | 37µs | 112µs | BEGIN@41 | Net::SMTP::
1 | 1 | 1 | 35µs | 35µs | BEGIN@494 | Net::SMTP::
1 | 1 | 1 | 33µs | 12.8ms | BEGIN@19 | Net::SMTP::
1 | 1 | 1 | 31µs | 113µs | BEGIN@30 | Net::SMTP::
1 | 1 | 1 | 27µs | 221µs | BEGIN@18 | Net::SMTP::
1 | 1 | 1 | 20µs | 54µs | BEGIN@46 | Net::SMTP::
1 | 1 | 1 | 20µs | 30µs | BEGIN@15 | Net::SMTP::
1 | 1 | 1 | 19µs | 43µs | BEGIN@16 | Net::SMTP::
0 | 0 | 0 | 0s | 0s | DESTROY | Net::SMTP::
0 | 0 | 0 | 0s | 0s | _AUTH | Net::SMTP::
0 | 0 | 0 | 0s | 0s | _BDAT | Net::SMTP::
0 | 0 | 0 | 0s | 0s | _DATA | Net::SMTP::
0 | 0 | 0 | 0s | 0s | _EHLO | Net::SMTP::
0 | 0 | 0 | 0s | 0s | _ETRN | Net::SMTP::
0 | 0 | 0 | 0s | 0s | _EXPN | Net::SMTP::
0 | 0 | 0 | 0s | 0s | _HELO | Net::SMTP::
0 | 0 | 0 | 0s | 0s | _HELP | Net::SMTP::
0 | 0 | 0 | 0s | 0s | _MAIL | Net::SMTP::
0 | 0 | 0 | 0s | 0s | _NOOP | Net::SMTP::
0 | 0 | 0 | 0s | 0s | _QUIT | Net::SMTP::
0 | 0 | 0 | 0s | 0s | _RCPT | Net::SMTP::
0 | 0 | 0 | 0s | 0s | _RSET | Net::SMTP::
0 | 0 | 0 | 0s | 0s | _SAML | Net::SMTP::
0 | 0 | 0 | 0s | 0s | _SEND | Net::SMTP::
0 | 0 | 0 | 0s | 0s | _SOML | Net::SMTP::
0 | 0 | 0 | 0s | 0s | start_SSL | Net::SMTP::_SSL::
0 | 0 | 0 | 0s | 0s | starttls | Net::SMTP::_SSL::
0 | 0 | 0 | 0s | 0s | _STARTTLS | Net::SMTP::
0 | 0 | 0 | 0s | 0s | _TURN | Net::SMTP::
0 | 0 | 0 | 0s | 0s | _VRFY | Net::SMTP::
0 | 0 | 0 | 0s | 0s | _addr | Net::SMTP::
0 | 0 | 0 | 0s | 0s | auth | Net::SMTP::
0 | 0 | 0 | 0s | 0s | banner | Net::SMTP::
0 | 0 | 0 | 0s | 0s | bdat | Net::SMTP::
0 | 0 | 0 | 0s | 0s | bdatlast | Net::SMTP::
0 | 0 | 0 | 0s | 0s | can_inet6 | Net::SMTP::
0 | 0 | 0 | 0s | 0s | can_ssl | Net::SMTP::
0 | 0 | 0 | 0s | 0s | data | Net::SMTP::
0 | 0 | 0 | 0s | 0s | datafh | Net::SMTP::
0 | 0 | 0 | 0s | 0s | domain | Net::SMTP::
0 | 0 | 0 | 0s | 0s | etrn | Net::SMTP::
0 | 0 | 0 | 0s | 0s | expand | Net::SMTP::
0 | 0 | 0 | 0s | 0s | hello | Net::SMTP::
0 | 0 | 0 | 0s | 0s | help | Net::SMTP::
0 | 0 | 0 | 0s | 0s | host | Net::SMTP::
0 | 0 | 0 | 0s | 0s | |
0 | 0 | 0 | 0s | 0s | new | Net::SMTP::
0 | 0 | 0 | 0s | 0s | quit | Net::SMTP::
0 | 0 | 0 | 0s | 0s | recipient | Net::SMTP::
0 | 0 | 0 | 0s | 0s | reset | Net::SMTP::
0 | 0 | 0 | 0s | 0s | send | Net::SMTP::
0 | 0 | 0 | 0s | 0s | send_and_mail | Net::SMTP::
0 | 0 | 0 | 0s | 0s | send_or_mail | Net::SMTP::
0 | 0 | 0 | 0s | 0s | starttls | Net::SMTP::
0 | 0 | 0 | 0s | 0s | supports | Net::SMTP::
0 | 0 | 0 | 0s | 0s | verify | Net::SMTP::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | # Net::SMTP.pm | ||||
2 | # | ||||
3 | # Versions up to 2.31_1 Copyright (c) 1995-2004 Graham Barr <gbarr@pobox.com>. | ||||
4 | # All rights reserved. | ||||
5 | # Changes in Version 2.31_2 onwards Copyright (C) 2013-2015 Steve Hay. All | ||||
6 | # rights reserved. | ||||
7 | # This module is free software; you can redistribute it and/or modify it under | ||||
8 | # the same terms as Perl itself, i.e. under the terms of either the GNU General | ||||
9 | # Public License or the Artistic License, as specified in the F<LICENCE> file. | ||||
10 | |||||
11 | package Net::SMTP; | ||||
12 | |||||
13 | 2 | 108µs | 1 | 60µs | # spent 60µs within Net::SMTP::BEGIN@13 which was called:
# once (60µs+0s) by Mail::SpamAssassin::Plugin::SpamCop::BEGIN@53 at line 13 # spent 60µs making 1 call to Net::SMTP::BEGIN@13 |
14 | |||||
15 | 2 | 60µs | 2 | 41µs | # spent 30µs (20+11) within Net::SMTP::BEGIN@15 which was called:
# once (20µs+11µs) by Mail::SpamAssassin::Plugin::SpamCop::BEGIN@53 at line 15 # spent 30µs making 1 call to Net::SMTP::BEGIN@15
# spent 11µs making 1 call to strict::import |
16 | 2 | 54µs | 2 | 66µs | # spent 43µs (19+24) within Net::SMTP::BEGIN@16 which was called:
# once (19µs+24µs) by Mail::SpamAssassin::Plugin::SpamCop::BEGIN@53 at line 16 # spent 43µs making 1 call to Net::SMTP::BEGIN@16
# spent 24µs making 1 call to warnings::import |
17 | |||||
18 | 2 | 59µs | 2 | 415µs | # spent 221µs (27+194) within Net::SMTP::BEGIN@18 which was called:
# once (27µs+194µs) by Mail::SpamAssassin::Plugin::SpamCop::BEGIN@53 at line 18 # spent 221µs making 1 call to Net::SMTP::BEGIN@18
# spent 194µs making 1 call to Exporter::import |
19 | 2 | 150µs | 2 | 25.5ms | # spent 12.8ms (33µs+12.7) within Net::SMTP::BEGIN@19 which was called:
# once (33µs+12.7ms) by Mail::SpamAssassin::Plugin::SpamCop::BEGIN@53 at line 19 # spent 12.8ms making 1 call to Net::SMTP::BEGIN@19
# spent 12.7ms making 1 call to IO::Socket::import |
20 | 2 | 527µs | 2 | 9.60ms | # spent 9.40ms (7.23+2.16) within Net::SMTP::BEGIN@20 which was called:
# once (7.23ms+2.16ms) by Mail::SpamAssassin::Plugin::SpamCop::BEGIN@53 at line 20 # spent 9.40ms making 1 call to Net::SMTP::BEGIN@20
# spent 206µs making 1 call to Exporter::import |
21 | 2 | 513µs | 2 | 7.68ms | # spent 6.92ms (2.31+4.61) within Net::SMTP::BEGIN@21 which was called:
# once (2.31ms+4.61ms) by Mail::SpamAssassin::Plugin::SpamCop::BEGIN@53 at line 21 # spent 6.92ms making 1 call to Net::SMTP::BEGIN@21
# spent 758µs making 1 call to Exporter::import |
22 | 2 | 182µs | 2 | 11.1ms | # spent 5.57ms (54µs+5.52) within Net::SMTP::BEGIN@22 which was called:
# once (54µs+5.52ms) by Mail::SpamAssassin::Plugin::SpamCop::BEGIN@53 at line 22 # spent 5.57ms making 1 call to Net::SMTP::BEGIN@22
# spent 5.52ms making 1 call to Exporter::import |
23 | |||||
24 | 1 | 3µs | our $VERSION = "3.08_01"; | ||
25 | |||||
26 | # Code for detecting if we can use SSL | ||||
27 | 1 | 6µs | my $ssl_class = eval { | ||
28 | 1 | 336µs | require IO::Socket::SSL; | ||
29 | # first version with default CA on most platforms | ||||
30 | 2 | 242µs | 2 | 196µs | # spent 113µs (31+82) within Net::SMTP::BEGIN@30 which was called:
# once (31µs+82µs) by Mail::SpamAssassin::Plugin::SpamCop::BEGIN@53 at line 30 # spent 113µs making 1 call to Net::SMTP::BEGIN@30
# spent 82µs making 1 call to warnings::unimport |
31 | 1 | 66µs | 1 | 27µs | IO::Socket::SSL->VERSION(2.007); # spent 27µs making 1 call to version::_VERSION |
32 | } && 'IO::Socket::SSL'; | ||||
33 | |||||
34 | 1 | 3µs | my $nossl_warn = !$ssl_class && | ||
35 | 'To use SSL please install IO::Socket::SSL with version>=2.007'; | ||||
36 | |||||
37 | # Code for detecting if we can use IPv6 | ||||
38 | 1 | 3µs | my $family_key = 'Domain'; | ||
39 | my $inet6_class = eval { | ||||
40 | 1 | 4µs | require IO::Socket::IP; | ||
41 | 2 | 186µs | 2 | 187µs | # spent 112µs (37+75) within Net::SMTP::BEGIN@41 which was called:
# once (37µs+75µs) by Mail::SpamAssassin::Plugin::SpamCop::BEGIN@53 at line 41 # spent 112µs making 1 call to Net::SMTP::BEGIN@41
# spent 75µs making 1 call to warnings::unimport |
42 | 1 | 32µs | 1 | 12µs | IO::Socket::IP->VERSION(0.20) || die; # spent 12µs making 1 call to version::_VERSION |
43 | 1 | 3µs | $family_key = 'Family'; | ||
44 | 1 | 4µs | } && 'IO::Socket::IP' || eval { | ||
45 | require IO::Socket::INET6; | ||||
46 | 2 | 7.87ms | 2 | 89µs | # spent 54µs (20+34) within Net::SMTP::BEGIN@46 which was called:
# once (20µs+34µs) by Mail::SpamAssassin::Plugin::SpamCop::BEGIN@53 at line 46 # spent 54µs making 1 call to Net::SMTP::BEGIN@46
# spent 34µs making 1 call to warnings::unimport |
47 | IO::Socket::INET6->VERSION(2.62); | ||||
48 | } && 'IO::Socket::INET6'; | ||||
49 | |||||
50 | sub can_ssl { $ssl_class }; | ||||
51 | sub can_inet6 { $inet6_class }; | ||||
52 | |||||
53 | 1 | 53µs | our @ISA = ('Net::Cmd', $inet6_class || 'IO::Socket::INET'); | ||
54 | |||||
55 | sub new { | ||||
56 | my $self = shift; | ||||
57 | my $type = ref($self) || $self; | ||||
58 | my ($host, %arg); | ||||
59 | if (@_ % 2) { | ||||
60 | $host = shift; | ||||
61 | %arg = @_; | ||||
62 | } | ||||
63 | else { | ||||
64 | %arg = @_; | ||||
65 | $host = delete $arg{Host}; | ||||
66 | } | ||||
67 | |||||
68 | if ($arg{SSL}) { | ||||
69 | # SSL from start | ||||
70 | die $nossl_warn if !$ssl_class; | ||||
71 | $arg{Port} ||= 465; | ||||
72 | } | ||||
73 | |||||
74 | my $hosts = defined $host ? $host : $NetConfig{smtp_hosts}; | ||||
75 | my $obj; | ||||
76 | |||||
77 | $arg{Timeout} = 120 if ! defined $arg{Timeout}; | ||||
78 | |||||
79 | foreach my $h (@{ref($hosts) ? $hosts : [$hosts]}) { | ||||
80 | $obj = $type->SUPER::new( | ||||
81 | PeerAddr => ($host = $h), | ||||
82 | PeerPort => $arg{Port} || 'smtp(25)', | ||||
83 | LocalAddr => $arg{LocalAddr}, | ||||
84 | LocalPort => $arg{LocalPort}, | ||||
85 | $family_key => $arg{Domain} || $arg{Family}, | ||||
86 | Proto => 'tcp', | ||||
87 | Timeout => $arg{Timeout} | ||||
88 | ) | ||||
89 | and last; | ||||
90 | } | ||||
91 | |||||
92 | return | ||||
93 | unless defined $obj; | ||||
94 | |||||
95 | ${*$obj}{'net_smtp_arg'} = \%arg; | ||||
96 | ${*$obj}{'net_smtp_host'} = $host; | ||||
97 | |||||
98 | if ($arg{SSL}) { | ||||
99 | Net::SMTP::_SSL->start_SSL($obj,%arg) | ||||
100 | or return; | ||||
101 | } | ||||
102 | |||||
103 | $obj->autoflush(1); | ||||
104 | |||||
105 | $obj->debug(exists $arg{Debug} ? $arg{Debug} : undef); | ||||
106 | |||||
107 | unless ($obj->response() == CMD_OK) { | ||||
108 | my $err = ref($obj) . ": " . $obj->code . " " . $obj->message; | ||||
109 | $obj->close(); | ||||
110 | $@ = $err; | ||||
111 | return; | ||||
112 | } | ||||
113 | |||||
114 | ${*$obj}{'net_smtp_exact_addr'} = $arg{ExactAddresses}; | ||||
115 | |||||
116 | (${*$obj}{'net_smtp_banner'}) = $obj->message; | ||||
117 | (${*$obj}{'net_smtp_domain'}) = $obj->message =~ /\A\s*(\S+)/; | ||||
118 | |||||
119 | if (!exists $arg{SendHello} || $arg{SendHello}) { | ||||
120 | unless ($obj->hello($arg{Hello} || "")) { | ||||
121 | my $err = ref($obj) . ": " . $obj->code . " " . $obj->message; | ||||
122 | $obj->close(); | ||||
123 | $@ = $err; | ||||
124 | return; | ||||
125 | } | ||||
126 | } | ||||
127 | |||||
128 | $obj; | ||||
129 | } | ||||
130 | |||||
131 | |||||
132 | sub host { | ||||
133 | my $me = shift; | ||||
134 | ${*$me}{'net_smtp_host'}; | ||||
135 | } | ||||
136 | |||||
137 | ## | ||||
138 | ## User interface methods | ||||
139 | ## | ||||
140 | |||||
141 | |||||
142 | sub banner { | ||||
143 | my $me = shift; | ||||
144 | |||||
145 | return ${*$me}{'net_smtp_banner'} || undef; | ||||
146 | } | ||||
147 | |||||
148 | |||||
149 | sub domain { | ||||
150 | my $me = shift; | ||||
151 | |||||
152 | return ${*$me}{'net_smtp_domain'} || undef; | ||||
153 | } | ||||
154 | |||||
155 | |||||
156 | sub etrn { | ||||
157 | my $self = shift; | ||||
158 | defined($self->supports('ETRN', 500, ["Command unknown: 'ETRN'"])) | ||||
159 | && $self->_ETRN(@_); | ||||
160 | } | ||||
161 | |||||
162 | |||||
163 | sub auth { | ||||
164 | my ($self, $username, $password) = @_; | ||||
165 | |||||
166 | eval { | ||||
167 | require MIME::Base64; | ||||
168 | require Authen::SASL; | ||||
169 | } or $self->set_status(500, ["Need MIME::Base64 and Authen::SASL todo auth"]), return 0; | ||||
170 | |||||
171 | my $mechanisms = $self->supports('AUTH', 500, ["Command unknown: 'AUTH'"]); | ||||
172 | return unless defined $mechanisms; | ||||
173 | |||||
174 | my $sasl; | ||||
175 | |||||
176 | if (ref($username) and UNIVERSAL::isa($username, 'Authen::SASL')) { | ||||
177 | $sasl = $username; | ||||
178 | my $requested_mechanisms = $sasl->mechanism(); | ||||
179 | if (! defined($requested_mechanisms) || $requested_mechanisms eq '') { | ||||
180 | $sasl->mechanism($mechanisms); | ||||
181 | } | ||||
182 | } | ||||
183 | else { | ||||
184 | die "auth(username, password)" if not length $username; | ||||
185 | $sasl = Authen::SASL->new( | ||||
186 | mechanism => $mechanisms, | ||||
187 | callback => { | ||||
188 | user => $username, | ||||
189 | pass => $password, | ||||
190 | authname => $username, | ||||
191 | }, | ||||
192 | debug => $self->debug | ||||
193 | ); | ||||
194 | } | ||||
195 | |||||
196 | my $client; | ||||
197 | my $str; | ||||
198 | do { | ||||
199 | if ($client) { | ||||
200 | # $client mechanism failed, so we need to exclude this mechanism from list | ||||
201 | my $failed_mechanism = $client->mechanism; | ||||
202 | return unless defined $failed_mechanism; | ||||
203 | $self->debug_text("Auth mechanism failed: $failed_mechanism") | ||||
204 | if $self->debug; | ||||
205 | $mechanisms =~ s/\b\Q$failed_mechanism\E\b//; | ||||
206 | return unless $mechanisms =~ /\S/; | ||||
207 | $sasl->mechanism($mechanisms); | ||||
208 | } | ||||
209 | |||||
210 | # We should probably allow the user to pass the host, but I don't | ||||
211 | # currently know and SASL mechanisms that are used by smtp that need it | ||||
212 | |||||
213 | $client = $sasl->client_new('smtp', ${*$self}{'net_smtp_host'}, 0); | ||||
214 | $str = $client->client_start; | ||||
215 | } while (!defined $str); | ||||
216 | |||||
217 | # We don't support sasl mechanisms that encrypt the socket traffic. | ||||
218 | # todo that we would really need to change the ISA hierarchy | ||||
219 | # so we don't inherit from IO::Socket, but instead hold it in an attribute | ||||
220 | |||||
221 | my @cmd = ("AUTH", $client->mechanism); | ||||
222 | my $code; | ||||
223 | |||||
224 | push @cmd, MIME::Base64::encode_base64($str, '') | ||||
225 | if defined $str and length $str; | ||||
226 | |||||
227 | while (($code = $self->command(@cmd)->response()) == CMD_MORE) { | ||||
228 | @cmd = ( | ||||
229 | MIME::Base64::encode_base64( | ||||
230 | $client->client_step(MIME::Base64::decode_base64(($self->message)[0])), '' | ||||
231 | ) | ||||
232 | ); | ||||
233 | } | ||||
234 | |||||
235 | $code == CMD_OK; | ||||
236 | } | ||||
237 | |||||
238 | |||||
239 | sub hello { | ||||
240 | my $me = shift; | ||||
241 | my $domain = shift || "localhost.localdomain"; | ||||
242 | my $ok = $me->_EHLO($domain); | ||||
243 | my @msg = $me->message; | ||||
244 | |||||
245 | if ($ok) { | ||||
246 | my $h = ${*$me}{'net_smtp_esmtp'} = {}; | ||||
247 | foreach my $ln (@msg) { | ||||
248 | $h->{uc $1} = $2 | ||||
249 | if $ln =~ /([-\w]+)\b[= \t]*([^\n]*)/; | ||||
250 | } | ||||
251 | } | ||||
252 | elsif ($me->status == CMD_ERROR) { | ||||
253 | @msg = $me->message | ||||
254 | if $ok = $me->_HELO($domain); | ||||
255 | } | ||||
256 | |||||
257 | return unless $ok; | ||||
258 | ${*$me}{net_smtp_hello_domain} = $domain; | ||||
259 | |||||
260 | $msg[0] =~ /\A\s*(\S+)/; | ||||
261 | return ($1 || " "); | ||||
262 | } | ||||
263 | |||||
264 | sub starttls { | ||||
265 | my $self = shift; | ||||
266 | $ssl_class or die $nossl_warn; | ||||
267 | $self->_STARTTLS or return; | ||||
268 | Net::SMTP::_SSL->start_SSL($self, | ||||
269 | %{ ${*$self}{'net_smtp_arg'} }, # (ssl) args given in new | ||||
270 | @_ # more (ssl) args | ||||
271 | ) or return; | ||||
272 | |||||
273 | # another hello after starttls to read new ESMTP capabilities | ||||
274 | return $self->hello(${*$self}{net_smtp_hello_domain}); | ||||
275 | } | ||||
276 | |||||
277 | |||||
278 | sub supports { | ||||
279 | my $self = shift; | ||||
280 | my $cmd = uc shift; | ||||
281 | return ${*$self}{'net_smtp_esmtp'}->{$cmd} | ||||
282 | if exists ${*$self}{'net_smtp_esmtp'}->{$cmd}; | ||||
283 | $self->set_status(@_) | ||||
284 | if @_; | ||||
285 | return; | ||||
286 | } | ||||
287 | |||||
288 | |||||
289 | sub _addr { | ||||
290 | my $self = shift; | ||||
291 | my $addr = shift; | ||||
292 | $addr = "" unless defined $addr; | ||||
293 | |||||
294 | if (${*$self}{'net_smtp_exact_addr'}) { | ||||
295 | return $1 if $addr =~ /^\s*(<.*>)\s*$/s; | ||||
296 | } | ||||
297 | else { | ||||
298 | return $1 if $addr =~ /(<[^>]*>)/; | ||||
299 | $addr =~ s/^\s+|\s+$//sg; | ||||
300 | } | ||||
301 | |||||
302 | "<$addr>"; | ||||
303 | } | ||||
304 | |||||
305 | |||||
306 | sub mail { | ||||
307 | my $me = shift; | ||||
308 | my $addr = _addr($me, shift); | ||||
309 | my $opts = ""; | ||||
310 | |||||
311 | if (@_) { | ||||
312 | my %opt = @_; | ||||
313 | my ($k, $v); | ||||
314 | |||||
315 | if (exists ${*$me}{'net_smtp_esmtp'}) { | ||||
316 | my $esmtp = ${*$me}{'net_smtp_esmtp'}; | ||||
317 | |||||
318 | if (defined($v = delete $opt{Size})) { | ||||
319 | if (exists $esmtp->{SIZE}) { | ||||
320 | $opts .= sprintf " SIZE=%d", $v + 0; | ||||
321 | } | ||||
322 | else { | ||||
323 | carp 'Net::SMTP::mail: SIZE option not supported by host'; | ||||
324 | } | ||||
325 | } | ||||
326 | |||||
327 | if (defined($v = delete $opt{Return})) { | ||||
328 | if (exists $esmtp->{DSN}) { | ||||
329 | $opts .= " RET=" . ((uc($v) eq "FULL") ? "FULL" : "HDRS"); | ||||
330 | } | ||||
331 | else { | ||||
332 | carp 'Net::SMTP::mail: DSN option not supported by host'; | ||||
333 | } | ||||
334 | } | ||||
335 | |||||
336 | if (defined($v = delete $opt{Bits})) { | ||||
337 | if ($v eq "8") { | ||||
338 | if (exists $esmtp->{'8BITMIME'}) { | ||||
339 | $opts .= " BODY=8BITMIME"; | ||||
340 | } | ||||
341 | else { | ||||
342 | carp 'Net::SMTP::mail: 8BITMIME option not supported by host'; | ||||
343 | } | ||||
344 | } | ||||
345 | elsif ($v eq "binary") { | ||||
346 | if (exists $esmtp->{'BINARYMIME'} && exists $esmtp->{'CHUNKING'}) { | ||||
347 | $opts .= " BODY=BINARYMIME"; | ||||
348 | ${*$me}{'net_smtp_chunking'} = 1; | ||||
349 | } | ||||
350 | else { | ||||
351 | carp 'Net::SMTP::mail: BINARYMIME option not supported by host'; | ||||
352 | } | ||||
353 | } | ||||
354 | elsif (exists $esmtp->{'8BITMIME'} or exists $esmtp->{'BINARYMIME'}) { | ||||
355 | $opts .= " BODY=7BIT"; | ||||
356 | } | ||||
357 | else { | ||||
358 | carp 'Net::SMTP::mail: 8BITMIME and BINARYMIME options not supported by host'; | ||||
359 | } | ||||
360 | } | ||||
361 | |||||
362 | if (defined($v = delete $opt{Transaction})) { | ||||
363 | if (exists $esmtp->{CHECKPOINT}) { | ||||
364 | $opts .= " TRANSID=" . _addr($me, $v); | ||||
365 | } | ||||
366 | else { | ||||
367 | carp 'Net::SMTP::mail: CHECKPOINT option not supported by host'; | ||||
368 | } | ||||
369 | } | ||||
370 | |||||
371 | if (defined($v = delete $opt{Envelope})) { | ||||
372 | if (exists $esmtp->{DSN}) { | ||||
373 | $v =~ s/([^\041-\176]|=|\+)/sprintf "+%02X", ord($1)/sge; | ||||
374 | $opts .= " ENVID=$v"; | ||||
375 | } | ||||
376 | else { | ||||
377 | carp 'Net::SMTP::mail: DSN option not supported by host'; | ||||
378 | } | ||||
379 | } | ||||
380 | |||||
381 | if (defined($v = delete $opt{ENVID})) { | ||||
382 | |||||
383 | # expected to be in a format as required by RFC 3461, xtext-encoded | ||||
384 | if (exists $esmtp->{DSN}) { | ||||
385 | $opts .= " ENVID=$v"; | ||||
386 | } | ||||
387 | else { | ||||
388 | carp 'Net::SMTP::mail: DSN option not supported by host'; | ||||
389 | } | ||||
390 | } | ||||
391 | |||||
392 | if (defined($v = delete $opt{AUTH})) { | ||||
393 | |||||
394 | # expected to be in a format as required by RFC 2554, | ||||
395 | # rfc2821-quoted and xtext-encoded, or <> | ||||
396 | if (exists $esmtp->{AUTH}) { | ||||
397 | $v = '<>' if !defined($v) || $v eq ''; | ||||
398 | $opts .= " AUTH=$v"; | ||||
399 | } | ||||
400 | else { | ||||
401 | carp 'Net::SMTP::mail: AUTH option not supported by host'; | ||||
402 | } | ||||
403 | } | ||||
404 | |||||
405 | if (defined($v = delete $opt{XVERP})) { | ||||
406 | if (exists $esmtp->{'XVERP'}) { | ||||
407 | $opts .= " XVERP"; | ||||
408 | } | ||||
409 | else { | ||||
410 | carp 'Net::SMTP::mail: XVERP option not supported by host'; | ||||
411 | } | ||||
412 | } | ||||
413 | |||||
414 | carp 'Net::SMTP::recipient: unknown option(s) ' . join(" ", keys %opt) . ' - ignored' | ||||
415 | if scalar keys %opt; | ||||
416 | } | ||||
417 | else { | ||||
418 | carp 'Net::SMTP::mail: ESMTP not supported by host - options discarded :-('; | ||||
419 | } | ||||
420 | } | ||||
421 | |||||
422 | $me->_MAIL("FROM:" . $addr . $opts); | ||||
423 | } | ||||
424 | |||||
425 | |||||
426 | sub send { my $me = shift; $me->_SEND("FROM:" . _addr($me, $_[0])) } | ||||
427 | sub send_or_mail { my $me = shift; $me->_SOML("FROM:" . _addr($me, $_[0])) } | ||||
428 | sub send_and_mail { my $me = shift; $me->_SAML("FROM:" . _addr($me, $_[0])) } | ||||
429 | |||||
430 | |||||
431 | sub reset { | ||||
432 | my $me = shift; | ||||
433 | |||||
434 | $me->dataend() | ||||
435 | if (exists ${*$me}{'net_smtp_lastch'}); | ||||
436 | |||||
437 | $me->_RSET(); | ||||
438 | } | ||||
439 | |||||
440 | |||||
441 | sub recipient { | ||||
442 | my $smtp = shift; | ||||
443 | my $opts = ""; | ||||
444 | my $skip_bad = 0; | ||||
445 | |||||
446 | if (@_ && ref($_[-1])) { | ||||
447 | my %opt = %{pop(@_)}; | ||||
448 | my $v; | ||||
449 | |||||
450 | $skip_bad = delete $opt{'SkipBad'}; | ||||
451 | |||||
452 | if (exists ${*$smtp}{'net_smtp_esmtp'}) { | ||||
453 | my $esmtp = ${*$smtp}{'net_smtp_esmtp'}; | ||||
454 | |||||
455 | if (defined($v = delete $opt{Notify})) { | ||||
456 | if (exists $esmtp->{DSN}) { | ||||
457 | $opts .= " NOTIFY=" . join(",", map { uc $_ } @$v); | ||||
458 | } | ||||
459 | else { | ||||
460 | carp 'Net::SMTP::recipient: DSN option not supported by host'; | ||||
461 | } | ||||
462 | } | ||||
463 | |||||
464 | if (defined($v = delete $opt{ORcpt})) { | ||||
465 | if (exists $esmtp->{DSN}) { | ||||
466 | $opts .= " ORCPT=" . $v; | ||||
467 | } | ||||
468 | else { | ||||
469 | carp 'Net::SMTP::recipient: DSN option not supported by host'; | ||||
470 | } | ||||
471 | } | ||||
472 | |||||
473 | carp 'Net::SMTP::recipient: unknown option(s) ' . join(" ", keys %opt) . ' - ignored' | ||||
474 | if scalar keys %opt; | ||||
475 | } | ||||
476 | elsif (%opt) { | ||||
477 | carp 'Net::SMTP::recipient: ESMTP not supported by host - options discarded :-('; | ||||
478 | } | ||||
479 | } | ||||
480 | |||||
481 | my @ok; | ||||
482 | foreach my $addr (@_) { | ||||
483 | if ($smtp->_RCPT("TO:" . _addr($smtp, $addr) . $opts)) { | ||||
484 | push(@ok, $addr) if $skip_bad; | ||||
485 | } | ||||
486 | elsif (!$skip_bad) { | ||||
487 | return 0; | ||||
488 | } | ||||
489 | } | ||||
490 | |||||
491 | return $skip_bad ? @ok : 1; | ||||
492 | } | ||||
493 | |||||
494 | # spent 35µs within Net::SMTP::BEGIN@494 which was called:
# once (35µs+0s) by Mail::SpamAssassin::Plugin::SpamCop::BEGIN@53 at line 498 | ||||
495 | 1 | 8µs | *to = \&recipient; | ||
496 | 1 | 2µs | *cc = \&recipient; | ||
497 | 1 | 23µs | *bcc = \&recipient; | ||
498 | 1 | 2.04ms | 1 | 35µs | } # spent 35µs making 1 call to Net::SMTP::BEGIN@494 |
499 | |||||
500 | |||||
501 | sub data { | ||||
502 | my $me = shift; | ||||
503 | |||||
504 | if (exists ${*$me}{'net_smtp_chunking'}) { | ||||
505 | carp 'Net::SMTP::data: CHUNKING extension in use, must call bdat instead'; | ||||
506 | } | ||||
507 | else { | ||||
508 | my $ok = $me->_DATA() && $me->datasend(@_); | ||||
509 | |||||
510 | $ok && @_ | ||||
511 | ? $me->dataend | ||||
512 | : $ok; | ||||
513 | } | ||||
514 | } | ||||
515 | |||||
516 | |||||
517 | sub bdat { | ||||
518 | my $me = shift; | ||||
519 | |||||
520 | if (exists ${*$me}{'net_smtp_chunking'}) { | ||||
521 | my $data = shift; | ||||
522 | |||||
523 | $me->_BDAT(length $data) | ||||
524 | && $me->rawdatasend($data) | ||||
525 | && $me->response() == CMD_OK; | ||||
526 | } | ||||
527 | else { | ||||
528 | carp 'Net::SMTP::bdat: CHUNKING extension is not in use, call data instead'; | ||||
529 | } | ||||
530 | } | ||||
531 | |||||
532 | |||||
533 | sub bdatlast { | ||||
534 | my $me = shift; | ||||
535 | |||||
536 | if (exists ${*$me}{'net_smtp_chunking'}) { | ||||
537 | my $data = shift; | ||||
538 | |||||
539 | $me->_BDAT(length $data, "LAST") | ||||
540 | && $me->rawdatasend($data) | ||||
541 | && $me->response() == CMD_OK; | ||||
542 | } | ||||
543 | else { | ||||
544 | carp 'Net::SMTP::bdat: CHUNKING extension is not in use, call data instead'; | ||||
545 | } | ||||
546 | } | ||||
547 | |||||
548 | |||||
549 | sub datafh { | ||||
550 | my $me = shift; | ||||
551 | return unless $me->_DATA(); | ||||
552 | return $me->tied_fh; | ||||
553 | } | ||||
554 | |||||
555 | |||||
556 | sub expand { | ||||
557 | my $me = shift; | ||||
558 | |||||
559 | $me->_EXPN(@_) | ||||
560 | ? ($me->message) | ||||
561 | : (); | ||||
562 | } | ||||
563 | |||||
564 | |||||
565 | sub verify { shift->_VRFY(@_) } | ||||
566 | |||||
567 | |||||
568 | sub help { | ||||
569 | my $me = shift; | ||||
570 | |||||
571 | $me->_HELP(@_) | ||||
572 | ? scalar $me->message | ||||
573 | : undef; | ||||
574 | } | ||||
575 | |||||
576 | |||||
577 | sub quit { | ||||
578 | my $me = shift; | ||||
579 | |||||
580 | $me->_QUIT; | ||||
581 | $me->close; | ||||
582 | } | ||||
583 | |||||
584 | |||||
585 | sub DESTROY { | ||||
586 | |||||
587 | # ignore | ||||
588 | } | ||||
589 | |||||
590 | ## | ||||
591 | ## RFC821 commands | ||||
592 | ## | ||||
593 | |||||
594 | |||||
595 | sub _EHLO { shift->command("EHLO", @_)->response() == CMD_OK } | ||||
596 | sub _HELO { shift->command("HELO", @_)->response() == CMD_OK } | ||||
597 | sub _MAIL { shift->command("MAIL", @_)->response() == CMD_OK } | ||||
598 | sub _RCPT { shift->command("RCPT", @_)->response() == CMD_OK } | ||||
599 | sub _SEND { shift->command("SEND", @_)->response() == CMD_OK } | ||||
600 | sub _SAML { shift->command("SAML", @_)->response() == CMD_OK } | ||||
601 | sub _SOML { shift->command("SOML", @_)->response() == CMD_OK } | ||||
602 | sub _VRFY { shift->command("VRFY", @_)->response() == CMD_OK } | ||||
603 | sub _EXPN { shift->command("EXPN", @_)->response() == CMD_OK } | ||||
604 | sub _HELP { shift->command("HELP", @_)->response() == CMD_OK } | ||||
605 | sub _RSET { shift->command("RSET")->response() == CMD_OK } | ||||
606 | sub _NOOP { shift->command("NOOP")->response() == CMD_OK } | ||||
607 | sub _QUIT { shift->command("QUIT")->response() == CMD_OK } | ||||
608 | sub _DATA { shift->command("DATA")->response() == CMD_MORE } | ||||
609 | sub _BDAT { shift->command("BDAT", @_) } | ||||
610 | sub _TURN { shift->unsupported(@_); } | ||||
611 | sub _ETRN { shift->command("ETRN", @_)->response() == CMD_OK } | ||||
612 | sub _AUTH { shift->command("AUTH", @_)->response() == CMD_OK } | ||||
613 | sub _STARTTLS { shift->command("STARTTLS")->response() == CMD_OK } | ||||
614 | |||||
615 | |||||
616 | { | ||||
617 | package Net::SMTP::_SSL; | ||||
618 | 1 | 20µs | our @ISA = ( $ssl_class ? ($ssl_class):(), 'Net::SMTP' ); | ||
619 | sub starttls { die "SMTP connection is already in SSL mode" } | ||||
620 | sub start_SSL { | ||||
621 | my ($class,$smtp,%arg) = @_; | ||||
622 | delete @arg{ grep { !m{^SSL_} } keys %arg }; | ||||
623 | ( $arg{SSL_verifycn_name} ||= $smtp->host ) | ||||
624 | =~s{(?<!:):[\w()]+$}{}; # strip port | ||||
625 | $arg{SSL_hostname} = $arg{SSL_verifycn_name} | ||||
626 | if ! defined $arg{SSL_hostname} && $class->can_client_sni; | ||||
627 | $arg{SSL_verifycn_scheme} ||= 'smtp'; | ||||
628 | my $ok = $class->SUPER::start_SSL($smtp,%arg); | ||||
629 | $@ = $ssl_class->errstr if !$ok; | ||||
630 | return $ok; | ||||
631 | } | ||||
632 | } | ||||
633 | |||||
- - | |||||
636 | 2 | 38µs | 1; | ||
637 | |||||
638 | __END__ |