You are viewing a plain text version of this content. The canonical link for it is here.
Posted to modperl-cvs@perl.apache.org by do...@hyperreal.org on 1999/01/18 05:26:00 UTC
cvs commit: modperl/src/modules/perl mod_perl.c mod_perl.h perl_config.c perl_util.c
dougm 99/01/17 20:25:59
Modified: . Changes
src/modules/perl mod_perl.c mod_perl.h perl_config.c
perl_util.c
Log:
add some insurance so HTTP_* env variables should always be wiped
Revision Changes Path
1.243 +2 -0 modperl/Changes
Index: Changes
===================================================================
RCS file: /export/home/cvs/modperl/Changes,v
retrieving revision 1.242
retrieving revision 1.243
diff -u -r1.242 -r1.243
--- Changes 1999/01/18 03:26:17 1.242
+++ Changes 1999/01/18 04:25:55 1.243
@@ -8,6 +8,8 @@
=item 1.17_01-dev
+add some insurance so HTTP_* env variables should always be wiped
+
fixed $r->finfo bug (properly set PL_laststatval)
PerlRequire/PerlModule will not let the server start if there is an
1.69 +10 -7 modperl/src/modules/perl/mod_perl.c
Index: mod_perl.c
===================================================================
RCS file: /export/home/cvs/modperl/src/modules/perl/mod_perl.c,v
retrieving revision 1.68
retrieving revision 1.69
diff -u -r1.68 -r1.69
--- mod_perl.c 1999/01/18 03:26:19 1.68
+++ mod_perl.c 1999/01/18 04:25:57 1.69
@@ -720,6 +720,7 @@
{
dSTATUS;
dPPDIR;
+ dPPREQ;
dTHR;
SV *nwvh = Nullsv;
@@ -758,11 +759,10 @@
/* hookup STDIN & STDOUT to the client */
perl_stdout2client(r);
perl_stdin2client(r);
-
- if(MP_ENV(cld))
- perl_setup_env(r);
+ cfg->setup_env = 1;
PERL_CALLBACK("PerlHandler", cld->PerlHandler);
+ cfg->setup_env = 0;
FREETMPS;
LEAVE;
@@ -1194,7 +1194,8 @@
void perl_per_request_init(request_rec *r)
{
dPPDIR;
-
+ dPPREQ;
+
/* PerlSetEnv */
mod_perl_dir_env(cld);
@@ -1216,10 +1217,12 @@
}
}
- if(!get_module_config(r->request_config, &perl_module)) {
- perl_request_config *cfg =
- perl_create_request_config(r->pool, r->server);
+ if(!cfg) {
+ cfg = perl_create_request_config(r->pool, r->server);
set_module_config(r->request_config, &perl_module, cfg);
+ }
+ else if (cfg->setup_env && MP_ENV(cld)) {
+ perl_setup_env(r);
}
if(callbacks_this_request++ > 0) return;
1.72 +1 -0 modperl/src/modules/perl/mod_perl.h
Index: mod_perl.h
===================================================================
RCS file: /export/home/cvs/modperl/src/modules/perl/mod_perl.h,v
retrieving revision 1.71
retrieving revision 1.72
diff -u -r1.71 -r1.72
--- mod_perl.h 1999/01/18 03:26:19 1.71
+++ mod_perl.h 1999/01/18 04:25:57 1.72
@@ -991,6 +991,7 @@
typedef struct {
HV *pnotes;
+ int setup_env;
} perl_request_config;
typedef struct {
1.63 +1 -0 modperl/src/modules/perl/perl_config.c
Index: perl_config.c
===================================================================
RCS file: /export/home/cvs/modperl/src/modules/perl/perl_config.c,v
retrieving revision 1.62
retrieving revision 1.63
diff -u -r1.62 -r1.63
--- perl_config.c 1999/01/18 03:02:26 1.62
+++ perl_config.c 1999/01/18 04:25:57 1.63
@@ -337,6 +337,7 @@
perl_request_config *cfg =
(perl_request_config *)pcalloc(p, sizeof(perl_request_config));
cfg->pnotes = Nullhv;
+ cfg->setup_env = 0;
return cfg;
}
1.26 +29 -18 modperl/src/modules/perl/perl_util.c
Index: perl_util.c
===================================================================
RCS file: /export/home/cvs/modperl/src/modules/perl/perl_util.c,v
retrieving revision 1.25
retrieving revision 1.26
diff -u -r1.25 -r1.26
--- perl_util.c 1999/01/18 02:46:36 1.25
+++ perl_util.c 1999/01/18 04:25:58 1.26
@@ -593,33 +593,44 @@
return table_elts(envtab);
}
+#define untie_env sv_unmagic((SV*)GvHV(envgv), 'E')
+#define tie_env sv_magic((SV*)GvHV(envgv), (SV*)envgv, 'E', Nullch, 0)
+#define delete_env(ken, klen) \
+ (void)hv_delete(GvHV(envgv), key, klen, G_DISCARD)
+
void perl_clear_env(void)
{
- char *key;
- I32 klen;
+ char *key;
+ I32 klen;
SV *val;
HV *hv = (HV*)GvHV(envgv);
- sv_unmagic((SV*)hv, 'E');
+ untie_env;
if(!hv_exists(hv, "MOD_PERL", 8)) {
- hv_store(hv, "MOD_PERL", 8,
- newSVpv(MOD_PERL_STRING_VERSION,0), FALSE);
- hv_store(hv, "GATEWAY_INTERFACE", 17,
- newSVpv("CGI-Perl/1.1",0), FALSE);
+ hv_store(hv, "MOD_PERL", 8,
+ newSVpv("mod_perl/1.17_01-dev",0), FALSE);
+ hv_store(hv, "GATEWAY_INTERFACE", 17,
+ newSVpv("CGI-Perl/1.1",0), FALSE);
}
- (void)hv_iterinit(hv);
- while ((val = hv_iternextsv(hv, (char **) &key, &klen))) {
- if((*key == 'G') && strEQ(key, "GATEWAY_INTERFACE"))
- continue;
- else if((*key == 'M') && strnEQ(key, "MOD_PERL", 8))
- continue;
- else if((*key == 'T') && strnEQ(key, "TZ", 2))
- continue;
- else if((*key == 'P') && strEQ(key, "PATH"))
+ (void)hv_iterinit(hv);
+ while ((val = hv_iternextsv(hv, (char **) &key, &klen))) {
+ if((*key == 'G') && strEQ(key, "GATEWAY_INTERFACE"))
+ continue;
+ else if((*key == 'M') && strnEQ(key, "MOD_PERL", 8))
+ continue;
+ else if((*key == 'T') && strnEQ(key, "TZ", 2))
+ continue;
+ else if((*key == 'P') && strEQ(key, "PATH"))
+ continue;
+ else if((*key == 'H') && strnEQ(key, "HTTP_", 5)) {
+ tie_env;
+ delete_env(key, klen);
+ untie_env;
continue;
- (void)hv_delete(hv, key, klen, G_DISCARD);
+ }
+ delete_env(key, klen);
}
- sv_magic((SV*)hv, (SV*)envgv, 'E', Nullch, 0);
+ tie_env;
}
void mod_perl_init_ids(void) /* $$, $>, $), etc */