git.sur5r.net Git - openldap/blob - servers/slapd/back-perl/SampleLDAP.pm

   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-2007 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  /path/to/this/file
  22 #       perlModule      SampleLDAP
  23 #
  24 # Note that "perlModulePath" is the directory path in which the perl module can be found
  25 #      not the path to the file. Please also see slapd-perl(5)
  26
  27 package SampleLDAP;
  28
  29 use POSIX;
  30
  31 sub new
  32 {
  33         my $class = shift;
  34
  35         my $this = {};
  36         bless $this, $class;
  37         print STDERR "Here in new\n";
  38         print STDERR "Posix Var " . BUFSIZ . " and " . FILENAME_MAX . "\n";
  39         return $this;
  40 }
  41
  42 sub init
  43 {
  44         return 0;
  45 }
  46
  47 sub search
  48 {
  49         my $this = shift;
  50         my($base, $scope, $deref, $sizeLim, $timeLim, $filterStr, $attrOnly, @attrs ) = @_;
  51         print STDERR "====$filterStr====\n";
  52         $filterStr =~ s/\(|\)//g;
  53         $filterStr =~ s/=/: /;
  54
  55         my @match_dn = ();
  56         foreach my $dn ( keys %$this ) {
  57                 if ( $this->{ $dn } =~ /$filterStr/im ) {
  58                         push @match_dn, $dn;
  59                         last if ( scalar @match_dn == $sizeLim );
  60
  61                 }
  62         }
  63
  64         my @match_entries = ();
  65
  66         foreach my $dn ( @match_dn )  {
  67                 push @match_entries, $this->{ $dn };
  68         }
  69
  70         return ( 0 , @match_entries );
  71
  72 }
  73
  74 sub compare
  75 {
  76         my $this = shift;
  77         my ( $dn, $avaStr ) = @_;
  78         my $rc = 5; # LDAP_COMPARE_FALSE
  79
  80         $avaStr =~ s/=/: /;
  81
  82         if ( $this->{ $dn } =~ /$avaStr/im ) {
  83                 $rc = 6; # LDAP_COMPARE_TRUE
  84         }
  85
  86         return $rc;
  87 }
  88
  89 sub modify
  90 {
  91         my $this = shift;
  92
  93         my ( $dn, @list ) = @_;
  94
  95         while ( @list > 0 ) {
  96                 my $action = shift @list;
  97                 my $key    = shift @list;
  98                 my $value  = shift @list;
  99
 100                 if( $action eq "ADD" ) {
 101                         $this->{ $dn } .= "$key: $value\n";
 102
 103                 }
 104                 elsif( $action eq "DELETE" ) {
 105                         $this->{ $dn } =~ s/^$key:\s*$value\n//mi ;
 106
 107                 }
 108                 elsif( $action eq "REPLACE" ) {
 109                         $this->{ $dn } =~ s/$key: .*$/$key: $value/im ;
 110                 }
 111         }
 112
 113         return 0;
 114 }
 115
 116 sub add
 117 {
 118         my $this = shift;
 119
 120         my ( $entryStr ) = @_;
 121
 122         my ( $dn ) = ( $entryStr =~ /dn:\s(.*)$/m );
 123
 124         #
 125         # This needs to be here until a normalized dn is
 126         # passed to this routine.
 127         #
 128         $dn = uc( $dn );
 129         $dn =~ s/\s*//g;
 130
 131
 132         $this->{$dn} = $entryStr;
 133
 134         return 0;
 135 }
 136
 137 sub modrdn
 138 {
 139         my $this = shift;
 140
 141         my ( $dn, $newdn, $delFlag ) = @_;
 142
 143         $this->{ $newdn } = $this->{ $dn };
 144
 145         if( $delFlag ) {
 146                 delete $this->{ $dn };
 147         }
 148         return 0;
 149
 150 }
 151
 152 sub delete
 153 {
 154         my $this = shift;
 155
 156         my ( $dn ) = @_;
 157
 158         print STDERR "XXXXXX $dn XXXXXXX\n";
 159         delete $this->{$dn};
 160 }
 161
 162 sub config
 163 {
 164         my $this = shift;
 165
 166         my ( @args ) = @_;
 167         local $, = " - ";
 168         print STDERR @args;
 169         print STDERR "\n";
 170         return 0;
 171 }
 172
 173 1;