# This is a sample Perl module for the OpenLDAP server slapd.
# $OpenLDAP: pkg/ldap/servers/slapd/back-perl/SampleLDAP.pm,v 1.8.2.3 2007/01/02 21:44:06 kurt Exp $
## This work is part of OpenLDAP Software .
##
## Copyright 1998-2007 The OpenLDAP Foundation.
## Portions Copyright 1999 John C. Quillan.
## All rights reserved.
##
## Redistribution and use in source and binary forms, with or without
## modification, are permitted only as authorized by the OpenLDAP
## Public License.
##
## A copy of this license is available in the file LICENSE in the
## top-level directory of the distribution or, alternatively, at
## .
#
# Usage: Add something like this to slapd.conf:
#
# database perl
# suffix "o=AnyOrg,c=US"
# perlModulePath /path/to/this/file
# perlModule SampleLDAP
package SampleLDAP;
use POSIX;
sub new
{
my $class = shift;
my $this = {};
bless $this, $class;
print STDERR "Here in new\n";
print STDERR "Posix Var " . BUFSIZ . " and " . FILENAME_MAX . "\n";
return $this;
}
sub init
{
return 0;
}
sub search
{
my $this = shift;
my($base, $scope, $deref, $sizeLim, $timeLim, $filterStr, $attrOnly, @attrs ) = @_;
print STDERR "====$filterStr====\n";
$filterStr =~ s/\(|\)//g;
$filterStr =~ s/=/: /;
my @match_dn = ();
foreach my $dn ( keys %$this ) {
if ( $this->{ $dn } =~ /$filterStr/im ) {
push @match_dn, $dn;
last if ( scalar @match_dn == $sizeLim );
}
}
my @match_entries = ();
foreach my $dn ( @match_dn ) {
push @match_entries, $this->{ $dn };
}
return ( 0 , @match_entries );
}
sub compare
{
my $this = shift;
my ( $dn, $avaStr ) = @_;
my $rc = 5; # LDAP_COMPARE_FALSE
$avaStr =~ s/=/: /;
if ( $this->{ $dn } =~ /$avaStr/im ) {
$rc = 6; # LDAP_COMPARE_TRUE
}
return $rc;
}
sub modify
{
my $this = shift;
my ( $dn, @list ) = @_;
while ( @list > 0 ) {
my $action = shift @list;
my $key = shift @list;
my $value = shift @list;
if( $action eq "ADD" ) {
$this->{ $dn } .= "$key: $value\n";
}
elsif( $action eq "DELETE" ) {
$this->{ $dn } =~ s/^$key:\s*$value\n//mi ;
}
elsif( $action eq "REPLACE" ) {
$this->{ $dn } =~ s/$key: .*$/$key: $value/im ;
}
}
return 0;
}
sub add
{
my $this = shift;
my ( $entryStr ) = @_;
my ( $dn ) = ( $entryStr =~ /dn:\s(.*)$/m );
#
# This needs to be here until a normalized dn is
# passed to this routine.
#
$dn = uc( $dn );
$dn =~ s/\s*//g;
$this->{$dn} = $entryStr;
return 0;
}
sub modrdn
{
my $this = shift;
my ( $dn, $newdn, $delFlag ) = @_;
$this->{ $newdn } = $this->{ $dn };
if( $delFlag ) {
delete $this->{ $dn };
}
return 0;
}
sub delete
{
my $this = shift;
my ( $dn ) = @_;
print STDERR "XXXXXX $dn XXXXXXX\n";
delete $this->{$dn};
}
sub config
{
my $this = shift;
my ( @args ) = @_;
local $, = " - ";
print STDERR @args;
print STDERR "\n";
return 0;
}
1;