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 if(defined($v = delete $opt{ORcpt}))
387 if(exists $esmtp->{DSN})
389 $opts .= " ORCPT=" . $v;
393 carp 'Net::SMTP::recipient: DSN option not supported by host';
397 carp 'Net::SMTP::recipient: unknown option(s) '
398 . join(" ", keys %opt)
404 carp 'Net::SMTP::recipient: ESMTP not supported by host - options discarded :-(';
412 if($smtp->_RCPT("TO:" . _addr($smtp, $addr) . $opts)) {
413 push(@ok,$addr) if $skip_bad;
420 return $skip_bad ? @ok : 1;
433 if(exists ${*$me}{'net_smtp_chunking'})
435 carp 'Net::SMTP::data: CHUNKING extension in use, must call bdat instead';
439 my $ok = $me->_DATA() && $me->datasend(@_);
441 $ok && @_ ? $me->dataend
450 if(exists ${*$me}{'net_smtp_chunking'})
454 $me->_BDAT(length $data) && $me->rawdatasend($data) &&
455 $me->response() == CMD_OK;
459 carp 'Net::SMTP::bdat: CHUNKING extension is not in use, call data instead';
467 if(exists ${*$me}{'net_smtp_chunking'})
471 $me->_BDAT(length $data, "LAST") && $me->rawdatasend($data) &&
472 $me->response() == CMD_OK;
476 carp 'Net::SMTP::bdat: CHUNKING extension is not in use, call data instead';
482 return unless $me->_DATA();
490 $me->_EXPN(@_) ? ($me->message)
495 sub verify { shift->_VRFY(@_) }
501 $me->_HELP(@_) ? scalar $me->message
522 sub _EHLO { shift->command("EHLO", @_)->response() == CMD_OK }
523 sub _HELO { shift->command("HELO", @_)->response() == CMD_OK }
524 sub _MAIL { shift->command("MAIL", @_)->response() == CMD_OK }
525 sub _RCPT { shift->command("RCPT", @_)->response() == CMD_OK }
526 sub _SEND { shift->command("SEND", @_)->response() == CMD_OK }
527 sub _SAML { shift->command("SAML", @_)->response() == CMD_OK }
528 sub _SOML { shift->command("SOML", @_)->response() == CMD_OK }
529 sub _VRFY { shift->command("VRFY", @_)->response() == CMD_OK }
530 sub _EXPN { shift->command("EXPN", @_)->response() == CMD_OK }
531 sub _HELP { shift->command("HELP", @_)->response() == CMD_OK }
532 sub _RSET { shift->command("RSET")->response() == CMD_OK }
533 sub _NOOP { shift->command("NOOP")->response() == CMD_OK }
534 sub _QUIT { shift->command("QUIT")->response() == CMD_OK }
535 sub _DATA { shift->command("DATA")->response() == CMD_MORE }
536 sub _BDAT { shift->command("BDAT", @_) }
537 sub _TURN { shift->unsupported(@_); }
538 sub _ETRN { shift->command("ETRN", @_)->response() == CMD_OK }
539 sub _AUTH { shift->command("AUTH", @_)->response() == CMD_OK }
547 Net::SMTP - Simple Mail Transfer Protocol Client
554 $smtp = Net::SMTP->new('mailhost');
555 $smtp = Net::SMTP->new('mailhost', Timeout => 60);
559 This module implements a client interface to the SMTP and ESMTP
560 protocol, enabling a perl5 application to talk to SMTP servers. This
561 documentation assumes that you are familiar with the concepts of the
562 SMTP protocol described in RFC821.
564 A new Net::SMTP object must be created with the I<new> method. Once
565 this has been done, all SMTP commands are accessed through this object.
567 The Net::SMTP class is a subclass of Net::Cmd and IO::Socket::INET.
571 This example prints the mail domain name of the SMTP server known as mailhost:
573 #!/usr/local/bin/perl -w
577 $smtp = Net::SMTP->new('mailhost');
578 print $smtp->domain,"\n";
581 This example sends a small message to the postmaster at the SMTP server
584 #!/usr/local/bin/perl -w
588 $smtp = Net::SMTP->new('mailhost');
590 $smtp->mail($ENV{USER});
591 $smtp->to('postmaster');
594 $smtp->datasend("To: postmaster\n");
595 $smtp->datasend("\n");
596 $smtp->datasend("A simple test message\n");
605 =item new ( [ HOST ] [, OPTIONS ] )
607 This is the constructor for a new Net::SMTP object. C<HOST> is the
608 name of the remote host to which an SMTP connection is required.
610 C<HOST> is optional. If C<HOST> is not given then it may instead be
611 passed as the C<Host> option described below. If neither is given then
612 the C<SMTP_Hosts> specified in C<Net::Config> will be used.
614 C<OPTIONS> are passed in a hash like fashion, using key and value pairs.
615 Possible options are:
617 B<Hello> - SMTP requires that you identify yourself. This option
618 specifies a string to pass as your mail domain. If not given localhost.localdomain
621 B<Host> - SMTP host to connect to. It may be a single scalar, as defined for
622 the C<PeerAddr> option in L<IO::Socket::INET>, or a reference to
623 an array with hosts to try in turn. The L</host> method will return the value
624 which was used to connect to the host.
626 B<LocalAddr> and B<LocalPort> - These parameters are passed directly
627 to IO::Socket to allow binding the socket to a local port.
629 B<Timeout> - Maximum time, in seconds, to wait for a response from the
630 SMTP server (default: 120)
632 B<ExactAddresses> - If true the all ADDRESS arguments must be as
633 defined by C<addr-spec> in RFC2822. If not given, or false, then
634 Net::SMTP will attempt to extract the address from the value passed.
636 B<Debug> - Enable debugging information
642 $smtp = Net::SMTP->new('mailhost',
643 Hello => 'my.mail.domain',
649 $smtp = Net::SMTP->new(
651 Hello => 'my.mail.domain',
656 # Connect to the default server from Net::config
657 $smtp = Net::SMTP->new(
658 Hello => 'my.mail.domain',
666 Unless otherwise stated all methods return either a I<true> or I<false>
667 value, with I<true> meaning that the operation was a success. When a method
668 states that it returns a value, failure will be returned as I<undef> or an
675 Returns the banner message which the server replied with when the
676 initial connection was made.
680 Returns the domain that the remote SMTP server identified itself as during
683 =item hello ( DOMAIN )
685 Tell the remote server the mail domain which you are in using the EHLO
686 command (or HELO if EHLO fails). Since this method is invoked
687 automatically when the Net::SMTP object is constructed the user should
688 normally not have to call it manually.
692 Returns the value used by the constructor, and passed to IO::Socket::INET,
693 to connect to the host.
695 =item etrn ( DOMAIN )
697 Request a queue run for the DOMAIN given.
699 =item auth ( USERNAME, PASSWORD )
701 Attempt SASL authentication.
703 =item mail ( ADDRESS [, OPTIONS] )
705 =item send ( ADDRESS )
707 =item send_or_mail ( ADDRESS )
709 =item send_and_mail ( ADDRESS )
711 Send the appropriate command to the server MAIL, SEND, SOML or SAML. C<ADDRESS>
712 is the address of the sender. This initiates the sending of a message. The
713 method C<recipient> should be called for each address that the message is to
716 The C<mail> method can some additional ESMTP OPTIONS which is passed
717 in hash like fashion, using key and value pairs. Possible options are:
720 Return => "FULL" | "HDRS"
721 Bits => "7" | "8" | "binary"
722 Transaction => <ADDRESS>
726 The C<Return> and C<Envelope> parameters are used for DSN (Delivery
727 Status Notification).
731 Reset the status of the server. This may be called after a message has been
732 initiated, but before any data has been sent, to cancel the sending of the
735 =item recipient ( ADDRESS [, ADDRESS, [...]] [, OPTIONS ] )
737 Notify the server that the current message should be sent to all of the
738 addresses given. Each address is sent as a separate command to the server.
739 Should the sending of any address result in a failure then the process is
740 aborted and a I<false> value is returned. It is up to the user to call
741 C<reset> if they so desire.
743 The C<recipient> method can also pass additional case-sensitive OPTIONS as an
744 anonymous hash using key and value pairs. Possible options are:
746 Notify => ['NEVER'] or ['SUCCESS','FAILURE','DELAY'] (see below)
748 SkipBad => 1 (to ignore bad addresses)
750 If C<SkipBad> is true the C<recipient> will not return an error when a bad
751 address is encountered and it will return an array of addresses that did
754 $smtp->recipient($recipient1,$recipient2); # Good
755 $smtp->recipient($recipient1,$recipient2, { SkipBad => 1 }); # Good
756 $smtp->recipient($recipient1,$recipient2, { Notify => ['FAILURE','DELAY'], SkipBad => 1 }); # Good
757 @goodrecips=$smtp->recipient(@recipients, { Notify => ['FAILURE'], SkipBad => 1 }); # Good
758 $smtp->recipient("$recipient,$recipient2"); # BAD
760 Notify is used to request Delivery Status Notifications (DSNs), but your
761 SMTP/ESMTP service may not respect this request depending upon its version and
762 your site's SMTP configuration.
764 Leaving out the Notify option usually defaults an SMTP service to its default
765 behavior equivalent to ['FAILURE'] notifications only, but again this may be
766 dependent upon your site's SMTP configuration.
768 The NEVER keyword must appear by itself if used within the Notify option and "requests
769 that a DSN not be returned to the sender under any conditions."
771 {Notify => ['NEVER']}
773 $smtp->recipient(@recipients, { Notify => ['NEVER'], SkipBad => 1 }); # Good
775 You may use any combination of these three values 'SUCCESS','FAILURE','DELAY' in
776 the anonymous array reference as defined by RFC3461 (see http://rfc.net/rfc3461.html
777 for more information. Note: quotations in this topic from same.).
779 A Notify parameter of 'SUCCESS' or 'FAILURE' "requests that a DSN be issued on
780 successful delivery or delivery failure, respectively."
782 A Notify parameter of 'DELAY' "indicates the sender's willingness to receive
783 delayed DSNs. Delayed DSNs may be issued if delivery of a message has been
784 delayed for an unusual amount of time (as determined by the Message Transfer
785 Agent (MTA) at which the message is delayed), but the final delivery status
786 (whether successful or failure) cannot be determined. The absence of the DELAY
787 keyword in a NOTIFY parameter requests that a "delayed" DSN NOT be issued under
790 {Notify => ['SUCCESS','FAILURE','DELAY']}
792 $smtp->recipient(@recipients, { Notify => ['FAILURE','DELAY'], SkipBad => 1 }); # Good
794 ORcpt is also part of the SMTP DSN extension according to RFC3461.
795 It is used to pass along the original recipient that the mail was first
796 sent to. The machine that generates a DSN will use this address to inform
797 the sender, because he can't know if recipients get rewritten by mail servers.
799 =item to ( ADDRESS [, ADDRESS [...]] )
801 =item cc ( ADDRESS [, ADDRESS [...]] )
803 =item bcc ( ADDRESS [, ADDRESS [...]] )
805 Synonyms for C<recipient>.
807 =item data ( [ DATA ] )
809 Initiate the sending of the data from the current message.
811 C<DATA> may be a reference to a list or a list. If specified the contents
812 of C<DATA> and a termination string C<".\r\n"> is sent to the server. And the
813 result will be true if the data was accepted.
815 If C<DATA> is not specified then the result will indicate that the server
816 wishes the data to be sent. The data must then be sent using the C<datasend>
817 and C<dataend> methods described in L<Net::Cmd>.
819 =item expand ( ADDRESS )
821 Request the server to expand the given address Returns an array
822 which contains the text read from the server.
824 =item verify ( ADDRESS )
826 Verify that C<ADDRESS> is a legitimate mailing address.
828 Most sites usually disable this feature in their SMTP service configuration.
829 Use "Debug => 1" option under new() to see if disabled.
831 =item help ( [ $subject ] )
833 Request help text from the server. Returns the text or undef upon failure
837 Send the QUIT command to the remote SMTP server and close the socket connection.
843 Net::SMTP attempts to DWIM with addresses that are passed. For
844 example an application might extract The From: line from an email
845 and pass that to mail(). While this may work, it is not recommended.
846 The application should really use a module like L<Mail::Address>
847 to extract the mail address and pass that.
849 If C<ExactAddresses> is passed to the constructor, then addresses
850 should be a valid rfc2821-quoted address, although Net::SMTP will
851 accept accept the address surrounded by angle brackets.
853 funny user@domain WRONG
854 "funny user"@domain RIGHT, recommended
855 <"funny user"@domain> OK
863 Graham Barr <gbarr@pobox.com>
867 Copyright (c) 1995-2004 Graham Barr. All rights reserved.
868 This program is free software; you can redistribute it and/or modify
869 it under the same terms as Perl itself.