[prev in list] [next in list] [prev in thread] [next in thread] 

List:       apache-modperl
Subject:    Re: [mp2] my filter crashes on reverse proxied content
From:       Stas Bekman <stas () stason ! org>
Date:       2004-03-27 0:06:00
Message-ID: 4064C568.4040909 () stason ! org
[Download RAW message or body]

Hi Michael,

>> That looks very similar to the mp2 test.
>>
>> t/filter/TestFilter/both_str_req_proxy.pm
>>
>> Since you didn't run the mp2 test suite at all I'd suggest to start 
>> there.
> 
> 
> I'd be happy to run a few cases, if you can point me to some documentation.

Absolutely: http://perl.apache.org/docs/2.0/os/win32/index.html
Courtesy of Randy Kobes, the brave win32 warrior.

>> I'll try to play with it and see if I can reproduce it. Mind you, I'm 
>> not running on win32.
> 
> 
> I'm curious whether you __can__ reproduce it then, since the problem 
> seems related to threading...

Yes, I should be able to, building perl with special patches (attached) and 
build arguments. There are unpolished yet and therefore not a part of the 
core. The patches are courtesy of Jan Dubois. After applying these patches, to 
build perl you need to add:

./Configure -des [...] \
-Accflags="-DPERL_IMPLICIT_CONTEXT -DPERL_TRACK_MEMPOOL"

Again, you don't need to do that on Win32. You need that to try to emulate 
perl's memory managment on win32, which differs from the rest of platforms. So 
with this patch I run the mp2 test suite without a hitch, so if you can modify 
the test that I've mentioned (closest one to your case) to break, I'll be able 
to fix it.

>>> You can verify it by simply running tomcat in the backend, and 
>>> reverse proxy http://localhost:8080/manager, you will see the same 
>>> behavior.
>>
>>
>>
>> right, "simply running tomcat"... 
> 
> Much simpler then setting up Exchange I can tell you ;-)

:)
__________________________________________________________________
Stas Bekman            JAm_pH ------> Just Another mod_perl Hacker
http://stason.org/     mod_perl Guide ---> http://perl.apache.org
mailto:stas@stason.org http://use.perl.org http://apacheweek.com
http://modperlbook.org http://apache.org   http://ticketmaster.com

["mempool.diff" (text/x-patch)]

--- 1/perl-5.8.3/util.c	2003-12-18 12:48:02.000000000 -0800
+++ perl-5.8.3/util.c	2004-01-21 17:15:41.000000000 -0800
@@ -60,6 +60,9 @@
 	    my_exit(1);
 	}
 #endif /* HAS_64K_LIMIT */
+#if defined(PERL_IMPLICIT_CONTEXT) && defined(PERL_TRACK_MEMPOOL)
+    size += sizeof(aTHX);
+#endif
 #ifdef DEBUGGING
     if ((long)size < 0)
 	Perl_croak_nocontext("panic: malloc");
@@ -67,8 +70,13 @@
     ptr = (Malloc_t)PerlMem_malloc(size?size:1);	/* malloc(0) is NASTY on our system \
*/  PERL_ALLOC_CHECK(ptr);
     DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%"UVxf": (%05ld) malloc %ld \
                bytes\n",PTR2UV(ptr),(long)PL_an++,(long)size));
-    if (ptr != Nullch)
+    if (ptr != Nullch) {
+#if defined(PERL_IMPLICIT_CONTEXT) && defined(PERL_TRACK_MEMPOOL)
+        *(PerlInterpreter**)ptr = aTHX;
+        ptr = (Malloc_t)((char*)ptr+sizeof(aTHX));
+#endif
 	return ptr;
+    }
     else if (PL_nomemok)
 	return Nullch;
     else {
@@ -104,6 +112,12 @@
 
     if (!where)
 	return safesysmalloc(size);
+#if defined(PERL_IMPLICIT_CONTEXT) && defined(PERL_TRACK_MEMPOOL)
+    where = (Malloc_t)((char*)where-sizeof(aTHX));
+    size += sizeof(aTHX);
+    if (*(PerlInterpreter**)where != aTHX)
+        Perl_croak_nocontext("panic: realloc from wrong pool");
+#endif
 #ifdef DEBUGGING
     if ((long)size < 0)
 	Perl_croak_nocontext("panic: realloc");
@@ -114,8 +128,12 @@
     DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%"UVxf": (%05ld) \
                rfree\n",PTR2UV(where),(long)PL_an++));
     DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%"UVxf": (%05ld) realloc %ld \
bytes\n",PTR2UV(ptr),(long)PL_an++,(long)size));  
-    if (ptr != Nullch)
+    if (ptr != Nullch) {
+#if defined(PERL_IMPLICIT_CONTEXT) && defined(PERL_TRACK_MEMPOOL)
+        ptr = (Malloc_t)((char*)ptr+sizeof(aTHX));
+#endif
 	return ptr;
+    }
     else if (PL_nomemok)
 	return Nullch;
     else {
@@ -131,11 +149,16 @@
 Free_t
 Perl_safesysfree(Malloc_t where)
 {
-#ifdef PERL_IMPLICIT_SYS
+#if defined(PERL_IMPLICIT_CONTEXT) || defined(PERL_TRACK_MEMPOOL)
     dTHX;
 #endif
     DEBUG_m( PerlIO_printf(Perl_debug_log, "0x%"UVxf": (%05ld) \
free\n",PTR2UV(where),(long)PL_an++));  if (where) {
+#if defined(PERL_IMPLICIT_CONTEXT) && defined(PERL_TRACK_MEMPOOL)
+        where = (Malloc_t)((char*)where-sizeof(aTHX));
+        if (*(PerlInterpreter**)where != aTHX)
+            Perl_croak_nocontext("panic: free from wrong pool");
+#endif
 	/*SUPPRESS 701*/
 	PerlMem_free(where);
     }
@@ -161,11 +184,18 @@
 	Perl_croak_nocontext("panic: calloc");
 #endif
     size *= count;
+#if defined(PERL_IMPLICIT_CONTEXT) && defined(PERL_TRACK_MEMPOOL)
+    size += sizeof(aTHX);
+#endif
     ptr = (Malloc_t)PerlMem_malloc(size?size:1);	/* malloc(0) is NASTY on our system \
*/  PERL_ALLOC_CHECK(ptr);
     DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%"UVxf": (%05ld) calloc %ld x %ld \
bytes\n",PTR2UV(ptr),(long)PL_an++,(long)count,(long)size));  if (ptr != Nullch) {
 	memset((void*)ptr, 0, size);
+#if defined(PERL_IMPLICIT_CONTEXT) && defined(PERL_TRACK_MEMPOOL)
+        *(PerlInterpreter**)ptr = aTHX;
+        ptr = (Malloc_t)((char*)ptr+sizeof(aTHX));
+#endif
 	return ptr;
     }
     else if (PL_nomemok)
diff -ur 1/perl-5.8.3/perl.h perl-5.8.3/perl.h
--- 1/perl-5.8.3/perl.h	2003-12-14 12:25:21.000000000 -0800
+++ perl-5.8.3/perl.h	2004-01-24 16:16:23.000000000 -0800
@@ -122,6 +122,18 @@
 #  define pTHX_2	3
 #  define pTHX_3	4
 #  define pTHX_4	5
+#  if defined(PERL_TRACK_MEMPOOL) && defined(PERL_IMPLICIT_CONTEXT)
+#    define CHECK_MEMPOOL(p)                                            \
+       if (*(PerlInterpreter**)((char*)p-sizeof(aTHX)) != aTHX) {       \
+           int *nowhere = NULL;                                         \
+           Perl_warn(aTHX_ "panic: modifying memory from wrong pool");  \
+           *nowhere = 0;                                                \
+       }
+#  endif
+#endif
+
+#ifndef CHECK_MEMPOOL
+#  define CHECK_MEMPOOL(p)
 #endif
 
 #define STATIC static
diff -ur 1/perl-5.8.3/sv.c perl-5.8.3/sv.c
--- 1/perl-5.8.3/sv.c	2004-01-14 05:40:13.000000000 -0800
+++ perl-5.8.3/sv.c	2004-01-24 16:35:32.000000000 -0800
@@ -170,6 +170,21 @@
     } STMT_END
 
 
+#if defined(PERL_IMPLICIT_CONTEXT) && defined(PERL_TRACK_MEMPOOL)
+STATIC SV*
+S_new_SV()
+{
+    SV* sv = safemalloc(sizeof(SV));
+    SvANY(sv) = 0;
+    SvREFCNT(sv) = 1;
+    SvFLAGS(sv) = 0;
+    return sv;
+}
+
+#  define new_SV(p) (p)=S_new_SV()
+#  define del_SV(p) safefree((char*)p)
+#else
+
 /* new_SV(): return a new, empty SV head */
 
 #ifdef DEBUG_LEAKING_SCALARS
@@ -253,6 +268,7 @@
 
 #endif /* DEBUGGING */
 
+#endif
 
 /*
 =head1 SV Manipulation Functions
@@ -1633,6 +1649,7 @@
 		SvFAKE_off(sv);
 		SvREADONLY_off(sv);
 	    }
+            CHECK_MEMPOOL(sv);
 	    New(703, s, newlen, char);
 	    if (SvPVX(sv) && SvCUR(sv)) {
 	        Move(SvPVX(sv), s, (newlen < SvCUR(sv)) ? newlen : SvCUR(sv), char);
@@ -10580,6 +10597,23 @@
 EXTERN_C PerlInterpreter *
 perl_clone_host(PerlInterpreter* proto_perl, UV flags);
 
+#if defined(PERL_IMPLICIT_CONTEXT) && defined(PERL_TRACK_MEMPOOL)
+STATIC void
+S_sv_initpv(pTHX_ SV *sv, const char *ptr)
+{
+    STRLEN len = strlen(ptr);
+    sv_upgrade(sv, SVt_PV);
+    New(703, SvPVX(sv), len+1, char);
+    Move(ptr, SvPVX(sv), len+1, char);
+    SvCUR(sv) = len;
+    SvLEN(sv) = len+1;
+    SvPOK_only_UTF8(sv);
+}
+#  define sv_initpv(sv, ptr) S_sv_initpv(aTHX_ sv, ptr)
+#else
+#  define sv_initpv(sv, ptr) sv_setpv(sv, ptr)
+#endif
+
 PerlInterpreter *
 perl_clone(PerlInterpreter *proto_perl, UV flags)
 {
@@ -10818,9 +10852,9 @@
 #endif
     PL_encoding		= sv_dup(proto_perl->Iencoding, param);
 
-    sv_setpvn(PERL_DEBUG_PAD(0), "", 0);	/* For regex debugging. */
-    sv_setpvn(PERL_DEBUG_PAD(1), "", 0);	/* ext/re needs these */
-    sv_setpvn(PERL_DEBUG_PAD(2), "", 0);	/* even without DEBUGGING. */
+    sv_initpv(PERL_DEBUG_PAD(0), "");	/* For regex debugging. */
+    sv_initpv(PERL_DEBUG_PAD(1), "");	/* ext/re needs these */
+    sv_initpv(PERL_DEBUG_PAD(2), "");	/* even without DEBUGGING. */
 
     /* Clone the regex array */
     PL_regex_padav = newAV();



-- 
Report problems: http://perl.apache.org/bugs/
Mail list info: http://perl.apache.org/maillist/modperl.html
List etiquette: http://perl.apache.org/maillist/email-etiquette.html

[prev in list] [next in list] [prev in thread] [next in thread] 

Configure | About | News | Add a list | Sponsored by KoreLogic