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.16"; # $Id: //depot/libnet/Net/SMTP.pm#16 $
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'"])) &&
101 Net::Domain::hostfqdn();
104 my $ok = $me->_EHLO($domain);
105 my @msg = $me->message;
109 my $h = ${*$me}{'net_smtp_esmtp'} = {};
113 if $ln =~ /(\S+)\b[ \t]*([^\n]*)/;
116 elsif($me->status == CMD_ERROR)
119 if $ok = $me->_HELO($domain);
122 $ok && $msg[0] =~ /\A(\S+)/
130 return ${*$self}{'net_smtp_esmtp'}->{$cmd}
131 if exists ${*$self}{'net_smtp_esmtp'}->{$cmd};
132 $self->set_status(@_)
139 my $addr = shift || "";
142 if $addr =~ /(<[^>]+>)/so;
145 $addr =~ s/(\A\s+|\s+\Z)//sog;
147 return "<" . $addr . ">";
154 my $addr = _addr(shift);
162 if(exists ${*$me}{'net_smtp_esmtp'})
164 my $esmtp = ${*$me}{'net_smtp_esmtp'};
166 if(defined($v = delete $opt{Size}))
168 if(exists $esmtp->{SIZE})
170 $opts .= sprintf " SIZE=%d", $v + 0
174 carp 'Net::SMTP::mail: SIZE option not supported by host';
178 if(defined($v = delete $opt{Return}))
180 if(exists $esmtp->{DSN})
182 $opts .= " RET=" . uc $v
186 carp 'Net::SMTP::mail: DSN option not supported by host';
190 if(defined($v = delete $opt{Bits}))
192 if(exists $esmtp->{'8BITMIME'})
194 $opts .= $v == 8 ? " BODY=8BITMIME" : " BODY=7BIT"
198 carp 'Net::SMTP::mail: 8BITMIME option not supported by host';
202 if(defined($v = delete $opt{Transaction}))
204 if(exists $esmtp->{CHECKPOINT})
206 $opts .= " TRANSID=" . _addr($v);
210 carp 'Net::SMTP::mail: CHECKPOINT option not supported by host';
214 if(defined($v = delete $opt{Envelope}))
216 if(exists $esmtp->{DSN})
218 $v =~ s/([^\041-\176]|=|\+)/sprintf "+%02x", ord($1)/sge;
223 carp 'Net::SMTP::mail: DSN option not supported by host';
227 carp 'Net::SMTP::recipient: unknown option(s) '
228 . join(" ", keys %opt)
234 carp 'Net::SMTP::mail: ESMTP not supported by host - options discarded :-(';
238 $me->_MAIL("FROM:".$addr.$opts);
241 sub send { shift->_SEND("FROM:" . _addr($_[0])) }
242 sub send_or_mail { shift->_SOML("FROM:" . _addr($_[0])) }
243 sub send_and_mail { shift->_SAML("FROM:" . _addr($_[0])) }
250 if(exists ${*$me}{'net_smtp_lastch'});
262 if(@_ && ref($_[-1]))
264 my %opt = %{pop(@_)};
267 $skip_bad = delete $opt{'SkipBad'};
269 if(exists ${*$smtp}{'net_smtp_esmtp'})
271 my $esmtp = ${*$smtp}{'net_smtp_esmtp'};
273 if(defined($v = delete $opt{Notify}))
275 if(exists $esmtp->{DSN})
277 $opts .= " NOTIFY=" . join(",",map { uc $_ } @$v)
281 carp 'Net::SMTP::recipient: DSN option not supported by host';
285 carp 'Net::SMTP::recipient: unknown option(s) '
286 . join(" ", keys %opt)
292 carp 'Net::SMTP::recipient: ESMTP not supported by host - options discarded :-(';
300 if($smtp->_RCPT("TO:" . _addr($addr) . $opts)) {
301 push(@ok,$addr) if $skip_bad;
308 return $skip_bad ? @ok : 1;
321 my $ok = $me->_DATA() && $me->datasend(@_);
323 $ok && @_ ? $me->dataend
331 $me->_EXPN(@_) ? ($me->message)
336 sub verify { shift->_VRFY(@_) }
342 $me->_HELP(@_) ? scalar $me->message
363 sub _EHLO { shift->command("EHLO", @_)->response() == CMD_OK }
364 sub _HELO { shift->command("HELO", @_)->response() == CMD_OK }
365 sub _MAIL { shift->command("MAIL", @_)->response() == CMD_OK }
366 sub _RCPT { shift->command("RCPT", @_)->response() == CMD_OK }
367 sub _SEND { shift->command("SEND", @_)->response() == CMD_OK }
368 sub _SAML { shift->command("SAML", @_)->response() == CMD_OK }
369 sub _SOML { shift->command("SOML", @_)->response() == CMD_OK }
370 sub _VRFY { shift->command("VRFY", @_)->response() == CMD_OK }
371 sub _EXPN { shift->command("EXPN", @_)->response() == CMD_OK }
372 sub _HELP { shift->command("HELP", @_)->response() == CMD_OK }
373 sub _RSET { shift->command("RSET")->response() == CMD_OK }
374 sub _NOOP { shift->command("NOOP")->response() == CMD_OK }
375 sub _QUIT { shift->command("QUIT")->response() == CMD_OK }
376 sub _DATA { shift->command("DATA")->response() == CMD_MORE }
377 sub _TURN { shift->unsupported(@_); }
378 sub _ETRN { shift->command("ETRN", @_)->response() == CMD_OK }
386 Net::SMTP - Simple Mail Transfer Protocol Client
393 $smtp = Net::SMTP->new('mailhost');
394 $smtp = Net::SMTP->new('mailhost', Timeout => 60);
398 This module implements a client interface to the SMTP and ESMTP
399 protocol, enabling a perl5 application to talk to SMTP servers. This
400 documentation assumes that you are familiar with the concepts of the
401 SMTP protocol described in RFC821.
403 A new Net::SMTP object must be created with the I<new> method. Once
404 this has been done, all SMTP commands are accessed through this object.
406 The Net::SMTP class is a subclass of Net::Cmd and IO::Socket::INET.
410 This example prints the mail domain name of the SMTP server known as mailhost:
412 #!/usr/local/bin/perl -w
416 $smtp = Net::SMTP->new('mailhost');
417 print $smtp->domain,"\n";
420 This example sends a small message to the postmaster at the SMTP server
423 #!/usr/local/bin/perl -w
427 $smtp = Net::SMTP->new('mailhost');
429 $smtp->mail($ENV{USER});
430 $smtp->to('postmaster');
433 $smtp->datasend("To: postmaster\n");
434 $smtp->datasend("\n");
435 $smtp->datasend("A simple test message\n");
444 =item new Net::SMTP [ HOST, ] [ OPTIONS ]
446 This is the constructor for a new Net::SMTP object. C<HOST> is the
447 name of the remote host to which a SMTP connection is required.
449 If C<HOST> is not given, then the C<SMTP_Host> specified in C<Net::Config>
452 C<OPTIONS> are passed in a hash like fashion, using key and value pairs.
453 Possible options are:
455 B<Hello> - SMTP requires that you identify yourself. This option
456 specifies a string to pass as your mail domain. If not
457 given a guess will be taken.
459 B<Timeout> - Maximum time, in seconds, to wait for a response from the
460 SMTP server (default: 120)
462 B<Debug> - Enable debugging information
468 $smtp = Net::SMTP->new('mailhost',
469 Hello => 'my.mail.domain'
478 Unless otherwise stated all methods return either a I<true> or I<false>
479 value, with I<true> meaning that the operation was a success. When a method
480 states that it returns a value, failure will be returned as I<undef> or an
487 Returns the banner message which the server replied with when the
488 initial connection was made.
492 Returns the domain that the remote SMTP server identified itself as during
495 =item hello ( DOMAIN )
497 Tell the remote server the mail domain which you are in using the EHLO
498 command (or HELO if EHLO fails). Since this method is invoked
499 automatically when the Net::SMTP object is constructed the user should
500 normally not have to call it manually.
502 =item etrn ( DOMAIN )
504 Request a queue run for the DOMAIN given.
506 =item mail ( ADDRESS [, OPTIONS] )
508 =item send ( ADDRESS )
510 =item send_or_mail ( ADDRESS )
512 =item send_and_mail ( ADDRESS )
514 Send the appropriate command to the server MAIL, SEND, SOML or SAML. C<ADDRESS>
515 is the address of the sender. This initiates the sending of a message. The
516 method C<recipient> should be called for each address that the message is to
519 The C<mail> method can some additional ESMTP OPTIONS which is passed
520 in hash like fashion, using key and value pairs. Possible options are:
525 Transaction => <ADDRESS>
531 Reset the status of the server. This may be called after a message has been
532 initiated, but before any data has been sent, to cancel the sending of the
535 =item recipient ( ADDRESS [, ADDRESS [ ...]] [, OPTIONS ] )
537 Notify the server that the current message should be sent to all of the
538 addresses given. Each address is sent as a separate command to the server.
539 Should the sending of any address result in a failure then the
540 process is aborted and a I<false> value is returned. It is up to the
541 user to call C<reset> if they so desire.
543 The C<recipient> method can some additional OPTIONS which is passed
544 in hash like fashion, using key and value pairs. Possible options are:
547 SkipBad => ignore bad addresses
549 If C<SkipBad> is true the C<recipient> will not return an error when a
550 bad address is encountered and it will return an array of addresses
553 $smtp->recipient($recipient1,$recipient2); # Good
554 $smtp->recipient($recipient1,$recipient2, { SkipBad => 1 }); # Good
555 $smtp->recipient("$recipient,$recipient2"); # BAD
557 =item to ( ADDRESS [, ADDRESS [...]] )
559 =item cc ( ADDRESS [, ADDRESS [...]] )
561 =item bcc ( ADDRESS [, ADDRESS [...]] )
563 Synonyms for C<recipient>.
565 =item data ( [ DATA ] )
567 Initiate the sending of the data from the current message.
569 C<DATA> may be a reference to a list or a list. If specified the contents
570 of C<DATA> and a termination string C<".\r\n"> is sent to the server. And the
571 result will be true if the data was accepted.
573 If C<DATA> is not specified then the result will indicate that the server
574 wishes the data to be sent. The data must then be sent using the C<datasend>
575 and C<dataend> methods described in L<Net::Cmd>.
577 =item expand ( ADDRESS )
579 Request the server to expand the given address Returns an array
580 which contains the text read from the server.
582 =item verify ( ADDRESS )
584 Verify that C<ADDRESS> is a legitimate mailing address.
586 =item help ( [ $subject ] )
588 Request help text from the server. Returns the text or undef upon failure
592 Send the QUIT command to the remote SMTP server and close the socket connection.
602 Graham Barr <gbarr@pobox.com>
606 Copyright (c) 1995-1997 Graham Barr. All rights reserved.
607 This program is free software; you can redistribute it and/or modify
608 it under the same terms as Perl itself.
612 I<$Id: //depot/libnet/Net/SMTP.pm#16 $>