Control: tag -1 patch pending This bug is surprisingly quiet, so an update seems to be in order.
For quite some time, this issue has been the last real blocker for Perl 5.22 transition. As seen in the upstream ticket [rt.cpan.org #101962], recent progress upstream got us to a point where the test suite is passing, and we're now waiting for the proposed patch to be cleaned up and committed. I'm about to upload the proposed patch to experimental as 2.0.9-2 so we can test it in our Perl 5.22 rebuilds. Any other testing would be welcome too. The patch does not have separate code paths for Perl 5.20 and 5.22, so testing the actual 2.0.9-2 binary packages from experimental on sid (still Perl 5.20 for now) would be just as useful. I'm attaching the actual patch I'm using for completeness. It's unmodified from the RT one except for line endings and -p0 -> -p1 conversion required by dpkg v3.0 (quilt) source format. -- Niko Tyni nt...@debian.org
Subject: Perl 5.22 compatibility Author: Steve Hay <steve.m....@googlemail.com> Author: Niko Tyni <nt...@debian.org> Origin: https://rt.cpan.org/Ticket/Attachment/1564180/834925/Perl-5.22-compatibility-take-4.patch Bug: https://rt.cpan.org/Public/Bug/Display.html?id=101962 Bug-Debian: https://bugs.debian.org/787493 Please note that this patch is still work in progress. --- libapache2-mod-perl2.orig/src/modules/perl/mod_perl.c +++ libapache2-mod-perl2/src/modules/perl/mod_perl.c @@ -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(); --- libapache2-mod-perl2.orig/src/modules/perl/modperl_env.c +++ libapache2-mod-perl2/src/modules/perl/modperl_env.c @@ -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,73 @@ 0 }; -void modperl_env_init(void) +static int modperl_env_magic_copy(pTHX_ SV *sv, MAGIC *mg, SV *nsv, const char *name, I32 namlen) +{ + 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) { - /* save originals */ - StructCopy(&PL_vtbl_env, &MP_PERL_vtbl_env, MGVTBL); - StructCopy(&PL_vtbl_envelem, &MP_PERL_vtbl_envelem, MGVTBL); + 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; - /* replace with our versions */ - StructCopy(&MP_vtbl_env, &PL_vtbl_env, MGVTBL); - StructCopy(&MP_vtbl_envelem, &PL_vtbl_envelem, MGVTBL); + return 1; } -void modperl_env_unload(void) +void modperl_env_init(pTHX) { - /* restore originals */ - StructCopy(&MP_PERL_vtbl_env, &PL_vtbl_env, MGVTBL); - StructCopy(&MP_PERL_vtbl_envelem, &PL_vtbl_envelem, MGVTBL); + 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); + + /* Restore original */ + sv_magicext((SV*)ENVHV, (SV*)NULL, PERL_MAGIC_env, &PL_vtbl_env, (char*)NULL, 0); } /* --- libapache2-mod-perl2.orig/src/modules/perl/modperl_env.h +++ libapache2-mod-perl2/src/modules/perl/modperl_env.h @@ -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 */ --- libapache2-mod-perl2.orig/src/modules/perl/modperl_perl.c +++ libapache2-mod-perl2/src/modules/perl/modperl_perl.c @@ -181,6 +181,8 @@ } } + modperl_env_unload(perl); + perl_destruct(perl); /* XXX: big bug in 5.6.1 fixed in 5.7.2+ --- libapache2-mod-perl2.orig/t/response/TestModperl/env.pm +++ libapache2-mod-perl2/t/response/TestModperl/env.pm @@ -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;
