--- /dev/null
+
+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>
+
* 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
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)
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
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
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/=/: /;
{
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;
/* $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
PUTBACK;
+#ifdef PERL_IS_5_6
+ count = call_method("add", G_SCALAR);
+#else
count = perl_call_method("add", G_SCALAR);
+#endif
SPAGAIN;
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 );
/* $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
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;
/* $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
/* $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
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;
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 );
/* $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
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) {
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
PUTBACK ;
+#ifdef PERL_IS_5_6
+ count = call_method("config", G_SCALAR);
+#else
count = perl_call_method("config", G_SCALAR);
+#endif
SPAGAIN ;
/* $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
PUTBACK;
+#ifdef PERL_IS_5_6
+ count = call_method("delete", G_SCALAR);
+#else
count = perl_call_method("delete", G_SCALAR);
+#endif
SPAGAIN;
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 );
}
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;
/* $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
#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 */
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;
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);
}
/* $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
PUTBACK;
+#ifdef PERL_IS_5_6
+ count = call_method("modify", G_SCALAR);
+#else
count = perl_call_method("modify", G_SCALAR);
+#endif
SPAGAIN;
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 );
/* $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
}
PUTBACK ;
+#ifdef PERL_IS_5_6
+ count = call_method("modrdn", G_SCALAR);
+#else
count = perl_call_method("modrdn", G_SCALAR);
+#endif
SPAGAIN ;
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 );
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
/* $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
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++ ) {
}
PUTBACK;
+#ifdef PERL_IS_5_6
+ count = call_method("search", G_ARRAY );
+#else
count = perl_call_method("search", G_ARRAY );
+#endif
SPAGAIN;
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 );
}
}
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 );
}
projects / openldap / commitdiff