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