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",