Commit 6cb301c5 authored by Xavier Guimard's avatar Xavier Guimard

Replace MIME::Lite by Email::Sender/MIME::Entity (#1206)

parent bd9e6f50
* check for issuer rules
* Add new SMTP params
* unhandled parameters:
* portalDisplayLoginHistory
* portalDisplayAppslist
* portalDisplayChangePassword
* portalDisplayLogout
* issuerDB\*Rule
* securize SOAP session creation by cipher
* Verify securedCookie=3 (strange)
......
......@@ -353,6 +353,7 @@ t/sessions/lock/.exists
t/sessions/saml/lock/.exists
t/sessions2/6e30af4ffa5689b3e49a104d1b160d316db2b2161a0f45776994eed19dbdc101
t/sessions2/lock/Apache-Session-6e30af4ffa5689b3e49a104d1b160d316db2b2161a0f45776994eed19dbdc101.lock
t/smtp.pm
t/test-ldap.pm
t/test-lib.pm
t/test-psgi.pm
......
......@@ -4,10 +4,11 @@ author:
- 'Xavier Guimard <x.guimard@free.fr>, Clément Oudot <clement@oodo.net>, Thomas Chemineau <thomas.chemineau@gmail.com>, Mikael Ates <mikael.ates@univ-st-etienne.fr>'
build_requires:
AuthCAS: '0'
Email::Sender: '0'
HTTP::Message: '0'
IO::String: '0'
LWP: '0'
MIME::Lite: '0'
MIME::Entity: '0'
Net::OpenID::Consumer: '0'
Net::OpenID::Server: '0'
SOAP::Lite: '0'
......@@ -29,6 +30,7 @@ no_index:
recommends:
AuthCAS: '0'
DBI: '0'
Email::Sender: '1.300027'
GD::SecurityImage: '0'
Glib: '0'
HTTP::Message: '0'
......@@ -36,7 +38,7 @@ recommends:
LWP: '0'
LWP::Protocol::https: '0'
Lasso: v2.3.0
MIME::Lite: '0'
MIME::Entity: '0'
Net::Facebook::Oauth2: '0'
Net::LDAP: '0.38'
Net::OAuth: '0'
......
......@@ -11,6 +11,7 @@ WriteMakefile(
'recommends' => {
'AuthCAS' => 0,
'DBI' => 0,
'Email::Sender' => 1.300027,
'GD::SecurityImage' => 0,
'Glib' => 0,
'HTTP::Message' => 0,
......@@ -18,7 +19,7 @@ WriteMakefile(
'Lasso' => '2.3.0',
'LWP' => 0,
'LWP::Protocol::https' => 0,
'MIME::Lite' => 0,
'MIME::Entity' => 0,
'Net::Facebook::Oauth2' => 0,
'Net::LDAP' => 0.38,
'Net::OAuth' => 0,
......@@ -32,10 +33,11 @@ WriteMakefile(
},
BUILD_REQUIRES => {
'AuthCAS' => 0,
'Email::Sender' => 0,
'HTTP::Message' => 0,
'IO::String' => 0,
'LWP' => 0,
'MIME::Lite' => 0,
'MIME::Entity' => 0,
'Net::OpenID::Consumer' => 0,
'Net::OpenID::Server' => 0,
'SOAP::Lite' => 0,
......
......@@ -9,7 +9,7 @@ use strict;
use Mouse;
use JSON qw(from_json);
use String::Random;
use MIMEEntity;
use MIME::Entity;
use Email::Sender::Simple qw(sendmail);
use Email::Sender::Transport::SMTP qw();
use MIME::Base64;
......@@ -17,6 +17,8 @@ use Encode;
our $VERSION = '2.0.0';
our $transport;
# PROPERTIES
has random => (
......@@ -32,6 +34,7 @@ has charset => (
has transport => (
is => 'rw',
default => sub {
return $transport if $transport;
my $conf = $_[0]->{conf};
return undef
unless ( $conf->{SMTPServer} );
......@@ -39,7 +42,7 @@ has transport => (
and $Email::Sender::Simple::VERSION < 1.300027 )
{
require Email::Sender::Transport::SMTPS;
return Email::Sender::Transport::SMTPS->new(
$transport = Email::Sender::Transport::SMTPS->new(
host => $conf->{SMTPServer},
( $conf->{SMTPPort} ? ( port => $conf->{SMTPPort} ) : () ),
(
......@@ -54,7 +57,7 @@ has transport => (
);
}
else {
return Email::Sender::Transport::SMTP->new(
$transport = Email::Sender::Transport::SMTP->new(
host => $conf->{SMTPServer},
port => $conf->{SMTPPort} || 25,
(
......@@ -73,6 +76,7 @@ has transport => (
),
);
}
return $transport;
},
);
......@@ -189,7 +193,8 @@ sub send_mail {
}
# Send the mail
sendmail( $message->stringify, { transport => $self->transport } );
sendmail( $message->stringify,
( $self->transport ? { transport => $self->transport } : () ) );
};
if ($@) {
$self->logger->error("Send message failed: $@");
......
......@@ -3,11 +3,11 @@ use strict;
use IO::String;
BEGIN {
require MIME::Lite;
require 't/test-lib.pm';
require 't/smtp.pm';
}
my $maintests = 11;
my $maintests = 13;
my ( $res, $user, $pwd, $host, $url, $query ) = my $mailSend = 0;
SKIP: {
......@@ -66,7 +66,9 @@ s/^.*token=([^&]+).*$/token=$1&firstname=foo&lastname=bar&mail=foobar%40badwolf.
);
expectOK($res);
# $query is set by MIME::Lite::send below
ok( mail() =~ m#a href="http://auth.example.com/register\?(.*?)"#,
'Found register token' );
$query = $1;
ok( $query =~ /register_token=/, 'Found register_token' );
ok(
......@@ -76,7 +78,13 @@ s/^.*token=([^&]+).*$/token=$1&firstname=foo&lastname=bar&mail=foobar%40badwolf.
);
expectOK($res);
# $user/$pwd are set by MIME::Lite::send below
ok(
mail() =~
m#Your login is.+?<b>(\w+)</b>.*?Your password is.+?<b>(.*?)</b>#s,
'Found user and password'
);
$user = $1;
$pwd = $2;
ok( $user eq 'fbar', 'Get good login' );
# Try to authenticate
......@@ -97,37 +105,3 @@ count($maintests);
clean_sessions();
done_testing( count() );
no warnings 'redefine';
my $mail2 = 0;
sub MIME::Lite::send {
my ($mail) = @_;
pass('Mail sent');
ok( $mail->header_as_string =~ /foobar\@badwolf.org/s, 'Found dest' )
or explain( $mail->header_as_string, 'To: foobar@badwolf.org' );
count(2);
unless ($mail2) {
$mailSend = 1;
ok(
$mail->body_as_string =~
m#a href="http://auth.example.com/register\?(.*?)"#,
'Found link'
);
count(1);
$query = $1;
$mail2++;
}
else {
$mailSend = 2;
ok(
$mail->body_as_string =~
m#Your login is.+?<b>(\w+)</b>.*?Your password is.+?<b>(.*?)</b>#s,
'Get login/pwd'
);
( $user, $pwd ) = ( $1, $2 );
count(1);
}
}
......@@ -3,12 +3,11 @@ use strict;
use IO::String;
BEGIN {
require MIME::Lite;
require 't/test-lib.pm';
require 't/smtp.pm';
}
my ( $res, $user, $pwd );
my $mailSend = 0;
my $client = LLNG::Manager::Test->new(
{
......@@ -51,9 +50,10 @@ ok(
count(1);
expectOK($res);
# $query is set by MIME::Lite::send below
ok( mail() =~ m#a href="http://auth.example.com/register\?(.*?)"#, 'Found register token') or print STDERR Dumper($main::mail);
$query = $1;
ok( $query =~ /register_token=/, 'Found register_token' );
count(1);
count(2);
ok(
$res = $client->_get( '/register', query => $query, accept => 'text/html' ),
......@@ -62,9 +62,11 @@ ok(
expectOK($res);
count(1);
# $user/$pwd are set by MIME::Lite::send below
ok( mail() =~ m#Your login is.+?<b>(\w+)</b>.*?Your password is.+?<b>(.*?)</b>#s, 'Found user and password');
$user = $1;
$pwd = $2;
ok( $user eq 'fbar', 'Get good login' );
count(1);
count(2);
# Try to authenticate
# 1. get token
......@@ -89,36 +91,3 @@ clean_sessions();
done_testing( count() );
no warnings 'redefine';
my $mail2 = 0;
sub MIME::Lite::send {
my ($mail) = @_;
pass('Mail sent');
ok( $mail->header_as_string =~ /foobar\@badwolf.org/s, 'Found dest' )
or explain( $mail->header_as_string, 'To: foobar@badwolf.org' );
count(2);
unless ($mail2) {
$mailSend = 1;
ok(
$mail->body_as_string =~
m#a href="http://auth.example.com/register\?(.*?)"#,
'Found link'
);
count(1);
$query = $1;
$mail2++;
}
else {
$mailSend = 2;
ok(
$mail->body_as_string =~
m#Your login is.+?<b>(\w+)</b>.*?Your password is.+?<b>(.*?)</b>#s,
'Get login/pwd'
);
( $user, $pwd ) = ( $1, $2 );
count(1);
}
}
......@@ -3,12 +3,11 @@ use strict;
use IO::String;
BEGIN {
require MIME::Lite;
require 't/test-lib.pm';
require 't/smtp.pm';
}
my ( $res, $user, $pwd );
my $mailSend = 0;
my $client = LLNG::Manager::Test->new(
{
......@@ -46,9 +45,11 @@ ok(
count(1);
expectOK($res);
# $query is set by MIME::Lite::send below
ok( mail() =~ m#a href="http://auth.example.com/register\?(.*?)"#,
'Found register token' );
$query = $1;
ok( $query =~ /register_token=/, 'Found register_token' );
count(1);
count(2);
ok(
$res = $client->_get( '/register', query => $query, accept => 'text/html' ),
......@@ -57,9 +58,15 @@ ok(
expectOK($res);
count(1);
# $user/$pwd are set by MIME::Lite::send below
ok(
mail() =~
m#Your login is.+?<b>(\w+)</b>.*?Your password is.+?<b>(.*?)</b>#s,
'Found user and password'
);
$user = $1;
$pwd = $2;
ok( $user eq 'fbar', 'Get good login' );
count(1);
count(2);
ok(
$res = $client->_post(
......@@ -76,36 +83,3 @@ clean_sessions();
done_testing( count() );
no warnings 'redefine';
my $mail2 = 0;
sub MIME::Lite::send {
my ($mail) = @_;
pass('Mail sent');
ok( $mail->header_as_string =~ /foobar\@badwolf.org/s, 'Found dest' )
or explain( $mail->header_as_string, 'To: foobar@badwolf.org' );
count(2);
unless ($mail2) {
$mailSend = 1;
ok(
$mail->body_as_string =~
m#a href="http://auth.example.com/register\?(.*?)"#,
'Found link'
);
count(1);
$query = $1;
$mail2++;
}
else {
$mailSend = 2;
ok(
$mail->body_as_string =~
m#Your login is.+?<b>(\w+)</b>.*?Your password is.+?<b>(.*?)</b>#s,
'Get login/pwd'
);
( $user, $pwd ) = ( $1, $2 );
count(1);
}
}
......@@ -3,12 +3,12 @@ use strict;
use IO::String;
BEGIN {
require MIME::Lite;
require 't/test-lib.pm';
require 't/smtp.pm';
}
my ( $res, $host, $url, $query );
my $maintests = 8;
my $maintests = 10;
my $mailSend = 0;
my $mail2 = 0;
......@@ -67,7 +67,10 @@ SKIP: {
'Post mail'
);
# $query has been set by MIME::Lite::send
ok( mail() =~ m#a href="http://auth.example.com/resetpwd\?(.*?)"#,
'Found link in mail' );
$query = $1;
ok(
$res =
$client->_get( '/resetpwd', query => $query, accept => 'text/html' ),
......@@ -87,6 +90,7 @@ SKIP: {
),
'Post new password'
);
ok( mail() =~ /Your password was changed/, 'Password was changed' );
#print STDERR Dumper($query);
}
......@@ -95,33 +99,3 @@ count($maintests);
clean_sessions();
done_testing( count() );
no warnings 'redefine';
sub MIME::Lite::send {
my ($mail) = @_;
pass('----- Mail given to MIME::Lite -----');
ok( $mail->header_as_string =~ /dwho\@badwolf.org/s, ' Found dest' )
or explain( $mail->header_as_string, 'To: dwho@badwolf.org' );
count(2);
unless ($mail2) {
$mailSend = 1;
ok(
$mail->body_as_string =~
m#a href="http://auth.example.com/resetpwd\?(.*?)"#,
' Found link'
);
count(1);
$query = $1;
$mail2++;
}
else {
$mailSend = 2;
ok( $mail->body_as_string =~ /Your password was changed/,
' Password was changed' );
count(1);
}
pass('----- Mail sent -----');
count(1);
}
......@@ -3,8 +3,8 @@ use strict;
use IO::String;
BEGIN {
require MIME::Lite;
require 't/test-lib.pm';
require 't/smtp.pm';
}
my ( $res, $user, $pwd );
......@@ -48,7 +48,11 @@ ok(
);
count(1);
# $query has been set by MIME::Lite::send
ok( mail() =~ m#a href="http://auth.example.com/resetpwd\?(.*?)"#,
'Found link in mail' );
$query = $1;
count(1);
ok(
$res = $client->_get( '/resetpwd', query => $query, accept => 'text/html' ),
'Post mail token received by mail'
......@@ -71,39 +75,11 @@ ok(
);
count(1);
ok( mail() =~ /Your password was changed/, 'Password was changed' );
count(1);
#print STDERR Dumper($query);
clean_sessions();
done_testing( count() );
no warnings 'redefine';
sub MIME::Lite::send {
my ($mail) = @_;
pass('----- Mail given to MIME::Lite -----');
ok( $mail->header_as_string =~ /dwho\@badwolf.org/s, ' Found dest' )
or explain( $mail->header_as_string, 'To: dwho@badwolf.org' );
count(2);
unless ($mail2) {
$mailSend = 1;
ok(
$mail->body_as_string =~
m#a href="http://auth.example.com/resetpwd\?(.*?)"#,
' Found link'
);
count(1);
$query = $1;
$mail2++;
}
else {
$mailSend = 2;
ok( $mail->body_as_string =~ /Your password was changed/,
' Password was changed' );
( $user, $pwd ) = ( $1, $2 );
count(1);
}
pass('----- Mail sent -----');
count(1);
}
......@@ -3,8 +3,8 @@ use strict;
use IO::String;
BEGIN {
require MIME::Lite;
require 't/test-lib.pm';
require 't/smtp.pm';
}
my ( $res, $user, $pwd );
......@@ -46,7 +46,11 @@ ok(
);
count(1);
# $query has been set by MIME::Lite::send
ok( mail() =~ m#a href="http://auth.example.com/resetpwd\?(.*?)"#,
'Found link in mail' );
$query = $1;
count(1);
ok(
$res = $client->_get( '/resetpwd', query => $query, accept => 'text/html' ),
'Post mail token received by mail'
......@@ -69,39 +73,11 @@ ok(
);
count(1);
ok( mail() =~ /Your password was changed/, 'Password was changed' );
count(1);
#print STDERR Dumper($query);
clean_sessions();
done_testing( count() );
no warnings 'redefine';
sub MIME::Lite::send {
my ($mail) = @_;
pass('----- Mail given to MIME::Lite -----');
ok( $mail->header_as_string =~ /dwho\@badwolf.org/s, ' Found dest' )
or explain( $mail->header_as_string, 'To: dwho@badwolf.org' );
count(2);
unless ($mail2) {
$mailSend = 1;
ok(
$mail->body_as_string =~
m#a href="http://auth.example.com/resetpwd\?(.*?)"#,
' Found link'
);
count(1);
$query = $1;
$mail2++;
}
else {
$mailSend = 2;
ok( $mail->body_as_string =~ /Your password was changed/,
' Password was changed' );
( $user, $pwd ) = ( $1, $2 );
count(1);
}
pass('----- Mail sent -----');
count(1);
}
package main;
my $mail;
my $envelope;
sub mail {
return $mail;
}
package Email::Sender::Transport::LLNG::Test;
use Mouse;
use Lemonldap::NG::Portal::Lib::SMTP;
$Lemonldap::NG::Portal::Lib::SMTP::transport = __PACKAGE__->new();
extends 'Email::Sender::Transport';
sub send_email {
my ( $self, $email, $envelope ) = @_;
$mail = $email->get_body;
$envelope = $envelope;
return $self->success;
}
1;
......@@ -79,7 +79,8 @@ BuildRequires: perl(Net::LDAP)
BuildRequires: perl(CGI::Session)
BuildRequires: perl(Test::Pod) >= 1.00
BuildRequires: perl(IO::String)
BuildRequires: perl(MIME::Lite)
BuildRequires: perl(Email::Sender)
BuildRequires: perl(MIME::Entity)
BuildRequires: perl(SOAP::Lite)
BuildRequires: perl(XML::Simple)
BuildRequires: perl(XML::LibXSLT)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment