]> git.sur5r.net Git - openldap/blobdiff - servers/slapd/back-perl/config.c
Add a default case with assert() just in case.
[openldap] / servers / slapd / back-perl / config.c
index 1ac51024f93dddf26ff5f25e7176280d1f3b742d..f68a0a1282d380df62fe23a2b1c669c07a98aabd 100644 (file)
@@ -1,3 +1,4 @@
+/* $OpenLDAP$ */
 /*
  *      Copyright 1999, John C. Quillan, All rights reserved.
  *
  * Config
  *
  **********************************************************/
-void
-perl_back_config(
-        Backend *be,
-        char *fname,
+int
+perl_back_db_config(
+        BackendDB *be,
+        const char *fname,
         int lineno,
         int argc,
         char **argv
@@ -40,15 +41,16 @@ perl_back_config(
        PerlBackend *perl_back = (PerlBackend *) be->be_private;
        char eval_str[EVAL_BUF_SIZE];
        int count ;
-
-       /***** SECURITY PROBLEM HERE FIX LATER *****/
+       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 <module>\" line\n",
                                fname, lineno, 0 );
-                       exit( 1 );
+                       return( 1 );
                }
 
                strncpy(eval_str, argv[1], EVAL_BUF_SIZE );
@@ -65,7 +67,7 @@ perl_back_config(
                        PUTBACK;
 
                        count = perl_call_method("new", G_SCALAR);
-
+                       
                        SPAGAIN;
 
                        if (count != 1) {
@@ -82,7 +84,7 @@ perl_back_config(
                        fprintf( stderr,
                                "%s: line %d: missing module in \"PerlModulePath <module>\" line\n",
                                fname, lineno );
-                       exit( 1 );
+                       return( 1 );
                }
 
                sprintf( eval_str, "push @INC, '%s';", argv[1] );
@@ -93,8 +95,40 @@ perl_back_config(
                 * Pass it to Perl module if defined
                 */
 
-               fprintf( stderr,
-                       "Unknown perl backeng config: %s\n", argv[0]);
-               exit( 1 );
+               {
+                       dSP ;  ENTER ; SAVETMPS;
+
+                       PUSHMARK(sp) ;
+                       XPUSHs( perl_back->pb_obj_ref );
+
+                       /* Put all arguments on the perl stack */
+                       for( args = 0; args < argc; args++ ) {
+                               XPUSHs(sv_2mortal(newSVpv(argv[args], 0)));
+                       }
+
+                       PUTBACK ;
+
+                       count = perl_call_method("config", G_SCALAR);
+
+                       SPAGAIN ;
+
+                       if (count != 1) {
+                               croak("Big trouble in config\n") ;
+                       }
+
+                       return_code = POPi;
+
+                       PUTBACK ; FREETMPS ;  LEAVE ;
+
+               }
+
+               /* if the module rejected it then we should reject it */
+               if ( return_code != 0 ) {
+                       fprintf( stderr,
+                                "Unknown perl backeng config: %s\n", argv[0]);
+                       exit( EXIT_FAILURE );
+               }
        }
+
+       return 0;
 }