The following is a tentative patch, just to check whether I'm on the right
direction. It implements:
- PerlPassEnv (server wide)
? should it be in .htaccess as well?
- PerlSetEnv (server wide and dir)
- .htaccess is missing.
+ a simple test
I'm not sure how to test PerlPassEnv, since I cannot rely on any known env
var set ahead. Where would it be a good place to set it, before the server
starts? (has to be done like ulimit setting, but this should be specific
for mod_perl and not hardcoded in Apache-Test.
Comments are welcome
I also have a question regarding apr_table_t. When creating the table with
apr_table_make one has to specify nelts. But then it grows automatically
as required (right?), so what's the point of nelts then? pre-alloc? In any
case what netls should I use for env vars table? I've used 2.
Index: Apache-Test/lib/Apache/TestConfig.pm
===================================================================
RCS file: /home/cvs/httpd-test/perl-framework/Apache-Test/lib/Apache/TestConfig.pm,v
retrieving revision 1.50
diff -u -r1.50 TestConfig.pm
--- Apache-Test/lib/Apache/TestConfig.pm 2001/08/28 16:02:56 1.50
+++ Apache-Test/lib/Apache/TestConfig.pm 2001/09/04 11:10:42
@@ -983,3 +983,6 @@
#and some big ones
Alias /getfiles-binary-httpd @httpd@
Alias /getfiles-binary-perl @perl@
+
+PerlPassEnv HOME PERL5LIB
+
Index: src/modules/perl/mod_perl.c
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/mod_perl.c,v
retrieving revision 1.63
diff -u -r1.63 mod_perl.c
--- src/modules/perl/mod_perl.c 2001/08/30 05:15:51 1.63
+++ src/modules/perl/mod_perl.c 2001/09/04 11:10:42
@@ -81,6 +81,10 @@
exit(1);
}
+ modperl_config_apply_PerlPassEnv(s, scfg, perl, p);
+ modperl_config_apply_PerlSetEnv(s, scfg, perl, p);
+
+
#ifndef USE_ITHREADS
cdata = modperl_cleanup_data_new(p, (void*)perl);
apr_pool_cleanup_register(p, cdata,
@@ -140,6 +144,9 @@
exit(1);
}
+ modperl_config_apply_PerlPassEnv(s, scfg, perl, p);
+ modperl_config_apply_PerlSetEnv(s, scfg, perl, p);
+
#ifdef USE_ITHREADS
if (!MpSrvENABLED(scfg)) {
@@ -369,9 +376,10 @@
static const command_rec modperl_cmds[] = {
MP_CMD_SRV_ITERATE("PerlSwitches", switches, "Perl Switches"),
- MP_CMD_SRV_ITERATE("PerlModule", modules, "PerlModule"),
- MP_CMD_SRV_ITERATE("PerlRequire", requires, "PerlRequire"),
- MP_CMD_DIR_ITERATE("PerlOptions", options, "Perl Options"),
+ MP_CMD_SRV_ITERATE("PerlModule", modules, "PerlModule"),
+ MP_CMD_SRV_ITERATE("PerlRequire", requires, "PerlRequire"),
+ MP_CMD_SRV_ITERATE("PerlPassEnv", passenv, "PerlPassEnv"),
+ MP_CMD_DIR_ITERATE("PerlOptions", options, "Perl Options"),
#ifdef MP_TRACE
MP_CMD_SRV_TAKE1("PerlTrace", trace, "Trace level"),
#endif
@@ -389,6 +397,7 @@
MP_CMD_DIR_TAKE1("PerlInterpScope", interp_scope,
"Scope of a Perl interpreter"),
#endif
+ MP_CMD_DIR_TAKE2("PerlSetEnv", setenv, "PerlSetEnv"),
MP_CMD_ENTRIES,
{ NULL },
};
Index: src/modules/perl/modperl_cmd.c
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_cmd.c,v
retrieving revision 1.6
diff -u -r1.6 modperl_cmd.c
--- src/modules/perl/modperl_cmd.c 2001/08/08 16:20:31 1.6
+++ src/modules/perl/modperl_cmd.c 2001/09/04 11:10:42
@@ -60,6 +60,32 @@
return NULL;
}
+MP_CMD_SRV_DECLARE(passenv)
+{
+ MP_dSCFG(parms->server);
+ *(const char **)apr_array_push(scfg->PassEnv) = arg;
+ MP_TRACE_d(MP_FUNC, "arg = %s\n", arg);
+ return NULL;
+}
+
+MP_CMD_SRV_DECLARE2(setenv)
+{
+ MP_dSCFG(parms->server);
+ modperl_config_dir_t *dcfg = (modperl_config_dir_t *)dummy;
+ int is_per_dir = parms->path ? 1 : 0;
+
+ if (is_per_dir) {
+ apr_table_set(scfg->SetEnv, arg1, arg2);
+ }
+ else {
+ apr_table_set(dcfg->SetEnv, arg1, arg2);
+ }
+ MP_TRACE_d(MP_FUNC, "arg1 = %s, arg2 = %s\n", arg1, arg2);
+ return NULL;
+}
+
+
+
MP_CMD_SRV_DECLARE(options)
{
MP_dSCFG(parms->server);
Index: src/modules/perl/modperl_cmd.h
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_cmd.h,v
retrieving revision 1.5
diff -u -r1.5 modperl_cmd.h
--- src/modules/perl/modperl_cmd.h 2001/08/08 07:02:41 1.5
+++ src/modules/perl/modperl_cmd.h 2001/09/04 11:10:42
@@ -8,10 +8,15 @@
#define MP_CMD_SRV_DECLARE(item) \
const char *modperl_cmd_##item(cmd_parms *parms, \
void *dummy, const char *arg)
+#define MP_CMD_SRV_DECLARE2(item) \
+const char *modperl_cmd_##item(cmd_parms *parms, \
+ void *dummy, const char *arg1, const char *arg2)
MP_CMD_SRV_DECLARE(trace);
MP_CMD_SRV_DECLARE(switches);
MP_CMD_SRV_DECLARE(modules);
MP_CMD_SRV_DECLARE(requires);
+MP_CMD_SRV_DECLARE(passenv);
+MP_CMD_SRV_DECLARE2(setenv);
MP_CMD_SRV_DECLARE(options);
#ifdef USE_ITHREADS
@@ -43,12 +48,20 @@
AP_INIT_TAKE1( name, modperl_cmd_##item, NULL, \
RSRC_CONF, desc )
+#define MP_CMD_SRV_TAKE2(name, item, desc) \
+ AP_INIT_TAKE2( name, modperl_cmd_##item, NULL, \
+ RSRC_CONF, desc )
+
#define MP_CMD_SRV_ITERATE(name, item, desc) \
AP_INIT_ITERATE( name, modperl_cmd_##item, NULL, \
RSRC_CONF, desc )
#define MP_CMD_DIR_TAKE1(name, item, desc) \
AP_INIT_TAKE1( name, modperl_cmd_##item, NULL, \
+ OR_ALL, desc )
+
+#define MP_CMD_DIR_TAKE2(name, item, desc) \
+ AP_INIT_TAKE2( name, modperl_cmd_##item, NULL, \
OR_ALL, desc )
#define MP_CMD_DIR_ITERATE(name, item, desc) \
Index: src/modules/perl/modperl_config.c
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_config.c,v
retrieving revision 1.35
diff -u -r1.35 modperl_config.c
--- src/modules/perl/modperl_config.c 2001/08/10 23:37:33 1.35
+++ src/modules/perl/modperl_config.c 2001/09/04 11:10:42
@@ -73,8 +73,10 @@
scfg->PerlModule = apr_array_make(p, 2, sizeof(char *));
scfg->PerlRequire = apr_array_make(p, 2, sizeof(char *));
+ scfg->PassEnv = apr_array_make(p, 2, sizeof(char *));
+ scfg->argv = apr_array_make(p, 2, sizeof(char *));
- scfg->argv = apr_array_make(p, 2, sizeof(char *));
+ scfg->SetEnv = apr_table_make(p, 2);
modperl_config_srv_argv_push((char *)ap_server_argv0);
@@ -90,6 +92,8 @@
dcfg->flags = modperl_options_new(p, MpDirType);
+ dcfg->SetEnv = apr_table_make(p, 2);
+
MP_TRACE_d(MP_FUNC, "0x%lx\n", (unsigned long)dcfg);
return dcfg;
@@ -157,6 +161,8 @@
merge_item(PerlModule);
merge_item(PerlRequire);
+ merge_item(PassEnv);
+ merge_item(SetEnv);
merge_item(threaded_mpm);
@@ -235,6 +241,44 @@
entries[i], modperl_server_desc(s,p));
return FALSE;
}
+ }
+
+ return TRUE;
+}
+
+int modperl_config_apply_PerlPassEnv(server_rec *s,
+ modperl_config_srv_t *scfg,
+ PerlInterpreter *perl, apr_pool_t *p)
+{
+ char **entries;
+ int i;
+ dTHXa(perl);
+
+ entries = (char **)scfg->PassEnv->elts;
+ for (i = 0; i < scfg->PassEnv->nelts; i++){
+ char *val = getenv(entries[i]);
+ mp_magic_setenv(aTHX_ entries[i], val?val:"");
+ MP_TRACE_d(MP_FUNC, "Passed ENV: %s=%s for server %s\n",
+ entries[i], val, modperl_server_desc(s,p));
+ }
+
+ return TRUE;
+}
+
+int modperl_config_apply_PerlSetEnv(server_rec *s,
+ modperl_config_srv_t *scfg,
+ PerlInterpreter *perl, apr_pool_t *p)
+{
+ dTHXa(perl);
+ apr_array_header_t *arr = apr_table_elts(scfg->SetEnv);
+ apr_table_entry_t *entries = (apr_table_entry_t *)arr->elts;
+ int i;
+
+ for (i = 0; i < arr->nelts; ++i) {
+ char *val = (const char *)apr_table_get(scfg->SetEnv, entries[i].key);
+ mp_magic_setenv(aTHX_ entries[i].key, val?val:"");
+ MP_TRACE_d(MP_FUNC, "Set ENV: %s=%s for server %s\n",
+ entries[i], val, modperl_server_desc(s,p));
}
return TRUE;
Index: src/modules/perl/modperl_config.h
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_config.h,v
retrieving revision 1.27
diff -u -r1.27 modperl_config.h
--- src/modules/perl/modperl_config.h 2001/08/08 16:20:31 1.27
+++ src/modules/perl/modperl_config.h 2001/09/04 11:10:42
@@ -67,4 +67,12 @@
modperl_config_srv_t *scfg,
PerlInterpreter *perl, apr_pool_t *p);
+int modperl_config_apply_PerlPassEnv(server_rec *s,
+ modperl_config_srv_t *scfg,
+ PerlInterpreter *perl, apr_pool_t *p);
+
+int modperl_config_apply_PerlSetEnv(server_rec *s,
+ modperl_config_srv_t *scfg,
+ PerlInterpreter *perl, apr_pool_t *p);
+
#endif /* MODPERL_CONFIG_H */
Index: src/modules/perl/modperl_env.c
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_env.c,v
retrieving revision 1.3
diff -u -r1.3 modperl_env.c
--- src/modules/perl/modperl_env.c 2001/06/27 05:35:55 1.3
+++ src/modules/perl/modperl_env.c 2001/09/04 11:10:42
@@ -36,6 +36,17 @@
{ NULL }
};
+void mp_magic_setenv(pTHX_ char *key, char *val)
+{
+ int klen = strlen(key);
+ SV **ptr = hv_fetch(GvHV(PL_envgv), key, klen, TRUE);
+ if (ptr) {
+ SvSetMagicSV(*ptr, newSVpv(val,0));
+
+ SvTAINTED_on(*ptr);
+ }
+}
+
static void mp_env_request_populate(pTHX_ request_rec *r)
{
HV *hv = GvHV(PL_envgv);
Index: src/modules/perl/modperl_env.h
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_env.h,v
retrieving revision 1.1
diff -u -r1.1 modperl_env.h
--- src/modules/perl/modperl_env.h 2001/05/08 04:10:41 1.1
+++ src/modules/perl/modperl_env.h 2001/09/04 11:10:42
@@ -8,6 +8,8 @@
#define modperl_env_tie(mg_flags) \
SvFLAGS((SV*)GvHV(PL_envgv)) |= mg_flags
+void mp_magic_setenv(pTHX_ char *key, char *val);
+
void modperl_env_request_tie(pTHX_ request_rec *r);
void modperl_env_request_untie(pTHX_ request_rec *r);
Index: src/modules/perl/modperl_types.h
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_types.h,v
retrieving revision 1.46
diff -u -r1.46 modperl_types.h
--- src/modules/perl/modperl_types.h 2001/08/30 05:15:51 1.46
+++ src/modules/perl/modperl_types.h 2001/09/04 11:10:42
@@ -110,6 +110,7 @@
} modperl_interp_scope_e;
typedef struct {
+ MpHV *SetEnv;
MpHV *SetVars;
MpAV *PassEnv;
MpAV *PerlRequire, *PerlModule;
--- /dev/null Sat Apr 14 19:06:21 2001
+++ t/response/TestDirective/perlsetenv.pm Tue Sep 4 19:07:04 2001
@@ -0,0 +1,21 @@
+package TestDirective::perlsetenv;
+
+use strict;
+use warnings FATAL => 'all';
+use Apache::Test;
+
+sub handler {
+ my $r = shift;
+ $r->content_type('text/plain');
+
+ plan $r, tests => 1;
+
+ ok (exists $ENV{NEWHOME} && $ENV{NEWHOME} eq '/home/foo');
+
+ Apache::OK;
+}
+
+1;
+__END__
+PerlSetEnv NEWHOME /home/foo
+
_____________________________________________________________________
Stas Bekman JAm_pH -- Just Another mod_perl Hacker
http://stason.org/ mod_perl Guide http://perl.apache.org/guide
mailto:[EMAIL PROTECTED] http://apachetoday.com http://eXtropia.com/
http://singlesheaven.com http://perl.apache.org http://perlmonth.com/
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
