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