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