Subject: | Net-LDAP-SimpleServer |
I am using Net::LDAP::SimpleServer as a back-end server for testing of an LDAP client, and one of the features of the latter that I need to test is a fairly common one: authenticating users by trying to bind using their DN/password. That is not currently supported by this module but can be quite easily added and is I think a useful feature to have here, so this is an enhancement request to add it, with a patch for that.
This patch enables binding using the DN/password of any entry in the data store that has objectClass 'person' and a userPassword attribute that is either plain text or an MD5 hash (in the standard "MD5:hash-value" format) in addition to allowing binding with the root_dn/root_pw.
Additionally, the patch adds a new option to control how userPassword attributes are returned in search replies:
'user_pwds' - whether user passwords can be read in search replies ('readable', 'not-readable' or 'hashed-md5'). 'hashed-md5' causes plain-text passwords in the data file to be returned as MD5 hashes ("MD5:hash-value") in the search results (not needed if the passwords in the data file are already MD5 hashes).
Note that since, as per its documentation, this module is not intended as a "real" LDAP server, this patch is not trying to be secure with user passwords in any way, but rather to emulate what real LDAP servers do in binds and in searches for user entries.
The patch is attached - note that it requires the patch from issue 101365 (https://rt.cpan.org/Public/Bug/Display.html?id=101365) to be applied first.
To apply the patch during installation, after unpacking Net-LDAP-SimpleServer-0.0.17.tar.gz, cd into the Net-LDAP-SimpleServer-0.0.17 directory and type:
- patch -p1 <path-to-it>/add-srch-scope.patch (see issue 101365)
- patch -p1 <path-to-it>/add-user-pwds.patch
Then continue the install as normal.
Subject: | add-user-pwds.patch |
diff -Naur Net-LDAP-SimpleServer-0.0.17-2/lib/Net/LDAP/SimpleServer/ProtocolHandler.pm Net-LDAP-SimpleServer-0.0.17/lib/Net/LDAP/SimpleServer/ProtocolHandler.pm
--- Net-LDAP-SimpleServer-0.0.17-2/lib/Net/LDAP/SimpleServer/ProtocolHandler.pm 2015-01-06 18:07:15.196343689 -0800
+++ Net-LDAP-SimpleServer-0.0.17/lib/Net/LDAP/SimpleServer/ProtocolHandler.pm 2015-01-06 18:31:07.110218401 -0800
@@ -9,7 +9,7 @@
use Net::LDAP::Server;
use base 'Net::LDAP::Server';
-use fields qw(store root_dn root_pw allow_anon);
+use fields qw(store root_dn root_pw allow_anon user_pwds);
use Carp;
use Net::LDAP::LDIF;
@@ -56,7 +56,9 @@
$self->{root_dn} = $canon_dn;
$self->{root_pw} = $params->{root_pw};
$self->{allow_anon} = $params->{allow_anon};
+ $self->{user_pwds} = $params->{user_pwds};
chomp( $self->{root_pw} );
+ chomp( $self->{user_pwds} );
return $self;
}
@@ -96,17 +98,47 @@
unless my $binddn = canonical_dn( $request->{name} );
#print STDERR qq#binddn is ok ($request->{name}) => ($binddn)\n#;
- #print STDERR qq#handler dn is $self->{root_dn}\n#;
- return _make_result(LDAP_INVALID_CREDENTIALS)
- unless uc($binddn) eq uc( $self->{root_dn} );
-
- #print STDERR qq{binddn is good\n};
my $bindpw = $request->{authentication}->{simple};
chomp($bindpw);
- #print STDERR qq|comparing ($bindpw) eq ($self->{root_pw})\n|;
- return _make_result(LDAP_INVALID_CREDENTIALS)
- unless $bindpw eq $self->{root_pw};
+ if (uc($binddn) eq uc( $self->{root_dn} )) {
+ #print STDERR qq#handler dn is $self->{root_dn}\n#;
+ #print STDERR qq|comparing pwd ($bindpw) eq ($self->{root_pw})\n|;
+ return _make_result(LDAP_INVALID_CREDENTIALS)
+ unless $bindpw eq $self->{root_pw};
+ } else {
+ #print STDERR qq#looking for users with passwords\n#;
+ my $list = $self->{store}->list;
+ my $filter = Net::LDAP::Filter->new("(&(objectClass=person)(userPassword=*))");
+ my $users = _match( $filter, $list );
+ my $authed = 0;
+ my $user = _find($binddn, $users);
+ if ($user) {
+ #print STDERR qq{found user entry for binddn $binddn\n};
+ my $pwds = _get_attr($user, 'userPassword');
+ #print STDERR qq|comparing pwd ($bindpw) with (| . join(", ", @{$pwds}) . ")\n";
+ $authed = 1 if (grep { $bindpw eq $_ } @{$pwds});
+ if (!$authed) {
+ foreach my $pwd (@{$pwds}) {
+ if (substr($pwd, 0, 4) eq "MD5:") {
+ use Digest::MD5;
+ use MIME::Base64;
+ my $ctx = Digest::MD5->new;
+ $ctx->add($bindpw);
+ my $hashpw = encode_base64($ctx->digest,'');
+ #print STDERR qq|comparing MD5 hash ($hashpw) with (| . substr($pwd, 4) . ")\n";
+ if ($hashpw eq substr($pwd, 4)) {
+ $authed = 1;
+ last;
+ }
+ }
+ }
+ }
+ }
+ if (!$authed) {
+ return _make_result(LDAP_INVALID_CREDENTIALS);
+ }
+ }
return $ok;
}
@@ -118,6 +150,14 @@
return [ grep { $f->match($_) } @{$elems} ];
}
+sub _find {
+ my ( $objectName, $elems ) = @_;
+
+ my $uc_name = uc($objectName);
+ my @objs = grep { uc($_->{asn}->{objectName}) eq $uc_name } @{$elems};
+ return ($#objs >= 0) ? $objs[0] : 0;
+}
+
sub _in_scope {
my ($dn, $basedn, $scope) = @_;
@@ -144,6 +184,20 @@
return _in_scope(uc($elem->{asn}->{'objectName'}), $uc_basedn, $scope);
}
+sub _get_attr {
+ my ( $elem, $type ) = @_;
+
+ my $vals = 0;
+ my $attrs = $elem->{asn}->{'attributes'};
+ for (my $j = 0; $j <= $#{$attrs}; $j++) {
+ if (uc($$attrs[$j]->{type}) eq uc($type)) {
+ $vals = $$attrs[$j]->{vals};
+ last;
+ }
+ }
+ return $vals;
+}
+
sub search {
my ( $self, $request ) = @_;
@@ -152,7 +206,8 @@
my @scopes = qw(baseObj oneLevel subTree);
my $basedn = $request->{baseObject};
- my $scope = $scopes[ (defined $request->{scope} && $request->{scope} <= 2) ? $request->{scope} : 2 ];
+ my $scope = $scopes[ (defined $request->{scope} && $request->{scope} <= 2)
+ ? $request->{scope} : 2 ];
#print STDERR '=' x 50 . "\n";
#print STDERR Dumper($request);
@@ -169,6 +224,34 @@
my $res = _match( $request->{filter}, $list );
+ if ($self->{user_pwds} ne 'readable') {
+ for (my $i = 0; $i <= $#{$res}; $i++) {
+ my $attrs = $$res[$i]->{asn}->{'attributes'};
+ if ($self->{user_pwds} eq 'hashed-md5') {
+ for (my $j = 0; $j <= $#{$attrs}; $j++) {
+ if ($$attrs[$j]->{type} eq 'userPassword') {
+ use Digest::MD5;
+ use MIME::Base64;
+ for (my $k = 0; $k <= $#{$$attrs[$j]->{vals}}; $k++) {
+ my $ctx = Digest::MD5->new;
+ $ctx->add($$attrs[$j]->{vals}[$k]);
+ $$attrs[$j]->{vals}[$k] = "{MD5}" . encode_base64($ctx->digest,'');
+ }
+ }
+ }
+ } else {
+ # Prune out any userPassword attributes
+ my @pruned_attrs = ();
+ for (my $j = 0; $j <= $#{$attrs}; $j++) {
+ push(@pruned_attrs, $$attrs[$j]) if ($$attrs[$j]->{type} ne 'userPassword');
+ }
+ if ($#pruned_attrs < $#{$attrs}) {
+ $$res[$i]->{asn}->{'attributes'} = [ @pruned_attrs ];
+ }
+ }
+ }
+ }
+
#print STDERR Dumper($res);
return ( _make_result(LDAP_SUCCESS), @{$res} );
@@ -218,7 +301,11 @@
=head2 bind( REQUEST )
-Handles a bind REQUEST from the LDAP client.
+Handles a bind REQUEST from the LDAP client. Allows binding with the root_dn
+/ root_pw, or with the DN of a user entry in the data store that has
+objectClass 'person'. In the latter case the bind password must match a
+'userPassword' attribute of that entry (case-sensitive) with plain text and
+MD5 ("MD5:hash-value") userPassword attributes supported.
=head2 unbind()
diff -Naur Net-LDAP-SimpleServer-0.0.17-2/lib/Net/LDAP/SimpleServer.pm Net-LDAP-SimpleServer-0.0.17/lib/Net/LDAP/SimpleServer.pm
--- Net-LDAP-SimpleServer-0.0.17-2/lib/Net/LDAP/SimpleServer.pm 2015-01-06 18:07:15.195343685 -0800
+++ Net-LDAP-SimpleServer-0.0.17/lib/Net/LDAP/SimpleServer.pm 2015-01-06 18:31:07.110218401 -0800
@@ -41,7 +41,7 @@
my $DEFAULT_LOG_FILE = File::Spec->catfile( $BASEDIR, 'server.log' );
my @LDAP_PRIVATE_OPTIONS = ( 'store', 'input', 'output' );
-my @LDAP_PUBLIC_OPTIONS = ( 'data_file', 'root_dn', 'root_pw', 'allow_anon' );
+my @LDAP_PUBLIC_OPTIONS = ( 'data_file', 'root_dn', 'root_pw', 'allow_anon', 'user_pwds' );
make_path($BASEDIR);
@@ -76,6 +76,7 @@
$v->{allow_anon} = 1;
$v->{root_dn} = 'cn=root';
$v->{data_file} = $DEFAULT_DATA_FILE if -r $DEFAULT_DATA_FILE;
+ $v->{user_pwds} = 'not-readable';
#use Data::Dumper; print STDERR Dumper($v);
return $v;
@@ -227,6 +228,14 @@
allow_anon - whether to allow for anonymous binds
+=item *
+
+user_pwds - whether user passwords can be read in search replies
+('readable', 'not-readable' or 'hashed-md5'). 'hashed-md5' causes plain-text
+passwords in the data file to be returned as MD5 hashes ("MD5:hash-value")
+in the search results (not needed if the passwords in the data file are
+already MD5 hashes).
+
=back
=head2 default_values()