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         int args;
  44         int return_code;
  45
  46
  47         if ( strcasecmp( argv[0], "perlModule" ) == 0 ) {
  48                 if ( argc < 2 ) {
  49                         Debug( LDAP_DEBUG_ANY,
  50                                  "%s.pm: line %d: missing module in \"perlModule <module>\" line\n",
  51                                 fname, lineno, 0 );
  52                         return( 1 );
  53                 }
  54
  55                 strncpy(eval_str, argv[1], EVAL_BUF_SIZE );
  56
  57                 perl_require_pv( strcat( eval_str, ".pm" ));
  58
  59                 if (SvTRUE(GvSV(errgv))) {
  60                         fprintf(stderr , "Error %s\n", SvPV(GvSV(errgv), na)) ;
  61
  62                 } else {
  63                         dSP; ENTER; SAVETMPS;
  64                         PUSHMARK(sp);
  65                         XPUSHs(sv_2mortal(newSVpv(argv[1], 0)));
  66                         PUTBACK;
  67
  68                         count = perl_call_method("new", G_SCALAR);
  69
  70                         SPAGAIN;
  71
  72                         if (count != 1) {
  73                                 croak("Big trouble in config\n") ;
  74                         }
  75
  76                         perl_back->pb_obj_ref = newSVsv(POPs);
  77
  78                         PUTBACK; FREETMPS; LEAVE ;
  79                 }
  80
  81         } else if ( strcasecmp( argv[0], "perlModulePath" ) == 0 ) {
  82                 if ( argc < 2 ) {
  83                         fprintf( stderr,
  84                                 "%s: line %d: missing module in \"PerlModulePath <module>\" line\n",
  85                                 fname, lineno );
  86                         return( 1 );
  87                 }
  88
  89                 sprintf( eval_str, "push @INC, '%s';", argv[1] );
  90                 loc_sv = perl_eval_pv( eval_str, 0 );
  91
  92         } else {
  93                 /*
  94                  * Pass it to Perl module if defined
  95                  */
  96
  97                 {
  98                         dSP ;  ENTER ; SAVETMPS;
  99
 100                         PUSHMARK(sp) ;
 101                         XPUSHs( perl_back->pb_obj_ref );
 102
 103                         /* Put all arguments on the perl stack */
 104                         for( args = 0; args < argc; args++ ) {
 105                                 XPUSHs(sv_2mortal(newSVpv(argv[args], 0)));
 106                         }
 107
 108                         PUTBACK ;
 109
 110                         count = perl_call_method("config", G_SCALAR);
 111
 112                         SPAGAIN ;
 113
 114                         if (count != 1) {
 115                                 croak("Big trouble in config\n") ;
 116                         }
 117
 118                         return_code = POPi;
 119
 120                         PUTBACK ; FREETMPS ;  LEAVE ;
 121
 122                 }
 123
 124                 /* if the module rejected it then we should reject it */
 125                 if ( return_code != 0 ) {
 126                         fprintf( stderr,
 127                                  "Unknown perl backeng config: %s\n", argv[0]);
 128                         exit( EXIT_FAILURE );
 129                 }
 130         }
 131
 132         return 0;
 133 }