Permalink
Switch branches/tags
Nothing to show
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
503 lines (431 sloc) 14.3 KB
# Movable Type (r) (C) 2001-2013 Six Apart, Ltd. All Rights Reserved.
# This code cannot be redistributed without permission from www.sixapart.com.
# For more information, consult your Movable Type license.
#
# $Id$
package MT::Mail;
use strict;
use MT;
use base qw( MT::ErrorHandler );
use Encode;
use Sys::Hostname;
our $MAX_LINE_OCTET = 998;
my %SMTPModules = (
Core => [ 'Net::SMTP', 'MIME::Base64' ],
Auth => ['Authen::SASL'],
SSL => [ 'Net::SMTP::SSL', 'IO::Socket::SSL', 'Net::SSLeay' ],
TLS => [ 'Net::SMTP::TLS', 'IO::Socket::SSL', 'Net::SSLeay' ],
);
sub send {
my $class = shift;
my ( $hdrs_arg, $body ) = @_;
local $hdrs_arg->{id} = $hdrs_arg->{id};
my $id = delete $hdrs_arg->{id};
my %hdrs = map { $_ => $hdrs_arg->{$_} } keys %$hdrs_arg;
foreach my $h ( keys %hdrs ) {
if ( ref( $hdrs{$h} ) eq 'ARRAY' ) {
map {y/\n\r/ /} @{ $hdrs{$h} };
}
else {
$hdrs{$h} =~ y/\n\r/ / unless ( ref( $hdrs{$h} ) );
}
}
my $mgr = MT->config;
my $xfer = $mgr->MailTransfer;
my $mail_enc = uc( $mgr->MailEncoding || $mgr->PublishCharset );
$mail_enc = lc $mail_enc;
require MT::I18N::default;
$body = MT::I18N::default->encode_text_encode( $body, undef, $mail_enc );
eval "require MIME::EncWords;";
unless ($@) {
foreach my $header ( keys %hdrs ) {
my $val = $hdrs{$header};
if ( ref $val eq 'ARRAY' ) {
foreach (@$val) {
if ( ( $mail_enc ne 'iso-8859-1' ) || (m/[^[:print:]]/) )
{
if ( $header =~ m/^(From|To|Reply-To|B?cc)/i ) {
if (m/^(.+?)\s*(<[^@>]+@[^>]+>)\s*$/) {
$_ = MIME::EncWords::encode_mimeword(
MT::I18N::default->encode_text_encode(
$1, undef, $mail_enc
),
'b',
$mail_enc
)
. ' '
. $2;
}
}
elsif ( $header
!~ m/^(Content-Type|Content-Transfer-Encoding|MIME-Version)/i
)
{
$_ = MIME::EncWords::encode_mimeword(
MT::I18N::default->encode_text_encode(
$_, undef, $mail_enc
),
'b',
$mail_enc
);
}
}
}
}
else {
if ( ( $mail_enc ne 'iso-8859-1' )
|| ( $val =~ /[^[:print:]]/ ) )
{
if ( $header =~ m/^(From|To|Reply|B?cc)/i ) {
if ( $val =~ m/^(.+?)\s*(<[^@>]+@[^>]+>)\s*$/ ) {
$hdrs{$header} = MIME::EncWords::encode_mimeword(
MT::I18N::default->encode_text_encode(
$1, undef, $mail_enc
),
'b',
$mail_enc
)
. ' '
. $2;
}
}
elsif ( $header
!~ m/^(Content-Type|Content-Transfer-Encoding|MIME-Version)/i
)
{
$hdrs{$header} = MIME::EncWords::encode_mimeword(
MT::I18N::default->encode_text_encode(
$val, undef, $mail_enc
),
'b',
$mail_enc
);
}
}
}
}
}
else {
$hdrs{Subject}
= MT::I18N::default->encode_text_encode( $hdrs{Subject}, undef,
$mail_enc );
$hdrs{From}
= MT::I18N::default->encode_text_encode( $hdrs{From}, undef,
$mail_enc );
}
$hdrs{'Content-Type'} ||= qq(text/plain; charset=") . $mail_enc . q(");
$hdrs{'Content-Transfer-Encoding'}
= ( ($mail_enc) !~ m/utf-?8/ ) ? '7bit' : '8bit';
$hdrs{'MIME-Version'} ||= "1.0";
$hdrs{From} = $mgr->EmailAddressMain unless exists $hdrs{From};
if ( $body =~ /^.{@{[$MAX_LINE_OCTET+1]},}/m
&& eval { require MIME::Base64 } )
{
$body = MIME::Base64::encode_base64($body);
$hdrs{'Content-Transfer-Encoding'} = 'base64';
}
return 1
unless MT->run_callbacks(
'mail_filter',
args => $hdrs_arg,
headers => \%hdrs,
body => \$body,
transfer => \$xfer,
( $id ? ( id => $id ) : () )
);
if ( $xfer eq 'sendmail' ) {
return $class->_send_mt_sendmail( \%hdrs, $body, $mgr );
}
elsif ( $xfer eq 'smtp' ) {
return $class->_send_mt_smtp( \%hdrs, $body, $mgr );
}
elsif ( $xfer eq 'debug' ) {
return $class->_send_mt_debug( \%hdrs, $body, $mgr );
}
else {
return $class->error(
MT->translate( "Unknown MailTransfer method '[_1]'", $xfer ) );
}
}
use MT::Util qw(is_valid_email);
sub _send_mt_debug {
my $class = shift;
my ( $hdrs, $body, $mgr ) = @_;
$hdrs->{To} = $mgr->DebugEmailAddress
if ( is_valid_email( $mgr->DebugEmailAddress || '' ) );
for my $key ( keys %$hdrs ) {
my @arr
= ref( $hdrs->{$key} ) eq 'ARRAY'
? @{ $hdrs->{$key} }
: ( $hdrs->{$key} );
print STDERR map "$key: $_\n", @arr;
}
print STDERR "\n";
print STDERR $body;
1;
}
sub _send_mt_smtp {
my $class = shift;
my ( $hdrs, $body, $mgr ) = @_;
$hdrs->{To} = $mgr->DebugEmailAddress
if ( is_valid_email( $mgr->DebugEmailAddress || '' ) );
# SMTP Configuration
my $host = $mgr->SMTPServer;
my $user = $mgr->SMTPUser;
my $pass = $mgr->SMTPPassword;
my $localhost = hostname() || 'localhost';
my $port
= $mgr->SMTPPort ? $mgr->SMTPPort
: $mgr->SMTPAuth eq 'ssl' ? 465
: 25;
my ( $auth, $tls, $ssl );
if ( $mgr->SMTPAuth ) {
if ( 'starttls' eq $mgr->SMTPAuth ) {
$tls = 1;
}
elsif ( 'ssl' eq $mgr->SMTPAuth ) {
$ssl = 1;
$auth = 1;
}
else {
$auth = 1;
}
}
return $class->error(
MT->translate(
"Username and password is required for SMTP authentication."
)
)
if ( $tls or $auth )
and ( !$user or !$pass );
# Check required modules;
my $mod_reqd;
my @modules = ();
push @modules, @{ $SMTPModules{Core} };
push @modules, @{ $SMTPModules{Auth} } if $auth;
push @modules, @{ $SMTPModules{SSL} } if $ssl;
push @modules, @{ $SMTPModules{TLS} } if $tls;
$class->can_use( \@modules ) or return;
# Make a smtp object
my $smtp;
if ($tls) {
$smtp = Net::SMTP::TLS->new(
$host,
Port => $port,
User => $user,
Password => $pass,
Timeout => 60,
Hello => $localhost,
( $MT::DebugMode ? ( Debug => 1 ) : () ),
)
or return $class->error(
MT->translate(
'Error connecting to SMTP server [_1]:[_2]',
$host, $port
)
);
}
elsif ($ssl) {
### By EasunLee Net::SMTP can do ssl well itself ,Net::SMTP::SSL is obsolete, use only when necessary,
$smtp = Net::SMTP->new(
$host,
Port => $port,
Timeout => 60,
Hello => $localhost,
SSL => 1,
( $MT::DebugMode ? ( Debug => 1 ) : () ),
)
or return $class->error(
MT->translate(
'Error connecting to SMTP server [_1]:[_2]',
$host, $port
)
);
}
else {
$smtp = Net::SMTP->new(
$host,
Port => $port,
Timeout => 60,
Hello => $localhost,
( $MT::DebugMode ? ( Debug => 1 ) : () ),
)
or return $class->error(
MT->translate(
'Error connecting to SMTP server [_1]:[_2]',
$host, $port
)
);
}
if ($auth) {
if ( !$smtp->auth( $user, $pass ) ) {
return $class->error(
MT->translate(
"Authentication failure: [_1]",
$smtp->message
)
);
}
}
# Set sender header if smtp user id is valid email
$hdrs->{Sender} = $user if MT::Util::is_valid_email($user);
# Setup headers
my $hdr;
foreach my $k ( keys %$hdrs ) {
next if ( $k =~ /^(To|Bcc|Cc)$/ );
$hdr .= "$k: " . $hdrs->{$k} . "\r\n";
}
# Sending mail
$smtp->mail( $hdrs->{From} );
foreach my $h (qw( To Bcc Cc )) {
if ( defined $hdrs->{$h} ) {
my $addr = $hdrs->{$h};
$addr = [$addr] unless 'ARRAY' eq ref $addr;
foreach my $a (@$addr) {
$smtp->recipient($a);
}
$hdr .= "$h: " . join( ",\r\n ", @$addr ) . "\r\n";
}
}
$smtp->data();
$smtp->datasend($hdr);
$smtp->datasend("\n");
$smtp->datasend($body);
$smtp->dataend();
$smtp->quit;
1;
}
my @Sendmail
= qw( /usr/lib/sendmail /usr/sbin/sendmail /usr/ucblib/sendmail );
sub _send_mt_sendmail {
my $class = shift;
my ( $hdrs, $body, $mgr ) = @_;
$hdrs->{To} = $mgr->DebugEmailAddress
if ( is_valid_email( $mgr->DebugEmailAddress || '' ) );
my $sm_loc;
for my $loc ( $mgr->SendMailPath, @Sendmail ) {
next unless $loc;
$sm_loc = $loc, last if -x $loc && !-d $loc;
}
return $class->error(
MT->translate(
"You do not have a valid path to sendmail on your machine. "
. "Perhaps you should try using SMTP?"
)
) unless $sm_loc;
local $SIG{PIPE} = {};
my $pid = open MAIL, '|-';
local $SIG{ALRM} = sub { CORE::exit() };
return unless defined $pid;
if ( !$pid ) {
exec $sm_loc, "-oi", "-t"
or return $class->error(
MT->translate( "Exec of sendmail failed: [_1]", "$!" ) );
}
for my $key ( keys %$hdrs ) {
my @arr
= ref( $hdrs->{$key} ) eq 'ARRAY'
? @{ $hdrs->{$key} }
: ( $hdrs->{$key} );
print MAIL map "$key: $_\n", @arr;
}
print MAIL "\n";
print MAIL $body;
close MAIL;
1;
}
sub can_use {
my $class = shift;
my ($mods) = @_;
return unless $mods;
my @err;
for my $module ( @{$mods} ) {
eval "use $module;";
push @err, $module
if $@;
}
if (@err) {
$class->error(
MT->translate(
"Following required module(s) were not found: ([_1])",
( join ', ', @err )
)
);
return;
}
return 1;
}
sub can_use_smtp {
my $class = shift;
my @mods;
push @mods, @{ $SMTPModules{Core} };
return $class->can_use( \@mods );
}
sub can_use_smtpauth {
my $class = shift;
# return if we cannot use smtp modules
return unless $class->can_use_smtp;
my @mods;
push @mods, @{ $SMTPModules{Auth} };
return $class->can_use( \@mods );
}
sub can_use_smtpauth_ssl {
my $class = shift;
# return if we cannot use smtp modules
return unless $class->can_use_smtp;
# return if we cannot use smtpauth modules
return unless $class->can_use_smtpauth;
my @mods;
push @mods, @{ $SMTPModules{SSL} };
return $class->can_use( \@mods );
}
sub can_use_smtpauth_tls {
my $class = shift;
# return if we cannot use smtp modules
return unless $class->can_use_smtp;
# return if we cannot use smtpauth modules
return unless $class->can_use_smtpauth;
my @mods;
push @mods, @{ $SMTPModules{TLS} };
return $class->can_use( \@mods );
}
1;
__END__
=head1 NAME
MT::Mail - Movable Type mail sender
=head1 SYNOPSIS
use MT::Mail;
my %head = ( To => 'foo@bar.com', Subject => 'My Subject' );
my $body = 'This is the body of the message.';
MT::Mail->send(\%head, $body)
or die MT::Mail->errstr;
=head1 DESCRIPTION
I<MT::Mail> is the Movable Type mail-sending interface. It can send mail
through I<sendmail> (in several different default locations), through SMTP,
or through a debugging interface that writes data to STDERR. You can set the
method of sending mail through the F<mt.cfg> file by changing the value for
the I<MailTransfer> setting to one of the following values: C<sendmail>,
C<smtp>, or C<debug>.
If you are using C<sendmail>, I<MT::Mail::send> looks for your I<sendmail>
program in any of the following locations: F</usr/lib/sendmail>,
F</usr/sbin/sendmail>, and F</usr/ucblib/sendmail>. If your I<sendmail> is at
a different location, you can set it using the I<SendMailPath> directive.
If you are using C<smtp>, I<MT::Mail::send> will by default use C<localhost>
as the SMTP server. You can change this by setting the I<SMTPServer>
directive.
=head1 USAGE
=head2 MT::Mail->send(\%headers, $body)
Sends a mail message with the headers I<\%headers> and the message body
I<$body>.
The keys and values in I<\%headers> are passed directly in to the mail
program or server, so you can use any valid mail header names as keys. If
you need to supply a list of header values, specify the hash value as a
reference to a list of the header values. For example:
%headers = ( Bcc => [ 'foo@bar.com', 'baz@quux.com' ] );
If you wish the lines in I<$body> to be wrapped, you should do this yourself;
it will not be done by I<send>.
On success, I<send> returns true; on failure, it returns C<undef>, and the
error message is in C<MT::Mail-E<gt>errstr>.
=head1 AUTHOR & COPYRIGHT
Please see the I<MT> manpage for author, copyright, and license information.
=cut