-: 0:Source:modperl_cmd.c
-: 0:Object:modperl_cmd.bb
-: 1:/* Copyright 2001-2004 The Apache Software Foundation
-: 2: *
-: 3: * Licensed under the Apache License, Version 2.0 (the "License");
-: 4: * you may not use this file except in compliance with the License.
-: 5: * You may obtain a copy of the License at
-: 6: *
-: 7: * http://www.apache.org/licenses/LICENSE-2.0
-: 8: *
-: 9: * Unless required by applicable law or agreed to in writing, software
-: 10: * distributed under the License is distributed on an "AS IS" BASIS,
-: 11: * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-: 12: * See the License for the specific language governing permissions and
-: 13: * limitations under the License.
-: 14: */
-: 15:
-: 16:#include "mod_perl.h"
-: 17:
-: 18:#ifdef USE_ITHREADS
-: 19:
-: 20:/*
-: 21: * perl context overriding and restoration is required when
-: 22: * PerlOptions +Parent/+Clone is used in vhosts, and perl is used to
-: 23: * at the server startup. So that sections, PerlLoadModule,
-: 24: * PerlModule and PerlRequire are all run using the right perl context
-: 25: * and restore to the original context when they are done.
-: 26: *
-: 27: * As of perl-5.8.3 it's unfortunate that it uses PERL_GET_CONTEXT and
-: 28: * doesn't rely on the passed pTHX internally. When and if perl is
-: 29: * fixed to always use pTHX if available, this context switching mess
-: 30: * can be removed.
-: 31: */
-: 32:
-: 33:#define MP_PERL_DECLARE_CONTEXT \
-: 34: PerlInterpreter *orig_perl; \
-: 35: pTHX;
-: 36:
-: 37:/* XXX: .htaccess support cannot use this perl with threaded MPMs */
-: 38:#define MP_PERL_OVERRIDE_CONTEXT \
-: 39: orig_perl = PERL_GET_CONTEXT; \
-: 40: aTHX = scfg->mip->parent->perl; \
-: 41: PERL_SET_CONTEXT(aTHX);
-: 42:
-: 43:#define MP_PERL_RESTORE_CONTEXT \
-: 44: PERL_SET_CONTEXT(orig_perl);
-: 45:
-: 46:#else
-: 47:
-: 48:#define MP_PERL_DECLARE_CONTEXT
-: 49:#define MP_PERL_OVERRIDE_CONTEXT
-: 50:#define MP_PERL_RESTORE_CONTEXT
-: 51:
-: 52:#endif
-: 53:
-: 54:static char *modperl_cmd_unclosed_directive(cmd_parms *parms)
#####: 55:{
#####: 56: return apr_pstrcat(parms->pool, parms->cmd->name,
-: 57: "> directive missing closing '>'", NULL);
-: 58:}
-: 59:
-: 60:static char *modperl_cmd_too_late(cmd_parms *parms)
#####: 61:{
#####: 62: return apr_pstrcat(parms->pool, "mod_perl is already running, "
-: 63: "too late for ", parms->cmd->name, NULL);
-: 64:}
-: 65:
-: 66:char *modperl_cmd_push_handlers(MpAV **handlers, const char *name,
-: 67: apr_pool_t *p)
1136: 68:{
1136: 69: modperl_handler_t *h = modperl_handler_new(p, name);
-: 70:
1136: 71: if (!*handlers) {
1052: 72: *handlers = modperl_handler_array_new(p);
1052: 73: MP_TRACE_d(MP_FUNC, "created handler stack\n");
-: 74: }
-: 75:
-: 76: /* XXX parse_handler if Perl is running */
-: 77:
1136: 78: modperl_handler_array_push(*handlers, h);
1136: 79: MP_TRACE_d(MP_FUNC, "pushed handler: %s\n", h->name);
-: 80:
1136: 81: return NULL;
-: 82:}
-: 83:
-: 84:char *modperl_cmd_push_filter_handlers(MpAV **handlers,
-: 85: const char *name,
-: 86: apr_pool_t *p)
164: 87:{
164: 88: modperl_handler_t *h = modperl_handler_new(p, name);
-: 89:
-: 90: /* filter modules need to be autoloaded, because their attributes
-: 91: * need to be known long before the callback is issued
-: 92: */
164: 93: if (*name == '-') {
#####: 94: MP_TRACE_h(MP_FUNC,
-: 95: "[%s] warning: filter handler %s will be not autoloaded. "
-: 96: "Unless the module defining this handler is explicitly "
-: 97: "preloaded, filter attributes will be ignored.\n",
-: 98: modperl_pid_tid(p), h->name);
-: 99: }
-: 100: else {
164: 101: MpHandlerAUTOLOAD_On(h);
164: 102: MP_TRACE_h(MP_FUNC,
-: 103: "[%s] filter handler %s will be autoloaded (to make "
-: 104: "the filter attributes available)\n",
-: 105: modperl_pid_tid(p), h->name);
-: 106: }
-: 107:
164: 108: if (!*handlers) {
132: 109: *handlers = modperl_handler_array_new(p);
132: 110: MP_TRACE_d(MP_FUNC, "created handler stack\n");
-: 111: }
-: 112:
164: 113: modperl_handler_array_push(*handlers, h);
164: 114: MP_TRACE_d(MP_FUNC, "pushed httpd filter handler: %s\n", h->name);
-: 115:
164: 116: return NULL;
-: 117:}
-: 118:
-: 119:char *modperl_cmd_push_httpd_filter_handlers(MpAV **handlers,
-: 120: const char *name,
-: 121: apr_pool_t *p)
20: 122:{
20: 123: modperl_handler_t *h = modperl_handler_new(p, name);
-: 124:
-: 125: /* this is not a real mod_perl handler, we just re-use the
-: 126: * handlers structure to be able to mix mod_perl and non-mod_perl
-: 127: * filters */
20: 128: MpHandlerFAKE_On(h);
20: 129: h->attrs = MP_FILTER_HTTPD_HANDLER;
-: 130:
20: 131: if (!*handlers) {
8: 132: *handlers = modperl_handler_array_new(p);
8: 133: MP_TRACE_d(MP_FUNC, "created handler stack\n");
-: 134: }
-: 135:
20: 136: modperl_handler_array_push(*handlers, h);
20: 137: MP_TRACE_d(MP_FUNC, "pushed httpd filter handler: %s\n", h->name);
-: 138:
20: 139: return NULL;
-: 140:}
-: 141:
-: 142:
-: 143:#define MP_CMD_SRV_TRACE \
-: 144: MP_TRACE_d(MP_FUNC, "%s %s\n", parms->cmd->name, arg)
-: 145:
-: 146:#define MP_CMD_SRV_CHECK \
-: 147:MP_CMD_SRV_TRACE; \
-: 148:{ \
-: 149: const char *err = ap_check_cmd_context(parms, GLOBAL_ONLY); \
-: 150: if (err) return err; \
-: 151:}
-: 152:
-: 153:MP_CMD_SRV_DECLARE(trace)
#####: 154:{
#####: 155: MP_CMD_SRV_CHECK;
#####: 156: modperl_trace_level_set(parms->server, arg);
#####: 157: return NULL;
-: 158:}
-: 159:
-: 160:static int modperl_vhost_is_running(server_rec *s)
16: 161:{
-: 162:#ifdef USE_ITHREADS
16: 163: MP_dSCFG(s);
16: 164: int is_vhost = (s != modperl_global_get_server_rec());
-: 165:
16: 166: if (is_vhost && scfg->mip) {
#####: 167: return TRUE;
-: 168: }
-: 169: else {
16: 170: return FALSE;
-: 171: }
-: 172:#else
-: 173: return modperl_is_running();
-: 174:#endif
-: 175:}
-: 176:
-: 177:MP_CMD_SRV_DECLARE(switches)
68: 178:{
68: 179: server_rec *s = parms->server;
68: 180: MP_dSCFG(s);
68: 181: if (s->is_virtual
-: 182: ? modperl_vhost_is_running(s)
-: 183: : modperl_is_running() ) {
#####: 184: return modperl_cmd_too_late(parms);
-: 185: }
68: 186: MP_TRACE_d(MP_FUNC, "arg = %s\n", arg);
68: 187: modperl_config_srv_argv_push(arg);
68: 188: return NULL;
-: 189:}
-: 190:
-: 191:MP_CMD_SRV_DECLARE(modules)
264: 192:{
264: 193: MP_dSCFG(parms->server);
264: 194: MP_PERL_DECLARE_CONTEXT;
-: 195:
264: 196: if (modperl_is_running() &&
-: 197: modperl_init_vhost(parms->server, parms->pool, NULL) != OK)
-: 198: {
#####: 199: return "init mod_perl vhost failed";
-: 200: }
-: 201:
264: 202: if (modperl_is_running()) {
40: 203: char *error = NULL;
-: 204:
40: 205: MP_TRACE_d(MP_FUNC, "load PerlModule %s\n", arg);
-: 206:
40: 207: MP_PERL_OVERRIDE_CONTEXT;
40: 208: if (!modperl_require_module(aTHX_ arg, FALSE)) {
#####: 209: error = SvPVX(ERRSV);
-: 210: }
40: 211: MP_PERL_RESTORE_CONTEXT;
-: 212:
40: 213: return error;
-: 214: }
-: 215: else {
224: 216: MP_TRACE_d(MP_FUNC, "push PerlModule %s\n", arg);
224: 217: *(const char **)apr_array_push(scfg->PerlModule) = arg;
224: 218: return NULL;
-: 219: }
-: 220:}
-: 221:
-: 222:MP_CMD_SRV_DECLARE(requires)
36: 223:{
36: 224: MP_dSCFG(parms->server);
36: 225: MP_PERL_DECLARE_CONTEXT;
-: 226:
36: 227: if (modperl_is_running() &&
-: 228: modperl_init_vhost(parms->server, parms->pool, NULL) != OK)
-: 229: {
#####: 230: return "init mod_perl vhost failed";
-: 231: }
-: 232:
36: 233: if (modperl_is_running()) {
#####: 234: char *error = NULL;
-: 235:
#####: 236: MP_TRACE_d(MP_FUNC, "load PerlRequire %s\n", arg);
-: 237:
#####: 238: MP_PERL_OVERRIDE_CONTEXT;
#####: 239: if (!modperl_require_file(aTHX_ arg, FALSE)) {
#####: 240: error = SvPVX(ERRSV);
-: 241: }
#####: 242: MP_PERL_RESTORE_CONTEXT;
-: 243:
#####: 244: return error;
-: 245: }
-: 246: else {
36: 247: MP_TRACE_d(MP_FUNC, "push PerlRequire %s\n", arg);
36: 248: *(const char **)apr_array_push(scfg->PerlRequire) = arg;
36: 249: return NULL;
-: 250: }
-: 251:}
-: 252:
-: 253:static MP_CMD_SRV_DECLARE2(handle_vars)
128: 254:{
128: 255: MP_dSCFG(parms->server);
128: 256: modperl_config_dir_t *dcfg = (modperl_config_dir_t *)mconfig;
128: 257: const char *name = parms->cmd->name;
-: 258:
-: 259: /* PerlSetVar and PerlAddVar logic. here's the deal...
-: 260: *
-: 261: * cfg->configvars holds the final PerlSetVar/PerlAddVar configuration
-: 262: * for a given server or directory. however, getting to that point
-: 263: * is kind of tricky, due to the add-style nature of PerlAddVar.
-: 264: *
-: 265: * the solution is to use cfg->setvars to hold PerlSetVar entries
-: 266: * and cfg->addvars to hold PerlAddVar entries, each serving as a
-: 267: * placeholder for when we need to know what's what in the merge routines.
-: 268: *
-: 269: * however, for the initial pass, apr_table_setn and apr_table_addn
-: 270: * will properly build the configvars table, which will be visible to
-: 271: * startup scripts trying to access per-server configurations.
-: 272: *
-: 273: * the end result is that we need to populate all three tables in order
-: 274: * to keep things straight later on see merge_table_config_vars in
-: 275: * modperl_config.c
-: 276: */
128: 277: modperl_table_modify_t func =
256: 278: strEQ(name, "PerlSetVar") ? apr_table_setn : apr_table_addn;
-: 279:
128: 280: apr_table_t *table =
256: 281: strEQ(name, "PerlSetVar") ? dcfg->setvars : dcfg->addvars;
-: 282:
128: 283: func(table, arg1, arg2);
128: 284: func(dcfg->configvars, arg1, arg2);
-: 285:
128: 286: MP_TRACE_d(MP_FUNC, "%s DIR: arg1 = %s, arg2 = %s\n",
-: 287: name, arg1, arg2);
-: 288:
-: 289: /* make available via Apache->server->dir_config */
128: 290: if (!parms->path) {
84: 291: table = strEQ(name, "PerlSetVar") ? scfg->setvars : scfg->addvars;
-: 292:
84: 293: func(table, arg1, arg2);
84: 294: func(scfg->configvars, arg1, arg2);
-: 295:
84: 296: MP_TRACE_d(MP_FUNC, "%s SRV: arg1 = %s, arg2 = %s\n",
-: 297: name, arg1, arg2);
-: 298: }
-: 299:
128: 300: return NULL;
-: 301:}
-: 302:
-: 303:MP_CMD_SRV_DECLARE2(set_var)
92: 304:{
92: 305: return modperl_cmd_handle_vars(parms, mconfig, arg1, arg2);
-: 306:}
-: 307:
-: 308:MP_CMD_SRV_DECLARE2(add_var)
36: 309:{
36: 310: return modperl_cmd_handle_vars(parms, mconfig, arg1, arg2);
-: 311:}
-: 312:
-: 313:MP_CMD_SRV_DECLARE2(set_env)
72: 314:{
72: 315: MP_dSCFG(parms->server);
72: 316: modperl_config_dir_t *dcfg = (modperl_config_dir_t *)mconfig;
-: 317:
-: 318:#ifdef ENV_IS_CASELESS /* i.e. WIN32 */
-: 319: /* we turn off env magic during hv_store later, so do this now,
-: 320: * else lookups on keys with lowercase characters will fails
-: 321: * because Perl will uppercase them prior to lookup.
-: 322: */
-: 323: modperl_str_toupper((char *)arg1);
-: 324:#endif
-: 325:
72: 326: MP_TRACE_d(MP_FUNC, "arg1 = %s, arg2 = %s\n", arg1, arg2);
-: 327:
72: 328: if (!parms->path) {
-: 329: /* will be propagated to environ */
24: 330: apr_table_setn(scfg->SetEnv, arg1, arg2);
-: 331: }
-: 332:
72: 333: apr_table_setn(dcfg->SetEnv, arg1, arg2);
-: 334:
72: 335: return NULL;
-: 336:}
-: 337:
-: 338:MP_CMD_SRV_DECLARE(pass_env)
16: 339:{
16: 340: MP_dSCFG(parms->server);
16: 341: char *val = getenv(arg);
-: 342:
-: 343:#ifdef ENV_IS_CASELESS /* i.e. WIN32 */
-: 344: /* we turn off env magic during hv_store later, so do this now,
-: 345: * else lookups on keys with lowercase characters will fails
-: 346: * because Perl will uppercase them prior to lookup.
-: 347: */
-: 348: modperl_str_toupper((char *)arg);
-: 349:#endif
-: 350:
16: 351: if (val) {
8: 352: apr_table_setn(scfg->PassEnv, arg, apr_pstrdup(parms->pool, val));
8: 353: MP_TRACE_d(MP_FUNC, "arg = %s, val = %s\n", arg, val);
-: 354: }
-: 355: else {
8: 356: MP_TRACE_d(MP_FUNC, "arg = %s: not found via getenv()\n", arg);
-: 357: }
-: 358:
16: 359: return NULL;
-: 360:}
-: 361:
-: 362:MP_CMD_SRV_DECLARE(options)
224: 363:{
224: 364: MP_dSCFG(parms->server);
224: 365: modperl_config_dir_t *dcfg = (modperl_config_dir_t *)mconfig;
224: 366: int is_per_dir = parms->path ? 1 : 0;
224: 367: modperl_options_t *opts = is_per_dir ? dcfg->flags : scfg->flags;
224: 368: apr_pool_t *p = parms->pool;
224: 369: const char *error;
-: 370:
224: 371: MP_TRACE_d(MP_FUNC, "arg = %s\n", arg);
224: 372: if ((error = modperl_options_set(p, opts, arg)) && !is_per_dir) {
-: 373: /* maybe a per-directory option outside of a container */
4: 374: if (modperl_options_set(p, dcfg->flags, arg) == NULL) {
4: 375: error = NULL;
-: 376: }
-: 377: }
-: 378:
4: 379: if (error) {
#####: 380: return error;
-: 381: }
-: 382:
224: 383: return NULL;
-: 384:}
-: 385:
-: 386:MP_CMD_SRV_DECLARE(init_handlers)
36: 387:{
36: 388: if (parms->path) {
28: 389: return modperl_cmd_header_parser_handlers(parms, mconfig, arg);
-: 390: }
-: 391:
8: 392: return modperl_cmd_post_read_request_handlers(parms, mconfig, arg);
-: 393:}
-: 394:
-: 395:static const char *modperl_cmd_parse_args(apr_pool_t *p,
-: 396: const char *args,
-: 397: apr_table_t **t)
37: 398:{
37: 399: const char *orig_args = args;
37: 400: char *pair, *key, *val;
37: 401: *t = apr_table_make(p, 2);
-: 402:
37: 403: while (*(pair = ap_getword(p, &args, ',')) != '\0') {
#####: 404: key = ap_getword_nc(p, &pair, '=');
#####: 405: val = pair;
-: 406:
#####: 407: if (!(*key && *val)) {
#####: 408: return apr_pstrcat(p, "invalid args spec: ",
-: 409: orig_args, NULL);
-: 410: }
-: 411:
#####: 412: apr_table_set(*t, key, val);
-: 413: }
-: 414:
37: 415: return NULL;
-: 416:}
-: 417:
-: 418:MP_CMD_SRV_DECLARE(perl)
37: 419:{
37: 420: apr_pool_t *p = parms->pool;
37: 421: const char *endp = ap_strrchr_c(arg, '>');
37: 422: const char *errmsg;
37: 423: char *code = "";
37: 424: char line[MAX_STRING_LEN];
37: 425: apr_table_t *args;
37: 426: ap_directive_t **current = mconfig;
37: 427: int line_num;
-: 428:
37: 429: if (!endp) {
#####: 430: return modperl_cmd_unclosed_directive(parms);
-: 431: }
-: 432:
37: 433: arg = apr_pstrndup(p, arg, endp - arg);
-: 434:
37: 435: if ((errmsg = modperl_cmd_parse_args(p, arg, &args))) {
#####: 436: return errmsg;
-: 437: }
-: 438:
37: 439: line_num = parms->config_file->line_number+1;
37: 440: while (!ap_cfg_getline(line, sizeof(line), parms->config_file)) {
-: 441: /*XXX: Not sure how robust this is */
209: 442: if (strEQ(line, "")) {
172: 443: break;
-: 444: }
-: 445:
-: 446: /*XXX: Less than optimal */
172: 447: code = apr_pstrcat(p, code, line, "\n", NULL);
-: 448: }
-: 449:
-: 450: /* Here, we have to replace our current config node for the next pass */
37: 451: if (!*current) {
37: 452: *current = apr_pcalloc(p, sizeof(**current));
-: 453: }
-: 454:
37: 455: (*current)->filename = parms->config_file->name;
37: 456: (*current)->line_num = line_num;
37: 457: (*current)->directive = apr_pstrdup(p, "Perl");
37: 458: (*current)->args = code;
37: 459: (*current)->data = args;
-: 460:
37: 461: return NULL;
-: 462:}
-: 463:
-: 464:#define MP_DEFAULT_PERLSECTION_HANDLER "Apache::PerlSections"
-: 465:#define MP_DEFAULT_PERLSECTION_PACKAGE "Apache::ReadConfig"
-: 466:#define MP_STRICT_PERLSECTIONS_SV \
-: 467: get_sv("Apache::Server::StrictPerlSections", FALSE)
-: 468:#define MP_PERLSECTIONS_SAVECONFIG_SV \
-: 469: get_sv("Apache::Server::SaveConfig", FALSE)
-: 470:
-: 471:MP_CMD_SRV_DECLARE(perldo)
36: 472:{
36: 473: apr_pool_t *p = parms->pool;
36: 474: server_rec *s = parms->server;
36: 475: apr_table_t *options;
36: 476: modperl_handler_t *handler = NULL;
36: 477: const char *pkg_name = NULL;
36: 478: ap_directive_t *directive = parms->directive;
-: 479:#ifdef USE_ITHREADS
36: 480: MP_dSCFG(s);
36: 481: MP_PERL_DECLARE_CONTEXT;
-: 482:#endif
-: 483:
36: 484: if (!(arg && *arg)) {
#####: 485: return NULL;
-: 486: }
-: 487:
-: 488: /* we must init earlier than normal */
36: 489: modperl_run();
-: 490:
36: 491: if (modperl_init_vhost(s, p, NULL) != OK) {
#####: 492: return "init mod_perl vhost failed";
-: 493: }
-: 494:
36: 495: MP_PERL_OVERRIDE_CONTEXT;
-: 496:
-: 497: /* data will be set by a section */
36: 498: if ((options = directive->data)) {
32: 499: const char *pkg_namespace;
32: 500: const char *pkg_base;
32: 501: const char *handler_name;
32: 502: const char *line_header;
-: 503:
32: 504: if (!(handler_name = apr_table_get(options, "handler"))) {
32: 505: handler_name = apr_pstrdup(p, MP_DEFAULT_PERLSECTION_HANDLER);
32: 506: apr_table_set(options, "handler", handler_name);
-: 507: }
-: 508:
32: 509: handler = modperl_handler_new(p, handler_name);
-: 510:
32: 511: if (!(pkg_base = apr_table_get(options, "package"))) {
32: 512: pkg_base = apr_pstrdup(p, MP_DEFAULT_PERLSECTION_PACKAGE);
-: 513: }
-: 514:
32: 515: pkg_namespace = modperl_file2package(p, directive->filename);
-: 516:
32: 517: pkg_name = apr_psprintf(p, "%s::%s::line_%d",
-: 518: pkg_base,
-: 519: pkg_namespace,
-: 520: directive->line_num);
-: 521:
32: 522: apr_table_set(options, "package", pkg_name);
-: 523:
32: 524: line_header = apr_psprintf(p, "\n#line %d %s\n",
-: 525: directive->line_num,
-: 526: directive->filename);
-: 527:
-: 528: /* put the code about to be executed in the configured package */
32: 529: arg = apr_pstrcat(p, "package ", pkg_name, ";", line_header,
-: 530: arg, NULL);
-: 531: }
-: 532:
-: 533: {
36: 534: GV *gv = gv_fetchpv("0", TRUE, SVt_PV);
36: 535: ENTER;
36: 536: save_scalar(gv); /* local $0 */
36: 537: sv_setpv_mg(GvSV(gv), directive->filename);
36: 538: eval_pv(arg, FALSE);
36: 539: LEAVE;
-: 540: }
-: 541:
36: 542: if (SvTRUE(ERRSV)) {
#####: 543: SV *strict = MP_STRICT_PERLSECTIONS_SV;
#####: 544: if (strict && SvTRUE(strict)) {
#####: 545: char *error = SvPVX(ERRSV);
#####: 546: MP_PERL_RESTORE_CONTEXT;
#####: 547: return error;
-: 548: }
-: 549: else {
#####: 550: modperl_log_warn(s, apr_psprintf(p, "Syntax error at %s:%d %s",
-: 551: directive->filename,
-: 552: directive->line_num,
-: 553: SvPVX(ERRSV)));
-: 554: }
-: 555: }
-: 556:
36: 557: if (handler) {
32: 558: int status;
32: 559: SV *saveconfig = MP_PERLSECTIONS_SAVECONFIG_SV;
32: 560: AV *args = Nullav;
-: 561:
32: 562: modperl_handler_make_args(aTHX_ &args,
-: 563: "Apache::CmdParms", parms,
-: 564: "APR::Table", options,
-: 565: NULL);
-: 566:
32: 567: status = modperl_callback(aTHX_ handler, p, NULL, s, args);
-: 568:
32: 569: SvREFCNT_dec((SV*)args);
-: 570:
32: 571: if (!(saveconfig && SvTRUE(saveconfig))) {
12: 572: HV *symtab = (HV*)gv_stashpv(pkg_name, FALSE);
12: 573: if (symtab) {
12: 574: modperl_clear_symtab(aTHX_ symtab);
-: 575: }
-: 576: }
-: 577:
32: 578: if (status != OK) {
#####: 579: char *error = SvTRUE(ERRSV) ? SvPVX(ERRSV) :
-: 580: apr_psprintf(p, " handler %s failed with status=%d",
#####: 581: handler->name, status);
#####: 582: MP_PERL_RESTORE_CONTEXT;
#####: 583: return error;
-: 584: }
-: 585: }
-: 586:
36: 587: MP_PERL_RESTORE_CONTEXT;
36: 588: return NULL;
-: 589:}
-: 590:
-: 591:#define MP_POD_FORMAT(s) \
-: 592: (ap_strstr_c(s, "httpd") || ap_strstr_c(s, "apache"))
-: 593:
-: 594:MP_CMD_SRV_DECLARE(pod)
10: 595:{
10: 596: char line[MAX_STRING_LEN];
-: 597:
10: 598: if (arg && *arg && !(MP_POD_FORMAT(arg) || strstr("pod", arg))) {
#####: 599: return "Unknown =back format";
-: 600: }
-: 601:
10: 602: while (!ap_cfg_getline(line, sizeof(line), parms->config_file)) {
20: 603: if (strEQ(line, "=cut")) {
15: 604: break;
-: 605: }
15: 606: if (strnEQ(line, "=over", 5) && MP_POD_FORMAT(line)) {
20: 607: break;
-: 608: }
-: 609: }
-: 610:
10: 611: return NULL;
-: 612:}
-: 613:
-: 614:MP_CMD_SRV_DECLARE(pod_cut)
#####: 615:{
#####: 616: return "=cut without =pod";
-: 617:}
-: 618:
-: 619:MP_CMD_SRV_DECLARE(END)
#####: 620:{
#####: 621: char line[MAX_STRING_LEN];
-: 622:
#####: 623: while (!ap_cfg_getline(line, sizeof(line), parms->config_file)) {
-: 624: /* soak up rest of the file */
-: 625: }
-: 626:
#####: 627: return NULL;
-: 628:}
-: 629:
-: 630:/*
-: 631: * XXX: the name of this directive may or may not stay.
-: 632: * need a way to note that a module has config directives.
-: 633: * don't want to start mod_perl when we see a non-special PerlModule.
-: 634: */
-: 635:MP_CMD_SRV_DECLARE(load_module)
24: 636:{
24: 637: apr_pool_t *p = parms->pool;
24: 638: server_rec *s = parms->server;
24: 639: const char *errmsg;
-: 640:
24: 641: MP_TRACE_d(MP_FUNC, "PerlLoadModule %s\n", arg);
-: 642:
-: 643: /* we must init earlier than normal */
24: 644: modperl_run();
-: 645:
24: 646: if ((errmsg = modperl_cmd_modules(parms, mconfig, arg))) {
#####: 647: return errmsg;
-: 648: }
-: 649:
24: 650: return modperl_module_add(p, s, arg);
-: 651:}
-: 652:
-: 653:/* propogate filters insertion ala SetInputFilter */
-: 654:MP_CMD_SRV_DECLARE(set_input_filter)
#####: 655:{
#####: 656: MP_dSCFG(parms->server);
#####: 657: modperl_config_dir_t *dcfg = (modperl_config_dir_t *)mconfig;
#####: 658: char *filter;
-: 659:
#####: 660: if (!MpSrvENABLE(scfg)) {
#####: 661: return apr_pstrcat(parms->pool,
-: 662: "Perl is disabled for server ",
-: 663: parms->server->server_hostname, NULL);
-: 664: }
#####: 665: if (!MpSrvINPUT_FILTER(scfg)) {
#####: 666: return apr_pstrcat(parms->pool,
-: 667: "PerlSetInputFilter is disabled for server ",
-: 668: parms->server->server_hostname, NULL);
-: 669: }
-: 670:
#####: 671: while (*arg && (filter = ap_getword(parms->pool, &arg, ';'))) {
#####: 672: modperl_cmd_push_httpd_filter_handlers(
-: 673: &(dcfg->handlers_per_dir[MP_INPUT_FILTER_HANDLER]),
-: 674: filter, parms->pool);
-: 675: }
-: 676:
#####: 677: return NULL;
-: 678:}
-: 679:
-: 680:/* propogate filters insertion ala SetOutputFilter */
-: 681:MP_CMD_SRV_DECLARE(set_output_filter)
20: 682:{
20: 683: MP_dSCFG(parms->server);
20: 684: modperl_config_dir_t *dcfg = (modperl_config_dir_t *)mconfig;
20: 685: char *filter;
-: 686:
20: 687: if (!MpSrvENABLE(scfg)) {
#####: 688: return apr_pstrcat(parms->pool,
-: 689: "Perl is disabled for server ",
-: 690: parms->server->server_hostname, NULL);
-: 691: }
20: 692: if (!MpSrvINPUT_FILTER(scfg)) {
#####: 693: return apr_pstrcat(parms->pool,
-: 694: "PerlSetOutputFilter is disabled for server ",
-: 695: parms->server->server_hostname, NULL);
-: 696: }
-: 697:
20: 698: while (*arg && (filter = ap_getword(parms->pool, &arg, ';'))) {
20: 699: modperl_cmd_push_httpd_filter_handlers(
-: 700: &(dcfg->handlers_per_dir[MP_OUTPUT_FILTER_HANDLER]),
-: 701: filter, parms->pool);
-: 702: }
-: 703:
20: 704: return NULL;
-: 705:}
-: 706:
-: 707:
-: 708:#ifdef MP_COMPAT_1X
-: 709:
-: 710:MP_CMD_SRV_DECLARE_FLAG(taint_check)
#####: 711:{
#####: 712: if (flag_on) {
#####: 713: return modperl_cmd_switches(parms, mconfig, "-T");
-: 714: }
-: 715:
#####: 716: return NULL;
-: 717:}
-: 718:
-: 719:MP_CMD_SRV_DECLARE_FLAG(warn)
#####: 720:{
#####: 721: if (flag_on) {
#####: 722: return modperl_cmd_switches(parms, mconfig, "-w");
-: 723: }
-: 724:
#####: 725: return NULL;
-: 726:}
-: 727:
-: 728:MP_CMD_SRV_DECLARE_FLAG(send_header)
#####: 729:{
#####: 730: char *arg = flag_on ? "+ParseHeaders" : "-ParseHeaders";
#####: 731: return modperl_cmd_options(parms, mconfig, arg);
-: 732:}
-: 733:
-: 734:MP_CMD_SRV_DECLARE_FLAG(setup_env)
#####: 735:{
#####: 736: char *arg = flag_on ? "+SetupEnv" : "-SetupEnv";
#####: 737: return modperl_cmd_options(parms, mconfig, arg);
-: 738:}
-: 739:
-: 740:#endif /* MP_COMPAT_1X */
-: 741:
-: 742:#ifdef USE_ITHREADS
-: 743:
-: 744:#define MP_INTERP_SCOPE_USAGE "PerlInterpScope must be one of "
-: 745:
-: 746:#define MP_INTERP_SCOPE_DIR_OPTS \
-: 747: "handler, subrequest or request"
-: 748:
-: 749:#define MP_INTERP_SCOPE_DIR_USAGE \
-: 750: MP_INTERP_SCOPE_USAGE MP_INTERP_SCOPE_DIR_OPTS
-: 751:
-: 752:#define MP_INTERP_SCOPE_SRV_OPTS \
-: 753: "connection, " MP_INTERP_SCOPE_DIR_OPTS
-: 754:
-: 755:#define MP_INTERP_SCOPE_SRV_USAGE \
-: 756: MP_INTERP_SCOPE_USAGE MP_INTERP_SCOPE_SRV_OPTS
-: 757:
-: 758:MP_CMD_SRV_DECLARE(interp_scope)
#####: 759:{
#####: 760: modperl_interp_scope_e *scope;
#####: 761: modperl_config_dir_t *dcfg = (modperl_config_dir_t *)mconfig;
#####: 762: MP_dSCFG(parms->server);
#####: 763: int is_per_dir = parms->path ? 1 : 0;
-: 764:
#####: 765: scope = is_per_dir ? &dcfg->interp_scope : &scfg->interp_scope;
-: 766:
#####: 767: switch (toLOWER(*arg)) {
-: 768: case 'h':
#####: 769: if (strcaseEQ(arg, "handler")) {
#####: 770: *scope = MP_INTERP_SCOPE_HANDLER;
#####: 771: break;
-: 772: }
-: 773: case 's':
#####: 774: if (strcaseEQ(arg, "subrequest")) {
#####: 775: *scope = MP_INTERP_SCOPE_SUBREQUEST;
#####: 776: break;
-: 777: }
-: 778: case 'r':
#####: 779: if (strcaseEQ(arg, "request")) {
#####: 780: *scope = MP_INTERP_SCOPE_REQUEST;
#####: 781: break;
-: 782: }
-: 783: case 'c':
#####: 784: if (!is_per_dir && strcaseEQ(arg, "connection")) {
#####: 785: *scope = MP_INTERP_SCOPE_CONNECTION;
#####: 786: break;
-: 787: }
-: 788: default:
#####: 789: return is_per_dir ?
-: 790: MP_INTERP_SCOPE_DIR_USAGE : MP_INTERP_SCOPE_SRV_USAGE;
-: 791: };
-: 792:
#####: 793: return NULL;
-: 794:}
-: 795:
-: 796:#define MP_CMD_INTERP_POOL_IMP(xitem) \
-: 797:const char *modperl_cmd_interp_##xitem(cmd_parms *parms, \
-: 798: void *mconfig, const char *arg) \
-: 799:{ \
-: 800: MP_dSCFG(parms->server); \
-: 801: int item = atoi(arg); \
-: 802: scfg->interp_pool_cfg->xitem = item; \
-: 803: MP_TRACE_d(MP_FUNC, "%s %d\n", parms->cmd->name, item); \
-: 804: return NULL; \
-: 805:}
-: 806:
#####: 807:MP_CMD_INTERP_POOL_IMP(start);
#####: 808:MP_CMD_INTERP_POOL_IMP(max);
#####: 809:MP_CMD_INTERP_POOL_IMP(max_spare);
#####: 810:MP_CMD_INTERP_POOL_IMP(min_spare);
#####: 811:MP_CMD_INTERP_POOL_IMP(max_requests);
-: 812:
-: 813:#endif /* USE_ITHREADS */