From 7127e0887cfd03f096ecf335b36d78fdb49815cd Mon Sep 17 00:00:00 2001
From: Luke Howard <lukeh@openldap.org>
Date: Tue, 16 Apr 2002 03:47:39 +0000
Subject: [PATCH] ITS#1659
---
servers/slapd/back-perl/README | 25 ++++++++++
servers/slapd/back-perl/SampleLDAP.pm | 24 ++++++---
servers/slapd/back-perl/add.c | 15 +++---
servers/slapd/back-perl/bind.c | 5 ++
servers/slapd/back-perl/close.c | 1 +
servers/slapd/back-perl/compare.c | 9 +++-
servers/slapd/back-perl/config.c | 30 ++++++++++--
servers/slapd/back-perl/delete.c | 13 +++--
servers/slapd/back-perl/external.h | 1 +
servers/slapd/back-perl/init.c | 70 ++++++++++++++++++++++-----
servers/slapd/back-perl/modify.c | 15 +++---
servers/slapd/back-perl/modrdn.c | 15 +++---
servers/slapd/back-perl/perl_back.h | 14 +++++-
servers/slapd/back-perl/search.c | 35 +++++++++-----
14 files changed, 203 insertions(+), 69 deletions(-)
create mode 100644 servers/slapd/back-perl/README
diff --git a/servers/slapd/back-perl/README b/servers/slapd/back-perl/README
new file mode 100644
index 0000000000..eefd007fdf
--- /dev/null
+++ b/servers/slapd/back-perl/README
@@ -0,0 +1,25 @@
+
+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 pty ltd.
+
+Luke Howard <lukeh@padl.com>
+
diff --git a/servers/slapd/back-perl/SampleLDAP.pm b/servers/slapd/back-perl/SampleLDAP.pm
index 24fd78edc2..6bbcd0e5a3 100644
--- a/servers/slapd/back-perl/SampleLDAP.pm
+++ b/servers/slapd/back-perl/SampleLDAP.pm
@@ -31,7 +31,8 @@ following actions that you wish to handle.
* add # adds an entry to back end
* modrdn # modifies a an entries rdn
* delete # deletes an ldap entry
- * config # process unknow config file lines
+ * config # process unknown config file lines
+ * init # called after backend is initialized
=head2 new
@@ -52,9 +53,12 @@ This method is called when a search request comes from a client.
It arguments are as follow.
* obj reference
- * filter string
+ * base DN
+ * scope
+ * alias deferencing policy
* size limit
* time limit
+ * filter string
* attributes only flag ( 1 for yes )
* list of attributes that are to be returned. (could be empty)
@@ -122,6 +126,12 @@ RETURN:
RETURN: non zero value if this is not a valid option.
+=head2 init
+
+ * obj reference
+
+RETURN: non zero value if initialization failed.
+
=head1 Configuration
The perl section of the config file recognizes the following
@@ -138,7 +148,9 @@ above.
perlModule ModName # use the module name ModName from ModName.pm
-
+ filterSearchResults # search results are candidates that need to be
+ # filtered, rather than search results to be
+ # returned directly to the client
=cut
@@ -160,7 +172,7 @@ sub new
sub search
{
my $this = shift;
- my( $filterStr, $sizeLim, $timeLim, $attrOnly, @attrs ) = @_;
+ my($base, $scope, $deref, $sizeLim, $timeLim, $filterStr, $attrOnly, @attrs ) = @_;
print STDERR "====$filterStr====\n";
$filterStr =~ s/\(|\)//g;
$filterStr =~ s/=/: /;
@@ -188,12 +200,12 @@ sub compare
{
my $this = shift;
my ( $dn, $avaStr ) = @_;
- my $rc = 0;
+ my $rc = 5; # LDAP_COMPARE_FALSE
$avaStr =~ s/=/: /;
if ( $this->{ $dn } =~ /$avaStr/im ) {
- $rc = 1;
+ $rc = 6; # LDAP_COMPARE_TRUE
}
return $rc;
diff --git a/servers/slapd/back-perl/add.c b/servers/slapd/back-perl/add.c
index 83509188d6..56548d04b3 100644
--- a/servers/slapd/back-perl/add.c
+++ b/servers/slapd/back-perl/add.c
@@ -1,6 +1,7 @@
/* $OpenLDAP$ */
/*
* Copyright 1999, John C. Quillan, All rights reserved.
+ * Portions Copyright 2002, myinternet pty ltd. 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
@@ -47,7 +48,11 @@ perl_back_add(
PUTBACK;
+#ifdef PERL_IS_5_6
+ count = call_method("add", G_SCALAR);
+#else
count = perl_call_method("add", G_SCALAR);
+#endif
SPAGAIN;
@@ -63,14 +68,8 @@ perl_back_add(
ldap_pvt_thread_mutex_unlock( &entry2str_mutex );
ldap_pvt_thread_mutex_unlock( &perl_interpreter_mutex );
- if( return_code != 0 ) {
- send_ldap_result( conn, op, LDAP_OPERATIONS_ERROR,
- NULL, NULL, NULL, NULL );
-
- } else {
- send_ldap_result( conn, op, LDAP_SUCCESS,
- NULL, NULL, NULL, NULL );
- }
+ send_ldap_result( conn, op, return_code,
+ NULL, NULL, NULL, NULL );
Debug( LDAP_DEBUG_ANY, "Perl ADD\n", 0, 0, 0 );
return( 0 );
diff --git a/servers/slapd/back-perl/bind.c b/servers/slapd/back-perl/bind.c
index fccc8e840a..f246c2f26e 100644
--- a/servers/slapd/back-perl/bind.c
+++ b/servers/slapd/back-perl/bind.c
@@ -1,6 +1,7 @@
/* $OpenLDAP$ */
/*
* Copyright 1999, John C. Quillan, All rights reserved.
+ * Portions Copyright 2002, myinternet pty ltd. 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
@@ -56,7 +57,11 @@ perl_back_bind(
XPUSHs(sv_2mortal(newSVpv( cred->bv_val , cred->bv_len)));
PUTBACK;
+#ifdef PERL_IS_5_6
+ count = call_method("bind", G_SCALAR);
+#else
count = perl_call_method("bind", G_SCALAR);
+#endif
SPAGAIN;
diff --git a/servers/slapd/back-perl/close.c b/servers/slapd/back-perl/close.c
index 79b62afe2c..483f5dfeec 100644
--- a/servers/slapd/back-perl/close.c
+++ b/servers/slapd/back-perl/close.c
@@ -1,6 +1,7 @@
/* $OpenLDAP$ */
/*
* Copyright 1999, John C. Quillan, All rights reserved.
+ * Portions Copyright 2002, myinternet pty ltd. 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
diff --git a/servers/slapd/back-perl/compare.c b/servers/slapd/back-perl/compare.c
index e4b1ac7443..1ca29f9f0a 100644
--- a/servers/slapd/back-perl/compare.c
+++ b/servers/slapd/back-perl/compare.c
@@ -1,6 +1,7 @@
/* $OpenLDAP$ */
/*
* Copyright 1999, John C. Quillan, All rights reserved.
+ * Portions Copyright 2002, myinternet pty ltd. 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
@@ -60,7 +61,11 @@ perl_back_compare(
XPUSHs(sv_2mortal(newSVpv( avastr , 0)));
PUTBACK;
+#ifdef PERL_IS_5_6
+ count = call_method("compare", G_SCALAR);
+#else
count = perl_call_method("compare", G_SCALAR);
+#endif
SPAGAIN;
@@ -77,8 +82,8 @@ perl_back_compare(
ch_free( avastr );
- send_ldap_result( conn, op, return_code ? LDAP_COMPARE_TRUE :
- LDAP_COMPARE_FALSE, NULL, NULL, NULL, NULL );
+ send_ldap_result( conn, op, return_code,
+ NULL, NULL, NULL, NULL );
Debug( LDAP_DEBUG_ANY, "Perl COMPARE\n", 0, 0, 0 );
diff --git a/servers/slapd/back-perl/config.c b/servers/slapd/back-perl/config.c
index fd3105aa7e..f70d2b7ebb 100644
--- a/servers/slapd/back-perl/config.c
+++ b/servers/slapd/back-perl/config.c
@@ -1,6 +1,7 @@
/* $OpenLDAP$ */
/*
* Copyright 1999, John C. Quillan, All rights reserved.
+ * Portions Copyright 2002, myinternet pty ltd. 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
@@ -53,21 +54,32 @@ perl_back_db_config(
return( 1 );
}
- strncpy(eval_str, argv[1], EVAL_BUF_SIZE );
+#ifdef PERL_IS_5_6
+ snprintf( eval_str, EVAL_BUF_SIZE, "use %s;", argv[1] );
+ eval_pv( eval_str, 0 );
+
+ if (SvTRUE(ERRSV)) {
+ fprintf(stderr , "Error %s\n", SvPV(ERRSV, na)) ;
+#else
+ snprintf( eval_str, EVAL_BUF_SIZE, "%s", argv[1] );
perl_require_pv( strcat( eval_str, ".pm" ));
if (SvTRUE(GvSV(errgv))) {
fprintf(stderr , "Error %s\n", SvPV(GvSV(errgv), na)) ;
-
+#endif /* PERL_IS_5_6 */
} else {
dSP; ENTER; SAVETMPS;
PUSHMARK(sp);
XPUSHs(sv_2mortal(newSVpv(argv[1], 0)));
PUTBACK;
+#ifdef PERL_IS_5_6
+ count = call_method("new", G_SCALAR);
+#else
count = perl_call_method("new", G_SCALAR);
-
+#endif
+
SPAGAIN;
if (count != 1) {
@@ -87,9 +99,15 @@ perl_back_db_config(
return( 1 );
}
- sprintf( eval_str, "push @INC, '%s';", argv[1] );
+ snprintf( eval_str, EVAL_BUF_SIZE, "push @INC, '%s';", argv[1] );
+#ifdef PERL_IS_5_6
+ loc_sv = eval_pv( eval_str, 0 );
+#else
loc_sv = perl_eval_pv( eval_str, 0 );
+#endif
+ } else if ( strcasecmp( argv[0], "filterSearchResults" ) == 0 ) {
+ perl_back->pb_filter_search_results = 1;
} else {
/*
* Pass it to Perl module if defined
@@ -108,7 +126,11 @@ perl_back_db_config(
PUTBACK ;
+#ifdef PERL_IS_5_6
+ count = call_method("config", G_SCALAR);
+#else
count = perl_call_method("config", G_SCALAR);
+#endif
SPAGAIN ;
diff --git a/servers/slapd/back-perl/delete.c b/servers/slapd/back-perl/delete.c
index 8dc9bca5a5..4cb45f5673 100644
--- a/servers/slapd/back-perl/delete.c
+++ b/servers/slapd/back-perl/delete.c
@@ -1,6 +1,7 @@
/* $OpenLDAP$ */
/*
* Copyright 1999, John C. Quillan, All rights reserved.
+ * Portions Copyright 2002, myinternet pty ltd. 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
@@ -46,7 +47,11 @@ perl_back_delete(
PUTBACK;
+#ifdef PERL_IS_5_6
+ count = call_method("delete", G_SCALAR);
+#else
count = perl_call_method("delete", G_SCALAR);
+#endif
SPAGAIN;
@@ -61,15 +66,9 @@ perl_back_delete(
ldap_pvt_thread_mutex_unlock( &perl_interpreter_mutex );
- if( return_code != 0 ) {
- send_ldap_result( conn, op, LDAP_OPERATIONS_ERROR,
+ send_ldap_result( conn, op, return_code,
NULL, NULL, NULL, NULL );
- } else {
- send_ldap_result( conn, op, LDAP_SUCCESS,
- NULL, NULL, NULL, NULL );
- }
-
Debug( LDAP_DEBUG_ANY, "Perl DELETE\n", 0, 0, 0 );
return( 0 );
}
diff --git a/servers/slapd/back-perl/external.h b/servers/slapd/back-perl/external.h
index 8962c5feed..f95fe171e4 100644
--- a/servers/slapd/back-perl/external.h
+++ b/servers/slapd/back-perl/external.h
@@ -10,6 +10,7 @@ extern BI_close perl_back_close;
extern BI_destroy perl_back_destroy;
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;
diff --git a/servers/slapd/back-perl/init.c b/servers/slapd/back-perl/init.c
index dd09b933d7..5e87b63b50 100644
--- a/servers/slapd/back-perl/init.c
+++ b/servers/slapd/back-perl/init.c
@@ -1,6 +1,7 @@
/* $OpenLDAP$ */
/*
* Copyright 1999, John C. Quillan, All rights reserved.
+ * Portions Copyright 2002, myinternet pty ltd. 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
@@ -33,15 +34,16 @@ ldap_pvt_thread_mutex_t perl_interpreter_mutex;
#ifdef SLAPD_PERL_DYNAMIC
-int back_perl_LTX_init_module(int argc, char *argv[]) {
- BackendInfo bi;
+int back_perl_LTX_init_module(int argc, char *argv[])
+{
+ BackendInfo bi;
- memset( &bi, '\0', sizeof(bi) );
- bi.bi_type = "perl";
- bi.bi_init = perl_back_initialize;
+ memset( &bi, '\0', sizeof(bi) );
+ bi.bi_type = "perl";
+ bi.bi_init = perl_back_initialize;
- backend_add(&bi);
- return 0;
+ backend_add(&bi);
+ return 0;
}
#endif /* SLAPD_PERL_DYNAMIC */
@@ -80,7 +82,7 @@ perl_back_initialize(
bi->bi_db_init = perl_back_db_init;
bi->bi_db_config = perl_back_db_config;
- bi->bi_db_open = 0;
+ bi->bi_db_open = perl_back_db_open;
bi->bi_db_close = 0;
bi->bi_db_destroy = perl_back_db_destroy;
@@ -117,22 +119,66 @@ perl_back_open(
int
perl_back_db_init(
- Backend *be
+ BackendDB *be
)
{
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 );
return 0;
}
+int
+perl_back_db_open(
+ BackendDB *be
+)
+{
+ 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;
+
+#ifdef PERL_IS_5_6
+ count = call_method("init", G_SCALAR);
+#else
+ count = perl_call_method("init", G_SCALAR);
+#endif
+
+ 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()
{
- char *file = __FILE__;
- dXSUB_SYS;
- newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
+ char *file = __FILE__;
+ dXSUB_SYS;
+ newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
}
diff --git a/servers/slapd/back-perl/modify.c b/servers/slapd/back-perl/modify.c
index 5122eb780c..e95e0feed4 100644
--- a/servers/slapd/back-perl/modify.c
+++ b/servers/slapd/back-perl/modify.c
@@ -1,6 +1,7 @@
/* $OpenLDAP$ */
/*
* Copyright 1999, John C. Quillan, All rights reserved.
+ * Portions Copyright 2002, myinternet pty ltd. 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
@@ -79,7 +80,11 @@ perl_back_modify(
PUTBACK;
+#ifdef PERL_IS_5_6
+ count = call_method("modify", G_SCALAR);
+#else
count = perl_call_method("modify", G_SCALAR);
+#endif
SPAGAIN;
@@ -94,14 +99,8 @@ perl_back_modify(
ldap_pvt_thread_mutex_unlock( &perl_interpreter_mutex );
- if( return_code != 0 ) {
- send_ldap_result( conn, op, LDAP_OPERATIONS_ERROR,
- NULL, NULL, NULL, NULL );
-
- } else {
- send_ldap_result( conn, op, LDAP_SUCCESS,
- NULL, NULL, NULL, NULL );
- }
+ send_ldap_result( conn, op, return_code,
+ NULL, NULL, NULL, NULL );
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
index 9aef7d9ae3..2990c89e8d 100644
--- a/servers/slapd/back-perl/modrdn.c
+++ b/servers/slapd/back-perl/modrdn.c
@@ -1,6 +1,7 @@
/* $OpenLDAP$ */
/*
* Copyright 1999, John C. Quillan, All rights reserved.
+ * Portions Copyright 2002, myinternet pty ltd. 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
@@ -69,7 +70,11 @@ perl_back_modrdn(
}
PUTBACK ;
+#ifdef PERL_IS_5_6
+ count = call_method("modrdn", G_SCALAR);
+#else
count = perl_call_method("modrdn", G_SCALAR);
+#endif
SPAGAIN ;
@@ -84,14 +89,8 @@ perl_back_modrdn(
ldap_pvt_thread_mutex_unlock( &perl_interpreter_mutex );
- if( return_code != 0 ) {
- send_ldap_result( conn, op, LDAP_OPERATIONS_ERROR,
- NULL, NULL, NULL, NULL );
-
- } else {
- send_ldap_result( conn, op, LDAP_SUCCESS,
- NULL, NULL, NULL, NULL );
- }
+ send_ldap_result( conn, op, return_code,
+ NULL, NULL, NULL, NULL );
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
index 6e53a7f25f..cb105577e3 100644
--- a/servers/slapd/back-perl/perl_back.h
+++ b/servers/slapd/back-perl/perl_back.h
@@ -5,15 +5,25 @@
LDAP_BEGIN_DECL
/*
+ * From Apache mod_perl: test for Perl version.[ja
*/
+#ifdef pTHX_
+#define PERL_IS_5_6
+#endif
+
#define EVAL_BUF_SIZE 500
+#ifdef pTHX_
+#define PERL_IS_5_6
+#endif
+
extern PerlInterpreter *perl_interpreter;
extern ldap_pvt_thread_mutex_t perl_interpreter_mutex;
typedef struct perl_backend_instance {
- char *pb_module_name;
- SV *pb_obj_ref;
+ char *pb_module_name;
+ SV *pb_obj_ref;
+ int pb_filter_search_results;
} PerlBackend;
LDAP_END_DECL
diff --git a/servers/slapd/back-perl/search.c b/servers/slapd/back-perl/search.c
index bedc09f9c9..5670a4e9f4 100644
--- a/servers/slapd/back-perl/search.c
+++ b/servers/slapd/back-perl/search.c
@@ -1,6 +1,7 @@
/* $OpenLDAP$ */
/*
* Copyright 1999, John C. Quillan, All rights reserved.
+ * Portions Copyright 2002, myinternet pty ltd. 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
@@ -61,9 +62,12 @@ perl_back_search(
PUSHMARK(sp) ;
XPUSHs( perl_back->pb_obj_ref );
- XPUSHs(sv_2mortal(newSVpv( filterstr->bv_val , 0)));
+ XPUSHs(sv_2mortal(newSVpv( nbase->bv_val , 0)));
+ XPUSHs(sv_2mortal(newSViv( scope )));
+ XPUSHs(sv_2mortal(newSViv( deref )));
XPUSHs(sv_2mortal(newSViv( sizelimit )));
XPUSHs(sv_2mortal(newSViv( timelimit )));
+ XPUSHs(sv_2mortal(newSVpv( filterstr->bv_val , 0)));
XPUSHs(sv_2mortal(newSViv( attrsonly )));
for ( an = attrs; an && an->an_name.bv_val; an++ ) {
@@ -71,7 +75,11 @@ perl_back_search(
}
PUTBACK;
+#ifdef PERL_IS_5_6
+ count = call_method("search", G_ARRAY );
+#else
count = perl_call_method("search", G_ARRAY );
+#endif
SPAGAIN;
@@ -89,9 +97,18 @@ perl_back_search(
Debug( LDAP_DEBUG_ANY, "str2entry(%s) failed\n", buf, 0, 0 );
} else {
- send_search_entry( be, conn, op,
- e, attrs, attrsonly, NULL );
-
+ int send_entry;
+
+ if (perl_back->pb_filter_search_results)
+ send_entry = (test_filter( be, conn, op, e, filter ) == LDAP_COMPARE_TRUE);
+ else
+ send_entry = 1;
+
+ if (send_entry) {
+ send_search_entry( be, conn, op,
+ e, attrs, attrsonly, NULL );
+ }
+
entry_free( e );
}
}
@@ -115,13 +132,7 @@ perl_back_search(
ldap_pvt_thread_mutex_unlock( &perl_interpreter_mutex );
- if( return_code != 0 ) {
- send_ldap_result( conn, op, LDAP_OPERATIONS_ERROR,
- NULL, NULL, NULL, NULL );
-
- } else {
- send_ldap_result( conn, op, LDAP_SUCCESS,
- NULL, NULL, NULL, NULL );
- }
+ send_ldap_result( conn, op, return_code,
+ NULL, NULL, NULL, NULL );
}
--
GitLab