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;
33 $host=delete $arg{Host};
35 my $hosts = defined $host ? $host : $NetConfig{smtp_hosts};
39 foreach $h (@{ref($hosts) ? $hosts : [ $hosts ]})
41 $obj = $type->SUPER::new(PeerAddr => ($host = $h),
42 PeerPort => $arg{Port} || 'smtp(25)',
43 LocalAddr => $arg{LocalAddr},
44 LocalPort => $arg{LocalPort},
46 Timeout => defined $arg{Timeout}
57 $obj->debug(exists $arg{Debug} ? $arg{Debug} : undef);
59 unless ($obj->response() == CMD_OK)
65 ${*$obj}{'net_smtp_exact_addr'} = $arg{ExactAddresses};
66 ${*$obj}{'net_smtp_host'} = $host;
68 (${*$obj}{'net_smtp_banner'}) = $obj->message;
69 (${*$obj}{'net_smtp_domain'}) = $obj->message =~ /\A\s*(\S+)/;
71 unless($obj->hello($arg{Hello} || ""))
82 ${*$me}{'net_smtp_host'};
86 ## User interface methods
93 return ${*$me}{'net_smtp_banner'} || undef;
100 return ${*$me}{'net_smtp_domain'} || undef;
105 defined($self->supports('ETRN',500,["Command unknown: 'ETRN'"])) &&
110 my ($self, $username, $password) = @_;
113 require MIME::Base64;
114 require Authen::SASL;
115 } or $self->set_status(500,["Need MIME::Base64 and Authen::SASL todo auth"]), return 0;
117 my $mechanisms = $self->supports('AUTH',500,["Command unknown: 'AUTH'"]);
118 return unless defined $mechanisms;
122 if (ref($username) and UNIVERSAL::isa($username,'Authen::SASL')) {
124 $sasl->mechanism($mechanisms);
127 die "auth(username, password)" if not length $username;
128 $sasl = Authen::SASL->new(mechanism=> $mechanisms,
129 callback => { user => $username,
131 authname => $username,
135 # We should probably allow the user to pass the host, but I don't
136 # currently know and SASL mechanisms that are used by smtp that need it
137 my $client = $sasl->client_new('smtp',${*$self}{'net_smtp_host'},0);
138 my $str = $client->client_start;
139 # We dont support sasl mechanisms that encrypt the socket traffic.
140 # todo that we would really need to change the ISA hierarchy
141 # so we dont inherit from IO::Socket, but instead hold it in an attribute
143 my @cmd = ("AUTH", $client->mechanism);
146 push @cmd, MIME::Base64::encode_base64($str,'')
147 if defined $str and length $str;
149 while (($code = $self->command(@cmd)->response()) == CMD_MORE) {
150 @cmd = (MIME::Base64::encode_base64(
151 $client->client_step(
152 MIME::Base64::decode_base64(
165 my $domain = shift || "localhost.localdomain";
166 my $ok = $me->_EHLO($domain);
167 my @msg = $me->message;
171 my $h = ${*$me}{'net_smtp_esmtp'} = {};
175 if $ln =~ /(\w+)\b[= \t]*([^\n]*)/;
178 elsif($me->status == CMD_ERROR)
181 if $ok = $me->_HELO($domain);
184 return undef unless $ok;
186 $msg[0] =~ /\A\s*(\S+)/;
193 return ${*$self}{'net_smtp_esmtp'}->{$cmd}
194 if exists ${*$self}{'net_smtp_esmtp'}->{$cmd};
195 $self->set_status(@_)
203 $addr = "" unless defined $addr;
205 if (${*$self}{'net_smtp_exact_addr'}) {
206 return $1 if $addr =~ /^\s*(<.*>)\s*$/s;
209 return $1 if $addr =~ /(<[^>]*>)/;
210 $addr =~ s/^\s+|\s+$//sg;
219 my $addr = _addr($me, shift);
227 if(exists ${*$me}{'net_smtp_esmtp'})
229 my $esmtp = ${*$me}{'net_smtp_esmtp'};
231 if(defined($v = delete $opt{Size}))
233 if(exists $esmtp->{SIZE})
235 $opts .= sprintf " SIZE=%d", $v + 0
239 carp 'Net::SMTP::mail: SIZE option not supported by host';
243 if(defined($v = delete $opt{Return}))
245 if(exists $esmtp->{DSN})
247 $opts .= " RET=" . ((uc($v) eq "FULL") ? "FULL" : "HDRS");
251 carp 'Net::SMTP::mail: DSN option not supported by host';
255 if(defined($v = delete $opt{Bits}))
259 if(exists $esmtp->{'8BITMIME'})
261 $opts .= " BODY=8BITMIME";
265 carp 'Net::SMTP::mail: 8BITMIME option not supported by host';
268 elsif($v eq "binary")
270 if(exists $esmtp->{'BINARYMIME'} && exists $esmtp->{'CHUNKING'})
272 $opts .= " BODY=BINARYMIME";
273 ${*$me}{'net_smtp_chunking'} = 1;
277 carp 'Net::SMTP::mail: BINARYMIME option not supported by host';
280 elsif(exists $esmtp->{'8BITMIME'} or exists $esmtp->{'BINARYMIME'})
282 $opts .= " BODY=7BIT";
286 carp 'Net::SMTP::mail: 8BITMIME and BINARYMIME options not supported by host';
290 if(defined($v = delete $opt{Transaction}))
292 if(exists $esmtp->{CHECKPOINT})
294 $opts .= " TRANSID=" . _addr($me, $v);
298 carp 'Net::SMTP::mail: CHECKPOINT option not supported by host';
302 if(defined($v = delete $opt{Envelope}))
304 if(exists $esmtp->{DSN})
306 $v =~ s/([^\041-\176]|=|\+)/sprintf "+%02x", ord($1)/sge;
311 carp 'Net::SMTP::mail: DSN option not supported by host';
315 if(defined($v = delete $opt{XVERP}))
317 if(exists $esmtp->{'XVERP'})
323 carp 'Net::SMTP::mail: XVERP option not supported by host';
327 carp 'Net::SMTP::recipient: unknown option(s) '
328 . join(" ", keys %opt)
334 carp 'Net::SMTP::mail: ESMTP not supported by host - options discarded :-(';
338 $me->_MAIL("FROM:".$addr.$opts);
341 sub send { my $me = shift; $me->_SEND("FROM:" . _addr($me, $_[0])) }
342 sub send_or_mail { my $me = shift; $me->_SOML("FROM:" . _addr($me, $_[0])) }
343 sub send_and_mail { my $me = shift; $me->_SAML("FROM:" . _addr($me, $_[0])) }
350 if(exists ${*$me}{'net_smtp_lastch'});
362 if(@_ && ref($_[-1]))
364 my %opt = %{pop(@_)};
367 $skip_bad = delete $opt{'SkipBad'};
369 if(exists ${*$smtp}{'net_smtp_esmtp'})
371 my $esmtp = ${*$smtp}{'net_smtp_esmtp'};
373 if(defined($v = delete $opt{Notify}))
375 if(exists $esmtp->{DSN})
377 $opts .= " NOTIFY=" . join(",",map { uc $_ } @$v)
381 carp 'Net::SMTP::recipient: DSN option not supported by host';
385 carp 'Net::SMTP::recipient: unknown option(s) '
386 . join(" ", keys %opt)
392 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'})
423 carp 'Net::SMTP::data: CHUNKING extension in use, must call bdat instead';
427 my $ok = $me->_DATA() && $me->datasend(@_);
429 $ok && @_ ? $me->dataend
438 if(exists ${*$me}{'net_smtp_chunking'})
442 $me->_BDAT(length $data) && $me->rawdatasend($data) &&
443 $me->response() == CMD_OK;
447 carp 'Net::SMTP::bdat: CHUNKING extension is not in use, call data instead';
455 if(exists ${*$me}{'net_smtp_chunking'})
459 $me->_BDAT(length $data, "LAST") && $me->rawdatasend($data) &&
460 $me->response() == CMD_OK;
464 carp 'Net::SMTP::bdat: CHUNKING extension is not in use, call data instead';
470 return unless $me->_DATA();
478 $me->_EXPN(@_) ? ($me->message)
483 sub verify { shift->_VRFY(@_) }
489 $me->_HELP(@_) ? scalar $me->message
510 sub _EHLO { shift->command("EHLO", @_)->response() == CMD_OK }
511 sub _HELO { shift->command("HELO", @_)->response() == CMD_OK }
512 sub _MAIL { shift->command("MAIL", @_)->response() == CMD_OK }
513 sub _RCPT { shift->command("RCPT", @_)->response() == CMD_OK }
514 sub _SEND { shift->command("SEND", @_)->response() == CMD_OK }
515 sub _SAML { shift->command("SAML", @_)->response() == CMD_OK }
516 sub _SOML { shift->command("SOML", @_)->response() == CMD_OK }
517 sub _VRFY { shift->command("VRFY", @_)->response() == CMD_OK }
518 sub _EXPN { shift->command("EXPN", @_)->response() == CMD_OK }
519 sub _HELP { shift->command("HELP", @_)->response() == CMD_OK }
520 sub _RSET { shift->command("RSET")->response() == CMD_OK }
521 sub _NOOP { shift->command("NOOP")->response() == CMD_OK }
522 sub _QUIT { shift->command("QUIT")->response() == CMD_OK }
523 sub _DATA { shift->command("DATA")->response() == CMD_MORE }
524 sub _BDAT { shift->command("BDAT", @_) }
525 sub _TURN { shift->unsupported(@_); }
526 sub _ETRN { shift->command("ETRN", @_)->response() == CMD_OK }
527 sub _AUTH { shift->command("AUTH", @_)->response() == CMD_OK }
535 Net::SMTP - Simple Mail Transfer Protocol Client
542 $smtp = Net::SMTP->new('mailhost');
543 $smtp = Net::SMTP->new('mailhost', Timeout => 60);
547 This module implements a client interface to the SMTP and ESMTP
548 protocol, enabling a perl5 application to talk to SMTP servers. This
549 documentation assumes that you are familiar with the concepts of the
550 SMTP protocol described in RFC821.
552 A new Net::SMTP object must be created with the I<new> method. Once
553 this has been done, all SMTP commands are accessed through this object.
555 The Net::SMTP class is a subclass of Net::Cmd and IO::Socket::INET.
559 This example prints the mail domain name of the SMTP server known as mailhost:
561 #!/usr/local/bin/perl -w
565 $smtp = Net::SMTP->new('mailhost');
566 print $smtp->domain,"\n";
569 This example sends a small message to the postmaster at the SMTP server
572 #!/usr/local/bin/perl -w
576 $smtp = Net::SMTP->new('mailhost');
578 $smtp->mail($ENV{USER});
579 $smtp->to('postmaster');
582 $smtp->datasend("To: postmaster\n");
583 $smtp->datasend("\n");
584 $smtp->datasend("A simple test message\n");
593 =item new ( [ HOST ] [, OPTIONS ] )
595 This is the constructor for a new Net::SMTP object. C<HOST> is the
596 name of the remote host to which an SMTP connection is required.
598 C<HOST> is optional. If C<HOST> is not given then it may instead be
599 passed as the C<Host> option described below. If neither is given then
600 the C<SMTP_Hosts> specified in C<Net::Config> will be used.
602 C<OPTIONS> are passed in a hash like fashion, using key and value pairs.
603 Possible options are:
605 B<Hello> - SMTP requires that you identify yourself. This option
606 specifies a string to pass as your mail domain. If not given localhost.localdomain
609 B<Host> - SMTP host to connect to. It may be a single scalar, as defined for
610 the C<PeerAddr> option in L<IO::Socket::INET>, or a reference to
611 an array with hosts to try in turn. The L</host> method will return the value
612 which was used to connect to the host.
614 B<LocalAddr> and B<LocalPort> - These parameters are passed directly
615 to IO::Socket to allow binding the socket to a local port.
617 B<Timeout> - Maximum time, in seconds, to wait for a response from the
618 SMTP server (default: 120)
620 B<ExactAddresses> - If true the all ADDRESS arguments must be as
621 defined by C<addr-spec> in RFC2822. If not given, or false, then
622 Net::SMTP will attempt to extract the address from the value passed.
624 B<Debug> - Enable debugging information
630 $smtp = Net::SMTP->new('mailhost',
631 Hello => 'my.mail.domain'
637 $smtp = Net::SMTP->new(
639 Hello => 'my.mail.domain'
644 # Connect to the default server from Net::config
645 $smtp = Net::SMTP->new(
646 Hello => 'my.mail.domain'
654 Unless otherwise stated all methods return either a I<true> or I<false>
655 value, with I<true> meaning that the operation was a success. When a method
656 states that it returns a value, failure will be returned as I<undef> or an
663 Returns the banner message which the server replied with when the
664 initial connection was made.
668 Returns the domain that the remote SMTP server identified itself as during
671 =item hello ( DOMAIN )
673 Tell the remote server the mail domain which you are in using the EHLO
674 command (or HELO if EHLO fails). Since this method is invoked
675 automatically when the Net::SMTP object is constructed the user should
676 normally not have to call it manually.
680 Returns the value used by the constructor, and passed to IO::Socket::INET,
681 to connect to the host.
683 =item etrn ( DOMAIN )
685 Request a queue run for the DOMAIN given.
687 =item auth ( USERNAME, PASSWORD )
689 Attempt SASL authentication.
691 =item mail ( ADDRESS [, OPTIONS] )
693 =item send ( ADDRESS )
695 =item send_or_mail ( ADDRESS )
697 =item send_and_mail ( ADDRESS )
699 Send the appropriate command to the server MAIL, SEND, SOML or SAML. C<ADDRESS>
700 is the address of the sender. This initiates the sending of a message. The
701 method C<recipient> should be called for each address that the message is to
704 The C<mail> method can some additional ESMTP OPTIONS which is passed
705 in hash like fashion, using key and value pairs. Possible options are:
708 Return => "FULL" | "HDRS"
709 Bits => "7" | "8" | "binary"
710 Transaction => <ADDRESS>
714 The C<Return> and C<Envelope> parameters are used for DSN (Delivery
715 Status Notification).
719 Reset the status of the server. This may be called after a message has been
720 initiated, but before any data has been sent, to cancel the sending of the
723 =item recipient ( ADDRESS [, ADDRESS, [...]] [, OPTIONS ] )
725 Notify the server that the current message should be sent to all of the
726 addresses given. Each address is sent as a separate command to the server.
727 Should the sending of any address result in a failure then the process is
728 aborted and a I<false> value is returned. It is up to the user to call
729 C<reset> if they so desire.
731 The C<recipient> method can also pass additional case-sensitive OPTIONS as an
732 anonymous hash using key and value pairs. Possible options are:
734 Notify => ['NEVER'] or ['SUCCESS','FAILURE','DELAY'] (see below)
735 SkipBad => 1 (to ignore bad addresses)
737 If C<SkipBad> is true the C<recipient> will not return an error when a bad
738 address is encountered and it will return an array of addresses that did
741 $smtp->recipient($recipient1,$recipient2); # Good
742 $smtp->recipient($recipient1,$recipient2, { SkipBad => 1 }); # Good
743 $smtp->recipient($recipient1,$recipient2, { Notify => ['FAILURE','DELAY'], SkipBad => 1 }); # Good
744 @goodrecips=$smtp->recipient(@recipients, { Notify => ['FAILURE'], SkipBad => 1 }); # Good
745 $smtp->recipient("$recipient,$recipient2"); # BAD
747 Notify is used to request Delivery Status Notifications (DSNs), but your
748 SMTP/ESMTP service may not respect this request depending upon its version and
749 your site's SMTP configuration.
751 Leaving out the Notify option usually defaults an SMTP service to its default
752 behavior equivalent to ['FAILURE'] notifications only, but again this may be
753 dependent upon your site's SMTP configuration.
755 The NEVER keyword must appear by itself if used within the Notify option and "requests
756 that a DSN not be returned to the sender under any conditions."
758 {Notify => ['NEVER']}
760 $smtp->recipient(@recipients, { Notify => ['NEVER'], SkipBad => 1 }); # Good
762 You may use any combination of these three values 'SUCCESS','FAILURE','DELAY' in
763 the anonymous array reference as defined by RFC3461 (see http://rfc.net/rfc3461.html
764 for more information. Note: quotations in this topic from same.).
766 A Notify parameter of 'SUCCESS' or 'FAILURE' "requests that a DSN be issued on
767 successful delivery or delivery failure, respectively."
769 A Notify parameter of 'DELAY' "indicates the sender's willingness to receive
770 delayed DSNs. Delayed DSNs may be issued if delivery of a message has been
771 delayed for an unusual amount of time (as determined by the Message Transfer
772 Agent (MTA) at which the message is delayed), but the final delivery status
773 (whether successful or failure) cannot be determined. The absence of the DELAY
774 keyword in a NOTIFY parameter requests that a "delayed" DSN NOT be issued under
777 {Notify => ['SUCCESS','FAILURE','DELAY']}
779 $smtp->recipient(@recipients, { Notify => ['FAILURE','DELAY'], SkipBad => 1 }); # Good
781 =item to ( ADDRESS [, ADDRESS [...]] )
783 =item cc ( ADDRESS [, ADDRESS [...]] )
785 =item bcc ( ADDRESS [, ADDRESS [...]] )
787 Synonyms for C<recipient>.
789 =item data ( [ DATA ] )
791 Initiate the sending of the data from the current message.
793 C<DATA> may be a reference to a list or a list. If specified the contents
794 of C<DATA> and a termination string C<".\r\n"> is sent to the server. And the
795 result will be true if the data was accepted.
797 If C<DATA> is not specified then the result will indicate that the server
798 wishes the data to be sent. The data must then be sent using the C<datasend>
799 and C<dataend> methods described in L<Net::Cmd>.
801 =item expand ( ADDRESS )
803 Request the server to expand the given address Returns an array
804 which contains the text read from the server.
806 =item verify ( ADDRESS )
808 Verify that C<ADDRESS> is a legitimate mailing address.
810 Most sites usually disable this feature in their SMTP service configuration.
811 Use "Debug => 1" option under new() to see if disabled.
813 =item help ( [ $subject ] )
815 Request help text from the server. Returns the text or undef upon failure
819 Send the QUIT command to the remote SMTP server and close the socket connection.
825 Net::SMTP attempts to DWIM with addresses that are passed. For
826 example an application might extract The From: line from an email
827 and pass that to mail(). While this may work, it is not recommended.
828 The application should really use a module like L<Mail::Address>
829 to extract the mail address and pass that.
831 If C<ExactAddresses> is passed to the constructor, then addresses
832 should be a valid rfc2821-quoted address, although Net::SMTP will
833 accept accept the address surrounded by angle brackets.
835 funny user@domain WRONG
836 "funny user"@domain RIGHT, recommended
837 <"funny user"@domain> OK
845 Graham Barr <gbarr@pobox.com>
849 Copyright (c) 1995-2004 Graham Barr. All rights reserved.
850 This program is free software; you can redistribute it and/or modify
851 it under the same terms as Perl itself.