/*
* $Id: perl.c 2164 2007-05-08 07:30:16Z bastian $
*
* Perl module for OpenSER
*
* Copyright (C) 2006 Collax GmbH
* (Bastian Friedrich <bastian.friedrich@collax.com>)
*
* This file is part of openser, a free SIP server.
*
* openser is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version
*
* openser is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* 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
*
*/
#define DEFAULTMODULE "OpenSER"
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <dlfcn.h>
#include "../../sr_module.h"
#include "../../mem/mem.h"
#include "../../mi/mi.h"
#include "../rr/api.h"
#include "../sl/sl_api.h"
/* lock_ops.h defines union semun, perl does not need to redefine it */
#ifdef USE_SYSV_SEM
# define HAS_UNION_SEMUN
#endif
#include "perlfunc.h"
#include "perl.h"
/* #include "perlxsi.h" function is in here... */
MODULE_VERSION
/* Full path to the script including executed functions */
char *filename = NULL;
/* Path to an arbitrary directory where the OpenSER Perl modules are
* installed */
char *modpath = NULL;
/* Allow unsafe module functions - functions with fixups. This will create
* memory leaks, the variable thus is not documented! */
int unsafemodfnc = 0;
/* Reference to the running Perl interpreter instance */
PerlInterpreter *my_perl = NULL;
/** SL binds */
struct sl_binds slb;
/*
* Module destroy function prototype
*/
static void destroy(void);
/*
* Module child-init function prototype
*/
static int child_init(int rank);
/*
* Module initialization function prototype
*/
static int mod_init(void);
/*
* Reload perl interpreter - reload perl script. Forward declaration.
*/
struct mi_root* perl_mi_reload(struct mi_root *cmd_tree, void *param);
/*
* Exported functions
*/
static cmd_export_t cmds[] = {
{ "perl_exec_simple", perl_exec_simple1, 1, NULL, REQUEST_ROUTE
| FAILURE_ROUTE
| ONREPLY_ROUTE
| BRANCH_ROUTE },
{ "perl_exec_simple", perl_exec_simple2, 2, NULL, REQUEST_ROUTE
| FAILURE_ROUTE
| ONREPLY_ROUTE
| BRANCH_ROUTE },
{ "perl_exec", perl_exec1, 1, NULL, REQUEST_ROUTE | FAILURE_ROUTE
| ONREPLY_ROUTE | BRANCH_ROUTE },
{ "perl_exec", perl_exec2, 2, NULL, REQUEST_ROUTE | FAILURE_ROUTE
| ONREPLY_ROUTE | BRANCH_ROUTE },
{ 0, 0, 0, 0, 0 }
};
/*
* Exported parameters
*/
static param_export_t params[] = {
{"filename", STR_PARAM, &filename},
{"modpath", STR_PARAM, &modpath},
{"unsafemodfnc", INT_PARAM, &unsafemodfnc},
{ 0, 0, 0 }
};
/*
* Exported MI functions
*/
static mi_export_t mi_cmds[] = {
/* FIXME This does not yet work...
{ "perl_reload", perl_mi_reload, MI_NO_INPUT_FLAG, 0, 0 },*/
{ 0, 0, 0, 0}
};
/*
* Module info
*/
#ifndef RTLD_NOW
/* for openbsd */
#define RTLD_NOW DL_LAZY
#endif
#ifndef RTLD_GLOBAL
/* Unsupported! */
#define RTLD_GLOBAL 0
#endif
/*
* Module interface
*/
struct module_exports exports = {
"perl",
RTLD_NOW | RTLD_GLOBAL,
cmds, /* Exported functions */
params, /* Exported parameters */
0, /* exported statistics */
mi_cmds, /* exported MI functions */
0, /* exported pseudo-variables */
mod_init, /* module initialization function */
0, /* response function */
destroy, /* destroy function */
child_init /* child initialization function */
};
static int child_init(int rank)
{
return 0;
}
EXTERN_C void boot_DynaLoader (pTHX_ CV* cv);
EXTERN_C void boot_OpenSER(pTHX_ CV* cv);
/*
* This is output by perl -MExtUtils::Embed -e xsinit
* and complemented by the OpenSER bootstrapping
*/
EXTERN_C void xs_init(pTHX) {
char *file = __FILE__;
dXSUB_SYS;
newXS("OpenSER::bootstrap", boot_OpenSER, file);
newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
}
/*
* Initialize the perl interpreter.
* This might later be used to reinit the module.
*/
PerlInterpreter *parser_init() {
int argc = 0;
char *argv[9];
PerlInterpreter *new_perl = NULL;
int modpathset = 0;
new_perl = perl_alloc();
if (!new_perl) {
LOG(L_ERR, "Could not allocate perl.\n");
return NULL;
}
perl_construct(new_perl);
argv[0] = ""; argc++; /* First param _needs_ to be empty */
/* Possible Include path extension by modparam */
if (modpath && (strlen(modpath) > 0)) {
modpathset = argc;
LOG(L_INFO, "perl: Setting lib path: '%s'\n", modpath);
argv[argc] = pkg_malloc(strlen(modpath)+20);
sprintf(argv[argc], "-I%s", modpath);
argc++;
}
argv[argc] = "-M"DEFAULTMODULE; argc++; /* Always "use" Openser.pm */
argv[argc] = filename; /* The script itself */
argc++;
if (perl_parse(new_perl, xs_init, argc, argv, NULL)) {
LOG(L_ERR, "Error loading perl file \"%s\".\n", argv[argc-1]);
if (modpathset) pkg_free(argv[modpathset]);
return NULL;
} else {
LOG(L_INFO, "perl: Successfully loaded perl file \"%s\"\n",
argv[argc-1]);
}
if (modpathset) pkg_free(argv[modpathset]);
perl_run(new_perl);
return new_perl;
}
/*
*
*/
int unload_perl(PerlInterpreter *p) {
perl_destruct(p);
perl_free(p);
return 0;
}
/*
* reload function.
* Reinitializes the interpreter. Works, but execution for _all_
* children is difficult.
*/
int perl_reload(struct sip_msg *m, char *a, char *b) {
PerlInterpreter *new_perl;
new_perl = parser_init();
if (new_perl) {
unload_perl(my_perl);
my_perl = new_perl;
#ifdef PERL_EXIT_DESTRUCT_END
PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
#else
#warning Perl 5.8.x should be used. Please upgrade.
#warning This binary will be unsupported.
PL_exit_flags |= PERL_EXIT_EXPECTED;
#endif
return 1;
} else {
return 0;
}
}
/*
* Reinit through fifo.
* Currently does not seem to work :((
*/
struct mi_root* perl_mi_reload(struct mi_root *cmd_tree, void *param)
{
if (perl_reload(NULL, NULL, NULL)) {
return init_mi_tree( 200, MI_OK_S, MI_OK_LEN);
} else {
return init_mi_tree( 500, "Perl reload failed", 18);
}
}
/*
* mod_init
* Called by openser at init time
*/
static int mod_init() {
int ret = 0;
LOG(L_INFO, "perl module - initializing\n");
if (!filename) {
LOG(L_ERR, "Insufficient module parameters."
" Module not loaded.\n");
return -1;
}
/**
* We will need sl_send_reply from stateless
* module for sending replies
*/
/* load the SL API */
if (load_sl_api(&slb)!=0) {
LOG(L_ERR, "ERROR:perl:mod_init: can't load SL API\n");
return -1;
}
PERL_SYS_INIT3(&argc, &argv, &environ);
if ((my_perl = parser_init())) {
ret = 0;
#ifdef PERL_EXIT_DESTRUCT_END
PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
#else
PL_exit_flags |= PERL_EXIT_EXPECTED;
#endif
} else {
ret = -1;
}
return ret;
}
/*
* destroy
* called by openser at exit time
*/
static void destroy(void)
{
if(my_perl==NULL)
return;
unload_perl(my_perl);
PERL_SYS_TERM();
my_perl = NULL;
}
syntax highlighted by Code2HTML, v. 0.9.1