From 39e66c09606af51a877a672ba14a87ff984082ae Mon Sep 17 00:00:00 2001 From: Vsevolod Stakhov Date: Fri, 13 Feb 2009 17:03:43 +0300 Subject: [PATCH] * Init perl and do all perl specific operations from the single place in code * Push objects correctly to stack (by blessing them and making hash reference) --- src/main.c | 53 +++----------------------- src/perl.c | 109 ++++++++++++++++++++++++++++++++++++++++++++++------- src/perl.h | 11 ++++++ 3 files changed, 111 insertions(+), 62 deletions(-) diff --git a/src/main.c b/src/main.c index e33d6e8dd..ee41b66dd 100644 --- a/src/main.c +++ b/src/main.c @@ -16,17 +16,13 @@ #endif #include -#include /* from the Perl distribution */ -#include /* from the Perl distribution */ - #include "main.h" #include "cfg_file.h" #include "util.h" +#include "perl.h" /* 2 seconds to fork new process in place of dead one */ #define SOFT_FORK_TIME 2 -/* Perl module init function */ -#define MODULE_INIT_FUNC "module_init" struct config_file *cfg; @@ -41,12 +37,10 @@ sig_atomic_t got_alarm; extern int yynerrs; extern FILE *yyin; -extern void boot_DynaLoader (pTHX_ CV* cv); -extern void boot_Socket (pTHX_ CV* cv); +extern void xs_init(pTHX); + -PerlInterpreter *perl_interpreter; -/* XXX: remove this shit when it would be clear why perl need this line */ -PerlInterpreter *my_perl; +extern PerlInterpreter *perl_interpreter; /* List of workers that are pending to start */ static GList *workers_pending = NULL; @@ -75,43 +69,6 @@ void sig_handler (int signo) } } -void -xs_init(pTHX) -{ - dXSUB_SYS; - /* DynaLoader is a special case */ - newXS ("DynaLoader::boot_DynaLoader", boot_DynaLoader, __FILE__); -} - -static void -init_filters (struct config_file *cfg) -{ - struct perl_module *module; - char *init_func, *class; - size_t funclen; - dSP; - - LIST_FOREACH (module, &cfg->perl_modules, next) { - if (module->path) { - require_pv (module->path); - ENTER; - SAVETMPS; - - PUSHMARK (SP); - XPUSHs (sv_2mortal (newSVpv (class, 0))); - XPUSHs (sv_2mortal (newSViv (PTR2IV (cfg)))); - PUTBACK; - /* Call module init function */ - funclen = strlen (module->path) + sizeof ("::") + sizeof (MODULE_INIT_FUNC) - 1; - init_func = g_malloc (funclen); - snptintf (init_func, funclen, "%s::%s", module->path, MODULE_INIT_FUNC); - call_method (init_func, G_DISCARD); - - FREETMPS; - LEAVE; - } - } -} static struct rspamd_worker * fork_worker (struct rspamd_main *rspamd, int listen_sock, int reconfig, enum process_type type) @@ -333,6 +290,7 @@ main (int argc, char **argv, char **env) init_signals (&signals, sig_handler); /* Init perl interpreter */ + dTHXa (perl_interpreter); PERL_SYS_INIT3 (&argc, &argv, &env); perl_interpreter = perl_alloc (); if (perl_interpreter == NULL) { @@ -340,7 +298,6 @@ main (int argc, char **argv, char **env) exit (-errno); } - my_perl = perl_interpreter; PERL_SET_CONTEXT (perl_interpreter); perl_construct (perl_interpreter); PL_exit_flags |= PERL_EXIT_DESTRUCT_END; diff --git a/src/perl.c b/src/perl.c index 870283835..607516439 100644 --- a/src/perl.c +++ b/src/perl.c @@ -7,26 +7,82 @@ #include -#include /* from the Perl distribution */ -#include /* from the Perl distribution */ - #include "url.h" #include "main.h" #include "perl.h" +#include "cfg_file.h" + +/* Perl module init function */ +#define MODULE_INIT_FUNC "module_init" + +PerlInterpreter *perl_interpreter; + +static HV *rspamd_stash; + +extern void boot_DynaLoader (pTHX_ CV* cv); +extern void boot_Socket (pTHX_ CV* cv); + +void +xs_init(pTHX) +{ + dXSUB_SYS; + /* DynaLoader is a special case */ + newXS ("DynaLoader::boot_DynaLoader", boot_DynaLoader, __FILE__); + + rspamd_stash = gv_stashpv("rspamd", TRUE); +} + +void +init_perl_filters (struct config_file *cfg) +{ + struct perl_module *module; + char *init_func; + size_t funclen; + SV* sv; + + dTHXa (perl_interpreter); + PERL_SET_CONTEXT (perl_interpreter); + + dSP; + LIST_FOREACH (module, &cfg->perl_modules, next) { + if (module->path) { + require_pv (module->path); + ENTER; + SAVETMPS; + + PUSHMARK (SP); + sv = sv_2mortal (sv_bless (newRV_noinc (newSViv (PTR2IV(cfg))), rspamd_stash)); + XPUSHs (sv); + PUTBACK; + /* Call module init function */ + funclen = strlen (module->path) + sizeof ("::") + sizeof (MODULE_INIT_FUNC) - 1; + init_func = g_malloc (funclen); + snprintf (init_func, funclen, "%s::%s", module->path, MODULE_INIT_FUNC); + call_pv (init_func, G_DISCARD); + + FREETMPS; + LEAVE; + } + } +} -extern PerlInterpreter *my_perl; int perl_call_header_filter (const char *function, struct worker_task *task) { int result; - dSP; + SV* sv; + dTHXa (perl_interpreter); + PERL_SET_CONTEXT (perl_interpreter); + + dSP; ENTER; SAVETMPS; PUSHMARK (SP); - XPUSHs (sv_2mortal (newSViv (PTR2IV (task)))); + sv = sv_2mortal (sv_bless (newRV_noinc (newSViv (PTR2IV(task))), rspamd_stash)); + XPUSHs (sv); PUTBACK; call_pv (function, G_SCALAR); @@ -47,13 +103,18 @@ int perl_call_mime_filter (const char *function, struct worker_task *task) { int result; - dSP; + SV *sv; + + dTHXa (perl_interpreter); + PERL_SET_CONTEXT (perl_interpreter); + dSP; ENTER; SAVETMPS; PUSHMARK (SP); - XPUSHs (sv_2mortal (newSViv (PTR2IV (task)))); + sv = sv_2mortal (sv_bless (newRV_noinc (newSViv (PTR2IV(task))), rspamd_stash)); + XPUSHs (sv); PUTBACK; call_pv (function, G_SCALAR); @@ -74,13 +135,18 @@ int perl_call_message_filter (const char *function, struct worker_task *task) { int result; - dSP; + SV *sv; + + dTHXa (perl_interpreter); + PERL_SET_CONTEXT (perl_interpreter); + dSP; ENTER; SAVETMPS; PUSHMARK (SP); - XPUSHs (sv_2mortal (newSViv (PTR2IV (task)))); + sv = sv_2mortal (sv_bless (newRV_noinc (newSViv (PTR2IV(task))), rspamd_stash)); + XPUSHs (sv); PUTBACK; call_pv (function, G_SCALAR); @@ -101,13 +167,18 @@ int perl_call_url_filter (const char *function, struct worker_task *task) { int result; - dSP; + SV *sv; + + dTHXa (perl_interpreter); + PERL_SET_CONTEXT (perl_interpreter); + dSP; ENTER; SAVETMPS; PUSHMARK (SP); - XPUSHs (sv_2mortal (newSViv (PTR2IV (task)))); + sv = sv_2mortal (sv_bless (newRV_noinc (newSViv (PTR2IV(task))), rspamd_stash)); + XPUSHs (sv); PUTBACK; call_pv (function, G_SCALAR); @@ -129,6 +200,10 @@ perl_call_chain_filter (const char *function, struct worker_task *task, int *mar { int result, i; AV *av; + SV *sv; + + dTHXa (perl_interpreter); + PERL_SET_CONTEXT (perl_interpreter); dSP; @@ -140,7 +215,8 @@ perl_call_chain_filter (const char *function, struct worker_task *task, int *mar av_push (av, sv_2mortal (newSViv (marks[i]))); } PUSHMARK (SP); - XPUSHs (sv_2mortal (newSViv (PTR2IV (task)))); + sv = sv_2mortal (sv_bless (newRV_noinc (newSViv (PTR2IV(task))), rspamd_stash)); + XPUSHs (sv); XPUSHs (sv_2mortal ((SV *)AvARRAY (av))); PUTBACK; @@ -166,13 +242,18 @@ void perl_call_memcached_callback (memcached_ctx_t *ctx, memc_error_t error, voi SV *callback; struct worker_task *task; } *callback_data = data; + SV *sv; + dTHXa (perl_interpreter); + PERL_SET_CONTEXT (perl_interpreter); + dSP; ENTER; SAVETMPS; PUSHMARK (SP); - XPUSHs (sv_2mortal (newSViv (PTR2IV (callback_data->task)))); + sv = sv_2mortal (sv_bless (newRV_noinc (newSViv (PTR2IV(callback_data->task))), rspamd_stash)); + XPUSHs (sv); XPUSHs (sv_2mortal (newSViv (error))); XPUSHs (sv_2mortal (newSVpv (ctx->param->buf, ctx->param->bufsize))); PUTBACK; diff --git a/src/perl.h b/src/perl.h index 9a37634e3..7aabe1895 100644 --- a/src/perl.h +++ b/src/perl.h @@ -5,8 +5,19 @@ #include #include "memcached.h" +#include /* from the Perl distribution */ +#include /* from the Perl distribution */ + +#ifndef PERL_IMPLICIT_CONTEXT +#undef dTHXa +#define dTHXa(a) +#endif + struct uri; struct worker_task; +struct config_file; + +void init_perl_filters (struct config_file *cfg); int perl_call_header_filter (const char *function, struct worker_task *task); int perl_call_mime_filter (const char *function, struct worker_task *task); -- 2.39.5