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.21"; # $Id: //depot/libnet/Net/SMTP.pm#22 $
21 @ISA = qw(Net::Cmd IO::Socket::INET);
26 my $type = ref($self) || $self;
27 my $host = shift if @_ % 2;
29 my $hosts = defined $host ? [ $host ] : $NetConfig{smtp_hosts};
33 foreach $h (@{$hosts})
35 $obj = $type->SUPER::new(PeerAddr => ($host = $h),
36 PeerPort => $arg{Port} || 'smtp(25)',
37 LocalAddr => $arg{LocalAddr},
38 LocalPort => $arg{LocalPort},
40 Timeout => defined $arg{Timeout}
51 $obj->debug(exists $arg{Debug} ? $arg{Debug} : undef);
53 unless ($obj->response() == CMD_OK)
59 ${*$obj}{'net_smtp_host'} = $host;
61 (${*$obj}{'net_smtp_banner'}) = $obj->message;
62 (${*$obj}{'net_smtp_domain'}) = $obj->message =~ /\A\s*(\S+)/;
64 unless($obj->hello($arg{Hello} || ""))
74 ## User interface methods
81 return ${*$me}{'net_smtp_banner'} || undef;
88 return ${*$me}{'net_smtp_domain'} || undef;
93 defined($self->supports('ETRN',500,["Command unknown: 'ETRN'"])) &&
97 sub auth { # auth(username, password) by mengwong 20011106. the only supported mechanism at this time is PLAIN.
99 # my $auth = $smtp->supports("AUTH");
100 # $smtp->auth("username", "password") or die $smtp->message;
103 require MIME::Base64;
106 my ($username, $password) = @_;
107 die "auth(username, password)" if not length $username;
109 my $mechanisms = $self->supports('AUTH',500,["Command unknown: 'AUTH'"]);
110 return unless defined $mechanisms;
112 if (not grep { uc $_ eq "PLAIN" } split ' ', $mechanisms) {
113 $self->set_status(500, ["PLAIN mechanism not supported; server supports $mechanisms"]);
116 my $authstring = MIME::Base64::encode_base64(join "\0", ($username)x2, $password);
117 $authstring =~ s/\n//g; # wrap long lines
119 $self->_AUTH("PLAIN $authstring");
125 my $domain = shift || "localhost.localdomain";
126 my $ok = $me->_EHLO($domain);
127 my @msg = $me->message;
131 my $h = ${*$me}{'net_smtp_esmtp'} = {};
135 if $ln =~ /(\S+)\b[ \t]*([^\n]*)/;
138 elsif($me->status == CMD_ERROR)
141 if $ok = $me->_HELO($domain);
144 $ok && $msg[0] =~ /\A\s*(\S+)/
152 return ${*$self}{'net_smtp_esmtp'}->{$cmd}
153 if exists ${*$self}{'net_smtp_esmtp'}->{$cmd};
154 $self->set_status(@_)
161 my $addr = shift || "";
164 if $addr =~ /(<[^>]+>)/so;
167 $addr =~ s/(\A\s+|\s+\Z)//sog;
169 return "<" . $addr . ">";
176 my $addr = _addr(shift);
184 if(exists ${*$me}{'net_smtp_esmtp'})
186 my $esmtp = ${*$me}{'net_smtp_esmtp'};
188 if(defined($v = delete $opt{Size}))
190 if(exists $esmtp->{SIZE})
192 $opts .= sprintf " SIZE=%d", $v + 0
196 carp 'Net::SMTP::mail: SIZE option not supported by host';
200 if(defined($v = delete $opt{Return}))
202 if(exists $esmtp->{DSN})
204 $opts .= " RET=" . uc $v
208 carp 'Net::SMTP::mail: DSN option not supported by host';
212 if(defined($v = delete $opt{Bits}))
214 if(exists $esmtp->{'8BITMIME'})
216 $opts .= $v == 8 ? " BODY=8BITMIME" : " BODY=7BIT"
220 carp 'Net::SMTP::mail: 8BITMIME option not supported by host';
224 if(defined($v = delete $opt{Transaction}))
226 if(exists $esmtp->{CHECKPOINT})
228 $opts .= " TRANSID=" . _addr($v);
232 carp 'Net::SMTP::mail: CHECKPOINT option not supported by host';
236 if(defined($v = delete $opt{Envelope}))
238 if(exists $esmtp->{DSN})
240 $v =~ s/([^\041-\176]|=|\+)/sprintf "+%02x", ord($1)/sge;
245 carp 'Net::SMTP::mail: DSN option not supported by host';
249 carp 'Net::SMTP::recipient: unknown option(s) '
250 . join(" ", keys %opt)
256 carp 'Net::SMTP::mail: ESMTP not supported by host - options discarded :-(';
260 $me->_MAIL("FROM:".$addr.$opts);
263 sub send { shift->_SEND("FROM:" . _addr($_[0])) }
264 sub send_or_mail { shift->_SOML("FROM:" . _addr($_[0])) }
265 sub send_and_mail { shift->_SAML("FROM:" . _addr($_[0])) }
272 if(exists ${*$me}{'net_smtp_lastch'});
284 if(@_ && ref($_[-1]))
286 my %opt = %{pop(@_)};
289 $skip_bad = delete $opt{'SkipBad'};
291 if(exists ${*$smtp}{'net_smtp_esmtp'})
293 my $esmtp = ${*$smtp}{'net_smtp_esmtp'};
295 if(defined($v = delete $opt{Notify}))
297 if(exists $esmtp->{DSN})
299 $opts .= " NOTIFY=" . join(",",map { uc $_ } @$v)
303 carp 'Net::SMTP::recipient: DSN option not supported by host';
307 carp 'Net::SMTP::recipient: unknown option(s) '
308 . join(" ", keys %opt)
314 carp 'Net::SMTP::recipient: ESMTP not supported by host - options discarded :-(';
322 if($smtp->_RCPT("TO:" . _addr($addr) . $opts)) {
323 push(@ok,$addr) if $skip_bad;
330 return $skip_bad ? @ok : 1;
343 my $ok = $me->_DATA() && $me->datasend(@_);
345 $ok && @_ ? $me->dataend
351 return unless $me->_DATA();
359 $me->_EXPN(@_) ? ($me->message)
364 sub verify { shift->_VRFY(@_) }
370 $me->_HELP(@_) ? scalar $me->message
391 sub _EHLO { shift->command("EHLO", @_)->response() == CMD_OK }
392 sub _HELO { shift->command("HELO", @_)->response() == CMD_OK }
393 sub _MAIL { shift->command("MAIL", @_)->response() == CMD_OK }
394 sub _RCPT { shift->command("RCPT", @_)->response() == CMD_OK }
395 sub _SEND { shift->command("SEND", @_)->response() == CMD_OK }
396 sub _SAML { shift->command("SAML", @_)->response() == CMD_OK }
397 sub _SOML { shift->command("SOML", @_)->response() == CMD_OK }
398 sub _VRFY { shift->command("VRFY", @_)->response() == CMD_OK }
399 sub _EXPN { shift->command("EXPN", @_)->response() == CMD_OK }
400 sub _HELP { shift->command("HELP", @_)->response() == CMD_OK }
401 sub _RSET { shift->command("RSET")->response() == CMD_OK }
402 sub _NOOP { shift->command("NOOP")->response() == CMD_OK }
403 sub _QUIT { shift->command("QUIT")->response() == CMD_OK }
404 sub _DATA { shift->command("DATA")->response() == CMD_MORE }
405 sub _TURN { shift->unsupported(@_); }
406 sub _ETRN { shift->command("ETRN", @_)->response() == CMD_OK }
407 sub _AUTH { shift->command("AUTH", @_)->response() == CMD_OK }
415 Net::SMTP - Simple Mail Transfer Protocol Client
422 $smtp = Net::SMTP->new('mailhost');
423 $smtp = Net::SMTP->new('mailhost', Timeout => 60);
427 This module implements a client interface to the SMTP and ESMTP
428 protocol, enabling a perl5 application to talk to SMTP servers. This
429 documentation assumes that you are familiar with the concepts of the
430 SMTP protocol described in RFC821.
432 A new Net::SMTP object must be created with the I<new> method. Once
433 this has been done, all SMTP commands are accessed through this object.
435 The Net::SMTP class is a subclass of Net::Cmd and IO::Socket::INET.
439 This example prints the mail domain name of the SMTP server known as mailhost:
441 #!/usr/local/bin/perl -w
445 $smtp = Net::SMTP->new('mailhost');
446 print $smtp->domain,"\n";
449 This example sends a small message to the postmaster at the SMTP server
452 #!/usr/local/bin/perl -w
456 $smtp = Net::SMTP->new('mailhost');
458 $smtp->mail($ENV{USER});
459 $smtp->to('postmaster');
462 $smtp->datasend("To: postmaster\n");
463 $smtp->datasend("\n");
464 $smtp->datasend("A simple test message\n");
473 =item new Net::SMTP [ HOST, ] [ OPTIONS ]
475 This is the constructor for a new Net::SMTP object. C<HOST> is the
476 name of the remote host to which an SMTP connection is required.
478 If C<HOST> is not given, then the C<SMTP_Host> specified in C<Net::Config>
481 C<OPTIONS> are passed in a hash like fashion, using key and value pairs.
482 Possible options are:
484 B<Hello> - SMTP requires that you identify yourself. This option
485 specifies a string to pass as your mail domain. If not
486 given a guess will be taken.
488 B<LocalAddr> and B<LocalPort> - These parameters are passed directly
489 to IO::Socket to allow binding the socket to a local port.
491 B<Timeout> - Maximum time, in seconds, to wait for a response from the
492 SMTP server (default: 120)
494 B<Debug> - Enable debugging information
500 $smtp = Net::SMTP->new('mailhost',
501 Hello => 'my.mail.domain'
510 Unless otherwise stated all methods return either a I<true> or I<false>
511 value, with I<true> meaning that the operation was a success. When a method
512 states that it returns a value, failure will be returned as I<undef> or an
519 Returns the banner message which the server replied with when the
520 initial connection was made.
524 Returns the domain that the remote SMTP server identified itself as during
527 =item hello ( DOMAIN )
529 Tell the remote server the mail domain which you are in using the EHLO
530 command (or HELO if EHLO fails). Since this method is invoked
531 automatically when the Net::SMTP object is constructed the user should
532 normally not have to call it manually.
534 =item etrn ( DOMAIN )
536 Request a queue run for the DOMAIN given.
538 =item auth ( USERNAME, PASSWORD )
540 Attempt SASL authentication. At this time only the PLAIN mechanism is supported.
542 At some point in the future support for using Authen::SASL will be added
544 =item mail ( ADDRESS [, OPTIONS] )
546 =item send ( ADDRESS )
548 =item send_or_mail ( ADDRESS )
550 =item send_and_mail ( ADDRESS )
552 Send the appropriate command to the server MAIL, SEND, SOML or SAML. C<ADDRESS>
553 is the address of the sender. This initiates the sending of a message. The
554 method C<recipient> should be called for each address that the message is to
557 The C<mail> method can some additional ESMTP OPTIONS which is passed
558 in hash like fashion, using key and value pairs. Possible options are:
563 Transaction => <ADDRESS>
569 Reset the status of the server. This may be called after a message has been
570 initiated, but before any data has been sent, to cancel the sending of the
573 =item recipient ( ADDRESS [, ADDRESS [ ...]] [, OPTIONS ] )
575 Notify the server that the current message should be sent to all of the
576 addresses given. Each address is sent as a separate command to the server.
577 Should the sending of any address result in a failure then the
578 process is aborted and a I<false> value is returned. It is up to the
579 user to call C<reset> if they so desire.
581 The C<recipient> method can some additional OPTIONS which is passed
582 in hash like fashion, using key and value pairs. Possible options are:
585 SkipBad => ignore bad addresses
587 If C<SkipBad> is true the C<recipient> will not return an error when a
588 bad address is encountered and it will return an array of addresses
591 $smtp->recipient($recipient1,$recipient2); # Good
592 $smtp->recipient($recipient1,$recipient2, { SkipBad => 1 }); # Good
593 $smtp->recipient("$recipient,$recipient2"); # BAD
595 =item to ( ADDRESS [, ADDRESS [...]] )
597 =item cc ( ADDRESS [, ADDRESS [...]] )
599 =item bcc ( ADDRESS [, ADDRESS [...]] )
601 Synonyms for C<recipient>.
603 =item data ( [ DATA ] )
605 Initiate the sending of the data from the current message.
607 C<DATA> may be a reference to a list or a list. If specified the contents
608 of C<DATA> and a termination string C<".\r\n"> is sent to the server. And the
609 result will be true if the data was accepted.
611 If C<DATA> is not specified then the result will indicate that the server
612 wishes the data to be sent. The data must then be sent using the C<datasend>
613 and C<dataend> methods described in L<Net::Cmd>.
615 =item expand ( ADDRESS )
617 Request the server to expand the given address Returns an array
618 which contains the text read from the server.
620 =item verify ( ADDRESS )
622 Verify that C<ADDRESS> is a legitimate mailing address.
624 =item help ( [ $subject ] )
626 Request help text from the server. Returns the text or undef upon failure
630 Send the QUIT command to the remote SMTP server and close the socket connection.
640 Graham Barr <gbarr@pobox.com>
644 Copyright (c) 1995-1997 Graham Barr. All rights reserved.
645 This program is free software; you can redistribute it and/or modify
646 it under the same terms as Perl itself.
650 I<$Id: //depot/libnet/Net/SMTP.pm#22 $>