|
602
|
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 |
|
|
|
19 |
$VERSION = "2.26"; # $Id: //depot/libnet/Net/SMTP.pm#31 $
|
|
|
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 (@{ref($hosts) ? $hosts : [ $hosts ]})
|
|
|
34 |
{
|
|
|
35 |
$obj = $type->SUPER::new(PeerAddr => ($host = $h),
|
|
|
36 |
PeerPort => $arg{Port} || 'smtp(25)',
|
|
|
37 |
LocalAddr => $arg{LocalAddr},
|
|
|
38 |
LocalPort => $arg{LocalPort},
|
|
|
39 |
Proto => 'tcp',
|
|
|
40 |
Timeout => defined $arg{Timeout}
|
|
|
41 |
? $arg{Timeout}
|
|
|
42 |
: 120
|
|
|
43 |
) and last;
|
|
|
44 |
}
|
|
|
45 |
|
|
|
46 |
return undef
|
|
|
47 |
unless defined $obj;
|
|
|
48 |
|
|
|
49 |
$obj->autoflush(1);
|
|
|
50 |
|
|
|
51 |
$obj->debug(exists $arg{Debug} ? $arg{Debug} : undef);
|
|
|
52 |
|
|
|
53 |
unless ($obj->response() == CMD_OK)
|
|
|
54 |
{
|
|
|
55 |
$obj->close();
|
|
|
56 |
return undef;
|
|
|
57 |
}
|
|
|
58 |
|
|
|
59 |
${*$obj}{'net_smtp_exact_addr'} = $arg{ExactAddresses};
|
|
|
60 |
${*$obj}{'net_smtp_host'} = $host;
|
|
|
61 |
|
|
|
62 |
(${*$obj}{'net_smtp_banner'}) = $obj->message;
|
|
|
63 |
(${*$obj}{'net_smtp_domain'}) = $obj->message =~ /\A\s*(\S+)/;
|
|
|
64 |
|
|
|
65 |
unless($obj->hello($arg{Hello} || ""))
|
|
|
66 |
{
|
|
|
67 |
$obj->close();
|
|
|
68 |
return undef;
|
|
|
69 |
}
|
|
|
70 |
|
|
|
71 |
$obj;
|
|
|
72 |
}
|
|
|
73 |
|
|
|
74 |
##
|
|
|
75 |
## User interface methods
|
|
|
76 |
##
|
|
|
77 |
|
|
|
78 |
sub banner
|
|
|
79 |
{
|
|
|
80 |
my $me = shift;
|
|
|
81 |
|
|
|
82 |
return ${*$me}{'net_smtp_banner'} || undef;
|
|
|
83 |
}
|
|
|
84 |
|
|
|
85 |
sub domain
|
|
|
86 |
{
|
|
|
87 |
my $me = shift;
|
|
|
88 |
|
|
|
89 |
return ${*$me}{'net_smtp_domain'} || undef;
|
|
|
90 |
}
|
|
|
91 |
|
|
|
92 |
sub etrn {
|
|
|
93 |
my $self = shift;
|
|
|
94 |
defined($self->supports('ETRN',500,["Command unknown: 'ETRN'"])) &&
|
|
|
95 |
$self->_ETRN(@_);
|
|
|
96 |
}
|
|
|
97 |
|
|
|
98 |
sub auth {
|
|
|
99 |
my ($self, $username, $password) = @_;
|
|
|
100 |
|
|
|
101 |
require MIME::Base64;
|
|
|
102 |
require Authen::SASL;
|
|
|
103 |
|
|
|
104 |
my $mechanisms = $self->supports('AUTH',500,["Command unknown: 'AUTH'"]);
|
|
|
105 |
return unless defined $mechanisms;
|
|
|
106 |
|
|
|
107 |
my $sasl;
|
|
|
108 |
|
|
|
109 |
if (ref($username) and UNIVERSAL::isa($username,'Authen::SASL')) {
|
|
|
110 |
$sasl = $username;
|
|
|
111 |
$sasl->mechanism($mechanisms);
|
|
|
112 |
}
|
|
|
113 |
else {
|
|
|
114 |
die "auth(username, password)" if not length $username;
|
|
|
115 |
$sasl = Authen::SASL->new(mechanism=> $mechanisms,
|
|
|
116 |
callback => { user => $username,
|
|
|
117 |
pass => $password,
|
|
|
118 |
authname => $username,
|
|
|
119 |
});
|
|
|
120 |
}
|
|
|
121 |
|
|
|
122 |
# We should probably allow the user to pass the host, but I don't
|
|
|
123 |
# currently know and SASL mechanisms that are used by smtp that need it
|
|
|
124 |
my $client = $sasl->client_new('smtp',${*$self}{'net_smtp_host'},0);
|
|
|
125 |
my $str = $client->client_start;
|
|
|
126 |
# We dont support sasl mechanisms that encrypt the socket traffic.
|
|
|
127 |
# todo that we would really need to change the ISA hierarchy
|
|
|
128 |
# so we dont inherit from IO::Socket, but instead hold it in an attribute
|
|
|
129 |
|
|
|
130 |
my @cmd = ("AUTH", $client->mechanism);
|
|
|
131 |
my $code;
|
|
|
132 |
|
|
|
133 |
push @cmd, MIME::Base64::encode_base64($str,'')
|
|
|
134 |
if defined $str and length $str;
|
|
|
135 |
|
|
|
136 |
while (($code = $self->command(@cmd)->response()) == CMD_MORE) {
|
|
|
137 |
@cmd = (MIME::Base64::encode_base64(
|
|
|
138 |
$client->client_step(
|
|
|
139 |
MIME::Base64::decode_base64(
|
|
|
140 |
($self->message)[0]
|
|
|
141 |
)
|
|
|
142 |
), ''
|
|
|
143 |
));
|
|
|
144 |
}
|
|
|
145 |
|
|
|
146 |
$code == CMD_OK;
|
|
|
147 |
}
|
|
|
148 |
|
|
|
149 |
sub hello
|
|
|
150 |
{
|
|
|
151 |
my $me = shift;
|
|
|
152 |
my $domain = shift || "localhost.localdomain";
|
|
|
153 |
my $ok = $me->_EHLO($domain);
|
|
|
154 |
my @msg = $me->message;
|
|
|
155 |
|
|
|
156 |
if($ok)
|
|
|
157 |
{
|
|
|
158 |
my $h = ${*$me}{'net_smtp_esmtp'} = {};
|
|
|
159 |
my $ln;
|
|
|
160 |
foreach $ln (@msg) {
|
|
|
161 |
$h->{uc $1} = $2
|
|
|
162 |
if $ln =~ /(\w+)\b[= \t]*([^\n]*)/;
|
|
|
163 |
}
|
|
|
164 |
}
|
|
|
165 |
elsif($me->status == CMD_ERROR)
|
|
|
166 |
{
|
|
|
167 |
@msg = $me->message
|
|
|
168 |
if $ok = $me->_HELO($domain);
|
|
|
169 |
}
|
|
|
170 |
|
|
|
171 |
return undef unless $ok;
|
|
|
172 |
|
|
|
173 |
$msg[0] =~ /\A\s*(\S+)/;
|
|
|
174 |
return ($1 || " ");
|
|
|
175 |
}
|
|
|
176 |
|
|
|
177 |
sub supports {
|
|
|
178 |
my $self = shift;
|
|
|
179 |
my $cmd = uc shift;
|
|
|
180 |
return ${*$self}{'net_smtp_esmtp'}->{$cmd}
|
|
|
181 |
if exists ${*$self}{'net_smtp_esmtp'}->{$cmd};
|
|
|
182 |
$self->set_status(@_)
|
|
|
183 |
if @_;
|
|
|
184 |
return;
|
|
|
185 |
}
|
|
|
186 |
|
|
|
187 |
sub _addr {
|
|
|
188 |
my $self = shift;
|
|
|
189 |
my $addr = shift;
|
|
|
190 |
$addr = "" unless defined $addr;
|
|
|
191 |
|
|
|
192 |
if (${*$self}{'net_smtp_exact_addr'}) {
|
|
|
193 |
return $1 if $addr =~ /^\s*(<.*>)\s*$/s;
|
|
|
194 |
}
|
|
|
195 |
else {
|
|
|
196 |
return $1 if $addr =~ /(<[^>]*>)/;
|
|
|
197 |
$addr =~ s/^\s+|\s+$//sg;
|
|
|
198 |
}
|
|
|
199 |
|
|
|
200 |
"<$addr>";
|
|
|
201 |
}
|
|
|
202 |
|
|
|
203 |
sub mail
|
|
|
204 |
{
|
|
|
205 |
my $me = shift;
|
|
|
206 |
my $addr = _addr($me, shift);
|
|
|
207 |
my $opts = "";
|
|
|
208 |
|
|
|
209 |
if(@_)
|
|
|
210 |
{
|
|
|
211 |
my %opt = @_;
|
|
|
212 |
my($k,$v);
|
|
|
213 |
|
|
|
214 |
if(exists ${*$me}{'net_smtp_esmtp'})
|
|
|
215 |
{
|
|
|
216 |
my $esmtp = ${*$me}{'net_smtp_esmtp'};
|
|
|
217 |
|
|
|
218 |
if(defined($v = delete $opt{Size}))
|
|
|
219 |
{
|
|
|
220 |
if(exists $esmtp->{SIZE})
|
|
|
221 |
{
|
|
|
222 |
$opts .= sprintf " SIZE=%d", $v + 0
|
|
|
223 |
}
|
|
|
224 |
else
|
|
|
225 |
{
|
|
|
226 |
carp 'Net::SMTP::mail: SIZE option not supported by host';
|
|
|
227 |
}
|
|
|
228 |
}
|
|
|
229 |
|
|
|
230 |
if(defined($v = delete $opt{Return}))
|
|
|
231 |
{
|
|
|
232 |
if(exists $esmtp->{DSN})
|
|
|
233 |
{
|
|
|
234 |
$opts .= " RET=" . ((uc($v) eq "FULL") ? "FULL" : "HDRS");
|
|
|
235 |
}
|
|
|
236 |
else
|
|
|
237 |
{
|
|
|
238 |
carp 'Net::SMTP::mail: DSN option not supported by host';
|
|
|
239 |
}
|
|
|
240 |
}
|
|
|
241 |
|
|
|
242 |
if(defined($v = delete $opt{Bits}))
|
|
|
243 |
{
|
|
|
244 |
if($v eq "8")
|
|
|
245 |
{
|
|
|
246 |
if(exists $esmtp->{'8BITMIME'})
|
|
|
247 |
{
|
|
|
248 |
$opts .= " BODY=8BITMIME";
|
|
|
249 |
}
|
|
|
250 |
else
|
|
|
251 |
{
|
|
|
252 |
carp 'Net::SMTP::mail: 8BITMIME option not supported by host';
|
|
|
253 |
}
|
|
|
254 |
}
|
|
|
255 |
elsif($v eq "binary")
|
|
|
256 |
{
|
|
|
257 |
if(exists $esmtp->{'BINARYMIME'} && exists $esmtp->{'CHUNKING'})
|
|
|
258 |
{
|
|
|
259 |
$opts .= " BODY=BINARYMIME";
|
|
|
260 |
${*$me}{'net_smtp_chunking'} = 1;
|
|
|
261 |
}
|
|
|
262 |
else
|
|
|
263 |
{
|
|
|
264 |
carp 'Net::SMTP::mail: BINARYMIME option not supported by host';
|
|
|
265 |
}
|
|
|
266 |
}
|
|
|
267 |
elsif(exists $esmtp->{'8BITMIME'} or exists $esmtp->{'BINARYMIME'})
|
|
|
268 |
{
|
|
|
269 |
$opts .= " BODY=7BIT";
|
|
|
270 |
}
|
|
|
271 |
else
|
|
|
272 |
{
|
|
|
273 |
carp 'Net::SMTP::mail: 8BITMIME and BINARYMIME options not supported by host';
|
|
|
274 |
}
|
|
|
275 |
}
|
|
|
276 |
|
|
|
277 |
if(defined($v = delete $opt{Transaction}))
|
|
|
278 |
{
|
|
|
279 |
if(exists $esmtp->{CHECKPOINT})
|
|
|
280 |
{
|
|
|
281 |
$opts .= " TRANSID=" . _addr($me, $v);
|
|
|
282 |
}
|
|
|
283 |
else
|
|
|
284 |
{
|
|
|
285 |
carp 'Net::SMTP::mail: CHECKPOINT option not supported by host';
|
|
|
286 |
}
|
|
|
287 |
}
|
|
|
288 |
|
|
|
289 |
if(defined($v = delete $opt{Envelope}))
|
|
|
290 |
{
|
|
|
291 |
if(exists $esmtp->{DSN})
|
|
|
292 |
{
|
|
|
293 |
$v =~ s/([^\041-\176]|=|\+)/sprintf "+%02x", ord($1)/sge;
|
|
|
294 |
$opts .= " ENVID=$v"
|
|
|
295 |
}
|
|
|
296 |
else
|
|
|
297 |
{
|
|
|
298 |
carp 'Net::SMTP::mail: DSN option not supported by host';
|
|
|
299 |
}
|
|
|
300 |
}
|
|
|
301 |
|
|
|
302 |
carp 'Net::SMTP::recipient: unknown option(s) '
|
|
|
303 |
. join(" ", keys %opt)
|
|
|
304 |
. ' - ignored'
|
|
|
305 |
if scalar keys %opt;
|
|
|
306 |
}
|
|
|
307 |
else
|
|
|
308 |
{
|
|
|
309 |
carp 'Net::SMTP::mail: ESMTP not supported by host - options discarded :-(';
|
|
|
310 |
}
|
|
|
311 |
}
|
|
|
312 |
|
|
|
313 |
$me->_MAIL("FROM:".$addr.$opts);
|
|
|
314 |
}
|
|
|
315 |
|
|
|
316 |
sub send { my $me = shift; $me->_SEND("FROM:" . _addr($me, $_[0])) }
|
|
|
317 |
sub send_or_mail { my $me = shift; $me->_SOML("FROM:" . _addr($me, $_[0])) }
|
|
|
318 |
sub send_and_mail { my $me = shift; $me->_SAML("FROM:" . _addr($me, $_[0])) }
|
|
|
319 |
|
|
|
320 |
sub reset
|
|
|
321 |
{
|
|
|
322 |
my $me = shift;
|
|
|
323 |
|
|
|
324 |
$me->dataend()
|
|
|
325 |
if(exists ${*$me}{'net_smtp_lastch'});
|
|
|
326 |
|
|
|
327 |
$me->_RSET();
|
|
|
328 |
}
|
|
|
329 |
|
|
|
330 |
|
|
|
331 |
sub recipient
|
|
|
332 |
{
|
|
|
333 |
my $smtp = shift;
|
|
|
334 |
my $opts = "";
|
|
|
335 |
my $skip_bad = 0;
|
|
|
336 |
|
|
|
337 |
if(@_ && ref($_[-1]))
|
|
|
338 |
{
|
|
|
339 |
my %opt = %{pop(@_)};
|
|
|
340 |
my $v;
|
|
|
341 |
|
|
|
342 |
$skip_bad = delete $opt{'SkipBad'};
|
|
|
343 |
|
|
|
344 |
if(exists ${*$smtp}{'net_smtp_esmtp'})
|
|
|
345 |
{
|
|
|
346 |
my $esmtp = ${*$smtp}{'net_smtp_esmtp'};
|
|
|
347 |
|
|
|
348 |
if(defined($v = delete $opt{Notify}))
|
|
|
349 |
{
|
|
|
350 |
if(exists $esmtp->{DSN})
|
|
|
351 |
{
|
|
|
352 |
$opts .= " NOTIFY=" . join(",",map { uc $_ } @$v)
|
|
|
353 |
}
|
|
|
354 |
else
|
|
|
355 |
{
|
|
|
356 |
carp 'Net::SMTP::recipient: DSN option not supported by host';
|
|
|
357 |
}
|
|
|
358 |
}
|
|
|
359 |
|
|
|
360 |
carp 'Net::SMTP::recipient: unknown option(s) '
|
|
|
361 |
. join(" ", keys %opt)
|
|
|
362 |
. ' - ignored'
|
|
|
363 |
if scalar keys %opt;
|
|
|
364 |
}
|
|
|
365 |
elsif(%opt)
|
|
|
366 |
{
|
|
|
367 |
carp 'Net::SMTP::recipient: ESMTP not supported by host - options discarded :-(';
|
|
|
368 |
}
|
|
|
369 |
}
|
|
|
370 |
|
|
|
371 |
my @ok;
|
|
|
372 |
my $addr;
|
|
|
373 |
foreach $addr (@_)
|
|
|
374 |
{
|
|
|
375 |
if($smtp->_RCPT("TO:" . _addr($smtp, $addr) . $opts)) {
|
|
|
376 |
push(@ok,$addr) if $skip_bad;
|
|
|
377 |
}
|
|
|
378 |
elsif(!$skip_bad) {
|
|
|
379 |
return 0;
|
|
|
380 |
}
|
|
|
381 |
}
|
|
|
382 |
|
|
|
383 |
return $skip_bad ? @ok : 1;
|
|
|
384 |
}
|
|
|
385 |
|
|
|
386 |
BEGIN {
|
|
|
387 |
*to = \&recipient;
|
|
|
388 |
*cc = \&recipient;
|
|
|
389 |
*bcc = \&recipient;
|
|
|
390 |
}
|
|
|
391 |
|
|
|
392 |
sub data
|
|
|
393 |
{
|
|
|
394 |
my $me = shift;
|
|
|
395 |
|
|
|
396 |
if(exists ${*$me}{'net_smtp_chunking'})
|
|
|
397 |
{
|
|
|
398 |
carp 'Net::SMTP::data: CHUNKING extension in use, must call bdat instead';
|
|
|
399 |
}
|
|
|
400 |
else
|
|
|
401 |
{
|
|
|
402 |
my $ok = $me->_DATA() && $me->datasend(@_);
|
|
|
403 |
|
|
|
404 |
$ok && @_ ? $me->dataend
|
|
|
405 |
: $ok;
|
|
|
406 |
}
|
|
|
407 |
}
|
|
|
408 |
|
|
|
409 |
sub bdat
|
|
|
410 |
{
|
|
|
411 |
my $me = shift;
|
|
|
412 |
|
|
|
413 |
if(exists ${*$me}{'net_smtp_chunking'})
|
|
|
414 |
{
|
|
|
415 |
my $data = shift;
|
|
|
416 |
|
|
|
417 |
$me->_BDAT(length $data) && $me->rawdatasend($data) &&
|
|
|
418 |
$me->response() == CMD_OK;
|
|
|
419 |
}
|
|
|
420 |
else
|
|
|
421 |
{
|
|
|
422 |
carp 'Net::SMTP::bdat: CHUNKING extension is not in use, call data instead';
|
|
|
423 |
}
|
|
|
424 |
}
|
|
|
425 |
|
|
|
426 |
sub bdatlast
|
|
|
427 |
{
|
|
|
428 |
my $me = shift;
|
|
|
429 |
|
|
|
430 |
if(exists ${*$me}{'net_smtp_chunking'})
|
|
|
431 |
{
|
|
|
432 |
my $data = shift;
|
|
|
433 |
|
|
|
434 |
$me->_BDAT(length $data, "LAST") && $me->rawdatasend($data) &&
|
|
|
435 |
$me->response() == CMD_OK;
|
|
|
436 |
}
|
|
|
437 |
else
|
|
|
438 |
{
|
|
|
439 |
carp 'Net::SMTP::bdat: CHUNKING extension is not in use, call data instead';
|
|
|
440 |
}
|
|
|
441 |
}
|
|
|
442 |
|
|
|
443 |
sub datafh {
|
|
|
444 |
my $me = shift;
|
|
|
445 |
return unless $me->_DATA();
|
|
|
446 |
return $me->tied_fh;
|
|
|
447 |
}
|
|
|
448 |
|
|
|
449 |
sub expand
|
|
|
450 |
{
|
|
|
451 |
my $me = shift;
|
|
|
452 |
|
|
|
453 |
$me->_EXPN(@_) ? ($me->message)
|
|
|
454 |
: ();
|
|
|
455 |
}
|
|
|
456 |
|
|
|
457 |
|
|
|
458 |
sub verify { shift->_VRFY(@_) }
|
|
|
459 |
|
|
|
460 |
sub help
|
|
|
461 |
{
|
|
|
462 |
my $me = shift;
|
|
|
463 |
|
|
|
464 |
$me->_HELP(@_) ? scalar $me->message
|
|
|
465 |
: undef;
|
|
|
466 |
}
|
|
|
467 |
|
|
|
468 |
sub quit
|
|
|
469 |
{
|
|
|
470 |
my $me = shift;
|
|
|
471 |
|
|
|
472 |
$me->_QUIT;
|
|
|
473 |
$me->close;
|
|
|
474 |
}
|
|
|
475 |
|
|
|
476 |
sub DESTROY
|
|
|
477 |
{
|
|
|
478 |
# ignore
|
|
|
479 |
}
|
|
|
480 |
|
|
|
481 |
##
|
|
|
482 |
## RFC821 commands
|
|
|
483 |
##
|
|
|
484 |
|
|
|
485 |
sub _EHLO { shift->command("EHLO", @_)->response() == CMD_OK }
|
|
|
486 |
sub _HELO { shift->command("HELO", @_)->response() == CMD_OK }
|
|
|
487 |
sub _MAIL { shift->command("MAIL", @_)->response() == CMD_OK }
|
|
|
488 |
sub _RCPT { shift->command("RCPT", @_)->response() == CMD_OK }
|
|
|
489 |
sub _SEND { shift->command("SEND", @_)->response() == CMD_OK }
|
|
|
490 |
sub _SAML { shift->command("SAML", @_)->response() == CMD_OK }
|
|
|
491 |
sub _SOML { shift->command("SOML", @_)->response() == CMD_OK }
|
|
|
492 |
sub _VRFY { shift->command("VRFY", @_)->response() == CMD_OK }
|
|
|
493 |
sub _EXPN { shift->command("EXPN", @_)->response() == CMD_OK }
|
|
|
494 |
sub _HELP { shift->command("HELP", @_)->response() == CMD_OK }
|
|
|
495 |
sub _RSET { shift->command("RSET")->response() == CMD_OK }
|
|
|
496 |
sub _NOOP { shift->command("NOOP")->response() == CMD_OK }
|
|
|
497 |
sub _QUIT { shift->command("QUIT")->response() == CMD_OK }
|
|
|
498 |
sub _DATA { shift->command("DATA")->response() == CMD_MORE }
|
|
|
499 |
sub _BDAT { shift->command("BDAT", @_) }
|
|
|
500 |
sub _TURN { shift->unsupported(@_); }
|
|
|
501 |
sub _ETRN { shift->command("ETRN", @_)->response() == CMD_OK }
|
|
|
502 |
sub _AUTH { shift->command("AUTH", @_)->response() == CMD_OK }
|
|
|
503 |
|
|
|
504 |
1;
|
|
|
505 |
|
|
|
506 |
__END__
|
|
|
507 |
|
|
|
508 |
=head1 NAME
|
|
|
509 |
|
|
|
510 |
Net::SMTP - Simple Mail Transfer Protocol Client
|
|
|
511 |
|
|
|
512 |
=head1 SYNOPSIS
|
|
|
513 |
|
|
|
514 |
use Net::SMTP;
|
|
|
515 |
|
|
|
516 |
# Constructors
|
|
|
517 |
$smtp = Net::SMTP->new('mailhost');
|
|
|
518 |
$smtp = Net::SMTP->new('mailhost', Timeout => 60);
|
|
|
519 |
|
|
|
520 |
=head1 DESCRIPTION
|
|
|
521 |
|
|
|
522 |
This module implements a client interface to the SMTP and ESMTP
|
|
|
523 |
protocol, enabling a perl5 application to talk to SMTP servers. This
|
|
|
524 |
documentation assumes that you are familiar with the concepts of the
|
|
|
525 |
SMTP protocol described in RFC821.
|
|
|
526 |
|
|
|
527 |
A new Net::SMTP object must be created with the I<new> method. Once
|
|
|
528 |
this has been done, all SMTP commands are accessed through this object.
|
|
|
529 |
|
|
|
530 |
The Net::SMTP class is a subclass of Net::Cmd and IO::Socket::INET.
|
|
|
531 |
|
|
|
532 |
=head1 EXAMPLES
|
|
|
533 |
|
|
|
534 |
This example prints the mail domain name of the SMTP server known as mailhost:
|
|
|
535 |
|
|
|
536 |
#!/usr/local/bin/perl -w
|
|
|
537 |
|
|
|
538 |
use Net::SMTP;
|
|
|
539 |
|
|
|
540 |
$smtp = Net::SMTP->new('mailhost');
|
|
|
541 |
print $smtp->domain,"\n";
|
|
|
542 |
$smtp->quit;
|
|
|
543 |
|
|
|
544 |
This example sends a small message to the postmaster at the SMTP server
|
|
|
545 |
known as mailhost:
|
|
|
546 |
|
|
|
547 |
#!/usr/local/bin/perl -w
|
|
|
548 |
|
|
|
549 |
use Net::SMTP;
|
|
|
550 |
|
|
|
551 |
$smtp = Net::SMTP->new('mailhost');
|
|
|
552 |
|
|
|
553 |
$smtp->mail($ENV{USER});
|
|
|
554 |
$smtp->to('postmaster');
|
|
|
555 |
|
|
|
556 |
$smtp->data();
|
|
|
557 |
$smtp->datasend("To: postmaster\n");
|
|
|
558 |
$smtp->datasend("\n");
|
|
|
559 |
$smtp->datasend("A simple test message\n");
|
|
|
560 |
$smtp->dataend();
|
|
|
561 |
|
|
|
562 |
$smtp->quit;
|
|
|
563 |
|
|
|
564 |
=head1 CONSTRUCTOR
|
|
|
565 |
|
|
|
566 |
=over 4
|
|
|
567 |
|
|
|
568 |
=item new Net::SMTP [ HOST, ] [ OPTIONS ]
|
|
|
569 |
|
|
|
570 |
This is the constructor for a new Net::SMTP object. C<HOST> is the
|
|
|
571 |
name of the remote host to which an SMTP connection is required.
|
|
|
572 |
|
|
|
573 |
If C<HOST> is an array reference then each value will be attempted
|
|
|
574 |
in turn until a connection is made.
|
|
|
575 |
|
|
|
576 |
If C<HOST> is not given, then the C<SMTP_Host> specified in C<Net::Config>
|
|
|
577 |
will be used.
|
|
|
578 |
|
|
|
579 |
C<OPTIONS> are passed in a hash like fashion, using key and value pairs.
|
|
|
580 |
Possible options are:
|
|
|
581 |
|
|
|
582 |
B<Hello> - SMTP requires that you identify yourself. This option
|
|
|
583 |
specifies a string to pass as your mail domain. If not
|
|
|
584 |
given a guess will be taken.
|
|
|
585 |
|
|
|
586 |
B<LocalAddr> and B<LocalPort> - These parameters are passed directly
|
|
|
587 |
to IO::Socket to allow binding the socket to a local port.
|
|
|
588 |
|
|
|
589 |
B<Timeout> - Maximum time, in seconds, to wait for a response from the
|
|
|
590 |
SMTP server (default: 120)
|
|
|
591 |
|
|
|
592 |
B<ExactAddresses> - If true the all ADDRESS arguments must be as
|
|
|
593 |
defined by C<addr-spec> in RFC2822. If not given, or false, then
|
|
|
594 |
Net::SMTP will attempt to extract the address from the value passed.
|
|
|
595 |
|
|
|
596 |
B<Debug> - Enable debugging information
|
|
|
597 |
|
|
|
598 |
|
|
|
599 |
Example:
|
|
|
600 |
|
|
|
601 |
|
|
|
602 |
$smtp = Net::SMTP->new('mailhost',
|
|
|
603 |
Hello => 'my.mail.domain'
|
|
|
604 |
Timeout => 30,
|
|
|
605 |
Debug => 1,
|
|
|
606 |
);
|
|
|
607 |
|
|
|
608 |
=back
|
|
|
609 |
|
|
|
610 |
=head1 METHODS
|
|
|
611 |
|
|
|
612 |
Unless otherwise stated all methods return either a I<true> or I<false>
|
|
|
613 |
value, with I<true> meaning that the operation was a success. When a method
|
|
|
614 |
states that it returns a value, failure will be returned as I<undef> or an
|
|
|
615 |
empty list.
|
|
|
616 |
|
|
|
617 |
=over 4
|
|
|
618 |
|
|
|
619 |
=item banner ()
|
|
|
620 |
|
|
|
621 |
Returns the banner message which the server replied with when the
|
|
|
622 |
initial connection was made.
|
|
|
623 |
|
|
|
624 |
=item domain ()
|
|
|
625 |
|
|
|
626 |
Returns the domain that the remote SMTP server identified itself as during
|
|
|
627 |
connection.
|
|
|
628 |
|
|
|
629 |
=item hello ( DOMAIN )
|
|
|
630 |
|
|
|
631 |
Tell the remote server the mail domain which you are in using the EHLO
|
|
|
632 |
command (or HELO if EHLO fails). Since this method is invoked
|
|
|
633 |
automatically when the Net::SMTP object is constructed the user should
|
|
|
634 |
normally not have to call it manually.
|
|
|
635 |
|
|
|
636 |
=item etrn ( DOMAIN )
|
|
|
637 |
|
|
|
638 |
Request a queue run for the DOMAIN given.
|
|
|
639 |
|
|
|
640 |
=item auth ( USERNAME, PASSWORD )
|
|
|
641 |
|
|
|
642 |
Attempt SASL authentication.
|
|
|
643 |
|
|
|
644 |
=item mail ( ADDRESS [, OPTIONS] )
|
|
|
645 |
|
|
|
646 |
=item send ( ADDRESS )
|
|
|
647 |
|
|
|
648 |
=item send_or_mail ( ADDRESS )
|
|
|
649 |
|
|
|
650 |
=item send_and_mail ( ADDRESS )
|
|
|
651 |
|
|
|
652 |
Send the appropriate command to the server MAIL, SEND, SOML or SAML. C<ADDRESS>
|
|
|
653 |
is the address of the sender. This initiates the sending of a message. The
|
|
|
654 |
method C<recipient> should be called for each address that the message is to
|
|
|
655 |
be sent to.
|
|
|
656 |
|
|
|
657 |
The C<mail> method can some additional ESMTP OPTIONS which is passed
|
|
|
658 |
in hash like fashion, using key and value pairs. Possible options are:
|
|
|
659 |
|
|
|
660 |
Size => <bytes>
|
|
|
661 |
Return => "FULL" | "HDRS"
|
|
|
662 |
Bits => "7" | "8" | "binary"
|
|
|
663 |
Transaction => <ADDRESS>
|
|
|
664 |
Envelope => <ENVID>
|
|
|
665 |
|
|
|
666 |
The C<Return> and C<Envelope> parameters are used for DSN (Delivery
|
|
|
667 |
Status Notification).
|
|
|
668 |
|
|
|
669 |
=item reset ()
|
|
|
670 |
|
|
|
671 |
Reset the status of the server. This may be called after a message has been
|
|
|
672 |
initiated, but before any data has been sent, to cancel the sending of the
|
|
|
673 |
message.
|
|
|
674 |
|
|
|
675 |
=item recipient ( ADDRESS [, ADDRESS [ ...]] [, OPTIONS ] )
|
|
|
676 |
|
|
|
677 |
Notify the server that the current message should be sent to all of the
|
|
|
678 |
addresses given. Each address is sent as a separate command to the server.
|
|
|
679 |
Should the sending of any address result in a failure then the
|
|
|
680 |
process is aborted and a I<false> value is returned. It is up to the
|
|
|
681 |
user to call C<reset> if they so desire.
|
|
|
682 |
|
|
|
683 |
The C<recipient> method can some additional OPTIONS which is passed
|
|
|
684 |
in hash like fashion, using key and value pairs. Possible options are:
|
|
|
685 |
|
|
|
686 |
Notify =>
|
|
|
687 |
SkipBad => ignore bad addresses
|
|
|
688 |
|
|
|
689 |
If C<SkipBad> is true the C<recipient> will not return an error when a
|
|
|
690 |
bad address is encountered and it will return an array of addresses
|
|
|
691 |
that did succeed.
|
|
|
692 |
|
|
|
693 |
$smtp->recipient($recipient1,$recipient2); # Good
|
|
|
694 |
$smtp->recipient($recipient1,$recipient2, { SkipBad => 1 }); # Good
|
|
|
695 |
$smtp->recipient("$recipient,$recipient2"); # BAD
|
|
|
696 |
|
|
|
697 |
=item to ( ADDRESS [, ADDRESS [...]] )
|
|
|
698 |
|
|
|
699 |
=item cc ( ADDRESS [, ADDRESS [...]] )
|
|
|
700 |
|
|
|
701 |
=item bcc ( ADDRESS [, ADDRESS [...]] )
|
|
|
702 |
|
|
|
703 |
Synonyms for C<recipient>.
|
|
|
704 |
|
|
|
705 |
=item data ( [ DATA ] )
|
|
|
706 |
|
|
|
707 |
Initiate the sending of the data from the current message.
|
|
|
708 |
|
|
|
709 |
C<DATA> may be a reference to a list or a list. If specified the contents
|
|
|
710 |
of C<DATA> and a termination string C<".\r\n"> is sent to the server. And the
|
|
|
711 |
result will be true if the data was accepted.
|
|
|
712 |
|
|
|
713 |
If C<DATA> is not specified then the result will indicate that the server
|
|
|
714 |
wishes the data to be sent. The data must then be sent using the C<datasend>
|
|
|
715 |
and C<dataend> methods described in L<Net::Cmd>.
|
|
|
716 |
|
|
|
717 |
=item expand ( ADDRESS )
|
|
|
718 |
|
|
|
719 |
Request the server to expand the given address Returns an array
|
|
|
720 |
which contains the text read from the server.
|
|
|
721 |
|
|
|
722 |
=item verify ( ADDRESS )
|
|
|
723 |
|
|
|
724 |
Verify that C<ADDRESS> is a legitimate mailing address.
|
|
|
725 |
|
|
|
726 |
=item help ( [ $subject ] )
|
|
|
727 |
|
|
|
728 |
Request help text from the server. Returns the text or undef upon failure
|
|
|
729 |
|
|
|
730 |
=item quit ()
|
|
|
731 |
|
|
|
732 |
Send the QUIT command to the remote SMTP server and close the socket connection.
|
|
|
733 |
|
|
|
734 |
=back
|
|
|
735 |
|
|
|
736 |
=head1 ADDRESSES
|
|
|
737 |
|
|
|
738 |
Net::SMTP attempts to DWIM with addresses that are passed. For
|
|
|
739 |
example an application might extract The From: line from an email
|
|
|
740 |
and pass that to mail(). While this may work, it is not reccomended.
|
|
|
741 |
The application should really use a module like L<Mail::Address>
|
|
|
742 |
to extract the mail address and pass that.
|
|
|
743 |
|
|
|
744 |
If C<ExactAddresses> is passed to the contructor, then addresses
|
|
|
745 |
should be a valid rfc2821-quoted address, although Net::SMTP will
|
|
|
746 |
accept accept the address surrounded by angle brackets.
|
|
|
747 |
|
|
|
748 |
funny user@domain WRONG
|
|
|
749 |
"funny user"@domain RIGHT, recommended
|
|
|
750 |
<"funny user"@domain> OK
|
|
|
751 |
|
|
|
752 |
=head1 SEE ALSO
|
|
|
753 |
|
|
|
754 |
L<Net::Cmd>
|
|
|
755 |
|
|
|
756 |
=head1 AUTHOR
|
|
|
757 |
|
|
|
758 |
Graham Barr <gbarr@pobox.com>
|
|
|
759 |
|
|
|
760 |
=head1 COPYRIGHT
|
|
|
761 |
|
|
|
762 |
Copyright (c) 1995-1997 Graham Barr. All rights reserved.
|
|
|
763 |
This program is free software; you can redistribute it and/or modify
|
|
|
764 |
it under the same terms as Perl itself.
|
|
|
765 |
|
|
|
766 |
=for html <hr>
|
|
|
767 |
|
|
|
768 |
I<$Id: //depot/libnet/Net/SMTP.pm#31 $>
|
|
|
769 |
|
|
|
770 |
=cut
|