git.sur5r.net Git - openldap/blob - servers/slapd/back-perl/config.c

   1 /*
   2  *       Copyright 1999, John C. Quillan, All rights reserved.
   3  *
   4  *       Redistribution and use in source and binary forms are permitted only
   5  *       as authorized by the OpenLDAP Public License.  A copy of this
   6  *       license is available at http://www.OpenLDAP.org/license.html or
   7  *       in file LICENSE in the top-level directory of the distribution.
   8  */
   9
  10 #include "portable.h"
  11 /* init.c - initialize shell backend */
  12
  13 #include <stdio.h>
  14 /*      #include <ac/types.h>
  15         #include <ac/socket.h>
  16 */
  17
  18 #include <EXTERN.h>
  19 #include <perl.h>
  20
  21 #include "slap.h"
  22 #include "perl_back.h"
  23
  24
  25 /**********************************************************
  26  *
  27  * Config
  28  *
  29  **********************************************************/
  30 int
  31 perl_back_db_config(
  32          BackendDB *be,
  33          char *fname,
  34          int lineno,
  35          int argc,
  36          char **argv
  37 )
  38 {
  39         SV* loc_sv;
  40         PerlBackend *perl_back = (PerlBackend *) be->be_private;
  41         char eval_str[EVAL_BUF_SIZE];
  42         int count ;
  43
  44         /***** SECURITY PROBLEM HERE FIX LATER *****/
  45
  46         if ( strcasecmp( argv[0], "perlModule" ) == 0 ) {
  47                 if ( argc < 2 ) {
  48                         Debug( LDAP_DEBUG_ANY,
  49                                  "%s.pm: line %d: missing module in \"perlModule <module>\" line\n",
  50                                 fname, lineno, 0 );
  51                         return( 1 );
  52                 }
  53
  54                 strncpy(eval_str, argv[1], EVAL_BUF_SIZE );
  55
  56                 perl_require_pv( strcat( eval_str, ".pm" ));
  57
  58                 if (SvTRUE(GvSV(errgv))) {
  59                         fprintf(stderr , "Error %s\n", SvPV(GvSV(errgv), na)) ;
  60
  61                 } else {
  62                         dSP; ENTER; SAVETMPS;
  63                         PUSHMARK(sp);
  64                         XPUSHs(sv_2mortal(newSVpv(argv[1], 0)));
  65                         PUTBACK;
  66
  67                         count = perl_call_method("new", G_SCALAR);
  68
  69                         SPAGAIN;
  70
  71                         if (count != 1) {
  72                                 croak("Big trouble in config\n") ;
  73                         }
  74
  75                         perl_back->pb_obj_ref = newSVsv(POPs);
  76
  77                         PUTBACK; FREETMPS; LEAVE ;
  78                 }
  79
  80         } else if ( strcasecmp( argv[0], "perlModulePath" ) == 0 ) {
  81                 if ( argc < 2 ) {
  82                         fprintf( stderr,
  83                                 "%s: line %d: missing module in \"PerlModulePath <module>\" line\n",
  84                                 fname, lineno );
  85                         return( 1 );
  86                 }
  87
  88                 sprintf( eval_str, "push @INC, '%s';", argv[1] );
  89                 loc_sv = perl_eval_pv( eval_str, 0 );
  90
  91         } else {
  92                 /*
  93                  * Pass it to Perl module if defined
  94                  */
  95
  96                 fprintf( stderr,
  97                         "Unknown perl backend config: %s\n", argv[0]);
  98                 return( 1 );
  99         }
 100
 101         return 0;
 102 }