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