Polled from branch_1_1 fix for bug #348

[freeradius.git] / src / modules / rlm_perl / rlm_perl.c

diff --git a/src/modules/rlm_perl/rlm_perl.c b/src/modules/rlm_perl/rlm_perl.c
index ac6733f..1b6041d 100644 (file)
--- a/src/modules/rlm_perl/rlm_perl.c
+++ b/src/modules/rlm_perl/rlm_perl.c
@@ -15,22 +15,21 @@
  *
  *   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
@@ -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"},
@@ -170,13 +169,13 @@ EXTERN_C void boot_DynaLoader(pTHX_ CV* 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 */
@@ -257,7 +256,7 @@ static void rlm_perl_close_handles(void **handles)
 static PerlInterpreter *rlm_perl_clone(PerlInterpreter *perl)
 {
        PerlInterpreter *clone;
-       UV      clone_flags = 0;
+       UV clone_flags = 0;
 
        PERL_SET_CONTEXT(perl);
 
@@ -554,6 +553,7 @@ static int init_pool (CONF_SECTION *conf, PERL_INST *inst) {
        int t;
        PERL_POOL       *pool;
 
+
        pool = rad_malloc(sizeof(PERL_POOL));
        memset(pool,0,sizeof(PERL_POOL));
 
@@ -580,30 +580,6 @@ static int init_pool (CONF_SECTION *conf, PERL_INST *inst) {
        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)
 {
@@ -746,7 +722,8 @@ static int perl_instantiate(CONF_SECTION *conf, void **instance)
        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;
 
        /*
@@ -778,6 +755,16 @@ static int perl_instantiate(CONF_SECTION *conf, void **instance)
        }
 
 #ifdef USE_ITHREADS
+       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);
@@ -1183,7 +1170,7 @@ static int perl_post_auth(void *instance, REQUEST *request)
 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;
@@ -1303,24 +1290,23 @@ static int perl_detach(void *instance)
  *     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 */
 };