Polled from branch_1_1 fix for bug #348
authorbjordanov <bjordanov>
Mon, 20 Mar 2006 08:45:52 +0000 (08:45 +0000)
committerbjordanov <bjordanov>
Mon, 20 Mar 2006 08:45:52 +0000 (08:45 +0000)
1  2 
src/modules/rlm_perl/rlm_perl.c

   *
   *   You should have received a copy of the GNU General Public License
   *   along with this program; if not, write to the Free Software
 - *   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 + *   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA
   *
   * Copyright 2002  The FreeRADIUS server project
   * Copyright 2002  Boian Jordanov <bjordanov@orbitel.bg>
   */
  
 -#include "autoconf.h"
 -#include "libradius.h"
 +#include <freeradius-devel/autoconf.h>
  
  #include <stdio.h>
  #include <stdlib.h>
  #include <string.h>
  
 -#include "radiusd.h"
 -#include "modules.h"
 -#include "conffile.h"
 +#include <freeradius-devel/radiusd.h>
 +#include <freeradius-devel/modules.h>
 +#include <freeradius-devel/conffile.h>
  
  #ifdef DEBUG
  #undef DEBUG
@@@ -126,7 -127,7 +126,7 @@@ typedef struct perl_inst 
   *    buffer over-flows.
   */
  static const CONF_PARSER module_config[] = {
 -      { "module",  PW_TYPE_STRING_PTR,
 +      { "module",  PW_TYPE_FILENAME,
          offsetof(PERL_INST,module), NULL,  "module"},
        { "func_authorize", PW_TYPE_STRING_PTR,
          offsetof(PERL_INST,func_authorize), NULL, "authorize"},
@@@ -169,13 -170,13 +169,13 @@@ EXTERN_C void boot_DynaLoader(pTHX_ CV
   *    We clone it for every instance if we have perl
   *    with -Duseithreads compiled in
   */
 -static PerlInterpreter        *interp;
 +static PerlInterpreter        *interp = NULL;
  
  static const CONF_PARSER pool_conf[] = {
        { "max_clones", PW_TYPE_INTEGER, offsetof(PERL_POOL, max_clones), NULL,         "32"},
 -      { "start_clones",PW_TYPE_INTEGER, offsetof(PERL_POOL, start_clones), NULL,              "5"},
 -      { "min_spare_clones",PW_TYPE_INTEGER, offsetof(PERL_POOL, min_spare_clones),NULL,       "3"},
 -      { "max_spare_clones",PW_TYPE_INTEGER, offsetof(PERL_POOL,max_spare_clones),NULL,        "3"},
 +      { "start_clones",PW_TYPE_INTEGER, offsetof(PERL_POOL, start_clones), NULL,              "32"},
 +      { "min_spare_clones",PW_TYPE_INTEGER, offsetof(PERL_POOL, min_spare_clones),NULL,       "0"},
 +      { "max_spare_clones",PW_TYPE_INTEGER, offsetof(PERL_POOL,max_spare_clones),NULL,        "32"},
        { "cleanup_delay",PW_TYPE_INTEGER, offsetof(PERL_POOL,cleanup_delay),NULL,              "5"},
        { "max_request_per_clone",PW_TYPE_INTEGER, offsetof(PERL_POOL,max_request_per_clone),NULL,      "0"},
        { NULL, -1, 0, NULL, NULL }             /* end the list */
@@@ -256,7 -257,7 +256,7 @@@ static void rlm_perl_close_handles(voi
  static PerlInterpreter *rlm_perl_clone(PerlInterpreter *perl)
  {
        PerlInterpreter *clone;
 -      UV      clone_flags = 0;
 +      UV clone_flags = 0;
  
        PERL_SET_CONTEXT(perl);
  
@@@ -553,7 -554,6 +553,7 @@@ static int init_pool (CONF_SECTION *con
        int t;
        PERL_POOL       *pool;
  
 +
        pool = rad_malloc(sizeof(PERL_POOL));
        memset(pool,0,sizeof(PERL_POOL));
  
        return 1;
  }
  #endif
 -/*
 - *    Do any per-module initialization.  e.g. set up connections
 - *    to external databases, read configuration files, set up
 - *    dictionary entries, etc.
 - *
 - *    Try to avoid putting too much stuff in here - it's better to
 - *    do it in instantiate() where it is not global.
 - *    I use one global interpetator to make things more fastest for
 - *    Threading env I clone new perl from this interp.
 - */
 -static int perl_init(void)
 -{
 -#ifdef USE_ITHREADS
 -      if ((interp = perl_alloc()) == NULL) {
 -              radlog(L_DBG, "rlm_perl: No memory for allocating new perl !");
 -              return -1;
 -      }
 -
 -      perl_construct(interp);
 -      PL_perl_destruct_level = 2;
 -#endif
 -      return 0;
 -
 -}
  
  static void xs_init(pTHX)
  {
@@@ -722,8 -746,7 +722,8 @@@ static int perl_instantiate(CONF_SECTIO
        HV              *rad_request_proxy_reply_hv;
        AV              *end_AV;
  
 -      char *embed[4], *xlat_name;
 +      char *embed[4];
 +      const char *xlat_name;
        int exitstatus = 0, argc=0;
  
        /*
        }
  
  #ifdef USE_ITHREADS
-       inst->perl = perl_clone(interp ,CLONEf_KEEP_PTR_TABLE);
 +      if (!interp) {
 +              if ((interp = perl_alloc()) == NULL) {
 +                      radlog(L_DBG, "rlm_perl: No memory for allocating new perl !");
 +                      return -1;
 +              }
 +              
 +              perl_construct(interp);
 +              PL_perl_destruct_level = 2;
 +      }
 +
+       inst->perl = interp;
        {
        dTHXa(inst->perl);
        }
@@@ -1170,7 -1183,7 +1170,7 @@@ static int perl_post_auth(void *instanc
  static int perl_detach(void *instance)
  {
        PERL_INST       *inst = (PERL_INST *) instance;
 -      int             exitstatus=0,count=0;
 +      int             exitstatus = 0, count = 0;
  
  #ifdef USE_ITHREADS
        POOL_HANDLE     *handle, *tmp, *tmp2;
   *    is single-threaded.
   */
  module_t rlm_perl = {
 +      RLM_MODULE_INIT,
        "perl",                         /* Name */
  #ifdef USE_ITHREADS
        RLM_TYPE_THREAD_SAFE,           /* type */
  #else
        RLM_TYPE_THREAD_UNSAFE,
  #endif
 -      perl_init,                      /* initialization */
        perl_instantiate,               /* instantiation */
 +      perl_detach,                    /* detach */
        {
 -              perl_authenticate,
 -              perl_authorize,
 -              perl_preacct,
 -              perl_accounting,
 +              perl_authenticate,      /* authenticate */
 +              perl_authorize,         /* authorize */
 +              perl_preacct,           /* preacct */
 +              perl_accounting,        /* accounting */
                perl_checksimul,        /* check simul */
 -              perl_pre_proxy,  /* pre-proxy */
 +              perl_pre_proxy,         /* pre-proxy */
                perl_post_proxy,        /* post-proxy */
 -              perl_post_auth    /* post-auth */
 +              perl_post_auth          /* post-auth */
        },
 -      perl_detach,                    /* detach */
 -      NULL,                           /* destroy */
  };