1 # This is a sample Perl module for the OpenLDAP server slapd.
3 ## This work is part of OpenLDAP Software <http://www.openldap.org/>.
5 ## Copyright 1998-2013 The OpenLDAP Foundation.
6 ## Portions Copyright 1999 John C. Quillan.
7 ## All rights reserved.
9 ## Redistribution and use in source and binary forms, with or without
10 ## modification, are permitted only as authorized by the OpenLDAP
13 ## A copy of this license is available in the file LICENSE in the
14 ## top-level directory of the distribution or, alternatively, at
15 ## <http://www.OpenLDAP.org/license.html>.
17 # Usage: Add something like this to slapd.conf:
20 # suffix "o=AnyOrg,c=US"
21 # perlModulePath /directory/containing/this/module
22 # perlModule SampleLDAP
24 # See the slapd-perl(5) manual page for details.
26 # This demo module keeps an in-memory hash {"DN" => "LDIF entry", ...}
27 # built in sub add{} & co. The data is lost when slapd shuts down.
34 $SampleLDAP::VERSION = '1.01';
41 print {*STDERR} "Here in new\n";
42 print {*STDERR} 'Posix Var ' . BUFSIZ . ' and ' . FILENAME_MAX . "\n";
52 my ( $base, $scope, $deref, $sizeLim, $timeLim, $filterStr, $attrOnly,
55 print {*STDERR} "====$filterStr====\n";
56 $filterStr =~ s/\(|\)//gm;
57 $filterStr =~ s/=/: /m;
60 for my $dn ( keys %{$this} ) {
61 if ( $this->{$dn} =~ /$filterStr/imx ) {
63 last if ( scalar @match_dn == $sizeLim );
68 my @match_entries = ();
70 for my $dn (@match_dn) {
71 push @match_entries, $this->{$dn};
74 return ( 0, @match_entries );
80 my ( $dn, $avaStr ) = @_;
81 my $rc = 5; # LDAP_COMPARE_FALSE
85 if ( $this->{$dn} =~ /$avaStr/im ) {
86 $rc = 6; # LDAP_COMPARE_TRUE
95 my ( $dn, @list ) = @_;
98 my $action = shift @list;
99 my $key = shift @list;
100 my $value = shift @list;
102 if ( $action eq 'ADD' ) {
103 $this->{$dn} .= "$key: $value\n";
106 elsif ( $action eq 'DELETE' ) {
107 $this->{$dn} =~ s/^$key:\s*$value\n//im;
110 elsif ( $action eq 'REPLACE' ) {
111 $this->{$dn} =~ s/$key: .*$/$key: $value/im;
123 my ($dn) = ( $entryStr =~ /dn:\s(.*)$/m );
126 # This needs to be here until a normalized dn is
127 # passed to this routine.
132 $this->{$dn} = $entryStr;
140 my ( $dn, $newdn, $delFlag ) = @_;
142 $this->{$newdn} = $this->{$dn};
156 print {*STDERR} "XXXXXX $dn XXXXXXX\n";
166 print {*STDERR} @args;
167 print {*STDERR} "\n";