]> 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 c2e4298e676f1c1f4857aaab36911da6a49ae671..f68a0a1282d380df62fe23a2b1c669c07a98aabd 100644 (file)
@@ -1,3 +1,4 @@
+/* $OpenLDAP$ */
 /*
  *      Copyright 1999, John C. Quillan, All rights reserved.
  *
@@ -30,7 +31,7 @@
 int
 perl_back_db_config(
         BackendDB *be,
-        char *fname,
+        const char *fname,
         int lineno,
         int argc,
         char **argv
@@ -40,8 +41,9 @@ perl_back_db_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 ) {
@@ -65,7 +67,7 @@ perl_back_db_config(
                        PUTBACK;
 
                        count = perl_call_method("new", G_SCALAR);
-
+                       
                        SPAGAIN;
 
                        if (count != 1) {
@@ -93,9 +95,39 @@ perl_back_db_config(
                 * Pass it to Perl module if defined
                 */
 
-               fprintf( stderr,
-                       "Unknown perl backend config: %s\n", argv[0]);
-               return( 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;