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

+########################################################################### 
+# 
+#    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

+/*
+ *   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

+/*
+ *	 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

+/*
+ *	 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

+/*
+ *	 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

+/*
+ *	 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

+/*
+ *	 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

+/*
+ *	 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;
+