Escape special characters in user/role names

This makes user and role names with special characters in them work,
instead of making the query syntactically invalid, and means we don't
have to reject user names with wildcards in them.

diff --git a/Changes b/Changes
index a06d711..aa3e1e0 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,3 +1,5 @@
+  - Escape special characters in user/role names
+
 1.014 26 April 2013
   - Don't fall back to unauthenticated bind when authenticating
 

diff --git a/lib/Catalyst/Authentication/Store/LDAP/Backend.pm b/lib/Catalyst/Authentication/Store/LDAP/Backend.pm
index 8c457b7..8e69c59 100644 (file)
--- a/lib/Catalyst/Authentication/Store/LDAP/Backend.pm
+++ b/lib/Catalyst/Authentication/Store/LDAP/Backend.pm
@@ -282,11 +282,6 @@ This method is usually only called by find_user().
 sub lookup_user {
     my ( $self, $id ) = @_;
 
-    # No sneaking in wildcards!
-    if ( $id =~ /\*/ ) {
-        Catalyst::Exception->throw("ID $id contains wildcards!");
-    }
-
     # Trim trailing space or we confuse ourselves
     $id =~ s/\s+$//;
     my $ldap = $self->ldap_bind;
@@ -419,6 +414,7 @@ sub _replace_filter {
     my $self    = shift;
     my $filter  = shift;
     my $replace = shift;
+    $replace =~ s/([*()\\\x{0}])/sprintf '\\%02x', ord($1)/ge;
     $filter =~ s/\%s/$replace/g;
     return $filter;
 }

diff --git a/t/02-realms_api.t b/t/02-realms_api.t
index 3d26b93..3683373 100644 (file)
--- a/t/02-realms_api.t
+++ b/t/02-realms_api.t
@@ -29,10 +29,20 @@ my $back = Catalyst::Authentication::Store::LDAP::Backend->new(
     }
 );
 
-isa_ok( $back, "Catalyst::Authentication::Store::LDAP::Backend" );
-ok( my $user = $back->find_user( { username => 'somebody' } ), "find_user" );
-isa_ok( $user, "Catalyst::Authentication::Store::LDAP::User" );
-my $displayname = $user->displayname;
-cmp_ok( $displayname, 'eq', 'Some Body', 'Should be Some Body' );
+isa_ok( $back, "Catalyst::Authentication::Store::LDAP::Backend", 'LDAP backed' );
+
+foreach (
+    ['somebody', 'Some Body'],
+    ['sunnO)))', 'Sunn O)))'],
+    ['some*',    'Some Star'],
+) {
+    my ($username, $name) = @$_;
+
+    my $user = $back->find_user( { username => $username } );
+    isa_ok( $user, "Catalyst::Authentication::Store::LDAP::User", "find_user('$username') result" );
+    my $displayname = $user->displayname;
+    is( $displayname, $name, 'Display name' );
+
+}
 
 done_testing;

diff --git a/t/lib/LDAPTest.pm b/t/lib/LDAPTest.pm
index e1e73c1..251881b 100644 (file)
--- a/t/lib/LDAPTest.pm
+++ b/t/lib/LDAPTest.pm
@@ -1,26 +1,54 @@
 # local test ldap server
 
 package LDAPTest;
+use strict;
+use warnings;
 
 use Net::LDAP::Server::Test;
 use Net::LDAP::Entry;
+use Net::LDAP;
 
 sub server_port {10636}
 sub server_host { 'ldap://127.0.0.1:' . server_port() }
 
 sub spawn_server {
-    my @mydata;
-    my $entry = Net::LDAP::Entry->new;
-    $entry->dn('ou=foobar');
-    $entry->add(
-        dn          => 'ou=foobar',
-        uid         => 'somebody',
-        displayName => 'Some Body',
-        cn          => [qw(value1 value2)]
-    );
-    push @mydata, $entry;
-
-    return Net::LDAP::Server::Test->new( server_port(), data => \@mydata );
+    my $server = Net::LDAP::Server::Test->new( server_port(), auto_schema => 1, @_ );
+
+    my $ldap = Net::LDAP->new(server_host()) or die "Can't connect: $@";
+    my $msg = $ldap->bind;
+    die "Can't bind: " . $msg->error if $msg->is_error;
+
+    for my $user (
+        {
+            uid         => 'somebody',
+            displayName => 'Some Body',
+            cn          => [qw(value1 value2)]
+        },
+        {
+            uid         => 'some*',
+            displayName => 'Some Star',
+            cn          => [qw(value1 value2)]
+        },
+        {
+            uid         => 'sunnO)))',
+            displayName => 'Sunn O)))',
+            cn          => [qw(value1 value2)]
+        }
+    ) {
+        my $msg = $ldap->add("uid=$user->{uid},ou=foobar", attrs => [
+            objectClass => 'person',
+            ou => 'foobar',
+            %{$user},
+        ]);
+        die "Can't bind: " . $msg->error if $msg->is_error;
+    };
+    return bless { server => $server, client => $ldap }, 'ServerWrapper';
+}
+
+sub ServerWrapper::stop {
+    my ($self) = @_;
+    $self->{client}->unbind;
+    $self->{server}->stop;
 }
 
 1;