1# This is a sample Perl module for the OpenLDAP server slapd.
2# $OpenLDAP$
3## This work is part of OpenLDAP Software <http://www.openldap.org/>.
4##
5## Copyright 1998-2011 The OpenLDAP Foundation.
6## Portions Copyright 1999 John C. Quillan.
7## All rights reserved.
8##
9## Redistribution and use in source and binary forms, with or without
10## modification, are permitted only as authorized by the OpenLDAP
11## Public License.
12##
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>.
16
17# Usage: Add something like this to slapd.conf:
18#
19#	database	perl
20#	suffix		"o=AnyOrg,c=US"
21#	perlModulePath	/directory/containing/this/module
22#	perlModule	SampleLDAP
23#
24# See the slapd-perl(5) manual page for details.
25#
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.
28
29package SampleLDAP;
30use strict;
31use warnings;
32use POSIX;
33
34$SampleLDAP::VERSION = '1.01';
35
36sub new {
37    my $class = shift;
38
39    my $this = {};
40    bless $this, $class;
41    print {*STDERR} "Here in new\n";
42    print {*STDERR} 'Posix Var ' . BUFSIZ . ' and ' . FILENAME_MAX . "\n";
43    return $this;
44}
45
46sub init {
47    return 0;
48}
49
50sub search {
51    my $this = shift;
52    my ( $base, $scope, $deref, $sizeLim, $timeLim, $filterStr, $attrOnly,
53        @attrs )
54      = @_;
55    print {*STDERR} "====$filterStr====\n";
56    $filterStr =~ s/\(|\)//gm;
57    $filterStr =~ s/=/: /m;
58
59    my @match_dn = ();
60    for my $dn ( keys %{$this} ) {
61        if ( $this->{$dn} =~ /$filterStr/imx ) {
62            push @match_dn, $dn;
63            last if ( scalar @match_dn == $sizeLim );
64
65        }
66    }
67
68    my @match_entries = ();
69
70    for my $dn (@match_dn) {
71        push @match_entries, $this->{$dn};
72    }
73
74    return ( 0, @match_entries );
75
76}
77
78sub compare {
79    my $this = shift;
80    my ( $dn, $avaStr ) = @_;
81    my $rc = 5;    # LDAP_COMPARE_FALSE
82
83    $avaStr =~ s/=/: /m;
84
85    if ( $this->{$dn} =~ /$avaStr/im ) {
86        $rc = 6;    # LDAP_COMPARE_TRUE
87    }
88
89    return $rc;
90}
91
92sub modify {
93    my $this = shift;
94
95    my ( $dn, @list ) = @_;
96
97    while ( @list > 0 ) {
98        my $action = shift @list;
99        my $key    = shift @list;
100        my $value  = shift @list;
101
102        if ( $action eq 'ADD' ) {
103            $this->{$dn} .= "$key: $value\n";
104
105        }
106        elsif ( $action eq 'DELETE' ) {
107            $this->{$dn} =~ s/^$key:\s*$value\n//im;
108
109        }
110        elsif ( $action eq 'REPLACE' ) {
111            $this->{$dn} =~ s/$key: .*$/$key: $value/im;
112        }
113    }
114
115    return 0;
116}
117
118sub add {
119    my $this = shift;
120
121    my ($entryStr) = @_;
122
123    my ($dn) = ( $entryStr =~ /dn:\s(.*)$/m );
124
125    #
126    # This needs to be here until a normalized dn is
127    # passed to this routine.
128    #
129    $dn = uc $dn;
130    $dn =~ s/\s*//gm;
131
132    $this->{$dn} = $entryStr;
133
134    return 0;
135}
136
137sub modrdn {
138    my $this = shift;
139
140    my ( $dn, $newdn, $delFlag ) = @_;
141
142    $this->{$newdn} = $this->{$dn};
143
144    if ($delFlag) {
145        delete $this->{$dn};
146    }
147    return 0;
148
149}
150
151sub delete {
152    my $this = shift;
153
154    my ($dn) = @_;
155
156    print {*STDERR} "XXXXXX $dn XXXXXXX\n";
157    delete $this->{$dn};
158    return 0;
159}
160
161sub config {
162    my $this = shift;
163
164    my (@args) = @_;
165    local $, = ' - ';
166    print {*STDERR} @args;
167    print {*STDERR} "\n";
168    return 0;
169}
170
1711;
172