dynamic request hook ordering (Win32 testers needed :)

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: dev-unsubscribe@xxxxxxxxxxxxxxx
For additional commands, e-mail: dev-help@xxxxxxxxxxxxxxx