Mail-Sender
view release on metacpan or search on metacpan
lib/Mail/Sender.pm view on Meta::CPAN
warnings::warnif('deprecated', 'Mail::Sender is deprecated and you should look to Email::Sender instead');
our $GMTdiff;
our $Error;
our %default; # loaded in from our config files
our $MD5_loaded = 0;
our $debug = 0;
our %CTypes = (
GIF => 'image/gif',
JPE => 'image/jpeg',
JPEG => 'image/jpeg',
SHTML => 'text/html',
SHTM => 'text/html',
HTML => 'text/html',
HTM => 'text/html',
TXT => 'text/plain',
INI => 'text/plain',
DOC => 'application/x-msword',
EML => 'message/rfc822',
);
our @Errors = (
'OK',
'Unknown encoding',
'TLS unsupported by server',
'TLS unsupported by script',
'IO::SOCKET::SSL failed',
'STARTTLS failed',
'debug file cannot be opened',
'file cannot be read',
'all recipients have been rejected',
'authentication protocol is not implemented',
'login not accepted',
'authentication protocol not accepted by the server',
'no From: address specified',
'no SMTP server specified',
'connection not established. Did you mean MailFile instead of SendFile?',
'site specific error',
'not available in singlepart mode',
'file not found',
'no file name specified in call to MailFile or SendFile',
'no message specified in call to MailMsg or MailFile',
'argument $to empty',
'transmission of message failed',
'local user $to unknown on host $smtp',
'unspecified communication error',
'service not available',
'connect() failed',
'socket() failed',
'$smtphost unknown'
);
# if you do not use MailFile or SendFile and only send 7BIT or 8BIT "encoded"
# messages you may comment out these lines.
#MIME::Base64 and MIME::QuotedPrint may be found at CPAN.
my $TLS_notsupported;
BEGIN {
eval <<'END'
use IO::Socket::SSL;# qw(debug4);
use Net::SSLeay;
1;
END
or $TLS_notsupported = $@;
}
# include config file and libraries when packaging the script
if (0) {
require 'Mail/Sender.config'; # local configuration
require 'Symbol.pm'; # for debuging and GetHandle() method
require 'Tie/Handle.pm'; # for debuging and GetHandle() method
require 'IO/Handle.pm'; # for debuging and GetHandle() method
require 'Digest/HMAC_MD5.pm'; # for CRAM-MD5 authentication only
require 'Authen/NTLM.pm'; # for NTLM authentication only
} # this block above is there to let PAR, PerlApp, PerlCtrl, PerlSvc and Perl2Exe know I may need those files.
BEGIN {
my $config = $INC{'Mail/Sender.pm'};
die
"Wrong case in use statement or Mail::Sender module renamed. Perl is case sensitive!!!\n"
unless $config;
my $compiled = !(-e $config)
; # if the module was not read from disk => the script has been "compiled"
$config =~ s/\.pm$/.config/;
if ($compiled or -e $config) {
# in a Perl2Exe or PerlApp created executable or PerlCtrl generated COM object
# or the config is known to exist
eval { require $config };
if ($@ and $@ !~ /Can't locate /) {
print STDERR "Error in Mail::Sender.config : $@";
}
}
}
#local IP address and name
my $local_name
= $ENV{HOSTNAME} || $ENV{HTTP_HOST} || (gethostbyname 'localhost')[0];
$local_name
=~ s/:.*$//; # the HTTP_HOST may be set to something like "foo.bar.com:1000"
my $local_IP = join('.', unpack('CCCC', (gethostbyname $local_name)[4]));
#time diference to GMT - Windows will not set $ENV{'TZ'}, if you know a better way ...
sub ResetGMTdiff {
my $local = time;
my $gm = Time::Local::timelocal(gmtime $local);
my $sign = qw( + + - ) [$local <=> $gm];
$GMTdiff = sprintf "%s%02d%02d", $sign, (gmtime abs($local - $gm))[2, 1];
return $GMTdiff;
}
ResetGMTdiff();
#
my @priority
= ('', '1 (Highest)', '2 (High)', '3 (Normal)', '4 (Low)', '5 (Lowest)');
#data encoding
my $chunksize = 1024 * 4;
my $chunksize64 = 71 * 57; # must be divisible by 57 !
lib/Mail/Sender.pm view on Meta::CPAN
$Error = "No SMTP server specified";
return -15, $Error;
}
sub _NOFROMSPECIFIED {
$! = 22;
$Error = "No From: address specified";
return -16, $Error;
}
sub _INVALIDAUTH {
my $proto = shift || '';
my $res = shift || '';
$! = 22;
$Error = "Authentication protocol $proto is not accepted by the server";
$Error .= ",\nresponse: $res" if $res;
return -17, $Error;
}
sub _LOGINERROR {
$! = 22;
$Error = "Login not accepted";
return -18, $Error;
}
sub _UNKNOWNAUTH {
my $msg = shift || '';
$! = 22;
$Error = "Authentication protocol $msg is not implemented by Mail::Sender";
return -19, $Error;
}
sub _ALLRECIPIENTSBAD {
$! = 2;
$Error = "All recipients are bad";
return -20, $Error;
}
sub _FILECANTREAD {
my $msg = shift || '';
$Error = "File \"$msg\" cannot be read: $^E";
return -21, $Error;
}
sub _DEBUGFILE {
$Error = shift;
return -22, $Error;
}
sub _STARTTLS {
my $msg = shift || '';
my $two = shift || '';
$! = 5;
$Error = "STARTTLS failed: $msg $two";
return -23, $Error;
}
sub _IO_SOCKET_SSL {
my $msg = shift || '';
$! = 5;
$Error = "IO::Socket::SSL->start_SSL failed: $msg";
return -24, $Error;
}
sub _TLS_UNSUPPORTED_BY_ME {
my $msg = shift || '';
$! = 5;
$Error = "TLS unsupported by the script: $msg";
return -25, $Error;
}
sub _TLS_UNSUPPORTED_BY_SERVER {
$! = 5;
$Error = "TLS unsupported by server";
return -26, $Error;
}
sub _UNKNOWNENCODING {
my $msg = shift || '';
$! = 5;
$Error = "Unknown encoding '$msg'";
return -27, $Error;
}
sub new {
my $this = shift;
my $self = {};
my $class;
if (ref($this)) {
$class = ref($this);
%$self = %$this;
}
else {
$class = $this;
}
bless $self, $class;
return $self->_initialize(@_);
}
sub _initialize {
undef $Error;
my $self = shift;
delete $self->{'_buffer'};
$self->{'debug'} = 0;
$self->{'proto'} = (getprotobyname('tcp'))[2];
$self->{'port'} = getservbyname('smtp', 'tcp') || 25
unless $self->{'port'};
$self->{'boundary'} = 'Message-Boundary-by-Mail-Sender-' . time();
$self->{'multipart'} = 'mixed'; # default is multipart/mixed
$self->{'tls_allowed'} = 1;
$self->{'client'} = $local_name;
# Copy defaults from %default
foreach my $key (keys %default) {
$self->{lc $key} = $default{$key};
}
lib/Mail/Sender.pm view on Meta::CPAN
return $self;
}
sub GuessCType {
my $file = shift;
if (defined $file && $file =~ /\.(.*)$/) {
return $CTypes{uc($1)} || 'application/octet-stream';
}
return 'application/octet-stream';
}
sub Connect {
my $self = shift();
my $s = IO::Socket::INET->new(
PeerHost => $self->{'smtp'},
PeerPort => $self->{'port'},
Proto => "tcp",
Timeout => ($self->{'timeout'} || 120),
) or return $self->Error(_CONNFAILED);
$s->autoflush(1);
binmode($s);
if ($self->{'debug'}) {
eval { $s = __Debug($s, $self->{'debug'}); }
or return $self->Error(_DEBUGFILE($@));
$self->{'debug_level'} = 4 unless defined $self->{'debug_level'};
}
$_ = get_response($s);
if (not $_ or !/^[123]/) { return $self->Error(_SERVNOTAVAIL($_)); }
$self->{'server'} = substr $_, 4;
$self->{'!greeting'} = $_;
{
my $res = $self->_say_helo($s);
return $res if $res;
}
if (
($self->{tls_required} or $self->{tls_allowed})
and !$TLS_notsupported
and ( defined($self->{'supports'}{STARTTLS})
or defined($self->{'supports'}{TLS}))
)
{
Net::SSLeay::load_error_strings();
Net::SSLeay::SSLeay_add_ssl_algorithms();
$Net::SSLeay::random_device = $0 if (!-s $Net::SSLeay::random_device);
Net::SSLeay::randomize();
my $res = send_cmd $s, "STARTTLS";
my ($code, $text) = split(/\s/, $res, 2);
return $self->Error(_STARTTLS($code, $text)) if ($code != 220);
my %ssl_options = (
SSL_version => 'TLSv1',
SSL_verify_mode => IO::Socket::SSL::SSL_VERIFY_NONE(),
);
if (exists $self->{ssl_version}) {
$ssl_options{SSL_version} = $self->{ssl_version};
}
if (exists $self->{ssl_verify_mode}) {
$ssl_options{SSL_verify_mode} = $self->{ssl_verify_mode};
}
if (exists $self->{ssl_ca_path}) {
$ssl_options{SSL_ca_path} = $self->{ssl_ca_path};
}
if (exists $self->{ssl_ca_file}) {
$ssl_options{SSL_ca_file} = $self->{ssl_ca_file};
}
if (exists $self->{ssl_verifycb_name}) {
$ssl_options{SSL_verifycb_name} = $self->{ssl_verifycb_name};
}
if (exists $self->{ssl_verifycn_schema}) {
$ssl_options{ssl_verifycn_schema} = $self->{ssl_verifycn_schema};
}
if (exists $self->{ssl_hostname}) {
$ssl_options{SSL_hostname} = $self->{ssl_hostname};
}
if ($self->{'debug'}) {
$res = IO::Socket::SSL->start_SSL(tied(*$s)->[0], %ssl_options);
}
else {
$res = IO::Socket::SSL->start_SSL($s, %ssl_options);
}
if (!$res) {
return $self->Error(_IO_SOCKET_SSL(IO::Socket::SSL::errstr()));
}
{
my $res = $self->_say_helo($s);
return $res if $res;
}
}
elsif ($self->{tls_required}) {
if ($TLS_notsupported) {
return $self->Error(_TLS_UNSUPPORTED_BY_ME($TLS_notsupported));
}
else {
return $self->Error(_TLS_UNSUPPORTED_BY_SERVER());
}
}
if ($self->{'auth'} or $self->{'username'}) {
$self->{'socket'} = $s;
my $res = $self->login();
return $res if $res;
delete $self->{'socket'}; # it's supposed to be added later
}
return $s;
}
sub Error {
my $self = shift();
if (@_) {
if (defined $self->{'socket'}) {
my $s = $self->{'socket'};
print $s "quit\x0D\x0A";
close $s;
delete $self->{'socket'};
}
delete $self->{'_data'};
($self->{'error'}, $self->{'error_msg'}) = @_;
}
if ($self->{'die_on_errors'} or ($self->{on_errors} && $self->{'on_errors'} eq 'die')) {
die $self->{'error_msg'} . "\n";
}
elsif (exists $self->{'on_errors'}
and (!defined($self->{'on_errors'}) or $self->{'on_errors'} eq 'undef'))
{
return;
}
return $self->{'error'};
}
sub ClearErrors {
my $self = shift();
delete $self->{'error'};
delete $self->{'error_msg'};
undef $Error;
}
sub _prepare_addresses {
my ($self, $type) = @_;
if (ref $self->{$type}) {
$self->{$type . '_list'}
lib/Mail/Sender.pm view on Meta::CPAN
=head1 NAME
Mail::Sender - (DEPRECATED) module for sending mails with attachments through an SMTP server
=head1 DEPRECATED
L<Mail::Sender> is deprecated. L<Email::Sender> is the go-to choice when you
need to send Email from Perl. Go there, be happy!
=head1 SYNOPSIS
use Mail::Sender;
my $sender = Mail::Sender->new({
smtp => 'mail.yourdomain.com',
from => 'your@address.com'
});
$sender->MailFile({
to => 'some@address.com',
subject => 'Here is the file',
msg => "I'm sending you the list you wanted.",
file => 'filename.txt'
});
=head1 DESCRIPTION
L<Mail::Sender> is deprecated. L<Email::Sender> is the go-to choice when you
need to send Email from Perl. Go there, be happy!
L<Mail::Sender> provides an object-oriented interface to sending mails. It directly connects to the mail server using L<IO::Socket>.
=head1 ATTRIBUTES
L<Mail::Sender> implements the following attributes.
* Please note that altering an attribute after object creation is best
handled with creating a copy using C<< $sender = $sender->new({attribute => 'value'}) >>.
To obtain the current value of an attribute, break all the rules and reach in
there! C<< my $val = $sender->{attribute}; >>
=head2 auth
# mutating single attributes could get costly!
$sender = $sender->new({auth => 'PLAIN'});
my $auth = $sender->{auth}; # reach in to grab
The SMTP authentication protocol to use to login to the server currently the
only ones supported are C<LOGIN>, C<PLAIN>, C<CRAM-MD5> and C<NTLM>.
Some protocols have module dependencies. C<CRAM-MD5> depends on L<Digest::HMAC_MD5>
and C<NTLM> on L<Authen::NTLM>.
You may add support for other authentication protocols yourself.
=head2 auth_encoded
# mutating single attributes could get costly!
$sender = $sender->new({auth_encoded => 1});
my $auth_enc = $sender->{auth_encoded}; # reach in to grab
If set to a true value, L<Mail::Sender> attempts to use TLS (encrypted connection)
whenever the server supports it and you have L<IO::Socket::SSL> and L<Net::SSLeay>.
The default value of this option is true! This means that if L<Mail::Sender>
can send the data encrypted, it will.
=head2 authdomain
# mutating single attributes could get costly!
$sender = $sender->new({authdomain => 'bar.com'});
my $domain = $sender->{authdomain}; # reach in to grab
The domain name; used optionally by the C<NTLM> authentication. Other authentication
protocols may use other options as well. They should all start with C<auth> though.
=head2 authid
# mutating single attributes could get costly!
$sender = $sender->new({authid => 'username'});
my $username = $sender->{authid}; # reach in to grab
The username used to login to the server.
=head2 authpwd
# mutating single attributes could get costly!
$sender = $sender->new({authpwd => 'password'});
my $password = $sender->{authpwd}; # reach in to grab
The password used to login to the server.
=head2 bcc
# mutating single attributes could get costly!
$sender = $sender->new({bcc => 'foo@bar.com'});
$sender = $sender->new({bcc => 'foo@bar.com, bar@baz.com'});
$sender = $sender->new({bcc => ['foo@bar.com', 'bar@baz.com']});
my $bcc = $sender->{bcc}; # reach in to grab
Send a blind carbon copy to these addresses.
=head2 boundary
# mutating single attributes could get costly!
$sender = $sender->new({boundary => '--'});
my $boundary = $sender->{boundary}; # reach in to grab
The message boundary. You usually do not have to change this, it might only come in handy if you need
to attach a multi-part mail created by L<Mail::Sender> to your message as a
single part. Even in that case any problems are unlikely.
=head2 cc
# mutating single attributes could get costly!
$sender = $sender->new({cc => 'foo@bar.com'});
$sender = $sender->new({cc => 'foo@bar.com, bar@baz.com'});
$sender = $sender->new({cc => ['foo@bar.com', 'bar@baz.com']});
my $cc = $sender->{cc}; # reach in to grab
Send a carbon copy to these addresses.
=head2 charset
lib/Mail/Sender.pm view on Meta::CPAN
The parameter may be either a string containing the headers in the right format
or a hash containing the headers and their values.
=head2 keepconnection
# mutating single attributes could get costly!
$sender = $sender->new({keepconnection => 1);
$sender = $sender->new({keepconnection => 0});
my $keepcon = $sender->{keepconnection}; # reach in to grab
If set to a true value, it causes the L<Mail::Sender> to keep the connection
open for several messages. The connection will be closed if you call the
L<Mail::Sender/"Close"> method with a true value or if you call
L<Mail::Sender/"Open">, L<Mail::Sender/"OpenMultipart">, L<Mail::Sender/"MailMsg">
or L<Mail::Sender/"MailFile"> with the C<smtp> attribute. This means that if you
want the object to keep the connection, you should pass the C<smtp> either to
L<Mail::Sender/"new"> or only to the first L<Mail::Sender/"Open">,
L<Mail::Sender/"OpenMultipart">, L<Mail::Sender/"MailMsg">
or L<Mail::Sender/"MailFile">!
=head2 multipart
# mutating single attributes could get costly!
$sender = $sender->new({multipart => 'Mixed'});
my $multi = $sender->{multipart}; # reach in to grab
The C<MIME> subtype for the whole message (C<Mixed/Related/Alternative>). You may
need to change this setting if you want to send an HTML body with some inline
images, or if you want to post the message in plain text as well as HTML
(alternative).
=head2 on_errors
# mutating single attributes could get costly!
$sender = $sender->new({on_errors => 'undef'}); # return undef on error
$sender = $sender->new({on_errors => 'die'}); # raise an exception
$sender = $sender->new({on_errors => 'code'}); # return the negative error code (default)
# -1 = $smtphost unknown
# -2 = socket() failed
# -3 = connect() failed
# -4 = service not available
# -5 = unspecified communication error
# -6 = local user $to unknown on host $smtp
# -7 = transmission of message failed
# -8 = argument $to empty
# -9 = no message specified in call to MailMsg or MailFile
# -10 = no file name specified in call to SendFile or MailFile
# -11 = file not found
# -12 = not available in singlepart mode
# -13 = site specific error
# -14 = connection not established. Did you mean MailFile instead of SendFile?
# -15 = no SMTP server specified
# -16 = no From: address specified
# -17 = authentication protocol not accepted by the server
# -18 = login not accepted
# -19 = authentication protocol is not implemented
# -20 = all recipients were rejected by the server
# -21 = file specified as an attachment cannot be read
# -22 = failed to open the specified debug file for writing
# -23 = STARTTLS failed (for SSL or TLS encrypted connections)
# -24 = IO::Socket::SSL->start_SSL failed
# -25 = TLS required by the specified options, but the required modules are not available. Need IO::Socket::SSL and Net::SSLeay
# -26 = TLS required by the specified options, but the server doesn't support it
# -27 = unknown encoding specified for the mail body, part or attachment. Only base64, quoted-printable, 7bit and 8bit supported.
my $on_errors = $sender->{on_errors}; # reach in to grab
say $Mail::Sender::Error; # contains a textual description of last error.
This option allows you to affect the way L<Mail::Sender> reports errors.
All methods return the C<$sender> object if they succeed.
C<< $Mail::Sender::Error >> C<< $sender->{'error'} >> and C<< $sender->{'error_msg'} >>
are set in all cases.
=head2 port
# mutating single attributes could get costly!
$sender = $sender->new({port => 25});
my $port = $sender->{port}; # reach in to grab
The TCP/IP port used form the connection. By default C<getservbyname('smtp', 'tcp')||25>.
You should only need to use this option if your mail server waits on a nonstandard port.
=head2 priority
# mutating single attributes could get costly!
$sender = $sender->new({priority => 1});
# 1. highest
# 2. high
# 3. normal
# 4. low
# 5. lowest
my $priority = $sender->{priority}; # reach in to grab
The message priority number.
=head2 replyto
# mutating single attributes could get costly!
$sender = $sender->new({replyto => 'foo@bar.com'});
my $replyto = $sender->{replyto}; # reach in to grab
The reply to address.
=head2 skip_bad_recipients
# mutating single attributes could get costly!
$sender = $sender->new({skip_bad_recipients => 1);
$sender = $sender->new({skip_bad_recipients => 0});
my $skip = $sender->{skip_bad_recipients}; # reach in to grab
If this option is set to false, or not specified, then L<Mail::Sender> stops
trying to send a message as soon as the first recipient's address fails. If it
is set to a true value, L<Mail::Sender> skips the bad addresses and tries to
send the message at least to the good ones. If all addresses are rejected by the
server, it reports a C<All recipients were rejected> message.
If any addresses were skipped, the C<< $sender->{'skipped_recipients'} >> will
be a reference to a hash containing the failed address and the server's response.
=head2 smtp
# mutating single attributes could get costly!
$sender = $sender->new({smtp => 'smtp.bar.com'});
my $smtp = $sender->{smtp}; # reach in to grab
The IP address or domain of your SMTP server.
=head2 ssl_...
The C<ssl_version>, C<ssl_verify_mode>, C<ssl_ca_path>, C<ssl_ca_file>,
C<ssl_verifycb_name>, C<ssl_verifycn_schema> and C<ssl_hostname> options (if
specified) are passed to L<IO::Socket::SSL/"start_SSL">. The default version is
C<TLSv1> and verify mode is C<IO::Socket::SSL::SSL_VERIFY_NONE>.
If you change the C<ssl_verify_mode> to C<SSL_VERIFY_PEER>, you may need to
specify the C<ssl_ca_file>. If you have L<Mozilla::CA> installed, then setting
it to C<< Mozilla::CA::SSL_ca_file() >> may help.
=head2 subject
# mutating single attributes could get costly!
$sender = $sender->new({subject => 'An email is coming!'});
my $subject = $sender->{subject}; # reach in to grab
The subject of the message.
=head2 tls_allowed
# mutating single attributes could get costly!
$sender = $sender->new({tls_allowed => 1}); # true, default
$sender = $sender->new({tls_allowed => 0}); # false
my $tls = $sender->{tls_allowed}; # reach in to grab
If set to a true value, L<Mail::Sender> will attempt to use TLS (encrypted
connection) whenever the server supports it. This requires that you have
L<IO::Socket::SSL> and L<Net::SSLeay>.
=head2 tls_required
# mutating single attributes could get costly!
$sender = $sender->new({tls_required => 1}); # true, require TLS encryption
$sender = $sender->new({tls_required => 0}); # false, plain. default
my $required = $sender->{tls_required};
If you set this option to a true value, the module will fail if it's unable to use TLS.
=head2 to
# mutating single attributes could get costly!
$sender = $sender->new({to => 'foo@bar.com'});
$sender = $sender->new({to => 'foo@bar.com, bar@baz.com'});
$sender = $sender->new({to => ['foo@bar.com', 'bar@baz.com']});
my $to = $sender->{to}; # reach in to grab
The recipient's addresses. This parameter may be either a comma separated list
of email addresses or a reference to a list of addresses.
=head1 METHODS
L<Mail::Sender> implements the following methods.
=head2 Attach
# set parameters in an ordered list
# -- description, ctype, encoding, disposition, file(s)
$sender = $sender->Attach(
'title', 'application/octet-stream', 'Base64', 'attachment; filename=*', '/file.txt'
);
$sender = $sender->Attach(
'title', 'application/octet-stream', 'Base64', 'attachment; filename=*',
['/file.txt', '/file2.txt']
);
# OR use a hashref
$sender = $sender->Attach({
description => 'some title',
charset => 'US-ASCII', # default
encoding => 'Base64', # default
ctype => 'application/octet-stream', # default
disposition => 'attachment; filename=*', # default
file => ['/file1.txt'], # file names
content_id => '#', # for auto-increment number, or * for filename
});
Sends a file as a separate part of the mail message. Only in multi-part mode.
=head2 Body
# set parameters in an ordered list
# -- charset, encoding, content-type
$sender = $sender->Body('US-ASCII', '7BIT', 'text/plain');
# OR use a hashref
$sender = $sender->Body({
charset => 'US-ASCII', # default
encoding => '7BIT', # default
ctype => 'text/plain', # default
msg => '',
( run in 1.689 second using v1.01-cache-2.11-cpan-39bf76dae61 )