xref: /netbsd-src/external/bsd/openldap/dist/servers/slapd/back-perl/SampleLDAP.pm (revision a5847cc334d9a7029f6352b847e9e8d71a0f9e0c)
1# This is a sample Perl module for the OpenLDAP server slapd.
2# OpenLDAP: pkg/ldap/servers/slapd/back-perl/SampleLDAP.pm,v 1.10.2.5 2010/04/13 20:23:36 kurt Exp
3## This work is part of OpenLDAP Software <http://www.openldap.org/>.
4##
5## Copyright 1998-2010 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
26package SampleLDAP;
27use strict;
28use warnings;
29use POSIX;
30
31$SampleLDAP::VERSION = '1.01';
32
33sub new {
34    my $class = shift;
35
36    my $this = {};
37    bless $this, $class;
38    print {*STDERR} "Here in new\n";
39    print {*STDERR} 'Posix Var ' . BUFSIZ . ' and ' . FILENAME_MAX . "\n";
40    return $this;
41}
42
43sub init {
44    return 0;
45}
46
47sub search {
48    my $this = shift;
49    my ( $base, $scope, $deref, $sizeLim, $timeLim, $filterStr, $attrOnly,
50        @attrs )
51      = @_;
52    print {*STDERR}, "====$filterStr====\n";
53    $filterStr =~ s/\(|\)//gm;
54    $filterStr =~ s/=/: /m;
55
56    my @match_dn = ();
57    for my $dn ( keys %{$this} ) {
58        if ( $this->{$dn} =~ /$filterStr/imx ) {
59            push @match_dn, $dn;
60            last if ( scalar @match_dn == $sizeLim );
61
62        }
63    }
64
65    my @match_entries = ();
66
67    for my $dn (@match_dn) {
68        push @match_entries, $this->{$dn};
69    }
70
71    return ( 0, @match_entries );
72
73}
74
75sub compare {
76    my $this = shift;
77    my ( $dn, $avaStr ) = @_;
78    my $rc = 5;    # LDAP_COMPARE_FALSE
79
80    $avaStr =~ s/=/: /m;
81
82    if ( $this->{$dn} =~ /$avaStr/im ) {
83        $rc = 6;    # LDAP_COMPARE_TRUE
84    }
85
86    return $rc;
87}
88
89sub modify {
90    my $this = shift;
91
92    my ( $dn, @list ) = @_;
93
94    while ( @list > 0 ) {
95        my $action = shift @list;
96        my $key    = shift @list;
97        my $value  = shift @list;
98
99        if ( $action eq 'ADD' ) {
100            $this->{$dn} .= "$key: $value\n";
101
102        }
103        elsif ( $action eq 'DELETE' ) {
104            $this->{$dn} =~ s/^$key:\s*$value\n//im;
105
106        }
107        elsif ( $action eq 'REPLACE' ) {
108            $this->{$dn} =~ s/$key: .*$/$key: $value/im;
109        }
110    }
111
112    return 0;
113}
114
115sub add {
116    my $this = shift;
117
118    my ($entryStr) = @_;
119
120    my ($dn) = ( $entryStr =~ /dn:\s(.*)$/m );
121
122    #
123    # This needs to be here until a normalized dn is
124    # passed to this routine.
125    #
126    $dn = uc $dn;
127    $dn =~ s/\s*//gm;
128
129    $this->{$dn} = $entryStr;
130
131    return 0;
132}
133
134sub modrdn {
135    my $this = shift;
136
137    my ( $dn, $newdn, $delFlag ) = @_;
138
139    $this->{$newdn} = $this->{$dn};
140
141    if ($delFlag) {
142        delete $this->{$dn};
143    }
144    return 0;
145
146}
147
148sub delete {
149    my $this = shift;
150
151    my ($dn) = @_;
152
153    print {*STDERR} "XXXXXX $dn XXXXXXX\n";
154    delete $this->{$dn};
155    return 0;
156}
157
158sub config {
159    my $this = shift;
160
161    my (@args) = @_;
162    local $, = ' - ';
163    print {*STDERR} @args;
164    print {*STDERR} "\n";
165    return 0;
166}
167
1681;
169