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.24"; # $Id: //depot/libnet/Net/SMTP.pm#25 $
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, MIME::Base64::encode_base64($str,''));
132 while (($code = $self->command(@cmd)->response()) == CMD_MORE) {
133 @cmd = (MIME::Base64::encode_base64(
134 $client->client_step(
135 MIME::Base64::decode_base64(
148 my $domain = shift || "localhost.localdomain";
149 my $ok = $me->_EHLO($domain);
150 my @msg = $me->message;
154 my $h = ${*$me}{'net_smtp_esmtp'} = {};
158 if $ln =~ /(\w+)\b[= \t]*([^\n]*)/;
161 elsif($me->status == CMD_ERROR)
164 if $ok = $me->_HELO($domain);
167 $ok && $msg[0] =~ /\A\s*(\S+)/
175 return ${*$self}{'net_smtp_esmtp'}->{$cmd}
176 if exists ${*$self}{'net_smtp_esmtp'}->{$cmd};
177 $self->set_status(@_)
184 $addr = "" unless defined $addr;
185 $addr =~ s/^\s*<?\s*|\s*>?\s*$//sg;
192 my $addr = _addr(shift);
200 if(exists ${*$me}{'net_smtp_esmtp'})
202 my $esmtp = ${*$me}{'net_smtp_esmtp'};
204 if(defined($v = delete $opt{Size}))
206 if(exists $esmtp->{SIZE})
208 $opts .= sprintf " SIZE=%d", $v + 0
212 carp 'Net::SMTP::mail: SIZE option not supported by host';
216 if(defined($v = delete $opt{Return}))
218 if(exists $esmtp->{DSN})
220 $opts .= " RET=" . uc $v
224 carp 'Net::SMTP::mail: DSN option not supported by host';
228 if(defined($v = delete $opt{Bits}))
230 if(exists $esmtp->{'8BITMIME'})
232 $opts .= $v == 8 ? " BODY=8BITMIME" : " BODY=7BIT"
236 carp 'Net::SMTP::mail: 8BITMIME option not supported by host';
240 if(defined($v = delete $opt{Transaction}))
242 if(exists $esmtp->{CHECKPOINT})
244 $opts .= " TRANSID=" . _addr($v);
248 carp 'Net::SMTP::mail: CHECKPOINT option not supported by host';
252 if(defined($v = delete $opt{Envelope}))
254 if(exists $esmtp->{DSN})
256 $v =~ s/([^\041-\176]|=|\+)/sprintf "+%02x", ord($1)/sge;
261 carp 'Net::SMTP::mail: DSN option not supported by host';
265 carp 'Net::SMTP::recipient: unknown option(s) '
266 . join(" ", keys %opt)
272 carp 'Net::SMTP::mail: ESMTP not supported by host - options discarded :-(';
276 $me->_MAIL("FROM:".$addr.$opts);
279 sub send { shift->_SEND("FROM:" . _addr($_[0])) }
280 sub send_or_mail { shift->_SOML("FROM:" . _addr($_[0])) }
281 sub send_and_mail { shift->_SAML("FROM:" . _addr($_[0])) }
288 if(exists ${*$me}{'net_smtp_lastch'});
300 if(@_ && ref($_[-1]))
302 my %opt = %{pop(@_)};
305 $skip_bad = delete $opt{'SkipBad'};
307 if(exists ${*$smtp}{'net_smtp_esmtp'})
309 my $esmtp = ${*$smtp}{'net_smtp_esmtp'};
311 if(defined($v = delete $opt{Notify}))
313 if(exists $esmtp->{DSN})
315 $opts .= " NOTIFY=" . join(",",map { uc $_ } @$v)
319 carp 'Net::SMTP::recipient: DSN option not supported by host';
323 carp 'Net::SMTP::recipient: unknown option(s) '
324 . join(" ", keys %opt)
330 carp 'Net::SMTP::recipient: ESMTP not supported by host - options discarded :-(';
338 if($smtp->_RCPT("TO:" . _addr($addr) . $opts)) {
339 push(@ok,$addr) if $skip_bad;
346 return $skip_bad ? @ok : 1;
359 my $ok = $me->_DATA() && $me->datasend(@_);
361 $ok && @_ ? $me->dataend
367 return unless $me->_DATA();
375 $me->_EXPN(@_) ? ($me->message)
380 sub verify { shift->_VRFY(@_) }
386 $me->_HELP(@_) ? scalar $me->message
407 sub _EHLO { shift->command("EHLO", @_)->response() == CMD_OK }
408 sub _HELO { shift->command("HELO", @_)->response() == CMD_OK }
409 sub _MAIL { shift->command("MAIL", @_)->response() == CMD_OK }
410 sub _RCPT { shift->command("RCPT", @_)->response() == CMD_OK }
411 sub _SEND { shift->command("SEND", @_)->response() == CMD_OK }
412 sub _SAML { shift->command("SAML", @_)->response() == CMD_OK }
413 sub _SOML { shift->command("SOML", @_)->response() == CMD_OK }
414 sub _VRFY { shift->command("VRFY", @_)->response() == CMD_OK }
415 sub _EXPN { shift->command("EXPN", @_)->response() == CMD_OK }
416 sub _HELP { shift->command("HELP", @_)->response() == CMD_OK }
417 sub _RSET { shift->command("RSET")->response() == CMD_OK }
418 sub _NOOP { shift->command("NOOP")->response() == CMD_OK }
419 sub _QUIT { shift->command("QUIT")->response() == CMD_OK }
420 sub _DATA { shift->command("DATA")->response() == CMD_MORE }
421 sub _TURN { shift->unsupported(@_); }
422 sub _ETRN { shift->command("ETRN", @_)->response() == CMD_OK }
423 sub _AUTH { shift->command("AUTH", @_)->response() == CMD_OK }
431 Net::SMTP - Simple Mail Transfer Protocol Client
438 $smtp = Net::SMTP->new('mailhost');
439 $smtp = Net::SMTP->new('mailhost', Timeout => 60);
443 This module implements a client interface to the SMTP and ESMTP
444 protocol, enabling a perl5 application to talk to SMTP servers. This
445 documentation assumes that you are familiar with the concepts of the
446 SMTP protocol described in RFC821.
448 A new Net::SMTP object must be created with the I<new> method. Once
449 this has been done, all SMTP commands are accessed through this object.
451 The Net::SMTP class is a subclass of Net::Cmd and IO::Socket::INET.
455 This example prints the mail domain name of the SMTP server known as mailhost:
457 #!/usr/local/bin/perl -w
461 $smtp = Net::SMTP->new('mailhost');
462 print $smtp->domain,"\n";
465 This example sends a small message to the postmaster at the SMTP server
468 #!/usr/local/bin/perl -w
472 $smtp = Net::SMTP->new('mailhost');
474 $smtp->mail($ENV{USER});
475 $smtp->to('postmaster');
478 $smtp->datasend("To: postmaster\n");
479 $smtp->datasend("\n");
480 $smtp->datasend("A simple test message\n");
489 =item new Net::SMTP [ HOST, ] [ OPTIONS ]
491 This is the constructor for a new Net::SMTP object. C<HOST> is the
492 name of the remote host to which an SMTP connection is required.
494 If C<HOST> is not given, then the C<SMTP_Host> specified in C<Net::Config>
497 C<OPTIONS> are passed in a hash like fashion, using key and value pairs.
498 Possible options are:
500 B<Hello> - SMTP requires that you identify yourself. This option
501 specifies a string to pass as your mail domain. If not
502 given a guess will be taken.
504 B<LocalAddr> and B<LocalPort> - These parameters are passed directly
505 to IO::Socket to allow binding the socket to a local port.
507 B<Timeout> - Maximum time, in seconds, to wait for a response from the
508 SMTP server (default: 120)
510 B<Debug> - Enable debugging information
516 $smtp = Net::SMTP->new('mailhost',
517 Hello => 'my.mail.domain'
526 Unless otherwise stated all methods return either a I<true> or I<false>
527 value, with I<true> meaning that the operation was a success. When a method
528 states that it returns a value, failure will be returned as I<undef> or an
535 Returns the banner message which the server replied with when the
536 initial connection was made.
540 Returns the domain that the remote SMTP server identified itself as during
543 =item hello ( DOMAIN )
545 Tell the remote server the mail domain which you are in using the EHLO
546 command (or HELO if EHLO fails). Since this method is invoked
547 automatically when the Net::SMTP object is constructed the user should
548 normally not have to call it manually.
550 =item etrn ( DOMAIN )
552 Request a queue run for the DOMAIN given.
554 =item auth ( USERNAME, PASSWORD )
556 Attempt SASL authentication.
558 =item mail ( ADDRESS [, OPTIONS] )
560 =item send ( ADDRESS )
562 =item send_or_mail ( ADDRESS )
564 =item send_and_mail ( ADDRESS )
566 Send the appropriate command to the server MAIL, SEND, SOML or SAML. C<ADDRESS>
567 is the address of the sender. This initiates the sending of a message. The
568 method C<recipient> should be called for each address that the message is to
571 The C<mail> method can some additional ESMTP OPTIONS which is passed
572 in hash like fashion, using key and value pairs. Possible options are:
577 Transaction => <ADDRESS>
583 Reset the status of the server. This may be called after a message has been
584 initiated, but before any data has been sent, to cancel the sending of the
587 =item recipient ( ADDRESS [, ADDRESS [ ...]] [, OPTIONS ] )
589 Notify the server that the current message should be sent to all of the
590 addresses given. Each address is sent as a separate command to the server.
591 Should the sending of any address result in a failure then the
592 process is aborted and a I<false> value is returned. It is up to the
593 user to call C<reset> if they so desire.
595 The C<recipient> method can some additional OPTIONS which is passed
596 in hash like fashion, using key and value pairs. Possible options are:
599 SkipBad => ignore bad addresses
601 If C<SkipBad> is true the C<recipient> will not return an error when a
602 bad address is encountered and it will return an array of addresses
605 $smtp->recipient($recipient1,$recipient2); # Good
606 $smtp->recipient($recipient1,$recipient2, { SkipBad => 1 }); # Good
607 $smtp->recipient("$recipient,$recipient2"); # BAD
609 =item to ( ADDRESS [, ADDRESS [...]] )
611 =item cc ( ADDRESS [, ADDRESS [...]] )
613 =item bcc ( ADDRESS [, ADDRESS [...]] )
615 Synonyms for C<recipient>.
617 =item data ( [ DATA ] )
619 Initiate the sending of the data from the current message.
621 C<DATA> may be a reference to a list or a list. If specified the contents
622 of C<DATA> and a termination string C<".\r\n"> is sent to the server. And the
623 result will be true if the data was accepted.
625 If C<DATA> is not specified then the result will indicate that the server
626 wishes the data to be sent. The data must then be sent using the C<datasend>
627 and C<dataend> methods described in L<Net::Cmd>.
629 =item expand ( ADDRESS )
631 Request the server to expand the given address Returns an array
632 which contains the text read from the server.
634 =item verify ( ADDRESS )
636 Verify that C<ADDRESS> is a legitimate mailing address.
638 =item help ( [ $subject ] )
640 Request help text from the server. Returns the text or undef upon failure
644 Send the QUIT command to the remote SMTP server and close the socket connection.
650 All methods that accept addresses expect the address to be a valid rfc2821-quoted address, although
651 Net::SMTP will accept accept the address surrounded by angle brackets.
653 funny user@domain WRONG
654 "funny user"@domain RIGHT, recommended
655 <"funny user"@domain> OK
663 Graham Barr <gbarr@pobox.com>
667 Copyright (c) 1995-1997 Graham Barr. All rights reserved.
668 This program is free software; you can redistribute it and/or modify
669 it under the same terms as Perl itself.
673 I<$Id: //depot/libnet/Net/SMTP.pm#25 $>