← Index
NYTProf Performance Profile   « line view »
For /usr/local/bin/sa-learn
  Run on Tue Nov 7 05:38:10 2017
Reported on Tue Nov 7 06:16:04 2017

Filename/usr/local/lib/perl5/5.24/Net/SMTP.pm
StatementsExecuted 39 statements in 8.87ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
1117.44ms10.3msNet::SMTP::::BEGIN@20 Net::SMTP::BEGIN@20
1112.49ms6.08msNet::SMTP::::BEGIN@21 Net::SMTP::BEGIN@21
11153µs53µsNet::SMTP::::BEGIN@13 Net::SMTP::BEGIN@13
11138µs6.75msNet::SMTP::::BEGIN@22 Net::SMTP::BEGIN@22
11135µs4.17msNet::SMTP::::BEGIN@19 Net::SMTP::BEGIN@19
11130µs93µsNet::SMTP::::BEGIN@30 Net::SMTP::BEGIN@30
11129µs62µsNet::SMTP::::BEGIN@46 Net::SMTP::BEGIN@46
11126µs270µsNet::SMTP::::BEGIN@18 Net::SMTP::BEGIN@18
11124µs36µsNet::SMTP::::BEGIN@15 Net::SMTP::BEGIN@15
11122µs81µsNet::SMTP::::BEGIN@41 Net::SMTP::BEGIN@41
11119µs58µsNet::SMTP::::BEGIN@16 Net::SMTP::BEGIN@16
11117µs17µsNet::SMTP::::BEGIN@494 Net::SMTP::BEGIN@494
0000s0sNet::SMTP::::DESTROY Net::SMTP::DESTROY
0000s0sNet::SMTP::::_AUTH Net::SMTP::_AUTH
0000s0sNet::SMTP::::_BDAT Net::SMTP::_BDAT
0000s0sNet::SMTP::::_DATA Net::SMTP::_DATA
0000s0sNet::SMTP::::_EHLO Net::SMTP::_EHLO
0000s0sNet::SMTP::::_ETRN Net::SMTP::_ETRN
0000s0sNet::SMTP::::_EXPN Net::SMTP::_EXPN
0000s0sNet::SMTP::::_HELO Net::SMTP::_HELO
0000s0sNet::SMTP::::_HELP Net::SMTP::_HELP
0000s0sNet::SMTP::::_MAIL Net::SMTP::_MAIL
0000s0sNet::SMTP::::_NOOP Net::SMTP::_NOOP
0000s0sNet::SMTP::::_QUIT Net::SMTP::_QUIT
0000s0sNet::SMTP::::_RCPT Net::SMTP::_RCPT
0000s0sNet::SMTP::::_RSET Net::SMTP::_RSET
0000s0sNet::SMTP::::_SAML Net::SMTP::_SAML
0000s0sNet::SMTP::::_SEND Net::SMTP::_SEND
0000s0sNet::SMTP::::_SOML Net::SMTP::_SOML
0000s0sNet::SMTP::_SSL::::start_SSLNet::SMTP::_SSL::start_SSL
0000s0sNet::SMTP::_SSL::::starttlsNet::SMTP::_SSL::starttls
0000s0sNet::SMTP::::_STARTTLS Net::SMTP::_STARTTLS
0000s0sNet::SMTP::::_TURN Net::SMTP::_TURN
0000s0sNet::SMTP::::_VRFY Net::SMTP::_VRFY
0000s0sNet::SMTP::::_addr Net::SMTP::_addr
0000s0sNet::SMTP::::auth Net::SMTP::auth
0000s0sNet::SMTP::::banner Net::SMTP::banner
0000s0sNet::SMTP::::bdat Net::SMTP::bdat
0000s0sNet::SMTP::::bdatlast Net::SMTP::bdatlast
0000s0sNet::SMTP::::can_inet6 Net::SMTP::can_inet6
0000s0sNet::SMTP::::can_ssl Net::SMTP::can_ssl
0000s0sNet::SMTP::::data Net::SMTP::data
0000s0sNet::SMTP::::datafh Net::SMTP::datafh
0000s0sNet::SMTP::::domain Net::SMTP::domain
0000s0sNet::SMTP::::etrn Net::SMTP::etrn
0000s0sNet::SMTP::::expand Net::SMTP::expand
0000s0sNet::SMTP::::hello Net::SMTP::hello
0000s0sNet::SMTP::::help Net::SMTP::help
0000s0sNet::SMTP::::host Net::SMTP::host
0000s0sNet::SMTP::::mail Net::SMTP::mail
0000s0sNet::SMTP::::new Net::SMTP::new
0000s0sNet::SMTP::::quit Net::SMTP::quit
0000s0sNet::SMTP::::recipient Net::SMTP::recipient
0000s0sNet::SMTP::::reset Net::SMTP::reset
0000s0sNet::SMTP::::send Net::SMTP::send
0000s0sNet::SMTP::::send_and_mail Net::SMTP::send_and_mail
0000s0sNet::SMTP::::send_or_mail Net::SMTP::send_or_mail
0000s0sNet::SMTP::::starttls Net::SMTP::starttls
0000s0sNet::SMTP::::supports Net::SMTP::supports
0000s0sNet::SMTP::::verify Net::SMTP::verify
Call graph for these subroutines as a Graphviz dot language file.
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
11package Net::SMTP;
12
132117µs153µs
# spent 53µs within Net::SMTP::BEGIN@13 which was called: # once (53µs+0s) by Mail::SpamAssassin::Plugin::SpamCop::BEGIN@53 at line 13
use 5.008001;
# spent 53µs making 1 call to Net::SMTP::BEGIN@13
14
15265µs249µs
# spent 36µs (24+12) within Net::SMTP::BEGIN@15 which was called: # once (24µs+12µs) by Mail::SpamAssassin::Plugin::SpamCop::BEGIN@53 at line 15
use strict;
# spent 36µs making 1 call to Net::SMTP::BEGIN@15 # spent 12µs making 1 call to strict::import
16274µs297µs
# spent 58µs (19+39) within Net::SMTP::BEGIN@16 which was called: # once (19µs+39µs) by Mail::SpamAssassin::Plugin::SpamCop::BEGIN@53 at line 16
use warnings;
# spent 58µs making 1 call to Net::SMTP::BEGIN@16 # spent 39µs making 1 call to warnings::import
17
18282µs2513µs
# spent 270µs (26+244) within Net::SMTP::BEGIN@18 which was called: # once (26µs+244µs) by Mail::SpamAssassin::Plugin::SpamCop::BEGIN@53 at line 18
use Carp;
# spent 270µs making 1 call to Net::SMTP::BEGIN@18 # spent 244µs making 1 call to Exporter::import
19286µs28.31ms
# spent 4.17ms (35µs+4.14) within Net::SMTP::BEGIN@19 which was called: # once (35µs+4.14ms) by Mail::SpamAssassin::Plugin::SpamCop::BEGIN@53 at line 19
use IO::Socket;
# spent 4.17ms making 1 call to Net::SMTP::BEGIN@19 # spent 4.14ms making 1 call to IO::Socket::import
202425µs210.5ms
# spent 10.3ms (7.44+2.82) within Net::SMTP::BEGIN@20 which was called: # once (7.44ms+2.82ms) by Mail::SpamAssassin::Plugin::SpamCop::BEGIN@53 at line 20
use Net::Cmd;
# spent 10.3ms making 1 call to Net::SMTP::BEGIN@20 # spent 287µs making 1 call to Exporter::import
212402µs26.37ms
# spent 6.08ms (2.49+3.60) within Net::SMTP::BEGIN@21 which was called: # once (2.49ms+3.60ms) by Mail::SpamAssassin::Plugin::SpamCop::BEGIN@53 at line 21
use Net::Config;
# spent 6.08ms making 1 call to Net::SMTP::BEGIN@21 # spent 290µs making 1 call to Exporter::import
222122µs213.5ms
# spent 6.75ms (38µs+6.71) within Net::SMTP::BEGIN@22 which was called: # once (38µs+6.71ms) by Mail::SpamAssassin::Plugin::SpamCop::BEGIN@53 at line 22
use Socket;
# spent 6.75ms making 1 call to Net::SMTP::BEGIN@22 # spent 6.71ms making 1 call to Exporter::import
23
2412µsour $VERSION = "3.08_01";
25
26# Code for detecting if we can use SSL
2715µsmy $ssl_class = eval {
281276µs require IO::Socket::SSL;
29 # first version with default CA on most platforms
302134µs2155µs
# spent 93µs (30+62) within Net::SMTP::BEGIN@30 which was called: # once (30µs+62µs) by Mail::SpamAssassin::Plugin::SpamCop::BEGIN@53 at line 30
no warnings 'numeric';
# spent 93µs making 1 call to Net::SMTP::BEGIN@30 # spent 62µs making 1 call to warnings::unimport
31160µs126µs IO::Socket::SSL->VERSION(2.007);
# spent 26µs making 1 call to version::_VERSION
32} && 'IO::Socket::SSL';
33
3413µsmy $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
3813µsmy $family_key = 'Domain';
39my $inet6_class = eval {
4013µs require IO::Socket::IP;
412110µs2139µs
# spent 81µs (22+58) within Net::SMTP::BEGIN@41 which was called: # once (22µs+58µs) by Mail::SpamAssassin::Plugin::SpamCop::BEGIN@53 at line 41
no warnings 'numeric';
# spent 81µs making 1 call to Net::SMTP::BEGIN@41 # spent 58µs making 1 call to warnings::unimport
42132µs112µs IO::Socket::IP->VERSION(0.20) || die;
# spent 12µs making 1 call to version::_VERSION
4313µs $family_key = 'Family';
4415µs} && 'IO::Socket::IP' || eval {
45 require IO::Socket::INET6;
4624.66ms295µs
# spent 62µs (29+33) within Net::SMTP::BEGIN@46 which was called: # once (29µs+33µs) by Mail::SpamAssassin::Plugin::SpamCop::BEGIN@53 at line 46
no warnings 'numeric';
# spent 62µs making 1 call to Net::SMTP::BEGIN@46 # spent 33µs making 1 call to warnings::unimport
47 IO::Socket::INET6->VERSION(2.62);
48} && 'IO::Socket::INET6';
49
50sub can_ssl { $ssl_class };
51sub can_inet6 { $inet6_class };
52
53152µsour @ISA = ('Net::Cmd', $inet6_class || 'IO::Socket::INET');
54
55sub 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
132sub host {
133 my $me = shift;
134 ${*$me}{'net_smtp_host'};
135}
136
137##
138## User interface methods
139##
140
141
142sub banner {
143 my $me = shift;
144
145 return ${*$me}{'net_smtp_banner'} || undef;
146}
147
148
149sub domain {
150 my $me = shift;
151
152 return ${*$me}{'net_smtp_domain'} || undef;
153}
154
155
156sub etrn {
157 my $self = shift;
158 defined($self->supports('ETRN', 500, ["Command unknown: 'ETRN'"]))
159 && $self->_ETRN(@_);
160}
161
162
163sub 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
239sub 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
264sub 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
278sub 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
289sub _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
306sub 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
426sub send { my $me = shift; $me->_SEND("FROM:" . _addr($me, $_[0])) }
427sub send_or_mail { my $me = shift; $me->_SOML("FROM:" . _addr($me, $_[0])) }
428sub send_and_mail { my $me = shift; $me->_SAML("FROM:" . _addr($me, $_[0])) }
429
430
431sub reset {
432 my $me = shift;
433
434 $me->dataend()
435 if (exists ${*$me}{'net_smtp_lastch'});
436
437 $me->_RSET();
438}
439
440
441sub 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 17µs within Net::SMTP::BEGIN@494 which was called: # once (17µs+0s) by Mail::SpamAssassin::Plugin::SpamCop::BEGIN@53 at line 498
BEGIN {
49513µs *to = \&recipient;
49612µs *cc = \&recipient;
497113µs *bcc = \&recipient;
49812.08ms117µs}
# spent 17µs making 1 call to Net::SMTP::BEGIN@494
499
500
501sub 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
517sub 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
533sub 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
549sub datafh {
550 my $me = shift;
551 return unless $me->_DATA();
552 return $me->tied_fh;
553}
554
555
556sub expand {
557 my $me = shift;
558
559 $me->_EXPN(@_)
560 ? ($me->message)
561 : ();
562}
563
564
565sub verify { shift->_VRFY(@_) }
566
567
568sub help {
569 my $me = shift;
570
571 $me->_HELP(@_)
572 ? scalar $me->message
573 : undef;
574}
575
576
577sub quit {
578 my $me = shift;
579
580 $me->_QUIT;
581 $me->close;
582}
583
584
585sub DESTROY {
586
587 # ignore
588}
589
590##
591## RFC821 commands
592##
593
594
595sub _EHLO { shift->command("EHLO", @_)->response() == CMD_OK }
596sub _HELO { shift->command("HELO", @_)->response() == CMD_OK }
597sub _MAIL { shift->command("MAIL", @_)->response() == CMD_OK }
598sub _RCPT { shift->command("RCPT", @_)->response() == CMD_OK }
599sub _SEND { shift->command("SEND", @_)->response() == CMD_OK }
600sub _SAML { shift->command("SAML", @_)->response() == CMD_OK }
601sub _SOML { shift->command("SOML", @_)->response() == CMD_OK }
602sub _VRFY { shift->command("VRFY", @_)->response() == CMD_OK }
603sub _EXPN { shift->command("EXPN", @_)->response() == CMD_OK }
604sub _HELP { shift->command("HELP", @_)->response() == CMD_OK }
605sub _RSET { shift->command("RSET")->response() == CMD_OK }
606sub _NOOP { shift->command("NOOP")->response() == CMD_OK }
607sub _QUIT { shift->command("QUIT")->response() == CMD_OK }
608sub _DATA { shift->command("DATA")->response() == CMD_MORE }
609sub _BDAT { shift->command("BDAT", @_) }
610sub _TURN { shift->unsupported(@_); }
611sub _ETRN { shift->command("ETRN", @_)->response() == CMD_OK }
612sub _AUTH { shift->command("AUTH", @_)->response() == CMD_OK }
613sub _STARTTLS { shift->command("STARTTLS")->response() == CMD_OK }
614
615
616{
617 package Net::SMTP::_SSL;
618117µ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
- -
636237µs1;
637
638__END__
Report produced by the NYTProf 6.04 Perl profiler, developed by Tim Bunce based on work by Adam Kaplan and Salvador Fandiño García.