Commit 6948cdcc authored by sikeda's avatar sikeda
Browse files

[change] Now "host" parameter of the LDAP datasource in list config may...

[change] Now "host" parameter of the LDAP datasource in list config may include URLs (ldap, ldaps and ldapi) along with hostnames.
So "port" and "use_ssl" parameters would be obsoleted.

Changes on code: host parameter of the LDAP datasource is checked by multiple_host_or_url regexp instead of multiple_host_with_port regexp; constructor of Sympa::Datasource::LDAP recognizes bind_dn and bind_password parameters; and as side effects, several cosmetic changes in sources are made.


git-svn-id: https://subversion.renater.fr/sympa/branches/sympa-6.2-branch@11794 05aa8bb8-cd2b-0410-b1d7-8918dfa770ce
parent 51388fb8
......@@ -3755,7 +3755,7 @@ sub do_login {
#Does the email belongs to an ldap directory?
if ($url_redirect = is_ldap_user($in{'email'})) {
$param->{'redirect_to'} = $url_redirect
if ($url_redirect && ($url_redirect != 1));
if $url_redirect ne 'none';
} elsif ($in{'failure_referer'}) {
$param->{'redirect_to'} = $in{'failure_referer'};
} else {
......@@ -4272,9 +4272,9 @@ sub do_sso_login {
} else {
unless (
defined $Conf::Conf{'auth_services'}{$robot}[$sso_id]
{'ldap_host'}
{'host'}
&& defined $Conf::Conf{'auth_services'}{$robot}[$sso_id]
{'ldap_get_email_by_uid_filter'}) {
{'get_email_by_uid_filter'}) {
Sympa::Report::reject_report_web('intern',
'auth_conf_no_identified_user',
{}, $param->{'action'}, '', '', $robot);
......@@ -4473,7 +4473,7 @@ sub is_ldap_user {
return undef;
}
 
## List all LDAP servers first
# List all LDAP servers first
my @ldap_servers;
foreach my $ldap (@{$Conf::Conf{'auth_services'}{$robot}}) {
next unless ($ldap->{'auth_type'} eq 'ldap');
......@@ -4481,7 +4481,7 @@ sub is_ldap_user {
push @ldap_servers, $ldap;
}
 
unless ($#ldap_servers >= 0) {
unless (@ldap_servers) {
return undef;
}
 
......@@ -4492,20 +4492,18 @@ sub is_ldap_user {
return undef;
}
 
my ($ldap_anonymous, $filter);
my ($ldaph, $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 $param = Sympa::Tools::Data::dup_var($ldap);
my $ds = Sympa::Datasource::LDAP->new($param);
my $ds = Sympa::Datasource::LDAP->new($ldap);
 
unless (defined $ds && ($ldap_anonymous = $ds->connect())) {
unless ($ds and $ldaph = $ds->connect()) {
Log::do_log('err', 'Unable to connect to the LDAP server "%s"',
$ldap->{'ldap_host'});
$ldap->{'host'});
next;
}
 
......@@ -4522,14 +4520,14 @@ sub is_ldap_user {
 
## !! une fonction get_dn_by_email/uid
 
my $mesg = $ldap_anonymous->search(
my $mesg = $ldaph->search(
base => $ldap->{'suffix'},
filter => "$filter",
scope => $ldap->{'scope'},
timeout => $ldap->{'timeout'}
);
 
unless ($mesg->count() != 0) {
unless ($mesg->count()) {
wwslog('notice',
'No entry in the LDAP Directory Tree of %s for %s',
$ldap->{'host'}, $auth);
......@@ -4538,11 +4536,10 @@ sub is_ldap_user {
}
 
$ds->disconnect();
my $redirect = $ldap->{'authentication_info_url'};
return $redirect || 1;
next unless ($ldap_anonymous);
return $ldap->{'authentication_info_url'} || 'none';
}
return undef;
}
 
## send back login form
......@@ -4816,7 +4813,7 @@ sub do_renewpasswd {
if ($in{'email'}) {
if ($url_redirect = is_ldap_user($in{'email'})) {
$param->{'redirect_to'} = $url_redirect
if ($url_redirect && ($url_redirect != 1));
if $url_redirect ne 'none';
} elsif (!tools::valid_email($in{'email'})) {
Sympa::Report::reject_report_web('user', 'incorrect_email',
{'email' => $in{'email'}},
......@@ -4866,7 +4863,7 @@ sub do_requestpasswd {
my $url_redirect;
if ($url_redirect = is_ldap_user($in{'email'})) {
## There might be no authentication_info_url URL defined in auth.conf
if ($url_redirect == 1) {
if ($url_redirect eq 'none') {
Sympa::Report::reject_report_web('user', 'ldap_user', {},
$param->{'action'});
wwslog('info', 'LDAP user %s, cannot remind password',
......@@ -4880,8 +4877,7 @@ sub do_requestpasswd {
);
return 'home';
} else {
$param->{'redirect_to'} = $url_redirect
if ($url_redirect && ($url_redirect != 1));
$param->{'redirect_to'} = $url_redirect;
return 1;
}
}
......
......@@ -1051,6 +1051,7 @@ sub _load_auth {
'negative_regexp' => '.*'
},
# Note: prefixes "ldap_" will be stripped. See below.
'cas' => {
'base_url' => 'http(s)?:/.*',
'non_blocking_redirection' => 'on|off',
......@@ -1074,6 +1075,7 @@ sub _load_auth {
'ldap_ssl_version' => 'sslv2/3|sslv2|sslv3|tlsv1',
'ldap_ssl_ciphers' => '[\w:]+'
},
# Note: prefixes "ldap_" will be stripped. See below.
'generic_sso' => {
'service_name' => '.+',
'service_id' => '\S+',
......@@ -1145,7 +1147,14 @@ sub _load_auth {
$value =~ s/\s//g;
}
$current_paragraph->{$keyword} = $value;
# Workaround: cas and generic_sso auth types require parameters
# prefixed by "ldap_", but LDAP datasource requires those not
# prefixed.
if ($keyword =~ /\Aldap_(\w+)\z/) {
$current_paragraph->{$1} = $value;
} else {
$current_paragraph->{$keyword} = $value;
}
}
## process current paragraph
......@@ -1217,7 +1226,7 @@ sub _load_auth {
## Force the default scope because '' is interpreted as
## 'base'
$current_paragraph->{'ldap_scope'} ||= 'sub';
$current_paragraph->{'scope'} ||= 'sub';
} elsif ($current_paragraph->{'auth_type'} eq 'generic_sso') {
$Conf{'generic_sso_number'}{$robot}++;
$Conf{'generic_sso_id'}{$robot}
......@@ -1225,7 +1234,7 @@ sub _load_auth {
$#paragraphs + 1;
## Force the default scope because '' is interpreted as
## 'base'
$current_paragraph->{'ldap_scope'} ||= 'sub';
$current_paragraph->{'scope'} ||= 'sub';
## default value for http_header_value_separator is ';'
$current_paragraph->{'http_header_value_separator'} ||=
';';
......
......@@ -205,7 +205,7 @@ sub authentication {
sub ldap_authentication {
my ($robot, $ldap, $auth, $pwd, $whichfilter) = @_;
my ($mesg, $host, $ldap_passwd, $ldap_anonymous);
my ($mesg, $host, $ldaph);
Log::do_log('debug2', '(%s, %s, %s)', $auth, '****', $whichfilter);
Log::do_log('debug3', 'Password used: %s', $pwd);
......@@ -235,16 +235,15 @@ sub ldap_authentication {
$filter =~ s/\[sender\]/$auth/ig;
## bind in order to have the user's DN
my $param = Sympa::Tools::Data::dup_var($ldap);
my $ds = Sympa::Datasource::LDAP->new($param);
my $ds = Sympa::Datasource::LDAP->new($ldap);
unless (defined $ds && ($ldap_anonymous = $ds->connect())) {
unless ($ds and $ldaph = $ds->connect()) {
Log::do_log('err', 'Unable to connect to the LDAP server "%s"',
$ldap->{'host'});
return undef;
}
$mesg = $ldap_anonymous->search(
$mesg = $ldaph->search(
base => $ldap->{'suffix'},
filter => "$filter",
scope => $ldap->{'scope'},
......@@ -265,21 +264,21 @@ sub ldap_authentication {
## bind with the DN and the pwd
## Duplicate structure first
## Then set the bind_dn and password according to the current user
$param = Sympa::Tools::Data::dup_var($ldap);
$param->{'ldap_bind_dn'} = $DN[0];
$param->{'ldap_bind_password'} = $pwd;
$ds = Sympa::Datasource::LDAP->new($param);
# 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,
}
);
unless (defined $ds && ($ldap_passwd = $ds->connect())) {
unless ($ds and $ldaph = $ds->connect()) {
Log::do_log('err', 'Unable to connect to the LDAP server "%s"',
$param->{'host'});
$ldap->{'host'});
return undef;
}
$mesg = $ldap_passwd->search(
$mesg = $ldaph->search(
base => $ldap->{'suffix'},
filter => "$filter",
scope => $ldap->{'scope'},
......@@ -296,6 +295,7 @@ sub ldap_authentication {
## To get the value of the canonic email and the alternative email
my (@canonic_email, @alternative);
my $param = Sympa::Tools::Data::dup_var($ldap);
## Keep previous alt emails not from LDAP source
my $previous = {};
foreach my $alt (keys %{$param->{'alt_emails'}}) {
......@@ -361,35 +361,34 @@ sub get_email_by_net_id {
return $email;
}
my $ldap = @{$Conf::Conf{'auth_services'}{$robot}}[$auth_id];
my $ldap = $Conf::Conf{'auth_services'}{$robot}->[$auth_id];
my $param = Sympa::Tools::Data::dup_var($ldap);
my $ds = Sympa::Datasource::LDAP->new($param);
my $ldap_anonymous;
my $ds = Sympa::Datasource::LDAP->new($ldap);
my $ldaph;
unless (defined $ds && ($ldap_anonymous = $ds->connect())) {
unless ($ds and $ldaph = $ds->connect()) {
Log::do_log('err', 'Unable to connect to the LDAP server "%s"',
$ldap->{'ldap_host'});
$ldap->{'host'});
return undef;
}
my $filter = $ldap->{'ldap_get_email_by_uid_filter'};
my $filter = $ldap->{'get_email_by_uid_filter'};
$filter =~ s/\[([\w-]+)\]/$attributes->{$1}/ig;
# my @alternative_conf = split(/,/,$ldap->{'alternative_email_attribute'});
my $emails = $ldap_anonymous->search(
base => $ldap->{'ldap_suffix'},
my $emails = $ldaph->search(
base => $ldap->{'suffix'},
filter => $filter,
scope => $ldap->{'ldap_scope'},
timeout => $ldap->{'ldap_timeout'},
attrs => [$ldap->{'ldap_email_attribute'}],
scope => $ldap->{'scope'},
timeout => $ldap->{'timeout'},
attrs => [$ldap->{'email_attribute'}],
);
my $count = $emails->count();
if ($emails->count() == 0) {
Log::do_log('notice', "No entry in the LDAP Directory Tree of %s",
$ldap->{'ldap_host'});
$ldap->{'host'});
$ds->disconnect();
return undef;
}
......@@ -399,7 +398,7 @@ sub get_email_by_net_id {
## return only the first attribute
my @results = $emails->entries;
foreach my $result (@results) {
return (lc($result->get_value($ldap->{'ldap_email_attribute'})));
return (lc($result->get_value($ldap->{'email_attribute'})));
}
}
......
......@@ -58,9 +58,10 @@ sub new {
sub _get_datasource_id {
my ($source) = shift;
Log::do_log('debug2', 'Getting datasource id for source "%s"', $source);
if (ref($source) eq 'Datasource') {
$source = shift;
}
# Not in case.
#if (ref($source) eq 'Sympa::Datasource') {
# $source = shift;
#}
if (ref($source)) {
## Ordering values so that order of keys in a hash don't mess the
......@@ -83,8 +84,10 @@ sub _get_datasource_id {
}
sub is_allowed_to_sync {
my $self = shift;
my $ranges = $self->{'nosync_time_ranges'};
#my $self = shift;
#my $ranges = $self->{'nosync_time_ranges'};
my $ranges = shift;
$ranges =~ s/^\s+//;
$ranges =~ s/\s+$//;
my $rsre = Sympa::Regexps::time_ranges();
......
......@@ -31,54 +31,41 @@ use Log;
use base qw(Sympa::Datasource);
use constant required_parameters => [qw(host)];
use constant optional_parameters => [
qw(port bind_dn bind_password
use_ssl use_start_tls ssl_version ssl_ciphers
ssl_cert ssl_key ca_verify ca_path ca_file)
];
use constant required_modules => [qw(Net::LDAP)];
sub new {
my $pkg = shift;
my $param = shift;
my $self = $param || {};
Log::do_log('debug', 'Creating new Sympa::Datasource::LDAP object');
## Map equivalent parameters (depends on the calling context : included
## members, scenario, authN
## Also set defaults
foreach my $p (keys %{$self}) {
unless ($p =~ /^ldap_/) {
my $p_equiv = 'ldap_' . $p;
## Respect existing entries
$self->{$p_equiv} = $self->{$p}
unless (defined $self->{$p_equiv});
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';
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;
}
}
$self->{'timeout'} ||= 3;
$self->{'ldap_bind_dn'} = $self->{'user'};
$self->{'ldap_bind_password'} = $self->{'passwd'};
$self->{'ca_verify'} ||= 'optional';
$self = $pkg->SUPER::new($self);
bless $self, $pkg;
unless (eval "require Net::LDAP") {
Log::do_log('err',
"Unable to use LDAP library, Net::LDAP required, install perl-ldap (CPAN) first"
);
return undef;
}
require Net::LDAP;
unless (eval "require Net::LDAP::Entry") {
Log::do_log('err',
"Unable to use LDAP library,Net::LDAP::Entry required install perl-ldap (CPAN) first"
);
return undef;
}
require Net::LDAP::Entry;
unless (eval "require Net::LDAP::Message") {
Log::do_log('err',
"Unable to use LDAP library,Net::LDAP::Entry required install perl-ldap (CPAN) first"
);
return undef;
}
require Net::LDAP::Message;
return $self;
}
......@@ -100,7 +87,7 @@ sub connect {
my $self = shift;
## Do we have all required parameters
foreach my $ldap_param ('ldap_host') {
foreach my $ldap_param (@{$self->required_parameters}) {
unless ($self->{$ldap_param}) {
Log::do_log('info', 'Missing parameter %s for LDAP connection',
$ldap_param);
......@@ -109,88 +96,90 @@ sub connect {
}
my $host_entry;
## There might be multiple alternate hosts defined
foreach $host_entry (split(/,/, $self->{'ldap_host'})) {
## Remove leading and trailing spaces
$host_entry =~ s/^\s*(\S.*\S)\s*$/$1/;
my ($host, $port) = split(/:/, $host_entry);
## If port a 'port' entry was defined, use it as default
$self->{'port'} ||= $port if (defined $port);
## value may be '1' or 'yes' depending on the context
if ( $self->{'ldap_use_ssl'} eq 'yes'
|| $self->{'ldap_use_ssl'} eq '1') {
$self->{'sslversion'} = $self->{'ldap_ssl_version'}
if ($self->{'ldap_ssl_version'});
$self->{'ciphers'} = $self->{'ldap_ssl_ciphers'}
if ($self->{'ldap_ssl_ciphers'});
unless (eval "require Net::LDAPS") {
Log::do_log('err',
"Unable to use LDAPS library, Net::LDAPS required");
return undef;
}
require Net::LDAPS;
$self->{'ldap_handler'} =
Net::LDAPS->new($host, port => $port, %{$self});
} else {
$self->{'ldap_handler'} = Net::LDAP->new($host, %{$self});
# There might be multiple alternate hosts defined
foreach my $host (split /\s*,\s*/, $self->{host}) {
# Canonicalize host parameter to be "scheme://host:port".
# Value of obsoleted use_ssl parameter may be '1' or 'yes' depending
# on the context.
$host .= ':' . $self->{port}
if $self->{port} and $host !~ m{:[-\w]+\z};
$host = 'ldaps://' . $host
if $self->{use_ssl}
and ($self->{use_ssl} eq '1' or $self->{use_ssl} eq 'yes')
and $host !~ m{\A[-\w]+://};
$host = 'ldap://' . $host
if $host !~ m{\A[-\w]+://};
# new() may die if depending module is missing (e.g. for SSL).
$self->{'ldap_handler'} = eval {
Net::LDAP->new(
$host,
timeout => $self->{'timeout'},
verify => $self->{'ca_verify'},
capath => $self->{'ca_path'},
cafile => $self->{'ca_file'},
sslversion => $self->{'ssl_version'},
ciphers => $self->{'ssl_ciphers'},
clientcert => $self->{'ssl_cert'},
clientkey => $self->{'ssl_key'},
);
};
# if $self->{'ldap_handler'} is defined, skip alternate hosts
if ($self->{'ldap_handler'}) {
$host_entry = $host;
last;
}
next unless (defined $self->{'ldap_handler'});
## if $self->{'ldap_handler'} is defined, skip alternate hosts
last;
}
unless (defined $self->{'ldap_handler'}) {
unless ($self->{'ldap_handler'}) {
Log::do_log('err', 'Unable to connect to the LDAP server "%s"',
$self->{'ldap_host'});
$self->{'host'});
return undef;
}
## Using start_tls() will convert the existing connection to using
## Transport Layer Security (TLS), which pro-
## vides an encrypted connection. This is only possible if the connection
## uses LDAPv3, and requires that the
## server advertizes support for LDAP_EXTENSION_START_TLS. Use
## "supported_extension" in Net::LDAP::RootDSE to
## check this.
# Using start_tls() will convert the existing connection to using
# Transport Layer Security (TLS), which provides an encrypted connection.
# FIXME: This is only possible if the connection uses LDAPv3, and requires
# that the server advertizes support for LDAP_EXTENSION_START_TLS. Use
# "supported_extension" in Net::LDAP::RootDSE to check this.
if ($self->{'use_start_tls'}) {
$self->{'ldap_handler'}->start_tls(
verify => $self->{'ca_verify'},
capath => $self->{'ca_path'},
cafile => $self->{'ca_file'},
sslversion => $self->{'ssl_version'},
ciphers => $self->{'ssl_ciphers'},
clientcert => $self->{'ssl_cert'},
clientkey => $self->{'ssl_key'},
);
# new() may die if depending module for SSL/TLS is missing.
# FIXME: Result should be checked.
eval {
$self->{'ldap_handler'}->start_tls(
verify => $self->{'ca_verify'},
capath => $self->{'ca_path'},
cafile => $self->{'ca_file'},
sslversion => $self->{'ssl_version'},
ciphers => $self->{'ssl_ciphers'},
clientcert => $self->{'ssl_cert'},
clientkey => $self->{'ssl_key'},
);
};
}
my $cnx;
## Not always anonymous...
if ( defined($self->{'ldap_bind_dn'})
&& defined($self->{'ldap_bind_password'})) {
$cnx = $self->{'ldap_handler'}->bind($self->{'ldap_bind_dn'},
password => $self->{'ldap_bind_password'});
if ( defined $self->{'bind_dn'}
and defined $self->{'bind_password'}) {
$cnx =
$self->{'ldap_handler'}
->bind($self->{'bind_dn'}, password => $self->{'bind_password'});
} else {
$cnx = $self->{'ldap_handler'}->bind;
}
unless (defined($cnx) && ($cnx->code() == 0)) {
unless (defined $cnx and $cnx->code() == 0) {
Log::do_log('err',
'Failed to bind to LDAP server: "%s", LDAP server error: "%s"',
$host_entry, $cnx->error, $cnx->server_error);
$self->{'ldap_handler'}->unbind;
return undef;
}
Log::do_log('debug', 'Bound to LDAP host "%s"', $host_entry);
Log::do_log('notice', 'Bound to LDAP host "%s"', $host_entry);
return $self->{'ldap_handler'};
}
## Does not make sense in LDAP context
......
......@@ -6710,11 +6710,9 @@ sub _include_users_voot_group {
## Returns a list of subscribers extracted from a remote LDAP Directory
sub _include_users_ldap {
my ($users, $id, $source, $default_user_options, $tied) = @_;
my ($users, $id, $source, $ds, $default_user_options, $tied) = @_;
Log::do_log('debug2', '');
my $user = $source->{'user'};
my $passwd = $source->{'passwd'};
my $ldap_suffix = $source->{'suffix'};
my $ldap_filter = $source->{'filter'};
my $ldap_attrs = $source->{'attrs'};
......@@ -6729,7 +6727,7 @@ sub _include_users_ldap {
## Connection timeout (default is 120)
#my $timeout = 30;
unless (defined $source && $source->connect()) {
unless ($ds and $ldaph = $ds->connect()) {
Log::do_log('err', 'Unable to connect to the LDAP server "%s"',
$source->{'host'});
return undef;
......@@ -6737,7 +6735,7 @@ sub _include_users_ldap {
Log::do_log('debug2',
'Searching on server %s; suffix %s; filter %s; attrs: %s',
$source->{'host'}, $ldap_suffix, $ldap_filter, $ldap_attrs);
$fetch = $source->{'ldap_handler'}->search(
$fetch = $ldaph->search(
base => "$ldap_suffix",
filter => "$ldap_filter",
attrs => [@attrs],
......@@ -6798,7 +6796,7 @@ sub _include_users_ldap {
}
}
unless ($source->disconnect()) {
unless ($ds->disconnect()) {
Log::do_log('notice', 'Can\'t unbind from LDAP server %s',
$source->{'host'});
return undef;
......@@ -6857,11 +6855,9 @@ sub _include_users_ldap {
## Returns a list of subscribers extracted indirectly from a remote LDAP
## Directory using a two-level query
sub _include_users_ldap_2level {
my ($users, $id, $source, $default_user_options, $tied) = @_;
my ($users, $id, $source, $ds, $default_user_options, $tied) = @_;
Log::do_log('debug2', '');
my $user = $source->{'user'};
my $passwd = $source->{'passwd'};
my $ldap_suffix1 = $source->{'suffix1'};
my $ldap_filter1 = $source->{'filter1'};
my $ldap_attrs1 = $source->{'attrs1'};
......@@ -6883,7 +6879,7 @@ sub _include_users_ldap_2level {
## LDAP and query handler
my ($ldaph, $fetch);