3 # Copyright (c) 1995-2004 Graham Barr <gbarr@pobox.com>. All rights reserved.
4 # This program is free software; you can redistribute it and/or
5 # modify it under the same terms as Perl itself.
12 use vars qw($VERSION @ISA);
21 @ISA = qw(Net::Cmd IO::Socket::INET);
26 my $type = ref($self) || $self;
34 $host = delete $arg{Host};
36 my $hosts = defined $host ? $host : $NetConfig{smtp_hosts};
40 foreach $h (@{ref($hosts) ? $hosts : [$hosts]}) {
41 $obj = $type->SUPER::new(
42 PeerAddr => ($host = $h),
43 PeerPort => $arg{Port} || 'smtp(25)',
44 LocalAddr => $arg{LocalAddr},
45 LocalPort => $arg{LocalPort},
47 Timeout => defined $arg{Timeout}
59 $obj->debug(exists $arg{Debug} ? $arg{Debug} : undef);
61 unless ($obj->response() == CMD_OK) {
66 ${*$obj}{'net_smtp_exact_addr'} = $arg{ExactAddresses};
67 ${*$obj}{'net_smtp_host'} = $host;
69 (${*$obj}{'net_smtp_banner'}) = $obj->message;
70 (${*$obj}{'net_smtp_domain'}) = $obj->message =~ /\A\s*(\S+)/;
72 unless ($obj->hello($arg{Hello} || "")) {
83 ${*$me}{'net_smtp_host'};
87 ## User interface methods
94 return ${*$me}{'net_smtp_banner'} || undef;
101 return ${*$me}{'net_smtp_domain'} || undef;
107 defined($self->supports('ETRN', 500, ["Command unknown: 'ETRN'"]))
113 my ($self, $username, $password) = @_;
116 require MIME::Base64;
117 require Authen::SASL;
118 } or $self->set_status(500, ["Need MIME::Base64 and Authen::SASL todo auth"]), return 0;
120 my $mechanisms = $self->supports('AUTH', 500, ["Command unknown: 'AUTH'"]);
121 return unless defined $mechanisms;
125 if (ref($username) and UNIVERSAL::isa($username, 'Authen::SASL')) {
127 $sasl->mechanism($mechanisms);
130 die "auth(username, password)" if not length $username;
131 $sasl = Authen::SASL->new(
132 mechanism => $mechanisms,
136 authname => $username,
141 # We should probably allow the user to pass the host, but I don't
142 # currently know and SASL mechanisms that are used by smtp that need it
143 my $client = $sasl->client_new('smtp', ${*$self}{'net_smtp_host'}, 0);
144 my $str = $client->client_start;
146 # We dont support sasl mechanisms that encrypt the socket traffic.
147 # todo that we would really need to change the ISA hierarchy
148 # so we dont inherit from IO::Socket, but instead hold it in an attribute
150 my @cmd = ("AUTH", $client->mechanism);
153 push @cmd, MIME::Base64::encode_base64($str, '')
154 if defined $str and length $str;
156 while (($code = $self->command(@cmd)->response()) == CMD_MORE) {
158 MIME::Base64::encode_base64(
159 $client->client_step(MIME::Base64::decode_base64(($self->message)[0])), ''
170 my $domain = shift || "localhost.localdomain";
171 my $ok = $me->_EHLO($domain);
172 my @msg = $me->message;
175 my $h = ${*$me}{'net_smtp_esmtp'} = {};
179 if $ln =~ /(\w+)\b[= \t]*([^\n]*)/;
182 elsif ($me->status == CMD_ERROR) {
184 if $ok = $me->_HELO($domain);
187 return undef unless $ok;
189 $msg[0] =~ /\A\s*(\S+)/;
197 return ${*$self}{'net_smtp_esmtp'}->{$cmd}
198 if exists ${*$self}{'net_smtp_esmtp'}->{$cmd};
199 $self->set_status(@_)
208 $addr = "" unless defined $addr;
210 if (${*$self}{'net_smtp_exact_addr'}) {
211 return $1 if $addr =~ /^\s*(<.*>)\s*$/s;
214 return $1 if $addr =~ /(<[^>]*>)/;
215 $addr =~ s/^\s+|\s+$//sg;
224 my $addr = _addr($me, shift);
231 if (exists ${*$me}{'net_smtp_esmtp'}) {
232 my $esmtp = ${*$me}{'net_smtp_esmtp'};
234 if (defined($v = delete $opt{Size})) {
235 if (exists $esmtp->{SIZE}) {
236 $opts .= sprintf " SIZE=%d", $v + 0;
239 carp 'Net::SMTP::mail: SIZE option not supported by host';
243 if (defined($v = delete $opt{Return})) {
244 if (exists $esmtp->{DSN}) {
245 $opts .= " RET=" . ((uc($v) eq "FULL") ? "FULL" : "HDRS");
248 carp 'Net::SMTP::mail: DSN option not supported by host';
252 if (defined($v = delete $opt{Bits})) {
254 if (exists $esmtp->{'8BITMIME'}) {
255 $opts .= " BODY=8BITMIME";
258 carp 'Net::SMTP::mail: 8BITMIME option not supported by host';
261 elsif ($v eq "binary") {
262 if (exists $esmtp->{'BINARYMIME'} && exists $esmtp->{'CHUNKING'}) {
263 $opts .= " BODY=BINARYMIME";
264 ${*$me}{'net_smtp_chunking'} = 1;
267 carp 'Net::SMTP::mail: BINARYMIME option not supported by host';
270 elsif (exists $esmtp->{'8BITMIME'} or exists $esmtp->{'BINARYMIME'}) {
271 $opts .= " BODY=7BIT";
274 carp 'Net::SMTP::mail: 8BITMIME and BINARYMIME options not supported by host';
278 if (defined($v = delete $opt{Transaction})) {
279 if (exists $esmtp->{CHECKPOINT}) {
280 $opts .= " TRANSID=" . _addr($me, $v);
283 carp 'Net::SMTP::mail: CHECKPOINT option not supported by host';
287 if (defined($v = delete $opt{Envelope})) {
288 if (exists $esmtp->{DSN}) {
289 $v =~ s/([^\041-\176]|=|\+)/sprintf "+%02x", ord($1)/sge;
290 $opts .= " ENVID=$v";
293 carp 'Net::SMTP::mail: DSN option not supported by host';
297 if (defined($v = delete $opt{ENVID})) {
299 # expected to be in a format as required by RFC 3461, xtext-encoded
300 if (exists $esmtp->{DSN}) {
301 $opts .= " ENVID=$v";
304 carp 'Net::SMTP::mail: DSN option not supported by host';
308 if (defined($v = delete $opt{AUTH})) {
310 # expected to be in a format as required by RFC 2554,
311 # rfc2821-quoted and xtext-encoded, or <>
312 if (exists $esmtp->{AUTH}) {
313 $v = '<>' if !defined($v) || $v eq '';
317 carp 'Net::SMTP::mail: AUTH option not supported by host';
321 if (defined($v = delete $opt{XVERP})) {
322 if (exists $esmtp->{'XVERP'}) {
326 carp 'Net::SMTP::mail: XVERP option not supported by host';
330 carp 'Net::SMTP::recipient: unknown option(s) ' . join(" ", keys %opt) . ' - ignored'
334 carp 'Net::SMTP::mail: ESMTP not supported by host - options discarded :-(';
338 $me->_MAIL("FROM:" . $addr . $opts);
342 sub send { my $me = shift; $me->_SEND("FROM:" . _addr($me, $_[0])) }
343 sub send_or_mail { my $me = shift; $me->_SOML("FROM:" . _addr($me, $_[0])) }
344 sub send_and_mail { my $me = shift; $me->_SAML("FROM:" . _addr($me, $_[0])) }
351 if (exists ${*$me}{'net_smtp_lastch'});
362 if (@_ && ref($_[-1])) {
363 my %opt = %{pop(@_)};
366 $skip_bad = delete $opt{'SkipBad'};
368 if (exists ${*$smtp}{'net_smtp_esmtp'}) {
369 my $esmtp = ${*$smtp}{'net_smtp_esmtp'};
371 if (defined($v = delete $opt{Notify})) {
372 if (exists $esmtp->{DSN}) {
373 $opts .= " NOTIFY=" . join(",", map { uc $_ } @$v);
376 carp 'Net::SMTP::recipient: DSN option not supported by host';
380 if (defined($v = delete $opt{ORcpt})) {
381 if (exists $esmtp->{DSN}) {
382 $opts .= " ORCPT=" . $v;
385 carp 'Net::SMTP::recipient: DSN option not supported by host';
389 carp 'Net::SMTP::recipient: unknown option(s) ' . join(" ", keys %opt) . ' - ignored'
393 carp 'Net::SMTP::recipient: ESMTP not supported by host - options discarded :-(';
400 if ($smtp->_RCPT("TO:" . _addr($smtp, $addr) . $opts)) {
401 push(@ok, $addr) if $skip_bad;
408 return $skip_bad ? @ok : 1;
421 if (exists ${*$me}{'net_smtp_chunking'}) {
422 carp 'Net::SMTP::data: CHUNKING extension in use, must call bdat instead';
425 my $ok = $me->_DATA() && $me->datasend(@_);
437 if (exists ${*$me}{'net_smtp_chunking'}) {
440 $me->_BDAT(length $data)
441 && $me->rawdatasend($data)
442 && $me->response() == CMD_OK;
445 carp 'Net::SMTP::bdat: CHUNKING extension is not in use, call data instead';
453 if (exists ${*$me}{'net_smtp_chunking'}) {
456 $me->_BDAT(length $data, "LAST")
457 && $me->rawdatasend($data)
458 && $me->response() == CMD_OK;
461 carp 'Net::SMTP::bdat: CHUNKING extension is not in use, call data instead';
468 return unless $me->_DATA();
482 sub verify { shift->_VRFY(@_) }
489 ? scalar $me->message
512 sub _EHLO { shift->command("EHLO", @_)->response() == CMD_OK }
513 sub _HELO { shift->command("HELO", @_)->response() == CMD_OK }
514 sub _MAIL { shift->command("MAIL", @_)->response() == CMD_OK }
515 sub _RCPT { shift->command("RCPT", @_)->response() == CMD_OK }
516 sub _SEND { shift->command("SEND", @_)->response() == CMD_OK }
517 sub _SAML { shift->command("SAML", @_)->response() == CMD_OK }
518 sub _SOML { shift->command("SOML", @_)->response() == CMD_OK }
519 sub _VRFY { shift->command("VRFY", @_)->response() == CMD_OK }
520 sub _EXPN { shift->command("EXPN", @_)->response() == CMD_OK }
521 sub _HELP { shift->command("HELP", @_)->response() == CMD_OK }
522 sub _RSET { shift->command("RSET")->response() == CMD_OK }
523 sub _NOOP { shift->command("NOOP")->response() == CMD_OK }
524 sub _QUIT { shift->command("QUIT")->response() == CMD_OK }
525 sub _DATA { shift->command("DATA")->response() == CMD_MORE }
526 sub _BDAT { shift->command("BDAT", @_) }
527 sub _TURN { shift->unsupported(@_); }
528 sub _ETRN { shift->command("ETRN", @_)->response() == CMD_OK }
529 sub _AUTH { shift->command("AUTH", @_)->response() == CMD_OK }
537 Net::SMTP - Simple Mail Transfer Protocol Client
544 $smtp = Net::SMTP->new('mailhost');
545 $smtp = Net::SMTP->new('mailhost', Timeout => 60);
549 This module implements a client interface to the SMTP and ESMTP
550 protocol, enabling a perl5 application to talk to SMTP servers. This
551 documentation assumes that you are familiar with the concepts of the
552 SMTP protocol described in RFC821.
554 A new Net::SMTP object must be created with the I<new> method. Once
555 this has been done, all SMTP commands are accessed through this object.
557 The Net::SMTP class is a subclass of Net::Cmd and IO::Socket::INET.
561 This example prints the mail domain name of the SMTP server known as mailhost:
563 #!/usr/local/bin/perl -w
567 $smtp = Net::SMTP->new('mailhost');
568 print $smtp->domain,"\n";
571 This example sends a small message to the postmaster at the SMTP server
574 #!/usr/local/bin/perl -w
578 $smtp = Net::SMTP->new('mailhost');
580 $smtp->mail($ENV{USER});
581 $smtp->to('postmaster');
584 $smtp->datasend("To: postmaster\n");
585 $smtp->datasend("\n");
586 $smtp->datasend("A simple test message\n");
595 =item new ( [ HOST ] [, OPTIONS ] )
597 This is the constructor for a new Net::SMTP object. C<HOST> is the
598 name of the remote host to which an SMTP connection is required.
600 C<HOST> is optional. If C<HOST> is not given then it may instead be
601 passed as the C<Host> option described below. If neither is given then
602 the C<SMTP_Hosts> specified in C<Net::Config> will be used.
604 C<OPTIONS> are passed in a hash like fashion, using key and value pairs.
605 Possible options are:
607 B<Hello> - SMTP requires that you identify yourself. This option
608 specifies a string to pass as your mail domain. If not given localhost.localdomain
611 B<Host> - SMTP host to connect to. It may be a single scalar, as defined for
612 the C<PeerAddr> option in L<IO::Socket::INET>, or a reference to
613 an array with hosts to try in turn. The L</host> method will return the value
614 which was used to connect to the host.
616 B<LocalAddr> and B<LocalPort> - These parameters are passed directly
617 to IO::Socket to allow binding the socket to a local port.
619 B<Timeout> - Maximum time, in seconds, to wait for a response from the
620 SMTP server (default: 120)
622 B<ExactAddresses> - If true the all ADDRESS arguments must be as
623 defined by C<addr-spec> in RFC2822. If not given, or false, then
624 Net::SMTP will attempt to extract the address from the value passed.
626 B<Debug> - Enable debugging information
632 $smtp = Net::SMTP->new('mailhost',
633 Hello => 'my.mail.domain',
639 $smtp = Net::SMTP->new(
641 Hello => 'my.mail.domain',
646 # Connect to the default server from Net::config
647 $smtp = Net::SMTP->new(
648 Hello => 'my.mail.domain',
656 Unless otherwise stated all methods return either a I<true> or I<false>
657 value, with I<true> meaning that the operation was a success. When a method
658 states that it returns a value, failure will be returned as I<undef> or an
665 Returns the banner message which the server replied with when the
666 initial connection was made.
670 Returns the domain that the remote SMTP server identified itself as during
673 =item hello ( DOMAIN )
675 Tell the remote server the mail domain which you are in using the EHLO
676 command (or HELO if EHLO fails). Since this method is invoked
677 automatically when the Net::SMTP object is constructed the user should
678 normally not have to call it manually.
682 Returns the value used by the constructor, and passed to IO::Socket::INET,
683 to connect to the host.
685 =item etrn ( DOMAIN )
687 Request a queue run for the DOMAIN given.
689 =item auth ( USERNAME, PASSWORD )
691 Attempt SASL authentication.
693 =item mail ( ADDRESS [, OPTIONS] )
695 =item send ( ADDRESS )
697 =item send_or_mail ( ADDRESS )
699 =item send_and_mail ( ADDRESS )
701 Send the appropriate command to the server MAIL, SEND, SOML or SAML. C<ADDRESS>
702 is the address of the sender. This initiates the sending of a message. The
703 method C<recipient> should be called for each address that the message is to
706 The C<mail> method can some additional ESMTP OPTIONS which is passed
707 in hash like fashion, using key and value pairs. Possible options are:
710 Return => "FULL" | "HDRS"
711 Bits => "7" | "8" | "binary"
712 Transaction => <ADDRESS>
713 Envelope => <ENVID> # xtext-encodes its argument
714 ENVID => <ENVID> # similar to Envelope, but expects argument encoded
716 AUTH => <submitter> # encoded address according to RFC 2554
718 The C<Return> and C<Envelope> parameters are used for DSN (Delivery
719 Status Notification).
721 The submitter address in C<AUTH> option is expected to be in a format as
722 required by RFC 2554, in an RFC2821-quoted form and xtext-encoded, or <> .
726 Reset the status of the server. This may be called after a message has been
727 initiated, but before any data has been sent, to cancel the sending of the
730 =item recipient ( ADDRESS [, ADDRESS, [...]] [, OPTIONS ] )
732 Notify the server that the current message should be sent to all of the
733 addresses given. Each address is sent as a separate command to the server.
734 Should the sending of any address result in a failure then the process is
735 aborted and a I<false> value is returned. It is up to the user to call
736 C<reset> if they so desire.
738 The C<recipient> method can also pass additional case-sensitive OPTIONS as an
739 anonymous hash using key and value pairs. Possible options are:
741 Notify => ['NEVER'] or ['SUCCESS','FAILURE','DELAY'] (see below)
743 SkipBad => 1 (to ignore bad addresses)
745 If C<SkipBad> is true the C<recipient> will not return an error when a bad
746 address is encountered and it will return an array of addresses that did
749 $smtp->recipient($recipient1,$recipient2); # Good
750 $smtp->recipient($recipient1,$recipient2, { SkipBad => 1 }); # Good
751 $smtp->recipient($recipient1,$recipient2, { Notify => ['FAILURE','DELAY'], SkipBad => 1 }); # Good
752 @goodrecips=$smtp->recipient(@recipients, { Notify => ['FAILURE'], SkipBad => 1 }); # Good
753 $smtp->recipient("$recipient,$recipient2"); # BAD
755 Notify is used to request Delivery Status Notifications (DSNs), but your
756 SMTP/ESMTP service may not respect this request depending upon its version and
757 your site's SMTP configuration.
759 Leaving out the Notify option usually defaults an SMTP service to its default
760 behavior equivalent to ['FAILURE'] notifications only, but again this may be
761 dependent upon your site's SMTP configuration.
763 The NEVER keyword must appear by itself if used within the Notify option and "requests
764 that a DSN not be returned to the sender under any conditions."
766 {Notify => ['NEVER']}
768 $smtp->recipient(@recipients, { Notify => ['NEVER'], SkipBad => 1 }); # Good
770 You may use any combination of these three values 'SUCCESS','FAILURE','DELAY' in
771 the anonymous array reference as defined by RFC3461 (see http://rfc.net/rfc3461.html
772 for more information. Note: quotations in this topic from same.).
774 A Notify parameter of 'SUCCESS' or 'FAILURE' "requests that a DSN be issued on
775 successful delivery or delivery failure, respectively."
777 A Notify parameter of 'DELAY' "indicates the sender's willingness to receive
778 delayed DSNs. Delayed DSNs may be issued if delivery of a message has been
779 delayed for an unusual amount of time (as determined by the Message Transfer
780 Agent (MTA) at which the message is delayed), but the final delivery status
781 (whether successful or failure) cannot be determined. The absence of the DELAY
782 keyword in a NOTIFY parameter requests that a "delayed" DSN NOT be issued under
785 {Notify => ['SUCCESS','FAILURE','DELAY']}
787 $smtp->recipient(@recipients, { Notify => ['FAILURE','DELAY'], SkipBad => 1 }); # Good
789 ORcpt is also part of the SMTP DSN extension according to RFC3461.
790 It is used to pass along the original recipient that the mail was first
791 sent to. The machine that generates a DSN will use this address to inform
792 the sender, because he can't know if recipients get rewritten by mail servers.
793 It is expected to be in a format as required by RFC3461, xtext-encoded.
795 =item to ( ADDRESS [, ADDRESS [...]] )
797 =item cc ( ADDRESS [, ADDRESS [...]] )
799 =item bcc ( ADDRESS [, ADDRESS [...]] )
801 Synonyms for C<recipient>.
803 =item data ( [ DATA ] )
805 Initiate the sending of the data from the current message.
807 C<DATA> may be a reference to a list or a list. If specified the contents
808 of C<DATA> and a termination string C<".\r\n"> is sent to the server. And the
809 result will be true if the data was accepted.
811 If C<DATA> is not specified then the result will indicate that the server
812 wishes the data to be sent. The data must then be sent using the C<datasend>
813 and C<dataend> methods described in L<Net::Cmd>.
815 =item expand ( ADDRESS )
817 Request the server to expand the given address Returns an array
818 which contains the text read from the server.
820 =item verify ( ADDRESS )
822 Verify that C<ADDRESS> is a legitimate mailing address.
824 Most sites usually disable this feature in their SMTP service configuration.
825 Use "Debug => 1" option under new() to see if disabled.
827 =item help ( [ $subject ] )
829 Request help text from the server. Returns the text or undef upon failure
833 Send the QUIT command to the remote SMTP server and close the socket connection.
839 Net::SMTP attempts to DWIM with addresses that are passed. For
840 example an application might extract The From: line from an email
841 and pass that to mail(). While this may work, it is not recommended.
842 The application should really use a module like L<Mail::Address>
843 to extract the mail address and pass that.
845 If C<ExactAddresses> is passed to the constructor, then addresses
846 should be a valid rfc2821-quoted address, although Net::SMTP will
847 accept accept the address surrounded by angle brackets.
849 funny user@domain WRONG
850 "funny user"@domain RIGHT, recommended
851 <"funny user"@domain> OK
859 Graham Barr <gbarr@pobox.com>
863 Copyright (c) 1995-2004 Graham Barr. All rights reserved.
864 This program is free software; you can redistribute it and/or modify
865 it under the same terms as Perl itself.