hi all

ok, I think the below patch handles everything that we had talked about over
the past week wrt +SetupEnv and %ENV.

in essence, here is the behavior that this patch implements:

  - under normal +SetupEnv circumstances (default perl-script or
modperl+SetupEnv), %ENV is set up with CGI variables and subprocess_env
table entries just prior to content generation.

  - -SetupEnv (default modperl or perl-script-SetupEnv) does nothing at all
to %ENV.

  - $r->subprocess_env() in a void context will force early population of
%ENV with both CGI variables and subprocess_env table entries

  - regardless of the state of %ENV, +SetupEnv _always_ tries to populate
%ENV with subprocess_env table entries.  this prevents void
$r->subprocess_env() calls from essentially locking out future table entries
from making it to %ENV.

  - CGI variables are set up only once for efficiency - either just prior to
content generation or on the first $r->subprocess_env() void call.

  - void $r->subprocess_env() calls will _not_ assure that future
subprocess_env entries will make it to %ENV - that's for +SetupEnv.

the net result is that with +SetupEnv content handlers are assured to have
both CGI variables and all subprocess_env table entries without interference
from handlers in prior phases.  the contents of %ENV is not guaranteed
anywhere else. specifically it is not guaranteed to be consistent across
phases (but it never was anyway).

anyway, the test setup for this is interesting - I wanted to use t_cmp from
within the handlers, which required a bit of non-standard juggling.  as for
the per-connection interpreter scope, it's not required for the tests to
pass under normal circumstances, but I was occasionally getting "plan before
you test!" errors that would go away with no changes, which I attributed to
swapped interpreters.  I suppose that I could plan at the start of each
request, but that might be even more strange.

--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.206
diff -u -r1.206 mod_perl.c
--- src/modules/perl/mod_perl.c 10 Jan 2004 05:01:04 -0000      1.206
+++ src/modules/perl/mod_perl.c 4 Feb 2004 20:52:43 -0000
@@ -837,8 +837,30 @@
 
 int modperl_response_handler(request_rec *r)
 {
+    MP_dDCFG;
+
+#ifdef USE_ITHREADS
+    pTHX;
+    modperl_interp_t *interp;
+#endif
+
     if (!strEQ(r->handler, "modperl")) {
         return DECLINED;
+    }
+
+    /* default is -SetupEnv, add if PerlOption +SetupEnv */
+    if (MpDirSETUP_ENV(dcfg)) {
+        MP_dRCFG;
+
+#ifdef USE_ITHREADS
+        interp = modperl_interp_select(r, r->connection, r->server);
+        aTHX = interp->perl;
+        if (MpInterpPUTBACK(interp)) {
+            rcfg->interp = interp;
+        }
+#endif
+
+        modperl_env_request_populate(aTHX_ r);
     }
 
     return modperl_response_handler_run(r, TRUE);
Index: src/modules/perl/modperl_callback.c
===================================================================
RCS file: /home/cvspublic/modperl-2.0/src/modules/perl/modperl_callback.c,v
retrieving revision 1.65
diff -u -r1.65 modperl_callback.c
--- src/modules/perl/modperl_callback.c 9 Jan 2004 04:59:18 -0000       1.65
+++ src/modules/perl/modperl_callback.c 4 Feb 2004 20:52:43 -0000
@@ -187,10 +187,6 @@
         modperl_handler_make_args(aTHX_ &av_args,
                                   "Apache::RequestRec", r, NULL);
 
-        /* only happens once per-request */
-        if (MpDirSETUP_ENV(dcfg)) {
-            modperl_env_request_populate(aTHX_ r);
-        }
         break;
       case MP_HANDLER_TYPE_PRE_CONNECTION:
       case MP_HANDLER_TYPE_CONNECTION:
Index: src/modules/perl/modperl_env.c
===================================================================
RCS file: /home/cvspublic/modperl-2.0/src/modules/perl/modperl_env.c,v
retrieving revision 1.29
diff -u -r1.29 modperl_env.c
--- src/modules/perl/modperl_env.c      22 Sep 2003 23:29:52 -0000      1.29
+++ src/modules/perl/modperl_env.c      4 Feb 2004 20:52:44 -0000
@@ -218,26 +218,47 @@
 {
     MP_dRCFG;
 
-    if (MpReqSETUP_ENV(rcfg)) {
-        return;
-    }
-            
+    /* this is called under the following conditions
+     *   - if PerlOptions +SetupEnv
+     *   - if $r->subprocess_env() is called in a void context with no args
+     *
+     * normally, %ENV is only populated once per request (if at all) -
+     * just prior to content generation if +SetupEnv.
+     *
+     * however, in the $r->subprocess_env() case it will be called 
+     * more than once - once for each void call, and once again just
+     * prior to content generation.  while costly, the multiple
+     * passes are required, otherwise void calls would prohibit later
+     * phases from populating %ENV with new subprocess_env table entries
+     */
+
     /* XXX: might want to always do this regardless of PerlOptions -SetupEnv */
     modperl_env_configure_request(r);
 
-    ap_add_common_vars(r);
-    ap_add_cgi_vars(r);
-
     MP_TRACE_e(MP_FUNC, "\n\t[%s/0x%lx/%s%s]"
                "[EMAIL PROTECTED] r->subprocess_env} = values r->subprocess_env;",
                modperl_pid_tid(r->pool), modperl_interp_address(aTHX),
                modperl_server_desc(r->server, r->pool), r->uri);
-    modperl_env_table_populate(aTHX_ r->subprocess_env);
+
+    /* however, we can eliminate some of the cost by only doing CGI
+     * variables once per-request no matter what.
+     */
+    if (! MpReqSETUP_ENV(rcfg)) {
+
+        ap_add_common_vars(r);
+        ap_add_cgi_vars(r);
 
 #ifdef MP_COMPAT_1X
-    modperl_env_default_populate(aTHX); /* reset GATEWAY_INTERFACE */
+        modperl_env_default_populate(aTHX); /* reset GATEWAY_INTERFACE */
 #endif
+    }
+
+    modperl_env_table_populate(aTHX_ r->subprocess_env);
 
+    /* don't set up CGI variables again.
+     * this also triggers modperl_env_request_unpopulate, which
+     * resets %ENV between requests - see modperl_config_request_cleanup 
+     */
     MpReqSETUP_ENV_On(rcfg);
 }
 
Index: t/hooks/TestHooks/headerparser.pm
===================================================================
RCS file: /home/cvspublic/modperl-2.0/t/hooks/TestHooks/headerparser.pm,v
retrieving revision 1.2
diff -u -r1.2 headerparser.pm
--- t/hooks/TestHooks/headerparser.pm   11 Apr 2002 11:08:43 -0000      1.2
+++ t/hooks/TestHooks/headerparser.pm   4 Feb 2004 20:52:45 -0000
@@ -13,7 +13,7 @@
 sub handler {
     my $r = shift;
 
-    $r->notes->set(url => $ENV{REQUEST_URI});
+    $r->notes->set(headerparser => 'set');
 
     Apache::OK;
 }
@@ -23,7 +23,7 @@
 
     plan $r, tests => 1;
 
-    ok $r->notes->get('url') eq $r->uri;
+    ok $r->notes->get('headerparser') eq 'set';
 
     Apache::OK;
 }
Index: xs/Apache/RequestRec/Apache__RequestRec.h
===================================================================
RCS file: /home/cvspublic/modperl-2.0/xs/Apache/RequestRec/Apache__RequestRec.h,v
retrieving revision 1.9
diff -u -r1.9 Apache__RequestRec.h
--- xs/Apache/RequestRec/Apache__RequestRec.h   30 Jan 2004 18:20:10 -0000      1.9
+++ xs/Apache/RequestRec/Apache__RequestRec.h   4 Feb 2004 20:52:48 -0000
@@ -47,12 +47,9 @@
                                            char *key, SV *val)
 {
     /* if called in a void context with no arguments, just
-     * populate %ENV and stop.  resetting SetupEnv off makes
-     * calling in a void context more than once meaningful.
+     * populate %ENV and stop.
      */
     if (key == NULL && GIMME_V == G_VOID) {
-        MP_dRCFG;
-        MpReqSETUP_ENV_Off(rcfg); 
         modperl_env_request_populate(aTHX_ r);
         return &PL_sv_undef;
     }

--- /dev/null   2003-01-30 05:24:37.000000000 -0500
+++ t/response/TestModperl/setupenv.pm  2004-02-04 15:52:29.000000000 -0500
@@ -0,0 +1,254 @@
+package TestModperl::setupenv;
+
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::RequestRec ();
+use APR::Table ();
+
+use Apache::Test;
+use Apache::TestUtil;
+
+use Apache::Const -compile => qw(OK DECLINED);
+
+sub handler {
+
+    my $r = shift;
+
+    # how many different URIs will be hit?
+    my $requests = $r->args;
+
+    # $requests locations with 3 tests each
+    plan $r, tests => $requests * 5;
+
+    return Apache::OK;
+}
+
+sub env {
+
+    Apache::Test::init_test_pm(shift);  # tie STDOUT
+
+    ok t_cmp(Apache::Test::vars('remote_addr'),
+             $ENV{REMOTE_ADDR},
+             'found REMOTE_ADDR in %ENV');
+
+    ok t_cmp('set',
+             $ENV{ONE},
+             'found subprocess_env table entry ONE in %ENV');
+
+    ok t_cmp('set',
+             $ENV{TWO},
+             'found subprocess_env table entry TWO in %ENV');
+
+    ok t_cmp('set',
+             $ENV{SETENV},
+             'found SetEnv entry in %ENV');
+
+    ok t_cmp('set',
+             $ENV{PERLSETENV},
+             'found PerlSetEnv entry in %ENV');
+
+    return Apache::OK;
+}
+
+sub noenv {
+
+    Apache::Test::init_test_pm(shift);  # tie STDOUT
+
+    ok t_cmp(undef,
+             $ENV{REMOTE_ADDR},
+             'REMOTE_ADDR not found in %ENV');
+
+    ok t_cmp(undef,
+             $ENV{ONE},
+             'subprocess_env table entry ONE not found in %ENV');
+
+    ok t_cmp(undef,
+             $ENV{TWO},
+             'subprocess_env table entry TWO not found in %ENV');
+
+    ok t_cmp(undef,
+             $ENV{SETENV},
+             'SetEnv entry not found in %ENV');
+
+    ok t_cmp(undef,
+             $ENV{PERLSETENV},
+             'PerlSetEnv entry not found in %ENV');
+
+    return Apache::OK;
+}
+
+sub someenv {
+
+    Apache::Test::init_test_pm(shift);  # tie STDOUT
+
+    ok t_cmp(Apache::Test::vars('remote_addr'),
+             $ENV{REMOTE_ADDR},
+             'found REMOTE_ADDR in %ENV');
+
+    # set before void call
+    ok t_cmp('set',
+             $ENV{ONE},
+             'found subprocess_env table entry one in %ENV');
+
+    ok t_cmp(undef,
+             $ENV{TWO},
+             'subprocess_env table entry TWO not found in %ENV');
+
+    ok t_cmp(undef,
+             $ENV{SETENV},
+             'SetEnv entry not found in %ENV');
+
+    # PerlSetEnv gets done earlier than SetEnv
+    ok t_cmp('set',
+             $ENV{PERLSETENV},
+             'found PerlSetEnv entry in %ENV');
+
+    return Apache::OK;
+}
+
+sub subenv_void {
+
+    shift->subprocess_env;
+
+    return Apache::OK;
+}
+
+sub subenv_one {
+
+    shift->subprocess_env->set(ONE => 'set');
+
+    return Apache::OK;
+}
+
+sub subenv_two {
+
+    shift->subprocess_env->set(TWO => 'set');
+
+    return Apache::OK;
+}
+
+1;
+__DATA__
+# create a separate virtual host so we can use
+# keepalives - a per-connection interpreter is
+# the only way to make sure that we can plan in
+# one request and test in subsequent tests
+<NoAutoConfig>
+<VirtualHost TestModperl::setupenv>
+
+    KeepAlive On
+
+    <IfDefine PERL_ITHREADS>
+        PerlInterpScope connection
+    </Ifdefine>
+
+    PerlModule TestModperl::setupenv
+
+    PerlPostReadRequestHandler TestModperl::setupenv::subenv_one
+    SetEnv SETENV set
+    PerlSetEnv PERLSETENV set
+
+    # plan
+    <Location /TestModperl__setupenv>
+        SetHandler modperl
+        PerlResponseHandler TestModperl::setupenv
+    </Location>
+
+    # default modperl handler
+    # %ENV should not contain standard CGI variables
+    # or entries from the subprocess_env table
+    <Location /TestModperl__setupenv_mpdefault>
+        SetHandler modperl
+        PerlResponseHandler TestModperl::setupenv::noenv
+
+        PerlFixupHandler TestModperl::setupenv::subenv_two
+    </Location>
+
+    # modperl handler + SetupEnv
+    # %ENV should contain CGI variables as well as
+    # anything put into the subprocess_env table
+    <Location /TestModperl__setupenv_mpsetup>
+        SetHandler modperl
+        PerlResponseHandler TestModperl::setupenv::env
+
+        PerlOptions +SetupEnv
+
+        PerlFixupHandler TestModperl::setupenv::subenv_two
+    </Location>
+
+    # $r->subprocess_env in a void context with no args
+    # should do the same as +SetupEnv wrt CGI variables
+    # and entries already in the subprocess_env table
+    # but subprocess_env entries that appear later will
+    # not show up in %ENV
+    <Location /TestModperl__setupenv_mpvoid>
+        SetHandler modperl
+        PerlResponseHandler TestModperl::setupenv::someenv
+
+        PerlHeaderParserHandler TestModperl::setupenv::subenv_void
+        PerlFixupHandler TestModperl::setupenv::subenv_two
+    </Location>
+
+    # +SetupEnv should always populate %ENV fully prior
+    # to running the content handler (regardless of when
+    # $r->subprocess_env() was called) to ensure that
+    # %ENV is an accurate representation of the
+    # subprocess_env table
+    <Location /TestModperl__setupenv_mpsetupvoid>
+        SetHandler modperl
+        PerlResponseHandler TestModperl::setupenv::env
+
+        PerlOptions +SetupEnv
+    
+        PerlHeaderParserHandler TestModperl::setupenv::subenv_void
+        PerlFixupHandler TestModperl::setupenv::subenv_two
+    </Location>
+
+    # default perl-script handler is equivalent to +SetupEnv
+    # CGI variables and subprocess_env entries will be in %ENV
+    <Location /TestModperl__setupenv_psdefault>
+        SetHandler perl-script
+        PerlResponseHandler TestModperl::setupenv::env
+
+        PerlFixupHandler TestModperl::setupenv::subenv_two
+    </Location>
+
+    # -SetupEnv should not put CGI variables or subprocess_env
+    # entries in %ENV
+    <Location /TestModperl__setupenv_psnosetup>
+        SetHandler perl-script
+        PerlResponseHandler TestModperl::setupenv::noenv
+
+        PerlOptions -SetupEnv
+
+        PerlFixupHandler TestModperl::setupenv::subenv_two
+    </Location>
+
+    # +SetupEnv should always populate %ENV fully prior
+    # to running the content handler (regardless of when
+    # $r->subprocess_env() was called) to ensure that
+    # %ENV is an accurate representation of the
+    # subprocess_env table
+    <Location /TestModperl__setupenv_psvoid>
+        SetHandler perl-script
+        PerlResponseHandler TestModperl::setupenv::env
+
+        PerlHeaderParserHandler TestModperl::setupenv::subenv_void
+        PerlFixupHandler TestModperl::setupenv::subenv_two
+    </Location>
+
+    # equivalent to modperl handler with $r->subprocess_env() - 
+    # CGI variables are there, but not subprocess_env entries
+    # that are populated after the void call
+    <Location /TestModperl__setupenv_psnosetupvoid>
+        SetHandler perl-script
+        PerlResponseHandler TestModperl::setupenv::someenv
+
+        PerlOptions -SetupEnv
+
+        PerlHeaderParserHandler TestModperl::setupenv::subenv_void
+        PerlFixupHandler TestModperl::setupenv::subenv_two
+    </Location>
+</VirtualHost>
+</NoAutoConfig>

--- /dev/null   2003-01-30 05:24:37.000000000 -0500
+++ t/modperl/setupenv.t        2004-02-04 15:06:55.000000000 -0500
@@ -0,0 +1,48 @@
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::TestRequest qw(GET_BODY_ASSERT);
+use Apache::Test;
+use Apache::TestUtil;
+
+my $module   = "TestModperl::setupenv";
+Apache::TestRequest::module($module);
+
+my $config   = Apache::Test::config();
+my $hostport = Apache::TestRequest::hostport($config);
+my $path     = Apache::TestRequest::module2path($module);
+
+my $base = "http://$hostport/$path";;
+
+t_debug("connecting to $base");
+
+my @locations = ("${base}_mpdefault",
+                 "${base}_mpsetup",
+                 "${base}_mpdefault",  # make sure %ENV is cleared
+                 "${base}_mpvoid",
+                 "${base}_mpsetupvoid",
+                 "${base}_psdefault",
+                 "${base}_psnosetup",
+                 "${base}_psvoid",
+                 "${base}_psnosetupvoid");
+
+# plan the tests from a handler so we can run
+# tests from within handlers across multiple requests
+#
+# this requires keepalives and a per-connection interpreter
+# to make certain we can plan in one request and test in another
+
+Apache::TestRequest::user_agent(keep_alive => 1);
+print GET_BODY_ASSERT join '?', $base, scalar @locations;
+
+# this tests for when %ENV is populated with CGI variables
+# as well as the contents of the subprocess_env table
+#
+# see setupenv.pm for a full description of the tests
+
+foreach my $location (@locations) {
+
+    t_debug("trying $location");
+
+    print GET_BODY_ASSERT $location;
+}

---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]

Reply via email to