Initial version of the experimental 'back-perl'

John's still working on the 'perl-test' (the perl backend test module).

acconfig.h

@@ -190,6 +190,9 @@
 /* define this to use SLAPD passwd backend */
 #undef SLAPD_PASSWD
 
+/* define this to use SLAPD perl backend */
+#undef SLAPD_PERL
+
 /* define this for phonetic support */
 #undef SLAPD_PHONETIC
 

build/top.mk

@@ -107,6 +107,8 @@ AC_LDFLAGS = @LDFLAGS@
 AC_LIBS = @LIBS@
 
 KRB_LIBS = @KRB_LIBS@
+PERL_CPPFLAGS = @SLAPD_PERL_CPPFLAGS@
+PERL_LDFLAGS = @SLAPD_PERL_LDFLAGS@
 TERMCAP_LIBS = @TERMCAP_LIBS@
 
 LDAPD_LIBS = @LDAPD_LIBS@

configure.in

@@ -85,6 +85,7 @@ OL_ARG_WITH(ldbm_type,[      --with-ldbm-type	use LDBM type], auto,
 	[auto btree hash])
 
 OL_ARG_ENABLE(passwd,[    --enable-passwd	enable passwd backend], no)dnl
+OL_ARG_ENABLE(perl,[    --enable-perl	enable perl backend], no)dnl
 OL_ARG_ENABLE(shell,[    --enable-shell	enable shell backend], no)dnl
 
 dnl SLURPD OPTIONS
@@ -113,6 +114,9 @@ if test $ol_enable_slapd = no ; then
 	if test $ol_enable_passwd = yes ; then
 		AC_MSG_WARN([slapd disabled, ignoring --enable_passwd argument])
 	fi
+	if test $ol_enable_perl = yes ; then
+		AC_MSG_WARN([slapd disabled, ignoring --enable_perl argument])
+	fi
 	if test $ol_enable_shell = yes ; then
 		AC_MSG_WARN([slapd disabled, ignoring --enable_shell argument])
 	fi
@@ -140,8 +144,9 @@ if test $ol_enable_slapd = no ; then
 
 	# force settings to no
 	ol_enable_ldbm=no
-	ol_enable_shell=no
 	ol_enable_passwd=no
+	ol_enable_perl=no
+	ol_enable_shell=no
 	ol_enable_aclgroups=no
 	ol_enable_wrappers=no
 	ol_enable_phonetic=no
@@ -161,7 +166,9 @@ elif test $ol_enable_ldbm = no ; then
 		AC_MSG_WARN([LDBM disabled, ignoring --with_ldbm_type argument])
 	fi
 
-	if test $ol_enable_passwd = no -a $ol_enable_shell = no ; then
+	if test $ol_enable_passwd = no -a \
+		$ol_enable_perl = no -a
+		$ol_enable_shell = no ; then
 		AC_MSG_ERROR([slapd requires a backend])
 	fi
 
@@ -208,9 +215,13 @@ BUILD_SLURPD=no
 
 BUILD_LDBM=no
 BUILD_PASSWD=no
+BUILD_PERL=no
 BUILD_SHELL=no
 BUILD_THREAD=no
 
+SLAPD_PERL_LDFLAGS=
+SLAPD_PERL_CPPFLAGS=
+
 KRB_LIBS=
 TERMCAP_LIBS=
 
@@ -226,6 +237,17 @@ AC_PATH_PROG(SENDMAIL, sendmail, /usr/lib/sendmail,
 AC_PATH_PROG(EDITOR, vi, /usr/ucb/vi, $PATH:/usr/ucb)
 AC_PATH_PROG(FINGER, finger, /usr/ucb/finger, $PATH:/usr/ucb)
 
+if test $ol_enable_perl = yes ; then
+	AC_PATH_PROG(PERLBIN, perl, /usr/bin/perl)
+
+	if test "no$PERLBIN" = "no" ; then
+		ol_enable_perl=no
+	fi
+
+	SLAPD_PERL_LDFLAGS="`$PERLBIN -MExtUtils::Embed -e ldopts|sed -e s/-lc//`"
+	SLAPD_PERL_CPPFLAGS="`$PERLBIN -MExtUtils::Embed -e perl_inc`"
+fi
+
 dnl Checks the compiler and UNIX Variants
 
 if test $cross_compiling = yes -a $ol_enable_x_compile = yes; then
@@ -1323,6 +1345,12 @@ if test "$ol_enable_passwd" != no ; then
 	BUILD_PASSWD=yes
 fi
 
+if test "$ol_enable_perl" != no ; then
+	AC_DEFINE(SLAPD_PERL,1)
+	BUILD_SLAPD=yes
+	BUILD_PERL=yes
+fi
+
 if test "$ol_enable_shell" != no ; then
 	AC_DEFINE(SLAPD_SHELL,1)
 	BUILD_SLAPD=yes
@@ -1344,6 +1372,7 @@ AC_SUBST(BUILD_LDAPD)
 AC_SUBST(BUILD_SLAPD)
   AC_SUBST(BUILD_LDBM)
   AC_SUBST(BUILD_PASSWD)
+  AC_SUBST(BUILD_PERL)
   AC_SUBST(BUILD_SHELL)
 AC_SUBST(BUILD_SLURPD)
 
@@ -1355,6 +1384,9 @@ AC_SUBST(LDBM_LIBS)
 AC_SUBST(LTHREAD_LIBS)
 AC_SUBST(LUTIL_LIBS)
 
+AC_SUBST(SLAPD_PERL_CPPFLAGS)
+AC_SUBST(SLAPD_PERL_LDFLAGS)
+
 AC_SUBST(KRB_LIBS)
 AC_SUBST(TERMCAP_LIBS)
 
@@ -1393,6 +1425,7 @@ servers/ldapd/Makefile:build/top.mk:servers/ldapd/Makefile.in:build/srv.mk \
 servers/slapd/Makefile:build/top.mk:servers/slapd/Makefile.in:build/srv.mk \
 servers/slapd/back-ldbm/Makefile:build/top.mk:servers/slapd/back-ldbm/Makefile.in:build/srv.mk \
 servers/slapd/back-passwd/Makefile:build/top.mk:servers/slapd/back-passwd/Makefile.in:build/srv.mk \
+servers/slapd/back-perl/Makefile:build/top.mk:servers/slapd/back-perl/Makefile.in:build/srv.mk \
 servers/slapd/back-shell/Makefile:build/top.mk:servers/slapd/back-shell/Makefile.in:build/srv.mk \
 servers/slapd/shell-backends/Makefile:build/top.mk:servers/slapd/shell-backends/Makefile.in:build/srv.mk \
 servers/slapd/tools/Makefile:build/top.mk:servers/slapd/tools/Makefile.in \

include/portable.h.in

@@ -257,6 +257,9 @@
 /* define this to use SLAPD passwd backend */
 #undef SLAPD_PASSWD
 
+/* define this to use SLAPD perl backend */
+#undef SLAPD_PERL
+
 /* define this for phonetic support */
 #undef SLAPD_PHONETIC
 

servers/slapd/Makefile.in

@@ -25,7 +25,7 @@ LDAP_LIBDIR= ../../libraries
 # $(LTHREAD_LIBS) must be last
 XLIBS = libbackends.a -lavl -lldbm -lldif -lldap -llber -llthread -llutil
 XXLIBS = $(LDBM_LIBS) $(SLAPD_LIBS) \
-	$(KRB_LIBS) $(LUTIL_LIBS)
+	$(PERL_LDFLAGS) $(KRB_LIBS) $(LUTIL_LIBS)
 XXXLIBS = $(LTHREAD_LIBS)
 
 BUILD_OPT = "--enable-slapd"

servers/slapd/back-perl/Makefile.in

@@ -0,0 +1,44 @@
+########################################################################### 
+# 
+#    Copyright 1999, John C. Quillan, All rights reserved.
+# 
+#    Redistribution and use in source and binary forms are permitted only
+#    as authorized by the OpenLDAP Public License.  A copy of this
+#    license is available at http://www.OpenLDAP.org/license.html or
+#    in file LICENSE in the top-level directory of the distribution.
+# 
+##########################################################################
+XSRCS	= version.c
+
+SRCS	= init.c search.c close.c config.c bind.c unbind.c compare.c \
+		modify.c add.c modrdn.c delete.c
+OBJS	= init.o search.o close.o config.o bind.o unbind.o compare.o \
+		modify.o add.o modrdn.o delete.o
+
+LDAP_INCDIR= ../../../include       
+LDAP_LIBDIR= ../../../libraries
+
+BUILD_OPT = "--enable-perl"
+BUILD_SRV = @BUILD_PERL@
+
+PROGRAMS =		libback-perl.a
+
+XINCPATH = -I.. -I$(srcdir)/..
+XDEFS = $(PERL_CPPFLAGS)
+
+all-local-srv:	FORCE
+	$(MAKE) $(MFLAGS) libback-perl.a
+
+libback-perl.a:	version.o
+	$(AR) ruv $@ $(OBJS) version.o
+	@$(RANLIB) $@
+	@touch ../.backend
+
+version.c: $(OBJS) $(LDAP_LIBDEPEND)
+	$(RM) $@
+	(u=$${USER-root} v=`$(CAT) $(VERSIONFILE)` d=`$(PWD)` h=`$(HOSTNAME)` \
+	t=`$(DATE)`; $(SED) -e "s|%WHEN%|$${t}|" \
+	-e "s|%WHOANDWHERE%|$${u}@$${h}:$${d}|" \
+	-e "s|%VERSION%|$${v}|" \
+	< $(srcdir)/Version.c > $@)
+

servers/slapd/back-perl/Version.c

@@ -0,0 +1,10 @@
+/*
+ *   Copyright 1999, John C. Quillan, All rights reserved.
+ *
+ *   Redistribution and use in source and binary forms are permitted only
+ *   as authorized by the OpenLDAP Public License.  A copy of this
+ *   license is available at http://www.OpenLDAP.org/license.html or
+ *   in file LICENSE in the top-level directory of the distribution.
+ */
+
+static char Versionstr[] = "  perl backend %VERSION% (%WHEN%)\n\t%WHOANDWHERE%\n";

servers/slapd/back-perl/add.c

@@ -0,0 +1,72 @@
+/*
+ *	 Copyright 1999, John C. Quillan, All rights reserved.
+ *
+ *	 Redistribution and use in source and binary forms are permitted only
+ *	 as authorized by the OpenLDAP Public License.	A copy of this
+ *	 license is available at http://www.OpenLDAP.org/license.html or
+ *	 in file LICENSE in the top-level directory of the distribution.
+ */
+
+#include "portable.h"
+
+#include <stdio.h>
+/*	#include <ac/types.h>
+	#include <ac/socket.h>
+*/
+
+#include <EXTERN.h>
+#include <perl.h>
+
+#include "slap.h"
+#include "perl_back.h"
+
+int
+perl_back_add(
+	Backend	*be,
+	Connection	*conn,
+	Operation	*op,
+	Entry	*e
+)
+{
+	int len;
+	int count;
+	int return_code;
+
+	PerlBackend *perl_back = (PerlBackend *) be->be_private;
+
+	pthread_mutex_lock( &perl_interpreter_mutex );	
+
+	{
+		dSP; ENTER; SAVETMPS;
+
+		PUSHMARK(sp);
+		XPUSHs( perl_back->pb_obj_ref );
+		XPUSHs(sv_2mortal(newSVpv( entry2str( e, &len, 0 ), 0 )));
+
+		PUTBACK;
+
+		count = perl_call_method("add", G_SCALAR);
+
+		SPAGAIN;
+
+		if (count != 1) {
+			croak("Big trouble in back_search\n");
+		}
+							 
+		return_code = POPi;
+
+		PUTBACK; FREETMPS; LEAVE;
+	}
+
+	pthread_mutex_unlock( &perl_interpreter_mutex );	
+
+	if( return_code != 0 ) {
+		send_ldap_result( conn, op, LDAP_OPERATIONS_ERROR, "", "" );
+
+	} else {
+		send_ldap_result( conn, op, LDAP_SUCCESS, "", "" );
+	}
+
+	Debug( LDAP_DEBUG_ANY, "Here ADD\n", 0, 0, 0 );
+	return( 0 );
+}

servers/slapd/back-perl/bind.c

@@ -0,0 +1,77 @@
+/*
+ *	 Copyright 1999, John C. Quillan, All rights reserved.
+ *
+ *	 Redistribution and use in source and binary forms are permitted only
+ *	 as authorized by the OpenLDAP Public License.	A copy of this
+ *	 license is available at http://www.OpenLDAP.org/license.html or
+ *	 in file LICENSE in the top-level directory of the distribution.
+ */
+
+#include "portable.h"
+/* init.c - initialize shell backend */
+	
+#include <stdio.h>
+/*	#include <ac/types.h>
+	#include <ac/socket.h>
+*/
+
+#include <EXTERN.h>
+#include <perl.h>
+
+#include "slap.h"
+#include "perl_back.h"
+
+
+/**********************************************************
+ *
+ * Bind
+ *
+ **********************************************************/
+int
+perl_back_bind(
+	Backend *be,
+	Connection *conn,
+	Operation *op,
+	char *dn,
+	int method,
+	struct berval *cred
+)
+{
+	int return_code;
+	int count;
+
+	PerlBackend *perl_back = (PerlBackend *) be->be_private;
+
+	pthread_mutex_lock( &perl_interpreter_mutex );	
+
+	{
+		dSP; ENTER; SAVETMPS;
+
+		PUSHMARK(sp);
+		XPUSHs( perl_back->pb_obj_ref );
+		XPUSHs(sv_2mortal(newSVpv( dn , 0)));
+		XPUSHs(sv_2mortal(newSVpv( cred->bv_val , cred->bv_len)));
+		PUTBACK;
+
+		count = perl_call_method("bind", G_SCALAR);
+
+		SPAGAIN;
+
+		if (count != 1) {
+			croak("Big trouble in back_search\n");
+		}
+
+		return_code = POPi;
+							 
+
+		PUTBACK; FREETMPS; LEAVE;
+	}
+
+	pthread_mutex_unlock( &perl_interpreter_mutex );	
+
+	Debug( LDAP_DEBUG_ANY, "Perl BIND\n", 0, 0, 0 );
+
+	return ( return_code );
+}
+
+

servers/slapd/back-perl/close.c

@@ -0,0 +1,42 @@
+/*
+ *	 Copyright 1999, John C. Quillan, All rights reserved.
+ *
+ *	 Redistribution and use in source and binary forms are permitted only
+ *	 as authorized by the OpenLDAP Public License.	A copy of this
+ *	 license is available at http://www.OpenLDAP.org/license.html or
+ *	 in file LICENSE in the top-level directory of the distribution.
+ */
+
+#include "portable.h"
+/* init.c - initialize shell backend */
+	
+#include <stdio.h>
+/*	#include <ac/types.h>
+	#include <ac/socket.h>
+*/
+
+#include <EXTERN.h>
+#include <perl.h>
+
+#include "slap.h"
+#include "perl_back.h"
+
+/**********************************************************
+ *
+ * Close
+ *
+ **********************************************************/
+
+void
+perl_back_close(
+	Backend *be
+)
+{
+	pthread_mutex_lock( &perl_interpreter_mutex );	
+
+	perl_destruct(perl_interpreter);
+	perl_free(perl_interpreter);
+
+	pthread_mutex_unlock( &perl_interpreter_mutex );	
+}
+

servers/slapd/back-perl/compare.c

@@ -0,0 +1,84 @@
+/*
+ *	 Copyright 1999, John C. Quillan, All rights reserved.
+ *
+ *	 Redistribution and use in source and binary forms are permitted only
+ *	 as authorized by the OpenLDAP Public License.	A copy of this
+ *	 license is available at http://www.OpenLDAP.org/license.html or
+ *	 in file LICENSE in the top-level directory of the distribution.
+ */
+
+#include "portable.h"
+
+#include <stdio.h>
+/*	#include <ac/types.h>
+	#include <ac/socket.h>
+*/
+
+#include <EXTERN.h>
+#include <perl.h>
+
+#include "slap.h"
+#include "perl_back.h"
+
+/**********************************************************
+ *
+ * Compare
+ *
+ **********************************************************/
+
+perl_back_compare(
+	Backend	*be,
+	Connection	*conn,
+	Operation	*op,
+	char	*dn,
+	Ava		*ava
+)
+{
+	int return_code;
+	int count;
+
+	PerlBackend *perl_back = (PerlBackend *)be->be_private;
+
+	send_ldap_result( conn, op, LDAP_NOT_SUPPORTED,
+		"", "not yet implemented" );
+
+#ifdef notdef
+	pthread_mutex_lock( &perl_interpreter_mutex );	
+
+	{
+		dSP; ENTER; SAVETMPS;
+
+		PUSHMARK(sp);
+		XPUSHs( perl_back->obj_ref );
+		XPUSHs(sv_2mortal(newSVpv( dn , 0)));
+		/* XPUSHs(sv_2mortal(newSVpv( cred->bv_val , cred->bv_len))); */
+		PUTBACK;
+
+		count = perl_call_method("bind", G_SCALAR);
+
+		SPAGAIN;
+
+		if (count != 1) {
+			croak("Big trouble in back_search\n");
+		}
+
+		return_code = POPi;
+							 
+		PUTBACK; FREETMPS; LEAVE;
+	}
+
+	pthread_mutex_unlock( &perl_interpreter_mutex );	
+
+	if( return_code != 0 ) {
+		send_ldap_result( conn, op, LDAP_COMPARE_TRUE, "", "" );
+
+	} else {
+		send_ldap_result( conn, op, LDAP_COMPARE_FALSE, "", "" );
+	}
+#endif
+
+	Debug( LDAP_DEBUG_ANY, "Here BIND\n", 0, 0, 0 );
+
+	return (0);
+}
+

servers/slapd/back-perl/config.c

@@ -0,0 +1,100 @@
+/*
+ *	 Copyright 1999, John C. Quillan, All rights reserved.
+ *
+ *	 Redistribution and use in source and binary forms are permitted only
+ *	 as authorized by the OpenLDAP Public License.	A copy of this
+ *	 license is available at http://www.OpenLDAP.org/license.html or
+ *	 in file LICENSE in the top-level directory of the distribution.
+ */
+
+#include "portable.h"
+/* init.c - initialize shell backend */
+	
+#include <stdio.h>
+/*	#include <ac/types.h>
+	#include <ac/socket.h>
+*/
+
+#include <EXTERN.h>
+#include <perl.h>
+
+#include "slap.h"
+#include "perl_back.h"
+
+
+/**********************************************************
+ *
+ * Config
+ *
+ **********************************************************/
+void
+perl_back_config(
+	 Backend *be,
+	 char *fname,
+	 int lineno,
+	 int argc,
+	 char **argv
+)
+{
+	SV* loc_sv;
+	PerlBackend *perl_back = (PerlBackend *) be->be_private;
+	char eval_str[EVAL_BUF_SIZE];
+	int count ;
+
+	/***** SECURITY PROBLEM HERE FIX LATER *****/
+
+	if ( strcasecmp( argv[0], "perlModule" ) == 0 ) {
+		if ( argc < 2 ) {
+			Debug( LDAP_DEBUG_ANY,
+				 "%s.pm: line %d: missing module in \"perlModule <module>\" line\n",
+				fname, lineno, 0 );
+			exit( 1 );
+		}
+
+		strncpy(eval_str, argv[1], EVAL_BUF_SIZE );
+
+		perl_require_pv( strcat( eval_str, ".pm" ));
+
+		if (SvTRUE(GvSV(errgv))) {
+			fprintf(stderr , "Error %s\n", SvPV(GvSV(errgv), na)) ;
+
+		} else {
+			dSP; ENTER; SAVETMPS;
+			PUSHMARK(sp);
+			XPUSHs(sv_2mortal(newSVpv(argv[1], 0)));
+			PUTBACK;
+
+			count = perl_call_method("new", G_SCALAR);
+
+			SPAGAIN;
+
+			if (count != 1) {
+				croak("Big trouble in config\n") ;
+			}
+
+			perl_back->pb_obj_ref = newSVsv(POPs);
+
+			PUTBACK; FREETMPS; LEAVE ;
+		}
+
+	} else if ( strcasecmp( argv[0], "perlModulePath" ) == 0 ) {
+		if ( argc < 2 ) {
+			fprintf( stderr,
+				"%s: line %d: missing module in \"PerlModulePath <module>\" line\n",
+				fname, lineno );
+			exit( 1 );
+		}
+
+		sprintf( eval_str, "push @INC, '%s';", argv[1] );
+		loc_sv = perl_eval_pv( eval_str, 0 );
+
+	} else {
+		/*
+		 * Pass it to Perl module if defined
+		 */
+
+		fprintf( stderr,
+			"Unknown perl backeng config: %s\n", argv[0]);
+		exit( 1 );
+	}
+}

servers/slapd/back-perl/delete.c

@@ -0,0 +1,71 @@
+/*
+ *	 Copyright 1999, John C. Quillan, All rights reserved.
+ *
+ *	 Redistribution and use in source and binary forms are permitted only
+ *	 as authorized by the OpenLDAP Public License.	A copy of this
+ *	 license is available at http://www.OpenLDAP.org/license.html or
+ *	 in file LICENSE in the top-level directory of the distribution.
+ */
+
+#include "portable.h"
+
+#include <stdio.h>
+/* #include <ac/types.h>
+#include <ac/socket.h>
+*/
+
+#include <EXTERN.h>
+#include <perl.h>
+
+#include "slap.h"
+#include "perl_back.h"
+
+perl_back_delete(
+	Backend	*be,
+	Connection	*conn,
+	Operation	*op,
+	char	*dn
+)
+{
+	int len;
+	int count;
+	int return_code;
+
+	PerlBackend *perl_back = (PerlBackend *) be->be_private;
+
+	pthread_mutex_lock( &perl_interpreter_mutex );	
+
+	{
+		dSP; ENTER; SAVETMPS;
+
+		PUSHMARK(sp);
+		XPUSHs( perl_back->pb_obj_ref );
+		XPUSHs(sv_2mortal(newSVpv( dn , 0 )));
+
+		PUTBACK;
+
+		count = perl_call_method("delete", G_SCALAR);
+
+		SPAGAIN;
+
+		if (count != 1) {
+			croak("Big trouble in perl-back_delete\n");
+		}
+							 
+		return_code = POPi;
+
+		PUTBACK; FREETMPS; LEAVE;
+	}
+
+	pthread_mutex_unlock( &perl_interpreter_mutex );	
+
+	if( return_code != 0 ) {
+		send_ldap_result( conn, op, LDAP_OPERATIONS_ERROR, "", "" );
+
+	} else {
+		send_ldap_result( conn, op, LDAP_SUCCESS, "", "" );
+	}
+
+	Debug( LDAP_DEBUG_ANY, "Here DELETE\n", 0, 0, 0 );
+	return( 0 );
+}

servers/slapd/back-perl/init.c

@@ -0,0 +1,58 @@
+/*
+ *	 Copyright 1999, John C. Quillan, All rights reserved.
+ *
+ *	 Redistribution and use in source and binary forms are permitted only
+ *	 as authorized by the OpenLDAP Public License.	A copy of this
+ *	 license is available at http://www.OpenLDAP.org/license.html or
+ *	 in file LICENSE in the top-level directory of the distribution.
+ */
+
+#include "portable.h"
+ /* init.c - initialize shell backend */
+	
+#include <stdio.h>
+/* #include <ac/types.h>
+	#include <ac/socket.h>
+*/
+
+#include <EXTERN.h>
+#include <perl.h>
+
+
+#include "slap.h"
+#include "perl_back.h"
+
+
+PerlInterpreter *perl_interpreter = NULL;
+pthread_mutex_t	perl_interpreter_mutex;
+
+
+/**********************************************************
+ *
+ * Init
+ *
+ **********************************************************/
+
+void
+perl_back_init(
+	Backend	*be
+)
+{
+	char *embedding[] = { "", "-e", "0" };
+
+	if( perl_interpreter == NULL ) {
+		perl_interpreter = perl_alloc();
+		perl_construct(perl_interpreter);
+		perl_parse(perl_interpreter, NULL, 3, embedding, (char **)NULL);
+		perl_run(perl_interpreter);
+		
+		pthread_mutex_init( &perl_interpreter_mutex,
+			pthread_mutexattr_default );
+	}
+
+	be->be_private = (PerlBackend *) ch_malloc( sizeof(PerlBackend) );
+	memset(&be->be_private, 0, sizeof(PerlBackend));
+
+	Debug( LDAP_DEBUG_ANY, "Here in perl backend\n", 0, 0, 0 );
+}
+

servers/slapd/back-perl/modify.c

@@ -0,0 +1,104 @@
+/*
+ *	 Copyright 1999, John C. Quillan, All rights reserved.
+ *
+ *	 Redistribution and use in source and binary forms are permitted only
+ *	 as authorized by the OpenLDAP Public License.	A copy of this
+ *	 license is available at http://www.OpenLDAP.org/license.html or
+ *	 in file LICENSE in the top-level directory of the distribution.
+ */
+
+#include "portable.h"
+
+#include <stdio.h>
+/* #include <ac/types.h>
+	#include <ac/socket.h>
+*/
+
+#include <EXTERN.h>
+#include <perl.h>
+
+#include "slap.h"
+#include "perl_back.h"
+
+int
+perl_back_modify(
+	Backend	*be,
+	Connection	*conn,
+	Operation	*op,
+	char	*dn,
+	LDAPModList	*modlist
+)
+{
+	char test[500];
+	int return_code;
+	int count;
+	int i;
+	int err = 0;
+	char *matched = NULL, *info = NULL;
+
+	PerlBackend *perl_back = (PerlBackend *)be->be_private;
+
+	pthread_mutex_lock( &perl_interpreter_mutex );	
+
+	{
+		dSP; ENTER; SAVETMPS;
+
+		PUSHMARK(sp);
+		XPUSHs( perl_back->pb_obj_ref );
+
+		for (; modlist != NULL; modlist = modlist->ml_next ) {
+			LDAPMod *mods = &modlist->ml_mod;
+
+			switch ( mods->mod_op & ~LDAP_MOD_BVALUES ) {
+			case LDAP_MOD_ADD:
+				XPUSHs(sv_2mortal(newSVpv("ADD", 0 )));
+				break;
+				
+			case LDAP_MOD_DELETE:
+				XPUSHs(sv_2mortal(newSVpv("DELETE", 0 )));
+				break;
+				
+			case LDAP_MOD_REPLACE:
+				XPUSHs(sv_2mortal(newSVpv("REPLACE", 0 )));
+				break;
+			}
+
+
+			XPUSHs(sv_2mortal(newSVpv( mods->mod_type, 0 )));
+
+			for ( i = 0;
+				mods->mod_bvalues != NULL && mods->mod_bvalues[i] != NULL;
+				i++ )
+			{
+				XPUSHs(sv_2mortal(newSVpv( mods->mod_bvalues[i]->bv_val, 0 )));
+			}
+		}
+
+		PUTBACK;
+
+		count = perl_call_method("modify", G_SCALAR);
+
+		SPAGAIN;
+
+		if (count != 1) {
+			croak("Big trouble in back_search\n");
+		}
+							 
+		return_code = POPi;
+
+		PUTBACK; FREETMPS; LEAVE;
+	}
+
+	pthread_mutex_unlock( &perl_interpreter_mutex );
+
+	if( return_code != 0 ) {
+		send_ldap_result( conn, op, LDAP_OPERATIONS_ERROR, "", "" );
+
+	} else {
+		send_ldap_result( conn, op, LDAP_SUCCESS, "", "" );
+	}
+
+	Debug( LDAP_DEBUG_ANY, "Perl MODIFY\n", 0, 0, 0 );
+	return( 0 );
+}
+

servers/slapd/back-perl/modrdn.c

@@ -0,0 +1,77 @@
+/*
+ *	 Copyright 1999, John C. Quillan, All rights reserved.
+ *
+ *	 Redistribution and use in source and binary forms are permitted only
+ *	 as authorized by the OpenLDAP Public License.	A copy of this
+ *	 license is available at http://www.OpenLDAP.org/license.html or
+ *	 in file LICENSE in the top-level directory of the distribution.
+ */
+
+#include "portable.h"
+
+#include <stdio.h>
+/*	#include <ac/types.h>
+	#include <ac/socket.h>
+*/
+
+#include <EXTERN.h>
+#include <perl.h>
+
+#include "slap.h"
+#include "perl_back.h"
+
+int
+perl_back_modrdn(
+	Backend	*be,
+	Connection	*conn,
+	Operation	*op,
+	char	*dn,
+	char	*newrdn,
+	int		deleteoldrdn
+)
+{
+	int len;
+	int count;
+	int return_code;
+
+	PerlBackend *perl_back = (PerlBackend *) be->be_private;
+
+	pthread_mutex_lock( &perl_interpreter_mutex );	
+
+	{
+		dSP; ENTER; SAVETMPS;
+
+		PUSHMARK(sp) ;
+		XPUSHs( perl_back->pb_obj_ref );
+		XPUSHs(sv_2mortal(newSVpv( dn , 0 )));
+		XPUSHs(sv_2mortal(newSVpv( newrdn , 0 )));
+		XPUSHs(sv_2mortal(newSViv( deleteoldrdn )));
+		PUTBACK ;
+
+		count = perl_call_method("modrdn", G_SCALAR);
+
+		SPAGAIN ;
+
+		if (count != 1) {
+			croak("Big trouble in back_search\n") ;
+		}
+							 
+		return_code = POPi;
+
+		PUTBACK; FREETMPS; LEAVE ;
+	}
+
+	pthread_mutex_unlock( &perl_interpreter_mutex );
+
+	if( return_code != 0 ) {
+		send_ldap_result( conn, op, LDAP_OPERATIONS_ERROR, "", "" );
+
+	} else {
+		send_ldap_result( conn, op, LDAP_SUCCESS, "", "" );
+	}
+
+	Debug( LDAP_DEBUG_ANY, "Perl MODRDN\n", 0, 0, 0 );
+	return( 0 );
+}
+
+

servers/slapd/back-perl/perl_back.h

@@ -0,0 +1,22 @@
+#ifndef PERL_BACK_H
+#define PERL_BACK_H 1
+
+#include <ldap_cdefs.h>
+
+LDAP_BEGIN_DECL
+
+/*
+ */
+#define EVAL_BUF_SIZE 500
+
+extern PerlInterpreter *perl_interpreter;
+extern pthread_mutex_t  perl_interpreter_mutex;
+
+typedef struct perl_backend_instance {
+  char *pb_module_name;
+  SV   *pb_obj_ref;
+} PerlBackend;
+
+LDAP_END_DECL
+
+#endif

servers/slapd/back-perl/search.c

@@ -0,0 +1,102 @@
+/*
+ *	 Copyright 1999, John C. Quillan, All rights reserved.
+ *
+ *	 Redistribution and use in source and binary forms are permitted only
+ *	 as authorized by the OpenLDAP Public License.	A copy of this
+ *	 license is available at http://www.OpenLDAP.org/license.html or
+ *	 in file LICENSE in the top-level directory of the distribution.
+ */
+
+#include "portable.h"
+
+#include <stdio.h>
+/*	#include <ac/types.h>
+	#include <ac/socket.h>
+*/
+
+#include <EXTERN.h>
+#include <perl.h>
+
+#include "slap.h"
+#include "perl_back.h"
+
+/**********************************************************
+ *
+ * Search
+ *
+ **********************************************************/
+int
+perl_back_search(
+	 Backend *be,
+	 Connection *conn,
+	 Operation *op,
+	 char *base,
+	 int scope,
+	 int deref,
+	 int sizelimit,
+	 int timelimit,
+	 Filter *filter,
+	 char *filterstr,
+	 char **attrs,
+	 int attrsonly
+)
+{
+	char test[500];
+	int count ;
+	int err = 0;
+	char *matched = NULL, *info = NULL;
+	PerlBackend *perl_back = (PerlBackend *)be->be_private;
+	Entry	*e;
+	char *buf;
+	int i;
+
+	pthread_mutex_lock( &perl_interpreter_mutex );	
+
+	{
+		dSP; ENTER; SAVETMPS;
+
+		PUSHMARK(sp) ;
+		XPUSHs( perl_back->pb_obj_ref );
+		XPUSHs(sv_2mortal(newSVpv( filterstr , 0)));
+		XPUSHs(sv_2mortal(newSViv( sizelimit )));
+		XPUSHs(sv_2mortal(newSViv( timelimit )));
+		XPUSHs(sv_2mortal(newSViv( attrsonly )));
+
+		for ( i = 0; attrs != NULL && attrs[i] != NULL; i++ ) {
+			XPUSHs(sv_2mortal(newSVpv( attrs[i] , 0)));
+		}
+		PUTBACK;
+
+		count = perl_call_method("search", G_SCALAR);
+
+		SPAGAIN;
+
+		if (count != 1) {
+			croak("Big trouble in back_search\n") ;
+		}
+							 
+		printf( "Before send search entry\n");
+		buf = POPp;
+
+		if ( (e = str2entry( buf )) == NULL ) {
+			Debug( LDAP_DEBUG_ANY, "str2entry(%s) failed\n", buf, 0, 0 );
+
+		} else {
+			send_search_entry( be,
+				conn,
+				op,
+				e,
+				attrs,
+				attrsonly );
+							 
+			entry_free( e );
+		}
+
+		PUTBACK; FREETMPS; LEAVE;
+	}
+
+	pthread_mutex_unlock( &perl_interpreter_mutex );	
+
+	send_ldap_result( conn, op, err, matched, info );
+}
+

servers/slapd/back-perl/unbind.c

@@ -0,0 +1,41 @@
+/*
+ *   Copyright 1999, John C. Quillan, All rights reserved.
+ *
+ *   Redistribution and use in source and binary forms are permitted only
+ *   as authorized by the OpenLDAP Public License.  A copy of this
+ *   license is available at http://www.OpenLDAP.org/license.html or
+ *   in file LICENSE in the top-level directory of the distribution.
+ */
+
+#include "portable.h"
+ /* init.c - initialize shell backend */
+  
+#include <stdio.h>
+/*	#include <ac/types.h>
+	#include <ac/socket.h>
+*/
+
+#include <EXTERN.h>
+#include <perl.h>
+
+#include "slap.h"
+#include "perl_back.h"
+
+
+/**********************************************************
+ *
+ * UnBind
+ *
+ **********************************************************/
+void
+perl_back_unbind(
+	Backend *be,
+	Connection *conn,
+	Operation *op
+)
+{
+	send_ldap_result( conn, op, LDAP_NOT_SUPPORTED,
+		"", "not yet implemented" );
+	Debug( LDAP_DEBUG_ANY, "Perl UNBIND\n", 0, 0, 0 );
+}
+

servers/slapd/backend.c

@@ -106,6 +106,33 @@ new_backend(
 	}
 #endif
 
+
+#ifdef SLAPD_PERL
+	if ( strcasecmp( type, "perl" ) == 0 ) {
+#ifdef notdef
+		be->be_abandon = perl_back_abandon;
+		be->be_bind = perl_back_bind;
+#else
+		be->be_abandon = NULL;
+		be->be_bind = NULL;
+#endif
+		be->be_unbind = perl_back_unbind;
+		be->be_search = perl_back_search;
+		be->be_compare = perl_back_compare;
+		be->be_modify = perl_back_modify;
+		be->be_modrdn = perl_back_modrdn;
+		be->be_add = perl_back_add;
+		be->be_delete = perl_back_delete;
+		be->be_config = perl_back_config;
+		be->be_init = perl_back_init;
+		be->be_close = perl_back_close;
+		be->be_type = "perl";
+		foundit = 1;
+	}
+#endif
+
+
+
 	if ( be->be_init != NULL ) {
 		(*be->be_init)( be );
 	}

servers/slapd/proto-slap.h

@@ -324,5 +324,21 @@ extern void shell_back_config LDAP_P((Backend *be, char *fname, int lineno, int
 extern void shell_back_init   LDAP_P((Backend *be));
 #endif
 
+#ifdef SLAPD_PERL
+extern int	perl_back_bind LDAP_P(( Backend *be, Connection *conn, Operation *op, char *dn, int method,    struct berval *crede ));
+extern void	perl_back_unbind LDAP_P(( Backend *be, Connection *conn, Operation *op ));
+extern int	perl_back_search LDAP_P(( Backend *be, Connection *conn, Operation *op, char *base, int scope, int deref, int sizelimit, int timelimit,  Filter *filter, char *filterstr, char **attrs, int attrsonly ));
+extern int	perl_back_compare LDAP_P((Backend *be, Connection *conn, Operation *op, char *dn, Ava 	*ava ));
+extern int	perl_back_modify LDAP_P(( Backend *be, Connection *conn, Operation *op, char *dn, LDAPModList *ml ));
+extern int	perl_back_modrdn LDAP_P(( Backend *be, Connection *conn, Operation *op, char *dn, char*newrdn, int deleteoldrdn ));
+extern int	perl_back_add LDAP_P(( Backend *be, Connection *conn, Operation *op, Entry *e ));
+extern int	perl_back_delete LDAP_P(( Backend *be, Connection *conn, Operation *op, char *dn ));
+/* extern int	perl_back_abandon(); */
+extern void	perl_back_config LDAP_P(( Backend *be, char *fname, int lineno, int argc, char **argv ));
+extern void	perl_back_init LDAP_P(( Backend *be ));
+extern void	perl_back_close LDAP_P(( Backend *be ));
+/* extern int      perl_back_group(); */
+#endif 
+
 #endif /* _proto_slap */
 

servers/slapd/tools/Makefile.in

@@ -20,7 +20,7 @@ LDAP_LIBDIR= ../../../libraries
 
 XLIBS = -lavl -lldif -lldap -llber -lldbm -llthread -llutil
 XXLIBS = $(LDAPD_LIBS) $(SLAPD_LIBS) \
-	$(LDBM_LIBS) $(KRB_LIBS) $(LUTIL_LIBS)
+	$(PERL_LDFLAGS) $(LDBM_LIBS) $(KRB_LIBS) $(LUTIL_LIBS)
 XXXLIBS = $(LTHREAD_LIBS)
 
 PROGRAMS=ldif2index ldif2ldbm ldbmcat ldif2id2entry \

tests/Makefile.in

@@ -13,6 +13,6 @@ clean-local:	FORCE
 	$(RM) test-db/[!C]* test-repl/[!C]* *core
 
 veryclean-local: FORCE
-	$(RM) -f data
+	@-$(RM) data
 	$(RM) -r test-db test-repl