You are viewing a plain text version of this content. The canonical link for it is here.
Posted to modperl-cvs@perl.apache.org by do...@hyperreal.org on 1999/05/17 21:08:24 UTC
cvs commit: modperl/src/modules/perl mod_perl.c mod_perl.h perl_config.c
dougm 99/05/17 12:08:23
Modified: . Changes ToDo
src/modules/perl mod_perl.c mod_perl.h perl_config.c
Log:
<Perl> sections now use 1.3.7-dev's cmd_parms->context to cure many
known, old bugs, e.g. @DirectoryIndex outside of %Location, .htaccess
and many more
Revision Changes Path
1.285 +4 -0 modperl/Changes
Index: Changes
===================================================================
RCS file: /export/home/cvs/modperl/Changes,v
retrieving revision 1.284
retrieving revision 1.285
diff -u -r1.284 -r1.285
--- Changes 1999/04/20 15:11:10 1.284
+++ Changes 1999/05/17 19:08:12 1.285
@@ -8,6 +8,10 @@
=item 1.19_01-dev
+<Perl> sections now use 1.3.7-dev's cmd_parms->context to cure many
+known, old bugs, e.g. @DirectoryIndex outside of %Location, .htaccess
+and many more [Salvador Ortiz Garcia <so...@msg.com.mx>]
+
fix bug where top-level PerlSetEnv's would be lost after 1st request
fix bug in Apache::ModuleConfig->get [Dave Hayes <da...@jetcafe.org>]
1.176 +0 -10 modperl/ToDo
Index: ToDo
===================================================================
RCS file: /export/home/cvs/modperl/ToDo,v
retrieving revision 1.175
retrieving revision 1.176
diff -u -r1.175 -r1.176
--- ToDo 1999/05/17 18:40:45 1.175
+++ ToDo 1999/05/17 19:08:13 1.176
@@ -7,8 +7,6 @@
- modules/file #6
-- <Perl> patch from Salvador
-
- Salvador's patch to avoid %ENV setup on subrequests
- <Perl> patch for *Match from Craig Lien <li...@rrnet.com>
@@ -23,8 +21,6 @@
- fix $Apache::Server::Starting under dso
-- push_handlers recursion bug spotted by Andreas
-
- PerlSetEnv gets lost?
- Apache::Include->virtual should return run() value, not status()
@@ -92,12 +88,6 @@
Was: libs='-lsocket -lnsl -ldb -ldl -lm -lc -lcrypt'
SunOS mailhost.cmc.net 5.5 Generic_103093-17 sun4m sparc sun4m
brian moore <be...@cmc.net>
-
-- sometimes w/ <Perl> we get: [warning] PerlSetVar->nelts = 1111992, e.g.:
- $User = "www";
- $ServerType = "standalone";
- @ScriptAlias = [('/cgi-bin','/the/path')];
- @Alias = [('/web/','/usr/home/web')];
- perl_config should not av_shift ARRAY refs from
%Apache::ReadConfig::
1.84 +2 -2 modperl/src/modules/perl/mod_perl.c
Index: mod_perl.c
===================================================================
RCS file: /export/home/cvs/modperl/src/modules/perl/mod_perl.c,v
retrieving revision 1.83
retrieving revision 1.84
diff -u -r1.83 -r1.84
--- mod_perl.c 1999/03/26 22:20:35 1.83
+++ mod_perl.c 1999/05/17 19:08:18 1.84
@@ -84,8 +84,8 @@
static command_rec perl_cmds[] = {
#ifdef PERL_SECTIONS
- { "<Perl>", perl_section, NULL, OR_ALL, RAW_ARGS, "Perl code" },
- { "</Perl>", perl_end_section, NULL, OR_ALL, NO_ARGS, "End Perl code" },
+ { "<Perl>", perl_section, NULL, SECTION_ALLOWED, RAW_ARGS, "Perl code" },
+ { "</Perl>", perl_end_section, NULL, SECTION_ALLOWED, NO_ARGS, "End Perl code" },
#endif
{ "=pod", perl_pod_section, NULL, OR_ALL, RAW_ARGS, "Start of POD" },
{ "=back", perl_pod_section, NULL, OR_ALL, RAW_ARGS, "End of =over" },
1.76 +14 -7 modperl/src/modules/perl/mod_perl.h
Index: mod_perl.h
===================================================================
RCS file: /export/home/cvs/modperl/src/modules/perl/mod_perl.h,v
retrieving revision 1.75
retrieving revision 1.76
diff -u -r1.75 -r1.76
--- mod_perl.h 1999/03/26 22:20:35 1.75
+++ mod_perl.h 1999/05/17 19:08:19 1.76
@@ -460,6 +460,17 @@
#define HAS_MMN_132 HAS_MMN(MMN_132)
#define HAS_MMN_136 HAS_MMN(MMN_136)
+#define HAS_CONTEXT MODULE_MAGIC_AT_LEAST(MMN_136,2)
+#if HAS_CONTEXT
+#define CAN_SELF_BOOT_SECTIONS (PERL_SECTIONS_SELF_BOOT)
+#define SECTION_ALLOWED OR_ALL
+#define USABLE_CONTEXT parms->context
+#else
+#define CAN_SELF_BOOT_SECTIONS ((parms->path==NULL)&&PERL_SECTIONS_SELF_BOOT)
+#define SECTION_ALLOWED RSRC_CONF
+#define USABLE_CONTEXT parms->server->lookup_defaults
+#endif
+
#define APACHE_SSL_12X (defined(APACHE_SSL) && (MODULE_MAGIC_NUMBER < MMN_130))
#if MODULE_MAGIC_NUMBER < MMN_130
@@ -1122,9 +1133,6 @@
#define require_Apache(s) \
perl_require_module("Apache", s)
-#define defined_Apache__ReadConfig \
-SvTRUE(perl_eval_pv("grep {defined %$_ or defined @$_ or defined $$_} keys %Apache::ReadConfig::;",TRUE))
-
char *mod_perl_auth_name(request_rec *r, char *val);
module *perl_get_module_ptr(char *name, int len);
@@ -1145,10 +1153,9 @@
CHAR_P perl_urlsection (cmd_parms *cmd, void *dummy, HV *hv);
CHAR_P perl_dirsection (cmd_parms *cmd, void *dummy, HV *hv);
CHAR_P perl_filesection (cmd_parms *cmd, void *dummy, HV *hv);
-void perl_add_file_conf (server_rec *s, void *url_config);
-void perl_handle_command(cmd_parms *cmd, void *dummy, char *line);
-void perl_handle_command_hv(HV *hv, char *key, cmd_parms *cmd, void *dummy);
-void perl_handle_command_av(AV *av, I32 n, char *key, cmd_parms *cmd, void *dummy);
+void perl_handle_command(cmd_parms *cmd, void *config, char *line);
+void perl_handle_command_hv(HV *hv, char *key, cmd_parms *cmd, void *config);
+void perl_handle_command_av(AV *av, I32 n, char *key, cmd_parms *cmd, void *config);
void perl_tainting_set(server_rec *s, int arg);
CHAR_P perl_cmd_require (cmd_parms *parms, void *dummy, char *arg);
1.70 +67 -93 modperl/src/modules/perl/perl_config.c
Index: perl_config.c
===================================================================
RCS file: /export/home/cvs/modperl/src/modules/perl/perl_config.c,v
retrieving revision 1.69
retrieving revision 1.70
diff -u -r1.69 -r1.70
--- perl_config.c 1999/04/20 15:11:11 1.69
+++ perl_config.c 1999/05/17 19:08:19 1.70
@@ -118,7 +118,7 @@
return retval;
}
-void perl_eat_config_string(cmd_parms *cmd, void *dummy, SV *sv) {
+void perl_eat_config_string(cmd_parms *cmd, void *config, SV *sv) {
CHAR_P errmsg;
configfile_t *perl_cfg =
pcfg_open_custom(cmd->pool, "mod_perl", (void*)sv,
@@ -126,7 +126,7 @@
configfile_t *old_cfg = cmd->config_file;
cmd->config_file = perl_cfg;
- errmsg = srm_command_loop(cmd, dummy);
+ errmsg = srm_command_loop(cmd, config);
cmd->config_file = old_cfg;
if(errmsg)
@@ -136,7 +136,7 @@
#define STRING_MEAL(s) ( (*s == 'P') && strEQ(s,"PerlConfig") )
#else
#define STRING_MEAL(s) 0
-#define perl_eat_config_string(cmd, dummy, sv)
+#define perl_eat_config_string(cmd, config, sv)
#endif
#define PERL_SECTIONS_PACKAGE "ApacheReadConfig"
@@ -524,7 +524,7 @@
}
#ifdef PERL_SECTIONS
- if((parms->path == NULL) && PERL_SECTIONS_SELF_BOOT)
+ if(CAN_SELF_BOOT_SECTIONS)
perl_section_self_boot(parms, dummy, arg);
#endif
@@ -554,7 +554,7 @@
}
#ifdef PERL_SECTIONS
- if((parms->path == NULL) && PERL_SECTIONS_SELF_BOOT)
+ if(CAN_SELF_BOOT_SECTIONS)
perl_section_self_boot(parms, dummy, arg);
#endif
@@ -964,7 +964,28 @@
#endif /* PERL_DIRECTIVE_HANDLERS */
#ifdef PERL_SECTIONS
+#if HAS_CONTEXT
+#define perl_set_config_vectors ap_set_config_vectors
+#else
+void *perl_set_config_vectors(cmd_parms *parms, void *config, module *mod)
+{
+ void *mconfig = get_module_config(config, mod);
+ void *sconfig = get_module_config(parms->server->module_config, mod);
+
+ if (!mconfig && mod->create_dir_config) {
+ mconfig = (*mod->create_dir_config) (parms->pool, parms->path);
+ set_module_config(config, mod, mconfig);
+ }
+ if (!sconfig && mod->create_server_config) {
+ sconfig = (*mod->create_server_config) (parms->pool, parms->server);
+ set_module_config(parms->server->module_config, mod, sconfig);
+ }
+ return mconfig;
+}
+#endif
+
+
CHAR_P perl_srm_command_loop(cmd_parms *parms, SV *sv)
{
char l[MAX_STRING_LEN];
@@ -1062,6 +1083,8 @@
if(errmsg)
log_printf(cmd->server, "<Perl>: %s", errmsg);
}
+ /* Emulate the handling of end token for the section */
+ perl_set_config_vectors(cmd, cfg, &core_module);
}
#define TRACE_SECTION(n,v) \
@@ -1125,13 +1148,6 @@
#define test__is_match(conf) conf->d_is_matchexp = is_matchexp( conf->d )
#endif
-/* for some odd reason, of there is no Options directive, we get a core dump.
- * work-around for now is setting it to something "harmless"
- */
-#define ADD_OPTIONS_WA \
- if(!hv_exists(tab, "Options", 7)) \
- hv_store(tab, "Options", 7, newSVpv("+MultiViews",0), 0)
-
CHAR_P perl_urlsection (cmd_parms *cmd, void *dummy, HV *hv)
{
dSEC;
@@ -1143,11 +1159,13 @@
core_dir_config *conf;
regex_t *r = NULL;
- void *new_url_conf = create_per_dir_config (cmd->pool);
+ void *new_url_conf;
if(list) {
SECiter_list(perl_urlsection(cmd, dummy, tab));
}
+
+ new_url_conf = create_per_dir_config (cmd->pool);
cmd->path = pstrdup(cmd->pool, getword_conf (cmd->pool, &key));
cmd->override = OR_ALL|ACCESS_CONF;
@@ -1159,14 +1177,10 @@
TRACE_SECTION("Location", cmd->path);
- ADD_OPTIONS_WA;
-
perl_section_hash_walk(cmd, new_url_conf, tab);
conf = (core_dir_config *)get_module_config(
new_url_conf, &core_module);
- if(!conf->opts)
- conf->opts = OPT_NONE;
conf->d = pstrdup(cmd->pool, cmd->path);
test__is_match(conf);
conf->r = r;
@@ -1190,13 +1204,15 @@
dSECiter_start
core_dir_config *conf;
- void *new_dir_conf = create_per_dir_config (cmd->pool);
+ void *new_dir_conf;
regex_t *r = NULL;
if(list) {
SECiter_list(perl_dirsection(cmd, dummy, tab));
}
+ new_dir_conf = create_per_dir_config (cmd->pool);
+
cmd->path = pstrdup(cmd->pool, getword_conf (cmd->pool, &key));
#ifdef __EMX__
@@ -1212,8 +1228,6 @@
TRACE_SECTION("Directory", cmd->path);
- ADD_OPTIONS_WA;
-
perl_section_hash_walk(cmd, new_dir_conf, tab);
conf = (core_dir_config *)get_module_config(new_dir_conf, &core_module);
@@ -1229,14 +1243,13 @@
return NULL;
}
-void perl_add_file_conf (server_rec *s, void *url_config)
+#if !HAS_CONTEXT
+static void add_file_conf(core_dir_config *conf, void *url_config)
{
- core_server_config *sconf = get_module_config (s->module_config,
- &core_module);
- void **new_space = (void **) push_array (sconf->sec);
-
+ void **new_space = (void **) push_array (conf->sec);
*new_space = url_config;
}
+#endif
CHAR_P perl_filesection (cmd_parms *cmd, void *dummy, HV *hv)
{
@@ -1247,16 +1260,18 @@
dSECiter_start
core_dir_config *conf;
- void *new_file_conf = create_per_dir_config (cmd->pool);
+ void *new_file_conf;
regex_t *r = NULL;
if(list) {
SECiter_list(perl_filesection(cmd, dummy, tab));
}
+ new_file_conf = create_per_dir_config (cmd->pool);
+
cmd->path = pstrdup(cmd->pool, getword_conf (cmd->pool, &key));
/* Only if not an .htaccess file */
- if (cmd->path)
+ if (!old_path)
cmd->override = OR_ALL|ACCESS_CONF;
if (!strcmp(cmd->path, "~")) {
@@ -1270,8 +1285,6 @@
TRACE_SECTION("Files", cmd->path);
- ADD_OPTIONS_WA;
-
perl_section_hash_walk(cmd, new_file_conf, tab);
conf = (core_dir_config *)get_module_config(new_file_conf, &core_module);
@@ -1281,7 +1294,7 @@
test__is_match(conf);
conf->r = r;
- perl_add_file_conf (cmd->server, new_file_conf);
+ add_file_conf((core_dir_config *)dummy, new_file_conf);
dSECiter_stop
TRACE_SECTION_END("Files");
@@ -1321,63 +1334,21 @@
return perl_end_magic;
}
-int perl_handle_self_command(cmd_parms *parms, void *dummy, char *line)
+void perl_handle_command(cmd_parms *cmd, void *config, char *line)
{
- const command_rec *cmd;
- const char *cmd_name, *args;
-
- if(!perl_sections_self_boot || (parms->path != NULL))
- return FALSE;
-
- args = line;
-
- cmd_name = getword_conf(parms->temp_pool, &args);
-
- if (*cmd_name == '\0')
- return FALSE;
-
- if(!(cmd = find_command(cmd_name, perl_module.cmds))) {
- /*fprintf(stderr, "%s is not a mod_perl command\n", cmd_name);*/
- return FALSE;
- }
- else {
- if(cmd->req_override == OR_ALL) {
- if(perl_sections_self_boot && perl_sections_boot_module) {
- fprintf(stderr, "Error in PerlModule %s\n",
- perl_sections_boot_module);
- fprintf(stderr,
- "*Apache::ReadConfig::%s must be inside a container\n",
- cmd_name);
- }
- else {
- fprintf(stderr, "Error in <Perl> section:\n");
- fprintf(stderr, "*%s must be inside a container\n",
- cmd_name);
- }
-
- exit(1);
- return TRUE;
- }
- }
-
- return FALSE;
-}
-
-void perl_handle_command(cmd_parms *cmd, void *dummy, char *line)
-{
CHAR_P errmsg;
- if(perl_handle_self_command(cmd, dummy, line))
- return;
MP_TRACE_s(fprintf(stderr, "handle_command (%s): ", line));
- errmsg = handle_command(cmd, dummy, line);
+ errmsg = handle_command(cmd, config, line);
MP_TRACE_s(fprintf(stderr, "%s\n", errmsg ? errmsg : "OK"));
if(errmsg)
log_printf(cmd->server, "<Perl>: %s", errmsg);
}
-void perl_handle_command_hv(HV *hv, char *key, cmd_parms *cmd, void *dummy)
+void perl_handle_command_hv(HV *hv, char *key, cmd_parms *cmd, void *config)
{
+ /* Emulate the handing of the begin token of the section */
+ void *dummy = perl_set_config_vectors(cmd, config, &core_module);
if(strEQ(key, "Location"))
perl_urlsection(cmd, dummy, hv);
else if(strEQ(key, "Directory"))
@@ -1390,7 +1361,7 @@
perl_limit_section(cmd, dummy, hv);
}
-void perl_handle_command_av(AV *av, I32 n, char *key, cmd_parms *cmd, void *dummy)
+void perl_handle_command_av(AV *av, I32 n, char *key, cmd_parms *cmd, void *config)
{
I32 alen = AvFILL(av);
I32 i, j;
@@ -1409,20 +1380,21 @@
if(SvROK(fsv)) {
i -= n;
perl_handle_command_av((AV*)SvRV(av_shift(av)), 0,
- key, cmd, dummy);
+ key, cmd, config);
}
else {
SV *sv = newSV(0);
sv_catpv(sv, key);
- sv_catpvn(sv, " ", 1);
+ sv_catpvn(sv, " \"", 2);
for(j=1; j<=n; j++) {
sv_catsv(sv, av_shift(av));
if(j != n)
- sv_catpvn(sv, " ", 1);
+ sv_catpvn(sv, "\" \"", 3);
}
+ sv_catpvn(sv,"\"",1);
- perl_handle_command(cmd, dummy, SvPVX(sv));
+ perl_handle_command(cmd, config, SvPVX(sv));
SvREFCNT_dec(sv);
}
}
@@ -1478,19 +1450,19 @@
void perl_section_self_boot(cmd_parms *parms, void *dummy, const char *arg)
{
HV *symtab;
+ SV *nk;
if(!PERL_RUNNING()) perl_startup(parms->server, parms->pool);
if(!(symtab = gv_stashpv(PERL_SECTIONS_PACKAGE, FALSE)))
return;
- if(HvKEYS(symtab) < 1)
- return;
- if(!defined_Apache__ReadConfig)
+ nk = perl_eval_pv("scalar(keys %ApacheReadConfig::);",TRUE);
+ if(!SvIV(nk))
return;
MP_TRACE_s(fprintf(stderr,
"bootstrapping <Perl> sections: arg=%s, keys=%d\n",
- arg, (int)HvKEYS(symtab)));
+ arg, SvIV(nk)));
perl_sections_boot_module = arg;
perl_sections_self_boot = 1;
@@ -1551,7 +1523,9 @@
char *key;
I32 klen, dotie=FALSE;
char line[MAX_STRING_LEN];
-
+ /* Use the parser context */
+ void *config = USABLE_CONTEXT;
+
if(!PERL_RUNNING()) perl_startup(parms->server, parms->pool);
require_Apache(parms->server);
@@ -1608,20 +1582,20 @@
if((sv = GvSV((GV*)val))) {
if(SvTRUE(sv)) {
if(STRING_MEAL(key)) {
- perl_eat_config_string(parms, dummy, sv);
+ perl_eat_config_string(parms, config, sv);
}
else {
STRLEN junk;
MP_TRACE_s(fprintf(stderr, "SVt_PV: $%s = `%s'\n",
key, SvPV(sv,junk)));
sprintf(line, "%s %s", key, SvPV(sv,junk));
- perl_handle_command(parms, dummy, line);
+ perl_handle_command(parms, config, line);
}
}
}
if((hv = GvHV((GV*)val))) {
- perl_handle_command_hv(hv, key, parms, dummy);
+ perl_handle_command_hv(hv, key, parms, config);
}
else if((av = GvAV((GV*)val))) {
module *mod = top_module;
@@ -1631,7 +1605,7 @@
if(STRING_MEAL(key)) {
SV *tmpsv;
while((tmpsv = av_shift(av)) != &sv_undef)
- perl_eat_config_string(parms, dummy, tmpsv);
+ perl_eat_config_string(parms, config, tmpsv);
continue;
}
@@ -1661,8 +1635,8 @@
shift = 1;
break;
}
- if(shift > alen) shift = 1; /* elements are refs */
- perl_handle_command_av(av, shift, key, parms, dummy);
+ if(shift > alen+1) shift = 1; /* elements are refs */
+ perl_handle_command_av(av, shift, key, parms, config);
}
}
SvREFCNT_dec(code);