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.18"; # $Id: //depot/libnet/Net/SMTP.pm#19 $
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)',
38 Timeout => defined $arg{Timeout}
49 $obj->debug(exists $arg{Debug} ? $arg{Debug} : undef);
51 unless ($obj->response() == CMD_OK)
57 ${*$obj}{'net_smtp_host'} = $host;
59 (${*$obj}{'net_smtp_banner'}) = $obj->message;
60 (${*$obj}{'net_smtp_domain'}) = $obj->message =~ /\A\s*(\S+)/;
62 unless($obj->hello($arg{Hello} || ""))
72 ## User interface methods
79 return ${*$me}{'net_smtp_banner'} || undef;
86 return ${*$me}{'net_smtp_domain'} || undef;
91 defined($self->supports('ETRN',500,["Command unknown: 'ETRN'"])) &&
95 sub auth { # auth(username, password) by mengwong 20011106. the only supported mechanism at this time is PLAIN.
97 # my $auth = $smtp->supports("AUTH");
98 # $smtp->auth("username", "password") or die $smtp->message;
101 require MIME::Base64;
104 my ($username, $password) = @_;
105 die "auth(username, password)" if not length $username;
107 my $mechanisms = $self->supports('AUTH',500,["Command unknown: 'AUTH'"]);
108 return unless defined $mechanisms;
110 if (not grep { uc $_ eq "PLAIN" } split ' ', $mechanisms) {
111 $self->set_status(500, ["PLAIN mechanism not supported; server supports $mechanisms"]);
114 my $authstring = MIME::Base64::encode_base64(join "\0", ($username)x2, $password);
115 $authstring =~ s/\n//g; # wrap long lines
117 $self->_AUTH("PLAIN $authstring");
123 my $domain = shift ||
126 Net::Domain::hostfqdn();
129 my $ok = $me->_EHLO($domain);
130 my @msg = $me->message;
134 my $h = ${*$me}{'net_smtp_esmtp'} = {};
138 if $ln =~ /(\S+)\b[ \t]*([^\n]*)/;
141 elsif($me->status == CMD_ERROR)
144 if $ok = $me->_HELO($domain);
147 $ok && $msg[0] =~ /\A\s*(\S+)/
155 return ${*$self}{'net_smtp_esmtp'}->{$cmd}
156 if exists ${*$self}{'net_smtp_esmtp'}->{$cmd};
157 $self->set_status(@_)
164 my $addr = shift || "";
167 if $addr =~ /(<[^>]+>)/so;
170 $addr =~ s/(\A\s+|\s+\Z)//sog;
172 return "<" . $addr . ">";
179 my $addr = _addr(shift);
187 if(exists ${*$me}{'net_smtp_esmtp'})
189 my $esmtp = ${*$me}{'net_smtp_esmtp'};
191 if(defined($v = delete $opt{Size}))
193 if(exists $esmtp->{SIZE})
195 $opts .= sprintf " SIZE=%d", $v + 0
199 carp 'Net::SMTP::mail: SIZE option not supported by host';
203 if(defined($v = delete $opt{Return}))
205 if(exists $esmtp->{DSN})
207 $opts .= " RET=" . uc $v
211 carp 'Net::SMTP::mail: DSN option not supported by host';
215 if(defined($v = delete $opt{Bits}))
217 if(exists $esmtp->{'8BITMIME'})
219 $opts .= $v == 8 ? " BODY=8BITMIME" : " BODY=7BIT"
223 carp 'Net::SMTP::mail: 8BITMIME option not supported by host';
227 if(defined($v = delete $opt{Transaction}))
229 if(exists $esmtp->{CHECKPOINT})
231 $opts .= " TRANSID=" . _addr($v);
235 carp 'Net::SMTP::mail: CHECKPOINT option not supported by host';
239 if(defined($v = delete $opt{Envelope}))
241 if(exists $esmtp->{DSN})
243 $v =~ s/([^\041-\176]|=|\+)/sprintf "+%02x", ord($1)/sge;
248 carp 'Net::SMTP::mail: DSN option not supported by host';
252 carp 'Net::SMTP::recipient: unknown option(s) '
253 . join(" ", keys %opt)
259 carp 'Net::SMTP::mail: ESMTP not supported by host - options discarded :-(';
263 $me->_MAIL("FROM:".$addr.$opts);
266 sub send { shift->_SEND("FROM:" . _addr($_[0])) }
267 sub send_or_mail { shift->_SOML("FROM:" . _addr($_[0])) }
268 sub send_and_mail { shift->_SAML("FROM:" . _addr($_[0])) }
275 if(exists ${*$me}{'net_smtp_lastch'});
287 if(@_ && ref($_[-1]))
289 my %opt = %{pop(@_)};
292 $skip_bad = delete $opt{'SkipBad'};
294 if(exists ${*$smtp}{'net_smtp_esmtp'})
296 my $esmtp = ${*$smtp}{'net_smtp_esmtp'};
298 if(defined($v = delete $opt{Notify}))
300 if(exists $esmtp->{DSN})
302 $opts .= " NOTIFY=" . join(",",map { uc $_ } @$v)
306 carp 'Net::SMTP::recipient: DSN option not supported by host';
310 carp 'Net::SMTP::recipient: unknown option(s) '
311 . join(" ", keys %opt)
317 carp 'Net::SMTP::recipient: ESMTP not supported by host - options discarded :-(';
325 if($smtp->_RCPT("TO:" . _addr($addr) . $opts)) {
326 push(@ok,$addr) if $skip_bad;
333 return $skip_bad ? @ok : 1;
346 my $ok = $me->_DATA() && $me->datasend(@_);
348 $ok && @_ ? $me->dataend
356 $me->_EXPN(@_) ? ($me->message)
361 sub verify { shift->_VRFY(@_) }
367 $me->_HELP(@_) ? scalar $me->message
388 sub _EHLO { shift->command("EHLO", @_)->response() == CMD_OK }
389 sub _HELO { shift->command("HELO", @_)->response() == CMD_OK }
390 sub _MAIL { shift->command("MAIL", @_)->response() == CMD_OK }
391 sub _RCPT { shift->command("RCPT", @_)->response() == CMD_OK }
392 sub _SEND { shift->command("SEND", @_)->response() == CMD_OK }
393 sub _SAML { shift->command("SAML", @_)->response() == CMD_OK }
394 sub _SOML { shift->command("SOML", @_)->response() == CMD_OK }
395 sub _VRFY { shift->command("VRFY", @_)->response() == CMD_OK }
396 sub _EXPN { shift->command("EXPN", @_)->response() == CMD_OK }
397 sub _HELP { shift->command("HELP", @_)->response() == CMD_OK }
398 sub _RSET { shift->command("RSET")->response() == CMD_OK }
399 sub _NOOP { shift->command("NOOP")->response() == CMD_OK }
400 sub _QUIT { shift->command("QUIT")->response() == CMD_OK }
401 sub _DATA { shift->command("DATA")->response() == CMD_MORE }
402 sub _TURN { shift->unsupported(@_); }
403 sub _ETRN { shift->command("ETRN", @_)->response() == CMD_OK }
404 sub _AUTH { shift->command("AUTH", @_)->response() == CMD_OK }
412 Net::SMTP - Simple Mail Transfer Protocol Client
419 $smtp = Net::SMTP->new('mailhost');
420 $smtp = Net::SMTP->new('mailhost', Timeout => 60);
424 This module implements a client interface to the SMTP and ESMTP
425 protocol, enabling a perl5 application to talk to SMTP servers. This
426 documentation assumes that you are familiar with the concepts of the
427 SMTP protocol described in RFC821.
429 A new Net::SMTP object must be created with the I<new> method. Once
430 this has been done, all SMTP commands are accessed through this object.
432 The Net::SMTP class is a subclass of Net::Cmd and IO::Socket::INET.
436 This example prints the mail domain name of the SMTP server known as mailhost:
438 #!/usr/local/bin/perl -w
442 $smtp = Net::SMTP->new('mailhost');
443 print $smtp->domain,"\n";
446 This example sends a small message to the postmaster at the SMTP server
449 #!/usr/local/bin/perl -w
453 $smtp = Net::SMTP->new('mailhost');
455 $smtp->mail($ENV{USER});
456 $smtp->to('postmaster');
459 $smtp->datasend("To: postmaster\n");
460 $smtp->datasend("\n");
461 $smtp->datasend("A simple test message\n");
470 =item new Net::SMTP [ HOST, ] [ OPTIONS ]
472 This is the constructor for a new Net::SMTP object. C<HOST> is the
473 name of the remote host to which an SMTP connection is required.
475 If C<HOST> is not given, then the C<SMTP_Host> specified in C<Net::Config>
478 C<OPTIONS> are passed in a hash like fashion, using key and value pairs.
479 Possible options are:
481 B<Hello> - SMTP requires that you identify yourself. This option
482 specifies a string to pass as your mail domain. If not
483 given a guess will be taken.
485 B<Timeout> - Maximum time, in seconds, to wait for a response from the
486 SMTP server (default: 120)
488 B<Debug> - Enable debugging information
494 $smtp = Net::SMTP->new('mailhost',
495 Hello => 'my.mail.domain'
504 Unless otherwise stated all methods return either a I<true> or I<false>
505 value, with I<true> meaning that the operation was a success. When a method
506 states that it returns a value, failure will be returned as I<undef> or an
513 Returns the banner message which the server replied with when the
514 initial connection was made.
518 Returns the domain that the remote SMTP server identified itself as during
521 =item hello ( DOMAIN )
523 Tell the remote server the mail domain which you are in using the EHLO
524 command (or HELO if EHLO fails). Since this method is invoked
525 automatically when the Net::SMTP object is constructed the user should
526 normally not have to call it manually.
528 =item etrn ( DOMAIN )
530 Request a queue run for the DOMAIN given.
532 =item auth ( USERNAME, PASSWORD )
534 Attempt SASL authentication. At this time only the PLAIN mechanism is supported.
536 At some point in the future support for using Authen::SASL will be added
538 =item mail ( ADDRESS [, OPTIONS] )
540 =item send ( ADDRESS )
542 =item send_or_mail ( ADDRESS )
544 =item send_and_mail ( ADDRESS )
546 Send the appropriate command to the server MAIL, SEND, SOML or SAML. C<ADDRESS>
547 is the address of the sender. This initiates the sending of a message. The
548 method C<recipient> should be called for each address that the message is to
551 The C<mail> method can some additional ESMTP OPTIONS which is passed
552 in hash like fashion, using key and value pairs. Possible options are:
557 Transaction => <ADDRESS>
563 Reset the status of the server. This may be called after a message has been
564 initiated, but before any data has been sent, to cancel the sending of the
567 =item recipient ( ADDRESS [, ADDRESS [ ...]] [, OPTIONS ] )
569 Notify the server that the current message should be sent to all of the
570 addresses given. Each address is sent as a separate command to the server.
571 Should the sending of any address result in a failure then the
572 process is aborted and a I<false> value is returned. It is up to the
573 user to call C<reset> if they so desire.
575 The C<recipient> method can some additional OPTIONS which is passed
576 in hash like fashion, using key and value pairs. Possible options are:
579 SkipBad => ignore bad addresses
581 If C<SkipBad> is true the C<recipient> will not return an error when a
582 bad address is encountered and it will return an array of addresses
585 $smtp->recipient($recipient1,$recipient2); # Good
586 $smtp->recipient($recipient1,$recipient2, { SkipBad => 1 }); # Good
587 $smtp->recipient("$recipient,$recipient2"); # BAD
589 =item to ( ADDRESS [, ADDRESS [...]] )
591 =item cc ( ADDRESS [, ADDRESS [...]] )
593 =item bcc ( ADDRESS [, ADDRESS [...]] )
595 Synonyms for C<recipient>.
597 =item data ( [ DATA ] )
599 Initiate the sending of the data from the current message.
601 C<DATA> may be a reference to a list or a list. If specified the contents
602 of C<DATA> and a termination string C<".\r\n"> is sent to the server. And the
603 result will be true if the data was accepted.
605 If C<DATA> is not specified then the result will indicate that the server
606 wishes the data to be sent. The data must then be sent using the C<datasend>
607 and C<dataend> methods described in L<Net::Cmd>.
609 =item expand ( ADDRESS )
611 Request the server to expand the given address Returns an array
612 which contains the text read from the server.
614 =item verify ( ADDRESS )
616 Verify that C<ADDRESS> is a legitimate mailing address.
618 =item help ( [ $subject ] )
620 Request help text from the server. Returns the text or undef upon failure
624 Send the QUIT command to the remote SMTP server and close the socket connection.
634 Graham Barr <gbarr@pobox.com>
638 Copyright (c) 1995-1997 Graham Barr. All rights reserved.
639 This program is free software; you can redistribute it and/or modify
640 it under the same terms as Perl itself.
644 I<$Id: //depot/libnet/Net/SMTP.pm#19 $>