3 # Copyright (c) 1995-1997 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);
19 $VERSION = "2.26"; # $Id: //depot/libnet/Net/SMTP.pm#31 $
21 @ISA = qw(Net::Cmd IO::Socket::INET);
26 my $type = ref($self) || $self;
28 $host = shift if @_ % 2;
30 my $hosts = defined $host ? $host : $NetConfig{smtp_hosts};
34 foreach $h (@{ref($hosts) ? $hosts : [ $hosts ]})
36 $obj = $type->SUPER::new(PeerAddr => ($host = $h),
37 PeerPort => $arg{Port} || 'smtp(25)',
38 LocalAddr => $arg{LocalAddr},
39 LocalPort => $arg{LocalPort},
41 Timeout => defined $arg{Timeout}
52 $obj->debug(exists $arg{Debug} ? $arg{Debug} : undef);
54 unless ($obj->response() == CMD_OK)
60 ${*$obj}{'net_smtp_exact_addr'} = $arg{ExactAddresses};
61 ${*$obj}{'net_smtp_host'} = $host;
63 (${*$obj}{'net_smtp_banner'}) = $obj->message;
64 (${*$obj}{'net_smtp_domain'}) = $obj->message =~ /\A\s*(\S+)/;
66 unless($obj->hello($arg{Hello} || ""))
76 ## User interface methods
83 return ${*$me}{'net_smtp_banner'} || undef;
90 return ${*$me}{'net_smtp_domain'} || undef;
95 defined($self->supports('ETRN',500,["Command unknown: 'ETRN'"])) &&
100 my ($self, $username, $password) = @_;
102 require MIME::Base64;
103 require Authen::SASL;
105 my $mechanisms = $self->supports('AUTH',500,["Command unknown: 'AUTH'"]);
106 return unless defined $mechanisms;
110 if (ref($username) and UNIVERSAL::isa($username,'Authen::SASL')) {
112 $sasl->mechanism($mechanisms);
115 die "auth(username, password)" if not length $username;
116 $sasl = Authen::SASL->new(mechanism=> $mechanisms,
117 callback => { user => $username,
119 authname => $username,
123 # We should probably allow the user to pass the host, but I don't
124 # currently know and SASL mechanisms that are used by smtp that need it
125 my $client = $sasl->client_new('smtp',${*$self}{'net_smtp_host'},0);
126 my $str = $client->client_start;
127 # We dont support sasl mechanisms that encrypt the socket traffic.
128 # todo that we would really need to change the ISA hierarchy
129 # so we dont inherit from IO::Socket, but instead hold it in an attribute
131 my @cmd = ("AUTH", $client->mechanism);
134 push @cmd, MIME::Base64::encode_base64($str,'')
135 if defined $str and length $str;
137 while (($code = $self->command(@cmd)->response()) == CMD_MORE) {
138 @cmd = (MIME::Base64::encode_base64(
139 $client->client_step(
140 MIME::Base64::decode_base64(
153 my $domain = shift || "localhost.localdomain";
154 my $ok = $me->_EHLO($domain);
155 my @msg = $me->message;
159 my $h = ${*$me}{'net_smtp_esmtp'} = {};
163 if $ln =~ /(\w+)\b[= \t]*([^\n]*)/;
166 elsif($me->status == CMD_ERROR)
169 if $ok = $me->_HELO($domain);
172 return undef unless $ok;
174 $msg[0] =~ /\A\s*(\S+)/;
181 return ${*$self}{'net_smtp_esmtp'}->{$cmd}
182 if exists ${*$self}{'net_smtp_esmtp'}->{$cmd};
183 $self->set_status(@_)
191 $addr = "" unless defined $addr;
193 if (${*$self}{'net_smtp_exact_addr'}) {
194 return $1 if $addr =~ /^\s*(<.*>)\s*$/s;
197 return $1 if $addr =~ /(<[^>]*>)/;
198 $addr =~ s/^\s+|\s+$//sg;
207 my $addr = _addr($me, shift);
215 if(exists ${*$me}{'net_smtp_esmtp'})
217 my $esmtp = ${*$me}{'net_smtp_esmtp'};
219 if(defined($v = delete $opt{Size}))
221 if(exists $esmtp->{SIZE})
223 $opts .= sprintf " SIZE=%d", $v + 0
227 carp 'Net::SMTP::mail: SIZE option not supported by host';
231 if(defined($v = delete $opt{Return}))
233 if(exists $esmtp->{DSN})
235 $opts .= " RET=" . ((uc($v) eq "FULL") ? "FULL" : "HDRS");
239 carp 'Net::SMTP::mail: DSN option not supported by host';
243 if(defined($v = delete $opt{Bits}))
247 if(exists $esmtp->{'8BITMIME'})
249 $opts .= " BODY=8BITMIME";
253 carp 'Net::SMTP::mail: 8BITMIME option not supported by host';
256 elsif($v eq "binary")
258 if(exists $esmtp->{'BINARYMIME'} && exists $esmtp->{'CHUNKING'})
260 $opts .= " BODY=BINARYMIME";
261 ${*$me}{'net_smtp_chunking'} = 1;
265 carp 'Net::SMTP::mail: BINARYMIME option not supported by host';
268 elsif(exists $esmtp->{'8BITMIME'} or exists $esmtp->{'BINARYMIME'})
270 $opts .= " BODY=7BIT";
274 carp 'Net::SMTP::mail: 8BITMIME and BINARYMIME options not supported by host';
278 if(defined($v = delete $opt{Transaction}))
280 if(exists $esmtp->{CHECKPOINT})
282 $opts .= " TRANSID=" . _addr($me, $v);
286 carp 'Net::SMTP::mail: CHECKPOINT option not supported by host';
290 if(defined($v = delete $opt{Envelope}))
292 if(exists $esmtp->{DSN})
294 $v =~ s/([^\041-\176]|=|\+)/sprintf "+%02x", ord($1)/sge;
299 carp 'Net::SMTP::mail: DSN option not supported by host';
303 carp 'Net::SMTP::recipient: unknown option(s) '
304 . join(" ", keys %opt)
310 carp 'Net::SMTP::mail: ESMTP not supported by host - options discarded :-(';
314 $me->_MAIL("FROM:".$addr.$opts);
317 sub send { my $me = shift; $me->_SEND("FROM:" . _addr($me, $_[0])) }
318 sub send_or_mail { my $me = shift; $me->_SOML("FROM:" . _addr($me, $_[0])) }
319 sub send_and_mail { my $me = shift; $me->_SAML("FROM:" . _addr($me, $_[0])) }
326 if(exists ${*$me}{'net_smtp_lastch'});
338 if(@_ && ref($_[-1]))
340 my %opt = %{pop(@_)};
343 $skip_bad = delete $opt{'SkipBad'};
345 if(exists ${*$smtp}{'net_smtp_esmtp'})
347 my $esmtp = ${*$smtp}{'net_smtp_esmtp'};
349 if(defined($v = delete $opt{Notify}))
351 if(exists $esmtp->{DSN})
353 $opts .= " NOTIFY=" . join(",",map { uc $_ } @$v)
357 carp 'Net::SMTP::recipient: DSN option not supported by host';
361 carp 'Net::SMTP::recipient: unknown option(s) '
362 . join(" ", keys %opt)
368 carp 'Net::SMTP::recipient: ESMTP not supported by host - options discarded :-(';
376 if($smtp->_RCPT("TO:" . _addr($smtp, $addr) . $opts)) {
377 push(@ok,$addr) if $skip_bad;
384 return $skip_bad ? @ok : 1;
397 if(exists ${*$me}{'net_smtp_chunking'})
399 carp 'Net::SMTP::data: CHUNKING extension in use, must call bdat instead';
403 my $ok = $me->_DATA() && $me->datasend(@_);
405 $ok && @_ ? $me->dataend
414 if(exists ${*$me}{'net_smtp_chunking'})
418 $me->_BDAT(length $data) && $me->rawdatasend($data) &&
419 $me->response() == CMD_OK;
423 carp 'Net::SMTP::bdat: CHUNKING extension is not in use, call data instead';
431 if(exists ${*$me}{'net_smtp_chunking'})
435 $me->_BDAT(length $data, "LAST") && $me->rawdatasend($data) &&
436 $me->response() == CMD_OK;
440 carp 'Net::SMTP::bdat: CHUNKING extension is not in use, call data instead';
446 return unless $me->_DATA();
454 $me->_EXPN(@_) ? ($me->message)
459 sub verify { shift->_VRFY(@_) }
465 $me->_HELP(@_) ? scalar $me->message
486 sub _EHLO { shift->command("EHLO", @_)->response() == CMD_OK }
487 sub _HELO { shift->command("HELO", @_)->response() == CMD_OK }
488 sub _MAIL { shift->command("MAIL", @_)->response() == CMD_OK }
489 sub _RCPT { shift->command("RCPT", @_)->response() == CMD_OK }
490 sub _SEND { shift->command("SEND", @_)->response() == CMD_OK }
491 sub _SAML { shift->command("SAML", @_)->response() == CMD_OK }
492 sub _SOML { shift->command("SOML", @_)->response() == CMD_OK }
493 sub _VRFY { shift->command("VRFY", @_)->response() == CMD_OK }
494 sub _EXPN { shift->command("EXPN", @_)->response() == CMD_OK }
495 sub _HELP { shift->command("HELP", @_)->response() == CMD_OK }
496 sub _RSET { shift->command("RSET")->response() == CMD_OK }
497 sub _NOOP { shift->command("NOOP")->response() == CMD_OK }
498 sub _QUIT { shift->command("QUIT")->response() == CMD_OK }
499 sub _DATA { shift->command("DATA")->response() == CMD_MORE }
500 sub _BDAT { shift->command("BDAT", @_) }
501 sub _TURN { shift->unsupported(@_); }
502 sub _ETRN { shift->command("ETRN", @_)->response() == CMD_OK }
503 sub _AUTH { shift->command("AUTH", @_)->response() == CMD_OK }
511 Net::SMTP - Simple Mail Transfer Protocol Client
518 $smtp = Net::SMTP->new('mailhost');
519 $smtp = Net::SMTP->new('mailhost', Timeout => 60);
523 This module implements a client interface to the SMTP and ESMTP
524 protocol, enabling a perl5 application to talk to SMTP servers. This
525 documentation assumes that you are familiar with the concepts of the
526 SMTP protocol described in RFC821.
528 A new Net::SMTP object must be created with the I<new> method. Once
529 this has been done, all SMTP commands are accessed through this object.
531 The Net::SMTP class is a subclass of Net::Cmd and IO::Socket::INET.
535 This example prints the mail domain name of the SMTP server known as mailhost:
537 #!/usr/local/bin/perl -w
541 $smtp = Net::SMTP->new('mailhost');
542 print $smtp->domain,"\n";
545 This example sends a small message to the postmaster at the SMTP server
548 #!/usr/local/bin/perl -w
552 $smtp = Net::SMTP->new('mailhost');
554 $smtp->mail($ENV{USER});
555 $smtp->to('postmaster');
558 $smtp->datasend("To: postmaster\n");
559 $smtp->datasend("\n");
560 $smtp->datasend("A simple test message\n");
569 =item new Net::SMTP [ HOST, ] [ OPTIONS ]
571 This is the constructor for a new Net::SMTP object. C<HOST> is the
572 name of the remote host to which an SMTP connection is required.
574 If C<HOST> is an array reference then each value will be attempted
575 in turn until a connection is made.
577 If C<HOST> is not given, then the C<SMTP_Host> specified in C<Net::Config>
580 C<OPTIONS> are passed in a hash like fashion, using key and value pairs.
581 Possible options are:
583 B<Hello> - SMTP requires that you identify yourself. This option
584 specifies a string to pass as your mail domain. If not
585 given a guess will be taken.
587 B<LocalAddr> and B<LocalPort> - These parameters are passed directly
588 to IO::Socket to allow binding the socket to a local port.
590 B<Timeout> - Maximum time, in seconds, to wait for a response from the
591 SMTP server (default: 120)
593 B<ExactAddresses> - If true the all ADDRESS arguments must be as
594 defined by C<addr-spec> in RFC2822. If not given, or false, then
595 Net::SMTP will attempt to extract the address from the value passed.
597 B<Debug> - Enable debugging information
603 $smtp = Net::SMTP->new('mailhost',
604 Hello => 'my.mail.domain'
613 Unless otherwise stated all methods return either a I<true> or I<false>
614 value, with I<true> meaning that the operation was a success. When a method
615 states that it returns a value, failure will be returned as I<undef> or an
622 Returns the banner message which the server replied with when the
623 initial connection was made.
627 Returns the domain that the remote SMTP server identified itself as during
630 =item hello ( DOMAIN )
632 Tell the remote server the mail domain which you are in using the EHLO
633 command (or HELO if EHLO fails). Since this method is invoked
634 automatically when the Net::SMTP object is constructed the user should
635 normally not have to call it manually.
637 =item etrn ( DOMAIN )
639 Request a queue run for the DOMAIN given.
641 =item auth ( USERNAME, PASSWORD )
643 Attempt SASL authentication.
645 =item mail ( ADDRESS [, OPTIONS] )
647 =item send ( ADDRESS )
649 =item send_or_mail ( ADDRESS )
651 =item send_and_mail ( ADDRESS )
653 Send the appropriate command to the server MAIL, SEND, SOML or SAML. C<ADDRESS>
654 is the address of the sender. This initiates the sending of a message. The
655 method C<recipient> should be called for each address that the message is to
658 The C<mail> method can some additional ESMTP OPTIONS which is passed
659 in hash like fashion, using key and value pairs. Possible options are:
662 Return => "FULL" | "HDRS"
663 Bits => "7" | "8" | "binary"
664 Transaction => <ADDRESS>
667 The C<Return> and C<Envelope> parameters are used for DSN (Delivery
668 Status Notification).
672 Reset the status of the server. This may be called after a message has been
673 initiated, but before any data has been sent, to cancel the sending of the
676 =item recipient ( ADDRESS [, ADDRESS [ ...]] [, OPTIONS ] )
678 Notify the server that the current message should be sent to all of the
679 addresses given. Each address is sent as a separate command to the server.
680 Should the sending of any address result in a failure then the
681 process is aborted and a I<false> value is returned. It is up to the
682 user to call C<reset> if they so desire.
684 The C<recipient> method can some additional OPTIONS which is passed
685 in hash like fashion, using key and value pairs. Possible options are:
688 SkipBad => ignore bad addresses
690 If C<SkipBad> is true the C<recipient> will not return an error when a
691 bad address is encountered and it will return an array of addresses
694 $smtp->recipient($recipient1,$recipient2); # Good
695 $smtp->recipient($recipient1,$recipient2, { SkipBad => 1 }); # Good
696 $smtp->recipient("$recipient,$recipient2"); # BAD
698 =item to ( ADDRESS [, ADDRESS [...]] )
700 =item cc ( ADDRESS [, ADDRESS [...]] )
702 =item bcc ( ADDRESS [, ADDRESS [...]] )
704 Synonyms for C<recipient>.
706 =item data ( [ DATA ] )
708 Initiate the sending of the data from the current message.
710 C<DATA> may be a reference to a list or a list. If specified the contents
711 of C<DATA> and a termination string C<".\r\n"> is sent to the server. And the
712 result will be true if the data was accepted.
714 If C<DATA> is not specified then the result will indicate that the server
715 wishes the data to be sent. The data must then be sent using the C<datasend>
716 and C<dataend> methods described in L<Net::Cmd>.
718 =item expand ( ADDRESS )
720 Request the server to expand the given address Returns an array
721 which contains the text read from the server.
723 =item verify ( ADDRESS )
725 Verify that C<ADDRESS> is a legitimate mailing address.
727 =item help ( [ $subject ] )
729 Request help text from the server. Returns the text or undef upon failure
733 Send the QUIT command to the remote SMTP server and close the socket connection.
739 Net::SMTP attempts to DWIM with addresses that are passed. For
740 example an application might extract The From: line from an email
741 and pass that to mail(). While this may work, it is not reccomended.
742 The application should really use a module like L<Mail::Address>
743 to extract the mail address and pass that.
745 If C<ExactAddresses> is passed to the contructor, then addresses
746 should be a valid rfc2821-quoted address, although Net::SMTP will
747 accept accept the address surrounded by angle brackets.
749 funny user@domain WRONG
750 "funny user"@domain RIGHT, recommended
751 <"funny user"@domain> OK
759 Graham Barr <gbarr@pobox.com>
763 Copyright (c) 1995-1997 Graham Barr. All rights reserved.
764 This program is free software; you can redistribute it and/or modify
765 it under the same terms as Perl itself.
769 I<$Id: //depot/libnet/Net/SMTP.pm#31 $>