www-apache/mod_perl Fix Perl initialization

Newer (>=5.22) versions of Perl require initialization to be handled
differently. The added patch comes from mod_perl's SVN, commit #1717474,
plus a few adaptations to apply cleanly.

Gentoo-Bug: 554794

Package-Manager: portage-2.2.26

2 files changed, 406 insertions, 0 deletions

diff --git a/www-apache/mod_perl/files/mod_perl_init_b554794.patch b/www-apache/mod_perl/files/mod_perl_init_b554794.patch
new file mode 100644
index 000000000000..b33a34a6efd2
--- /dev/null
+++ b/www-apache/mod_perl/files/mod_perl_init_b554794.patch
@@ -0,0 +1,241 @@
+--- a/src/modules/perl/modperl_env.c.orig	2015-12-28 11:42:26.604632457 +0100
++++ b/src/modules/perl/modperl_env.c	2015-12-28 12:36:35.305228288 +0100
+@@ -120,6 +120,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);
+@@ -431,13 +432,11 @@
+ }
+ 
+ /* to store the original virtual tables
+- * these are global, not per-interpreter
++ * handy access to perl's original virtual tables
+  */
+-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; \
+@@ -534,6 +533,26 @@
+     return 0;
+ }
+ 
++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)
++{
++    MAGIC *nmg;
++    MP_TRACE_e(MP_FUNC, "localizing %%ENV");
++    nmg = sv_magicext(nsv, mg->mg_obj, mg->mg_type, &MP_vtbl_env, (char*)NULL, 0);
++    nmg->mg_ptr = mg->mg_ptr;
++    nmg->mg_flags |= MGf_COPY;
++    nmg->mg_flags |= MGf_LOCAL;
++
++    return 1;
++}
++
+ static int modperl_env_magic_set(pTHX_ SV *sv, MAGIC *mg)
+ {
+     request_rec *r = (request_rec *)EnvMgObj;
+@@ -625,15 +644,18 @@
+ #endif
+ 
+ /* override %ENV virtual tables with our own */
+-static MGVTBL MP_vtbl_env = {
++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,
+@@ -641,20 +663,62 @@
+     0
+ };
+ 
+-void modperl_env_init(void)
++void modperl_env_init(pTHX)
+ {
+-    /* save originals */
+-    StructCopy(&PL_vtbl_env, &MP_PERL_vtbl_env, MGVTBL);
+-    StructCopy(&PL_vtbl_envelem, &MP_PERL_vtbl_envelem, MGVTBL);
++    MAGIC *mg;
+ 
+-    /* replace with our versions */
+-    StructCopy(&MP_vtbl_env, &PL_vtbl_env, MGVTBL);
+-    StructCopy(&MP_vtbl_envelem, &PL_vtbl_envelem, MGVTBL);
++    /* Find the 'E' magic on %ENV */
++    if (!my_perl)
++        return;
++    if (!PL_envgv)
++        return;
++    if (!SvRMAGICAL(ENVHV))
++        return;
++    mg = mg_find((const SV *)ENVHV, PERL_MAGIC_env);
++    if (!mg)
++        return;
++       
++    /* Ignore it if it isn't perl's original version */
++    if (mg->mg_virtual != &PL_vtbl_env)
++        return;
++
++    MP_TRACE_e(MP_FUNC, "env_init - ptr: %x obj: %x flags: %x",
++               mg->mg_ptr, mg->mg_obj, mg->mg_flags);
++
++    /* Remove it */
++    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(void)
++void modperl_env_unload(pTHX)
+ {
+-    /* restore originals */
+-    StructCopy(&MP_PERL_vtbl_env, &PL_vtbl_env, MGVTBL);
+-    StructCopy(&MP_PERL_vtbl_envelem, &PL_vtbl_envelem, MGVTBL);
++     MAGIC *mg;
++
++    /* Find the 'E' magic on %ENV */
++    if (!my_perl)
++        return;
++    if (!PL_envgv)
++        return;
++    if (!SvRMAGICAL(ENVHV))
++        return;
++    mg = mg_find((const SV *)ENVHV, PERL_MAGIC_env);
++    if (!mg)
++        return;
++
++    /* Ignore it if it isn't our version */
++    if (mg->mg_virtual != &MP_vtbl_env)
++        return;
++
++    MP_TRACE_e(MP_FUNC, "env_unload - ptr: %x obj: %x flags: %x",
++               mg->mg_ptr, mg->mg_obj, mg->mg_flags);
++
++    /* Remove it */
++    mg_free_type((SV*)ENVHV, PERL_MAGIC_env);
++
++    /* Restore perl's original version */
++    sv_magicext((SV*)ENVHV, (SV*)NULL, PERL_MAGIC_env, &PL_vtbl_env, (char*)NULL, 0);
+ }
+--- a/src/modules/perl/modperl_env.h.orig	2015-12-28 11:42:34.868727490 +0100
++++ b/src/modules/perl/modperl_env.h	2015-12-28 12:37:47.730041274 +0100
+@@ -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,8 +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_env;
++MGVTBL MP_vtbl_envelem;
+ 
+ #endif /* MODPERL_ENV_H */
+Index: trunk/src/modules/perl/modperl_perl.c
+===================================================================
+--- trunk/src/modules/perl/modperl_perl.c	(revision 1717473)
++++ trunk/src/modules/perl/modperl_perl.c	(revision 1717474)
+@@ -181,6 +181,8 @@
+         }
+     }
+ 
++    modperl_env_unload(perl);
++
+     perl_destruct(perl);
+ 
+     /* XXX: big bug in 5.6.1 fixed in 5.7.2+
+Index: trunk/src/modules/perl/mod_perl.c
+===================================================================
+--- trunk/src/modules/perl/mod_perl.c	(revision 1717473)
++++ trunk/src/modules/perl/mod_perl.c	(revision 1717474)
+@@ -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();
+Index: trunk/t/response/TestModperl/env.pm
+===================================================================
+--- trunk/t/response/TestModperl/env.pm	(revision 1717473)
++++ trunk/t/response/TestModperl/env.pm	(revision 1717474)
+@@ -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;
diff --git a/www-apache/mod_perl/mod_perl-2.0.8-r3.ebuild b/www-apache/mod_perl/mod_perl-2.0.8-r3.ebuild
new file mode 100644
index 000000000000..bdd62158de76
--- /dev/null
+++ b/www-apache/mod_perl/mod_perl-2.0.8-r3.ebuild
@@ -0,0 +1,165 @@
+# Copyright 1999-2015 Gentoo Foundation
+# Distributed under the terms of the GNU General Public License v2
+# $Id$
+
+EAPI="5"
+
+inherit depend.apache apache-module perl-module eutils
+
+DESCRIPTION="An embedded Perl interpreter for Apache2"
+HOMEPAGE="https://projects.apache.org/projects/mod_perl.html"
+SRC_URI="mirror://apache/perl/${P}.tar.gz"
+
+LICENSE="GPL-2"
+SLOT="1"
+KEYWORDS=""
+IUSE="debug"
+
+# Make sure we always use the latest Apache-Test version or even check the
+# version of the bundled Apache-Test!
+#
+# We need both, apache and perl but either apache without threads or perl with
+# ithreads, bug 373943
+DEPEND="
+	>=dev-perl/Apache-Test-1.360
+	>=dev-perl/CGI-3.08
+	dev-lang/perl[ithreads]
+	www-servers/apache
+"
+RDEPEND="${DEPEND}"
+PDEPEND=">=dev-perl/Apache-Reload-0.11
+	>=dev-perl/Apache-SizeLimit-0.95"
+
+APACHE2_MOD_FILE="${S}/src/modules/perl/mod_perl.so"
+APACHE2_MOD_CONF="2.0.3/75_${PN}"
+APACHE2_MOD_DEFINE="PERL"
+
+SRC_TEST="do"
+
+DOCFILES="Changes INSTALL README STATUS"
+
+need_apache2_4
+
+src_prepare() {
+	perl-module_src_prepare
+
+	# I am not entirely happy with this solution, but here's what's
+	# going on here if someone wants to take a stab at another
+	# approach.  When userpriv compilation is off, then the make
+	# process drops to user "nobody" to run the test servers.  This
+	# server is closed, and then the socket is rebound using
+	# SO_REUSEADDR.  If the same user does this, there is no problem,
+	# and the socket may be rebound immediately.  If a different user
+	# (yes, in my testing, even root) attempts to rebind, it fails.
+	# Since the "is the socket available yet" code and the
+	# second-batch bind call both run as root, this will fail.
+
+	# The upstream settings on my test machine cause the second batch
+	# of tests to fail, believing the socket to still be in use.  I
+	# tried patching various parts to make them run as the user
+	# specified in $config->{vars}{user} using getpwnam, but found
+	# this patch to be fairly intrusive, because the userid must be
+	# restored and the patch must be applied to multiple places.
+
+	# For now, we will simply extend the timeout in hopes that in the
+	# non-userpriv case, the socket will clear from the kernel tables
+	# normally, and the tests will proceed.
+
+	# If anybody is still having problems, then commenting out "make
+	# test" below should allow the software to build properly.
+
+	# Robert Coie <rac@gentoo.org> 2003.05.06
+#	sed -i -e "s/sleep \$_/sleep \$_ << 2/" \
+#		"${S}"/Apache-Test/lib/Apache/TestServer.pm \
+#		|| die "problem editing TestServer.pm"
+
+	# rendhalver - this got redone for 2.0.1 and seems to fix the make test problems
+	epatch "${FILESDIR}"/${PN}-2.0.1-sneak-tmpdir.patch
+	epatch "${FILESDIR}"/${PN}-2.0.4-inline.patch #550244
+
+	# bug 352724
+	epatch "${FILESDIR}/${P}-bundled-Apache-Test.patch"
+	rm -rf Apache-{Test,Reload,SizeLimit}/ lib/Bundle/
+	sed -i \
+		-e 's:^Apache-\(Reload\|SizeLimit\|Test\).*::' \
+		-e 's:^lib/Bundle/Apache2.pm::' \
+		MANIFEST || die
+
+	# 410453
+	epatch "${FILESDIR}/use-client_ip-client_add-instead-of-remote_ip-remote.patch"
+	epatch "${FILESDIR}/use-log.level-instead-of-loglevel.patch"
+
+	# 554794
+	epatch "${FILESDIR}/mod_perl_init_b554794.patch"
+}
+
+src_configure() {
+	local debug=$(usex debug 1 0)
+	perl Makefile.PL \
+		PREFIX="${EPREFIX}"/usr \
+		INSTALLDIRS=vendor \
+		MP_USE_DSO=1 \
+		MP_APXS=${APXS} \
+		MP_APR_CONFIG=/usr/bin/apr-1-config \
+		MP_TRACE=${debug} \
+		MP_DEBUG=${debug} \
+		|| die
+}
+
+src_test() {
+	# make test notes whether it is running as root, and drops
+	# privileges all the way to "nobody" if so, so we must adjust
+	# write permissions accordingly in this case.
+
+	# IF YOU SUDO TO EMERGE AND HAVE !env_reset set testing will fail!
+	if [[ "$(id -u)" == "0" ]]; then
+		chown nobody:nobody "${WORKDIR}" "${T}"
+	fi
+
+	# this does not || die because of bug 21325. kudos to smark for
+	# the idea of setting HOME.
+	TMPDIR="${T}" HOME="${T}/" perl-module_src_test
+}
+
+src_install() {
+	apache-module_src_install
+
+	default
+#emake DESTDIR="${D}" install || die
+
+	# TODO: add some stuff from docs/ back?
+
+	# rendhalver - fix the perllocal.pod that gets installed
+	# it seems to me that this has been getting installed for ages
+	perl_delete_localpod
+	# Remove empty .bs files as well
+	perl_delete_packlist
+
+	insinto "${APACHE_MODULES_CONFDIR}"
+	doins "${FILESDIR}"/2.0.3/apache2-mod_perl-startup.pl
+
+	# this is an attempt to get @INC in line with /usr/bin/perl.
+	# there is blib garbage in the mainstream one that can only be
+	# useful during internal testing, so we wait until here and then
+	# just go with a clean slate.  should be much easier to see what's
+	# happening and revert if problematic.
+
+	# Sorry for this evil hack...
+	perl_set_version # just to be sure...
+	sed -i \
+		-e "s,-I${S}/[^[:space:]\"\']\+[[:space:]]\?,,g" \
+		-e "s,-typemap[[:space:]]${S}/[^[:space:]\"\']\+[[:space:]]\?,,g" \
+		-e "s,${S}\(/[^[:space:]\"\']\+\)\?,/,g" \
+		"${D}/${VENDOR_ARCH}/Apache2/BuildConfig.pm" || die
+
+	for fname in $(find "${D}" -type f -not -name '*.so'); do
+		grep -q "\(${D}\|${S}\)" "${fname}" && ewarn "QA: File contains a temporary path ${fname}"
+		sed -i -e "s:\(${D}\|${S}\):/:g" ${fname}
+	done
+	# All the rest
+	perl_remove_temppath
+}
+
+pkg_postinst() {
+	apache-module_pkg_postinst
+}