init III
This commit is contained in:
486
Perl OTRS/Kernel/System/Email/SMTP.pm
Normal file
486
Perl OTRS/Kernel/System/Email/SMTP.pm
Normal file
@@ -0,0 +1,486 @@
|
||||
# --
|
||||
# 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;
|
||||
Reference in New Issue
Block a user