geoff 2004/02/11 18:05:29
Modified: . Changes
src/modules/perl modperl_cmd.c modperl_config.c
modperl_types.h modperl_util.c
todo release
Added: t/htdocs/merge2 htaccess
t/modperl merge.t merge2.t merge3.t
t/response/TestModperl merge.pm
Log:
fix PerlAddVar configuration merging
(short explanation, lots of work)
Revision Changes Path
1.327 +2 -0 modperl-2.0/Changes
Index: Changes
===================================================================
RCS file: /home/cvs/modperl-2.0/Changes,v
retrieving revision 1.326
retrieving revision 1.327
diff -u -r1.326 -r1.327
--- Changes 9 Feb 2004 19:44:41 -0000 1.326
+++ Changes 12 Feb 2004 02:05:28 -0000 1.327
@@ -12,6 +12,8 @@
=item 1.99_13-dev
+fix PerlAddVar configuration merging [Geoffrey Young]
+
Anonymous subs are now supported in push_handlers, set_handlers,
add_input_filter, etc. A fast cached cv is used with non-ithreaded
perl. A slower deparse/eval approach (via B::Deparse) is used with
1.55 +27 -2 modperl-2.0/src/modules/perl/modperl_cmd.c
Index: modperl_cmd.c
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_cmd.c,v
retrieving revision 1.54
retrieving revision 1.55
diff -u -r1.54 -r1.55
--- modperl_cmd.c 9 Feb 2004 18:18:16 -0000 1.54
+++ modperl_cmd.c 12 Feb 2004 02:05:28 -0000 1.55
@@ -241,17 +241,42 @@
modperl_config_dir_t *dcfg = (modperl_config_dir_t *)mconfig;
const char *name = parms->cmd->name;
+ /* PerlSetVar and PerlAddVar logic. here's the deal...
+ *
+ * cfg->configvars holds the final PerlSetVar/PerlAddVar configuration
+ * for a given server or directory. however, getting to that point
+ * is kind of tricky, due to the add-style nature of PerlAddVar.
+ *
+ * the solution is to use cfg->setvars to hold PerlSetVar entries
+ * and cfg->addvars to hold PerlAddVar entries, each serving as a
+ * placeholder for when we need to know what's what in the merge routines.
+ *
+ * however, for the initial pass, apr_table_setn and apr_table_addn
+ * will properly build the configvars table, which will be visible to
+ * startup scripts trying to access per-server configurations.
+ *
+ * the end result is that we need to populate all three tables in order
+ * to keep things straight later on see merge_table_config_vars in
+ * modperl_config.c
+ */
modperl_table_modify_t func =
strEQ(name, "PerlSetVar") ? apr_table_setn : apr_table_addn;
- func(dcfg->vars, arg1, arg2);
+ apr_table_t *table =
+ strEQ(name, "PerlSetVar") ? dcfg->setvars : dcfg->addvars;
+
+ func(table, arg1, arg2);
+ func(dcfg->configvars, arg1, arg2);
MP_TRACE_d(MP_FUNC, "%s DIR: arg1 = %s, arg2 = %s\n",
name, arg1, arg2);
/* make available via Apache->server->dir_config */
if (!parms->path) {
- func(scfg->vars, arg1, arg2);
+ table = strEQ(name, "PerlSetVar") ? scfg->setvars : scfg->addvars;
+
+ func(table, arg1, arg2);
+ func(scfg->configvars, arg1, arg2);
MP_TRACE_d(MP_FUNC, "%s SRV: arg1 = %s, arg2 = %s\n",
name, arg1, arg2);
1.75 +97 -20 modperl-2.0/src/modules/perl/modperl_config.c
Index: modperl_config.c
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_config.c,v
retrieving revision 1.74
retrieving revision 1.75
diff -u -r1.74 -r1.75
--- modperl_config.c 10 Jan 2004 02:52:20 -0000 1.74
+++ modperl_config.c 12 Feb 2004 02:05:28 -0000 1.75
@@ -17,24 +17,26 @@
#define merge_item(item) \
mrg->item = add->item ? add->item : base->item
-/* take the 'base' values, and override with 'add' values if any */
static apr_table_t *modperl_table_overlap(apr_pool_t *p,
apr_table_t *base,
apr_table_t *add)
{
- int i;
- const apr_array_header_t *arr = apr_table_elts(base);
- apr_table_entry_t *entries = (apr_table_entry_t *)arr->elts;
- apr_table_t *merge = apr_table_copy(p, add);
-
- for (i = 0; i < arr->nelts; i++) {
- if (apr_table_get(add, entries[i].key)) {
- continue;
- }
- else {
- apr_table_addn(merge, entries[i].key, entries[i].val);
- }
- }
+ /* take the base (parent) values, and override with add (child) values,
+ * generating a new table. entries in add but not in base will be
+ * added to the new table. all using core apr table routines.
+ *
+ * note that this is equivalent to apr_table_overlap except a new
+ * table is generated, which is required (otherwise we would clobber
+ * the existing parent or child configurations)
+ */
+ apr_table_t *merge = apr_table_overlay(p, base, add);
+
+ /* compress will squash each key to the last value in the table. this
+ * is acceptable for all tables that expect only a single value per key
+ * such as PerlPassEnv and PerlSetEnv. PerlSetVar/PerlAddVar get their
+ * own, non-standard, merge routines in merge_table_config_vars.
+ */
+ apr_table_compress(merge, APR_OVERLAP_TABLES_SET);
return merge;
}
@@ -42,6 +44,53 @@
#define merge_table_overlap_item(item) \
mrg->item = modperl_table_overlap(p, base->item, add->item)
+static apr_table_t *merge_table_config_vars(apr_pool_t *p,
+ apr_table_t *configvars,
+ apr_table_t *set,
+ apr_table_t *add)
+{
+ apr_table_t *base = apr_table_copy(p, configvars);
+ apr_table_t *merged_config_vars;
+
+ const apr_array_header_t *arr;
+ apr_table_entry_t *entries;
+ int i;
+
+ /* configvars already contains a properly merged PerlSetVar/PerlAddVar
+ * configuration for the base (parent), so all we need to do is merge
+ * the add (child) configuration into it properly.
+ *
+ * any PerlSetVar settings in the add (child) config need to reset
+ * existing entries in the base (parent) config, or generate a
+ * new entry where none existed previously. PerlAddVar settings
+ * are merged into that.
+ *
+ * unfortunately, there is no set of apr functions to do this for us -
+ * apr_compress_table would be ok, except it always merges mulit-valued
+ * keys into one, regardless of the merge flag, which is no good - we
+ * need separate entries, not a single comma-delimted entry.
+ *
+ * fortunately, the logic here is simple - first, (re)set the base (parent)
+ * table where a PerlSetVar entry exists in the child (add) configuration.
+ * then, just overlay the PerlAddVar configuration into it.
+ */
+
+ arr = apr_table_elts(set);
+ entries = (apr_table_entry_t *)arr->elts;
+
+ /* hopefully this is faster than using apr_table_do */
+ for (i = 0; i < arr->nelts; i++) {
+ apr_table_setn(base, entries[i].key, entries[i].val);
+ }
+
+ /* at this point, all the PerlSetVar merging has happened. add in the
+ * add (child) PerlAddVar entries and we're done
+ */
+ merged_config_vars = apr_table_overlay(p, base, add);
+
+ return merged_config_vars;
+}
+
#define merge_handlers(merge_flag, array) \
if (merge_flag(mrg)) { \
mrg->array = modperl_handler_array_merge(p, \
@@ -71,10 +120,22 @@
merge_item(location);
- merge_table_overlap_item(vars);
-
merge_table_overlap_item(SetEnv);
+ /* this is where we merge PerlSetVar and PerlAddVar together */
+ mrg->configvars = merge_table_config_vars(p,
+ base->configvars,
+ add->setvars, add->addvars);
+
+ /* note we don't care about merging dcfg->setvars or dcfg->addvars
+ * specifically - what is important to merge is dfcg->configvars.
+ * but we need to keep track of the entries for this config, so
+ * the merged values are simply the values for the add (current)
+ * configuration.
+ */
+ mrg->setvars = add->setvars;
+ mrg->addvars = add->addvars;
+
/* XXX: check if Perl*Handler is disabled */
for (i=0; i < MP_HANDLER_NUM_PER_DIR; i++) {
merge_handlers(MpDirMERGE_HANDLERS, handlers_per_dir[i]);
@@ -107,7 +168,9 @@
scfg->argv = apr_array_make(p, 2, sizeof(char *));
- scfg->vars = apr_table_make(p, 2);
+ scfg->setvars = apr_table_make(p, 2);
+ scfg->addvars = apr_table_make(p, 2);
+ scfg->configvars = apr_table_make(p, 2);
scfg->PassEnv = apr_table_make(p, 2);
scfg->SetEnv = apr_table_make(p, 2);
@@ -130,7 +193,9 @@
dcfg->flags = modperl_options_new(p, MpDirType);
- dcfg->vars = apr_table_make(p, 2);
+ dcfg->setvars = apr_table_make(p, 2);
+ dcfg->addvars = apr_table_make(p, 2);
+ dcfg->configvars = apr_table_make(p, 2);
dcfg->SetEnv = apr_table_make(p, 2);
@@ -224,11 +289,23 @@
merge_item(PerlModule);
merge_item(PerlRequire);
- merge_table_overlap_item(vars);
-
merge_table_overlap_item(SetEnv);
merge_table_overlap_item(PassEnv);
+ /* this is where we merge PerlSetVar and PerlAddVar together */
+ mrg->configvars = merge_table_config_vars(p,
+ base->configvars,
+ add->setvars, add->addvars);
+
+ /* note we don't care about merging dcfg->setvars or dcfg->addvars
+ * specifically - what is important to merge is dfcg->configvars.
+ * but we need to keep track of the entries for this config, so
+ * the merged values are simply the values for the add (current)
+ * configuration.
+ */
+ mrg->setvars = add->setvars;
+ mrg->addvars = add->addvars;
+
merge_item(threaded_mpm);
merge_item(server);
1.73 +6 -2 modperl-2.0/src/modules/perl/modperl_types.h
Index: modperl_types.h
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_types.h,v
retrieving revision 1.72
retrieving revision 1.73
diff -u -r1.72 -r1.73
--- modperl_types.h 9 Feb 2004 19:37:38 -0000 1.72
+++ modperl_types.h 12 Feb 2004 02:05:28 -0000 1.73
@@ -111,7 +111,9 @@
} modperl_interp_scope_e;
typedef struct {
- MpHV *vars;
+ MpHV *setvars;
+ MpHV *addvars;
+ MpHV *configvars;
MpHV *SetEnv;
MpHV *PassEnv;
MpAV *PerlRequire, *PerlModule;
@@ -142,7 +144,9 @@
char *PerlDispatchHandler;
MpAV *handlers_per_dir[MP_HANDLER_NUM_PER_DIR];
MpHV *SetEnv;
- MpHV *vars;
+ MpHV *setvars;
+ MpHV *addvars;
+ MpHV *configvars;
modperl_options_t *flags;
#ifdef USE_ITHREADS
modperl_interp_scope_e interp_scope;
1.62 +2 -2 modperl-2.0/src/modules/perl/modperl_util.c
Index: modperl_util.c
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_util.c,v
retrieving revision 1.61
retrieving revision 1.62
diff -u -r1.61 -r1.62
--- modperl_util.c 19 Jan 2004 19:59:58 -0000 1.61
+++ modperl_util.c 12 Feb 2004 02:05:28 -0000 1.62
@@ -568,7 +568,7 @@
if (r && r->per_dir_config) {
MP_dDCFG;
- retval = modperl_table_get_set(aTHX_ dcfg->vars,
+ retval = modperl_table_get_set(aTHX_ dcfg->configvars,
key, sv_val, FALSE);
}
@@ -576,7 +576,7 @@
if (s && s->module_config) {
MP_dSCFG(s);
SvREFCNT_dec(retval); /* in case above did newSV(0) */
- retval = modperl_table_get_set(aTHX_ scfg->vars,
+ retval = modperl_table_get_set(aTHX_ scfg->configvars,
key, sv_val, FALSE);
}
else {
1.1 modperl-2.0/t/htdocs/merge2/htaccess
Index: htaccess
===================================================================
# htaccess file for t/response/TestModperl/merge.pm
PerlSetEnv MergeSetEnv3 SetEnv3Merge3Val
PerlSetVar MergeSetVar3 SetVar3Merge3Val
PerlSetVar MergeAddVar3 AddVar3Merge3Val1
PerlAddVar MergeAddVar3 AddVar3Merge3Val2
1.1 modperl-2.0/t/modperl/merge.t
Index: merge.t
===================================================================
use strict;
use warnings FATAL => 'all';
use Apache::TestRequest qw(GET_BODY_ASSERT);
use Apache::Test;
use Apache::TestUtil;
my $module = 'TestModperl::merge';
Apache::TestRequest::module($module);
my $config = Apache::Test::config();
my $hostport = Apache::TestRequest::hostport($config);
my $base = "http://$hostport";;
# test server-to-container merging (without overrides) for:
# PerlSetEnv
# PerlPassEnv
# PerlSetVar
# PerlAddVar
my $uri = "$base/merge";
t_debug("connecting to $uri");
print GET_BODY_ASSERT $uri;
1.1 modperl-2.0/t/modperl/merge2.t
Index: merge2.t
===================================================================
use strict;
use warnings FATAL => 'all';
use Apache::TestRequest qw(GET_BODY_ASSERT);
use Apache::Test;
use Apache::TestUtil;
my $module = 'TestModperl::merge';
Apache::TestRequest::module($module);
my $config = Apache::Test::config();
my $hostport = Apache::TestRequest::hostport($config);
my $base = "http://$hostport";;
# test server-to-container merging (with overrides) for:
# PerlSetEnv
# PerlPassEnv
# PerlSetVar
# PerlAddVar
my $uri = "$base/merge2/";
t_debug("connecting to $uri");
print GET_BODY_ASSERT $uri;
1.1 modperl-2.0/t/modperl/merge3.t
Index: merge3.t
===================================================================
use strict;
use warnings FATAL => 'all';
use Apache::TestRequest qw(GET_BODY_ASSERT);
use Apache::Test;
use Apache::TestUtil;
my $module = 'TestModperl::merge';
Apache::TestRequest::module($module);
my $config = Apache::Test::config();
my $hostport = Apache::TestRequest::hostport($config);
my $base = "http://$hostport";;
# test multi-level merging (server-to-container-to-htaccess) for:
# PerlSetEnv
# PerlPassEnv
# PerlSetVar
# PerlAddVar
my $uri = "$base/merge2/merge3.html";
t_debug("connecting to $uri");
print GET_BODY_ASSERT $uri;
1.1 modperl-2.0/t/response/TestModperl/merge.pm
Index: merge.pm
===================================================================
package TestModperl::merge;
use strict;
use warnings FATAL => 'all';
use Apache::Server ();
use Apache::ServerUtil ();
use Apache::RequestUtil ();
use APR::Table ();
use Apache::Test;
use Apache::TestUtil;
use Apache::Const -compile => 'OK';
# this is the configuration and handler for t/modperl/merge.t,
# t/modperl/merge2.t, and t/modperl/merge3.t. see any of those
# tests and/or the below configuration for more details
# result tables for the below tests (trying to make the code more simple...)
# the hash itself represents a request
# the keys to the main hash represent merge levels - 1 for the non-overriding
# merge, 2 for an overriding merge, and 3 for a two-level merge
# the rest should be self-explanatory - settings and expected values.
our %merge1 = ( 1 =>
{ PerlPassEnv => [APACHE_TEST_HOSTTYPE => 'z80'],
PerlSetEnv => [MergeSetEnv1 => 'SetEnv1Val'],
PerlSetVar => [MergeSetVar1 => 'SetVar1Val'],
PerlAddVar => [MergeAddVar1 => ['AddVar1Val1',
'AddVar1Val2']],
},
2 =>
{ PerlSetEnv => [MergeSetEnv2 => 'SetEnv2Val'],
PerlSetVar => [MergeSetVar2 => 'SetVar2Val'],
PerlAddVar => [MergeAddVar2 => ['AddVar2Val1',
'AddVar2Val2']],
},
3 =>
{ PerlSetEnv => [MergeSetEnv3 => 'SetEnv3Val'],
PerlSetVar => [MergeSetVar3 => 'SetVar3Val'],
PerlAddVar => [MergeAddVar3 => ['AddVar3Val1',
'AddVar3Val2']],
},
);
our %merge2 = ( 1 =>
{ PerlPassEnv => [APACHE_TEST_HOSTTYPE => 'z80'],
PerlSetEnv => [MergeSetEnv1 => 'SetEnv1Val'],
PerlSetVar => [MergeSetVar1 => 'SetVar1Val'],
PerlAddVar => [MergeAddVar1 => ['AddVar1Val1',
'AddVar1Val2']],
},
2 =>
{ PerlSetEnv => [MergeSetEnv2 => 'SetEnv2Merge2Val'],
PerlSetVar => [MergeSetVar2 => 'SetVar2Merge2Val'],
PerlAddVar => [MergeAddVar2 => ['AddVar2Merge2Val1',
'AddVar2Merge2Val2']],
},
3 =>
{ PerlSetEnv => [MergeSetEnv3 => 'SetEnv3Val'],
PerlSetVar => [MergeSetVar3 => 'SetVar3Val'],
PerlAddVar => [MergeAddVar3 => ['AddVar3Val1',
'AddVar3Val2']],
},
);
our %merge3 = ( 1 =>
{ PerlPassEnv => [APACHE_TEST_HOSTTYPE => 'z80'],
PerlSetEnv => [MergeSetEnv1 => 'SetEnv1Val'],
PerlSetVar => [MergeSetVar1 => 'SetVar1Val'],
PerlAddVar => [MergeAddVar1 => ['AddVar1Val1',
'AddVar1Val2']],
},
2 =>
{ PerlSetEnv => [MergeSetEnv2 => 'SetEnv2Merge2Val'],
PerlSetVar => [MergeSetVar2 => 'SetVar2Merge2Val'],
PerlAddVar => [MergeAddVar2 => ['AddVar2Merge2Val1',
'AddVar2Merge2Val2']],
},
3 =>
{ PerlSetEnv => [MergeSetEnv3 => 'SetEnv3Merge3Val'],
PerlSetVar => [MergeSetVar3 => 'SetVar3Merge3Val'],
PerlAddVar => [MergeAddVar3 => ['AddVar3Merge3Val1',
'AddVar3Merge3Val2']],
},
);
sub handler {
my $r = shift;
plan $r, tests => 10;
no strict qw(refs);
my $location = $r->location;
my $hash;
if ($location =~ m/(merge3)/) {
$hash = $1;
} elsif ($location =~ m/(merge2)/) {
$hash = $1;
} else {
$hash = 'merge1';
}
t_debug("testing against results in $hash");
foreach my $level (sort keys %$hash) {
foreach my $directive (sort keys %{$hash->{$level}}) {
my $key = $hash->{$level}->{$directive}->[0];
my $value = $hash->{$level}->{$directive}->[1];
my @expected = ref $value ? @$value : $value;
my $comment = join ' ', $directive, $key, @expected;
if ($directive =~ m/Env/) {
my $received = $ENV{$key};
ok t_cmp($expected[0], $received, $comment);
}
elsif ($directive =~ m/Set/) {
my $received = $r->dir_config->get($key);
ok t_cmp($expected[0], $received, $comment);
}
else {
my @received = $r->dir_config->get($key);
ok t_cmp([EMAIL PROTECTED], [EMAIL PROTECTED], $comment);
}
}
}
Apache::OK;
}
1;
__END__
<NoAutoConfig>
PerlModule TestModperl::merge
<VirtualHost TestModperl::merge>
# these should pass through all merges untouched
PerlPassEnv APACHE_TEST_HOSTTYPE
PerlSetEnv MergeSetEnv1 SetEnv1Val
PerlSetVar MergeSetVar1 SetVar1Val
PerlSetVar MergeAddVar1 AddVar1Val1
PerlAddVar MergeAddVar1 AddVar1Val2
# these are overridden in /merge1 and /merge1/merge2
PerlSetEnv MergeSetEnv2 SetEnv2Val
PerlSetVar MergeSetVar2 SetVar2Val
PerlSetVar MergeAddVar2 AddVar2Val1
PerlAddVar MergeAddVar2 AddVar2Val2
# these are overridden in /merge1/merge2 via htaccess
PerlSetEnv MergeSetEnv3 SetEnv3Val
PerlSetVar MergeSetVar3 SetVar3Val
PerlSetVar MergeAddVar3 AddVar3Val1
PerlAddVar MergeAddVar3 AddVar3Val2
<Location /merge>
# same as per-server level
SetHandler perl-script
PerlResponseHandler TestModperl::merge
</Location>
AccessFileName htaccess
<Directory @DocumentRoot@/merge2>
# overrides "2" values - "1" and "3" values left untouched
PerlSetEnv MergeSetEnv2 SetEnv2Merge2Val
PerlSetVar MergeSetVar2 SetVar2Merge2Val
PerlSetVar MergeAddVar2 AddVar2Merge2Val1
PerlAddVar MergeAddVar2 AddVar2Merge2Val2
SetHandler perl-script
PerlResponseHandler TestModperl::merge
# don't trigger htaccess files automatically
AllowOverride none
<Files merge3.html>
# initiate a double merge with htaccess file
AllowOverride all
</Files>
</Directory>
</VirtualHost>
</NoAutoConfig>
1.17 +0 -4 modperl-2.0/todo/release
Index: release
===================================================================
RCS file: /home/cvs/modperl-2.0/todo/release,v
retrieving revision 1.16
retrieving revision 1.17
diff -u -r1.16 -r1.17
--- release 10 Feb 2004 15:02:00 -0000 1.16
+++ release 12 Feb 2004 02:05:29 -0000 1.17
@@ -84,10 +84,6 @@
release it any dependency on mod_perl will be resolved as mod_perl
2.0, when mod_perl 1.0 may be required instead.
-* Set/Add overlapping in config which is not doing the right thing. See:
- http://marc.theaimsgroup.com/?l=apache-modperl-dev&m=100622977803237&w=2
- http://marc.theaimsgroup.com/?t=97984528900002&r=1&w=2
-
* Apache::{Server,Process} classes:
require mutex lock for writing (e.g. $s->(error_fname|error_log)
Status: most likely some server/process datastructures aren't
