summaryrefslogtreecommitdiffstats
path: root/servers/slapd/back-perl
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--servers/slapd/back-perl/Makefile.in46
-rw-r--r--servers/slapd/back-perl/README24
-rw-r--r--servers/slapd/back-perl/SampleLDAP.pm171
-rw-r--r--servers/slapd/back-perl/add.c62
-rw-r--r--servers/slapd/back-perl/asperl_undefs.h38
-rw-r--r--servers/slapd/back-perl/bind.c80
-rw-r--r--servers/slapd/back-perl/close.c59
-rw-r--r--servers/slapd/back-perl/compare.c80
-rw-r--r--servers/slapd/back-perl/config.c254
-rw-r--r--servers/slapd/back-perl/delete.c59
-rw-r--r--servers/slapd/back-perl/init.c177
-rw-r--r--servers/slapd/back-perl/modify.c97
-rw-r--r--servers/slapd/back-perl/modrdn.c63
-rw-r--r--servers/slapd/back-perl/perl_back.h82
-rw-r--r--servers/slapd/back-perl/proto-perl.h43
-rw-r--r--servers/slapd/back-perl/search.c122
16 files changed, 1457 insertions, 0 deletions
diff --git a/servers/slapd/back-perl/Makefile.in b/servers/slapd/back-perl/Makefile.in
new file mode 100644
index 0000000..2e609ee
--- /dev/null
+++ b/servers/slapd/back-perl/Makefile.in
@@ -0,0 +1,46 @@
+# Makefile.in for back-perl
+# $OpenLDAP$
+## This work is part of OpenLDAP Software <http://www.openldap.org/>.
+##
+## Copyright 1998-2018 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>.
+
+SRCS = init.c search.c close.c config.c bind.c compare.c \
+ modify.c add.c modrdn.c delete.c
+OBJS = init.lo search.lo close.lo config.lo bind.lo compare.lo \
+ modify.lo add.lo modrdn.lo delete.lo
+
+LDAP_INCDIR= ../../../include
+LDAP_LIBDIR= ../../../libraries
+
+BUILD_OPT = "--enable-perl"
+BUILD_MOD = @BUILD_PERL@
+PERL_CPPFLAGS = @PERL_CPPFLAGS@
+
+mod_DEFS = -DSLAPD_IMPORT
+MOD_DEFS = $(@BUILD_PERL@_DEFS)
+MOD_LIBS = @MOD_PERL_LDFLAGS@
+
+shared_LDAP_LIBS = $(LDAP_LIBLDAP_R_LA) $(LDAP_LIBLBER_LA)
+NT_LINK_LIBS = -L.. -lslapd $(@BUILD_LIBS_DYNAMIC@_LDAP_LIBS)
+UNIX_LINK_LIBS = $(@BUILD_LIBS_DYNAMIC@_LDAP_LIBS)
+
+LIBBASE = back_perl
+
+XINCPATH = -I.. -I$(srcdir)/..
+XDEFS = $(PERL_CPPFLAGS) $(MODULES_CPPFLAGS)
+
+all-local-lib: ../.backend
+
+../.backend: lib$(LIBBASE).a
+ @touch $@
+
diff --git a/servers/slapd/back-perl/README b/servers/slapd/back-perl/README
new file mode 100644
index 0000000..0959b44
--- /dev/null
+++ b/servers/slapd/back-perl/README
@@ -0,0 +1,24 @@
+Differences from 2.0 Perl API:
+
+- Perl 5.6 is supported
+
+- backend methods return actual LDAP result codes, not
+ true/false; this gives the Perl module finer control
+ of the error returned to the client
+
+- a filterSearchResults configuration file directive was
+ added to tell the backend glue that the results returned
+ from the Perl module are candidates only
+
+- the "init" method is called after the backend has been
+ initialized - this lets you do some initialization after
+ *all* configuration file directives have been read
+
+- the interface for the search method is improved to
+ pass the scope, deferencing policy, size limit, etc.
+ See SampleLDAP.pm for details.
+
+These changes were sponsored by myinternet Limited.
+
+Luke Howard <lukeh@padl.com>
+
diff --git a/servers/slapd/back-perl/SampleLDAP.pm b/servers/slapd/back-perl/SampleLDAP.pm
new file mode 100644
index 0000000..f4c7906
--- /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-2018 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;
diff --git a/servers/slapd/back-perl/add.c b/servers/slapd/back-perl/add.c
new file mode 100644
index 0000000..401cdca
--- /dev/null
+++ b/servers/slapd/back-perl/add.c
@@ -0,0 +1,62 @@
+/* $OpenLDAP$ */
+/* This work is part of OpenLDAP Software <http://www.openldap.org/>.
+ *
+ * Copyright 1999-2018 The OpenLDAP Foundation.
+ * Portions Copyright 1999 John C. Quillan.
+ * Portions Copyright 2002 myinternet Limited.
+ * 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 file LICENSE in the
+ * top-level directory of the distribution or, alternatively, at
+ * <http://www.OpenLDAP.org/license.html>.
+ */
+
+#include "perl_back.h"
+
+int
+perl_back_add(
+ Operation *op,
+ SlapReply *rs )
+{
+ PerlBackend *perl_back = (PerlBackend *) op->o_bd->be_private;
+ int len;
+ int count;
+
+ PERL_SET_CONTEXT( PERL_INTERPRETER );
+ ldap_pvt_thread_mutex_lock( &perl_interpreter_mutex );
+ ldap_pvt_thread_mutex_lock( &entry2str_mutex );
+
+ {
+ dSP; ENTER; SAVETMPS;
+
+ PUSHMARK(sp);
+ XPUSHs( perl_back->pb_obj_ref );
+ XPUSHs(sv_2mortal(newSVpv( entry2str( op->ora_e, &len ), 0 )));
+
+ PUTBACK;
+
+ count = call_method("add", G_SCALAR);
+
+ SPAGAIN;
+
+ if (count != 1) {
+ croak("Big trouble in back_add\n");
+ }
+
+ rs->sr_err = POPi;
+
+ PUTBACK; FREETMPS; LEAVE;
+ }
+
+ ldap_pvt_thread_mutex_unlock( &entry2str_mutex );
+ ldap_pvt_thread_mutex_unlock( &perl_interpreter_mutex );
+
+ send_ldap_result( op, rs );
+
+ Debug( LDAP_DEBUG_ANY, "Perl ADD\n", 0, 0, 0 );
+ return( 0 );
+}
diff --git a/servers/slapd/back-perl/asperl_undefs.h b/servers/slapd/back-perl/asperl_undefs.h
new file mode 100644
index 0000000..95368ba
--- /dev/null
+++ b/servers/slapd/back-perl/asperl_undefs.h
@@ -0,0 +1,38 @@
+/* $OpenLDAP$ */
+/* This work is part of OpenLDAP Software <http://www.openldap.org/>.
+ *
+ * Copyright 1999-2018 The OpenLDAP Foundation.
+ * 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 file LICENSE in the
+ * top-level directory of the distribution or, alternatively, at
+ * <http://www.OpenLDAP.org/license.html>.
+ */
+
+/* This file is probably obsolete. If it is not, */
+/* #inclusion of it may have to be moved. See ITS#2513. */
+
+/* This file is necessary because both PERL headers */
+/* and OpenLDAP define a number of macros without */
+/* checking wether they're already defined */
+
+#ifndef ASPERL_UNDEFS_H
+#define ASPERL_UNDEFS_H
+
+/* ActiveState Win32 PERL port support */
+/* set in ldap/include/portable.h */
+# ifdef HAVE_WIN32_ASPERL
+/* The following macros are undefined to prevent */
+/* redefinition in PERL headers*/
+# undef gid_t
+# undef uid_t
+# undef mode_t
+# undef caddr_t
+# undef WIN32_LEAN_AND_MEAN
+# endif
+#endif
+
diff --git a/servers/slapd/back-perl/bind.c b/servers/slapd/back-perl/bind.c
new file mode 100644
index 0000000..86dff19
--- /dev/null
+++ b/servers/slapd/back-perl/bind.c
@@ -0,0 +1,80 @@
+/* $OpenLDAP$ */
+/* This work is part of OpenLDAP Software <http://www.openldap.org/>.
+ *
+ * Copyright 1999-2018 The OpenLDAP Foundation.
+ * Portions Copyright 1999 John C. Quillan.
+ * Portions Copyright 2002 myinternet Limited.
+ * 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 file LICENSE in the
+ * top-level directory of the distribution or, alternatively, at
+ * <http://www.OpenLDAP.org/license.html>.
+ */
+
+#include "perl_back.h"
+
+
+/**********************************************************
+ *
+ * Bind
+ *
+ **********************************************************/
+int
+perl_back_bind(
+ Operation *op,
+ SlapReply *rs )
+{
+ int count;
+
+ PerlBackend *perl_back = (PerlBackend *) op->o_bd->be_private;
+
+ /* allow rootdn as a means to auth without the need to actually
+ * contact the proxied DSA */
+ switch ( be_rootdn_bind( op, rs ) ) {
+ case SLAP_CB_CONTINUE:
+ break;
+
+ default:
+ return rs->sr_err;
+ }
+
+ PERL_SET_CONTEXT( PERL_INTERPRETER );
+ ldap_pvt_thread_mutex_lock( &perl_interpreter_mutex );
+
+ {
+ dSP; ENTER; SAVETMPS;
+
+ PUSHMARK(SP);
+ XPUSHs( perl_back->pb_obj_ref );
+ XPUSHs(sv_2mortal(newSVpv( op->o_req_dn.bv_val , op->o_req_dn.bv_len)));
+ XPUSHs(sv_2mortal(newSVpv( op->orb_cred.bv_val , op->orb_cred.bv_len)));
+ PUTBACK;
+
+ count = call_method("bind", G_SCALAR);
+
+ SPAGAIN;
+
+ if (count != 1) {
+ croak("Big trouble in back_bind\n");
+ }
+
+ rs->sr_err = POPi;
+
+
+ PUTBACK; FREETMPS; LEAVE;
+ }
+
+ ldap_pvt_thread_mutex_unlock( &perl_interpreter_mutex );
+
+ Debug( LDAP_DEBUG_ANY, "Perl BIND returned 0x%04x\n", rs->sr_err, 0, 0 );
+
+ /* frontend will send result on success (0) */
+ if( rs->sr_err != LDAP_SUCCESS )
+ send_ldap_result( op, rs );
+
+ return ( rs->sr_err );
+}
diff --git a/servers/slapd/back-perl/close.c b/servers/slapd/back-perl/close.c
new file mode 100644
index 0000000..90797ab
--- /dev/null
+++ b/servers/slapd/back-perl/close.c
@@ -0,0 +1,59 @@
+/* $OpenLDAP$ */
+/* This work is part of OpenLDAP Software <http://www.openldap.org/>.
+ *
+ * Copyright 1999-2018 The OpenLDAP Foundation.
+ * Portions Copyright 1999 John C. Quillan.
+ * Portions Copyright 2002 myinternet Limited.
+ * 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 file LICENSE in the
+ * top-level directory of the distribution or, alternatively, at
+ * <http://www.OpenLDAP.org/license.html>.
+ */
+
+#include "perl_back.h"
+#include "../config.h"
+/**********************************************************
+ *
+ * Close
+ *
+ **********************************************************/
+
+int
+perl_back_close(
+ BackendInfo *bd
+)
+{
+ perl_destruct(PERL_INTERPRETER);
+ perl_free(PERL_INTERPRETER);
+ PERL_INTERPRETER = NULL;
+#ifdef PERL_SYS_TERM
+ PERL_SYS_TERM();
+#endif
+
+ ldap_pvt_thread_mutex_destroy( &perl_interpreter_mutex );
+
+ return 0;
+}
+
+int
+perl_back_db_destroy(
+ BackendDB *be,
+ ConfigReply *cr
+)
+{
+ PerlBackend *pb = be->be_private;
+
+ ch_free( pb->pb_module_name );
+ ber_bvarray_free( pb->pb_module_path );
+ ber_bvarray_free( pb->pb_module_config );
+
+ free( be->be_private );
+ be->be_private = NULL;
+
+ return 0;
+}
diff --git a/servers/slapd/back-perl/compare.c b/servers/slapd/back-perl/compare.c
new file mode 100644
index 0000000..69b5657
--- /dev/null
+++ b/servers/slapd/back-perl/compare.c
@@ -0,0 +1,80 @@
+/* $OpenLDAP$ */
+/* This work is part of OpenLDAP Software <http://www.openldap.org/>.
+ *
+ * Copyright 1999-2018 The OpenLDAP Foundation.
+ * Portions Copyright 1999 John C. Quillan.
+ * Portions Copyright 2002 myinternet Limited.
+ * 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 file LICENSE in the
+ * top-level directory of the distribution or, alternatively, at
+ * <http://www.OpenLDAP.org/license.html>.
+ */
+
+#include "perl_back.h"
+#include "lutil.h"
+
+/**********************************************************
+ *
+ * Compare
+ *
+ **********************************************************/
+
+int
+perl_back_compare(
+ Operation *op,
+ SlapReply *rs )
+{
+ int count, avalen;
+ char *avastr;
+
+ PerlBackend *perl_back = (PerlBackend *)op->o_bd->be_private;
+
+ avalen = op->orc_ava->aa_desc->ad_cname.bv_len + 1 +
+ op->orc_ava->aa_value.bv_len;
+ avastr = ch_malloc( avalen + 1 );
+
+ lutil_strcopy( lutil_strcopy( lutil_strcopy( avastr,
+ op->orc_ava->aa_desc->ad_cname.bv_val ), "=" ),
+ op->orc_ava->aa_value.bv_val );
+
+ PERL_SET_CONTEXT( PERL_INTERPRETER );
+ ldap_pvt_thread_mutex_lock( &perl_interpreter_mutex );
+
+ {
+ dSP; ENTER; SAVETMPS;
+
+ PUSHMARK(sp);
+ XPUSHs( perl_back->pb_obj_ref );
+ XPUSHs(sv_2mortal(newSVpv( op->o_req_dn.bv_val , op->o_req_dn.bv_len)));
+ XPUSHs(sv_2mortal(newSVpv( avastr , avalen)));
+ PUTBACK;
+
+ count = call_method("compare", G_SCALAR);
+
+ SPAGAIN;
+
+ if (count != 1) {
+ croak("Big trouble in back_compare\n");
+ }
+
+ rs->sr_err = POPi;
+
+ PUTBACK; FREETMPS; LEAVE;
+ }
+
+ ldap_pvt_thread_mutex_unlock( &perl_interpreter_mutex );
+
+ ch_free( avastr );
+
+ send_ldap_result( op, rs );
+
+ Debug( LDAP_DEBUG_ANY, "Perl COMPARE\n", 0, 0, 0 );
+
+ return (0);
+}
+
diff --git a/servers/slapd/back-perl/config.c b/servers/slapd/back-perl/config.c
new file mode 100644
index 0000000..544e960
--- /dev/null
+++ b/servers/slapd/back-perl/config.c
@@ -0,0 +1,254 @@
+/* $OpenLDAP$ */
+/* This work is part of OpenLDAP Software <http://www.openldap.org/>.
+ *
+ * Copyright 1999-2018 The OpenLDAP Foundation.
+ * Portions Copyright 1999 John C. Quillan.
+ * Portions Copyright 2002 myinternet Limited.
+ * 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 file LICENSE in the
+ * top-level directory of the distribution or, alternatively, at
+ * <http://www.OpenLDAP.org/license.html>.
+ */
+
+#include "perl_back.h"
+#include "../config.h"
+
+static ConfigDriver perl_cf;
+
+enum {
+ PERL_MODULE = 1,
+ PERL_PATH,
+ PERL_CONFIG
+};
+
+static ConfigTable perlcfg[] = {
+ { "perlModule", "module", 2, 2, 0,
+ ARG_STRING|ARG_MAGIC|PERL_MODULE, perl_cf,
+ "( OLcfgDbAt:11.1 NAME 'olcPerlModule' "
+ "DESC 'Perl module name' "
+ "EQUALITY caseExactMatch "
+ "SYNTAX OMsDirectoryString SINGLE-VALUE )", NULL, NULL },
+ { "perlModulePath", "path", 2, 2, 0,
+ ARG_MAGIC|PERL_PATH, perl_cf,
+ "( OLcfgDbAt:11.2 NAME 'olcPerlModulePath' "
+ "DESC 'Perl module path' "
+ "EQUALITY caseExactMatch "
+ "SYNTAX OMsDirectoryString )", NULL, NULL },
+ { "filterSearchResults", "on|off", 2, 2, 0, ARG_ON_OFF|ARG_OFFSET,
+ (void *)offsetof(PerlBackend, pb_filter_search_results),
+ "( OLcfgDbAt:11.3 NAME 'olcPerlFilterSearchResults' "
+ "DESC 'Filter search results before returning to client' "
+ "SYNTAX OMsBoolean SINGLE-VALUE )", NULL, NULL },
+ { "perlModuleConfig", "args", 2, 0, 0,
+ ARG_MAGIC|PERL_CONFIG, perl_cf,
+ "( OLcfgDbAt:11.4 NAME 'olcPerlModuleConfig' "
+ "DESC 'Perl module config directives' "
+ "EQUALITY caseExactMatch "
+ "SYNTAX OMsDirectoryString )", NULL, NULL },
+ { NULL }
+};
+
+static ConfigOCs perlocs[] = {
+ { "( OLcfgDbOc:11.1 "
+ "NAME 'olcDbPerlConfig' "
+ "DESC 'Perl DB configuration' "
+ "SUP olcDatabaseConfig "
+ "MUST ( olcPerlModulePath $ olcPerlModule ) "
+ "MAY ( olcPerlFilterSearchResults $ olcPerlModuleConfig ) )",
+ Cft_Database, perlcfg, NULL, NULL },
+ { NULL }
+};
+
+static ConfigOCs ovperlocs[] = {
+ { "( OLcfgDbOc:11.2 "
+ "NAME 'olcovPerlConfig' "
+ "DESC 'Perl overlay configuration' "
+ "SUP olcOverlayConfig "
+ "MUST ( olcPerlModulePath $ olcPerlModule ) "
+ "MAY ( olcPerlFilterSearchResults $ olcPerlModuleConfig ) )",
+ Cft_Overlay, perlcfg, NULL, NULL },
+ { NULL }
+};
+
+/**********************************************************
+ *
+ * Config
+ *
+ **********************************************************/
+int
+perl_back_db_config(
+ BackendDB *be,
+ const char *fname,
+ int lineno,
+ int argc,
+ char **argv
+)
+{
+ int rc = config_generic_wrapper( be, fname, lineno, argc, argv );
+ /* backward compatibility: map unknown directives to perlModuleConfig */
+ if ( rc == SLAP_CONF_UNKNOWN ) {
+ char **av = ch_malloc( (argc+2) * sizeof(char *));
+ int i;
+ av[0] = "perlModuleConfig";
+ av++;
+ for ( i=0; i<argc; i++ )
+ av[i] = argv[i];
+ av[i] = NULL;
+ av--;
+ rc = config_generic_wrapper( be, fname, lineno, argc+1, av );
+ ch_free( av );
+ }
+ return rc;
+}
+
+static int
+perl_cf(
+ ConfigArgs *c
+)
+{
+ PerlBackend *pb = (PerlBackend *) c->be->be_private;
+ SV* loc_sv;
+ int count ;
+ int args;
+ int rc = 0;
+ char eval_str[EVAL_BUF_SIZE];
+ struct berval bv;
+
+ if ( c->op == SLAP_CONFIG_EMIT ) {
+ switch( c-> type ) {
+ case PERL_MODULE:
+ if ( !pb->pb_module_name )
+ return 1;
+ c->value_string = ch_strdup( pb->pb_module_name );
+ break;
+ case PERL_PATH:
+ if ( !pb->pb_module_path )
+ return 1;
+ ber_bvarray_dup_x( &c->rvalue_vals, pb->pb_module_path, NULL );
+ break;
+ case PERL_CONFIG:
+ if ( !pb->pb_module_config )
+ return 1;
+ ber_bvarray_dup_x( &c->rvalue_vals, pb->pb_module_config, NULL );
+ break;
+ }
+ } else if ( c->op == LDAP_MOD_DELETE ) {
+ /* FIXME: none of this affects the state of the perl
+ * interpreter at all. We should probably destroy it
+ * and recreate it...
+ */
+ switch( c-> type ) {
+ case PERL_MODULE:
+ ch_free( pb->pb_module_name );
+ pb->pb_module_name = NULL;
+ break;
+ case PERL_PATH:
+ if ( c->valx < 0 ) {
+ ber_bvarray_free( pb->pb_module_path );
+ pb->pb_module_path = NULL;
+ } else {
+ int i = c->valx;
+ ch_free( pb->pb_module_path[i].bv_val );
+ for (; pb->pb_module_path[i].bv_val; i++ )
+ pb->pb_module_path[i] = pb->pb_module_path[i+1];
+ }
+ break;
+ case PERL_CONFIG:
+ if ( c->valx < 0 ) {
+ ber_bvarray_free( pb->pb_module_config );
+ pb->pb_module_config = NULL;
+ } else {
+ int i = c->valx;
+ ch_free( pb->pb_module_config[i].bv_val );
+ for (; pb->pb_module_config[i].bv_val; i++ )
+ pb->pb_module_config[i] = pb->pb_module_config[i+1];
+ }
+ break;
+ }
+ } else {
+ switch( c->type ) {
+ case PERL_MODULE:
+ snprintf( eval_str, EVAL_BUF_SIZE, "use %s;", c->argv[1] );
+ eval_pv( eval_str, 0 );
+
+ if (SvTRUE(ERRSV)) {
+ STRLEN len;
+
+ snprintf( c->cr_msg, sizeof( c->cr_msg ), "%s: error %s",
+ c->log, SvPV(ERRSV, len ));
+ Debug( LDAP_DEBUG_ANY, "%s\n", c->cr_msg, 0, 0 );
+ rc = 1;
+ } else {
+ dSP; ENTER; SAVETMPS;
+ PUSHMARK(sp);
+ XPUSHs(sv_2mortal(newSVpv(c->argv[1], 0)));
+ PUTBACK;
+
+ count = call_method("new", G_SCALAR);
+
+ SPAGAIN;
+
+ if (count != 1) {
+ croak("Big trouble in config\n") ;
+ }
+
+ pb->pb_obj_ref = newSVsv(POPs);
+
+ PUTBACK; FREETMPS; LEAVE ;
+ pb->pb_module_name = ch_strdup( c->argv[1] );
+ }
+ break;
+
+ case PERL_PATH:
+ snprintf( eval_str, EVAL_BUF_SIZE, "push @INC, '%s';", c->argv[1] );
+ loc_sv = eval_pv( eval_str, 0 );
+ /* XXX loc_sv return value is ignored. */
+ ber_str2bv( c->argv[1], 0, 0, &bv );
+ value_add_one( &pb->pb_module_path, &bv );
+ break;
+
+ case PERL_CONFIG: {
+ dSP ; ENTER ; SAVETMPS;
+
+ PUSHMARK(sp) ;
+ XPUSHs( pb->pb_obj_ref );
+
+ /* Put all arguments on the perl stack */
+ for( args = 1; args < c->argc; args++ )
+ XPUSHs(sv_2mortal(newSVpv(c->argv[args], 0)));
+
+ ber_str2bv( c->line + STRLENOF("perlModuleConfig "), 0, 0, &bv );
+ value_add_one( &pb->pb_module_config, &bv );
+
+ PUTBACK ;
+
+ count = call_method("config", G_SCALAR);
+
+ SPAGAIN ;
+
+ if (count != 1) {
+ croak("Big trouble in config\n") ;
+ }
+
+ rc = POPi;
+
+ PUTBACK ; FREETMPS ; LEAVE ;
+ }
+ break;
+ }
+ }
+ return rc;
+}
+
+int
+perl_back_init_cf( BackendInfo *bi )
+{
+ bi->bi_cf_ocs = perlocs;
+
+ return config_register_schema( perlcfg, perlocs );
+}
diff --git a/servers/slapd/back-perl/delete.c b/servers/slapd/back-perl/delete.c
new file mode 100644
index 0000000..2f7d478
--- /dev/null
+++ b/servers/slapd/back-perl/delete.c
@@ -0,0 +1,59 @@
+/* $OpenLDAP$ */
+/* This work is part of OpenLDAP Software <http://www.openldap.org/>.
+ *
+ * Copyright 1999-2018 The OpenLDAP Foundation.
+ * Portions Copyright 1999 John C. Quillan.
+ * Portions Copyright 2002 myinternet Limited.
+ * 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 file LICENSE in the
+ * top-level directory of the distribution or, alternatively, at
+ * <http://www.OpenLDAP.org/license.html>.
+ */
+
+#include "perl_back.h"
+
+int
+perl_back_delete(
+ Operation *op,
+ SlapReply *rs )
+{
+ PerlBackend *perl_back = (PerlBackend *) op->o_bd->be_private;
+ int count;
+
+ PERL_SET_CONTEXT( PERL_INTERPRETER );
+ ldap_pvt_thread_mutex_lock( &perl_interpreter_mutex );
+
+ {
+ dSP; ENTER; SAVETMPS;
+
+ PUSHMARK(sp);
+ XPUSHs( perl_back->pb_obj_ref );
+ XPUSHs(sv_2mortal(newSVpv( op->o_req_dn.bv_val , op->o_req_dn.bv_len )));
+
+ PUTBACK;
+
+ count = call_method("delete", G_SCALAR);
+
+ SPAGAIN;
+
+ if (count != 1) {
+ croak("Big trouble in perl-back_delete\n");
+ }
+
+ rs->sr_err = POPi;
+
+ PUTBACK; FREETMPS; LEAVE;
+ }
+
+ ldap_pvt_thread_mutex_unlock( &perl_interpreter_mutex );
+
+ send_ldap_result( op, rs );
+
+ Debug( LDAP_DEBUG_ANY, "Perl DELETE\n", 0, 0, 0 );
+ return( 0 );
+}
diff --git a/servers/slapd/back-perl/init.c b/servers/slapd/back-perl/init.c
new file mode 100644
index 0000000..a768555
--- /dev/null
+++ b/servers/slapd/back-perl/init.c
@@ -0,0 +1,177 @@
+/* $OpenLDAP$ */
+/* This work is part of OpenLDAP Software <http://www.openldap.org/>.
+ *
+ * Copyright 1999-2018 The OpenLDAP Foundation.
+ * Portions Copyright 1999 John C. Quillan.
+ * Portions Copyright 2002 myinternet Limited.
+ * 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 file LICENSE in the
+ * top-level directory of the distribution or, alternatively, at
+ * <http://www.OpenLDAP.org/license.html>.
+ */
+
+#include "perl_back.h"
+#include "../config.h"
+
+#ifdef PERL_SYS_INIT3
+#include <ac/unistd.h> /* maybe get environ */
+extern char **environ;
+#endif
+
+static void perl_back_xs_init LDAP_P((PERL_BACK_XS_INIT_PARAMS));
+EXT void boot_DynaLoader LDAP_P((PERL_BACK_BOOT_DYNALOADER_PARAMS));
+
+PerlInterpreter *PERL_INTERPRETER = NULL;
+ldap_pvt_thread_mutex_t perl_interpreter_mutex;
+
+
+/**********************************************************
+ *
+ * Init
+ *
+ **********************************************************/
+
+int
+perl_back_initialize(
+ BackendInfo *bi
+)
+{
+ char *embedding[] = { "", "-e", "0", NULL }, **argv = embedding;
+ int argc = 3;
+#ifdef PERL_SYS_INIT3
+ char **env = environ;
+#else
+ char **env = NULL;
+#endif
+
+ bi->bi_open = NULL;
+ bi->bi_config = 0;
+ bi->bi_close = perl_back_close;
+ bi->bi_destroy = 0;
+
+ bi->bi_db_init = perl_back_db_init;
+ bi->bi_db_config = perl_back_db_config;
+ bi->bi_db_open = perl_back_db_open;
+ bi->bi_db_close = 0;
+ bi->bi_db_destroy = perl_back_db_destroy;
+
+ bi->bi_op_bind = perl_back_bind;
+ bi->bi_op_unbind = 0;
+ bi->bi_op_search = perl_back_search;
+ bi->bi_op_compare = perl_back_compare;
+ bi->bi_op_modify = perl_back_modify;
+ bi->bi_op_modrdn = perl_back_modrdn;
+ bi->bi_op_add = perl_back_add;
+ bi->bi_op_delete = perl_back_delete;
+ bi->bi_op_abandon = 0;
+
+ bi->bi_extended = 0;
+
+ bi->bi_chk_referrals = 0;
+
+ bi->bi_connection_init = 0;
+ bi->bi_connection_destroy = 0;
+
+ /* injecting code from perl_back_open, because using fonction reference (bi->bi_open) is not functional */
+ Debug( LDAP_DEBUG_TRACE, "perl backend open\n", 0, 0, 0 );
+
+ if( PERL_INTERPRETER != NULL ) {
+ Debug( LDAP_DEBUG_ANY, "perl backend open: already opened\n",
+ 0, 0, 0 );
+ return 1;
+ }
+
+ ldap_pvt_thread_mutex_init( &perl_interpreter_mutex );
+
+#ifdef PERL_SYS_INIT3
+ PERL_SYS_INIT3(&argc, &argv, &env);
+#endif
+ PERL_INTERPRETER = perl_alloc();
+ perl_construct(PERL_INTERPRETER);
+#ifdef PERL_EXIT_DESTRUCT_END
+ PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
+#endif
+ perl_parse(PERL_INTERPRETER, perl_back_xs_init, argc, argv, env);
+ perl_run(PERL_INTERPRETER);
+ return perl_back_init_cf( bi );
+}
+
+int
+perl_back_db_init(
+ BackendDB *be,
+ ConfigReply *cr
+)
+{
+ be->be_private = (PerlBackend *) ch_malloc( sizeof(PerlBackend) );
+ memset( be->be_private, '\0', sizeof(PerlBackend));
+
+ ((PerlBackend *)be->be_private)->pb_filter_search_results = 0;
+
+ Debug( LDAP_DEBUG_TRACE, "perl backend db init\n", 0, 0, 0 );
+
+ be->be_cf_ocs = be->bd_info->bi_cf_ocs;
+
+ return 0;
+}
+
+int
+perl_back_db_open(
+ BackendDB *be,
+ ConfigReply *cr
+)
+{
+ int count;
+ int return_code;
+
+ PerlBackend *perl_back = (PerlBackend *) be->be_private;
+
+ ldap_pvt_thread_mutex_lock( &perl_interpreter_mutex );
+
+ {
+ dSP; ENTER; SAVETMPS;
+
+ PUSHMARK(sp);
+ XPUSHs( perl_back->pb_obj_ref );
+
+ PUTBACK;
+
+ count = call_method("init", G_SCALAR);
+
+ SPAGAIN;
+
+ if (count != 1) {
+ croak("Big trouble in perl_back_db_open\n");
+ }
+
+ return_code = POPi;
+
+ PUTBACK; FREETMPS; LEAVE;
+ }
+
+ ldap_pvt_thread_mutex_unlock( &perl_interpreter_mutex );
+
+ return return_code;
+}
+
+
+static void
+perl_back_xs_init(PERL_BACK_XS_INIT_PARAMS)
+{
+ char *file = __FILE__;
+ dXSUB_SYS;
+ newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
+}
+
+#if SLAPD_PERL == SLAPD_MOD_DYNAMIC
+
+/* conditionally define the init_module() function */
+SLAP_BACKEND_INIT_MODULE( perl )
+
+#endif /* SLAPD_PERL == SLAPD_MOD_DYNAMIC */
+
+
diff --git a/servers/slapd/back-perl/modify.c b/servers/slapd/back-perl/modify.c
new file mode 100644
index 0000000..177cdf4
--- /dev/null
+++ b/servers/slapd/back-perl/modify.c
@@ -0,0 +1,97 @@
+/* $OpenLDAP$ */
+/* This work is part of OpenLDAP Software <http://www.openldap.org/>.
+ *
+ * Copyright 1999-2018 The OpenLDAP Foundation.
+ * Portions Copyright 1999 John C. Quillan.
+ * Portions Copyright 2002 myinternet Limited.
+ * 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 file LICENSE in the
+ * top-level directory of the distribution or, alternatively, at
+ * <http://www.OpenLDAP.org/license.html>.
+ */
+
+#include "perl_back.h"
+#include <ac/string.h>
+
+int
+perl_back_modify(
+ Operation *op,
+ SlapReply *rs )
+{
+ PerlBackend *perl_back = (PerlBackend *)op->o_bd->be_private;
+ Modifications *modlist = op->orm_modlist;
+ int count;
+ int i;
+
+ PERL_SET_CONTEXT( PERL_INTERPRETER );
+ ldap_pvt_thread_mutex_lock( &perl_interpreter_mutex );
+
+ {
+ dSP; ENTER; SAVETMPS;
+
+ PUSHMARK(sp);
+ XPUSHs( perl_back->pb_obj_ref );
+ XPUSHs(sv_2mortal(newSVpv( op->o_req_dn.bv_val , 0)));
+
+ for (; modlist != NULL; modlist = modlist->sml_next ) {
+ Modification *mods = &modlist->sml_mod;
+
+ switch ( mods->sm_op & ~LDAP_MOD_BVALUES ) {
+ case LDAP_MOD_ADD:
+ XPUSHs(sv_2mortal(newSVpv("ADD", STRLENOF("ADD") )));
+ break;
+
+ case LDAP_MOD_DELETE:
+ XPUSHs(sv_2mortal(newSVpv("DELETE", STRLENOF("DELETE") )));
+ break;
+
+ case LDAP_MOD_REPLACE:
+ XPUSHs(sv_2mortal(newSVpv("REPLACE", STRLENOF("REPLACE") )));
+ break;
+ }
+
+
+ XPUSHs(sv_2mortal(newSVpv( mods->sm_desc->ad_cname.bv_val,
+ mods->sm_desc->ad_cname.bv_len )));
+
+ for ( i = 0;
+ mods->sm_values != NULL && mods->sm_values[i].bv_val != NULL;
+ i++ )
+ {
+ XPUSHs(sv_2mortal(newSVpv( mods->sm_values[i].bv_val, mods->sm_values[i].bv_len )));
+ }
+
+ /* Fix delete attrib without value. */
+ if ( i == 0) {
+ XPUSHs(sv_newmortal());
+ }
+ }
+
+ PUTBACK;
+
+ count = call_method("modify", G_SCALAR);
+
+ SPAGAIN;
+
+ if (count != 1) {
+ croak("Big trouble in back_modify\n");
+ }
+
+ rs->sr_err = POPi;
+
+ PUTBACK; FREETMPS; LEAVE;
+ }
+
+ ldap_pvt_thread_mutex_unlock( &perl_interpreter_mutex );
+
+ send_ldap_result( op, rs );
+
+ Debug( LDAP_DEBUG_ANY, "Perl MODIFY\n", 0, 0, 0 );
+ return( 0 );
+}
+
diff --git a/servers/slapd/back-perl/modrdn.c b/servers/slapd/back-perl/modrdn.c
new file mode 100644
index 0000000..a7e9140
--- /dev/null
+++ b/servers/slapd/back-perl/modrdn.c
@@ -0,0 +1,63 @@
+/* $OpenLDAP$ */
+/* This work is part of OpenLDAP Software <http://www.openldap.org/>.
+ *
+ * Copyright 1999-2018 The OpenLDAP Foundation.
+ * Portions Copyright 1999 John C. Quillan.
+ * Portions Copyright 2002 myinternet Limited.
+ * 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 file LICENSE in the
+ * top-level directory of the distribution or, alternatively, at
+ * <http://www.OpenLDAP.org/license.html>.
+ */
+
+#include "perl_back.h"
+
+int
+perl_back_modrdn(
+ Operation *op,
+ SlapReply *rs )
+{
+ PerlBackend *perl_back = (PerlBackend *) op->o_bd->be_private;
+ int count;
+
+ PERL_SET_CONTEXT( PERL_INTERPRETER );
+ ldap_pvt_thread_mutex_lock( &perl_interpreter_mutex );
+
+ {
+ dSP; ENTER; SAVETMPS;
+
+ PUSHMARK(sp) ;
+ XPUSHs( perl_back->pb_obj_ref );
+ XPUSHs(sv_2mortal(newSVpv( op->o_req_dn.bv_val , op->o_req_dn.bv_len )));
+ XPUSHs(sv_2mortal(newSVpv( op->orr_newrdn.bv_val , op->orr_newrdn.bv_len )));
+ XPUSHs(sv_2mortal(newSViv( op->orr_deleteoldrdn )));
+ if ( op->orr_newSup != NULL ) {
+ XPUSHs(sv_2mortal(newSVpv( op->orr_newSup->bv_val , op->orr_newSup->bv_len )));
+ }
+ PUTBACK ;
+
+ count = call_method("modrdn", G_SCALAR);
+
+ SPAGAIN ;
+
+ if (count != 1) {
+ croak("Big trouble in back_modrdn\n") ;
+ }
+
+ rs->sr_err = POPi;
+
+ PUTBACK; FREETMPS; LEAVE ;
+ }
+
+ ldap_pvt_thread_mutex_unlock( &perl_interpreter_mutex );
+
+ send_ldap_result( op, rs );
+
+ Debug( LDAP_DEBUG_ANY, "Perl MODRDN\n", 0, 0, 0 );
+ return( 0 );
+}
diff --git a/servers/slapd/back-perl/perl_back.h b/servers/slapd/back-perl/perl_back.h
new file mode 100644
index 0000000..8f314f7
--- /dev/null
+++ b/servers/slapd/back-perl/perl_back.h
@@ -0,0 +1,82 @@
+/* $OpenLDAP$ */
+/* This work is part of OpenLDAP Software <http://www.openldap.org/>.
+ *
+ * Copyright 1999-2018 The OpenLDAP Foundation.
+ * Portions Copyright 1999 John C. Quillan.
+ * Portions Copyright 2002 myinternet Limited.
+ * 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 file LICENSE in the
+ * top-level directory of the distribution or, alternatively, at
+ * <http://www.OpenLDAP.org/license.html>.
+ */
+
+#ifndef PERL_BACK_H
+#define PERL_BACK_H 1
+
+#include <EXTERN.h>
+#include <perl.h>
+#undef _ /* #defined by both Perl and ac/localize.h */
+#include "asperl_undefs.h"
+
+#include "portable.h"
+
+#include "slap.h"
+
+LDAP_BEGIN_DECL
+
+/*
+ * From Apache mod_perl: test for Perl version.
+ */
+
+#if defined(pTHX_) || (PERL_REVISION > 5 || (PERL_REVISION == 5 && PERL_VERSION >= 6))
+#define PERL_IS_5_6
+#endif
+
+#define EVAL_BUF_SIZE 500
+
+extern ldap_pvt_thread_mutex_t perl_interpreter_mutex;
+
+#ifdef PERL_IS_5_6
+/* We should be using the PL_errgv, I think */
+/* All the old style variables are prefixed with PL_ now */
+# define errgv PL_errgv
+# define na PL_na
+#else
+# define call_method(m, f) perl_call_method(m, f)
+# define eval_pv(m, f) perl_eval_pv(m, f)
+# define ERRSV GvSV(errgv)
+#endif
+
+#if defined( HAVE_WIN32_ASPERL ) || defined( USE_ITHREADS )
+/* pTHX is needed often now */
+# define PERL_INTERPRETER my_perl
+# define PERL_BACK_XS_INIT_PARAMS pTHX
+# define PERL_BACK_BOOT_DYNALOADER_PARAMS pTHX, CV *cv
+#else
+# define PERL_INTERPRETER perl_interpreter
+# define PERL_BACK_XS_INIT_PARAMS void
+# define PERL_BACK_BOOT_DYNALOADER_PARAMS CV *cv
+# define PERL_SET_CONTEXT(i)
+#endif
+
+extern PerlInterpreter *PERL_INTERPRETER;
+
+
+typedef struct perl_backend_instance {
+ char *pb_module_name;
+ BerVarray pb_module_path;
+ BerVarray pb_module_config;
+ SV *pb_obj_ref;
+ int pb_filter_search_results;
+} PerlBackend;
+
+LDAP_END_DECL
+
+#include "proto-perl.h"
+
+#endif /* PERL_BACK_H */
diff --git a/servers/slapd/back-perl/proto-perl.h b/servers/slapd/back-perl/proto-perl.h
new file mode 100644
index 0000000..cd3bc14
--- /dev/null
+++ b/servers/slapd/back-perl/proto-perl.h
@@ -0,0 +1,43 @@
+/* $OpenLDAP$ */
+/* This work is part of OpenLDAP Software <http://www.openldap.org/>.
+ *
+ * Copyright 1999-2018 The OpenLDAP Foundation.
+ * Portions Copyright 1999 John C. Quillan.
+ * Portions Copyright 2002 myinternet Limited.
+ * 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 file LICENSE in the
+ * top-level directory of the distribution or, alternatively, at
+ * <http://www.OpenLDAP.org/license.html>.
+ */
+
+#ifndef PROTO_PERL_H
+#define PROTO_PERL_H
+
+LDAP_BEGIN_DECL
+
+extern BI_init perl_back_initialize;
+
+extern BI_close perl_back_close;
+
+extern BI_db_init perl_back_db_init;
+extern BI_db_open perl_back_db_open;
+extern BI_db_destroy perl_back_db_destroy;
+extern BI_db_config perl_back_db_config;
+
+extern BI_op_bind perl_back_bind;
+extern BI_op_search perl_back_search;
+extern BI_op_compare perl_back_compare;
+extern BI_op_modify perl_back_modify;
+extern BI_op_modrdn perl_back_modrdn;
+extern BI_op_add perl_back_add;
+extern BI_op_delete perl_back_delete;
+
+extern int perl_back_init_cf( BackendInfo *bi );
+LDAP_END_DECL
+
+#endif /* PROTO_PERL_H */
diff --git a/servers/slapd/back-perl/search.c b/servers/slapd/back-perl/search.c
new file mode 100644
index 0000000..fc2efbc
--- /dev/null
+++ b/servers/slapd/back-perl/search.c
@@ -0,0 +1,122 @@
+/* $OpenLDAP$ */
+/* This work is part of OpenLDAP Software <http://www.openldap.org/>.
+ *
+ * Copyright 1999-2018 The OpenLDAP Foundation.
+ * Portions Copyright 1999 John C. Quillan.
+ * Portions Copyright 2002 myinternet Limited.
+ * 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 file LICENSE in the
+ * top-level directory of the distribution or, alternatively, at
+ * <http://www.OpenLDAP.org/license.html>.
+ */
+
+#include "perl_back.h"
+
+/**********************************************************
+ *
+ * Search
+ *
+ **********************************************************/
+int
+perl_back_search(
+ Operation *op,
+ SlapReply *rs )
+{
+ PerlBackend *perl_back = (PerlBackend *)op->o_bd->be_private;
+ int count ;
+ AttributeName *an;
+ Entry *e;
+ char *buf;
+ int i;
+
+ PERL_SET_CONTEXT( PERL_INTERPRETER );
+ ldap_pvt_thread_mutex_lock( &perl_interpreter_mutex );
+
+ {
+ dSP; ENTER; SAVETMPS;
+
+ PUSHMARK(sp) ;
+ XPUSHs( perl_back->pb_obj_ref );
+ XPUSHs(sv_2mortal(newSVpv( op->o_req_ndn.bv_val , op->o_req_ndn.bv_len)));
+ XPUSHs(sv_2mortal(newSViv( op->ors_scope )));
+ XPUSHs(sv_2mortal(newSViv( op->ors_deref )));
+ XPUSHs(sv_2mortal(newSViv( op->ors_slimit )));
+ XPUSHs(sv_2mortal(newSViv( op->ors_tlimit )));
+ XPUSHs(sv_2mortal(newSVpv( op->ors_filterstr.bv_val , op->ors_filterstr.bv_len)));
+ XPUSHs(sv_2mortal(newSViv( op->ors_attrsonly )));
+
+ for ( an = op->ors_attrs; an && an->an_name.bv_val; an++ ) {
+ XPUSHs(sv_2mortal(newSVpv( an->an_name.bv_val , an->an_name.bv_len)));
+ }
+ PUTBACK;
+
+ count = call_method("search", G_ARRAY );
+
+ SPAGAIN;
+
+ if (count < 1) {
+ croak("Big trouble in back_search\n") ;
+ }
+
+ if ( count > 1 ) {
+
+ for ( i = 1; i < count; i++ ) {
+
+ buf = POPp;
+
+ if ( (e = str2entry( buf )) == NULL ) {
+ Debug( LDAP_DEBUG_ANY, "str2entry(%s) failed\n", buf, 0, 0 );
+
+ } else {
+ int send_entry;
+
+ if (perl_back->pb_filter_search_results)
+ send_entry = (test_filter( op, e, op->ors_filter ) == LDAP_COMPARE_TRUE);
+ else
+ send_entry = 1;
+
+ if (send_entry) {
+ rs->sr_entry = e;
+ rs->sr_attrs = op->ors_attrs;
+ rs->sr_flags = REP_ENTRY_MODIFIABLE;
+ rs->sr_err = LDAP_SUCCESS;
+ rs->sr_err = send_search_entry( op, rs );
+ rs->sr_flags = 0;
+ rs->sr_attrs = NULL;
+ rs->sr_entry = NULL;
+ if ( rs->sr_err == LDAP_SIZELIMIT_EXCEEDED || rs->sr_err == LDAP_BUSY ) {
+ goto done;
+ }
+ }
+
+ entry_free( e );
+ }
+ }
+ }
+
+ /*
+ * We grab the return code last because the stack comes
+ * from perl in reverse order.
+ *
+ * ex perl: return ( 0, $res_1, $res_2 );
+ *
+ * ex stack: <$res_2> <$res_1> <0>
+ */
+
+ rs->sr_err = POPi;
+
+done:;
+ PUTBACK; FREETMPS; LEAVE;
+ }
+
+ ldap_pvt_thread_mutex_unlock( &perl_interpreter_mutex );
+
+ send_ldap_result( op, rs );
+
+ return 0;
+}
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-22 18:54:22 +0000