mirror of
https://git.openldap.org/openldap/openldap.git
synced 2025-01-18 11:05:48 +08:00
Dynamic config support - not fully backward compatible
This commit is contained in:
parent
e3eecf85c4
commit
a815d1821c
@ -16,121 +16,184 @@
|
||||
*/
|
||||
|
||||
#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_STRING|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_STRING|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 'olcPerlConfig' "
|
||||
"DESC 'Perl DB configuration' "
|
||||
"SUP olcDatabaseConfig "
|
||||
"MUST ( olcPerlModulePath $ olcPerlModule ) "
|
||||
"MAY ( olcPerlFilterSearchResults $ olcPerlModuleConfig ) )",
|
||||
Cft_Database, perlcfg, NULL, NULL },
|
||||
{ NULL }
|
||||
};
|
||||
|
||||
/**********************************************************
|
||||
*
|
||||
* Config
|
||||
*
|
||||
**********************************************************/
|
||||
int
|
||||
perl_back_db_config(
|
||||
BackendDB *be,
|
||||
const char *fname,
|
||||
int lineno,
|
||||
int argc,
|
||||
char **argv
|
||||
static int
|
||||
perl_cf(
|
||||
ConfigArgs *c
|
||||
)
|
||||
{
|
||||
PerlBackend *pb = (PerlBackend *) c->be->be_private;
|
||||
SV* loc_sv;
|
||||
PerlBackend *perl_back = (PerlBackend *) be->be_private;
|
||||
char eval_str[EVAL_BUF_SIZE];
|
||||
int count ;
|
||||
int args;
|
||||
int return_code;
|
||||
|
||||
int rc = 0;
|
||||
char eval_str[EVAL_BUF_SIZE];
|
||||
struct berval bv;
|
||||
|
||||
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 );
|
||||
return( 1 );
|
||||
if ( c->op == SLAP_CONFIG_EMIT ) {
|
||||
switch( c-> type ) {
|
||||
case PERL_MODULE:
|
||||
if ( bv.bv_len < 1 )
|
||||
return 1;
|
||||
value_add_one( &c->rvalue_vals, &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;
|
||||
}
|
||||
|
||||
#ifdef PERL_IS_5_6
|
||||
snprintf( eval_str, EVAL_BUF_SIZE, "use %s;", argv[1] );
|
||||
eval_pv( eval_str, 0 );
|
||||
|
||||
if (SvTRUE(ERRSV)) {
|
||||
STRLEN n_a;
|
||||
|
||||
fprintf(stderr , "Error %s\n", SvPV(ERRSV, n_a)) ;
|
||||
}
|
||||
#else
|
||||
snprintf( eval_str, EVAL_BUF_SIZE, "%s.pm", argv[1] );
|
||||
perl_require_pv( eval_str );
|
||||
|
||||
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) {
|
||||
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 );
|
||||
return( 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
|
||||
|
||||
/* XXX loc_sv return value is ignored. */
|
||||
|
||||
} else if ( strcasecmp( argv[0], "filterSearchResults" ) == 0 ) {
|
||||
perl_back->pb_filter_search_results = 1;
|
||||
} else {
|
||||
return_code = SLAP_CONF_UNKNOWN;
|
||||
/*
|
||||
* Pass it to Perl module if defined
|
||||
} 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.bv_val );
|
||||
BER_BVZERO( &pb->pb_module_name );
|
||||
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:
|
||||
#ifdef PERL_IS_5_6
|
||||
snprintf( eval_str, EVAL_BUF_SIZE, "use %s;", c->argv[1] );
|
||||
eval_pv( eval_str, 0 );
|
||||
#else
|
||||
snprintf( eval_str, EVAL_BUF_SIZE, "%s.pm", c->argv[1] );
|
||||
perl_require_pv( eval_str );
|
||||
#endif /* PERL_IS_5_6 */
|
||||
|
||||
{
|
||||
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 ;
|
||||
ber_str2bv( c->argv[1], 0, 1, &pb->pb_module_name );
|
||||
}
|
||||
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( perl_back->pb_obj_ref );
|
||||
XPUSHs( pb->pb_obj_ref );
|
||||
|
||||
/* Put all arguments on the perl stack */
|
||||
for( args = 0; args < argc; args++ ) {
|
||||
XPUSHs(sv_2mortal(newSVpv(argv[args], 0)));
|
||||
for( args = 1; args < c->argc; args++ ) {
|
||||
XPUSHs(sv_2mortal(newSVpv(c->argv[args], 0)));
|
||||
}
|
||||
|
||||
PUTBACK ;
|
||||
|
||||
#ifdef PERL_IS_5_6
|
||||
count = call_method("config", G_SCALAR);
|
||||
#else
|
||||
count = perl_call_method("config", G_SCALAR);
|
||||
#endif
|
||||
|
||||
SPAGAIN ;
|
||||
|
||||
@ -138,14 +201,20 @@ perl_back_db_config(
|
||||
croak("Big trouble in config\n") ;
|
||||
}
|
||||
|
||||
return_code = POPi;
|
||||
rc = POPi;
|
||||
|
||||
PUTBACK ; FREETMPS ; LEAVE ;
|
||||
|
||||
}
|
||||
break;
|
||||
}
|
||||
|
||||
return return_code;
|
||||
}
|
||||
|
||||
return 0;
|
||||
return rc;
|
||||
}
|
||||
|
||||
int
|
||||
perl_back_init_cf( BackendInfo *bi )
|
||||
{
|
||||
bi->bi_cf_ocs = perlocs;
|
||||
|
||||
return config_register_schema( perlcfg, perlocs );
|
||||
}
|
||||
|
@ -45,7 +45,7 @@ perl_back_initialize(
|
||||
bi->bi_destroy = 0;
|
||||
|
||||
bi->bi_db_init = perl_back_db_init;
|
||||
bi->bi_db_config = perl_back_db_config;
|
||||
bi->bi_db_config = 0;
|
||||
bi->bi_db_open = perl_back_db_open;
|
||||
bi->bi_db_close = 0;
|
||||
bi->bi_db_destroy = perl_back_db_destroy;
|
||||
@ -79,7 +79,7 @@ perl_back_initialize(
|
||||
ldap_pvt_thread_mutex_init( &perl_interpreter_mutex );
|
||||
|
||||
#ifdef PERL_SYS_INIT3
|
||||
PERL_SYS_INIT3(&argc, &embedding, (char **)NULL);
|
||||
PERL_SYS_INIT3(&argc, &embedding, (char ***)NULL);
|
||||
#endif
|
||||
PERL_INTERPRETER = perl_alloc();
|
||||
perl_construct(PERL_INTERPRETER);
|
||||
@ -88,7 +88,7 @@ perl_back_initialize(
|
||||
#endif
|
||||
perl_parse(PERL_INTERPRETER, perl_back_xs_init, argc, embedding, (char **)NULL);
|
||||
perl_run(PERL_INTERPRETER);
|
||||
return 0;
|
||||
return perl_back_init_cf( bi );
|
||||
}
|
||||
|
||||
int
|
||||
|
@ -46,6 +46,9 @@ extern ldap_pvt_thread_mutex_t perl_interpreter_mutex;
|
||||
/* 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 ERRSV GvSV(errgv)
|
||||
#endif
|
||||
|
||||
#if defined( HAVE_WIN32_ASPERL ) || defined( USE_ITHREADS )
|
||||
@ -63,7 +66,9 @@ extern PerlInterpreter *PERL_INTERPRETER;
|
||||
|
||||
|
||||
typedef struct perl_backend_instance {
|
||||
char *pb_module_name;
|
||||
struct berval pb_module_name;
|
||||
BerVarray pb_module_path;
|
||||
BerVarray pb_module_config;
|
||||
SV *pb_obj_ref;
|
||||
int pb_filter_search_results;
|
||||
} PerlBackend;
|
||||
|
@ -27,7 +27,6 @@ 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;
|
||||
@ -37,6 +36,7 @@ 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 */
|
||||
|
Loading…
Reference in New Issue
Block a user