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