On Fri, 2002-04-19 at 01:43, PinkFreud wrote:
> Here's a bit more information:
>
> Given two directives:
> $VirtualHost{$host}->{Alias} = [ '/perl/', "$vhostdir/$dir/perl/" ];
> $VirtualHost{$host}->{Alias} = $vhost{config}->{Alias};
>
> The first works. The second does not. According to
> Apache::PerlSections->dump, %VirtualHost is *exactly* the same when
> using both directives - yet it seems the server ignores the Alias
> directive when it's assigned from $vhost{config} (either that, mod_perl
> fails to pass it to the server).
> Also, if I set a variable within httpd.conf to mimic $vhost{config} and
> then assign that to $VirtualHost{$host}, it works without a problem.
> The issuse is definitely with the variable being read in from an
> external file.
>
> Strange, no?
Yes, weird.
I'm hunting any remaining bugs related to <Perl> Sections.
Can you please test the attached patch vs 1.26? (please forget about the
patch posted by Michel, it is mine and in CVS now, but in this I'm
trying a more radical approach and checking for the proper nesting of
directives)
Then try to reproduce your problems under MOD_PERL_TRACE=ds (see the
DEBUGGIN section in the mod_perl man page), thats is, compile mod_perl
with PERL_TRACE=1 and run your Apache in single process mode:
# MOD_PERL_TRACE=ds <path_to_your>/httpd -X
And please post the generated log.
Regards.
Salvador Ortiz
diff -ru mod_perl-1.26.orig/src/modules/perl/perl_config.c mod_perl-1.26.msg/src/modules/perl/perl_config.c
--- mod_perl-1.26.orig/src/modules/perl/perl_config.c Tue Jul 10 20:47:15 2001
+++ mod_perl-1.26.msg/src/modules/perl/perl_config.c Thu Feb 21 01:43:10 2002
@@ -51,6 +51,7 @@
#include "mod_perl.h"
extern API_VAR_EXPORT module *top_module;
+IV mp_cmdparms = 0;
#ifdef PERL_SECTIONS
static int perl_sections_self_boot = 0;
@@ -1166,6 +1167,9 @@
char *tmpkey;
I32 tmpklen;
SV *tmpval;
+ const command_rec *orec = cmd->cmd;
+ const char *old_end_token = cmd->end_token;
+ cmd->end_token = (const char *)cmd->info;
(void)hv_iterinit(hv);
while ((tmpval = hv_iternextsv(hv, &tmpkey, &tmpklen))) {
char line[MAX_STRING_LEN];
@@ -1173,6 +1177,13 @@
if (SvMAGICAL(tmpval)) mg_get(tmpval); /* tied hash FETCH */
if(SvROK(tmpval)) {
if(SvTYPE(SvRV(tmpval)) == SVt_PVAV) {
+ module *tmod = top_module;
+ const command_rec *c;
+ if(!(c = find_command_in_modules((const char *)tmpkey, &tmod))) {
+ fprintf(stderr, "command_rec for directive `%s' not found!\n", tmpkey);
+ continue;
+ }
+ cmd->cmd = c; /* for do_quote */
perl_handle_command_av((AV*)SvRV(tmpval),
0, tmpkey, cmd, cfg);
continue;
@@ -1195,8 +1206,12 @@
if(errmsg)
log_printf(cmd->server, "<Perl>: %s", errmsg);
}
- /* Emulate the handling of end token for the section */
+ cmd->cmd = orec;
+ cmd->info = cmd->end_token;
+ cmd->end_token = old_end_token;
+ /* Emulate the handling of end token for the section
perl_set_config_vectors(cmd, cfg, &core_module);
+ */
}
#ifdef WIN32
@@ -1225,13 +1240,21 @@
pool *p = cmd->pool;
char *arg;
const char *errmsg = NULL;
+ const char *err = ap_check_cmd_context(cmd, GLOBAL_ONLY);
+ if (err != NULL) {
+ return err;
+ }
+ if (main_server->is_virtual) {
+ return "<VirtualHost> doesn't nest!";
+ }
+
dSECiter_start
if(entries) {
SECiter_list(perl_virtualhost_section(cmd, dummy, tab));
}
- arg = pstrdup(cmd->pool, getword_conf (cmd->pool, &key));
+ arg = getword_conf (cmd->pool, &key);
#if MODULE_MAGIC_NUMBER >= 19970912
errmsg = init_virtual_host(p, arg, main_server, &s);
@@ -1256,9 +1279,9 @@
perl_section_hash_walk(cmd, s->lookup_defaults, tab);
cmd->server = main_server;
+ TRACE_SECTION_END("VirtualHost");
dSECiter_stop
- TRACE_SECTION_END("VirtualHost");
return NULL;
}
@@ -1281,6 +1304,11 @@
#ifdef PERL_TRACE
char *sname = SECTION_NAME("Location");
#endif
+ const char *err = ap_check_cmd_context(cmd,
+ NOT_IN_DIR_LOC_FILE|NOT_IN_LIMIT);
+ if (err != NULL) {
+ return err;
+ }
dSECiter_start
@@ -1295,10 +1323,10 @@
new_url_conf = create_per_dir_config (cmd->pool);
- cmd->path = pstrdup(cmd->pool, getword_conf (cmd->pool, &key));
+ cmd->path = getword_conf (cmd->pool, &key);
cmd->override = OR_ALL|ACCESS_CONF;
- if (cmd->info) { /* <LocationMatch> */
+ if (cmd->cmd->cmd_data) { /* <LocationMatch> */
r = pregcomp(cmd->pool, cmd->path, REG_EXTENDED);
}
else if (!strcmp(cmd->path, "~")) {
@@ -1317,12 +1345,12 @@
conf->r = r;
add_per_url_conf (cmd->server, new_url_conf);
+ TRACE_SECTION_END(sname);
dSECiter_stop
cmd->path = old_path;
cmd->override = old_overrides;
- TRACE_SECTION_END(sname);
return NULL;
}
@@ -1334,6 +1362,11 @@
#ifdef PERL_TRACE
char *sname = SECTION_NAME("Directory");
#endif
+ const char *err = ap_check_cmd_context(cmd,
+ NOT_IN_DIR_LOC_FILE|NOT_IN_LIMIT);
+ if (err != NULL) {
+ return err;
+ }
dSECiter_start
@@ -1347,7 +1380,7 @@
new_dir_conf = create_per_dir_config (cmd->pool);
- cmd->path = pstrdup(cmd->pool, getword_conf (cmd->pool, &key));
+ cmd->path = getword_conf (cmd->pool, &key);
#ifdef __EMX__
/* Fix OS/2 HPFS filename case problem. */
@@ -1355,12 +1388,12 @@
#endif
cmd->override = OR_ALL|ACCESS_CONF;
- if (cmd->info) { /* <DirectoryMatch> */
+ if (cmd->cmd->cmd_data) { /* <DirectoryMatch> */
r = pregcomp(cmd->pool, cmd->path, REG_EXTENDED|USE_ICASE);
}
else if (!strcmp(cmd->path, "~")) {
cmd->path = getword_conf (cmd->pool, &key);
- r = pregcomp(cmd->pool, cmd->path, REG_EXTENDED);
+ r = pregcomp(cmd->pool, cmd->path, REG_EXTENDED|USE_ICASE);
}
TRACE_SECTION(sname, cmd->path);
@@ -1371,12 +1404,12 @@
conf->r = r;
add_per_dir_conf (cmd->server, new_dir_conf);
+ TRACE_SECTION_END(sname);
dSECiter_stop
cmd->path = old_path;
cmd->override = old_overrides;
- TRACE_SECTION_END(sname);
return NULL;
}
@@ -1396,6 +1429,10 @@
#ifdef PERL_TRACE
char *sname = SECTION_NAME("Files");
#endif
+ const char *err = ap_check_cmd_context(cmd, NOT_IN_LIMIT|NOT_IN_LOCATION);
+ if (err != NULL) {
+ return err;
+ }
dSECiter_start
@@ -1409,38 +1446,38 @@
new_file_conf = create_per_dir_config (cmd->pool);
- cmd->path = pstrdup(cmd->pool, getword_conf (cmd->pool, &key));
+ cmd->path = getword_conf (cmd->pool, &key);
+
/* Only if not an .htaccess file */
if (!old_path)
cmd->override = OR_ALL|ACCESS_CONF;
- if (cmd->info) { /* <FilesMatch> */
+ if (cmd->cmd->cmd_data) { /* <FilesMatch> */
r = ap_pregcomp(cmd->pool, cmd->path, REG_EXTENDED|USE_ICASE);
}
else if (!strcmp(cmd->path, "~")) {
cmd->path = getword_conf (cmd->pool, &key);
- if (old_path && cmd->path[0] != '/' && cmd->path[0] != '^')
- cmd->path = pstrcat(cmd->pool, "^", old_path, cmd->path, NULL);
- r = pregcomp(cmd->pool, cmd->path, REG_EXTENDED);
+ r = pregcomp(cmd->pool, cmd->path, REG_EXTENDED|USE_ICASE);
+ }
+ else {
+ /* Ensure that the pathname is canonical */
+ cmd->path = ap_os_canonical_filename(cmd->pool, cmd->path);
}
- else if (old_path && cmd->path[0] != '/')
- cmd->path = pstrcat(cmd->pool, old_path, cmd->path, NULL);
TRACE_SECTION(sname, cmd->path);
perl_section_hash_walk(cmd, new_file_conf, tab);
conf = (core_dir_config *)get_module_config(new_file_conf, &core_module);
- if(!conf->opts)
- conf->opts = OPT_NONE;
conf->d = pstrdup(cmd->pool, cmd->path);
test__is_match(conf);
conf->r = r;
add_file_conf((core_dir_config *)dummy, new_file_conf);
+ TRACE_SECTION_END(sname);
dSECiter_stop
- TRACE_SECTION_END(sname);
+
cmd->path = old_path;
cmd->override = old_overrides;
@@ -1451,13 +1488,6 @@
{
SV *sv;
char *methods;
- module *mod = top_module;
- const command_rec *nrec = find_command_in_modules("<Limit", &mod);
- const command_rec *orec = cmd->cmd;
- /*void *ac = (void*)create_default_per_dir_config(cmd->pool);*/
-
- if(nrec)
- cmd->cmd = nrec;
if(hv_exists(hv,"METHODS", 7))
sv = hv_delete(hv, "METHODS", 7, G_SCALAR);
@@ -1473,7 +1503,6 @@
limit_section(cmd, dummy, methods);
perl_section_hash_walk(cmd, dummy, hv);
cmd->limited = -1;
- cmd->cmd = orec;
return NULL;
}
@@ -1509,24 +1538,49 @@
{
/* Emulate the handing of the begin token of the section */
void *dummy = perl_set_config_vectors(cmd, config, &core_module);
- void *old_info = cmd->info;
-
- if (strstr(key, "Match")) {
- cmd->info = (void*)key;
+ char directive[MAX_STRING_LEN];
+ module *tmod = top_module;
+ const command_rec *c;
+ CHAR_P errmsg;
+
+ /* Now we find the directive in top_module, we need a real command_rec */
+ sprintf(directive,"<%s",key);
+ if(!(c = find_command_in_modules((const char *)directive, &tmod))) {
+ fprintf(stderr, "Warn: Directive `%s' not found in handle_command_av!\n", directive);
+ return;
}
+ cmd->cmd = c;
+ /* HACK! if we want to use ap_check_cmd_context we need the end token pointer,
+ * but those are static consts in http_core.c, so we use the copy in top_module
+ * and pass it to the handler in cmd->info, anyway the data in cmd->info is just a
+ * copy of cmd->cmd->cmd_data
+ */
+ sprintf(directive,"</%s>",key);
+ c = find_command_in_modules((const char *)directive, &tmod);
+ cmd->info = (void *)(c->name);
if(strnEQ(key, "Location", 8))
- perl_urlsection(cmd, dummy, hv);
+ errmsg = perl_urlsection(cmd, dummy, hv);
else if(strnEQ(key, "Directory", 9))
- perl_dirsection(cmd, dummy, hv);
+ errmsg = perl_dirsection(cmd, dummy, hv);
else if(strEQ(key, "VirtualHost"))
- perl_virtualhost_section(cmd, dummy, hv);
+ errmsg = perl_virtualhost_section(cmd, dummy, hv);
else if(strnEQ(key, "Files", 5))
- perl_filesection(cmd, (core_dir_config *)dummy, hv);
- else if(strEQ(key, "Limit"))
- perl_limit_section(cmd, config, hv);
+ errmsg = perl_filesection(cmd, (core_dir_config *)dummy, hv);
+ else if(strnEQ(key, "Limit", 5))
+ errmsg = perl_limit_section(cmd, config, hv);
+
+ if (errmsg) {
+ SV *sv;
+ if ((sv = STRICT_PERL_SECTIONS_SV) && SvTRUE(sv)) {
+ croak("<Perl>: %s", errmsg);
+ }
+ else {
+ log_printf(cmd->server, "<Perl>: %s", errmsg);
+ }
+ }
+ MP_TRACE_s(fprintf(stderr, "%s %s\n", key, errmsg ? errmsg : "OK"));
- cmd->info = old_info;
}
void perl_handle_command_av(AV *av, I32 n, char *key, cmd_parms *cmd, void *config)
@@ -1742,6 +1799,7 @@
sv_setpv(perl_get_sv("0", TRUE), cmd_filename);
+ mp_cmdparms = (IV)parms;
ENTER_SAFE(parms->server, parms->pool);
MP_TRACE_g(mod_perl_dump_opmask());
@@ -1754,6 +1812,7 @@
}
LEAVE_SAFE;
+ mp_cmdparms = 0;
{
dTHR;
@@ -1809,6 +1868,9 @@
fprintf(stderr, "command_rec for directive `%s' not found!\n", key);
continue;
}
+ /* Now we are handling the �c� command and perl_handle_command_av */
+ /* uses parms->cmd */
+ parms->cmd = c;
MP_TRACE_s(fprintf(stderr,
"`@%s' directive is %s, (%d elements)\n",
