This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Upgrade libnet from version 3.07 to 3.08
[perl5.git] / cpan / libnet / lib / Net / SMTP.pm
CommitLineData
406c51ee
JH
1# Net::SMTP.pm
2#
2e173144
CBW
3# Versions up to 2.31_1 Copyright (c) 1995-2004 Graham Barr <gbarr@pobox.com>.
4# All rights reserved.
db956464 5# Changes in Version 2.31_2 onwards Copyright (C) 2013-2015 Steve Hay. All
2e173144 6# rights reserved.
a4f8ff46
SH
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.
406c51ee
JH
10
11package Net::SMTP;
12
2e173144 13use 5.008001;
406c51ee
JH
14
15use strict;
2e173144
CBW
16use warnings;
17
406c51ee
JH
18use Carp;
19use IO::Socket;
20use Net::Cmd;
21use Net::Config;
2901a52f 22use Socket;
2e173144 23
bfdb5bfe 24our $VERSION = "3.08";
2e173144
CBW
25
26# Code for detecting if we can use SSL
27my $ssl_class = eval {
28 require IO::Socket::SSL;
29 # first version with default CA on most platforms
2901a52f
CBW
30 no warnings 'numeric';
31 IO::Socket::SSL->VERSION(2.007);
2e173144 32} && 'IO::Socket::SSL';
406c51ee 33
2e173144 34my $nossl_warn = !$ssl_class &&
2901a52f 35 'To use SSL please install IO::Socket::SSL with version>=2.007';
406c51ee 36
2e173144 37# Code for detecting if we can use IPv6
db956464 38my $family_key = 'Domain';
2e173144
CBW
39my $inet6_class = eval {
40 require IO::Socket::IP;
2901a52f 41 no warnings 'numeric';
db956464
CBW
42 IO::Socket::IP->VERSION(0.20) || die;
43 $family_key = 'Family';
2e173144
CBW
44} && 'IO::Socket::IP' || eval {
45 require IO::Socket::INET6;
2901a52f 46 no warnings 'numeric';
2e173144
CBW
47 IO::Socket::INET6->VERSION(2.62);
48} && 'IO::Socket::INET6';
406c51ee 49
2e173144
CBW
50sub can_ssl { $ssl_class };
51sub can_inet6 { $inet6_class };
52
53our @ISA = ('Net::Cmd', $inet6_class || 'IO::Socket::INET');
b3f6f6a6
RGS
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 }
2e173144
CBW
67
68 if ($arg{SSL}) {
69 # SSL from start
70 die $nossl_warn if !$ssl_class;
71 $arg{Port} ||= 465;
72 }
73
b3f6f6a6
RGS
74 my $hosts = defined $host ? $host : $NetConfig{smtp_hosts};
75 my $obj;
76
2e173144
CBW
77 $arg{Timeout} = 120 if ! defined $arg{Timeout};
78
79 foreach my $h (@{ref($hosts) ? $hosts : [$hosts]}) {
b3f6f6a6
RGS
80 $obj = $type->SUPER::new(
81 PeerAddr => ($host = $h),
82 PeerPort => $arg{Port} || 'smtp(25)',
83 LocalAddr => $arg{LocalAddr},
84 LocalPort => $arg{LocalPort},
db956464 85 $family_key => $arg{Domain} || $arg{Family},
b3f6f6a6 86 Proto => 'tcp',
2e173144 87 Timeout => $arg{Timeout}
b3f6f6a6
RGS
88 )
89 and last;
406c51ee
JH
90 }
91
2e173144 92 return
b3f6f6a6 93 unless defined $obj;
406c51ee 94
2e173144 95 ${*$obj}{'net_smtp_arg'} = \%arg;
2901a52f
CBW
96 ${*$obj}{'net_smtp_host'} = $host;
97
2e173144 98 if ($arg{SSL}) {
2901a52f 99 Net::SMTP::_SSL->start_SSL($obj,%arg)
2e173144
CBW
100 or return;
101 }
102
b3f6f6a6 103 $obj->autoflush(1);
406c51ee 104
b3f6f6a6 105 $obj->debug(exists $arg{Debug} ? $arg{Debug} : undef);
406c51ee 106
b3f6f6a6 107 unless ($obj->response() == CMD_OK) {
8723f121 108 my $err = ref($obj) . ": " . $obj->code . " " . $obj->message;
b3f6f6a6 109 $obj->close();
8723f121 110 $@ = $err;
2e173144 111 return;
406c51ee
JH
112 }
113
b3f6f6a6 114 ${*$obj}{'net_smtp_exact_addr'} = $arg{ExactAddresses};
406c51ee 115
b3f6f6a6
RGS
116 (${*$obj}{'net_smtp_banner'}) = $obj->message;
117 (${*$obj}{'net_smtp_domain'}) = $obj->message =~ /\A\s*(\S+)/;
406c51ee 118
a4f8ff46
SH
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 }
406c51ee
JH
126 }
127
b3f6f6a6 128 $obj;
406c51ee
JH
129}
130
b3f6f6a6 131
f92f3fcb 132sub host {
b3f6f6a6
RGS
133 my $me = shift;
134 ${*$me}{'net_smtp_host'};
f92f3fcb
GB
135}
136
406c51ee
JH
137##
138## User interface methods
139##
140
406c51ee 141
b3f6f6a6
RGS
142sub banner {
143 my $me = shift;
144
145 return ${*$me}{'net_smtp_banner'} || undef;
406c51ee
JH
146}
147
406c51ee 148
b3f6f6a6
RGS
149sub domain {
150 my $me = shift;
151
152 return ${*$me}{'net_smtp_domain'} || undef;
406c51ee
JH
153}
154
b3f6f6a6 155
406c51ee 156sub etrn {
b3f6f6a6
RGS
157 my $self = shift;
158 defined($self->supports('ETRN', 500, ["Command unknown: 'ETRN'"]))
159 && $self->_ETRN(@_);
406c51ee
JH
160}
161
b3f6f6a6 162
16f7bb68 163sub auth {
b3f6f6a6 164 my ($self, $username, $password) = @_;
c8570720 165
b3f6f6a6
RGS
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;
c8570720 170
b3f6f6a6
RGS
171 my $mechanisms = $self->supports('AUTH', 500, ["Command unknown: 'AUTH'"]);
172 return unless defined $mechanisms;
c8570720 173
b3f6f6a6 174 my $sasl;
16f7bb68 175
b3f6f6a6
RGS
176 if (ref($username) and UNIVERSAL::isa($username, 'Authen::SASL')) {
177 $sasl = $username;
2e173144
CBW
178 my $requested_mechanisms = $sasl->mechanism();
179 if (! defined($requested_mechanisms) || $requested_mechanisms eq '') {
180 $sasl->mechanism($mechanisms);
181 }
b3f6f6a6
RGS
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,
2e173144
CBW
191 },
192 debug => $self->debug
b3f6f6a6
RGS
193 );
194 }
16f7bb68 195
2e173144
CBW
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;
162b417c 202 return unless defined $failed_mechanism;
2e173144
CBW
203 $self->debug_text("Auth mechanism failed: $failed_mechanism")
204 if $self->debug;
205 $mechanisms =~ s/\b\Q$failed_mechanism\E\b//;
162b417c 206 return unless $mechanisms =~ /\S/;
dadfa42f 207 $sasl->mechanism($mechanisms);
2e173144 208 }
2e173144
CBW
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);
b3f6f6a6 216
07513bb4 217 # We don't support sasl mechanisms that encrypt the socket traffic.
b3f6f6a6 218 # todo that we would really need to change the ISA hierarchy
07513bb4 219 # so we don't inherit from IO::Socket, but instead hold it in an attribute
b3f6f6a6
RGS
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 }
c8570720 234
b3f6f6a6 235 $code == CMD_OK;
c8570720
GB
236}
237
b3f6f6a6
RGS
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'} = {};
2e173144 247 foreach my $ln (@msg) {
b3f6f6a6 248 $h->{uc $1} = $2
8723f121 249 if $ln =~ /([-\w]+)\b[= \t]*([^\n]*)/;
406c51ee
JH
250 }
251 }
b3f6f6a6
RGS
252 elsif ($me->status == CMD_ERROR) {
253 @msg = $me->message
254 if $ok = $me->_HELO($domain);
406c51ee
JH
255 }
256
2e173144
CBW
257 return unless $ok;
258 ${*$me}{net_smtp_hello_domain} = $domain;
dea4d7df 259
b3f6f6a6
RGS
260 $msg[0] =~ /\A\s*(\S+)/;
261 return ($1 || " ");
406c51ee
JH
262}
263
2e173144
CBW
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
b3f6f6a6 277
406c51ee 278sub supports {
b3f6f6a6
RGS
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;
406c51ee
JH
286}
287
b3f6f6a6 288
16f7bb68 289sub _addr {
dea4d7df 290 my $self = shift;
16f7bb68
GB
291 my $addr = shift;
292 $addr = "" unless defined $addr;
dea4d7df
GB
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
16f7bb68 302 "<$addr>";
406c51ee
JH
303}
304
b3f6f6a6
RGS
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;
406c51ee 321 }
b3f6f6a6
RGS
322 else {
323 carp 'Net::SMTP::mail: SIZE option not supported by host';
406c51ee
JH
324 }
325 }
326
b3f6f6a6
RGS
327 if (defined($v = delete $opt{Return})) {
328 if (exists $esmtp->{DSN}) {
329 $opts .= " RET=" . ((uc($v) eq "FULL") ? "FULL" : "HDRS");
406c51ee 330 }
b3f6f6a6
RGS
331 else {
332 carp 'Net::SMTP::mail: DSN option not supported by host';
406c51ee
JH
333 }
334 }
335
b3f6f6a6
RGS
336 if (defined($v = delete $opt{Bits})) {
337 if ($v eq "8") {
338 if (exists $esmtp->{'8BITMIME'}) {
339 $opts .= " BODY=8BITMIME";
dea4d7df 340 }
b3f6f6a6
RGS
341 else {
342 carp 'Net::SMTP::mail: 8BITMIME option not supported by host';
dea4d7df
GB
343 }
344 }
b3f6f6a6
RGS
345 elsif ($v eq "binary") {
346 if (exists $esmtp->{'BINARYMIME'} && exists $esmtp->{'CHUNKING'}) {
347 $opts .= " BODY=BINARYMIME";
348 ${*$me}{'net_smtp_chunking'} = 1;
dea4d7df 349 }
b3f6f6a6
RGS
350 else {
351 carp 'Net::SMTP::mail: BINARYMIME option not supported by host';
dea4d7df
GB
352 }
353 }
b3f6f6a6
RGS
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}) {
8723f121 373 $v =~ s/([^\041-\176]|=|\+)/sprintf "+%02X", ord($1)/sge;
b3f6f6a6 374 $opts .= " ENVID=$v";
406c51ee 375 }
b3f6f6a6
RGS
376 else {
377 carp 'Net::SMTP::mail: DSN option not supported by host';
406c51ee
JH
378 }
379 }
380
b3f6f6a6
RGS
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";
406c51ee 386 }
b3f6f6a6
RGS
387 else {
388 carp 'Net::SMTP::mail: DSN option not supported by host';
406c51ee
JH
389 }
390 }
391
b3f6f6a6
RGS
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";
406c51ee 399 }
b3f6f6a6
RGS
400 else {
401 carp 'Net::SMTP::mail: AUTH option not supported by host';
406c51ee
JH
402 }
403 }
404
b3f6f6a6
RGS
405 if (defined($v = delete $opt{XVERP})) {
406 if (exists $esmtp->{'XVERP'}) {
407 $opts .= " XVERP";
f92f3fcb 408 }
b3f6f6a6
RGS
409 else {
410 carp 'Net::SMTP::mail: XVERP option not supported by host';
f92f3fcb
GB
411 }
412 }
413
b3f6f6a6
RGS
414 carp 'Net::SMTP::recipient: unknown option(s) ' . join(" ", keys %opt) . ' - ignored'
415 if scalar keys %opt;
406c51ee 416 }
b3f6f6a6
RGS
417 else {
418 carp 'Net::SMTP::mail: ESMTP not supported by host - options discarded :-(';
406c51ee
JH
419 }
420 }
421
b3f6f6a6 422 $me->_MAIL("FROM:" . $addr . $opts);
406c51ee
JH
423}
424
b3f6f6a6
RGS
425
426sub send { my $me = shift; $me->_SEND("FROM:" . _addr($me, $_[0])) }
dea4d7df
GB
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])) }
406c51ee 429
406c51ee 430
b3f6f6a6
RGS
431sub reset {
432 my $me = shift;
406c51ee 433
b3f6f6a6
RGS
434 $me->dataend()
435 if (exists ${*$me}{'net_smtp_lastch'});
436
437 $me->_RSET();
406c51ee
JH
438}
439
440
b3f6f6a6
RGS
441sub recipient {
442 my $smtp = shift;
443 my $opts = "";
444 my $skip_bad = 0;
406c51ee 445
b3f6f6a6
RGS
446 if (@_ && ref($_[-1])) {
447 my %opt = %{pop(@_)};
448 my $v;
406c51ee 449
b3f6f6a6 450 $skip_bad = delete $opt{'SkipBad'};
406c51ee 451
b3f6f6a6
RGS
452 if (exists ${*$smtp}{'net_smtp_esmtp'}) {
453 my $esmtp = ${*$smtp}{'net_smtp_esmtp'};
406c51ee 454
b3f6f6a6
RGS
455 if (defined($v = delete $opt{Notify})) {
456 if (exists $esmtp->{DSN}) {
457 $opts .= " NOTIFY=" . join(",", map { uc $_ } @$v);
406c51ee 458 }
b3f6f6a6
RGS
459 else {
460 carp 'Net::SMTP::recipient: DSN option not supported by host';
406c51ee
JH
461 }
462 }
463
b3f6f6a6
RGS
464 if (defined($v = delete $opt{ORcpt})) {
465 if (exists $esmtp->{DSN}) {
466 $opts .= " ORCPT=" . $v;
7cf5cf7c 467 }
b3f6f6a6
RGS
468 else {
469 carp 'Net::SMTP::recipient: DSN option not supported by host';
7cf5cf7c
SP
470 }
471 }
472
b3f6f6a6
RGS
473 carp 'Net::SMTP::recipient: unknown option(s) ' . join(" ", keys %opt) . ' - ignored'
474 if scalar keys %opt;
406c51ee 475 }
b3f6f6a6
RGS
476 elsif (%opt) {
477 carp 'Net::SMTP::recipient: ESMTP not supported by host - options discarded :-(';
406c51ee
JH
478 }
479 }
480
b3f6f6a6 481 my @ok;
2e173144 482 foreach my $addr (@_) {
b3f6f6a6
RGS
483 if ($smtp->_RCPT("TO:" . _addr($smtp, $addr) . $opts)) {
484 push(@ok, $addr) if $skip_bad;
406c51ee 485 }
b3f6f6a6 486 elsif (!$skip_bad) {
406c51ee
JH
487 return 0;
488 }
489 }
490
b3f6f6a6 491 return $skip_bad ? @ok : 1;
406c51ee
JH
492}
493
686337f3
JH
494BEGIN {
495 *to = \&recipient;
496 *cc = \&recipient;
497 *bcc = \&recipient;
498}
406c51ee 499
406c51ee 500
b3f6f6a6
RGS
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';
dea4d7df 506 }
b3f6f6a6
RGS
507 else {
508 my $ok = $me->_DATA() && $me->datasend(@_);
dea4d7df 509
b3f6f6a6
RGS
510 $ok && @_
511 ? $me->dataend
512 : $ok;
dea4d7df
GB
513 }
514}
515
dea4d7df 516
b3f6f6a6
RGS
517sub bdat {
518 my $me = shift;
519
520 if (exists ${*$me}{'net_smtp_chunking'}) {
521 my $data = shift;
406c51ee 522
b3f6f6a6
RGS
523 $me->_BDAT(length $data)
524 && $me->rawdatasend($data)
525 && $me->response() == CMD_OK;
dea4d7df 526 }
b3f6f6a6
RGS
527 else {
528 carp 'Net::SMTP::bdat: CHUNKING extension is not in use, call data instead';
dea4d7df
GB
529 }
530}
531
dea4d7df 532
b3f6f6a6
RGS
533sub bdatlast {
534 my $me = shift;
535
536 if (exists ${*$me}{'net_smtp_chunking'}) {
537 my $data = shift;
dea4d7df 538
b3f6f6a6
RGS
539 $me->_BDAT(length $data, "LAST")
540 && $me->rawdatasend($data)
541 && $me->response() == CMD_OK;
dea4d7df 542 }
b3f6f6a6
RGS
543 else {
544 carp 'Net::SMTP::bdat: CHUNKING extension is not in use, call data instead';
dea4d7df 545 }
406c51ee
JH
546}
547
b3f6f6a6 548
12df23ee
GB
549sub datafh {
550 my $me = shift;
551 return unless $me->_DATA();
552 return $me->tied_fh;
553}
554
406c51ee 555
b3f6f6a6
RGS
556sub expand {
557 my $me = shift;
558
559 $me->_EXPN(@_)
560 ? ($me->message)
561 : ();
406c51ee
JH
562}
563
564
565sub verify { shift->_VRFY(@_) }
566
406c51ee 567
b3f6f6a6
RGS
568sub help {
569 my $me = shift;
570
571 $me->_HELP(@_)
572 ? scalar $me->message
573 : undef;
406c51ee
JH
574}
575
406c51ee 576
b3f6f6a6
RGS
577sub quit {
578 my $me = shift;
579
580 $me->_QUIT;
581 $me->close;
406c51ee
JH
582}
583
b3f6f6a6
RGS
584
585sub DESTROY {
586
587 # ignore
406c51ee
JH
588}
589
590##
591## RFC821 commands
592##
593
b3f6f6a6
RGS
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 }
dea4d7df 609sub _BDAT { shift->command("BDAT", @_) }
b3f6f6a6
RGS
610sub _TURN { shift->unsupported(@_); }
611sub _ETRN { shift->command("ETRN", @_)->response() == CMD_OK }
612sub _AUTH { shift->command("AUTH", @_)->response() == CMD_OK }
2e173144
CBW
613sub _STARTTLS { shift->command("STARTTLS")->response() == CMD_OK }
614
615
616{
617 package Net::SMTP::_SSL;
618 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 )
a4f8ff46 624 =~s{(?<!:):[\w()]+$}{}; # strip port
2901a52f 625 $arg{SSL_hostname} = $arg{SSL_verifycn_name}
a4f8ff46 626 if ! defined $arg{SSL_hostname} && $class->can_client_sni;
2e173144
CBW
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
634
406c51ee
JH
635
6361;
637
638__END__
639
640=head1 NAME
641
642Net::SMTP - Simple Mail Transfer Protocol Client
643
644=head1 SYNOPSIS
645
646 use Net::SMTP;
686337f3 647
406c51ee
JH
648 # Constructors
649 $smtp = Net::SMTP->new('mailhost');
650 $smtp = Net::SMTP->new('mailhost', Timeout => 60);
651
652=head1 DESCRIPTION
653
654This module implements a client interface to the SMTP and ESMTP
655protocol, enabling a perl5 application to talk to SMTP servers. This
656documentation assumes that you are familiar with the concepts of the
db956464
CBW
657SMTP protocol described in RFC2821.
658With L<IO::Socket::SSL> installed it also provides support for implicit and
659explicit TLS encryption, i.e. SMTPS or SMTP+STARTTLS.
406c51ee 660
db956464
CBW
661The Net::SMTP class is a subclass of Net::Cmd and (depending on avaibility) of
662IO::Socket::IP, IO::Socket::INET6 or IO::Socket::INET.
406c51ee
JH
663
664=head1 EXAMPLES
665
666This example prints the mail domain name of the SMTP server known as mailhost:
667
668 #!/usr/local/bin/perl -w
686337f3 669
406c51ee 670 use Net::SMTP;
686337f3 671
406c51ee
JH
672 $smtp = Net::SMTP->new('mailhost');
673 print $smtp->domain,"\n";
674 $smtp->quit;
675
676This example sends a small message to the postmaster at the SMTP server
677known as mailhost:
678
679 #!/usr/local/bin/perl -w
686337f3 680
406c51ee 681 use Net::SMTP;
686337f3 682
8723f121 683 my $smtp = Net::SMTP->new('mailhost');
686337f3 684
406c51ee 685 $smtp->mail($ENV{USER});
8723f121
SH
686 if ($smtp->to('postmaster')) {
687 $smtp->data();
688 $smtp->datasend("To: postmaster\n");
689 $smtp->datasend("\n");
690 $smtp->datasend("A simple test message\n");
691 $smtp->dataend();
692 } else {
693 print "Error: ", $smtp->message();
694 }
686337f3 695
406c51ee
JH
696 $smtp->quit;
697
698=head1 CONSTRUCTOR
699
700=over 4
701
f92f3fcb 702=item new ( [ HOST ] [, OPTIONS ] )
406c51ee
JH
703
704This is the constructor for a new Net::SMTP object. C<HOST> is the
d1be9408 705name of the remote host to which an SMTP connection is required.
406c51ee 706
8723f121
SH
707On failure C<undef> will be returned and C<$@> will contain the reason
708for the failure.
709
f92f3fcb
GB
710C<HOST> is optional. If C<HOST> is not given then it may instead be
711passed as the C<Host> option described below. If neither is given then
712the C<SMTP_Hosts> specified in C<Net::Config> will be used.
406c51ee
JH
713
714C<OPTIONS> are passed in a hash like fashion, using key and value pairs.
715Possible options are:
716
717B<Hello> - SMTP requires that you identify yourself. This option
f92f3fcb
GB
718specifies a string to pass as your mail domain. If not given localhost.localdomain
719will be used.
720
a4f8ff46
SH
721B<SendHello> - If false then the EHLO (or HELO) command that is normally sent
722when constructing the object will not be sent. In that case the command will
723have to be sent manually by calling C<hello()> instead.
724
8723f121
SH
725B<Host> - SMTP host to connect to. It may be a single scalar (hostname[:port]),
726as defined for the C<PeerAddr> option in L<IO::Socket::INET>, or a reference to
f92f3fcb
GB
727an array with hosts to try in turn. The L</host> method will return the value
728which was used to connect to the host.
2e173144 729Format - C<PeerHost> from L<IO::Socket::INET> new method.
406c51ee 730
2e173144
CBW
731B<Port> - port to connect to.
732Default - 25 for plain SMTP and 465 for immediate SSL.
733
734B<SSL> - If the connection should be done from start with SSL, contrary to later
735upgrade with C<starttls>.
736You can use SSL arguments as documented in L<IO::Socket::SSL>, but it will
737usually use the right arguments already.
8723f121 738
12df23ee 739B<LocalAddr> and B<LocalPort> - These parameters are passed directly
db956464
CBW
740to IO::Socket to allow binding the socket to a specific local address and port.
741
742B<Domain> - This parameter is passed directly to IO::Socket and makes it
743possible to enforce IPv4 connections even if L<IO::Socket::IP> is used as super
744class. Alternatively B<Family> can be used.
12df23ee 745
406c51ee
JH
746B<Timeout> - Maximum time, in seconds, to wait for a response from the
747SMTP server (default: 120)
748
dea4d7df
GB
749B<ExactAddresses> - If true the all ADDRESS arguments must be as
750defined by C<addr-spec> in RFC2822. If not given, or false, then
751Net::SMTP will attempt to extract the address from the value passed.
752
406c51ee
JH
753B<Debug> - Enable debugging information
754
755
756Example:
757
758
759 $smtp = Net::SMTP->new('mailhost',
5abafd4c
SH
760 Hello => 'my.mail.domain',
761 Timeout => 30,
406c51ee 762 Debug => 1,
5abafd4c 763 );
406c51ee 764
f92f3fcb
GB
765 # the same
766 $smtp = Net::SMTP->new(
5abafd4c
SH
767 Host => 'mailhost',
768 Hello => 'my.mail.domain',
769 Timeout => 30,
f92f3fcb 770 Debug => 1,
5abafd4c 771 );
f92f3fcb 772
2e173144
CBW
773 # the same with direct SSL
774 $smtp = Net::SMTP->new('mailhost',
a4f8ff46
SH
775 Hello => 'my.mail.domain',
776 Timeout => 30,
777 Debug => 1,
778 SSL => 1,
779 );
2e173144 780
f92f3fcb
GB
781 # Connect to the default server from Net::config
782 $smtp = Net::SMTP->new(
5abafd4c
SH
783 Hello => 'my.mail.domain',
784 Timeout => 30,
785 );
f92f3fcb 786
686337f3
JH
787=back
788
406c51ee
JH
789=head1 METHODS
790
791Unless otherwise stated all methods return either a I<true> or I<false>
792value, with I<true> meaning that the operation was a success. When a method
793states that it returns a value, failure will be returned as I<undef> or an
794empty list.
795
487a122b
SH
796C<Net::SMTP> inherits from C<Net::Cmd> so methods defined in C<Net::Cmd> may
797be used to send commands to the remote SMTP server in addition to the methods
798documented here.
799
406c51ee
JH
800=over 4
801
802=item banner ()
803
804Returns the banner message which the server replied with when the
805initial connection was made.
806
807=item domain ()
808
809Returns the domain that the remote SMTP server identified itself as during
810connection.
811
812=item hello ( DOMAIN )
813
814Tell the remote server the mail domain which you are in using the EHLO
815command (or HELO if EHLO fails). Since this method is invoked
816automatically when the Net::SMTP object is constructed the user should
817normally not have to call it manually.
818
f92f3fcb
GB
819=item host ()
820
821Returns the value used by the constructor, and passed to IO::Socket::INET,
822to connect to the host.
823
406c51ee
JH
824=item etrn ( DOMAIN )
825
826Request a queue run for the DOMAIN given.
827
2e173144
CBW
828=item starttls ( SSLARGS )
829
830Upgrade existing plain connection to SSL.
831You can use SSL arguments as documented in L<IO::Socket::SSL>, but it will
832usually use the right arguments already.
833
c8570720
GB
834=item auth ( USERNAME, PASSWORD )
835
bfdb5bfe
SH
836=item auth ( SASL )
837
838Attempt SASL authentication. Requires Authen::SASL module. The first form
839constructs a new Authen::SASL object using the given username and password;
840the second form uses the given Authen::SASL object.
c8570720 841
406c51ee
JH
842=item mail ( ADDRESS [, OPTIONS] )
843
844=item send ( ADDRESS )
845
846=item send_or_mail ( ADDRESS )
847
848=item send_and_mail ( ADDRESS )
849
850Send the appropriate command to the server MAIL, SEND, SOML or SAML. C<ADDRESS>
851is the address of the sender. This initiates the sending of a message. The
852method C<recipient> should be called for each address that the message is to
853be sent to.
854
855The C<mail> method can some additional ESMTP OPTIONS which is passed
856in hash like fashion, using key and value pairs. Possible options are:
857
858 Size => <bytes>
dea4d7df
GB
859 Return => "FULL" | "HDRS"
860 Bits => "7" | "8" | "binary"
406c51ee 861 Transaction => <ADDRESS>
b3f6f6a6
RGS
862 Envelope => <ENVID> # xtext-encodes its argument
863 ENVID => <ENVID> # similar to Envelope, but expects argument encoded
f92f3fcb 864 XVERP => 1
b3f6f6a6 865 AUTH => <submitter> # encoded address according to RFC 2554
406c51ee 866
dea4d7df
GB
867The C<Return> and C<Envelope> parameters are used for DSN (Delivery
868Status Notification).
406c51ee 869
b3f6f6a6
RGS
870The submitter address in C<AUTH> option is expected to be in a format as
871required by RFC 2554, in an RFC2821-quoted form and xtext-encoded, or <> .
872
406c51ee
JH
873=item reset ()
874
875Reset the status of the server. This may be called after a message has been
876initiated, but before any data has been sent, to cancel the sending of the
877message.
878
f92f3fcb 879=item recipient ( ADDRESS [, ADDRESS, [...]] [, OPTIONS ] )
406c51ee
JH
880
881Notify the server that the current message should be sent to all of the
882addresses given. Each address is sent as a separate command to the server.
f92f3fcb
GB
883Should the sending of any address result in a failure then the process is
884aborted and a I<false> value is returned. It is up to the user to call
885C<reset> if they so desire.
406c51ee 886
f92f3fcb
GB
887The C<recipient> method can also pass additional case-sensitive OPTIONS as an
888anonymous hash using key and value pairs. Possible options are:
406c51ee 889
f92f3fcb 890 Notify => ['NEVER'] or ['SUCCESS','FAILURE','DELAY'] (see below)
7cf5cf7c 891 ORcpt => <ORCPT>
f92f3fcb 892 SkipBad => 1 (to ignore bad addresses)
406c51ee 893
f92f3fcb
GB
894If C<SkipBad> is true the C<recipient> will not return an error when a bad
895address is encountered and it will return an array of addresses that did
896succeed.
406c51ee 897
686337f3
JH
898 $smtp->recipient($recipient1,$recipient2); # Good
899 $smtp->recipient($recipient1,$recipient2, { SkipBad => 1 }); # Good
f92f3fcb
GB
900 $smtp->recipient($recipient1,$recipient2, { Notify => ['FAILURE','DELAY'], SkipBad => 1 }); # Good
901 @goodrecips=$smtp->recipient(@recipients, { Notify => ['FAILURE'], SkipBad => 1 }); # Good
902 $smtp->recipient("$recipient,$recipient2"); # BAD
903
904Notify is used to request Delivery Status Notifications (DSNs), but your
905SMTP/ESMTP service may not respect this request depending upon its version and
906your site's SMTP configuration.
907
908Leaving out the Notify option usually defaults an SMTP service to its default
909behavior equivalent to ['FAILURE'] notifications only, but again this may be
910dependent upon your site's SMTP configuration.
911
912The NEVER keyword must appear by itself if used within the Notify option and "requests
913that a DSN not be returned to the sender under any conditions."
914
915 {Notify => ['NEVER']}
916
917 $smtp->recipient(@recipients, { Notify => ['NEVER'], SkipBad => 1 }); # Good
918
919You may use any combination of these three values 'SUCCESS','FAILURE','DELAY' in
8723f121 920the anonymous array reference as defined by RFC3461 (see http://www.ietf.org/rfc/rfc3461.txt
f92f3fcb
GB
921for more information. Note: quotations in this topic from same.).
922
923A Notify parameter of 'SUCCESS' or 'FAILURE' "requests that a DSN be issued on
924successful delivery or delivery failure, respectively."
925
926A Notify parameter of 'DELAY' "indicates the sender's willingness to receive
927delayed DSNs. Delayed DSNs may be issued if delivery of a message has been
928delayed for an unusual amount of time (as determined by the Message Transfer
929Agent (MTA) at which the message is delayed), but the final delivery status
930(whether successful or failure) cannot be determined. The absence of the DELAY
931keyword in a NOTIFY parameter requests that a "delayed" DSN NOT be issued under
932any conditions."
933
934 {Notify => ['SUCCESS','FAILURE','DELAY']}
935
936 $smtp->recipient(@recipients, { Notify => ['FAILURE','DELAY'], SkipBad => 1 }); # Good
686337f3 937
7cf5cf7c
SP
938ORcpt is also part of the SMTP DSN extension according to RFC3461.
939It is used to pass along the original recipient that the mail was first
940sent to. The machine that generates a DSN will use this address to inform
941the sender, because he can't know if recipients get rewritten by mail servers.
b3f6f6a6 942It is expected to be in a format as required by RFC3461, xtext-encoded.
7cf5cf7c 943
406c51ee
JH
944=item to ( ADDRESS [, ADDRESS [...]] )
945
686337f3
JH
946=item cc ( ADDRESS [, ADDRESS [...]] )
947
948=item bcc ( ADDRESS [, ADDRESS [...]] )
949
950Synonyms for C<recipient>.
406c51ee
JH
951
952=item data ( [ DATA ] )
953
954Initiate the sending of the data from the current message.
955
db956464
CBW
956C<DATA> may be a reference to a list or a list and must be encoded by the
957caller to octets of whatever encoding is required, e.g. by using the Encode
958module's C<encode()> function.
959
960If specified the contents of C<DATA> and a termination string C<".\r\n"> is
961sent to the server. The result will be true if the data was accepted.
406c51ee
JH
962
963If C<DATA> is not specified then the result will indicate that the server
964wishes the data to be sent. The data must then be sent using the C<datasend>
965and C<dataend> methods described in L<Net::Cmd>.
966
2e173144
CBW
967=item bdat ( DATA )
968
969=item bdatlast ( DATA )
970
971Use the alternate DATA command "BDAT" of the data chunking service extension
972defined in RFC1830 for efficiently sending large MIME messages.
973
406c51ee
JH
974=item expand ( ADDRESS )
975
976Request the server to expand the given address Returns an array
977which contains the text read from the server.
978
979=item verify ( ADDRESS )
980
981Verify that C<ADDRESS> is a legitimate mailing address.
982
f92f3fcb
GB
983Most sites usually disable this feature in their SMTP service configuration.
984Use "Debug => 1" option under new() to see if disabled.
985
406c51ee
JH
986=item help ( [ $subject ] )
987
988Request help text from the server. Returns the text or undef upon failure
989
990=item quit ()
991
992Send the QUIT command to the remote SMTP server and close the socket connection.
993
2e173144
CBW
994=item can_inet6 ()
995
996Returns whether we can use IPv6.
997
998=item can_ssl ()
999
1000Returns whether we can use SSL.
1001
406c51ee
JH
1002=back
1003
16f7bb68
GB
1004=head1 ADDRESSES
1005
dea4d7df
GB
1006Net::SMTP attempts to DWIM with addresses that are passed. For
1007example an application might extract The From: line from an email
3c4b39be 1008and pass that to mail(). While this may work, it is not recommended.
dea4d7df
GB
1009The application should really use a module like L<Mail::Address>
1010to extract the mail address and pass that.
1011
3c4b39be 1012If C<ExactAddresses> is passed to the constructor, then addresses
dea4d7df 1013should be a valid rfc2821-quoted address, although Net::SMTP will
07513bb4 1014accept the address surrounded by angle brackets.
16f7bb68
GB
1015
1016 funny user@domain WRONG
1017 "funny user"@domain RIGHT, recommended
1018 <"funny user"@domain> OK
1019
406c51ee
JH
1020=head1 SEE ALSO
1021
2e173144
CBW
1022L<Net::Cmd>,
1023L<IO::Socket::SSL>
406c51ee
JH
1024
1025=head1 AUTHOR
1026
2e173144
CBW
1027Graham Barr E<lt>F<gbarr@pobox.com>E<gt>
1028
1029Steve Hay E<lt>F<shay@cpan.org>E<gt> is now maintaining libnet as of version
10301.22_02
406c51ee
JH
1031
1032=head1 COPYRIGHT
1033
2e173144 1034Versions up to 2.31_1 Copyright (c) 1995-2004 Graham Barr. All rights reserved.
db956464 1035Changes in Version 2.31_2 onwards Copyright (C) 2013-2015 Steve Hay. All rights
2e173144
CBW
1036reserved.
1037
a4f8ff46
SH
1038This module is free software; you can redistribute it and/or modify it under the
1039same terms as Perl itself, i.e. under the terms of either the GNU General Public
1040License or the Artistic License, as specified in the F<LICENCE> file.
406c51ee
JH
1041
1042=cut