hi all ok, I spent some time and was able to get configuration-based dynamic hook ordering working.
the attached patch adds a PerlHook*Handler directive for each request phase (minus the PerlResponseHandler). so, you would have a configuration like this PerlHookTransHandler Last valid values correspond to APR_HOOK* values: ReallyFirst, First, Middle, Last, ReallyLast. the directives (and effects) are global, so they are not allowed in vhosts - you get one shot, just like you did with ClearModuleList/AddModule in 1.3. two things of note: 1 - I really need someone on Win32 to give this a whirl. there's some code in there (swiped from mod_info) that is Win32 specific so it needs to be excercised. running both the mod_perl test suite as well as the attached tests would be greatly appreciated. 2 - on a parallel with this specific feature, I noticed that mod_perl hooks PerlOptions +GlobalRequest logic in post-read-request and header-parser phases, via RUN_FIRST. since we moved user-defined PerlInitHandler logic to RUN_REALLY_FIRST, its possible that user-defined Perl handlers will run _before_ mod_perl gets the chance to insert its global logic. I'm not sure if this is a bad thing, but it sounds bad. so, I created a MODPERL_HOOK_REALLY_FIRST define (-20) to put the +GlobalRequest logic really, really first for those two phases. please review. --Geoff
Index: src/modules/perl/mod_perl.c
===================================================================
RCS file: /home/cvspublic/modperl-2.0/src/modules/perl/mod_perl.c,v
retrieving revision 1.208
diff -u -r1.208 mod_perl.c
--- src/modules/perl/mod_perl.c 13 Feb 2004 14:58:05 -0000 1.208
+++ src/modules/perl/mod_perl.c 27 Feb 2004 16:33:23 -0000
@@ -573,6 +573,9 @@
modperl_trace_logfile_set(s->error_log);
#endif
+ /* fixup the placement of mod_perl in the hook order */
+ modperl_util_resort_hooks(scfg);
+
ap_add_version_component(pconf, MP_VERSION_STRING);
ap_add_version_component(pconf,
Perl_form(aTHX_ "Perl/v%vd", PL_patchlevel));
@@ -713,11 +716,15 @@
ap_hook_create_request(modperl_hook_create_request,
NULL, NULL, APR_HOOK_MIDDLE);
+ /* both of these hooks need to run really, really first.
+ * otherwise, the global request_rec will be set up _after_ some
+ * Perl handlers run.
+ */
ap_hook_post_read_request(modperl_hook_post_read_request,
- NULL, NULL, APR_HOOK_FIRST);
+ NULL, NULL, MODPERL_HOOK_REALLY_FIRST);
ap_hook_header_parser(modperl_hook_header_parser,
- NULL, NULL, APR_HOOK_FIRST);
+ NULL, NULL, MODPERL_HOOK_REALLY_FIRST);
ap_hook_child_init(modperl_hook_child_init,
NULL, NULL, APR_HOOK_FIRST);
@@ -778,6 +785,26 @@
MP_CMD_SRV_FLAG("PerlWarn", warn,
"Turn on -w switch"),
#endif
+ MP_CMD_SRV_TAKE1("PerlHookPostReadRequestHandler", order,
+ "hook order for PerlPostReadRequestHandler"),
+ MP_CMD_SRV_TAKE1("PerlHookTransHandler", order,
+ "hook order for PerlTransHandler"),
+ MP_CMD_SRV_TAKE1("PerlHookMapToStorageHandler", order,
+ "hook order for PerlMapToStorageHandler"),
+ MP_CMD_SRV_TAKE1("PerlHookHeaderParserHandler", order,
+ "hook order for PerlHeaderParserHandler"),
+ MP_CMD_SRV_TAKE1("PerlHookAccessHandler", order,
+ "hook order for PerlAccessHandler"),
+ MP_CMD_SRV_TAKE1("PerlHookAuthenHandler", order,
+ "hook order for PerlAuthenHandler"),
+ MP_CMD_SRV_TAKE1("PerlHookAuthzHandler", order,
+ "hook order for PerlAuthzHandler"),
+ MP_CMD_SRV_TAKE1("PerlHookTypeHandler", order,
+ "hook order for PerlTypeHandler"),
+ MP_CMD_SRV_TAKE1("PerlHookFixupHandler", order,
+ "hook order for PerlFixupHandler"),
+ MP_CMD_SRV_TAKE1("PerlHookLogHandler", order,
+ "hook order for PerlLogHandler"),
MP_CMD_ENTRIES,
{ NULL },
};
Index: src/modules/perl/mod_perl.h
===================================================================
RCS file: /home/cvspublic/modperl-2.0/src/modules/perl/mod_perl.h,v
retrieving revision 1.61
diff -u -r1.61 mod_perl.h
--- src/modules/perl/mod_perl.h 22 Sep 2003 17:43:41 -0000 1.61
+++ src/modules/perl/mod_perl.h 27 Feb 2004 16:33:23 -0000
@@ -108,4 +108,7 @@
const char *,
const char *);
+/* we need to hook a few internal things before APR_HOOK_REALLY_FIRST */
+#define MODPERL_HOOK_REALLY_FIRST (-20)
+
#endif /* MOD_PERL_H */
Index: src/modules/perl/modperl_cmd.c
===================================================================
RCS file: /home/cvspublic/modperl-2.0/src/modules/perl/modperl_cmd.c,v
retrieving revision 1.57
diff -u -r1.57 modperl_cmd.c
--- src/modules/perl/modperl_cmd.c 14 Feb 2004 04:25:01 -0000 1.57
+++ src/modules/perl/modperl_cmd.c 27 Feb 2004 16:33:23 -0000
@@ -142,6 +142,62 @@
return NULL;
}
+MP_CMD_SRV_DECLARE(order)
+{
+ MP_dSCFG(parms->server);
+ const char *name = parms->cmd->name;
+
+ int order;
+
+ /* main server only */
+ MP_CMD_SRV_CHECK;
+
+ /* I tried to put these in the order of utility, thus making
+ * a tedious task as efficient as possible
+ */
+ switch (*arg) {
+ case 'R':
+ case 'r':
+ /* useful */
+ if (! strcasecmp(arg, "ReallyLast")) {
+ order = APR_HOOK_REALLY_LAST;
+ break;
+ }
+ /* useful, but the default */
+ if (! strcasecmp(arg, "ReallyFirst")) {
+ order = APR_HOOK_REALLY_FIRST;
+ break;
+ }
+ case 'L':
+ case 'l':
+ /* also useful */
+ if (! strcasecmp(arg, "Last")) {
+ order = APR_HOOK_LAST;
+ break;
+ }
+ case 'F':
+ case 'f':
+ /* probably won't do what the user expects */
+ if (! strcasecmp(arg, "First")) {
+ order = APR_HOOK_FIRST;
+ break;
+ }
+ case 'M':
+ case 'm':
+ /* probably too vague to be useful */
+ if (! strcasecmp(arg, "Middle")) {
+ order = APR_HOOK_MIDDLE;
+ break;
+ }
+ default:
+ return apr_pstrcat(parms->pool, "invalid value for ",
+ name, ": ", arg, NULL);
+ }
+
+ apr_table_setn(scfg->hook_order, name, apr_itoa(parms->pool, order));
+ return NULL;
+}
+
static int modperl_vhost_is_running(server_rec *s)
{
#ifdef USE_ITHREADS
Index: src/modules/perl/modperl_cmd.h
===================================================================
RCS file: /home/cvspublic/modperl-2.0/src/modules/perl/modperl_cmd.h,v
retrieving revision 1.22
diff -u -r1.22 modperl_cmd.h
--- src/modules/perl/modperl_cmd.h 9 Feb 2004 18:18:16 -0000 1.22
+++ src/modules/perl/modperl_cmd.h 27 Feb 2004 16:33:23 -0000
@@ -42,6 +42,7 @@
MP_CMD_SRV_DECLARE(load_module);
MP_CMD_SRV_DECLARE(set_input_filter);
MP_CMD_SRV_DECLARE(set_output_filter);
+MP_CMD_SRV_DECLARE(order);
#ifdef MP_COMPAT_1X
Index: src/modules/perl/modperl_config.c
===================================================================
RCS file: /home/cvspublic/modperl-2.0/src/modules/perl/modperl_config.c,v
retrieving revision 1.76
diff -u -r1.76 modperl_config.c
--- src/modules/perl/modperl_config.c 14 Feb 2004 01:38:05 -0000 1.76
+++ src/modules/perl/modperl_config.c 27 Feb 2004 16:33:23 -0000
@@ -179,6 +179,9 @@
scfg->gtop = modperl_gtop_new(p);
#endif
+ /* no merge required - applies to the main server only */
+ scfg->hook_order = apr_table_make(p, 2);
+
/* must copy ap_server_argv0, because otherwise any read/write of
* $0 corrupts process' argv[0] (visible with 'ps -ef' on most
* unices). This is due to the logic of calculating PL_origalen in
Index: src/modules/perl/modperl_types.h
===================================================================
RCS file: /home/cvspublic/modperl-2.0/src/modules/perl/modperl_types.h,v
retrieving revision 1.73
diff -u -r1.73 modperl_types.h
--- src/modules/perl/modperl_types.h 12 Feb 2004 02:05:28 -0000 1.73
+++ src/modules/perl/modperl_types.h 27 Feb 2004 16:33:23 -0000
@@ -137,6 +137,7 @@
modperl_options_t *flags;
apr_hash_t *modules;
server_rec *server;
+ MpHV *hook_order;
} modperl_config_srv_t;
typedef struct {
Index: src/modules/perl/modperl_util.c
===================================================================
RCS file: /home/cvspublic/modperl-2.0/src/modules/perl/modperl_util.c,v
retrieving revision 1.62
diff -u -r1.62 modperl_util.c
--- src/modules/perl/modperl_util.c 12 Feb 2004 02:05:28 -0000 1.62
+++ src/modules/perl/modperl_util.c 27 Feb 2004 16:33:23 -0000
@@ -843,3 +843,103 @@
/* copy the SV in case the pool goes out of scope before the perl scalar */
return newSVpv(ap_server_root_relative(p, fname), 0);
}
+
+/* from here down is support for dynamic hook ordering. this is mostly
+ * stolen from mod_info.c, so see also the logic and descriptions there.
+ */
+
+typedef struct
+{
+ void (*dummy)(void *);
+ const char *szName;
+ const char * const *aszPredecessors;
+ const char * const *aszSuccessors;
+ int nOrder;
+} hook_struct_t;
+
+typedef apr_array_header_t * (
+#ifdef WIN32
+__stdcall
+#endif
+* hook_get_t)(void);
+
+typedef struct {
+ const char *name;
+ hook_get_t get;
+} hook_lookup_t;
+
+static hook_lookup_t request_hooks[] = {
+ {"PerlHookPostReadRequestHandler", ap_hook_get_post_read_request},
+ {"PerlHookTransHandler", ap_hook_get_translate_name},
+ {"PerlHookMapToStorageHandler", ap_hook_get_map_to_storage},
+ {"PerlHookHeaderParserHandler", ap_hook_get_header_parser},
+ {"PerlHookAccessHandler", ap_hook_get_access_checker},
+ {"PerlHookAuthenHandler", ap_hook_get_check_user_id},
+ {"PerlHookAuthzHandler", ap_hook_get_auth_checker},
+ {"PerlHookTypeHandler", ap_hook_get_type_checker},
+ {"PerlHookFixupHandler", ap_hook_get_fixups},
+ {"PerlHookLogHandler", ap_hook_get_log_transaction},
+ {NULL},
+};
+
+void modperl_util_resort_hooks(modperl_config_srv_t *scfg) {
+
+ /* change the ordering of a specific phase, placing mod_perl someplace
+ * than the default APR_HOOK_REALLY_FIRST order
+ */
+
+ int i;
+
+ /* if there were no PerlHook*Handler directives we can quit early */
+ if (apr_is_empty_table(scfg->hook_order)) {
+ MP_TRACE_a(MP_FUNC, "hook order table is empty - using defaults");
+ return;
+ }
+
+ /* we have _something_ to process. it would make more sense to have
+ * scfg->hook_order drive the process, but that would require a bunch
+ * of string comparisons to fetch the proper ap_hook_get* function...
+ */
+ for (i = 0; request_hooks[i].name; i++) {
+ int int_order;
+ const char *char_order;
+ apr_array_header_t *hooks;
+ hook_struct_t *elts;
+
+ MP_TRACE_a(MP_FUNC, "finding configured hook order for %s",
+ request_hooks[i].name);
+
+ char_order = apr_table_get(scfg->hook_order, request_hooks[i].name);
+
+ if (char_order == NULL) {
+ MP_TRACE_a(MP_FUNC, "no %s specified - using defaults",
+ request_hooks[i].name);
+ continue;
+ }
+
+ hooks = request_hooks[i].get();
+ elts = (hook_struct_t *)hooks->elts;
+ int_order = atoi(char_order);
+
+ /* isolate mod_perl from the phase hooks and insert new ordering */
+
+ int j;
+ for (j = 0; j < hooks->nelts; j++) {
+ if (strcmp(elts[j].szName,"mod_perl.c") == 0) {
+ if (elts[j].nOrder == MODPERL_HOOK_REALLY_FIRST) {
+ /* XXX hack. don't override any of mod_perl's internal
+ * callbacks, just the ones users can set - szName is set
+ * to mod_perl.c for _every_ registered mod_perl hook.
+ */
+ continue;
+ }
+ MP_TRACE_a(MP_FUNC, "using %s to set hook order to %d",
+ request_hooks[i].name, int_order);
+ elts[j].nOrder = int_order;
+ }
+ }
+ }
+
+ /* resort the hooks */
+ apr_hook_sort_all();
+}
Index: src/modules/perl/modperl_util.h
===================================================================
RCS file: /home/cvspublic/modperl-2.0/src/modules/perl/modperl_util.h,v
retrieving revision 1.51
diff -u -r1.51 modperl_util.h
--- src/modules/perl/modperl_util.h 14 Jan 2004 21:27:40 -0000 1.51
+++ src/modules/perl/modperl_util.h 27 Feb 2004 16:33:23 -0000
@@ -162,4 +162,6 @@
SV *modperl_server_root_relative(pTHX_ SV *sv, const char *fname);
+void modperl_util_resort_hooks(modperl_config_srv_t *scfg);
+
#endif /* MODPERL_UTIL_H */
hook_order_test-mp2.tar.gz
Description: GNU Zip compressed data
--------------------------------------------------------------------- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED]
