Back to index

openldap  2.4.31
Enumerations | Functions | Variables
config.c File Reference
#include "perl_back.h"
#include "../config.h"

Go to the source code of this file.

Enumerations

enum  { PERL_MODULE = 1, PERL_PATH, PERL_CONFIG }

Functions

int perl_back_db_config (BackendDB *be, const char *fname, int lineno, int argc, char **argv)
static int perl_cf (ConfigArgs *c)
int perl_back_init_cf (BackendInfo *bi)

Variables

static ConfigDriver perl_cf
static ConfigTable perlcfg []
static ConfigOCs perlocs []
static ConfigOCs ovperlocs []

Enumeration Type Documentation

anonymous enum
Enumerator:
PERL_MODULE 
PERL_PATH 
PERL_CONFIG 

Definition at line 23 of file config.c.


Function Documentation

int perl_back_db_config ( BackendDB be,
const char *  fname,
int  lineno,
int  argc,
char **  argv 
)

Definition at line 84 of file config.c.

{
       int rc = config_generic_wrapper( be, fname, lineno, argc, argv );
       /* backward compatibility: map unknown directives to perlModuleConfig */
       if ( rc == SLAP_CONF_UNKNOWN ) {
              char **av = ch_malloc( (argc+2) * sizeof(char *));
              int i;
              av[0] = "perlModuleConfig";
              av++;
              for ( i=0; i<argc; i++ )
                     av[i] = argv[i];
              av[i] = NULL;
              av--;
              rc = config_generic_wrapper( be, fname, lineno, argc+1, av );
              ch_free( av );
       }
       return rc;
}

Here is the call graph for this function:

Definition at line 247 of file config.c.

Here is the call graph for this function:

Here is the caller graph for this function:

static int perl_cf ( ConfigArgs c) [static]

Definition at line 110 of file config.c.

{
       PerlBackend *pb = (PerlBackend *) c->be->be_private;
       SV* loc_sv;
       int count ;
       int args;
       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 ( !pb->pb_module_name )
                            return 1;
                     c->value_string = ch_strdup( 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;
              }
       } 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 );
                     pb->pb_module_name = NULL;
                     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:
                     snprintf( eval_str, EVAL_BUF_SIZE, "use %s;", c->argv[1] );
                     eval_pv( eval_str, 0 );

                     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 ;
                            pb->pb_module_name = ch_strdup( c->argv[1] );
                     }
                     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( pb->pb_obj_ref );

                     /* Put all arguments on the perl stack */
                     for( args = 1; args < c->argc; args++ ) {
                            XPUSHs(sv_2mortal(newSVpv(c->argv[args], 0)));
                     }

                     PUTBACK ;

                     count = call_method("config", G_SCALAR);

                     SPAGAIN ;

                     if (count != 1) {
                            croak("Big trouble in config\n") ;
                     }

                     rc = POPi;

                     PUTBACK ; FREETMPS ;  LEAVE ;
                     }
                     break;
              }
       }
       return rc;
}

Here is the call graph for this function:


Variable Documentation

ConfigOCs ovperlocs[] [static]
Initial value:
 {
       { "( OLcfgDbOc:11.2 "
              "NAME 'olcovPerlConfig' "
              "DESC 'Perl overlay configuration' "
              "SUP olcOverlayConfig "
              "MUST ( olcPerlModulePath $ olcPerlModule ) "
              "MAY ( olcPerlFilterSearchResults $ olcPerlModuleConfig ) )",
                     Cft_Overlay, perlcfg, NULL, NULL },
       { NULL }
}

Definition at line 67 of file config.c.

Definition at line 21 of file config.c.

ConfigTable perlcfg[] [static]
Initial value:
 {
       { "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_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_MAGIC|PERL_CONFIG, perl_cf, 
              "( OLcfgDbAt:11.4 NAME 'olcPerlModuleConfig' "
                     "DESC 'Perl module config directives' "
                     "EQUALITY caseExactMatch "
                     "SYNTAX OMsDirectoryString )", NULL, NULL },
       { NULL }
}

Definition at line 29 of file config.c.

ConfigOCs perlocs[] [static]
Initial value:
 {
       { "( OLcfgDbOc:11.1 "
              "NAME 'olcDbPerlConfig' "
              "DESC 'Perl DB configuration' "
              "SUP olcDatabaseConfig "
              "MUST ( olcPerlModulePath $ olcPerlModule ) "
              "MAY ( olcPerlFilterSearchResults $ olcPerlModuleConfig ) )",
                     Cft_Database, perlcfg, NULL, NULL },
       { NULL }
}

Definition at line 56 of file config.c.