Commit | Line | Data |
7e1af8bc |
1 | # Net::SMTP.pm |
2 | # |
3 | # Copyright (c) 1995 Graham Barr <Graham.Barr@tiuk.ti.com>. All rights |
4 | # reserved. 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 | =head1 NAME |
10 | |
11 | Net::SMTP - Simple Mail transfer Protocol Client |
12 | |
13 | =head1 SYNOPSIS |
14 | |
15 | use Net::SMTP; |
16 | |
17 | # Constructors |
18 | $smtp = Net::SMTP->new('mailhost'); |
19 | $smtp = Net::SMTP->new('mailhost', Timeout => 60); |
20 | |
21 | =head1 DESCRIPTION |
22 | |
23 | This module implements a client interface to the SMTP protocol, enabling |
24 | a perl5 application to talk to SMTP servers. This documentation assumes |
25 | that you are familiar with the SMTP protocol described in RFC821. |
26 | |
27 | A new Net::SMTP object must be created with the I<new> method. Once |
28 | this has been done, all SMTP commands are accessed through this object. |
29 | |
30 | =head1 EXAMPLES |
31 | |
32 | This example prints the mail domain name of the SMTP server known as mailhost: |
33 | |
34 | #!/usr/local/bin/perl -w |
35 | |
36 | use Net::SMTP; |
37 | |
38 | $smtp = Net::SMTP->new('mailhost'); |
39 | |
40 | print $smtp->domain,"\n"; |
41 | |
42 | $smtp->quit; |
43 | |
44 | This example sends a small message to the postmaster at the SMTP server |
45 | known as mailhost: |
46 | |
47 | #!/usr/local/bin/perl -w |
48 | |
49 | use Net::SMTP; |
50 | |
51 | $smtp = Net::SMTP->new('mailhost'); |
52 | |
53 | $smtp->mail($ENV{USER}); |
54 | |
55 | $smtp->to('postmaster'); |
56 | |
57 | $smtp->data(); |
58 | |
59 | $smtp->datasend("To: postmaster\n"); |
60 | $smtp->datasend("\n"); |
61 | $smtp->datasend("A simple test message\n"); |
62 | |
63 | $smtp->dataend(); |
64 | |
65 | $smtp->quit; |
66 | |
67 | =head1 CONSTRUCTOR |
68 | |
69 | =over 4 |
70 | |
71 | =item new ( HOST, [ OPTIONS ] ) |
72 | |
73 | This is the constructor for a new Net::SMTP object. C<HOST> is the |
74 | name of the remote host to which a SMTP connection is required. |
75 | |
76 | C<OPTIONS> are passed in a hash like fasion, using key and value pairs. |
77 | Possible options are: |
78 | |
79 | B<Hello> - SMTP requires that you identify yourself. This option |
80 | specifies a string to pass as your mail domain. If not |
81 | given a guess will be taken. |
82 | |
83 | B<Timeout> - Maximum time, in seconds, to wait for a response from the |
84 | SMTP server (default: 120) |
85 | |
86 | B<Debug> - Enable debugging information |
87 | |
88 | |
89 | Example: |
90 | |
91 | |
92 | $smtp = Net::SMTP->new('mailhost', |
93 | Hello => 'my.mail.domain' |
94 | ); |
95 | |
96 | =head1 METHODS |
97 | |
98 | Unless otherwise stated all methods return either a I<true> or I<false> |
99 | value, with I<true> meaning that the operation was a success. When a method |
100 | states that it returns a value, falure will be returned as I<undef> or an |
101 | empty list. |
102 | |
103 | =over 4 |
104 | |
105 | =item domain () |
106 | |
107 | Returns the domain that the remote SMTP server identified itself as during |
108 | connection. |
109 | |
110 | =item hello ( DOMAIN ) |
111 | |
112 | Tell the remote server the mail domain which you are in using the HELO |
113 | command. |
114 | |
115 | =item mail ( ADDRESS ) |
116 | |
117 | =item send ( ADDRESS ) |
118 | |
119 | =item send_or_mail ( ADDRESS ) |
120 | |
121 | =item send_and_mail ( ADDRESS ) |
122 | |
123 | Send the appropriate command to the server MAIL, SEND, SOML or SAML. C<ADDRESS> |
124 | is the address of the sender. This initiates the sending of a message. The |
125 | method C<recipient> should be called for each address that the message is to |
126 | be sent to. |
127 | |
128 | =item reset () |
129 | |
130 | Reset the status of the server. This may be called after a message has been |
131 | initiated, but before any data has been sent, to cancel the sending of the |
132 | message. |
133 | |
134 | =item recipient ( ADDRESS [, ADDRESS [ ...]] ) |
135 | |
136 | Notify the server that the current message should be sent to all of the |
137 | addresses given. Each address is sent as a separate command to the server. |
138 | Should the sending of any address result in a failure then the |
139 | process is aborted and a I<false> value is returned. It is up to the |
140 | user to call C<reset> if they so desire. |
141 | |
142 | =item to () |
143 | |
144 | A synonym for recipient |
145 | |
146 | =item data ( [ DATA ] ) |
147 | |
148 | Initiate the sending of the data fro the current message. |
149 | |
150 | C<DATA> may be a reference to a list or a list. If specified the contents |
151 | of C<DATA> and a termination string C<".\r\n"> is sent to the server. And the |
152 | result will be true if the data was accepted. |
153 | |
154 | If C<DATA> is not specified then the result will indicate that the server |
155 | wishes the data to be sent. The data must then be sent using the C<datasend> |
156 | and C<dataend> methods defined in C<Net::Cmd>. |
157 | |
158 | =item expand ( ADDRESS ) |
159 | |
160 | Request the server to expand the given address Returns a reference to an array |
161 | which contains the text read from the server. |
162 | |
163 | =item verify ( ADDRESS ) |
164 | |
165 | Verify that C<ADDRESS> is a legitimate mailing address. |
166 | |
167 | =item help ( [ $subject ] ) |
168 | |
169 | Request help text from the server. Returns the text or undef upon failure |
170 | |
171 | =item quit () |
172 | |
173 | Send the QUIT command to the remote SMTP server and close the socket connection. |
174 | |
175 | =back |
176 | |
177 | =head1 SEE ALSO |
178 | |
179 | L<Net::Cmd> |
180 | |
181 | =head1 AUTHOR |
182 | |
183 | Graham Barr <Graham.Barr@tiuk.ti.com> |
184 | |
185 | =head1 REVISION |
186 | |
187 | $Revision: 2.1 $ |
188 | $Date: 1996/08/20 20:23:56 $ |
189 | |
190 | The VERSION is derived from the revision by changing each number after the |
191 | first dot into a 2 digit number so |
192 | |
193 | Revision 1.8 => VERSION 1.08 |
194 | Revision 1.2.3 => VERSION 1.0203 |
195 | |
196 | =head1 COPYRIGHT |
197 | |
198 | Copyright (c) 1995 Graham Barr. All rights reserved. This program is free |
199 | software; you can redistribute it and/or modify it under the same terms |
200 | as Perl itself. |
201 | |
202 | =cut |
203 | |
204 | require 5.001; |
205 | |
206 | use strict; |
207 | use vars qw($VERSION @ISA); |
208 | use Socket 1.3; |
209 | use Carp; |
210 | use IO::Socket; |
211 | use Net::Cmd; |
212 | |
213 | $VERSION = do{my @r=(q$Revision: 2.1 $=~/(\d+)/g);sprintf "%d."."%02d"x$#r,@r}; |
214 | |
215 | @ISA = qw(Net::Cmd IO::Socket::INET); |
216 | |
217 | sub new |
218 | { |
219 | my $self = shift; |
220 | my $type = ref($self) || $self; |
221 | my $host = shift; |
222 | my %arg = @_; |
223 | my $obj = $type->SUPER::new(PeerAddr => $host, |
224 | PeerPort => $arg{Port} || 'smtp(25)', |
225 | Proto => 'tcp', |
226 | Timeout => defined $arg{Timeout} |
227 | ? $arg{Timeout} |
228 | : 120 |
229 | ) or return undef; |
230 | |
231 | $obj->autoflush(1); |
232 | |
233 | $obj->debug(exists $arg{Debug} ? $arg{Debug} : undef); |
234 | |
235 | unless ($obj->response() == CMD_OK) |
236 | { |
237 | $obj->SUPER::close(); |
238 | return undef; |
239 | } |
240 | |
241 | ${*$obj}{'net_smtp_host'} = $host; |
242 | |
243 | (${*$obj}{'net_smtp_domain'}) = $obj->message =~ /\A\s*(\S+)/; |
244 | |
245 | $obj->hello($arg{Hello} || ""); |
246 | |
247 | $obj; |
248 | } |
249 | |
250 | ## |
251 | ## User interface methods |
252 | ## |
253 | |
254 | sub domain |
255 | { |
256 | my $me = shift; |
257 | |
258 | return ${*$me}{'net_smtp_domain'} || undef; |
259 | } |
260 | |
261 | sub hello |
262 | { |
263 | my $me = shift; |
264 | my $domain = shift || |
265 | eval { |
266 | require Net::Domain; |
267 | Net::Domain::hostdomain(); |
268 | } || |
269 | ""; |
270 | my $ok = $me->_EHLO($domain); |
271 | my $msg; |
272 | |
273 | if($ok) |
274 | { |
275 | $msg = $me->message; |
276 | |
277 | my $h = ${*$me}{'net_smtp_esmtp'} = {}; |
278 | my $ext; |
279 | foreach $ext (qw(8BITMIME CHECKPOINT DSN SIZE)) |
280 | { |
281 | $h->{$ext} = 1 |
282 | if $msg =~ /\b${ext}\b/; |
283 | } |
284 | } |
285 | else |
286 | { |
287 | $msg = $me->message |
288 | if $me->_HELO($domain); |
289 | } |
290 | |
291 | $ok && $msg =~ /\A(\S+)/ |
292 | ? $1 |
293 | : undef; |
294 | } |
295 | |
296 | sub _addr |
297 | { |
298 | my $addr = shift || ""; |
299 | |
300 | return $1 |
301 | if $addr =~ /(<[^>]+>)/so; |
302 | |
303 | $addr =~ s/\n/ /sog; |
304 | $addr =~ s/(\A\s+|\s+\Z)//sog; |
305 | |
306 | return "<" . $addr . ">"; |
307 | } |
308 | |
309 | |
310 | sub mail |
311 | { |
312 | my $me = shift; |
313 | my $addr = _addr(shift); |
314 | my $opts = ""; |
315 | |
316 | if(@_) |
317 | { |
318 | my %opt = @_; |
319 | my($k,$v); |
320 | |
321 | if(exists ${*$me}{'net_smtp_esmtp'}) |
322 | { |
323 | my $esmtp = ${*$me}{'net_smtp_esmtp'}; |
324 | |
325 | if(defined($v = delete $opt{Size})) |
326 | { |
327 | if(exists $esmtp->{SIZE}) |
328 | { |
329 | $opts .= sprintf " SIZE=%d", $v + 0 |
330 | } |
331 | else |
332 | { |
333 | carp 'Net::SMTP::mail: SIZE option not supported by host'; |
334 | } |
335 | } |
336 | |
337 | if(defined($v = delete $opt{Return})) |
338 | { |
339 | if(exists $esmtp->{DSN}) |
340 | { |
341 | $opts .= " RET=" . uc $v |
342 | } |
343 | else |
344 | { |
345 | carp 'Net::SMTP::mail: DSN option not supported by host'; |
346 | } |
347 | } |
348 | |
349 | if(defined($v = delete $opt{Bits})) |
350 | { |
351 | if(exists $esmtp->{'8BITMIME'}) |
352 | { |
353 | $opts .= $v == 8 ? " BODY=8BITMIME" : " BODY=7BIT" |
354 | } |
355 | else |
356 | { |
357 | carp 'Net::SMTP::mail: 8BITMIME option not supported by host'; |
358 | } |
359 | } |
360 | |
361 | if(defined($v = delete $opt{Transaction})) |
362 | { |
363 | if(exists $esmtp->{CHECKPOINT}) |
364 | { |
365 | $opts .= " TRANSID=" . _addr($v); |
366 | } |
367 | else |
368 | { |
369 | carp 'Net::SMTP::mail: CHECKPOINT option not supported by host'; |
370 | } |
371 | } |
372 | |
373 | if(defined($v = delete $opt{Envelope})) |
374 | { |
375 | if(exists $esmtp->{DSN}) |
376 | { |
377 | $v =~ s/([^\041-\176]|=|\+)/sprintf "+%02x", ord($1)/sge; |
378 | $opts .= " ENVID=$v" |
379 | } |
380 | else |
381 | { |
382 | carp 'Net::SMTP::mail: DSN option not supported by host'; |
383 | } |
384 | } |
385 | |
386 | carp 'Net::SMTP::recipient: unknown option(s) ' |
387 | . join(" ", keys %opt) |
388 | . ' - ignored' |
389 | if scalar keys %opt; |
390 | } |
391 | else |
392 | { |
393 | carp 'Net::SMTP::mail: ESMTP not supported by host - options discarded :-('; |
394 | } |
395 | } |
396 | |
397 | $me->_MAIL("FROM:".$addr.$opts); |
398 | } |
399 | |
400 | sub send { shift->_SEND("FROM:" . _addr($_[0])) } |
401 | sub send_or_mail { shift->_SOML("FROM:" . _addr($_[0])) } |
402 | sub send_and_mail { shift->_SAML("FROM:" . _addr($_[0])) } |
403 | |
404 | sub reset |
405 | { |
406 | my $me = shift; |
407 | |
408 | $me->dataend() |
409 | if(exists ${*$me}{'net_smtp_lastch'}); |
410 | |
411 | $me->_RSET(); |
412 | } |
413 | |
414 | |
415 | sub recipient |
416 | { |
417 | my $smtp = shift; |
418 | my $ok = 1; |
419 | my $opts = ""; |
420 | |
421 | if(@_ && ref($_[-1])) |
422 | { |
423 | my %opt = %{pop(@_)}; |
424 | my $v; |
425 | |
426 | if(exists ${*$smtp}{'net_smtp_esmtp'}) |
427 | { |
428 | my $esmtp = ${*$smtp}{'net_smtp_esmtp'}; |
429 | |
430 | if(defined($v = delete $opt{Notify})) |
431 | { |
432 | if(exists $esmtp->{DSN}) |
433 | { |
434 | $opts .= " NOTIFY=" . join(",",map { uc $_ } @$v) |
435 | } |
436 | else |
437 | { |
438 | carp 'Net::SMTP::recipient: DSN option not supported by host'; |
439 | } |
440 | } |
441 | |
442 | carp 'Net::SMTP::recipient: unknown option(s) ' |
443 | . join(" ", keys %opt) |
444 | . ' - ignored' |
445 | if scalar keys %opt; |
446 | } |
447 | else |
448 | { |
449 | carp 'Net::SMTP::recipient: ESMTP not supported by host - options discarded :-('; |
450 | } |
451 | } |
452 | |
453 | while($ok && scalar(@_)) |
454 | { |
455 | $ok = $smtp->_RCPT("TO:" . _addr(shift) . $opts); |
456 | } |
457 | |
458 | return $ok; |
459 | } |
460 | |
461 | *to = \&recipient; |
462 | |
463 | sub data |
464 | { |
465 | my $me = shift; |
466 | |
467 | my $ok = $me->_DATA() && $me->datasend(@_); |
468 | |
469 | $ok && @_ ? $me->dataend |
470 | : $ok; |
471 | } |
472 | |
473 | sub expand |
474 | { |
475 | my $me = shift; |
476 | |
477 | $me->_EXPN(@_) ? ($me->message) |
478 | : (); |
479 | } |
480 | |
481 | |
482 | sub verify { shift->_VRFY(@_) } |
483 | |
484 | sub help |
485 | { |
486 | my $me = shift; |
487 | |
488 | $me->_HELP(@_) ? scalar $me->message |
489 | : undef; |
490 | } |
491 | |
492 | sub close |
493 | { |
494 | my $me = shift; |
495 | |
496 | return 1 |
497 | unless (ref($me) && defined fileno($me)); |
498 | |
499 | $me->_QUIT && $me->SUPER::close; |
500 | } |
501 | |
502 | sub DESTROY { shift->close } |
503 | sub quit { shift->close } |
504 | |
505 | ## |
506 | ## RFC821 commands |
507 | ## |
508 | |
509 | sub _EHLO { shift->command("EHLO", @_)->response() == CMD_OK } |
510 | sub _HELO { shift->command("HELO", @_)->response() == CMD_OK } |
511 | sub _MAIL { shift->command("MAIL", @_)->response() == CMD_OK } |
512 | sub _RCPT { shift->command("RCPT", @_)->response() == CMD_OK } |
513 | sub _SEND { shift->command("SEND", @_)->response() == CMD_OK } |
514 | sub _SAML { shift->command("SAML", @_)->response() == CMD_OK } |
515 | sub _SOML { shift->command("SOML", @_)->response() == CMD_OK } |
516 | sub _VRFY { shift->command("VRFY", @_)->response() == CMD_OK } |
517 | sub _EXPN { shift->command("EXPN", @_)->response() == CMD_OK } |
518 | sub _HELP { shift->command("HELP", @_)->response() == CMD_OK } |
519 | sub _RSET { shift->command("RSET")->response() == CMD_OK } |
520 | sub _NOOP { shift->command("NOOP")->response() == CMD_OK } |
521 | sub _QUIT { shift->command("QUIT")->response() == CMD_OK } |
522 | sub _DATA { shift->command("DATA")->response() == CMD_MORE } |
523 | sub _TURN { shift->unsupported(@_); } |
524 | |
525 | 1; |
526 | |