On Wed, 16 Aug 2000, Geoffrey Young wrote:
> ack... so the alias only goes one way? I guess it makes sense that we
> can't know at run time what the Init handler stands for, but how come
> get_handlers('PerlInitHandler') comes up blank? Isn't it just a table
> entry?
it's not in the get/set handler lookup table. just use
PostReadRequest/HeaderParser for now, we'll see about making Init do the
right thing with get/set handlers later.
> well, it got the handler ok, but I couldn't set it properly:
>
> #!/usr/bin/perl
>
> my $r = shift;
> $r->set_handlers(PerlCleanupHandler => [\&cleanup]);
> $r->send_http_header('text/plain');
> print "done";
>
> sub cleanup {
> warn "hi";
> }
>
> is a no go. same with using ['My::Cleanup'] as the arg...
ok, fixed, problem described in new Apache.xs comment:
/* since register_cleanups are fifo, and the already registered
* mod_perl_end_cleanup() runs PerlCleanupHandlers, PerlCleanupHandler
* needs to maintain the refcnt itself
*/
> I also noticed that the patch didn't fix the get_handlers() coderef bug:
>
> #!/usr/bin/perl
>
> my $r = shift;
> $r->push_handlers(PerlCleanupHandler => sub { warn "hi"; });
> #my $handlers = $r->get_handlers('PerlCleanupHandler');
> $r->send_http_header('text/plain');
> print "done";
>
> uncomment the get_handlers() line and the cleanup handler never runs and you
> get "Attempt to free unreferenced scalar"
i see the problem, perl_handler_merge_avs() did not increment the
reference counts during av_push(). below is the current patch against cvs
which fixes both problems. thanks for testing geoff!
Index: src/modules/perl/Apache.xs
===================================================================
RCS file: /home/cvs/modperl/src/modules/perl/Apache.xs,v
retrieving revision 1.103
diff -u -r1.103 Apache.xs
--- src/modules/perl/Apache.xs 2000/08/15 19:36:32 1.103
+++ src/modules/perl/Apache.xs 2000/08/21 22:33:32
@@ -73,12 +73,6 @@
void (*set_func) (void *, void *, SV *);
} perl_handler_table;
-typedef struct {
- I32 fill;
- AV *av;
- AV **ptr;
-} perl_save_av;
-
static void set_handler_dir (perl_handler_table *tab, request_rec *r, SV *sv);
static void set_handler_srv (perl_handler_table *tab, request_rec *r, SV *sv);
@@ -101,77 +95,78 @@
{HandlerDirEntry("PerlFixupHandler", PerlFixupHandler)},
{HandlerDirEntry("PerlHandler", PerlHandler)},
{HandlerDirEntry("PerlLogHandler", PerlLogHandler)},
+ {HandlerDirEntry("PerlCleanupHandler", PerlCleanupHandler)},
{ FALSE, NULL }
};
-static void perl_restore_av(void *data)
-{
- perl_save_av *save_av = (perl_save_av *)data;
-
- if(save_av->fill != DONE) {
- AvFILLp(*save_av->ptr) = save_av->fill;
- }
- else if(save_av->av != Nullav) {
- *save_av->ptr = save_av->av;
- }
-}
-
static void perl_handler_merge_avs(char *hook, AV **dest)
{
int i = 0;
HV *hv = perl_get_hv("Apache::PerlStackedHandlers", FALSE);
SV **svp = hv_fetch(hv, hook, strlen(hook), FALSE);
AV *base;
-
+
if(!(svp && SvROK(*svp)))
return;
base = (AV*)SvRV(*svp);
for(i=0; i<=AvFILL(base); i++) {
SV *sv = *av_fetch(base, i, FALSE);
- av_push(*dest, sv);
+ av_push(*dest, SvREFCNT_inc(sv));
}
}
+#define avptr_from_offset(ptr, tab) \
+(AV **)((char *)ptr + (int)(long)tab->offset)
+
static void set_handler_base(void *ptr, perl_handler_table *tab, pool *p, SV *sv)
{
- AV **av = (AV **)((char *)ptr + (int)(long)tab->offset);
+ int do_register_cleanup = 0;
+ AV **av = avptr_from_offset(ptr, tab);
- perl_save_av *save_av =
- (perl_save_av *)palloc(p, sizeof(perl_save_av));
-
- save_av->fill = DONE;
- save_av->av = Nullav;
-
- if((sv == &sv_undef) || (SvIOK(sv) && SvIV(sv) == DONE)) {
- if(AvTRUE(*av)) {
- save_av->fill = AvFILL(*av);
- AvFILLp(*av) = -1;
- }
- }
- else if(SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVAV) {
- if(AvTRUE(*av))
- save_av->av = av_copy_array(*av);
- *av = (AV*)SvRV(sv);
- ++SvREFCNT(*av);
+ if ((sv == &sv_undef) || (SvIOK(sv) && SvIV(sv) == DONE)) {
+ if (!*av) {
+ do_register_cleanup = 1;
+ }
+ if (*av && SvREFCNT(*av)) {
+ SvREFCNT_dec(*av);
+ }
+ *av = newAV();
+ }
+ else if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVAV) {
+ *av = (AV*)SvRV(sv);
+ ++SvREFCNT(*av);
+ do_register_cleanup = 1;
}
else {
- croak("Can't set_handler with that value");
+ croak("Can't set_handler with that value");
+ }
+
+ /* since register_cleanups are fifo, and the already registered
+ * mod_perl_end_cleanup() runs PerlCleanupHandlers, PerlCleanupHandler
+ * needs to maintain the refcnt itself
+ */
+ if (do_register_cleanup && strNE(tab->name, "PerlCleanupHandler")) {
+ register_cleanup(p, (void*)*av, mod_perl_cleanup_av, mod_perl_noop);
}
- save_av->ptr = av;
- register_cleanup(p, save_av, perl_restore_av, mod_perl_noop);
}
-static void set_handler_dir(perl_handler_table *tab, request_rec *r, SV *sv)
+void set_handler_dir(perl_handler_table *tab, request_rec *r, SV *sv)
{
- dPPDIR;
- set_handler_base((void*)cld, tab, r->pool, sv);
+ dPPREQ;
+ if (!cfg->dir_cfg) {
+ cfg->dir_cfg = perl_create_dir_config(r->pool, r->uri);
+ }
+ set_handler_base((void*)cfg->dir_cfg, tab, r->pool, sv);
}
static void set_handler_srv(perl_handler_table *tab, request_rec *r, SV *sv)
{
- dPSRV(r->server);
- set_handler_base((void*)cls, tab, r->pool, sv);
+ dPPREQ;
+ if (!cfg->srv_cfg) {
+ cfg->srv_cfg = perl_create_server_config(r->pool, NULL);
+ }
+ set_handler_base((void*)cfg->srv_cfg, tab, r->pool, sv);
}
static perl_handler_table *perl_handler_lookup(char *name)
@@ -185,29 +180,45 @@
return NULL;
}
-
static SV *get_handlers(request_rec *r, char *hook)
{
AV *avcopy;
AV **av;
+ dPPREQ;
dPPDIR;
dPSRV(r->server);
void *ptr;
perl_handler_table *tab = perl_handler_lookup(hook);
- if(!tab) return Nullsv;
+ if (!tab) {
+ return Nullsv;
+ }
- if(tab->type == PER_DIR_CONFIG)
- ptr = (void*)cld;
- else
- ptr = (void*)cls;
+ if (tab->type == PER_DIR_CONFIG) {
+ if (cfg->dir_cfg && *avptr_from_offset(cfg->dir_cfg, tab)) {
+ ptr = (void*)cfg->dir_cfg;
+ }
+ else {
+ ptr = (void*)cld;
+ }
+ }
+ else {
+ if (cfg->srv_cfg && *avptr_from_offset(cfg->srv_cfg, tab)) {
+ ptr = (void*)cfg->srv_cfg;
+ }
+ else {
+ ptr = (void*)cls;
+ }
+ }
- av = (AV **)((char *)ptr + (int)(long)tab->offset);
+ av = avptr_from_offset(ptr, tab);
- if(*av)
+ if (*av) {
avcopy = av_copy_array(*av);
- else
- avcopy = newAV();
+ }
+ else {
+ avcopy = newAV();
+ }
perl_handler_merge_avs(hook, &avcopy);
Index: src/modules/perl/mod_perl.c
===================================================================
RCS file: /home/cvs/modperl/src/modules/perl/mod_perl.c,v
retrieving revision 1.124
diff -u -r1.124 mod_perl.c
--- src/modules/perl/mod_perl.c 2000/08/15 19:36:33 1.124
+++ src/modules/perl/mod_perl.c 2000/08/21 22:33:32
@@ -891,7 +891,8 @@
}
cfg->setup_env = 1;
- PERL_CALLBACK("PerlHandler", cld->PerlHandler);
+ PERL_CALLBACK("PerlHandler",
+ PERL_REQ_DIR_HANDLER(cfg, cld, PerlHandler));
cfg->setup_env = 0;
FREETMPS;
@@ -965,16 +966,21 @@
{
dSTATUS;
dPSRV(r->server);
+ dPPREQ;
+
#if MODULE_MAGIC_NUMBER > 19980270
if(r->parsed_uri.scheme && r->parsed_uri.hostname && do_proxy(r)) {
r->proxyreq = 1;
r->uri = r->unparsed_uri;
}
#endif
+
#ifdef PERL_INIT
- PERL_CALLBACK("PerlInitHandler", cls->PerlInitHandler);
+ PERL_CALLBACK("PerlInitHandler",
+ PERL_REQ_SRV_HANDLER(cfg, cls, PerlInitHandler));
#endif
- PERL_CALLBACK("PerlPostReadRequestHandler", cls->PerlPostReadRequestHandler);
+ PERL_CALLBACK("PerlPostReadRequestHandler",
+ PERL_REQ_SRV_HANDLER(cfg, cls, PerlPostReadRequestHandler));
return status;
}
#endif
@@ -984,7 +990,9 @@
{
dSTATUS;
dPSRV(r->server);
- PERL_CALLBACK("PerlTransHandler", cls->PerlTransHandler);
+ dPPREQ;
+ PERL_CALLBACK("PerlTransHandler",
+ PERL_REQ_SRV_HANDLER(cfg, cls, PerlTransHandler));
return status;
}
#endif
@@ -994,12 +1002,13 @@
{
dSTATUS;
dPPDIR;
+ dPPREQ;
#ifdef PERL_INIT
PERL_CALLBACK("PerlInitHandler",
- cld->PerlInitHandler);
+ PERL_REQ_DIR_HANDLER(cfg, cld, PerlInitHandler));
#endif
PERL_CALLBACK("PerlHeaderParserHandler",
- cld->PerlHeaderParserHandler);
+ PERL_REQ_DIR_HANDLER(cfg, cld, PerlHeaderParserHandler));
return status;
}
#endif
@@ -1009,7 +1018,9 @@
{
dSTATUS;
dPPDIR;
- PERL_CALLBACK("PerlAuthenHandler", cld->PerlAuthenHandler);
+ dPPREQ;
+ PERL_CALLBACK("PerlAuthenHandler",
+ PERL_REQ_DIR_HANDLER(cfg, cld, PerlAuthenHandler));
return status;
}
#endif
@@ -1019,7 +1030,9 @@
{
dSTATUS;
dPPDIR;
- PERL_CALLBACK("PerlAuthzHandler", cld->PerlAuthzHandler);
+ dPPREQ;
+ PERL_CALLBACK("PerlAuthzHandler",
+ PERL_REQ_DIR_HANDLER(cfg, cld, PerlAuthzHandler));
return status;
}
#endif
@@ -1029,7 +1042,9 @@
{
dSTATUS;
dPPDIR;
- PERL_CALLBACK("PerlAccessHandler", cld->PerlAccessHandler);
+ dPPREQ;
+ PERL_CALLBACK("PerlAccessHandler",
+ PERL_REQ_DIR_HANDLER(cfg, cld, PerlAccessHandler));
return status;
}
#endif
@@ -1039,7 +1054,9 @@
{
dSTATUS;
dPPDIR;
- PERL_CALLBACK("PerlTypeHandler", cld->PerlTypeHandler);
+ dPPREQ;
+ PERL_CALLBACK("PerlTypeHandler",
+ PERL_REQ_DIR_HANDLER(cfg, cld, PerlTypeHandler));
return status;
}
#endif
@@ -1049,7 +1066,9 @@
{
dSTATUS;
dPPDIR;
- PERL_CALLBACK("PerlFixupHandler", cld->PerlFixupHandler);
+ dPPREQ;
+ PERL_CALLBACK("PerlFixupHandler",
+ PERL_REQ_DIR_HANDLER(cfg, cld, PerlFixupHandler));
return status;
}
#endif
@@ -1059,7 +1078,9 @@
{
dSTATUS;
dPPDIR;
- PERL_CALLBACK("PerlLogHandler", cld->PerlLogHandler);
+ dPPREQ;
+ PERL_CALLBACK("PerlLogHandler",
+ PERL_REQ_DIR_HANDLER(cfg, cld, PerlLogHandler));
return status;
}
#endif
@@ -1117,9 +1138,14 @@
request_rec *r = (request_rec *)data;
dSTATUS;
dPPDIR;
+ dPPREQ;
#ifdef PERL_CLEANUP
- PERL_CALLBACK("PerlCleanupHandler", CleanupHandler);
+ PERL_CALLBACK("PerlCleanupHandler",
+ PERL_REQ_DIR_HANDLER(cfg, cld, PerlCleanupHandler));
+ if (PERL_HAS_REQ_DIR_HANDLER(cfg, PerlCleanupHandler)) {
+ SvREFCNT_dec((SV*)cfg->dir_cfg->PerlCleanupHandler);
+ }
#endif
MP_TRACE_g(fprintf(stderr, "perl_end_cleanup..."));
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/08/21 22:33:33
@@ -1058,7 +1058,21 @@
HV *pnotes;
int setup_env;
array_header *sigsave;
+ perl_dir_config *dir_cfg;
+ perl_server_config *srv_cfg;
} perl_request_config;
+
+#define PERL_HAS_REQ_DIR_HANDLER(cfg, h) \
+(cfg && cfg->dir_cfg && cfg->dir_cfg->h)
+
+#define PERL_HAS_REQ_SRV_HANDLER(cfg, h) \
+(cfg && cfg->srv_cfg && cfg->srv_cfg->h)
+
+#define PERL_REQ_DIR_HANDLER(cfg, cld, h) \
+(PERL_HAS_REQ_DIR_HANDLER(cfg,h) ? cfg->dir_cfg->h : cld->h)
+
+#define PERL_REQ_SRV_HANDLER(cfg, cls, h) \
+(PERL_HAS_REQ_SRV_HANDLER(cfg, h) ? cfg->srv_cfg->h : cls->h)
typedef struct {
int is_method;
