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