Commit | Line | Data |
406c51ee |
1 | # Net::SMTP.pm |
2 | # |
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. |
6 | |
7 | package Net::SMTP; |
8 | |
9 | require 5.001; |
10 | |
11 | use strict; |
12 | use vars qw($VERSION @ISA); |
13 | use Socket 1.3; |
14 | use Carp; |
15 | use IO::Socket; |
16 | use Net::Cmd; |
17 | use Net::Config; |
18 | |
c8570720 |
19 | $VERSION = "2.18"; # $Id: //depot/libnet/Net/SMTP.pm#19 $ |
406c51ee |
20 | |
21 | @ISA = qw(Net::Cmd IO::Socket::INET); |
22 | |
23 | sub new |
24 | { |
25 | my $self = shift; |
26 | my $type = ref($self) || $self; |
27 | my $host = shift if @_ % 2; |
28 | my %arg = @_; |
29 | my $hosts = defined $host ? [ $host ] : $NetConfig{smtp_hosts}; |
30 | my $obj; |
31 | |
32 | my $h; |
33 | foreach $h (@{$hosts}) |
34 | { |
35 | $obj = $type->SUPER::new(PeerAddr => ($host = $h), |
36 | PeerPort => $arg{Port} || 'smtp(25)', |
37 | Proto => 'tcp', |
38 | Timeout => defined $arg{Timeout} |
39 | ? $arg{Timeout} |
40 | : 120 |
41 | ) and last; |
42 | } |
43 | |
44 | return undef |
45 | unless defined $obj; |
46 | |
47 | $obj->autoflush(1); |
48 | |
49 | $obj->debug(exists $arg{Debug} ? $arg{Debug} : undef); |
50 | |
51 | unless ($obj->response() == CMD_OK) |
52 | { |
53 | $obj->close(); |
54 | return undef; |
55 | } |
56 | |
57 | ${*$obj}{'net_smtp_host'} = $host; |
58 | |
59 | (${*$obj}{'net_smtp_banner'}) = $obj->message; |
60 | (${*$obj}{'net_smtp_domain'}) = $obj->message =~ /\A\s*(\S+)/; |
61 | |
62 | unless($obj->hello($arg{Hello} || "")) |
63 | { |
64 | $obj->close(); |
65 | return undef; |
66 | } |
67 | |
68 | $obj; |
69 | } |
70 | |
71 | ## |
72 | ## User interface methods |
73 | ## |
74 | |
75 | sub banner |
76 | { |
77 | my $me = shift; |
78 | |
79 | return ${*$me}{'net_smtp_banner'} || undef; |
80 | } |
81 | |
82 | sub domain |
83 | { |
84 | my $me = shift; |
85 | |
86 | return ${*$me}{'net_smtp_domain'} || undef; |
87 | } |
88 | |
89 | sub etrn { |
90 | my $self = shift; |
91 | defined($self->supports('ETRN',500,["Command unknown: 'ETRN'"])) && |
92 | $self->_ETRN(@_); |
93 | } |
94 | |
c8570720 |
95 | sub auth { # auth(username, password) by mengwong 20011106. the only supported mechanism at this time is PLAIN. |
96 | # |
97 | # my $auth = $smtp->supports("AUTH"); |
98 | # $smtp->auth("username", "password") or die $smtp->message; |
99 | # |
100 | |
101 | require MIME::Base64; |
102 | |
103 | my $self = shift; |
104 | my ($username, $password) = @_; |
105 | die "auth(username, password)" if not length $username; |
106 | |
107 | my $mechanisms = $self->supports('AUTH',500,["Command unknown: 'AUTH'"]); |
108 | return unless defined $mechanisms; |
109 | |
110 | if (not grep { uc $_ eq "PLAIN" } split ' ', $mechanisms) { |
111 | $self->set_status(500, ["PLAIN mechanism not supported; server supports $mechanisms"]); |
112 | return; |
113 | } |
114 | my $authstring = MIME::Base64::encode_base64(join "\0", ($username)x2, $password); |
115 | $authstring =~ s/\n//g; # wrap long lines |
116 | |
117 | $self->_AUTH("PLAIN $authstring"); |
118 | } |
119 | |
406c51ee |
120 | sub hello |
121 | { |
122 | my $me = shift; |
123 | my $domain = shift || |
124 | eval { |
125 | require Net::Domain; |
126 | Net::Domain::hostfqdn(); |
127 | } || |
128 | ""; |
129 | my $ok = $me->_EHLO($domain); |
130 | my @msg = $me->message; |
131 | |
132 | if($ok) |
133 | { |
134 | my $h = ${*$me}{'net_smtp_esmtp'} = {}; |
135 | my $ln; |
136 | foreach $ln (@msg) { |
686337f3 |
137 | $h->{uc $1} = $2 |
406c51ee |
138 | if $ln =~ /(\S+)\b[ \t]*([^\n]*)/; |
139 | } |
140 | } |
141 | elsif($me->status == CMD_ERROR) |
142 | { |
143 | @msg = $me->message |
144 | if $ok = $me->_HELO($domain); |
145 | } |
146 | |
302c2e6b |
147 | $ok && $msg[0] =~ /\A\s*(\S+)/ |
406c51ee |
148 | ? $1 |
149 | : undef; |
150 | } |
151 | |
152 | sub supports { |
153 | my $self = shift; |
154 | my $cmd = uc shift; |
155 | return ${*$self}{'net_smtp_esmtp'}->{$cmd} |
156 | if exists ${*$self}{'net_smtp_esmtp'}->{$cmd}; |
157 | $self->set_status(@_) |
158 | if @_; |
159 | return; |
160 | } |
161 | |
162 | sub _addr |
163 | { |
164 | my $addr = shift || ""; |
165 | |
166 | return $1 |
167 | if $addr =~ /(<[^>]+>)/so; |
168 | |
169 | $addr =~ s/\n/ /sog; |
170 | $addr =~ s/(\A\s+|\s+\Z)//sog; |
171 | |
172 | return "<" . $addr . ">"; |
173 | } |
174 | |
175 | |
176 | sub mail |
177 | { |
178 | my $me = shift; |
179 | my $addr = _addr(shift); |
180 | my $opts = ""; |
181 | |
182 | if(@_) |
183 | { |
184 | my %opt = @_; |
185 | my($k,$v); |
186 | |
187 | if(exists ${*$me}{'net_smtp_esmtp'}) |
188 | { |
189 | my $esmtp = ${*$me}{'net_smtp_esmtp'}; |
190 | |
191 | if(defined($v = delete $opt{Size})) |
192 | { |
193 | if(exists $esmtp->{SIZE}) |
194 | { |
195 | $opts .= sprintf " SIZE=%d", $v + 0 |
196 | } |
197 | else |
198 | { |
199 | carp 'Net::SMTP::mail: SIZE option not supported by host'; |
200 | } |
201 | } |
202 | |
203 | if(defined($v = delete $opt{Return})) |
204 | { |
205 | if(exists $esmtp->{DSN}) |
206 | { |
207 | $opts .= " RET=" . uc $v |
208 | } |
209 | else |
210 | { |
211 | carp 'Net::SMTP::mail: DSN option not supported by host'; |
212 | } |
213 | } |
214 | |
215 | if(defined($v = delete $opt{Bits})) |
216 | { |
217 | if(exists $esmtp->{'8BITMIME'}) |
218 | { |
219 | $opts .= $v == 8 ? " BODY=8BITMIME" : " BODY=7BIT" |
220 | } |
221 | else |
222 | { |
223 | carp 'Net::SMTP::mail: 8BITMIME option not supported by host'; |
224 | } |
225 | } |
226 | |
227 | if(defined($v = delete $opt{Transaction})) |
228 | { |
229 | if(exists $esmtp->{CHECKPOINT}) |
230 | { |
231 | $opts .= " TRANSID=" . _addr($v); |
232 | } |
233 | else |
234 | { |
235 | carp 'Net::SMTP::mail: CHECKPOINT option not supported by host'; |
236 | } |
237 | } |
238 | |
239 | if(defined($v = delete $opt{Envelope})) |
240 | { |
241 | if(exists $esmtp->{DSN}) |
242 | { |
243 | $v =~ s/([^\041-\176]|=|\+)/sprintf "+%02x", ord($1)/sge; |
244 | $opts .= " ENVID=$v" |
245 | } |
246 | else |
247 | { |
248 | carp 'Net::SMTP::mail: DSN option not supported by host'; |
249 | } |
250 | } |
251 | |
252 | carp 'Net::SMTP::recipient: unknown option(s) ' |
253 | . join(" ", keys %opt) |
254 | . ' - ignored' |
255 | if scalar keys %opt; |
256 | } |
257 | else |
258 | { |
259 | carp 'Net::SMTP::mail: ESMTP not supported by host - options discarded :-('; |
260 | } |
261 | } |
262 | |
263 | $me->_MAIL("FROM:".$addr.$opts); |
264 | } |
265 | |
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])) } |
269 | |
270 | sub reset |
271 | { |
272 | my $me = shift; |
273 | |
274 | $me->dataend() |
275 | if(exists ${*$me}{'net_smtp_lastch'}); |
276 | |
277 | $me->_RSET(); |
278 | } |
279 | |
280 | |
281 | sub recipient |
282 | { |
283 | my $smtp = shift; |
284 | my $opts = ""; |
285 | my $skip_bad = 0; |
286 | |
287 | if(@_ && ref($_[-1])) |
288 | { |
289 | my %opt = %{pop(@_)}; |
290 | my $v; |
291 | |
292 | $skip_bad = delete $opt{'SkipBad'}; |
293 | |
294 | if(exists ${*$smtp}{'net_smtp_esmtp'}) |
295 | { |
296 | my $esmtp = ${*$smtp}{'net_smtp_esmtp'}; |
297 | |
298 | if(defined($v = delete $opt{Notify})) |
299 | { |
300 | if(exists $esmtp->{DSN}) |
301 | { |
302 | $opts .= " NOTIFY=" . join(",",map { uc $_ } @$v) |
303 | } |
304 | else |
305 | { |
306 | carp 'Net::SMTP::recipient: DSN option not supported by host'; |
307 | } |
308 | } |
309 | |
310 | carp 'Net::SMTP::recipient: unknown option(s) ' |
311 | . join(" ", keys %opt) |
312 | . ' - ignored' |
313 | if scalar keys %opt; |
314 | } |
315 | elsif(%opt) |
316 | { |
317 | carp 'Net::SMTP::recipient: ESMTP not supported by host - options discarded :-('; |
318 | } |
319 | } |
320 | |
321 | my @ok; |
322 | my $addr; |
323 | foreach $addr (@_) |
324 | { |
325 | if($smtp->_RCPT("TO:" . _addr($addr) . $opts)) { |
326 | push(@ok,$addr) if $skip_bad; |
327 | } |
328 | elsif(!$skip_bad) { |
329 | return 0; |
330 | } |
331 | } |
332 | |
333 | return $skip_bad ? @ok : 1; |
334 | } |
335 | |
686337f3 |
336 | BEGIN { |
337 | *to = \&recipient; |
338 | *cc = \&recipient; |
339 | *bcc = \&recipient; |
340 | } |
406c51ee |
341 | |
342 | sub data |
343 | { |
344 | my $me = shift; |
345 | |
346 | my $ok = $me->_DATA() && $me->datasend(@_); |
347 | |
348 | $ok && @_ ? $me->dataend |
349 | : $ok; |
350 | } |
351 | |
352 | sub expand |
353 | { |
354 | my $me = shift; |
355 | |
356 | $me->_EXPN(@_) ? ($me->message) |
357 | : (); |
358 | } |
359 | |
360 | |
361 | sub verify { shift->_VRFY(@_) } |
362 | |
363 | sub help |
364 | { |
365 | my $me = shift; |
366 | |
367 | $me->_HELP(@_) ? scalar $me->message |
368 | : undef; |
369 | } |
370 | |
371 | sub quit |
372 | { |
373 | my $me = shift; |
374 | |
375 | $me->_QUIT; |
376 | $me->close; |
377 | } |
378 | |
379 | sub DESTROY |
380 | { |
381 | # ignore |
382 | } |
383 | |
384 | ## |
385 | ## RFC821 commands |
386 | ## |
387 | |
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 } |
c8570720 |
404 | sub _AUTH { shift->command("AUTH", @_)->response() == CMD_OK } |
406c51ee |
405 | |
406 | 1; |
407 | |
408 | __END__ |
409 | |
410 | =head1 NAME |
411 | |
412 | Net::SMTP - Simple Mail Transfer Protocol Client |
413 | |
414 | =head1 SYNOPSIS |
415 | |
416 | use Net::SMTP; |
686337f3 |
417 | |
406c51ee |
418 | # Constructors |
419 | $smtp = Net::SMTP->new('mailhost'); |
420 | $smtp = Net::SMTP->new('mailhost', Timeout => 60); |
421 | |
422 | =head1 DESCRIPTION |
423 | |
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. |
428 | |
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. |
431 | |
432 | The Net::SMTP class is a subclass of Net::Cmd and IO::Socket::INET. |
433 | |
434 | =head1 EXAMPLES |
435 | |
436 | This example prints the mail domain name of the SMTP server known as mailhost: |
437 | |
438 | #!/usr/local/bin/perl -w |
686337f3 |
439 | |
406c51ee |
440 | use Net::SMTP; |
686337f3 |
441 | |
406c51ee |
442 | $smtp = Net::SMTP->new('mailhost'); |
443 | print $smtp->domain,"\n"; |
444 | $smtp->quit; |
445 | |
446 | This example sends a small message to the postmaster at the SMTP server |
447 | known as mailhost: |
448 | |
449 | #!/usr/local/bin/perl -w |
686337f3 |
450 | |
406c51ee |
451 | use Net::SMTP; |
686337f3 |
452 | |
406c51ee |
453 | $smtp = Net::SMTP->new('mailhost'); |
686337f3 |
454 | |
406c51ee |
455 | $smtp->mail($ENV{USER}); |
456 | $smtp->to('postmaster'); |
686337f3 |
457 | |
406c51ee |
458 | $smtp->data(); |
459 | $smtp->datasend("To: postmaster\n"); |
460 | $smtp->datasend("\n"); |
461 | $smtp->datasend("A simple test message\n"); |
462 | $smtp->dataend(); |
686337f3 |
463 | |
406c51ee |
464 | $smtp->quit; |
465 | |
466 | =head1 CONSTRUCTOR |
467 | |
468 | =over 4 |
469 | |
470 | =item new Net::SMTP [ HOST, ] [ OPTIONS ] |
471 | |
472 | This is the constructor for a new Net::SMTP object. C<HOST> is the |
d1be9408 |
473 | name of the remote host to which an SMTP connection is required. |
406c51ee |
474 | |
475 | If C<HOST> is not given, then the C<SMTP_Host> specified in C<Net::Config> |
476 | will be used. |
477 | |
478 | C<OPTIONS> are passed in a hash like fashion, using key and value pairs. |
479 | Possible options are: |
480 | |
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. |
484 | |
485 | B<Timeout> - Maximum time, in seconds, to wait for a response from the |
486 | SMTP server (default: 120) |
487 | |
488 | B<Debug> - Enable debugging information |
489 | |
490 | |
491 | Example: |
492 | |
493 | |
494 | $smtp = Net::SMTP->new('mailhost', |
495 | Hello => 'my.mail.domain' |
496 | Timeout => 30, |
497 | Debug => 1, |
498 | ); |
499 | |
686337f3 |
500 | =back |
501 | |
406c51ee |
502 | =head1 METHODS |
503 | |
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 |
507 | empty list. |
508 | |
509 | =over 4 |
510 | |
511 | =item banner () |
512 | |
513 | Returns the banner message which the server replied with when the |
514 | initial connection was made. |
515 | |
516 | =item domain () |
517 | |
518 | Returns the domain that the remote SMTP server identified itself as during |
519 | connection. |
520 | |
521 | =item hello ( DOMAIN ) |
522 | |
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. |
527 | |
528 | =item etrn ( DOMAIN ) |
529 | |
530 | Request a queue run for the DOMAIN given. |
531 | |
c8570720 |
532 | =item auth ( USERNAME, PASSWORD ) |
533 | |
534 | Attempt SASL authentication. At this time only the PLAIN mechanism is supported. |
535 | |
536 | At some point in the future support for using Authen::SASL will be added |
537 | |
406c51ee |
538 | =item mail ( ADDRESS [, OPTIONS] ) |
539 | |
540 | =item send ( ADDRESS ) |
541 | |
542 | =item send_or_mail ( ADDRESS ) |
543 | |
544 | =item send_and_mail ( ADDRESS ) |
545 | |
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 |
549 | be sent to. |
550 | |
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: |
553 | |
554 | Size => <bytes> |
555 | Return => <???> |
556 | Bits => "7" | "8" |
557 | Transaction => <ADDRESS> |
558 | Envelope => <ENVID> |
559 | |
560 | |
561 | =item reset () |
562 | |
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 |
565 | message. |
566 | |
567 | =item recipient ( ADDRESS [, ADDRESS [ ...]] [, OPTIONS ] ) |
568 | |
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. |
574 | |
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: |
577 | |
578 | Notify => |
579 | SkipBad => ignore bad addresses |
580 | |
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 |
583 | that did succeed. |
584 | |
686337f3 |
585 | $smtp->recipient($recipient1,$recipient2); # Good |
586 | $smtp->recipient($recipient1,$recipient2, { SkipBad => 1 }); # Good |
587 | $smtp->recipient("$recipient,$recipient2"); # BAD |
588 | |
406c51ee |
589 | =item to ( ADDRESS [, ADDRESS [...]] ) |
590 | |
686337f3 |
591 | =item cc ( ADDRESS [, ADDRESS [...]] ) |
592 | |
593 | =item bcc ( ADDRESS [, ADDRESS [...]] ) |
594 | |
595 | Synonyms for C<recipient>. |
406c51ee |
596 | |
597 | =item data ( [ DATA ] ) |
598 | |
599 | Initiate the sending of the data from the current message. |
600 | |
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. |
604 | |
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>. |
608 | |
609 | =item expand ( ADDRESS ) |
610 | |
611 | Request the server to expand the given address Returns an array |
612 | which contains the text read from the server. |
613 | |
614 | =item verify ( ADDRESS ) |
615 | |
616 | Verify that C<ADDRESS> is a legitimate mailing address. |
617 | |
618 | =item help ( [ $subject ] ) |
619 | |
620 | Request help text from the server. Returns the text or undef upon failure |
621 | |
622 | =item quit () |
623 | |
624 | Send the QUIT command to the remote SMTP server and close the socket connection. |
625 | |
626 | =back |
627 | |
628 | =head1 SEE ALSO |
629 | |
630 | L<Net::Cmd> |
631 | |
632 | =head1 AUTHOR |
633 | |
634 | Graham Barr <gbarr@pobox.com> |
635 | |
636 | =head1 COPYRIGHT |
637 | |
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. |
641 | |
686337f3 |
642 | =for html <hr> |
643 | |
c8570720 |
644 | I<$Id: //depot/libnet/Net/SMTP.pm#19 $> |
686337f3 |
645 | |
406c51ee |
646 | =cut |