487 lines
14 KiB
Perl
487 lines
14 KiB
Perl
# --
|
|
# Copyright (C) 2001-2019 OTRS AG, https://otrs.com/
|
|
# --
|
|
# This software comes with ABSOLUTELY NO WARRANTY. For details, see
|
|
# the enclosed file COPYING for license information (GPL). If you
|
|
# did not receive this file, see https://www.gnu.org/licenses/gpl-3.0.txt.
|
|
# --
|
|
|
|
package Kernel::System::Email::SMTP;
|
|
|
|
use strict;
|
|
use warnings;
|
|
|
|
use Net::SMTP;
|
|
|
|
our @ObjectDependencies = (
|
|
'Kernel::Config',
|
|
'Kernel::System::DB',
|
|
'Kernel::System::Encode',
|
|
'Kernel::System::Log',
|
|
'Kernel::System::CommunicationLog',
|
|
);
|
|
|
|
sub new {
|
|
my ( $Type, %Param ) = @_;
|
|
|
|
# allocate new hash for object
|
|
my $Self = {%Param};
|
|
bless( $Self, $Type );
|
|
|
|
# debug
|
|
$Self->{Debug} = $Param{Debug} || 0;
|
|
if ( $Self->{Debug} > 2 ) {
|
|
|
|
# shown on STDERR
|
|
$Self->{SMTPDebug} = 1;
|
|
}
|
|
|
|
( $Self->{SMTPType} ) = ( $Type =~ m/::Email::(.*)$/i );
|
|
|
|
return $Self;
|
|
}
|
|
|
|
sub Check {
|
|
my ( $Self, %Param ) = @_;
|
|
|
|
$Param{CommunicationLogObject}->ObjectLogStart(
|
|
ObjectLogType => 'Connection',
|
|
);
|
|
|
|
my $Return = sub {
|
|
my %LocalParam = @_;
|
|
$Param{CommunicationLogObject}->ObjectLogStop(
|
|
ObjectLogType => 'Connection',
|
|
Status => $LocalParam{Success} ? 'Successful' : 'Failed',
|
|
);
|
|
|
|
return %LocalParam;
|
|
};
|
|
|
|
my $ReturnSuccess = sub { return $Return->( @_, Success => 1, ); };
|
|
my $ReturnError = sub { return $Return->( @_, Success => 0, ); };
|
|
|
|
# get config object
|
|
my $ConfigObject = $Kernel::OM->Get('Kernel::Config');
|
|
|
|
# get config data
|
|
$Self->{FQDN} = $ConfigObject->Get('FQDN');
|
|
$Self->{MailHost} = $ConfigObject->Get('SendmailModule::Host')
|
|
|| die "No SendmailModule::Host found in Kernel/Config.pm";
|
|
$Self->{SMTPPort} = $ConfigObject->Get('SendmailModule::Port');
|
|
$Self->{User} = $ConfigObject->Get('SendmailModule::AuthUser');
|
|
$Self->{Password} = $ConfigObject->Get('SendmailModule::AuthPassword');
|
|
|
|
$Param{CommunicationLogObject}->ObjectLog(
|
|
ObjectLogType => 'Connection',
|
|
Priority => 'Debug',
|
|
Key => 'Kernel::System::Email::SMTP',
|
|
Value => 'Testing connection to SMTP service (3 attempts max.).',
|
|
);
|
|
|
|
# 3 possible attempts to connect to the SMTP server.
|
|
# (MS Exchange Servers have sometimes problems on port 25)
|
|
my $SMTP;
|
|
|
|
my $TryConnectMessage = sprintf
|
|
"%%s: Trying to connect to '%s%s' on %s with SMTP type '%s'.",
|
|
$Self->{MailHost},
|
|
( $Self->{SMTPPort} ? ':' . $Self->{SMTPPort} : '' ),
|
|
$Self->{FQDN},
|
|
$Self->{SMTPType};
|
|
TRY:
|
|
for my $Try ( 1 .. 3 ) {
|
|
|
|
$Param{CommunicationLogObject}->ObjectLog(
|
|
ObjectLogType => 'Connection',
|
|
Priority => 'Debug',
|
|
Key => 'Kernel::System::Email::SMTP',
|
|
Value => sprintf( $TryConnectMessage, $Try, ),
|
|
);
|
|
|
|
# connect to mail server
|
|
eval {
|
|
$SMTP = $Self->_Connect(
|
|
MailHost => $Self->{MailHost},
|
|
FQDN => $Self->{FQDN},
|
|
SMTPPort => $Self->{SMTPPort},
|
|
SMTPDebug => $Self->{SMTPDebug},
|
|
);
|
|
return 1;
|
|
} || do {
|
|
my $Error = $@;
|
|
$Kernel::OM->Get('Kernel::System::Log')->Log(
|
|
Priority => 'error',
|
|
Message => sprintf(
|
|
"SMTP, connection try %s, unexpected error captured: %s",
|
|
$Try,
|
|
$Error,
|
|
),
|
|
);
|
|
};
|
|
|
|
last TRY if $SMTP;
|
|
|
|
$Param{CommunicationLogObject}->ObjectLog(
|
|
ObjectLogType => 'Connection',
|
|
Priority => 'Debug',
|
|
Key => 'Kernel::System::Email::SMTP',
|
|
Value => "$Try: Connection could not be established. Waiting for 0.3 seconds.",
|
|
);
|
|
|
|
# sleep 0,3 seconds;
|
|
select( undef, undef, undef, 0.3 ); ## no critic
|
|
}
|
|
|
|
# return if no connect was possible
|
|
if ( !$SMTP ) {
|
|
|
|
$Param{CommunicationLogObject}->ObjectLog(
|
|
ObjectLogType => 'Connection',
|
|
Priority => 'Error',
|
|
Key => 'Kernel::System::Email::SMTP',
|
|
Value => "Could not connect to host '$Self->{MailHost}'. ErrorMessage: $!",
|
|
);
|
|
|
|
return $ReturnError->(
|
|
ErrorMessage => "Can't connect to $Self->{MailHost}: $!!",
|
|
);
|
|
}
|
|
|
|
# Enclose SMTP in a wrapper to handle unexpected exceptions
|
|
$SMTP = $Self->_GetSMTPSafeWrapper(
|
|
SMTP => $SMTP,
|
|
);
|
|
|
|
# use smtp auth if configured
|
|
if ( $Self->{User} && $Self->{Password} ) {
|
|
|
|
$Param{CommunicationLogObject}->ObjectLog(
|
|
ObjectLogType => 'Connection',
|
|
Priority => 'Debug',
|
|
Key => 'Kernel::System::Email::SMTP',
|
|
Value => "Using SMTP authentication with user '$Self->{User}' and (hidden) password.",
|
|
);
|
|
|
|
if ( !$SMTP->( 'auth', $Self->{User}, $Self->{Password} ) ) {
|
|
|
|
my $Code = $SMTP->( 'code', );
|
|
my $Error = $Code . ', ' . $SMTP->( 'message', );
|
|
|
|
$SMTP->( 'quit', );
|
|
|
|
$Param{CommunicationLogObject}->ObjectLog(
|
|
ObjectLogType => 'Connection',
|
|
Priority => 'Error',
|
|
Key => 'Kernel::System::Email::SMTP',
|
|
Value => "SMTP authentication failed (SMTP code: $Code, ErrorMessage: $Error).",
|
|
);
|
|
|
|
return $ReturnError->(
|
|
ErrorMessage => "SMTP authentication failed: $Error!",
|
|
Code => $Code,
|
|
);
|
|
}
|
|
}
|
|
|
|
return $ReturnSuccess->(
|
|
SMTP => $SMTP,
|
|
);
|
|
}
|
|
|
|
sub Send {
|
|
my ( $Self, %Param ) = @_;
|
|
|
|
$Param{CommunicationLogObject}->ObjectLog(
|
|
ObjectLogType => 'Message',
|
|
Priority => 'Info',
|
|
Key => 'Kernel::System::Email::SMTP',
|
|
Value => 'Received message for sending, validating message contents.',
|
|
);
|
|
|
|
# check needed stuff
|
|
for (qw(Header Body ToArray)) {
|
|
if ( !$Param{$_} ) {
|
|
|
|
$Param{CommunicationLogObject}->ObjectLog(
|
|
ObjectLogType => 'Message',
|
|
Priority => 'Error',
|
|
Key => 'Kernel::System::Email::SMTP',
|
|
Value => "Need $_!",
|
|
);
|
|
|
|
return $Self->_SendError(
|
|
%Param,
|
|
ErrorMessage => "Need $_!",
|
|
);
|
|
}
|
|
}
|
|
if ( !$Param{From} ) {
|
|
$Param{From} = '';
|
|
}
|
|
|
|
# connect to smtp server
|
|
my %Result = $Self->Check(%Param);
|
|
|
|
if ( !$Result{Success} ) {
|
|
return $Self->_SendError( %Param, %Result, );
|
|
}
|
|
|
|
# set/get SMTP handle
|
|
my $SMTP = $Result{SMTP};
|
|
|
|
$Param{CommunicationLogObject}->ObjectLog(
|
|
ObjectLogType => 'Message',
|
|
Priority => 'Debug',
|
|
Key => 'Kernel::System::Email::SMTP',
|
|
Value => "Sending envelope from (mail from: $Param{From}) to server.",
|
|
);
|
|
|
|
# set envelope from, return if from was not accepted by the server
|
|
if ( !$SMTP->( 'mail', $Param{From}, ) ) {
|
|
|
|
my $FullErrorMessage = sprintf(
|
|
"Envelope from '%s' not accepted by the server: %s, %s!",
|
|
$Param{From},
|
|
$SMTP->( 'code', ),
|
|
$SMTP->( 'message', ),
|
|
);
|
|
|
|
$Param{CommunicationLogObject}->ObjectLog(
|
|
ObjectLogType => 'Message',
|
|
Priority => 'Error',
|
|
Key => 'Kernel::System::Email::SMTP',
|
|
Value => $FullErrorMessage,
|
|
);
|
|
|
|
return $Self->_SendError(
|
|
%Param,
|
|
ErrorMessage => $FullErrorMessage,
|
|
SMTP => $SMTP,
|
|
);
|
|
}
|
|
|
|
TO:
|
|
for my $To ( @{ $Param{ToArray} } ) {
|
|
|
|
$Param{CommunicationLogObject}->ObjectLog(
|
|
ObjectLogType => 'Message',
|
|
Priority => 'Debug',
|
|
Key => 'Kernel::System::Email::SMTP',
|
|
Value => "Sending envelope to (rcpt to: $To) to server.",
|
|
);
|
|
|
|
# Check if the recipient is valid
|
|
next TO if $SMTP->( 'to', $To, );
|
|
|
|
my $FullErrorMessage = sprintf(
|
|
"Envelope to '%s' not accepted by the server: %s, %s!",
|
|
$To,
|
|
$SMTP->( 'code', ),
|
|
$SMTP->( 'message', ),
|
|
);
|
|
|
|
$Param{CommunicationLogObject}->ObjectLog(
|
|
ObjectLogType => 'Message',
|
|
Priority => 'Error',
|
|
Key => 'Kernel::System::Email::SMTP',
|
|
Value => $FullErrorMessage,
|
|
);
|
|
|
|
return $Self->_SendError(
|
|
%Param,
|
|
ErrorMessage => $FullErrorMessage,
|
|
SMTP => $SMTP,
|
|
);
|
|
}
|
|
|
|
my $ToString = join ',', @{ $Param{ToArray} };
|
|
|
|
# get encode object
|
|
my $EncodeObject = $Kernel::OM->Get('Kernel::System::Encode');
|
|
|
|
# encode utf8 header strings (of course, there should only be 7 bit in there!)
|
|
$EncodeObject->EncodeOutput( $Param{Header} );
|
|
|
|
# encode utf8 body strings
|
|
$EncodeObject->EncodeOutput( $Param{Body} );
|
|
|
|
# send data
|
|
$Param{CommunicationLogObject}->ObjectLog(
|
|
ObjectLogType => 'Message',
|
|
Priority => 'Debug',
|
|
Key => 'Kernel::System::Email::SMTP',
|
|
Value => "Sending message data to server.",
|
|
);
|
|
|
|
# Send email data by chunks because when in SSL mode, each SSL
|
|
# frame has a maximum of 16kB (Bug #12957).
|
|
# We send always the first 4000 characters until '$Data' is empty.
|
|
# If any error occur while sending data to the smtp server an exception
|
|
# is thrown and '$DataSent' will be undefined.
|
|
my $DataSent = eval {
|
|
my $Data = ${ $Param{Header} } . "\n" . ${ $Param{Body} };
|
|
my $ChunkSize = 4000;
|
|
|
|
$SMTP->( 'data', ) || die "error starting data sending";
|
|
|
|
while ( my $DataLength = length $Data ) {
|
|
my $TmpChunkSize = ( $ChunkSize > $DataLength ) ? $DataLength : $ChunkSize;
|
|
my $Chunk = substr $Data, 0, $TmpChunkSize;
|
|
|
|
$SMTP->( 'datasend', $Chunk, ) || die "error sending data chunk";
|
|
|
|
$Data = substr $Data, $TmpChunkSize;
|
|
}
|
|
|
|
$SMTP->( 'dataend', ) || die "error ending data sending";
|
|
|
|
return 1;
|
|
};
|
|
|
|
if ( !$DataSent ) {
|
|
my $FullErrorMessage = sprintf(
|
|
"Could not send message to server: %s, %s!",
|
|
$SMTP->( 'code', ),
|
|
$SMTP->( 'message', ),
|
|
);
|
|
|
|
$Param{CommunicationLogObject}->ObjectLog(
|
|
ObjectLogType => 'Message',
|
|
Priority => 'Error',
|
|
Key => 'Kernel::System::Email::SMTP',
|
|
Value => $FullErrorMessage,
|
|
);
|
|
|
|
return $Self->_SendError(
|
|
%Param,
|
|
ErrorMessage => $FullErrorMessage,
|
|
SMTP => $SMTP,
|
|
);
|
|
}
|
|
|
|
# debug
|
|
if ( $Self->{Debug} > 2 ) {
|
|
$Kernel::OM->Get('Kernel::System::Log')->Log(
|
|
Priority => 'notice',
|
|
Message => "Sent email to '$ToString' from '$Param{From}'.",
|
|
);
|
|
}
|
|
|
|
$Param{CommunicationLogObject}->ObjectLog(
|
|
ObjectLogType => 'Message',
|
|
Priority => 'Info',
|
|
Key => 'Kernel::System::Email::SMTP',
|
|
Value => "Email successfully sent from '$Param{From}' to '$ToString'.",
|
|
);
|
|
|
|
return $Self->_SendSuccess(
|
|
SMTP => $SMTP,
|
|
%Param
|
|
);
|
|
}
|
|
|
|
sub _Connect {
|
|
my ( $Self, %Param ) = @_;
|
|
|
|
# check needed stuff
|
|
for (qw(MailHost FQDN)) {
|
|
if ( !$Param{$_} ) {
|
|
$Kernel::OM->Get('Kernel::System::Log')->Log(
|
|
Priority => 'error',
|
|
Message => "Need $_!",
|
|
);
|
|
return;
|
|
}
|
|
}
|
|
|
|
# Remove a possible port from the FQDN value
|
|
my $FQDN = $Param{FQDN};
|
|
$FQDN =~ s{:\d+}{}smx;
|
|
|
|
# set up connection connection
|
|
my $SMTP = Net::SMTP->new(
|
|
$Param{MailHost},
|
|
Hello => $FQDN,
|
|
Port => $Param{SMTPPort} || 25,
|
|
Timeout => 30,
|
|
Debug => $Param{SMTPDebug},
|
|
);
|
|
|
|
return $SMTP;
|
|
}
|
|
|
|
sub _SendResult {
|
|
my ( $Self, %Param ) = @_;
|
|
|
|
my $SMTP = delete $Param{SMTP};
|
|
$SMTP->( 'quit', ) if $SMTP;
|
|
|
|
return {%Param};
|
|
}
|
|
|
|
sub _SendSuccess {
|
|
my ( $Self, %Param ) = @_;
|
|
return $Self->_SendResult(
|
|
Success => 1,
|
|
%Param
|
|
);
|
|
}
|
|
|
|
sub _SendError {
|
|
my ( $Self, %Param ) = @_;
|
|
|
|
my $SMTP = $Param{SMTP};
|
|
if ( $SMTP && !defined $Param{Code} ) {
|
|
$Param{Code} = $SMTP->( 'code', );
|
|
}
|
|
|
|
return $Self->_SendResult(
|
|
Success => 0,
|
|
%Param,
|
|
SMTPError => 1,
|
|
);
|
|
}
|
|
|
|
sub _GetSMTPSafeWrapper {
|
|
my ( $Self, %Param, ) = @_;
|
|
|
|
my $SMTP = $Param{SMTP};
|
|
|
|
return sub {
|
|
my $Operation = shift;
|
|
my @LocalParams = @_;
|
|
|
|
my $ScalarResult;
|
|
my @ArrayResult = ();
|
|
my $Wantarray = wantarray;
|
|
|
|
eval {
|
|
if ($Wantarray) {
|
|
@ArrayResult = $SMTP->$Operation( @LocalParams, );
|
|
}
|
|
else {
|
|
$ScalarResult = $SMTP->$Operation( @LocalParams, );
|
|
}
|
|
|
|
return 1;
|
|
} || do {
|
|
my $Error = $@;
|
|
$Kernel::OM->Get('Kernel::System::Log')->Log(
|
|
Priority => 'error',
|
|
Message => sprintf(
|
|
"Error while executing 'SMTP->%s(%s)': %s",
|
|
$Operation,
|
|
join( ',', @LocalParams ),
|
|
$Error,
|
|
),
|
|
);
|
|
};
|
|
|
|
return @ArrayResult if $Wantarray;
|
|
return $ScalarResult;
|
|
};
|
|
}
|
|
|
|
1;
|