| /* Licensed to the Apache Software Foundation (ASF) under one or more |
| * contributor license agreements. See the NOTICE file distributed with |
| * this work for additional information regarding copyright ownership. |
| * The ASF licenses this file to You under the Apache License, Version 2.0 |
| * (the "License"); you may not use this file except in compliance with |
| * the License. You may obtain a copy of the License at |
| * |
| * http://www.apache.org/licenses/LICENSE-2.0 |
| * |
| * Unless required by applicable law or agreed to in writing, software |
| * distributed under the License is distributed on an "AS IS" BASIS, |
| * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. |
| * See the License for the specific language governing permissions and |
| * limitations under the License. |
| */ |
| |
| #include "mod_perl.h" |
| |
| /* This ensures that a given directive is either in Server context |
| * or in a .htaccess file, usefull for things like PerlRequire |
| */ |
| #define MP_CHECK_SERVER_OR_HTACCESS_CONTEXT \ |
| if (parms->path && (parms->override & ACCESS_CONF)) { \ |
| ap_directive_t *d = parms->directive; \ |
| return apr_psprintf(parms->pool, \ |
| "%s directive not allowed in a %s> block", \ |
| d->directive, \ |
| d->parent->directive); \ |
| } |
| |
| static char *modperl_cmd_unclosed_directive(cmd_parms *parms) |
| { |
| return apr_pstrcat(parms->pool, parms->cmd->name, |
| "> directive missing closing '>'", NULL); |
| } |
| |
| static char *modperl_cmd_too_late(cmd_parms *parms) |
| { |
| return apr_pstrcat(parms->pool, "mod_perl is already running, " |
| "too late for ", parms->cmd->name, NULL); |
| } |
| |
| char *modperl_cmd_push_handlers(MpAV **handlers, const char *name, |
| apr_pool_t *p) |
| { |
| modperl_handler_t *h = modperl_handler_new(p, name); |
| |
| if (!*handlers) { |
| *handlers = modperl_handler_array_new(p); |
| MP_TRACE_d(MP_FUNC, "created handler stack"); |
| } |
| |
| /* XXX parse_handler if Perl is running */ |
| |
| modperl_handler_array_push(*handlers, h); |
| MP_TRACE_d(MP_FUNC, "pushed handler: %s", h->name); |
| |
| return NULL; |
| } |
| |
| char *modperl_cmd_push_filter_handlers(MpAV **handlers, |
| const char *name, |
| apr_pool_t *p) |
| { |
| modperl_handler_t *h = modperl_handler_new(p, name); |
| |
| /* filter modules need to be autoloaded, because their attributes |
| * need to be known long before the callback is issued |
| */ |
| if (*name == '-') { |
| MP_TRACE_h(MP_FUNC, |
| "warning: filter handler %s will be not autoloaded. " |
| "Unless the module defining this handler is explicitly " |
| "preloaded, filter attributes will be ignored."); |
| } |
| else { |
| MpHandlerAUTOLOAD_On(h); |
| MP_TRACE_h(MP_FUNC, |
| "filter handler %s will be autoloaded (to make " |
| "the filter attributes available)", h->name); |
| } |
| |
| if (!*handlers) { |
| *handlers = modperl_handler_array_new(p); |
| MP_TRACE_d(MP_FUNC, "created handler stack"); |
| } |
| |
| modperl_handler_array_push(*handlers, h); |
| MP_TRACE_d(MP_FUNC, "pushed httpd filter handler: %s", h->name); |
| |
| return NULL; |
| } |
| |
| static char *modperl_cmd_push_httpd_filter_handlers(MpAV **handlers, |
| const char *name, |
| apr_pool_t *p) |
| { |
| modperl_handler_t *h = modperl_handler_new(p, name); |
| |
| /* this is not a real mod_perl handler, we just re-use the |
| * handlers structure to be able to mix mod_perl and non-mod_perl |
| * filters */ |
| MpHandlerFAKE_On(h); |
| h->attrs = MP_FILTER_HTTPD_HANDLER; |
| |
| if (!*handlers) { |
| *handlers = modperl_handler_array_new(p); |
| MP_TRACE_d(MP_FUNC, "created handler stack"); |
| } |
| |
| modperl_handler_array_push(*handlers, h); |
| MP_TRACE_d(MP_FUNC, "pushed httpd filter handler: %s", h->name); |
| |
| return NULL; |
| } |
| |
| |
| #define MP_CMD_SRV_TRACE \ |
| MP_TRACE_d(MP_FUNC, "%s %s", parms->cmd->name, arg) |
| |
| #define MP_CMD_SRV_CHECK \ |
| MP_CMD_SRV_TRACE; \ |
| { \ |
| const char *err = ap_check_cmd_context(parms, GLOBAL_ONLY); \ |
| if (err) return err; \ |
| } |
| |
| MP_CMD_SRV_DECLARE(trace) |
| { |
| MP_CMD_SRV_CHECK; |
| modperl_trace_level_set_apache(parms->server, arg); |
| return NULL; |
| } |
| |
| /* this test shows whether the perl for the current s is running |
| * (either base or vhost) */ |
| static int modperl_vhost_is_running(server_rec *s) |
| { |
| #ifdef USE_ITHREADS |
| if (s->is_virtual){ |
| MP_dSCFG(s); |
| return scfg->mip ? TRUE : FALSE; |
| } |
| #endif |
| |
| return modperl_is_running(); |
| |
| } |
| |
| MP_CMD_SRV_DECLARE(switches) |
| { |
| server_rec *s = parms->server; |
| MP_dSCFG(s); |
| if (modperl_vhost_is_running(s)) { |
| return modperl_cmd_too_late(parms); |
| } |
| MP_TRACE_d(MP_FUNC, "arg = %s", arg); |
| |
| if (!strncasecmp(arg, "+inherit", 8)) { |
| modperl_cmd_options(parms, mconfig, "+InheritSwitches"); |
| } |
| else { |
| modperl_config_srv_argv_push(arg); |
| } |
| return NULL; |
| } |
| |
| MP_CMD_SRV_DECLARE(modules) |
| { |
| MP_dSCFG(parms->server); |
| modperl_config_dir_t *dcfg = (modperl_config_dir_t *)mconfig; |
| MP_PERL_CONTEXT_DECLARE; |
| |
| MP_CHECK_SERVER_OR_HTACCESS_CONTEXT; |
| |
| if (modperl_is_running() && |
| modperl_init_vhost(parms->server, parms->pool, NULL) != OK) |
| { |
| return "init mod_perl vhost failed"; |
| } |
| |
| if (modperl_is_running()) { |
| char *error = NULL; |
| |
| MP_TRACE_d(MP_FUNC, "load PerlModule %s", arg); |
| |
| MP_PERL_CONTEXT_STORE_OVERRIDE(scfg->mip->parent->perl); |
| if (!modperl_require_module(aTHX_ arg, FALSE)) { |
| error = SvPVX(ERRSV); |
| } |
| else { |
| modperl_env_sync_srv_env_hash2table(aTHX_ parms->pool, scfg); |
| modperl_env_sync_dir_env_hash2table(aTHX_ parms->pool, dcfg); |
| } |
| MP_PERL_CONTEXT_RESTORE; |
| |
| return error; |
| } |
| else { |
| MP_TRACE_d(MP_FUNC, "push PerlModule %s", arg); |
| *(const char **)apr_array_push(scfg->PerlModule) = arg; |
| return NULL; |
| } |
| } |
| |
| MP_CMD_SRV_DECLARE(requires) |
| { |
| MP_dSCFG(parms->server); |
| modperl_config_dir_t *dcfg = (modperl_config_dir_t *)mconfig; |
| MP_PERL_CONTEXT_DECLARE; |
| |
| MP_CHECK_SERVER_OR_HTACCESS_CONTEXT; |
| |
| if (modperl_is_running() && |
| modperl_init_vhost(parms->server, parms->pool, NULL) != OK) |
| { |
| return "init mod_perl vhost failed"; |
| } |
| |
| if (modperl_is_running()) { |
| char *error = NULL; |
| |
| MP_TRACE_d(MP_FUNC, "load PerlRequire %s", arg); |
| |
| MP_PERL_CONTEXT_STORE_OVERRIDE(scfg->mip->parent->perl); |
| if (!modperl_require_file(aTHX_ arg, FALSE)) { |
| error = SvPVX(ERRSV); |
| } |
| else { |
| modperl_env_sync_srv_env_hash2table(aTHX_ parms->pool, scfg); |
| modperl_env_sync_dir_env_hash2table(aTHX_ parms->pool, dcfg); |
| } |
| MP_PERL_CONTEXT_RESTORE; |
| |
| return error; |
| } |
| else { |
| MP_TRACE_d(MP_FUNC, "push PerlRequire %s", arg); |
| *(const char **)apr_array_push(scfg->PerlRequire) = arg; |
| return NULL; |
| } |
| } |
| |
| MP_CMD_SRV_DECLARE(config_requires) |
| { |
| /* we must init earlier than normal */ |
| modperl_run(); |
| |
| /* PerlConfigFile is only different from PerlRequires by forcing |
| * an immediate init. |
| */ |
| return modperl_cmd_requires(parms, mconfig, arg); |
| } |
| |
| MP_CMD_SRV_DECLARE(post_config_requires) |
| { |
| apr_pool_t *p = parms->temp_pool; |
| modperl_config_dir_t *dcfg = (modperl_config_dir_t *)mconfig; |
| MP_dSCFG(parms->server); |
| |
| modperl_require_file_t *require = apr_pcalloc(p, sizeof(*require)); |
| MP_TRACE_d(MP_FUNC, "push PerlPostConfigRequire for %s", arg); |
| require->file = arg; |
| require->dcfg = dcfg; |
| |
| *(modperl_require_file_t **) |
| apr_array_push(scfg->PerlPostConfigRequire) = require; |
| |
| return NULL; |
| } |
| |
| static void modperl_cmd_addvar_func(apr_table_t *configvars, |
| apr_table_t *setvars, |
| const char *key, const char *val) |
| { |
| apr_table_addn(configvars, key, val); |
| } |
| |
| /* Conceptually, setvar is { unsetvar; addvar; } */ |
| |
| static void modperl_cmd_setvar_func(apr_table_t *configvars, |
| apr_table_t *setvars, |
| const char * key, const char *val) |
| { |
| apr_table_setn(setvars, key, val); |
| apr_table_setn(configvars, key, val); |
| } |
| |
| static const char *modperl_cmd_modvar(modperl_var_modify_t varfunc, |
| cmd_parms *parms, |
| modperl_config_dir_t *dcfg, |
| const char *arg1, const char *arg2) |
| { |
| varfunc(dcfg->configvars, dcfg->setvars, arg1, arg2); |
| |
| MP_TRACE_d(MP_FUNC, "%s DIR: arg1 = %s, arg2 = %s", |
| parms->cmd->name, arg1, arg2); |
| |
| /* make available via Apache2->server->dir_config */ |
| if (!parms->path) { |
| MP_dSCFG(parms->server); |
| varfunc(scfg->configvars, scfg->setvars, arg1, arg2); |
| |
| MP_TRACE_d(MP_FUNC, "%s SRV: arg1 = %s, arg2 = %s", |
| parms->cmd->name, arg1, arg2); |
| } |
| |
| return NULL; |
| } |
| |
| MP_CMD_SRV_DECLARE2(add_var) |
| { |
| modperl_config_dir_t *dcfg = (modperl_config_dir_t *)mconfig; |
| return modperl_cmd_modvar(modperl_cmd_addvar_func, parms, dcfg, arg1, arg2); |
| } |
| |
| MP_CMD_SRV_DECLARE2(set_var) |
| { |
| modperl_config_dir_t *dcfg = (modperl_config_dir_t *)mconfig; |
| return modperl_cmd_modvar(modperl_cmd_setvar_func, parms, dcfg, arg1, arg2); |
| } |
| |
| MP_CMD_SRV_DECLARE2(set_env) |
| { |
| MP_dSCFG(parms->server); |
| modperl_config_dir_t *dcfg = (modperl_config_dir_t *)mconfig; |
| |
| #ifdef ENV_IS_CASELESS /* i.e. WIN32 */ |
| /* we turn off env magic during hv_store later, so do this now, |
| * else lookups on keys with lowercase characters will fails |
| * because Perl will uppercase them prior to lookup. |
| */ |
| modperl_str_toupper((char *)arg1); |
| #endif |
| |
| MP_TRACE_d(MP_FUNC, "arg1 = %s, arg2 = %s", arg1, arg2); |
| |
| if (!parms->path) { |
| /* will be propagated to environ */ |
| apr_table_setn(scfg->SetEnv, arg1, arg2); |
| /* sync SetEnv => %ENV only for the top-level values */ |
| if (modperl_vhost_is_running(parms->server)) { |
| MP_PERL_CONTEXT_DECLARE; |
| MP_PERL_CONTEXT_STORE_OVERRIDE(scfg->mip->parent->perl); |
| modperl_env_hv_store(aTHX_ arg1, arg2); |
| MP_PERL_CONTEXT_RESTORE; |
| } |
| } |
| |
| apr_table_setn(dcfg->SetEnv, arg1, arg2); |
| |
| return NULL; |
| } |
| |
| MP_CMD_SRV_DECLARE(pass_env) |
| { |
| MP_dSCFG(parms->server); |
| char *val = getenv(arg); |
| |
| #ifdef ENV_IS_CASELESS /* i.e. WIN32 */ |
| /* we turn off env magic during hv_store later, so do this now, |
| * else lookups on keys with lowercase characters will fails |
| * because Perl will uppercase them prior to lookup. |
| */ |
| modperl_str_toupper((char *)arg); |
| #endif |
| |
| if (val) { |
| apr_table_setn(scfg->PassEnv, arg, apr_pstrdup(parms->pool, val)); |
| if (modperl_vhost_is_running(parms->server)) { |
| MP_PERL_CONTEXT_DECLARE; |
| MP_PERL_CONTEXT_STORE_OVERRIDE(scfg->mip->parent->perl); |
| modperl_env_hv_store(aTHX_ arg, val); |
| MP_PERL_CONTEXT_RESTORE; |
| } |
| MP_TRACE_d(MP_FUNC, "arg = %s, val = %s", arg, val); |
| } |
| else { |
| MP_TRACE_d(MP_FUNC, "arg = %s: not found via getenv()", arg); |
| } |
| |
| return NULL; |
| } |
| |
| MP_CMD_SRV_DECLARE(options) |
| { |
| MP_dSCFG(parms->server); |
| modperl_config_dir_t *dcfg = (modperl_config_dir_t *)mconfig; |
| int is_per_dir = parms->path ? 1 : 0; |
| modperl_options_t *opts = is_per_dir ? dcfg->flags : scfg->flags; |
| apr_pool_t *p = parms->temp_pool; |
| const char *error; |
| |
| MP_TRACE_d(MP_FUNC, "arg = %s", arg); |
| if ((error = modperl_options_set(p, opts, arg)) && !is_per_dir) { |
| /* maybe a per-directory option outside of a container */ |
| if (modperl_options_set(p, dcfg->flags, arg) == NULL) { |
| error = NULL; |
| } |
| } |
| |
| if (error) { |
| return error; |
| } |
| |
| return NULL; |
| } |
| |
| MP_CMD_SRV_DECLARE(init_handlers) |
| { |
| if (parms->path) { |
| return modperl_cmd_header_parser_handlers(parms, mconfig, arg); |
| } |
| |
| return modperl_cmd_post_read_request_handlers(parms, mconfig, arg); |
| } |
| |
| #if AP_SERVER_MAJORVERSION_NUMBER>2 || \ |
| (AP_SERVER_MAJORVERSION_NUMBER == 2 && AP_SERVER_MINORVERSION_NUMBER>=3) |
| |
| MP_CMD_SRV_DECLARE2(authz_provider) |
| { |
| apr_pool_t *p = parms->pool; |
| char *name = apr_pstrdup(p, arg1); |
| char *cb = apr_pstrdup(p, arg2); |
| |
| modperl_register_auth_provider_name(p, AUTHZ_PROVIDER_GROUP, name, |
| AUTHZ_PROVIDER_VERSION, cb, NULL, |
| AP_AUTH_INTERNAL_PER_CONF); |
| return NULL; |
| } |
| |
| MP_CMD_SRV_DECLARE2(authn_provider) |
| { |
| apr_pool_t *p = parms->pool; |
| char *name = apr_pstrdup(p, arg1); |
| char *cb = apr_pstrdup(p, arg2); |
| |
| modperl_register_auth_provider_name(p, AUTHN_PROVIDER_GROUP, name, |
| AUTHN_PROVIDER_VERSION, cb, NULL, |
| AP_AUTH_INTERNAL_PER_CONF); |
| return NULL; |
| } |
| |
| #endif |
| |
| static const char *modperl_cmd_parse_args(apr_pool_t *p, |
| const char *args, |
| apr_table_t **t) |
| { |
| const char *orig_args = args; |
| char *pair, *key, *val; |
| *t = apr_table_make(p, 2); |
| |
| while (*(pair = ap_getword(p, &args, ',')) != '\0') { |
| key = ap_getword_nc(p, &pair, '='); |
| val = pair; |
| |
| if (!(*key && *val)) { |
| return apr_pstrcat(p, "invalid args spec: ", |
| orig_args, NULL); |
| } |
| |
| apr_table_set(*t, key, val); |
| } |
| |
| return NULL; |
| } |
| |
| MP_CMD_SRV_DECLARE(perl) |
| { |
| apr_pool_t *p = parms->pool; |
| const char *endp = ap_strrchr_c(arg, '>'); |
| const char *errmsg; |
| char *code = ""; |
| char line[MAX_STRING_LEN]; |
| apr_table_t *args; |
| ap_directive_t **current = mconfig; |
| int line_num; |
| |
| if (!endp) { |
| return modperl_cmd_unclosed_directive(parms); |
| } |
| |
| MP_CHECK_SERVER_OR_HTACCESS_CONTEXT; |
| |
| arg = apr_pstrndup(p, arg, endp - arg); |
| |
| if ((errmsg = modperl_cmd_parse_args(p, arg, &args))) { |
| return errmsg; |
| } |
| |
| line_num = parms->config_file->line_number+1; |
| while (!ap_cfg_getline(line, sizeof(line), parms->config_file)) { |
| /*XXX: Not sure how robust this is */ |
| if (strEQ(line, "</Perl>")) { |
| break; |
| } |
| |
| /*XXX: Less than optimal */ |
| code = apr_pstrcat(p, code, line, "\n", NULL); |
| } |
| |
| /* Here, we have to replace our current config node for the next pass */ |
| if (!*current) { |
| *current = apr_pcalloc(p, sizeof(**current)); |
| } |
| |
| (*current)->filename = parms->config_file->name; |
| (*current)->line_num = line_num; |
| (*current)->directive = apr_pstrdup(p, "Perl"); |
| (*current)->args = code; |
| (*current)->data = args; |
| |
| return NULL; |
| } |
| |
| #define MP_DEFAULT_PERLSECTION_HANDLER "Apache2::PerlSections" |
| #define MP_DEFAULT_PERLSECTION_PACKAGE "Apache2::ReadConfig" |
| #define MP_PERLSECTIONS_SAVECONFIG_SV \ |
| get_sv("Apache2::PerlSections::Save", FALSE) |
| #define MP_PERLSECTIONS_SERVER_SV \ |
| get_sv("Apache2::PerlSections::Server", TRUE) |
| |
| MP_CMD_SRV_DECLARE(perldo) |
| { |
| apr_pool_t *p = parms->pool; |
| server_rec *s = parms->server; |
| modperl_config_dir_t *dcfg = (modperl_config_dir_t *)mconfig; |
| apr_table_t *options; |
| modperl_handler_t *handler = NULL; |
| const char *pkg_name = NULL; |
| ap_directive_t *directive = parms->directive; |
| MP_dSCFG(s); |
| MP_PERL_CONTEXT_DECLARE; |
| |
| if (!(arg && *arg)) { |
| return NULL; |
| } |
| |
| MP_CHECK_SERVER_OR_HTACCESS_CONTEXT; |
| |
| /* we must init earlier than normal */ |
| modperl_run(); |
| |
| if (modperl_init_vhost(s, p, NULL) != OK) { |
| return "init mod_perl vhost failed"; |
| } |
| |
| MP_PERL_CONTEXT_STORE_OVERRIDE(scfg->mip->parent->perl); |
| |
| /* data will be set by a <Perl> section */ |
| if ((options = directive->data)) { |
| const char *pkg_namespace; |
| const char *pkg_base; |
| const char *handler_name; |
| const char *line_header; |
| |
| if (!(handler_name = apr_table_get(options, "handler"))) { |
| handler_name = apr_pstrdup(p, MP_DEFAULT_PERLSECTION_HANDLER); |
| apr_table_set(options, "handler", handler_name); |
| } |
| |
| handler = modperl_handler_new(p, handler_name); |
| |
| if (!(pkg_base = apr_table_get(options, "package"))) { |
| pkg_base = apr_pstrdup(p, MP_DEFAULT_PERLSECTION_PACKAGE); |
| } |
| |
| pkg_namespace = modperl_file2package(p, directive->filename); |
| |
| pkg_name = apr_psprintf(p, "%s::%s::line_%d", |
| pkg_base, |
| pkg_namespace, |
| directive->line_num); |
| |
| apr_table_set(options, "package", pkg_name); |
| |
| line_header = apr_psprintf(p, "\n#line %d %s\n", |
| directive->line_num, |
| directive->filename); |
| |
| /* put the code about to be executed in the configured package */ |
| arg = apr_pstrcat(p, "package ", pkg_name, ";", line_header, |
| arg, NULL); |
| } |
| |
| #ifdef USE_ITHREADS |
| MP_TRACE_i(MP_FUNC, "using interp %lx to execute perl section:\n%s", |
| scfg->mip->parent, arg); |
| #endif |
| |
| { |
| SV *server = MP_PERLSECTIONS_SERVER_SV; |
| SV *code = newSVpv(arg, 0); |
| GV *gv = gv_fetchpv("0", TRUE, SVt_PV); |
| ENTER;SAVETMPS; |
| save_scalar(gv); /* local $0 */ |
| #if MP_PERL_VERSION_AT_LEAST(5, 9, 0) |
| TAINT_NOT; /* XXX: temp workaround, see my p5p post */ |
| #endif |
| sv_setref_pv(server, "Apache2::ServerRec", (void*)s); |
| sv_setpv_mg(GvSV(gv), directive->filename); |
| eval_sv(code, G_SCALAR|G_KEEPERR); |
| SvREFCNT_dec(code); |
| modperl_env_sync_srv_env_hash2table(aTHX_ p, scfg); |
| modperl_env_sync_dir_env_hash2table(aTHX_ p, dcfg); |
| FREETMPS;LEAVE; |
| } |
| |
| if (SvTRUE(ERRSV)) { |
| MP_PERL_CONTEXT_RESTORE; |
| return SvPVX(ERRSV); |
| } |
| |
| if (handler) { |
| int status; |
| SV *saveconfig = MP_PERLSECTIONS_SAVECONFIG_SV; |
| AV *args = (AV *)NULL; |
| |
| modperl_handler_make_args(aTHX_ &args, |
| "Apache2::CmdParms", parms, |
| "APR::Table", options, |
| NULL); |
| |
| status = modperl_callback(aTHX_ handler, p, NULL, s, args); |
| |
| SvREFCNT_dec((SV*)args); |
| |
| if (!(saveconfig && SvTRUE(saveconfig))) { |
| modperl_package_unload(aTHX_ pkg_name); |
| } |
| |
| if (status != OK) { |
| char *error = SvTRUE(ERRSV) ? SvPVX(ERRSV) : |
| apr_psprintf(p, "<Perl> handler %s failed with status=%d", |
| handler->name, status); |
| MP_PERL_CONTEXT_RESTORE; |
| return error; |
| } |
| } |
| |
| MP_PERL_CONTEXT_RESTORE; |
| return NULL; |
| } |
| |
| #define MP_POD_FORMAT(s) \ |
| (ap_strstr_c(s, "httpd") || ap_strstr_c(s, "apache")) |
| |
| MP_CMD_SRV_DECLARE(pod) |
| { |
| char line[MAX_STRING_LEN]; |
| |
| if (arg && *arg && !(MP_POD_FORMAT(arg) || strstr("pod", arg))) { |
| return "Unknown =back format"; |
| } |
| |
| while (!ap_cfg_getline(line, sizeof(line), parms->config_file)) { |
| if (strEQ(line, "=cut")) { |
| break; |
| } |
| if (strnEQ(line, "=over", 5) && MP_POD_FORMAT(line)) { |
| break; |
| } |
| } |
| |
| return NULL; |
| } |
| |
| MP_CMD_SRV_DECLARE(pod_cut) |
| { |
| return "=cut without =pod"; |
| } |
| |
| MP_CMD_SRV_DECLARE(END) |
| { |
| char line[MAX_STRING_LEN]; |
| |
| while (!ap_cfg_getline(line, sizeof(line), parms->config_file)) { |
| /* soak up rest of the file */ |
| } |
| |
| return NULL; |
| } |
| |
| /* |
| * XXX: the name of this directive may or may not stay. |
| * need a way to note that a module has config directives. |
| * don't want to start mod_perl when we see a non-special PerlModule. |
| */ |
| MP_CMD_SRV_DECLARE(load_module) |
| { |
| const char *errmsg; |
| |
| MP_TRACE_d(MP_FUNC, "PerlLoadModule %s", arg); |
| |
| /* we must init earlier than normal */ |
| modperl_run(); |
| |
| if ((errmsg = modperl_cmd_modules(parms, mconfig, arg))) { |
| return errmsg; |
| } |
| |
| return NULL; |
| } |
| |
| /* propogate filters insertion ala SetInputFilter */ |
| MP_CMD_SRV_DECLARE(set_input_filter) |
| { |
| MP_dSCFG(parms->server); |
| modperl_config_dir_t *dcfg = (modperl_config_dir_t *)mconfig; |
| char *filter; |
| |
| if (!MpSrvENABLE(scfg)) { |
| return apr_pstrcat(parms->pool, |
| "Perl is disabled for server ", |
| parms->server->server_hostname, NULL); |
| } |
| if (!MpSrvINPUT_FILTER(scfg)) { |
| return apr_pstrcat(parms->pool, |
| "PerlSetInputFilter is disabled for server ", |
| parms->server->server_hostname, NULL); |
| } |
| |
| while (*arg && (filter = ap_getword(parms->pool, &arg, ';'))) { |
| modperl_cmd_push_httpd_filter_handlers( |
| &(dcfg->handlers_per_dir[MP_INPUT_FILTER_HANDLER]), |
| filter, parms->pool); |
| } |
| |
| return NULL; |
| } |
| |
| /* propogate filters insertion ala SetOutputFilter */ |
| MP_CMD_SRV_DECLARE(set_output_filter) |
| { |
| MP_dSCFG(parms->server); |
| modperl_config_dir_t *dcfg = (modperl_config_dir_t *)mconfig; |
| char *filter; |
| |
| if (!MpSrvENABLE(scfg)) { |
| return apr_pstrcat(parms->pool, |
| "Perl is disabled for server ", |
| parms->server->server_hostname, NULL); |
| } |
| if (!MpSrvINPUT_FILTER(scfg)) { |
| return apr_pstrcat(parms->pool, |
| "PerlSetOutputFilter is disabled for server ", |
| parms->server->server_hostname, NULL); |
| } |
| |
| while (*arg && (filter = ap_getword(parms->pool, &arg, ';'))) { |
| modperl_cmd_push_httpd_filter_handlers( |
| &(dcfg->handlers_per_dir[MP_OUTPUT_FILTER_HANDLER]), |
| filter, parms->pool); |
| } |
| |
| return NULL; |
| } |
| |
| |
| #ifdef MP_COMPAT_1X |
| |
| MP_CMD_SRV_DECLARE_FLAG(taint_check) |
| { |
| if (flag_on) { |
| return modperl_cmd_switches(parms, mconfig, "-T"); |
| } |
| |
| return NULL; |
| } |
| |
| MP_CMD_SRV_DECLARE_FLAG(warn) |
| { |
| if (flag_on) { |
| return modperl_cmd_switches(parms, mconfig, "-w"); |
| } |
| |
| return NULL; |
| } |
| |
| MP_CMD_SRV_DECLARE_FLAG(send_header) |
| { |
| char *arg = flag_on ? "+ParseHeaders" : "-ParseHeaders"; |
| return modperl_cmd_options(parms, mconfig, arg); |
| } |
| |
| MP_CMD_SRV_DECLARE_FLAG(setup_env) |
| { |
| char *arg = flag_on ? "+SetupEnv" : "-SetupEnv"; |
| return modperl_cmd_options(parms, mconfig, arg); |
| } |
| |
| #endif /* MP_COMPAT_1X */ |
| |
| #ifdef USE_ITHREADS |
| |
| #define MP_CMD_INTERP_POOL_IMP(xitem) \ |
| const char *modperl_cmd_interp_##xitem(cmd_parms *parms, \ |
| void *mconfig, const char *arg) \ |
| { \ |
| MP_dSCFG(parms->server); \ |
| int item = atoi(arg); \ |
| scfg->interp_pool_cfg->xitem = item; \ |
| MP_TRACE_d(MP_FUNC, "%s %d", parms->cmd->name, item); \ |
| return NULL; \ |
| } |
| |
| MP_CMD_INTERP_POOL_IMP(start); |
| MP_CMD_INTERP_POOL_IMP(max); |
| MP_CMD_INTERP_POOL_IMP(max_spare); |
| MP_CMD_INTERP_POOL_IMP(min_spare); |
| MP_CMD_INTERP_POOL_IMP(max_requests); |
| |
| #endif /* USE_ITHREADS */ |
| |
| /* |
| * Local Variables: |
| * c-basic-offset: 4 |
| * indent-tabs-mode: nil |
| * End: |
| */ |