From a815d1821ca9928acec7b5666340d6c9fbdd5a31 Mon Sep 17 00:00:00 2001 From: Howard Chu Date: Fri, 4 Feb 2011 15:00:10 +0000 Subject: [PATCH] Dynamic config support - not fully backward compatible --- servers/slapd/back-perl/config.c | 241 +++++++++++++++++---------- servers/slapd/back-perl/init.c | 6 +- servers/slapd/back-perl/perl_back.h | 7 +- servers/slapd/back-perl/proto-perl.h | 2 +- 4 files changed, 165 insertions(+), 91 deletions(-) diff --git a/servers/slapd/back-perl/config.c b/servers/slapd/back-perl/config.c index 5584821899..e8489b6869 100644 --- a/servers/slapd/back-perl/config.c +++ b/servers/slapd/back-perl/config.c @@ -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; - - - if ( strcasecmp( argv[0], "perlModule" ) == 0 ) { - if ( argc < 2 ) { - Debug( LDAP_DEBUG_ANY, - "%s.pm: line %d: missing module in \"perlModule \" line\n", - fname, lineno, 0 ); - return( 1 ); + int rc = 0; + char eval_str[EVAL_BUF_SIZE]; + struct berval bv; + + 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 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", argv[1] ); - perl_require_pv( eval_str ); - - if (SvTRUE(GvSV(errgv))) { - fprintf(stderr , "Error %s\n", SvPV(GvSV(errgv), na)) ; - } + snprintf( eval_str, EVAL_BUF_SIZE, "%s.pm", c->argv[1] ); + perl_require_pv( eval_str ); #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 + if (SvTRUE(ERRSV)) { + STRLEN len; - SPAGAIN; + 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; - if (count != 1) { - croak("Big trouble in config\n") ; - } + count = call_method("new", G_SCALAR); - perl_back->pb_obj_ref = newSVsv(POPs); + SPAGAIN; - PUTBACK; FREETMPS; LEAVE ; - } + if (count != 1) { + croak("Big trouble in config\n") ; + } - } else if ( strcasecmp( argv[0], "perlModulePath" ) == 0 ) { - if ( argc < 2 ) { - fprintf( stderr, - "%s: line %d: missing module in \"PerlModulePath \" line\n", - fname, lineno ); - return( 1 ); - } + pb->pb_obj_ref = newSVsv(POPs); - 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. */ + PUTBACK; FREETMPS; LEAVE ; + ber_str2bv( c->argv[1], 0, 1, &pb->pb_module_name ); + } + break; - } 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 - */ + 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 rc; +} + +int +perl_back_init_cf( BackendInfo *bi ) +{ + bi->bi_cf_ocs = perlocs; - return 0; + return config_register_schema( perlcfg, perlocs ); } diff --git a/servers/slapd/back-perl/init.c b/servers/slapd/back-perl/init.c index ba3aabdf2a..b421881cea 100644 --- a/servers/slapd/back-perl/init.c +++ b/servers/slapd/back-perl/init.c @@ -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 diff --git a/servers/slapd/back-perl/perl_back.h b/servers/slapd/back-perl/perl_back.h index 3c3960c0b5..e08e70bb95 100644 --- a/servers/slapd/back-perl/perl_back.h +++ b/servers/slapd/back-perl/perl_back.h @@ -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; diff --git a/servers/slapd/back-perl/proto-perl.h b/servers/slapd/back-perl/proto-perl.h index c34fe57127..f0582d8958 100644 --- a/servers/slapd/back-perl/proto-perl.h +++ b/servers/slapd/back-perl/proto-perl.h @@ -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 */ -- 2.39.5