1 /* $OpenLDAP: pkg/ldap/servers/slapd/back-perl/config.c,v 1.22.2.3 2008/02/11 23:26:47 kurt Exp $ */ 2 /* This work is part of OpenLDAP Software <http://www.openldap.org/>. 3 * 4 * Copyright 1999-2008 The OpenLDAP Foundation. 5 * Portions Copyright 1999 John C. Quillan. 6 * Portions Copyright 2002 myinternet Limited. 7 * All rights reserved. 8 * 9 * Redistribution and use in source and binary forms, with or without 10 * modification, are permitted only as authorized by the OpenLDAP 11 * Public License. 12 * 13 * A copy of this license is available in file LICENSE in the 14 * top-level directory of the distribution or, alternatively, at 15 * <http://www.OpenLDAP.org/license.html>. 16 */ 17 18 #include "perl_back.h" 19 20 21 /********************************************************** 22 * 23 * Config 24 * 25 **********************************************************/ 26 int 27 perl_back_db_config( 28 BackendDB *be, 29 const char *fname, 30 int lineno, 31 int argc, 32 char **argv 33 ) 34 { 35 SV* loc_sv; 36 PerlBackend *perl_back = (PerlBackend *) be->be_private; 37 char eval_str[EVAL_BUF_SIZE]; 38 int count ; 39 int args; 40 int return_code; 41 42 43 if ( strcasecmp( argv[0], "perlModule" ) == 0 ) { 44 if ( argc < 2 ) { 45 Debug( LDAP_DEBUG_ANY, 46 "%s.pm: line %d: missing module in \"perlModule <module>\" line\n", 47 fname, lineno, 0 ); 48 return( 1 ); 49 } 50 51 #ifdef PERL_IS_5_6 52 snprintf( eval_str, EVAL_BUF_SIZE, "use %s;", argv[1] ); 53 eval_pv( eval_str, 0 ); 54 55 if (SvTRUE(ERRSV)) { 56 STRLEN n_a; 57 58 fprintf(stderr , "Error %s\n", SvPV(ERRSV, n_a)) ; 59 } 60 #else 61 snprintf( eval_str, EVAL_BUF_SIZE, "%s.pm", argv[1] ); 62 perl_require_pv( eval_str ); 63 64 if (SvTRUE(GvSV(errgv))) { 65 fprintf(stderr , "Error %s\n", SvPV(GvSV(errgv), na)) ; 66 } 67 #endif /* PERL_IS_5_6 */ 68 else { 69 dSP; ENTER; SAVETMPS; 70 PUSHMARK(sp); 71 XPUSHs(sv_2mortal(newSVpv(argv[1], 0))); 72 PUTBACK; 73 74 #ifdef PERL_IS_5_6 75 count = call_method("new", G_SCALAR); 76 #else 77 count = perl_call_method("new", G_SCALAR); 78 #endif 79 80 SPAGAIN; 81 82 if (count != 1) { 83 croak("Big trouble in config\n") ; 84 } 85 86 perl_back->pb_obj_ref = newSVsv(POPs); 87 88 PUTBACK; FREETMPS; LEAVE ; 89 } 90 91 } else if ( strcasecmp( argv[0], "perlModulePath" ) == 0 ) { 92 if ( argc < 2 ) { 93 fprintf( stderr, 94 "%s: line %d: missing module in \"PerlModulePath <module>\" line\n", 95 fname, lineno ); 96 return( 1 ); 97 } 98 99 snprintf( eval_str, EVAL_BUF_SIZE, "push @INC, '%s';", argv[1] ); 100 #ifdef PERL_IS_5_6 101 loc_sv = eval_pv( eval_str, 0 ); 102 #else 103 loc_sv = perl_eval_pv( eval_str, 0 ); 104 #endif 105 106 /* XXX loc_sv return value is ignored. */ 107 108 } else if ( strcasecmp( argv[0], "filterSearchResults" ) == 0 ) { 109 perl_back->pb_filter_search_results = 1; 110 } else { 111 return_code = SLAP_CONF_UNKNOWN; 112 /* 113 * Pass it to Perl module if defined 114 */ 115 116 { 117 dSP ; ENTER ; SAVETMPS; 118 119 PUSHMARK(sp) ; 120 XPUSHs( perl_back->pb_obj_ref ); 121 122 /* Put all arguments on the perl stack */ 123 for( args = 0; args < argc; args++ ) { 124 XPUSHs(sv_2mortal(newSVpv(argv[args], 0))); 125 } 126 127 PUTBACK ; 128 129 #ifdef PERL_IS_5_6 130 count = call_method("config", G_SCALAR); 131 #else 132 count = perl_call_method("config", G_SCALAR); 133 #endif 134 135 SPAGAIN ; 136 137 if (count != 1) { 138 croak("Big trouble in config\n") ; 139 } 140 141 return_code = POPi; 142 143 PUTBACK ; FREETMPS ; LEAVE ; 144 145 } 146 147 return return_code; 148 } 149 150 return 0; 151 } 152