src/lib/Sympa/DatabaseDriver/LDAP.pm

@@ -8,6 +8,9 @@
 # Copyright (c) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
 # 2006, 2007, 2008, 2009, 2010, 2011 Comite Reseau des Universites
 # Copyright (c) 2011, 2012, 2013, 2014, 2015, 2016, 2017 GIP RENATER
+# Copyright 2018 The Sympa Community. See the AUTHORS.md file at the
+# top-level directory of this distribution and at
+# <https://github.com/sympa-community/sympa.git>.
 #
 # This program is free software; you can redistribute it and/or modify
 # it under the terms of the GNU General Public License as published by
@@ -40,7 +43,7 @@ use constant optional_parameters => [
         use_tls ssl_version ssl_ciphers
         ssl_cert ssl_key ca_verify ca_path ca_file)
 ];
-use constant required_modules => [qw(Net::LDAP)];
+use constant required_modules => [qw(Net::LDAP Net::LDAP::Util)];
 use constant optional_modules => [qw(IO::Socket::SSL)];
 
 sub _new {
@@ -221,6 +224,38 @@ sub error {
     return undef;
 }
 
+sub canonical_dn {
+    my $self = shift;
+    my $dn   = shift;
+
+    my $canonical = Net::LDAP::Util::canonical_dn($dn);
+    return undef unless defined $canonical;
+
+    # Some (e.g. Active Directory) may be fond of RFC1779 escaping.
+    # So we use that method (See RFC4514 2.4) as much as possible.
+    # N.B.: AD also allows it for LF (0A), CR (0D) and "/" (2F).
+    #   But RFC1779 allows it for CR and RFC4514 does for neither.
+    $canonical =~ s{\\(20|22|23|2B|2C|3B|3C|3D|3E|5C)}{
+        "\\" . (chr hex "0x$1")
+    }eg;
+
+    return $canonical;
+}
+
+sub escape_dn_value {
+    my $self = shift;
+    my $str  = shift;
+
+    return Net::LDAP::Util::escape_dn_value($str);
+}
+
+sub escape_filter_value {
+    my $self = shift;
+    my $str  = shift;
+
+    return Net::LDAP::Util::escape_filter_value($str);
+}
+
 1;
 
 =encoding utf-8
@@ -233,6 +268,29 @@ Sympa::DatabaseDriver::LDAP - Database driver for LDAP search operation
 
 TBD.
 
+=head2 Methods specific to this module
+
+=over
+
+=item canonical_dn ( $dn )
+
+I<Instance method>.
+See L<Net::LDAP::Util/canonical_dn>.
+
+However, this method try to use RFC 1779 escaping as much as possible.
+
+=item escape_dn_value ( $string )
+
+I<Instance method>.
+See L<Net::LDAP::Util/escape_dn_value>.
+
+=item escape_filter_value ( $string )
+
+I<Instance method>.
+See L<Net::LDAP::Util/escape_filter_value>.
+
+=back
+
 =head1 SEE ALSO
 
 L<Sympa::DatabaseDriver>, L<Sympa::Database>.

src/lib/Sympa/List.pm

@@ -5250,11 +5250,24 @@ sub _include_users_ldap_2level {
 
     my ($suffix2, $filter2);
     foreach my $attr (@attrs) {
-        # Escape LDAP characters occurring in attribute
-        my $escaped_attr = $attr;
-        $escaped_attr =~ s/([\\\(\*\)\0])/sprintf "\\%02X", ord($1)/eg;
-
+        my $escaped_attr;
+
+        # Escape LDAP characters occurring in attribute for search base.
+        if ($ldap_suffix2 =~ /[[]attrs1[]]\z/) {
+            # [attrs1] should be a DN, because it is search base or its root.
+            $escaped_attr = $db->canonical_dn($attr);
+            unless (defined $escaped_attr) {
+                $log->syslog('err', 'Attribute value is not a DN: %s', $attr);
+                next;
+            }
+        } else {
+            # [attrs1] may be an attributevalue in DN.
+            $escaped_attr = $db->escape_dn_value($attr);
+        }
         ($suffix2 = $ldap_suffix2) =~ s/\[attrs1\]/$escaped_attr/g;
+
+        # Escape LDAP characters occurring in attribute for search filter.
+        $escaped_attr = $db->escape_filter_value($attr);
         ($filter2 = $ldap_filter2) =~ s/\[attrs1\]/$escaped_attr/g;
 
         $log->syslog('debug2',

src/lib/Sympa/ModDef.pm

@@ -348,6 +348,8 @@ our %cpan_modules = (
         'gettext_id' =>
             'required to query LDAP directories. Sympa can do LDAP-based authentication ; it can also build mailing lists with LDAP-extracted members.',
     },
+    # Net::LDAP::Entry, Net::LDAP::Util and Net::LDAPS are included in
+    # perl-ldap.
     'Net::SMTP' => {
         package_name => 'libnet',
         'gettext_id' =>