2009-12-21 23:28:38 +01:00
|
|
|
##@file
|
|
|
|
# SMTP common functions
|
|
|
|
|
|
|
|
##@class
|
|
|
|
# SMTP common functions
|
2017-01-04 06:52:39 +01:00
|
|
|
package Lemonldap::NG::Portal::Lib::SMTP;
|
2009-12-21 23:28:38 +01:00
|
|
|
|
|
|
|
use strict;
|
2017-01-04 06:52:39 +01:00
|
|
|
use Mouse;
|
2017-02-17 21:47:01 +01:00
|
|
|
use JSON qw(from_json);
|
2009-12-21 23:28:38 +01:00
|
|
|
use String::Random;
|
2017-03-27 07:22:08 +02:00
|
|
|
use MIME::Entity;
|
2017-03-26 07:26:28 +02:00
|
|
|
use Email::Sender::Simple qw(sendmail);
|
|
|
|
use Email::Sender::Transport::SMTP qw();
|
2011-06-21 14:31:45 +02:00
|
|
|
use MIME::Base64;
|
2011-05-27 16:08:49 +02:00
|
|
|
use Encode;
|
2009-12-21 23:28:38 +01:00
|
|
|
|
2016-03-17 23:19:44 +01:00
|
|
|
our $VERSION = '2.0.0';
|
2009-12-21 23:28:38 +01:00
|
|
|
|
2017-03-27 07:22:08 +02:00
|
|
|
our $transport;
|
|
|
|
|
2017-01-04 06:52:39 +01:00
|
|
|
# PROPERTIES
|
|
|
|
|
2017-01-04 06:53:34 +01:00
|
|
|
has random => (
|
|
|
|
is => 'rw',
|
|
|
|
default => sub {
|
|
|
|
return String::Random->new;
|
|
|
|
}
|
|
|
|
);
|
|
|
|
has charset => (
|
|
|
|
is => 'rw',
|
2017-03-27 18:51:18 +02:00
|
|
|
lazy => 1,
|
2017-01-04 06:53:34 +01:00
|
|
|
default => sub { return $_[0]->{conf}->{mailCharset} || 'utf-8' }
|
|
|
|
);
|
2017-03-26 07:26:28 +02:00
|
|
|
has transport => (
|
|
|
|
is => 'rw',
|
2017-03-27 18:51:18 +02:00
|
|
|
lazy => 1,
|
2017-03-26 07:26:28 +02:00
|
|
|
default => sub {
|
2017-03-27 07:22:08 +02:00
|
|
|
return $transport if $transport;
|
2017-03-26 07:26:28 +02:00
|
|
|
my $conf = $_[0]->{conf};
|
|
|
|
return undef
|
|
|
|
unless ( $conf->{SMTPServer} );
|
|
|
|
if ( $conf->{SMTPTLS}
|
|
|
|
and $Email::Sender::Simple::VERSION < 1.300027 )
|
|
|
|
{
|
|
|
|
require Email::Sender::Transport::SMTPS;
|
2017-03-27 07:22:08 +02:00
|
|
|
$transport = Email::Sender::Transport::SMTPS->new(
|
2017-03-26 07:26:28 +02:00
|
|
|
host => $conf->{SMTPServer},
|
|
|
|
( $conf->{SMTPPort} ? ( port => $conf->{SMTPPort} ) : () ),
|
|
|
|
(
|
|
|
|
$conf->{SMTPAuthUser}
|
|
|
|
? (
|
|
|
|
sasl_username => $conf->{SMTPAuthUser},
|
|
|
|
sasl_password => $conf->{SMTPAuthPass}
|
|
|
|
)
|
|
|
|
: ()
|
|
|
|
),
|
|
|
|
ssl => $conf->{SMTPTLS},
|
|
|
|
);
|
|
|
|
}
|
|
|
|
else {
|
2017-03-27 07:22:08 +02:00
|
|
|
$transport = Email::Sender::Transport::SMTP->new(
|
2017-03-26 07:26:28 +02:00
|
|
|
host => $conf->{SMTPServer},
|
2017-03-27 09:02:19 +02:00
|
|
|
( $conf->{SMTPPort} ? ( port => $conf->{SMTPPort} ) : () ),
|
2017-03-26 07:26:28 +02:00
|
|
|
(
|
|
|
|
$conf->{SMTPAuthUser}
|
|
|
|
? (
|
|
|
|
sasl_username => $conf->{SMTPAuthUser},
|
|
|
|
sasl_password => $conf->{SMTPAuthPass}
|
|
|
|
)
|
|
|
|
: ()
|
|
|
|
),
|
|
|
|
( $conf->{SMTPTLS} ? ( ssl => $conf->{SMTPTLS} ) : () ),
|
|
|
|
(
|
|
|
|
$conf->{SMTPTLSOpts}
|
|
|
|
? ( ssl_options => $conf->{SMTPTLSOpts} )
|
|
|
|
: ()
|
|
|
|
),
|
|
|
|
);
|
|
|
|
}
|
2017-03-27 07:22:08 +02:00
|
|
|
return $transport;
|
2017-03-26 07:26:28 +02:00
|
|
|
},
|
|
|
|
);
|
2017-01-04 06:52:39 +01:00
|
|
|
|
2017-02-17 21:47:01 +01:00
|
|
|
sub translate {
|
|
|
|
my ( $self, $req ) = @_;
|
|
|
|
|
|
|
|
# Get language using llnglanguage cookie
|
|
|
|
my $lang = $req->cookies->{llnglanguage} || 'en';
|
|
|
|
my $json = $self->conf->{templateDir} . "/common/mail/$lang.json";
|
|
|
|
$json = $self->conf->{templateDir} . '/common/mail/en.json'
|
|
|
|
unless ( -f $json );
|
2017-12-11 19:36:55 +01:00
|
|
|
open F, $json
|
|
|
|
or die 'Installation error: '
|
|
|
|
. $!
|
|
|
|
. " ($self->{conf}->{templateDir}/$lang.json or $self->{conf}->{templateDir}/common/mail/en.json)";
|
2017-02-17 21:47:01 +01:00
|
|
|
$json = join '', <F>;
|
|
|
|
close F;
|
2017-09-28 14:52:14 +02:00
|
|
|
$lang = from_json( $json, { allow_nonref => 1 } );
|
2017-02-17 21:47:01 +01:00
|
|
|
return sub {
|
|
|
|
($_) = @_;
|
|
|
|
$$_ =~ s/\s+trspan="(\w+?)"(.*?)>.*?</"$2>".($lang->{$1}||$1).'<'/gse;
|
2017-02-19 09:07:21 +01:00
|
|
|
$$_ =~ s/^(\w+)$/$lang->{$1}||$1/es;
|
2017-02-17 21:47:01 +01:00
|
|
|
};
|
|
|
|
}
|
|
|
|
|
2009-12-21 23:28:38 +01:00
|
|
|
# Generate a complex password based on a regular expression
|
|
|
|
# @param regexp regular expression
|
|
|
|
sub gen_password {
|
2017-01-04 06:53:34 +01:00
|
|
|
my ( $self, $regexp ) = @_;
|
2017-01-04 06:52:39 +01:00
|
|
|
return $self->random->randregex($regexp);
|
2009-12-21 23:28:38 +01:00
|
|
|
}
|
|
|
|
|
2010-01-21 18:38:55 +01:00
|
|
|
# Send mail
|
2010-01-22 12:25:37 +01:00
|
|
|
# @param mail recipient address
|
|
|
|
# @param subject mail subject
|
|
|
|
# @param body mail body
|
|
|
|
# @param html optional set content type to HTML
|
2009-12-21 23:28:38 +01:00
|
|
|
# @return boolean result
|
2010-01-21 18:38:55 +01:00
|
|
|
sub send_mail {
|
2016-01-02 10:29:05 +01:00
|
|
|
my ( $self, $mail, $subject, $body, $html ) = @_;
|
2017-02-15 07:41:50 +01:00
|
|
|
$self->logger->debug("send_mail called to send \"$subject\" to $mail");
|
2009-12-21 23:28:38 +01:00
|
|
|
|
2011-05-27 16:08:49 +02:00
|
|
|
# Encode the body with the given charset
|
2017-02-08 17:53:13 +01:00
|
|
|
$body = encode( $self->charset, decode( 'utf-8', $body ) );
|
|
|
|
$subject = encode( $self->charset, decode( 'utf-8', $subject ) );
|
2011-05-27 16:08:49 +02:00
|
|
|
|
|
|
|
# Debug messages
|
2017-02-15 07:41:50 +01:00
|
|
|
$self->logger->debug( "SMTP From " . $self->conf->{mailFrom} );
|
|
|
|
$self->logger->debug( "SMTP To " . $mail );
|
|
|
|
$self->logger->debug( "SMTP Subject " . $subject );
|
|
|
|
$self->logger->debug( "SMTP Body " . $body );
|
|
|
|
$self->logger->debug( "SMTP HTML flag " . ( $html ? "on" : "off" ) );
|
|
|
|
$self->logger->debug( "SMTP Reply-To " . $self->conf->{mailReplyTo} )
|
2017-01-14 20:31:48 +01:00
|
|
|
if $self->conf->{mailReplyTo};
|
2011-05-27 11:41:13 +02:00
|
|
|
|
2011-05-27 16:30:14 +02:00
|
|
|
# Encode the subject
|
2016-12-29 07:25:07 +01:00
|
|
|
$subject = encode_base64( $subject, '' );
|
2017-01-04 06:52:39 +01:00
|
|
|
$subject =~ s/\s//gs;
|
2017-01-04 06:53:34 +01:00
|
|
|
$subject = '=?' . $self->charset . "?B?$subject?=";
|
2011-05-27 16:30:14 +02:00
|
|
|
|
2011-05-27 18:20:56 +02:00
|
|
|
# Detect included images (cid)
|
|
|
|
my %cid = ( $body =~ m/"cid:([^:]+):([^"]+)"/g );
|
|
|
|
|
|
|
|
# Replace cid in body
|
|
|
|
$body =~ s/"cid:([^:]+):([^"]+)"/"cid:$1"/g;
|
|
|
|
|
2009-12-21 23:28:38 +01:00
|
|
|
eval {
|
2011-05-27 18:20:56 +02:00
|
|
|
|
|
|
|
# Create message
|
2011-05-30 14:06:52 +02:00
|
|
|
my $message;
|
|
|
|
|
|
|
|
# HTML case
|
|
|
|
if ($html) {
|
2017-03-26 07:26:28 +02:00
|
|
|
$message = MIME::Entity->build(
|
2017-01-14 20:31:48 +01:00
|
|
|
From => $self->conf->{mailFrom},
|
|
|
|
To => $mail,
|
|
|
|
(
|
|
|
|
$self->conf->{mailReplyTo}
|
|
|
|
? ( "Reply-To" => $self->conf->{mailReplyTo} )
|
|
|
|
: ()
|
|
|
|
),
|
|
|
|
Subject => $subject,
|
|
|
|
Type => 'multipart/related',
|
2011-05-30 14:06:52 +02:00
|
|
|
);
|
|
|
|
|
|
|
|
# Attach HTML message
|
2011-05-27 18:20:56 +02:00
|
|
|
$message->attach(
|
2017-01-04 06:53:34 +01:00
|
|
|
Type => 'text/html; charset=' . $self->charset,
|
2011-05-30 14:06:52 +02:00
|
|
|
Data => qq{$body},
|
|
|
|
);
|
|
|
|
|
|
|
|
# Attach included images
|
|
|
|
foreach ( keys %cid ) {
|
|
|
|
$message->attach(
|
|
|
|
Type => "image/" . ( $cid{$_} =~ m/\.(\w+)/ )[0],
|
|
|
|
Id => $_,
|
2017-01-04 06:52:39 +01:00
|
|
|
Path => $self->p->{templateDir} . "/" . $cid{$_},
|
2011-05-30 14:06:52 +02:00
|
|
|
);
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
# Plain text case
|
|
|
|
else {
|
2017-03-26 07:26:28 +02:00
|
|
|
$message = MIME::Entity->build(
|
2017-01-14 20:31:48 +01:00
|
|
|
From => $self->conf->{mailFrom},
|
2011-05-30 14:06:52 +02:00
|
|
|
To => $mail,
|
2017-01-14 20:31:48 +01:00
|
|
|
"Reply-To" => $self->conf->{mailReplyTo},
|
2011-05-30 14:06:52 +02:00
|
|
|
Subject => $subject,
|
|
|
|
Type => 'TEXT',
|
|
|
|
Data => $body,
|
2011-05-27 18:20:56 +02:00
|
|
|
);
|
2011-05-30 14:06:52 +02:00
|
|
|
|
|
|
|
# Manage content type and charset
|
|
|
|
$message->attr( "content-type" => "text/plain" );
|
2017-01-04 06:52:39 +01:00
|
|
|
$message->attr( "content-type.charset" => $self->charset );
|
2011-05-30 14:06:52 +02:00
|
|
|
|
2011-05-27 18:20:56 +02:00
|
|
|
}
|
|
|
|
|
|
|
|
# Send the mail
|
2017-03-27 07:22:08 +02:00
|
|
|
sendmail( $message->stringify,
|
|
|
|
( $self->transport ? { transport => $self->transport } : () ) );
|
2009-12-21 23:28:38 +01:00
|
|
|
};
|
|
|
|
if ($@) {
|
2017-02-15 07:41:50 +01:00
|
|
|
$self->logger->error("Send message failed: $@");
|
2009-12-21 23:28:38 +01:00
|
|
|
return 0;
|
|
|
|
}
|
|
|
|
|
|
|
|
return 1;
|
|
|
|
}
|
|
|
|
|
2011-05-20 16:30:21 +02:00
|
|
|
## @method string getMailSession(string user)
|
|
|
|
# Check if a mail session exists
|
|
|
|
# @param user the value of the user key in session
|
|
|
|
# @return the first session id found or nothing if no session
|
|
|
|
sub getMailSession {
|
2016-01-02 10:29:05 +01:00
|
|
|
my ( $self, $user ) = @_;
|
2011-05-20 16:30:21 +02:00
|
|
|
|
2017-01-04 06:52:39 +01:00
|
|
|
my $moduleOptions = $self->conf->{globalStorageOptions} || {};
|
|
|
|
$moduleOptions->{backend} = $self->conf->{globalStorage};
|
2014-02-26 11:57:49 +01:00
|
|
|
my $module = "Lemonldap::NG::Common::Apache::Session";
|
|
|
|
|
2011-05-20 16:30:21 +02:00
|
|
|
# Search on mail sessions
|
2014-02-26 11:57:49 +01:00
|
|
|
my $sessions = $module->searchOn( $moduleOptions, "user", $user );
|
2011-05-20 16:30:21 +02:00
|
|
|
|
|
|
|
# Browse found sessions to check if it's a mail session
|
|
|
|
foreach my $id ( keys %$sessions ) {
|
2017-01-24 06:10:57 +01:00
|
|
|
my $mailSession = $self->p->getApacheSession($id);
|
2014-10-27 12:19:25 +01:00
|
|
|
next unless ($mailSession);
|
2017-01-29 10:11:27 +01:00
|
|
|
return $mailSession if ( $mailSession->data->{_type} =~ /^mail$/ );
|
2011-05-20 16:30:21 +02:00
|
|
|
}
|
|
|
|
|
|
|
|
# No mail session found, return empty string
|
|
|
|
return "";
|
|
|
|
}
|
|
|
|
|
2014-05-23 20:47:36 +02:00
|
|
|
## @method string getRegisterSession(string mail)
|
|
|
|
# Check if a register session exists
|
|
|
|
# @param mail the value of the mail key in session
|
|
|
|
# @return the first session id found or nothing if no session
|
|
|
|
sub getRegisterSession {
|
2016-01-02 10:29:05 +01:00
|
|
|
my ( $self, $mail ) = @_;
|
2014-05-23 20:47:36 +02:00
|
|
|
|
2017-01-04 06:52:39 +01:00
|
|
|
my $moduleOptions = $self->conf->{globalStorageOptions} || {};
|
|
|
|
$moduleOptions->{backend} = $self->conf->{globalStorage};
|
2014-05-23 20:47:36 +02:00
|
|
|
my $module = "Lemonldap::NG::Common::Apache::Session";
|
|
|
|
|
|
|
|
# Search on register sessions
|
|
|
|
my $sessions = $module->searchOn( $moduleOptions, "mail", $mail );
|
|
|
|
|
|
|
|
# Browse found sessions to check if it's a register session
|
|
|
|
foreach my $id ( keys %$sessions ) {
|
2017-01-24 06:10:57 +01:00
|
|
|
my $registerSession = $self->p->getApacheSession($id);
|
2014-10-27 12:19:25 +01:00
|
|
|
next unless ($registerSession);
|
2017-12-19 09:29:35 +01:00
|
|
|
return $id
|
|
|
|
if ( $registerSession->data->{_type}
|
|
|
|
and $registerSession->data->{_type} =~ /^register$/ );
|
2014-05-23 20:47:36 +02:00
|
|
|
}
|
|
|
|
|
|
|
|
# No register session found, return empty string
|
|
|
|
return "";
|
|
|
|
}
|
|
|
|
|
2009-12-21 23:28:38 +01:00
|
|
|
1;
|