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.25"; # $Id: //depot/libnet/Net/SMTP.pm#26 $
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'"])) &&
98 my ($self, $username, $password) = @_;
100 require MIME::Base64;
101 require Authen::SASL;
103 my $mechanisms = $self->supports('AUTH',500,["Command unknown: 'AUTH'"]);
104 return unless defined $mechanisms;
108 if (ref($username) and UNIVERSAL::isa($username,'Authen::SASL')) {
110 $sasl->mechanism($mechanisms);
113 die "auth(username, password)" if not length $username;
114 $sasl = Authen::SASL->new(mechanism=> $mechanisms,
115 callback => { user => $username,
117 authname => $username,
121 # We should probably allow the user to pass the host, but I don't
122 # currently know and SASL mechanisms that are used by smtp that need it
123 my $client = $sasl->client_new('smtp',${*$self}{'net_smtp_host'},0);
124 my $str = $client->client_start;
125 # We dont support sasl mechanisms that encrypt the socket traffic.
126 # todo that we would really need to change the ISA hierarchy
127 # so we dont inherit from IO::Socket, but instead hold it in an attribute
129 my @cmd = ("AUTH", $client->mechanism);
132 push @cmd, MIME::Base64::encode_base64($str,'')
133 if defined $str and length $str;
135 while (($code = $self->command(@cmd)->response()) == CMD_MORE) {
136 @cmd = (MIME::Base64::encode_base64(
137 $client->client_step(
138 MIME::Base64::decode_base64(
151 my $domain = shift || "localhost.localdomain";
152 my $ok = $me->_EHLO($domain);
153 my @msg = $me->message;
157 my $h = ${*$me}{'net_smtp_esmtp'} = {};
161 if $ln =~ /(\w+)\b[= \t]*([^\n]*)/;
164 elsif($me->status == CMD_ERROR)
167 if $ok = $me->_HELO($domain);
170 $ok && $msg[0] =~ /\A\s*(\S+)/
178 return ${*$self}{'net_smtp_esmtp'}->{$cmd}
179 if exists ${*$self}{'net_smtp_esmtp'}->{$cmd};
180 $self->set_status(@_)
187 $addr = "" unless defined $addr;
188 $addr =~ s/^\s*<?\s*|\s*>?\s*$//sg;
195 my $addr = _addr(shift);
203 if(exists ${*$me}{'net_smtp_esmtp'})
205 my $esmtp = ${*$me}{'net_smtp_esmtp'};
207 if(defined($v = delete $opt{Size}))
209 if(exists $esmtp->{SIZE})
211 $opts .= sprintf " SIZE=%d", $v + 0
215 carp 'Net::SMTP::mail: SIZE option not supported by host';
219 if(defined($v = delete $opt{Return}))
221 if(exists $esmtp->{DSN})
223 $opts .= " RET=" . uc $v
227 carp 'Net::SMTP::mail: DSN option not supported by host';
231 if(defined($v = delete $opt{Bits}))
233 if(exists $esmtp->{'8BITMIME'})
235 $opts .= $v == 8 ? " BODY=8BITMIME" : " BODY=7BIT"
239 carp 'Net::SMTP::mail: 8BITMIME option not supported by host';
243 if(defined($v = delete $opt{Transaction}))
245 if(exists $esmtp->{CHECKPOINT})
247 $opts .= " TRANSID=" . _addr($v);
251 carp 'Net::SMTP::mail: CHECKPOINT option not supported by host';
255 if(defined($v = delete $opt{Envelope}))
257 if(exists $esmtp->{DSN})
259 $v =~ s/([^\041-\176]|=|\+)/sprintf "+%02x", ord($1)/sge;
264 carp 'Net::SMTP::mail: DSN option not supported by host';
268 carp 'Net::SMTP::recipient: unknown option(s) '
269 . join(" ", keys %opt)
275 carp 'Net::SMTP::mail: ESMTP not supported by host - options discarded :-(';
279 $me->_MAIL("FROM:".$addr.$opts);
282 sub send { shift->_SEND("FROM:" . _addr($_[0])) }
283 sub send_or_mail { shift->_SOML("FROM:" . _addr($_[0])) }
284 sub send_and_mail { shift->_SAML("FROM:" . _addr($_[0])) }
291 if(exists ${*$me}{'net_smtp_lastch'});
303 if(@_ && ref($_[-1]))
305 my %opt = %{pop(@_)};
308 $skip_bad = delete $opt{'SkipBad'};
310 if(exists ${*$smtp}{'net_smtp_esmtp'})
312 my $esmtp = ${*$smtp}{'net_smtp_esmtp'};
314 if(defined($v = delete $opt{Notify}))
316 if(exists $esmtp->{DSN})
318 $opts .= " NOTIFY=" . join(",",map { uc $_ } @$v)
322 carp 'Net::SMTP::recipient: DSN option not supported by host';
326 carp 'Net::SMTP::recipient: unknown option(s) '
327 . join(" ", keys %opt)
333 carp 'Net::SMTP::recipient: ESMTP not supported by host - options discarded :-(';
341 if($smtp->_RCPT("TO:" . _addr($addr) . $opts)) {
342 push(@ok,$addr) if $skip_bad;
349 return $skip_bad ? @ok : 1;
362 my $ok = $me->_DATA() && $me->datasend(@_);
364 $ok && @_ ? $me->dataend
370 return unless $me->_DATA();
378 $me->_EXPN(@_) ? ($me->message)
383 sub verify { shift->_VRFY(@_) }
389 $me->_HELP(@_) ? scalar $me->message
410 sub _EHLO { shift->command("EHLO", @_)->response() == CMD_OK }
411 sub _HELO { shift->command("HELO", @_)->response() == CMD_OK }
412 sub _MAIL { shift->command("MAIL", @_)->response() == CMD_OK }
413 sub _RCPT { shift->command("RCPT", @_)->response() == CMD_OK }
414 sub _SEND { shift->command("SEND", @_)->response() == CMD_OK }
415 sub _SAML { shift->command("SAML", @_)->response() == CMD_OK }
416 sub _SOML { shift->command("SOML", @_)->response() == CMD_OK }
417 sub _VRFY { shift->command("VRFY", @_)->response() == CMD_OK }
418 sub _EXPN { shift->command("EXPN", @_)->response() == CMD_OK }
419 sub _HELP { shift->command("HELP", @_)->response() == CMD_OK }
420 sub _RSET { shift->command("RSET")->response() == CMD_OK }
421 sub _NOOP { shift->command("NOOP")->response() == CMD_OK }
422 sub _QUIT { shift->command("QUIT")->response() == CMD_OK }
423 sub _DATA { shift->command("DATA")->response() == CMD_MORE }
424 sub _TURN { shift->unsupported(@_); }
425 sub _ETRN { shift->command("ETRN", @_)->response() == CMD_OK }
426 sub _AUTH { shift->command("AUTH", @_)->response() == CMD_OK }
434 Net::SMTP - Simple Mail Transfer Protocol Client
441 $smtp = Net::SMTP->new('mailhost');
442 $smtp = Net::SMTP->new('mailhost', Timeout => 60);
446 This module implements a client interface to the SMTP and ESMTP
447 protocol, enabling a perl5 application to talk to SMTP servers. This
448 documentation assumes that you are familiar with the concepts of the
449 SMTP protocol described in RFC821.
451 A new Net::SMTP object must be created with the I<new> method. Once
452 this has been done, all SMTP commands are accessed through this object.
454 The Net::SMTP class is a subclass of Net::Cmd and IO::Socket::INET.
458 This example prints the mail domain name of the SMTP server known as mailhost:
460 #!/usr/local/bin/perl -w
464 $smtp = Net::SMTP->new('mailhost');
465 print $smtp->domain,"\n";
468 This example sends a small message to the postmaster at the SMTP server
471 #!/usr/local/bin/perl -w
475 $smtp = Net::SMTP->new('mailhost');
477 $smtp->mail($ENV{USER});
478 $smtp->to('postmaster');
481 $smtp->datasend("To: postmaster\n");
482 $smtp->datasend("\n");
483 $smtp->datasend("A simple test message\n");
492 =item new Net::SMTP [ HOST, ] [ OPTIONS ]
494 This is the constructor for a new Net::SMTP object. C<HOST> is the
495 name of the remote host to which an SMTP connection is required.
497 If C<HOST> is not given, then the C<SMTP_Host> specified in C<Net::Config>
500 C<OPTIONS> are passed in a hash like fashion, using key and value pairs.
501 Possible options are:
503 B<Hello> - SMTP requires that you identify yourself. This option
504 specifies a string to pass as your mail domain. If not
505 given a guess will be taken.
507 B<LocalAddr> and B<LocalPort> - These parameters are passed directly
508 to IO::Socket to allow binding the socket to a local port.
510 B<Timeout> - Maximum time, in seconds, to wait for a response from the
511 SMTP server (default: 120)
513 B<Debug> - Enable debugging information
519 $smtp = Net::SMTP->new('mailhost',
520 Hello => 'my.mail.domain'
529 Unless otherwise stated all methods return either a I<true> or I<false>
530 value, with I<true> meaning that the operation was a success. When a method
531 states that it returns a value, failure will be returned as I<undef> or an
538 Returns the banner message which the server replied with when the
539 initial connection was made.
543 Returns the domain that the remote SMTP server identified itself as during
546 =item hello ( DOMAIN )
548 Tell the remote server the mail domain which you are in using the EHLO
549 command (or HELO if EHLO fails). Since this method is invoked
550 automatically when the Net::SMTP object is constructed the user should
551 normally not have to call it manually.
553 =item etrn ( DOMAIN )
555 Request a queue run for the DOMAIN given.
557 =item auth ( USERNAME, PASSWORD )
559 Attempt SASL authentication.
561 =item mail ( ADDRESS [, OPTIONS] )
563 =item send ( ADDRESS )
565 =item send_or_mail ( ADDRESS )
567 =item send_and_mail ( ADDRESS )
569 Send the appropriate command to the server MAIL, SEND, SOML or SAML. C<ADDRESS>
570 is the address of the sender. This initiates the sending of a message. The
571 method C<recipient> should be called for each address that the message is to
574 The C<mail> method can some additional ESMTP OPTIONS which is passed
575 in hash like fashion, using key and value pairs. Possible options are:
580 Transaction => <ADDRESS>
586 Reset the status of the server. This may be called after a message has been
587 initiated, but before any data has been sent, to cancel the sending of the
590 =item recipient ( ADDRESS [, ADDRESS [ ...]] [, OPTIONS ] )
592 Notify the server that the current message should be sent to all of the
593 addresses given. Each address is sent as a separate command to the server.
594 Should the sending of any address result in a failure then the
595 process is aborted and a I<false> value is returned. It is up to the
596 user to call C<reset> if they so desire.
598 The C<recipient> method can some additional OPTIONS which is passed
599 in hash like fashion, using key and value pairs. Possible options are:
602 SkipBad => ignore bad addresses
604 If C<SkipBad> is true the C<recipient> will not return an error when a
605 bad address is encountered and it will return an array of addresses
608 $smtp->recipient($recipient1,$recipient2); # Good
609 $smtp->recipient($recipient1,$recipient2, { SkipBad => 1 }); # Good
610 $smtp->recipient("$recipient,$recipient2"); # BAD
612 =item to ( ADDRESS [, ADDRESS [...]] )
614 =item cc ( ADDRESS [, ADDRESS [...]] )
616 =item bcc ( ADDRESS [, ADDRESS [...]] )
618 Synonyms for C<recipient>.
620 =item data ( [ DATA ] )
622 Initiate the sending of the data from the current message.
624 C<DATA> may be a reference to a list or a list. If specified the contents
625 of C<DATA> and a termination string C<".\r\n"> is sent to the server. And the
626 result will be true if the data was accepted.
628 If C<DATA> is not specified then the result will indicate that the server
629 wishes the data to be sent. The data must then be sent using the C<datasend>
630 and C<dataend> methods described in L<Net::Cmd>.
632 =item expand ( ADDRESS )
634 Request the server to expand the given address Returns an array
635 which contains the text read from the server.
637 =item verify ( ADDRESS )
639 Verify that C<ADDRESS> is a legitimate mailing address.
641 =item help ( [ $subject ] )
643 Request help text from the server. Returns the text or undef upon failure
647 Send the QUIT command to the remote SMTP server and close the socket connection.
653 All methods that accept addresses expect the address to be a valid rfc2821-quoted address, although
654 Net::SMTP will accept accept the address surrounded by angle brackets.
656 funny user@domain WRONG
657 "funny user"@domain RIGHT, recommended
658 <"funny user"@domain> OK
666 Graham Barr <gbarr@pobox.com>
670 Copyright (c) 1995-1997 Graham Barr. All rights reserved.
671 This program is free software; you can redistribute it and/or modify
672 it under the same terms as Perl itself.
676 I<$Id: //depot/libnet/Net/SMTP.pm#26 $>