Further reduced to the minimal:

<Location /crash2>
  SetHandler perl-script
  PerlHandler Server::Killer
</Location>

package Server::Killer;

use 5.008;
use strict;

use Apache::Request;
use Apache::Constants qw(:common);

our $GlobalS;

sub handler
{
    my $r = shift;
    $r->send_http_header;
    $r->print("ok");

    my $q=Apache::Request->new($r);
    $GlobalS=$q->param();

    return OK;
}

1;

This patch against the current cvs prevents the segfault. Though it doesn't eliminate the problem, since it's caused elsewhere.

Index: src/modules/perl/perl_util.c
===================================================================
RCS file: /home/cvs/modperl/src/modules/perl/perl_util.c,v
retrieving revision 1.53
diff -u -r1.53 perl_util.c
--- src/modules/perl/perl_util.c        30 Oct 2003 19:39:17 -0000      1.53
+++ src/modules/perl/perl_util.c        13 Nov 2003 01:33:46 -0000
@@ -96,6 +96,7 @@
     if(SvROK(rv) && SvTYPE(SvRV(rv)) == SVt_PVHV) {
        SV *sv = perl_hvrv_magic_obj(rv);
        if(!sv) croak("HV is not magic!");
+       if(!SvROK(sv)) croak("trying to free magic that was freed already!");
        return (table *)SvIV((SV*)SvRV(sv));
     }
     return (table *)SvIV((SV*)SvRV(rv));

It seems that your global $GlobalS var contains a reference to an Apache::Request table, but A-R object is not global, so when the scope of the handler is exited A-R object gets destroyed, leaving $GlobalS containting a pointer to a black hole. That black hole is req->parms in Request.xs in libapreq.

And here is a quick workaround for you, while we are figuring out the origin problem:

    $r->push_handlers(PerlCleanupHandler =>
        sub { undef $GlobalS if defined $GlobalS } );

So the new handler now looks like:

package Server::Killer;

use 5.008;
use strict;

use Apache::Request;
use Apache::Constants qw(:common);

our $GlobalS;

sub handler
{
    my $r = shift;
    $r->send_http_header;
    $r->print("ok");

    my $q=Apache::Request->new($r);
    $GlobalS=$q->param();

    $r->push_handlers(PerlCleanupHandler =>
        sub { undef $GlobalS if defined $GlobalS } );

    return OK;
}

1;

Actually a simple:

    undef $GlobalS;
    return OK;
}

does the trick. Again, what you want to achieve is destroying that global reference to parm before A-R object is destroyed.

Though, since in your original code you import the global symbols you will need to destroy them in the package they were created. But this will do the trick:

    $GlobalS = undef;
    return OK;
}

as it'll affect the alias as well as the exported variable, putting the reference counting to 0.

Joe, any ideas on this one? (we are talking about libapreq1/mp1) May be we should just assume that it's OK that the A-R table was already freed? Does this patch introduce a leak? I'd suggest to write a test for libapreq2 to cover this case.

Index: src/modules/perl/perl_util.c
===================================================================
RCS file: /home/cvs/modperl/src/modules/perl/perl_util.c,v
retrieving revision 1.53
diff -u -r1.53 perl_util.c
--- src/modules/perl/perl_util.c        30 Oct 2003 19:39:17 -0000      1.53
+++ src/modules/perl/perl_util.c        13 Nov 2003 01:49:48 -0000
@@ -96,6 +96,8 @@
     if(SvROK(rv) && SvTYPE(SvRV(rv)) == SVt_PVHV) {
        SV *sv = perl_hvrv_magic_obj(rv);
        if(!sv) croak("HV is not magic!");
+        /* already freed? */
+       if(!SvROK(sv)) return (table *)NULL;
        return (table *)SvIV((SV*)SvRV(sv));
     }
     return (table *)SvIV((SV*)SvRV(rv));
Index: src/modules/perl/Table.xs
===================================================================
RCS file: /home/cvs/modperl/src/modules/perl/Table.xs,v
retrieving revision 1.10
diff -u -r1.10 Table.xs
--- src/modules/perl/Table.xs   23 May 2000 15:56:12 -0000      1.10
+++ src/modules/perl/Table.xs   13 Nov 2003 01:49:48 -0000
@@ -114,9 +114,13 @@
     Apache__Table tab;

     CODE:
-    tab = (Apache__Table)hvrv2table(self);
-    if(SvROK(self) && SvTYPE(SvRV(self)) == SVt_PVHV)
-        safefree(tab);
+    if(self && SvROK(self) && SvTYPE(SvRV(self)) == SVt_PVHV) {
+        tab = (Apache__Table)hvrv2table(self);
+        if (tab) {
+            safefree(tab);
+
+        }
+    }

 void
 FETCH(self, key)


__________________________________________________________________ Stas Bekman JAm_pH ------> Just Another mod_perl Hacker http://stason.org/ mod_perl Guide ---> http://perl.apache.org mailto:[EMAIL PROTECTED] http://use.perl.org http://apacheweek.com http://modperlbook.org http://apache.org http://ticketmaster.com


-- Reporting bugs: http://perl.apache.org/bugs/ Mail list info: http://perl.apache.org/maillist/modperl.html



Reply via email to