Re: Does the AxKit-devel mailing list have an archive?
ok, here's the right patch. the deal is, the generated .xs file would
register cleanups for objects created by {DIR,SERVER}_CREATE, but not
MERGE. perl_config.c:perl_perl_merge_cfg() now takes care of this as it
should. i did some testing with t/TestDirectives and do not see any
leakage.
p.s.
(i left the cleanup_av -> cleanup_sv rename in there, even though
the patch no longer uses that function)
Index: src/modules/perl/perl_config.c
===
RCS file: /home/cvs/modperl/src/modules/perl/perl_config.c,v
retrieving revision 1.101
diff -u -r1.101 perl_config.c
--- src/modules/perl/perl_config.c 2000/08/15 19:36:33 1.101
+++ src/modules/perl/perl_config.c 2000/09/22 18:41:22
@@ -436,7 +436,7 @@
sva = newSVpv(arg,0);
if(!*cmd) {
*cmd = newAV();
- register_cleanup(p, (void*)*cmd, mod_perl_cleanup_av, mod_perl_noop);
+ register_cleanup(p, (void*)*cmd, mod_perl_cleanup_sv, mod_perl_noop);
MP_TRACE_d(fprintf(stderr, "init `%s' stack\n", hook));
}
MP_TRACE_d(fprintf(stderr, "perl_cmd_push_handlers: @%s, '%s'\n", hook, arg));
@@ -823,13 +823,13 @@
return NULL;
}
-void mod_perl_cleanup_av(void *data)
+void mod_perl_cleanup_sv(void *data)
{
-AV *av = (AV*)data;
-if(SvREFCNT((SV*)av)) {
- MP_TRACE_g(fprintf(stderr, "cleanup_av: SvREFCNT(0x%lx)==%d\n",
- (unsigned long)av, (int)SvREFCNT((SV*)av)));
- SvREFCNT_dec((SV*)av);
+SV *sv = (SV*)data;
+if (SvREFCNT(sv)) {
+MP_TRACE_g(fprintf(stderr, "cleanup_sv: SvREFCNT(0x%lx)==%d\n",
+ (unsigned long)sv, (int)SvREFCNT(sv)));
+SvREFCNT_dec(sv);
}
}
@@ -929,7 +929,7 @@
*basevp = (mod_perl_perl_dir_config *)basev,
*addvp = (mod_perl_perl_dir_config *)addv;
-SV *sv,
+SV *sv=Nullsv,
*basesv = basevp ? basevp->obj : Nullsv,
*addsv = addvp ? addvp->obj : Nullsv;
@@ -958,16 +958,23 @@
if((perl_eval_ok(NULL) == OK) && (count == 1)) {
sv = POPs;
++SvREFCNT(sv);
- mrg->obj = sv;
mrg->pclass = SvCLASS(sv);
}
PUTBACK;
FREETMPS;LEAVE;
}
else {
- mrg->obj = newSVsv(basesv);
- mrg->pclass = basevp->pclass;
+sv = newSVsv(basesv);
+mrg->pclass = basevp->pclass;
}
+
+if (sv) {
+mrg->obj = sv;
+register_cleanup(p, (void*)mrg,
+ perl_perl_cmd_cleanup, mod_perl_noop);
+
+}
+
return (void *)mrg;
}
Index: src/modules/perl/mod_perl.h
===
RCS file: /home/cvs/modperl/src/modules/perl/mod_perl.h,v
retrieving revision 1.102
diff -u -r1.102 mod_perl.h
--- src/modules/perl/mod_perl.h 2000/08/15 19:36:33 1.102
+++ src/modules/perl/mod_perl.h 2000/09/22 18:41:32
@@ -1132,7 +1132,7 @@
void perl_setup_env(request_rec *r);
SV *perl_bless_request_rec(request_rec *);
void perl_set_request_rec(request_rec *);
-void mod_perl_cleanup_av(void *data);
+void mod_perl_cleanup_sv(void *data);
void mod_perl_cleanup_handler(void *data);
void mod_perl_end_cleanup(void *data);
void mod_perl_register_cleanup(request_rec *r, SV *sv);
Re: Does the AxKit-devel mailing list have an archive?
hold on, that patch was wrong, perl_perl_cmd_cleanup() is called by the Apache::ExtUtils generated .xs, new patch in a few..
Re: Does the AxKit-devel mailing list have an archive?
On Sun, 17 Sep 2000, Matt Sergeant wrote:
> On Sun, 17 Sep 2000, Alexander Farber (EED) wrote:
>
> > Matt Sergeant wrote:
> > > > > # my @vary = $r->header_out('Vary') if $r->header_out('Vary');
> > > > > # push @vary, "Accept-Encoding", "User-Agent";
> > >
> > > I think its a mod_perl bug. There's nothing leaky in the perl here.
> >
> > Isn't it the same as
> > http://www.perl.com/pub/2000/05/p5pdigest/THISWEEK-2521.html#my_x_if_0;_Trick
>
> Nice catch!
>
> Yes it is the same. Thats good news for Doug :-)
good news that i don't need to debug that, better news that i'm not the
sole cause of your leak hunting ;)
there is also a leak in DIR_MERGE, which the patch below should fix.
notice perl_perl_cmd_cleanup() has been removed, it was never being
called, argh. mod_perl_cleanup_sv() does the same, without as much
tracing, but a directive handler class DESTROY method can add more trace
info if desired. this patch also renames mod_perl_cleanup_av to
mod_perl_cleanup_sv, since _av was just casting to an SV* anyhow.
Index: src/modules/perl/perl_config.c
===
RCS file: /home/cvs/modperl/src/modules/perl/perl_config.c,v
retrieving revision 1.101
diff -u -r1.101 perl_config.c
--- src/modules/perl/perl_config.c 2000/08/15 19:36:33 1.101
+++ src/modules/perl/perl_config.c 2000/09/22 18:04:14
@@ -436,7 +436,7 @@
sva = newSVpv(arg,0);
if(!*cmd) {
*cmd = newAV();
- register_cleanup(p, (void*)*cmd, mod_perl_cleanup_av, mod_perl_noop);
+ register_cleanup(p, (void*)*cmd, mod_perl_cleanup_sv, mod_perl_noop);
MP_TRACE_d(fprintf(stderr, "init `%s' stack\n", hook));
}
MP_TRACE_d(fprintf(stderr, "perl_cmd_push_handlers: @%s, '%s'\n", hook, arg));
@@ -823,13 +823,13 @@
return NULL;
}
-void mod_perl_cleanup_av(void *data)
+void mod_perl_cleanup_sv(void *data)
{
-AV *av = (AV*)data;
-if(SvREFCNT((SV*)av)) {
- MP_TRACE_g(fprintf(stderr, "cleanup_av: SvREFCNT(0x%lx)==%d\n",
- (unsigned long)av, (int)SvREFCNT((SV*)av)));
- SvREFCNT_dec((SV*)av);
+SV *sv = (SV*)data;
+if (SvREFCNT(sv)) {
+MP_TRACE_g(fprintf(stderr, "cleanup_sv: SvREFCNT(0x%lx)==%d\n",
+ (unsigned long)sv, (int)SvREFCNT(sv)));
+SvREFCNT_dec(sv);
}
}
@@ -895,6 +895,8 @@
if((perl_eval_ok(parms ? parms->server : NULL) == OK) && (count == 1)) {
*sv = POPs;
++SvREFCNT(*sv);
+register_cleanup(parms->pool, (void*)*sv,
+ mod_perl_cleanup_sv, mod_perl_noop);
}
PUTBACK;
FREETMPS;LEAVE;
@@ -905,6 +907,8 @@
/* return bless {}, $class */
if(!SvTRUE(*sv)) {
*sv = newRV_noinc((SV*)newHV());
+register_cleanup(parms->pool, (void*)*sv,
+ mod_perl_cleanup_sv, mod_perl_noop);
return sv_bless(*sv, pclass);
}
else
@@ -929,7 +933,7 @@
*basevp = (mod_perl_perl_dir_config *)basev,
*addvp = (mod_perl_perl_dir_config *)addv;
-SV *sv,
+SV *sv=Nullsv,
*basesv = basevp ? basevp->obj : Nullsv,
*addsv = addvp ? addvp->obj : Nullsv;
@@ -958,16 +962,22 @@
if((perl_eval_ok(NULL) == OK) && (count == 1)) {
sv = POPs;
++SvREFCNT(sv);
- mrg->obj = sv;
mrg->pclass = SvCLASS(sv);
}
PUTBACK;
FREETMPS;LEAVE;
}
else {
- mrg->obj = newSVsv(basesv);
- mrg->pclass = basevp->pclass;
+sv = newSVsv(basesv);
+mrg->pclass = basevp->pclass;
}
+
+if (sv) {
+mrg->obj = sv;
+register_cleanup(p, (void*)sv,
+ mod_perl_cleanup_sv, mod_perl_noop);
+}
+
return (void *)mrg;
}
@@ -979,18 +989,6 @@
void *perl_perl_merge_srv_config(pool *p, void *basev, void *addv)
{
return perl_perl_merge_cfg(p, basev, addv, PERL_SERVER_MERGE);
-}
-
-void perl_perl_cmd_cleanup(void *data)
-{
-mod_perl_perl_dir_config *cld = (mod_perl_perl_dir_config *)data;
-
-if(cld->obj) {
- MP_TRACE_c(fprintf(stderr,
- "cmd_cleanup: SvREFCNT($%s::$obj) == %d\n",
- cld->pclass, (int)SvREFCNT(cld->obj)));
- SvREFCNT_dec(cld->obj);
-}
}
CHAR_P perl_cmd_perl_TAKE123(cmd_parms *cmd, mod_perl_perl_dir_config *data,
Index: src/modules/perl/mod_perl.h
===
RCS file: /home/cvs/modperl/src/modules/perl/mod_perl.h,v
retrieving revision 1.102
diff -u -r1.102 mod_perl.h
--- src/modules/perl/mod_perl.h 2000/08/15 19:36:33 1.102
+++ src/modules/perl/mod_perl.h 2000/09/22 18:04:26
@@ -1132,7 +1132,7 @@
void perl_setup_env(request_rec *r);
SV *perl_bless_request_rec(request_rec *);
void perl_set_request_rec(request_rec *);
-void mod_perl_cleanup_av(
Re: Does the AxKit-devel mailing list have an archive?
On Sun, 17 Sep 2000, Alexander Farber (EED) wrote:
> Matt Sergeant wrote:
> > > > # my @vary = $r->header_out('Vary') if $r->header_out('Vary');
> > > > # push @vary, "Accept-Encoding", "User-Agent";
> >
> > I think its a mod_perl bug. There's nothing leaky in the perl here.
>
> Isn't it the same as
> http://www.perl.com/pub/2000/05/p5pdigest/THISWEEK-2521.html#my_x_if_0;_Trick
Nice catch!
Yes it is the same. Thats good news for Doug :-)
This probably needs fixing in Apache::GzipChain too then, as the code was
directly cut and paste from there.
--
Fastnet Software Ltd. High Performance Web Specialists
Providing mod_perl, XML, Sybase and Oracle solutions
Email for training and consultancy availability.
http://sergeant.org | AxKit: http://axkit.org
Re: Does the AxKit-devel mailing list have an archive?
Matt Sergeant wrote:
> > > # my @vary = $r->header_out('Vary') if $r->header_out('Vary');
> > > # push @vary, "Accept-Encoding", "User-Agent";
>
> I think its a mod_perl bug. There's nothing leaky in the perl here.
Isn't it the same as
http://www.perl.com/pub/2000/05/p5pdigest/THISWEEK-2521.html#my_x_if_0;_Trick
Re: Does the AxKit-devel mailing list have an archive?
On Fri, 15 Sep 2000, ___cliff rayman___ wrote:
> Matt Sergeant wrote:
>
> >
> > Gzipped results to the browser, ripped straight from Apache::GzipChain:
> >
> > # AxKit::Debug(5, 'Getting Vary header');
> > # my @vary = $r->header_out('Vary') if $r->header_out('Vary');
> > # push @vary, "Accept-Encoding", "User-Agent";
> > # AxKit::Debug(5, 'Setting Vary header');
> > # $r->header_out('Vary',
> > # join ", ",
> > # @vary
> > # );
> >
>
> excuse my ignorance, but for my own knowledge, what is the problem with this code?
>is it the
> "my @vary" with the "if" conditional??
I think its a mod_perl bug. There's nothing leaky in the perl here.
--
Fastnet Software Ltd. High Performance Web Specialists
Providing mod_perl, XML, Sybase and Oracle solutions
Email for training and consultancy availability.
http://sergeant.org | AxKit: http://axkit.org
Re: Does the AxKit-devel mailing list have an archive?
Matt Sergeant wrote:
>
> Gzipped results to the browser, ripped straight from Apache::GzipChain:
>
> # AxKit::Debug(5, 'Getting Vary header');
> # my @vary = $r->header_out('Vary') if $r->header_out('Vary');
> # push @vary, "Accept-Encoding", "User-Agent";
> # AxKit::Debug(5, 'Setting Vary header');
> # $r->header_out('Vary',
> # join ", ",
> # @vary
> # );
>
excuse my ignorance, but for my own knowledge, what is the problem with this code?
is it the
"my @vary" with the "if" conditional??
--
___cliff [EMAIL PROTECTED]http://www.genwax.com/
Re: Does the AxKit-devel mailing list have an archive?
Since a few people have asked what the leak in AxKit was, I've now setup
the archive so people can go and read...
On Fri, 15 Sep 2000, Wilt, Paul wrote:
> I would like to see how you traced down your memory leak and what the final
> root cause turned out to be!
It does now [matt sets up the archive...]
http://axkit.org/cgi-bin/ezmlm-cgi/4
See "Phew- thats a lot of updates!".
For anyone interested in how I debugged it, the exception handling
initiative was absolutely fundamental to this, although I'm thinking of
re-writing the guide section a bit to cover everything that I've changed
my mind about while debugging this. Anyway, I found the second mentioned
leak in the "Phew" message by creating a new mod_perl handler class that
emulated AxKit's minimum path (which just returned DECLINED), which I knew
to be leaking. Gradually I added in some code from AxKit until the leak
showed up. That was the push @_, "\n" bug.
The second one was the worst leak - it seemed to leak memory
exponentially - it would remain stable for about 300 hits, and then
suddenly go absolutely out of control leaking about 50k a hit, then 100k a
hit, until I had a 200M mod_perl process eating nothng but swap. To find
this was where exceptions came in. Once I'd gotten rid of the Debug memory
leak I could then add in a throw Declined(reason => "mem test") anywhere
in the code. This would simply return DECLINED. I moved it further and
further into the code, until it passed the point where it started leaking,
then I had to follow that stepping into the function. And this is where
exceptions are really cool - I don't need to change the method to get
right out to the exception handler - no multiple return() statements to
cope with, just throw the exception and you're out of the code. So anyway,
it turned out that the leak occurs in this code which I use to send
Gzipped results to the browser, ripped straight from Apache::GzipChain:
# AxKit::Debug(5, 'Getting Vary header');
# my @vary = $r->header_out('Vary') if $r->header_out('Vary');
# push @vary, "Accept-Encoding", "User-Agent";
# AxKit::Debug(5, 'Setting Vary header');
# $r->header_out('Vary',
# join ", ",
# @vary
# );
(excuse the fact that its commented out).
Once I removed that the leak was gone.
The final one, which was even trickier to find, was DIR_MERGE (part of
mod_perl's custom config directives code). I had suspected it might leak a
bit, and my suspicions are now confirmed. I'll let Doug deal with that
one.
Its been an exhausting week trying to find this and do real work at the
same time too! Unfortunately it has set back the CMS quite severely and it
won't be ready in time for ApacheCon, so no demo for that I'm afraid...
--
Fastnet Software Ltd. High Performance Web Specialists
Providing mod_perl, XML, Sybase and Oracle solutions
Email for training and consultancy availability.
http://sergeant.org | AxKit: http://axkit.org
