Commit 8384b5d5 authored by sikeda's avatar sikeda
Browse files

[dev] Refactoring: Sympa::Datasource::SQL and Sympa::Datasource::LDAP are...

[dev] Refactoring: Sympa::Datasource::SQL and Sympa::Datasource::LDAP are merged and became Sympa::Database.  Code specific to LDAP is moved to Sympa::DatabaseDriver::LDAP.


git-svn-id: https://subversion.renater.fr/sympa/branches/sympa-6.2-branch@11801 05aa8bb8-cd2b-0410-b1d7-8918dfa770ce
parent 1841b00c
......@@ -28,7 +28,7 @@ check_SCRIPTS = t/Language.t \
t/Regexps.t \
t/compile_modules.t \
t/compile_executables.t \
t/Datasource_LDAP.t \
t/Database_LDAP.t \
t/tools_data.t \
t/tools_file.t \
t/Tools_SMIME.t \
......
......@@ -69,10 +69,10 @@ use Conf;
use Sympa::ConfDef;
use Sympa::Constants;
use Sympa::Crash Hook => \&_crash_handler; # Show traceback.
use Sympa::Database;
use Sympa::Family;
use Sympa::HTMLSanitizer;
use Sympa::Language;
use Sympa::Datasource::LDAP;
use Sympa::List;
use Log;
use Sympa::Marc::Search;
......@@ -4463,8 +4463,6 @@ sub do_sso_login_succeeded {
}
}
 
BEGIN { eval 'use Net::LDAP'; }
sub is_ldap_user {
my $auth = shift; ## User email or UID
wwslog('debug2', '(%s)', $auth);
......@@ -4485,23 +4483,15 @@ sub is_ldap_user {
return undef;
}
 
unless ($Net::LDAP::VERSION) {
wwslog('err',
"Unable to use LDAP library, Net::LDAP required,install perl-ldap (CPAN) first"
);
return undef;
}
my ($ldaph, $filter);
my $filter;
 
foreach my $ldap (@ldap_servers) {
# skip ldap auth service if the user id or email do not match regexp
# auth service parameter
next unless ($auth =~ /$ldap->{'regexp'}/i);
my $ds = Sympa::Datasource::LDAP->new($ldap);
next unless $auth =~ /$ldap->{'regexp'}/i;
 
unless ($ds and $ldaph = $ds->connect()) {
my $db = Sympa::Database->new('LDAP', %$ldap);
unless ($db and $db->connect) {
Log::do_log('err', 'Unable to connect to the LDAP server "%s"',
$ldap->{'host'});
next;
......@@ -4520,22 +4510,23 @@ sub is_ldap_user {
 
## !! une fonction get_dn_by_email/uid
 
my $mesg = $ldaph->search(
my $mesg = $db->do_operation(
'search',
base => $ldap->{'suffix'},
filter => "$filter",
scope => $ldap->{'scope'},
timeout => $ldap->{'timeout'}
);
 
unless ($mesg->count()) {
unless ($mesg and $mesg->count()) {
wwslog('notice',
'No entry in the LDAP Directory Tree of %s for %s',
$ldap->{'host'}, $auth);
$ds->disconnect();
$db->disconnect();
last;
}
 
$ds->disconnect();
$db->disconnect();
return $ldap->{'authentication_info_url'} || 'none';
}
 
......
......@@ -33,9 +33,11 @@ nobase_modules_DATA = \
Sympa/Config_XML.pm \
Sympa/Constants.pm \
Sympa/Crash.pm \
Sympa/Database.pm \
Sympa/DatabaseDescription.pm \
Sympa/DatabaseDriver.pm \
Sympa/DatabaseDriver/CSV.pm \
Sympa/DatabaseDriver/LDAP.pm \
Sympa/DatabaseDriver/MySQL.pm \
Sympa/DatabaseDriver/ODBC.pm \
Sympa/DatabaseDriver/Oracle.pm \
......@@ -44,8 +46,6 @@ nobase_modules_DATA = \
Sympa/DatabaseDriver/SQLite.pm\
Sympa/DatabaseDriver/Sybase.pm \
Sympa/Datasource.pm \
Sympa/Datasource/LDAP.pm \
Sympa/Datasource/SQL.pm \
Sympa/Family.pm \
Sympa/Fetch.pm \
Sympa/HTML/FormatText.pm \
......@@ -96,9 +96,11 @@ MAN3PM = \
Sympa/ConfDef.pm \
Sympa/Constants.pm \
Sympa/Crash.pm \
Sympa/Database.pm \
Sympa/DatabaseDescription.pm \
Sympa/DatabaseDriver.pm \
Sympa/DatabaseDriver/CSV.pm \
Sympa/DatabaseDriver/LDAP.pm \
Sympa/DatabaseDriver/MySQL.pm \
Sympa/DatabaseDriver/ODBC.pm \
Sympa/DatabaseDriver/Oracle.pm \
......
......@@ -29,10 +29,10 @@ use warnings;
use Conf;
use Sympa::Constants;
use Sympa::Database;
use Sympa::DatabaseDescription;
use Log;
#use Sympa::List;
use Sympa::Datasource::SQL;
use tools;
use Sympa::Tools::Data;
......@@ -138,12 +138,13 @@ sub connect_sympa_database {
($option ne 'just_try' && !$ENV{'GATEWAY_INTERFACE'}),
'warn' => 1,
};
unless ($db_source = Sympa::Datasource::SQL->new($db_conf)) {
Log::do_log('err', 'Unable to create Sympa::Datasource::SQL object');
unless ($db_source =
Sympa::Database->new($db_conf->{'db_type'}, %$db_conf)) {
Log::do_log('err', 'Unable to create Sympa::Database object');
return undef;
}
## Used to check that connecting to the Sympa database works and the
## Sympa::Datasource::SQL object is created.
## Sympa::Database object is created.
$use_db = 1;
# Just in case, we connect to the database here. Probably not necessary.
......
......@@ -30,7 +30,7 @@ use Digest::MD5;
use POSIX qw();
use Conf;
use Sympa::Datasource::LDAP;
use Sympa::Database;
use Log;
use Sympa::Report;
use Sympa::Robot;
......@@ -205,7 +205,7 @@ sub authentication {
sub ldap_authentication {
my ($robot, $ldap, $auth, $pwd, $whichfilter) = @_;
my ($mesg, $host, $ldaph);
my ($mesg, $host);
Log::do_log('debug2', '(%s, %s, %s)', $auth, '****', $whichfilter);
Log::do_log('debug3', 'Password used: %s', $pwd);
......@@ -235,60 +235,62 @@ sub ldap_authentication {
$filter =~ s/\[sender\]/$auth/ig;
## bind in order to have the user's DN
my $ds = Sympa::Datasource::LDAP->new($ldap);
my $db = Sympa::Database->new('LDAP', %$ldap);
unless ($ds and $ldaph = $ds->connect()) {
unless ($db and $db->connect()) {
Log::do_log('err', 'Unable to connect to the LDAP server "%s"',
$ldap->{'host'});
return undef;
}
$mesg = $ldaph->search(
$mesg = $db->do_operation(
'search',
base => $ldap->{'suffix'},
filter => "$filter",
scope => $ldap->{'scope'},
timeout => $ldap->{'timeout'}
);
if ($mesg->count() == 0) {
unless ($mesg and $mesg->count()) {
Log::do_log('notice',
'No entry in the LDAP Directory Tree of %s for %s',
$ldap->{'host'}, $auth);
$ds->disconnect();
$db->disconnect();
return undef;
}
my $refhash = $mesg->as_struct();
my (@DN) = keys(%$refhash);
$ds->disconnect();
$db->disconnect();
## bind with the DN and the pwd
# Then set the bind_dn and password according to the current user
$ds = Sympa::Datasource::LDAP->new(
{ %$ldap,
bind_dn => $DN[0],
bind_password => $pwd,
}
$db = Sympa::Database->new(
'LDAP',
%$ldap,
bind_dn => $DN[0],
bind_password => $pwd,
);
unless ($ds and $ldaph = $ds->connect()) {
unless ($db and $db->connect()) {
Log::do_log('err', 'Unable to connect to the LDAP server "%s"',
$ldap->{'host'});
return undef;
}
$mesg = $ldaph->search(
$mesg = $db->do_operation(
'search',
base => $ldap->{'suffix'},
filter => "$filter",
scope => $ldap->{'scope'},
timeout => $ldap->{'timeout'}
);
if ($mesg->count() == 0 || $mesg->code() != 0) {
unless ($mesg and $mesg->count()) {
Log::do_log('notice', "No entry in the LDAP Directory Tree of %s",
$ldap->{'host'});
$ds->disconnect();
$db->disconnect();
return undef;
}
......@@ -324,7 +326,7 @@ sub ldap_authentication {
$param->{'alt_emails'}{$alt} = $previous->{$alt};
}
$ds->disconnect() or Log::do_log('notice', 'Unable to unbind');
$db->disconnect() or Log::do_log('notice', 'Unable to unbind');
Log::do_log('debug3', 'Canonic: %s', $canonic_email[0]);
## If the identifier provided was a valid email, return the provided
## email.
......@@ -363,10 +365,9 @@ sub get_email_by_net_id {
my $ldap = $Conf::Conf{'auth_services'}{$robot}->[$auth_id];
my $ds = Sympa::Datasource::LDAP->new($ldap);
my $ldaph;
my $db = Sympa::Database->new('LDAP', %$ldap);
unless ($ds and $ldaph = $ds->connect()) {
unless ($db and $db->connect()) {
Log::do_log('err', 'Unable to connect to the LDAP server "%s"',
$ldap->{'host'});
return undef;
......@@ -377,26 +378,26 @@ sub get_email_by_net_id {
# my @alternative_conf = split(/,/,$ldap->{'alternative_email_attribute'});
my $emails = $ldaph->search(
my $mesg = $db->do_operation(
'search',
base => $ldap->{'suffix'},
filter => $filter,
scope => $ldap->{'scope'},
timeout => $ldap->{'timeout'},
attrs => [$ldap->{'email_attribute'}],
);
my $count = $emails->count();
if ($emails->count() == 0) {
unless ($mesg and $mesg->count()) {
Log::do_log('notice', "No entry in the LDAP Directory Tree of %s",
$ldap->{'host'});
$ds->disconnect();
$db->disconnect();
return undef;
}
$ds->disconnect();
$db->disconnect();
## return only the first attribute
my @results = $emails->entries;
my @results = $mesg->entries;
foreach my $result (@results) {
return (lc($result->get_value($ldap->{'email_attribute'})));
}
......
......@@ -22,7 +22,7 @@
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <http://www.gnu.org/licenses/>.
package Sympa::Datasource::SQL;
package Sympa::Database;
use strict;
use warnings;
......@@ -44,13 +44,15 @@ my %driver_aliases = (
Pg => 'Sympa::DatabaseDriver::PostgreSQL',
);
# Sympa::Database is the proxy class of Sympa::DatabaseDriver subclasses.
# The constructor may be overridden by _new() method.
sub new {
Log::do_log('debug2', '(%s, %s)', @_);
my $class = shift;
my $params = shift;
my %params = %$params;
my $class = shift;
my $db_type = shift;
my %params = @_;
my $driver = $driver_aliases{$params{'db_type'}} || $params{'db_type'};
my $driver = $driver_aliases{$db_type} || $db_type;
$driver = 'Sympa::DatabaseDriver::' . $driver
unless $driver =~ /::/;
unless (eval "require $driver"
......@@ -60,7 +62,8 @@ sub new {
return undef;
}
my $self = bless {
return $driver->_new(
$db_type,
map {
(exists $params{$_} and defined $params{$_})
? ($_ => $params{$_})
......@@ -70,9 +73,15 @@ sub new {
@{$driver->optional_parameters},
'reconnect_options'
)
} => $driver;
);
}
return $self;
sub _new {
my $class = shift;
my $db_type = shift;
my %params = @_;
return bless {%params} => $class;
}
############################################################
......@@ -139,7 +148,7 @@ sub connect {
$connection_of{$self->{_id}} = eval { $self->_connect };
unless ($self->ping) {
unless ( $self->{'reconnect_options'}
unless ($self->{'reconnect_options'}
and $self->{'reconnect_options'}{'keep_trying'}) {
Log::do_log('err', 'Can\'t connect to Database %s', $self);
$self->{_status} = 'failed';
......@@ -196,6 +205,10 @@ sub __dbh {
return $connection_of{$self->{_id} || ''};
}
sub do_operation {
die 'Not implemented';
}
sub do_query {
my $self = shift;
my $query = shift;
......@@ -223,7 +236,7 @@ sub do_query {
my $trace_statement = sprintf $query,
@{$self->prepare_query_log_values(@params)};
Log::do_log('err', 'Unable to prepare SQL statement %s: %s',
$trace_statement, $self->__dbh->errstr);
$trace_statement, $self->error);
return undef;
}
}
......@@ -250,7 +263,7 @@ sub do_query {
@{$self->prepare_query_log_values(@params)};
Log::do_log('err',
'Unable to prepare SQL statement %s: %s',
$trace_statement, $self->__dbh->errstr);
$trace_statement, $self->error);
return undef;
}
}
......@@ -259,7 +272,7 @@ sub do_query {
my $trace_statement = sprintf $query,
@{$self->prepare_query_log_values(@params)};
Log::do_log('err', 'Unable to execute SQL statement "%s": %s',
$trace_statement, $self->__dbh->errstr);
$trace_statement, $self->error);
return undef;
}
}
......@@ -312,7 +325,7 @@ sub do_prepared_query {
} else {
unless ($sth = $self->__dbh->prepare($query)) {
Log::do_log('err', 'Unable to prepare SQL statement: %s',
$self->__dbh->errstr);
$self->error);
return undef;
}
}
......@@ -344,7 +357,7 @@ sub do_prepared_query {
unless ($sth = $self->__dbh->prepare($query)) {
Log::do_log('err',
'Unable to prepare SQL statement: %s',
$self->__dbh->errstr);
$self->error);
return undef;
}
}
......@@ -359,7 +372,7 @@ sub do_prepared_query {
$self->{'cached_prepared_statements'}{$query} = $sth;
unless ($sth->execute(@params)) {
Log::do_log('err', 'Unable to execute SQL statement "%s": %s',
$query, $self->__dbh->errstr);
$query, $self->error);
return undef;
}
}
......@@ -397,6 +410,14 @@ sub disconnect {
# NOT YET USED.
#sub create_db;
sub error {
my $self = shift;
my $dbh = $self->__dbh;
return sprintf '(%s) %s', $dbh->state, ($dbh->errstr || '') if $dbh;
return undef;
}
sub ping {
my $self = shift;
......@@ -456,3 +477,51 @@ sub get_id {
}
1;
=encoding utf-8
=head1 NAME
Sympa::Database - Handling databases
=head1 SYNOPSIS
TBD.
=head1 DESCRIPTION
TBD.
=head2 Methods
=over
=item new ( $db_type, [ option => value, ... ] )
I<Constructor>.
TBD.
=item do_operation ( $operation, options... )
I<Instance method>, I<only for LDAP>.
TBD.
=item do_prepared_query ( $statement, parameters... )
I<Instance method>, I<only for SQL>.
TBD.
=item do_query ( $statement, parameters... )
I<Instance method>, I<only for SQL>.
TBD.
TBD.
=back
=head1 SEE ALSO
L<Sympa::DatabaseDriver>, L<Sympa::Datasource>, L<SDM>.
=cut
......@@ -29,7 +29,7 @@ use warnings;
use Log;
use base qw(Sympa::Datasource::SQL);
use base qw(Sympa::Database);
use constant required_modules => [];
use constant required_parameters => [qw(db_host db_name db_user db_passwd)];
......
......@@ -22,14 +22,15 @@
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <http://www.gnu.org/licenses/>.
package Sympa::Datasource::LDAP;
package Sympa::DatabaseDriver::LDAP;
use strict;
use warnings;
use English qw(-no_match_vars);
use Log;
use base qw(Sympa::Datasource);
use base qw(Sympa::DatabaseDriver);
use constant required_parameters => [qw(host)];
use constant optional_parameters => [
......@@ -39,128 +40,86 @@ use constant optional_parameters => [
];
use constant required_modules => [qw(Net::LDAP)];
sub new {
Log::do_log('debug2', '(%s, %s)', @_);
my $class = shift;
my $params = shift;
my %params = %$params;
my $self = bless {
map {
(exists $params{$_} and defined $params{$_})
? ($_ => $params{$_})
: ()
} (@{$class->required_parameters}, @{$class->optional_parameters})
} => $class;
$self->{timeout} ||= 3;
$self->{ca_verify} ||= 'optional';
sub _new {
my $class = shift;
my $db_type = shift;
my %params = @_;
# Canonicalize host parameter to be "scheme://host:port".
my @hosts =
(ref $self->{host})
? @{$self->{host}}
: (split /\s*,\s*/, $self->{host});
(ref $params{host})
? @{$params{host}}
: (split /\s*,\s*/, $params{host});
foreach my $host (@hosts) {
$host .= ':' . $self->{port}
if $self->{port} and $host !~ m{:[-\w]+\z};
$host .= ':' . $params{port}
if $params{port} and $host !~ m{:[-\w]+\z};
# Value of obsoleted use_ssl parameter may be '1' or 'yes' depending
# on the context.
$host = 'ldaps://' . $host
if $self->{use_ssl}
and ($self->{use_ssl} eq '1' or $self->{use_ssl} eq 'yes')
if $params{use_ssl}
and ($params{use_ssl} eq '1' or $params{use_ssl} eq 'yes')
and $host !~ m{\A[-\w]+://};
$host = 'ldap://' . $host
if $host !~ m{\A[-\w]+://};
}
$self->{host} = [@hosts];
foreach my $module (@{$class->required_modules}) {
unless (eval "require $module") {
Log::do_log(
'err',
'No module installed for LDAP. You should download and install %s',
$module
);
return undef;
}
}
$params{_hosts} = [@hosts];
$params{host} = join ',', @hosts;
delete $params{port};
delete $params{use_ssl};
return $self;
return bless {%params} => $class;
}
############################################################
# connect
############################################################
# Connect to an LDAP directory. This could be called as
# a Sympa::Datasource::LDAP object member, or as a static sub.
#
# IN : -$options : ref to a hash. Options for the connection process.
# currently accepts 'keep_trying' : wait and retry until
# db connection is ok (boolean) ; 'warn' : warn
# listmaster if connection fails (boolean)
# OUT : $self->{'ldap_handler'}
# | undef
#
##############################################################
sub connect {
sub _connect {
my $self = shift;
## Do we have all required parameters
foreach my $ldap_param (@{$self->required_parameters}) {
unless ($self->{$ldap_param}) {
Log::do_log('info', 'Missing parameter %s for LDAP connection',
$ldap_param);
return undef;
}
}
my $connection;
my $host_entry;
# There might be multiple alternate hosts defined
foreach my $host (@{$self->{host}}) {
foreach my $host (@{$self->{_hosts}}) {
# new() may die if depending module is missing (e.g. for SSL).
$self->{'ldap_handler'} = eval {
$connection = eval {
Net::LDAP->new(
$host,