PORTREVISION=	1

--- src/modules/perl/mod_perl.c.orig	2015-06-18 22:13:55.000000000 +0200

+++ src/modules/perl/mod_perl.c	2016-05-11 20:35:19.285089000 +0200

@@ -262,6 +262,8 @@

         exit(1);

     }

+    modperl_env_init(aTHX);

+

     /* suspend END blocks to be run at server shutdown */

     endav = PL_endav;

     PL_endav = (AV *)NULL;

@@ -576,9 +578,6 @@

     /* modifies PL_ppaddr */

     modperl_perl_pp_set_all();

-    /* modifies PL_vtbl_env{elem} */

-    modperl_env_init();

-

     return APR_SUCCESS;

 }

@@ -597,8 +596,6 @@

     MP_TRACE_i(MP_FUNC, "mod_perl sys term");

-    modperl_env_unload();

-

     modperl_perl_pp_unset_all();

     PERL_SYS_TERM();

--- src/modules/perl/modperl_env.c.orig	2015-06-18 22:13:54.000000000 +0200

+++ src/modules/perl/modperl_env.c	2016-05-11 21:06:13.364008000 +0200

@@ -121,6 +121,7 @@

     const apr_array_header_t *array;

     apr_table_entry_t *elts;

+    modperl_env_init(aTHX);

     modperl_env_untie(mg_flags);

     array = apr_table_elts(table);

@@ -434,11 +435,8 @@

 /* to store the original virtual tables

  * these are global, not per-interpreter

  */

-static MGVTBL MP_PERL_vtbl_env;

-static MGVTBL MP_PERL_vtbl_envelem;

-

 #define MP_PL_vtbl_call(name, meth) \

-    MP_PERL_vtbl_##name.svt_##meth(aTHX_ sv, mg)

+    PL_vtbl_##name.svt_##meth(aTHX_ sv, mg)

 #define MP_dENV_KEY \

     STRLEN klen; \

@@ -612,16 +610,22 @@

 }

 #endif

+static int modperl_env_magic_copy(pTHX_ SV *sv, MAGIC *mg, SV *nsv, const char *name, I32 namlen);

+static int modperl_env_magic_local_all(pTHX_ SV *nsv, MAGIC *mg);

+

 /* override %ENV virtual tables with our own */

 static MGVTBL MP_vtbl_env = {

     0,

     modperl_env_magic_set_all,

     0,

     modperl_env_magic_clear_all,

-    0

+    0,

+    modperl_env_magic_copy,

+    0,

+    modperl_env_magic_local_all

 };

-static MGVTBL MP_vtbl_envelem = {

+MGVTBL MP_vtbl_envelem = {

     0,

     modperl_env_magic_set,

     0,

@@ -629,22 +633,70 @@

     0

 };

-void modperl_env_init(void)

+static int modperl_env_magic_copy(pTHX_ SV *sv, MAGIC *mg, SV *nsv, const char *name, I32 namlen)

 {

     /* save originals */

-    StructCopy(&PL_vtbl_env, &MP_PERL_vtbl_env, MGVTBL);

-    StructCopy(&PL_vtbl_envelem, &MP_PERL_vtbl_envelem, MGVTBL);

-

-    /* replace with our versions */

-    StructCopy(&MP_vtbl_env, &PL_vtbl_env, MGVTBL);

-    StructCopy(&MP_vtbl_envelem, &PL_vtbl_envelem, MGVTBL);

-}

+    MP_TRACE_e(MP_FUNC, "setting up %%ENV element magic");

+    sv_magicext(nsv, mg->mg_obj,

+		toLOWER(mg->mg_type), &MP_vtbl_envelem, name, namlen);

+

+    return 1;

+}

+

+static int modperl_env_magic_local_all(pTHX_ SV *nsv, MAGIC *mg)

+{

+    MAGIC *nmg;

+    MP_TRACE_e(MP_FUNC, "localizing %%ENV");

+    nmg = sv_magicext(nsv, mg->mg_obj,

+		mg->mg_type, &MP_vtbl_env, NULL, 0);

+    nmg->mg_ptr = mg->mg_ptr;

+    nmg->mg_flags |= MGf_COPY;

+    nmg->mg_flags |= MGf_LOCAL;

+

+    return 1;

+}

+

+void modperl_env_init(pTHX)

+{

+    MAGIC *mg;

+    /* Remove existing 'E' magic from %ENV */

+    /* TODO: Should check there is not multiple 'E' magic! */

+    if (!my_perl)

+	return;

+    if (!PL_envgv)

+	return;

+    if (!SvRMAGICAL(ENVHV))

+	return;

+    mg = mg_find((const SV *)ENVHV, PERL_MAGIC_env);

+    if (!mg)

+	return;

+    if (mg->mg_virtual == &MP_vtbl_env)

+	return;

+    MP_TRACE_d(MP_FUNC, "ptr: %x obj: %x flags:%x", mg->mg_ptr, mg->mg_obj, mg->mg_flags);

+    mg_free_type((SV*)ENVHV, PERL_MAGIC_env);

+

+    /* Add our version instead */

+    mg = sv_magicext((SV*)ENVHV, (SV*)NULL, PERL_MAGIC_env, &MP_vtbl_env, (char*)NULL, 0);

+    mg->mg_flags |= MGf_COPY;

+    mg->mg_flags |= MGf_LOCAL;

+}

+

+void modperl_env_unload(pTHX)

+{

+    /* Remove our 'E' magic from %ENV */

+    /* TODO: Should check there is not multiple 'E' magic! */

+    if (!my_perl)

+	return;

+    if (!PL_envgv)

+	return;

+    if (!SvRMAGICAL(ENVHV))

+	return;

+    if (!mg_find((const SV *)ENVHV, PERL_MAGIC_env))

+	return;

+    mg_free_type((SV*)ENVHV, PERL_MAGIC_env);

-void modperl_env_unload(void)

-{

-    /* restore originals */

-    StructCopy(&MP_PERL_vtbl_env, &PL_vtbl_env, MGVTBL);

-    StructCopy(&MP_PERL_vtbl_envelem, &PL_vtbl_envelem, MGVTBL);

+    /* Restore original */

+    sv_magicext((SV*)ENVHV, (SV*)NULL, PERL_MAGIC_env, &PL_vtbl_env, (char*)NULL, 0);

 }

 /*

--- src/modules/perl/modperl_env.h.orig	2016-05-11 21:36:26.176077000 +0200

+++ src/modules/perl/modperl_env.h	2016-05-11 21:37:37.854775000 +0200

@@ -28,7 +28,7 @@

     MP_magical_tie(ENVHV, mg_flags)

 #define modperl_envelem_tie(sv, key, klen) \

-    sv_magic(sv, (SV *)NULL, 'e', key, klen)

+    sv_magicext(sv, (SV *)NULL, PERL_MAGIC_envelem, &MP_vtbl_envelem, key, klen)

 void modperl_env_hash_keys(pTHX);

@@ -58,9 +58,11 @@

 void modperl_env_request_untie(pTHX_ request_rec *r);

-void modperl_env_init(void);

+void modperl_env_init(pTHX);

-void modperl_env_unload(void);

+void modperl_env_unload(pTHX);

+

+MGVTBL MP_vtbl_envelem;

 #endif /* MODPERL_ENV_H */

--- src/modules/perl/modperl_perl.c.orig	2015-06-18 22:13:55.000000000 +0200

+++ src/modules/perl/modperl_perl.c	2016-05-11 21:07:47.180082000 +0200

@@ -181,6 +181,8 @@

         }

     }

+    modperl_env_unload(perl);

+

     perl_destruct(perl);

     /* XXX: big bug in 5.6.1 fixed in 5.7.2+

--- t/response/TestModperl/env.pm.orig	2015-06-18 22:13:58.000000000 +0200

+++ t/response/TestModperl/env.pm	2016-05-11 21:09:00.010061000 +0200

@@ -15,7 +15,7 @@

 sub handler {

     my $r = shift;

-    plan $r, tests => 23 + keys(%ENV);

+    plan $r, tests => 23 + 3 * keys(%ENV);

     my $env = $r->subprocess_env;

@@ -75,6 +75,8 @@

     for my $key (sort keys %ENV) {

         eval { delete $ENV{$key}; };

         ok t_cmp($@, '', $key);

+	ok t_cmp($ENV{$key}, undef, "ENV{$key} is empty");

+	ok t_cmp($env->get($key), undef, "subprocess_env($key) is empty");

     }

     Apache2::Const::OK;