diff options
author | Daniel Baumann <daniel.baumann@progress-linux.org> | 2024-04-15 17:54:12 +0000 |
---|---|---|
committer | Daniel Baumann <daniel.baumann@progress-linux.org> | 2024-04-15 17:54:12 +0000 |
commit | b527294153be3b79563c82c66102adc0004736c0 (patch) | |
tree | 9b423a224848441885190b5ea7cf0feb23510c9d /servers/slapd/back-perl/SampleLDAP.pm | |
parent | Initial commit. (diff) | |
download | openldap-b527294153be3b79563c82c66102adc0004736c0.tar.xz openldap-b527294153be3b79563c82c66102adc0004736c0.zip |
Adding upstream version 2.6.7+dfsg.upstream/2.6.7+dfsg
Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>
Diffstat (limited to 'servers/slapd/back-perl/SampleLDAP.pm')
-rw-r--r-- | servers/slapd/back-perl/SampleLDAP.pm | 171 |
1 files changed, 171 insertions, 0 deletions
diff --git a/servers/slapd/back-perl/SampleLDAP.pm b/servers/slapd/back-perl/SampleLDAP.pm new file mode 100644 index 0000000..91e9ae3 --- /dev/null +++ b/servers/slapd/back-perl/SampleLDAP.pm @@ -0,0 +1,171 @@ +# This is a sample Perl module for the OpenLDAP server slapd. +# $OpenLDAP$ +## This work is part of OpenLDAP Software <http://www.openldap.org/>. +## +## Copyright 1998-2022 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 +## <http://www.OpenLDAP.org/license.html>. + +# Usage: Add something like this to slapd.conf: +# +# database perl +# suffix "o=AnyOrg,c=US" +# perlModulePath /directory/containing/this/module +# perlModule SampleLDAP +# +# See the slapd-perl(5) manual page for details. +# +# This demo module keeps an in-memory hash {"DN" => "LDIF entry", ...} +# built in sub add{} & co. The data is lost when slapd shuts down. + +package SampleLDAP; +use strict; +use warnings; +use POSIX; + +$SampleLDAP::VERSION = '1.01'; + +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/\(|\)//gm; + $filterStr =~ s/=/: /m; + + my @match_dn = (); + for my $dn ( keys %{$this} ) { + if ( $this->{$dn} =~ /$filterStr/imx ) { + push @match_dn, $dn; + last if ( scalar @match_dn == $sizeLim ); + + } + } + + my @match_entries = (); + + for 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/=/: /m; + + 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//im; + + } + 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*//gm; + + $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}; + return 0; +} + +sub config { + my $this = shift; + + my (@args) = @_; + local $, = ' - '; + print {*STDERR} @args; + print {*STDERR} "\n"; + return 0; +} + +1; |