-: 0:Source:modperl_config.c -: 0:Object:modperl_config.bb -: 1:/* Copyright 2000-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:void *modperl_config_dir_create(apr_pool_t *p, char *dir) 886: 19:{ 886: 20: modperl_config_dir_t *dcfg = modperl_config_dir_new(p); -: 21: 886: 22: dcfg->location = dir; -: 23: -: 24:#ifdef USE_ITHREADS -: 25: /* defaults to per-server scope */ 886: 26: dcfg->interp_scope = MP_INTERP_SCOPE_UNDEF; -: 27:#endif -: 28: 886: 29: return dcfg; -: 30:} -: 31: -: 32:#define merge_item(item) \ -: 33: mrg->item = add->item ? add->item : base->item -: 34: -: 35:static apr_table_t *modperl_table_overlap(apr_pool_t *p, -: 36: apr_table_t *base, -: 37: apr_table_t *add) 1086: 38:{ -: 39: /* take the base (parent) values, and override with add (child) values, -: 40: * generating a new table. entries in add but not in base will be -: 41: * added to the new table. all using core apr table routines. -: 42: * -: 43: * note that this is equivalent to apr_table_overlap except a new -: 44: * table is generated, which is required (otherwise we would clobber -: 45: * the existing parent or child configurations) -: 46: */ 1086: 47: apr_table_t *merge = apr_table_overlay(p, base, add); -: 48: -: 49: /* compress will squash each key to the last value in the table. this -: 50: * is acceptable for all tables that expect only a single value per key -: 51: * such as PerlPassEnv and PerlSetEnv. PerlSetVar/PerlAddVar get their -: 52: * own, non-standard, merge routines in merge_table_config_vars. -: 53: */ 1086: 54: apr_table_compress(merge, APR_OVERLAP_TABLES_SET); -: 55: 1086: 56: return merge; -: 57:} -: 58: -: 59:#define merge_table_overlap_item(item) \ -: 60: mrg->item = modperl_table_overlap(p, base->item, add->item) -: 61: -: 62:static apr_table_t *merge_table_config_vars(apr_pool_t *p, -: 63: apr_table_t *configvars, -: 64: apr_table_t *set, -: 65: apr_table_t *add) 1002: 66:{ 1002: 67: apr_table_t *base = apr_table_copy(p, configvars); 1002: 68: apr_table_t *merged_config_vars; -: 69: 1002: 70: const apr_array_header_t *arr; 1002: 71: apr_table_entry_t *entries; 1002: 72: int i; -: 73: -: 74: /* configvars already contains a properly merged PerlSetVar/PerlAddVar -: 75: * configuration for the base (parent), so all we need to do is merge -: 76: * the add (child) configuration into it properly. -: 77: * -: 78: * any PerlSetVar settings in the add (child) config need to reset -: 79: * existing entries in the base (parent) config, or generate a -: 80: * new entry where none existed previously. PerlAddVar settings -: 81: * are merged into that. -: 82: * -: 83: * unfortunately, there is no set of apr functions to do this for us - -: 84: * apr_compress_table would be ok, except it always merges mulit-valued -: 85: * keys into one, regardless of the APR_OVERLAP_TABLES flag. that is, -: 86: * regardless of whether newer entries are set or merged into existing -: 87: * entries, the entire table is _always_ compressed. this is no good - -: 88: * we need separate entries for existing keys, not a single (compressed) -: 89: * entry. -: 90: * -: 91: * fortunately, the logic here is simple. first, (re)set the base (parent) -: 92: * table where a PerlSetVar entry exists in the add (child) configuration. -: 93: * then, just overlay the PerlAddVar configuration into it. -: 94: */ -: 95: 1002: 96: arr = apr_table_elts(set); 1002: 97: entries = (apr_table_entry_t *)arr->elts; -: 98: -: 99: /* hopefully this is faster than using apr_table_do */ 1070: 100: for (i = 0; i < arr->nelts; i++) { 68: 101: apr_table_setn(base, entries[i].key, entries[i].val); -: 102: } -: 103: -: 104: /* at this point, all the PerlSetVar merging has happened. add in the -: 105: * add (child) PerlAddVar entries and we're done -: 106: */ 1002: 107: merged_config_vars = apr_table_overlay(p, base, add); -: 108: 1002: 109: return merged_config_vars; -: 110:} -: 111: -: 112:#define merge_handlers(merge_flag, array) \ -: 113: if (merge_flag(mrg)) { \ -: 114: mrg->array = modperl_handler_array_merge(p, \ -: 115: base->array, \ -: 116: add->array); \ -: 117: } \ -: 118: else { \ -: 119: merge_item(array); \ -: 120: } -: 121: -: 122:void *modperl_config_dir_merge(apr_pool_t *p, void *basev, void *addv) 918: 123:{ 918: 124: int i; -: 125: modperl_config_dir_t 918: 126: *base = (modperl_config_dir_t *)basev, 918: 127: *add = (modperl_config_dir_t *)addv, 918: 128: *mrg = modperl_config_dir_new(p); -: 129: 918: 130: MP_TRACE_d(MP_FUNC, "basev==0x%lx, addv==0x%lx\n", -: 131: (unsigned long)basev, (unsigned long)addv); -: 132: -: 133:#ifdef USE_ITHREADS 918: 134: merge_item(interp_scope); -: 135:#endif -: 136: 918: 137: mrg->flags = modperl_options_merge(p, base->flags, add->flags); -: 138: 918: 139: merge_item(location); -: 140: 918: 141: merge_table_overlap_item(SetEnv); -: 142: -: 143: /* this is where we merge PerlSetVar and PerlAddVar together */ 918: 144: mrg->configvars = merge_table_config_vars(p, -: 145: base->configvars, -: 146: add->setvars, add->addvars); -: 147: -: 148: /* note we don't care about merging dcfg->setvars or dcfg->addvars -: 149: * specifically - what is important to merge is dfcg->configvars. -: 150: * but we need to keep track of the entries for this config, so -: 151: * the merged values are simply the values for the add (current) -: 152: * configuration. -: 153: */ 918: 154: mrg->setvars = add->setvars; 918: 155: mrg->addvars = add->addvars; -: 156: -: 157: /* XXX: check if Perl*Handler is disabled */ 11016: 158: for (i=0; i < MP_HANDLER_NUM_PER_DIR; i++) { 10098: 159: merge_handlers(MpDirMERGE_HANDLERS, handlers_per_dir[i]); -: 160: } -: 161: 918: 162: return mrg; -: 163:} -: 164: -: 165:modperl_config_req_t *modperl_config_req_new(request_rec *r) 453: 166:{ 453: 167: modperl_config_req_t *rcfg = 906: 168: (modperl_config_req_t *)apr_pcalloc(r->pool, sizeof(*rcfg)); -: 169: 453: 170: MP_TRACE_d(MP_FUNC, "0x%lx\n", (unsigned long)rcfg); -: 171: 453: 172: return rcfg; -: 173:} -: 174: -: 175:modperl_config_srv_t *modperl_config_srv_new(apr_pool_t *p) 178: 176:{ 178: 177: modperl_config_srv_t *scfg = (modperl_config_srv_t *) 356: 178: apr_pcalloc(p, sizeof(*scfg)); -: 179: 178: 180: scfg->flags = modperl_options_new(p, MpSrvType); 178: 181: MpSrvENABLE_On(scfg); /* mod_perl enabled by default */ 178: 182: MpSrvHOOKS_ALL_On(scfg); /* all hooks enabled by default */ -: 183: 178: 184: scfg->PerlModule = apr_array_make(p, 2, sizeof(char *)); 178: 185: scfg->PerlRequire = apr_array_make(p, 2, sizeof(char *)); -: 186: 178: 187: scfg->argv = apr_array_make(p, 2, sizeof(char *)); -: 188: 178: 189: scfg->setvars = apr_table_make(p, 2); 178: 190: scfg->addvars = apr_table_make(p, 2); 178: 191: scfg->configvars = apr_table_make(p, 2); -: 192: 178: 193: scfg->PassEnv = apr_table_make(p, 2); 178: 194: scfg->SetEnv = apr_table_make(p, 2); -: 195: -: 196:#ifdef MP_USE_GTOP -: 197: scfg->gtop = modperl_gtop_new(p); -: 198:#endif -: 199: -: 200: /* must copy ap_server_argv0, because otherwise any read/write of -: 201: * $0 corrupts process' argv[0] (visible with 'ps -ef' on most -: 202: * unices). This is due to the logic of calculating PL_origalen in -: 203: * perl_parse, which is later used in set_mg.c:Perl_magic_set() to -: 204: * truncate the argv[0] setting. remember that argv[0] passed to -: 205: * perl_parse() != process's real argv[0]. -: 206: * -: 207: * as a copying side-effect, changing $0 now doesn't affect the -: 208: * way the process is seen from the outside. -: 209: */ 178: 210: modperl_config_srv_argv_push(apr_pstrmemdup(p, ap_server_argv0, -: 211: strlen(ap_server_argv0))); -: 212: 178: 213: MP_TRACE_d(MP_FUNC, "new scfg: 0x%lx\n", (unsigned long)scfg); -: 214: 178: 215: return scfg; -: 216:} -: 217: -: 218:modperl_config_dir_t *modperl_config_dir_new(apr_pool_t *p) 1804: 219:{ 1804: 220: modperl_config_dir_t *dcfg = (modperl_config_dir_t *) 3608: 221: apr_pcalloc(p, sizeof(modperl_config_dir_t)); -: 222: 1804: 223: dcfg->flags = modperl_options_new(p, MpDirType); -: 224: 1804: 225: dcfg->setvars = apr_table_make(p, 2); 1804: 226: dcfg->addvars = apr_table_make(p, 2); 1804: 227: dcfg->configvars = apr_table_make(p, 2); -: 228: 1804: 229: dcfg->SetEnv = apr_table_make(p, 2); -: 230: 1804: 231: MP_TRACE_d(MP_FUNC, "new dcfg: 0x%lx\n", (unsigned long)dcfg); -: 232: 1804: 233: return dcfg; -: 234:} -: 235: -: 236:#ifdef MP_TRACE -: 237:static void dump_argv(modperl_config_srv_t *scfg) #####: 238:{ #####: 239: int i; #####: 240: char **argv = (char **)scfg->argv->elts; #####: 241: modperl_trace(NULL, "modperl_config_srv_argv_init =>"); #####: 242: for (i=0; iargv->nelts; i++) { #####: 243: modperl_trace(NULL, " %d = %s", i, argv[i]); -: 244: } -: 245:} -: 246:#endif -: 247: -: 248:char **modperl_config_srv_argv_init(modperl_config_srv_t *scfg, int *argc) 20: 249:{ 20: 250: modperl_config_srv_argv_push("-e;0"); -: 251: 20: 252: *argc = scfg->argv->nelts; -: 253: 20: 254: MP_TRACE_g_do(dump_argv(scfg)); -: 255: 20: 256: return (char **)scfg->argv->elts; -: 257:} -: 258: -: 259:void *modperl_config_srv_create(apr_pool_t *p, server_rec *s) 86: 260:{ 86: 261: modperl_config_srv_t *scfg = modperl_config_srv_new(p); -: 262: 86: 263: ap_mpm_query(AP_MPMQ_IS_THREADED, &scfg->threaded_mpm); -: 264: 86: 265: if (!s->is_virtual) { -: 266: -: 267: /* give a chance to MOD_PERL_TRACE env var to set -: 268: * PerlTrace. This place is the earliest point in mod_perl -: 269: * configuration parsing, when we have the server object -: 270: */ 10: 271: modperl_trace_level_set(s, NULL); -: 272: -: 273: /* Must store the global server record as early as possible, -: 274: * because if mod_perl happens to be started from within a -: 275: * vhost (e.g., PerlLoadModule) the base server record won't -: 276: * be available to vhost and things will blow up -: 277: */ 10: 278: modperl_init_globals(s, p); -: 279: } -: 280: 86: 281: MP_TRACE_d(MP_FUNC, "p=0x%lx, s=0x%lx, virtual=%d\n", -: 282: p, s, s->is_virtual); -: 283: -: 284:#ifdef USE_ITHREADS -: 285: 86: 286: scfg->interp_pool_cfg = -: 287: (modperl_tipool_config_t *) 86: 288: apr_pcalloc(p, sizeof(*scfg->interp_pool_cfg)); -: 289: 86: 290: scfg->interp_scope = MP_INTERP_SCOPE_REQUEST; -: 291: -: 292: /* XXX: determine reasonable defaults */ 86: 293: scfg->interp_pool_cfg->start = 3; 86: 294: scfg->interp_pool_cfg->max_spare = 3; 86: 295: scfg->interp_pool_cfg->min_spare = 3; 86: 296: scfg->interp_pool_cfg->max = 5; 86: 297: scfg->interp_pool_cfg->max_requests = 2000; -: 298:#endif /* USE_ITHREADS */ -: 299: 86: 300: scfg->server = s; -: 301: 86: 302: return scfg; -: 303:} -: 304: -: 305:/* XXX: this is not complete */ -: 306:void *modperl_config_srv_merge(apr_pool_t *p, void *basev, void *addv) 84: 307:{ 84: 308: int i; -: 309: modperl_config_srv_t 84: 310: *base = (modperl_config_srv_t *)basev, 84: 311: *add = (modperl_config_srv_t *)addv, 84: 312: *mrg = modperl_config_srv_new(p); -: 313: 84: 314: MP_TRACE_d(MP_FUNC, "basev==0x%lx, addv==0x%lx\n", -: 315: (unsigned long)basev, (unsigned long)addv); -: 316: 84: 317: merge_item(modules); 84: 318: merge_item(PerlModule); 84: 319: merge_item(PerlRequire); -: 320: 84: 321: merge_table_overlap_item(SetEnv); 84: 322: merge_table_overlap_item(PassEnv); -: 323: -: 324: /* this is where we merge PerlSetVar and PerlAddVar together */ 84: 325: mrg->configvars = merge_table_config_vars(p, -: 326: base->configvars, -: 327: add->setvars, add->addvars); -: 328: -: 329: /* note we don't care about merging dcfg->setvars or dcfg->addvars -: 330: * specifically - what is important to merge is dfcg->configvars. -: 331: * but we need to keep track of the entries for this config, so -: 332: * the merged values are simply the values for the add (current) -: 333: * configuration. -: 334: */ 84: 335: mrg->setvars = add->setvars; 84: 336: mrg->addvars = add->addvars; -: 337: 84: 338: merge_item(threaded_mpm); 84: 339: merge_item(server); -: 340: -: 341:#ifdef USE_ITHREADS 84: 342: merge_item(interp_pool_cfg); 84: 343: merge_item(interp_scope); -: 344:#else -: 345: merge_item(perl); -: 346:#endif -: 347: 84: 348: if (add->argv->nelts == 2 && #####: 349: strEQ(((char **)add->argv->elts)[1], "+inherit")) -: 350: { -: 351: /* only inherit base PerlSwitches if explicitly told to */ #####: 352: mrg->argv = base->argv; -: 353: } -: 354: else { 84: 355: mrg->argv = add->argv; -: 356: } -: 357: 84: 358: mrg->flags = modperl_options_merge(p, base->flags, add->flags); -: 359: -: 360: /* XXX: check if Perl*Handler is disabled */ 336: 361: for (i=0; i < MP_HANDLER_NUM_PER_SRV; i++) { 252: 362: merge_handlers(MpSrvMERGE_HANDLERS, handlers_per_srv[i]); -: 363: } 252: 364: for (i=0; i < MP_HANDLER_NUM_FILES; i++) { 168: 365: merge_handlers(MpSrvMERGE_HANDLERS, handlers_files[i]); -: 366: } 252: 367: for (i=0; i < MP_HANDLER_NUM_PROCESS; i++) { 168: 368: merge_handlers(MpSrvMERGE_HANDLERS, handlers_process[i]); -: 369: } 168: 370: for (i=0; i < MP_HANDLER_NUM_PRE_CONNECTION; i++) { 84: 371: merge_handlers(MpSrvMERGE_HANDLERS, handlers_pre_connection[i]); -: 372: } 168: 373: for (i=0; i < MP_HANDLER_NUM_CONNECTION; i++) { 84: 374: merge_handlers(MpSrvMERGE_HANDLERS, handlers_connection[i]); -: 375: } -: 376: 84: 377: if (modperl_is_running()) { 84: 378: if (modperl_init_vhost(mrg->server, p, NULL) != OK) { #####: 379: exit(1); /*XXX*/ -: 380: } -: 381: } -: 382: -: 383:#ifdef USE_ITHREADS 84: 384: merge_item(mip); -: 385:#endif -: 386: 84: 387: return mrg; -: 388:} -: 389: -: 390:/* any per-request cleanup goes here */ -: 391: -: 392:apr_status_t modperl_config_request_cleanup(pTHX_ request_rec *r) 447: 393:{ 447: 394: apr_status_t retval; 447: 395: MP_dRCFG; -: 396: 447: 397: retval = modperl_callback_per_dir(MP_CLEANUP_HANDLER, r, MP_HOOK_RUN_ALL); -: 398: 447: 399: if (rcfg->pnotes) { 3: 400: SvREFCNT_dec(rcfg->pnotes); 3: 401: rcfg->pnotes = Nullhv; -: 402: } -: 403: -: 404: /* undo changes to %ENV caused by +SetupEnv, perl-script, or -: 405: * $r->subprocess_env, so the values won't persist */ 447: 406: if (MpReqSETUP_ENV(rcfg)) { 153: 407: modperl_env_request_unpopulate(aTHX_ r); -: 408: } -: 409: 447: 410: return retval; -: 411:} -: 412: -: 413:apr_status_t modperl_config_req_cleanup(void *data) 447: 414:{ 447: 415: request_rec *r = (request_rec *)data; 447: 416: MP_dTHX; -: 417: 447: 418: return modperl_config_request_cleanup(aTHX_ r); -: 419:} -: 420: -: 421:void *modperl_get_perl_module_config(ap_conf_vector_t *cv) #####: 422:{ #####: 423: return ap_get_module_config(cv, &perl_module); -: 424:} -: 425: -: 426:void modperl_set_perl_module_config(ap_conf_vector_t *cv, void *cfg) #####: 427:{ #####: 428: ap_set_module_config(cv, &perl_module, cfg); -: 429:} -: 430: -: 431:int modperl_config_apply_PerlModule(server_rec *s, -: 432: modperl_config_srv_t *scfg, -: 433: PerlInterpreter *perl, apr_pool_t *p) 92: 434:{ 92: 435: char **entries; 92: 436: int i; 92: 437: dTHXa(perl); -: 438: 92: 439: entries = (char **)scfg->PerlModule->elts; 316: 440: for (i = 0; i < scfg->PerlModule->nelts; i++){ 224: 441: if (modperl_require_module(aTHX_ entries[i], TRUE)){ 224: 442: MP_TRACE_d(MP_FUNC, "loaded Perl module %s for server %s\n", -: 443: entries[i], modperl_server_desc(s,p)); -: 444: } -: 445: else { #####: 446: ap_log_error(APLOG_MARK, APLOG_ERR, 0, s, -: 447: "Can't load Perl module %s for server %s, exiting...", -: 448: entries[i], modperl_server_desc(s,p)); #####: 449: return FALSE; -: 450: } -: 451: } -: 452: 92: 453: return TRUE; -: 454:} -: 455: -: 456:int modperl_config_apply_PerlRequire(server_rec *s, -: 457: modperl_config_srv_t *scfg, -: 458: PerlInterpreter *perl, apr_pool_t *p) 92: 459:{ 92: 460: char **entries; 92: 461: int i; 92: 462: dTHXa(perl); -: 463: 92: 464: entries = (char **)scfg->PerlRequire->elts; 128: 465: for (i = 0; i < scfg->PerlRequire->nelts; i++){ 36: 466: if (modperl_require_file(aTHX_ entries[i], TRUE)){ 36: 467: MP_TRACE_d(MP_FUNC, "loaded Perl file: %s for server %s\n", -: 468: entries[i], modperl_server_desc(s,p)); -: 469: } -: 470: else { #####: 471: ap_log_error(APLOG_MARK, APLOG_ERR, 0, s, -: 472: "Can't load Perl file: %s for server %s, exiting...", -: 473: entries[i], modperl_server_desc(s,p)); #####: 474: return FALSE; -: 475: } -: 476: } -: 477: 92: 478: return TRUE; -: 479:} -: 480: -: 481:typedef struct { -: 482: AV *av; -: 483: I32 ix; -: 484: PerlInterpreter *perl; -: 485:} svav_param_t; -: 486: -: 487:static void *svav_getstr(void *buf, size_t bufsiz, void *param) 228: 488:{ 228: 489: svav_param_t *svav_param = (svav_param_t *)param; 228: 490: dTHXa(svav_param->perl); 228: 491: AV *av = svav_param->av; 228: 492: SV *sv; 228: 493: STRLEN n_a; -: 494: 228: 495: if (svav_param->ix > AvFILL(av)) { 62: 496: return NULL; -: 497: } -: 498: 166: 499: sv = AvARRAY(av)[svav_param->ix++]; 166: 500: SvPV_force(sv, n_a); -: 501: 166: 502: apr_cpystrn(buf, SvPVX(sv), bufsiz); -: 503: 166: 504: return buf; -: 505:} -: 506: -: 507:const char *modperl_config_insert(pTHX_ server_rec *s, -: 508: apr_pool_t *p, -: 509: apr_pool_t *ptmp, -: 510: int override, -: 511: char *path, -: 512: ap_conf_vector_t *conf, -: 513: SV *lines) 62: 514:{ 62: 515: const char *errmsg; 62: 516: cmd_parms parms; 62: 517: svav_param_t svav_parms; 62: 518: ap_directive_t *conftree = NULL; -: 519: 62: 520: memset(&parms, '\0', sizeof(parms)); -: 521: 62: 522: parms.limited = -1; 62: 523: parms.server = s; 62: 524: parms.override = override; 62: 525: parms.path = path; 62: 526: parms.pool = p; -: 527: 62: 528: if (ptmp) { 13: 529: parms.temp_pool = ptmp; -: 530: } -: 531: else { 49: 532: apr_pool_create(&parms.temp_pool, p); -: 533: } -: 534: 62: 535: if (!(SvROK(lines) && (SvTYPE(SvRV(lines)) == SVt_PVAV))) { #####: 536: return "not an array reference"; -: 537: } -: 538: 62: 539: svav_parms.av = (AV*)SvRV(lines); 62: 540: svav_parms.ix = 0; -: 541:#ifdef USE_ITHREADS 62: 542: svav_parms.perl = aTHX; -: 543:#endif -: 544: 62: 545: parms.config_file = ap_pcfg_open_custom(p, "mod_perl", -: 546: &svav_parms, NULL, -: 547: svav_getstr, NULL); -: 548: 62: 549: errmsg = ap_build_config(&parms, p, parms.temp_pool, &conftree); -: 550: 62: 551: if (!errmsg) { 62: 552: errmsg = ap_walk_config(conftree, &parms, conf); -: 553: } -: 554: 62: 555: ap_cfg_closefile(parms.config_file); -: 556: 62: 557: if (ptmp != parms.temp_pool) { 49: 558: apr_pool_destroy(parms.temp_pool); -: 559: } -: 560: 62: 561: return errmsg; -: 562:} -: 563: -: 564:const char *modperl_config_insert_server(pTHX_ server_rec *s, SV *lines) 49: 565:{ 49: 566: int override = (RSRC_CONF | OR_ALL) & ~(OR_AUTHCFG | OR_LIMIT); 49: 567: apr_pool_t *p = s->process->pconf; -: 568: 49: 569: return modperl_config_insert(aTHX_ s, p, NULL, override, NULL, -: 570: s->lookup_defaults, lines); -: 571:} -: 572: -: 573:const char *modperl_config_insert_request(pTHX_ -: 574: request_rec *r, -: 575: SV *lines, -: 576: char *path, -: 577: int override) 13: 578:{ 13: 579: const char *errmsg; 13: 580: ap_conf_vector_t *dconf = ap_create_per_dir_config(r->pool); -: 581: 13: 582: errmsg = modperl_config_insert(aTHX_ -: 583: r->server, r->pool, r->pool, -: 584: override, path, -: 585: dconf, lines); -: 586: 13: 587: if (errmsg) { #####: 588: return errmsg; -: 589: } -: 590: 13: 591: r->per_dir_config = -: 592: ap_merge_per_dir_configs(r->pool, -: 593: r->per_dir_config, -: 594: dconf); -: 595: 13: 596: return NULL; -: 597:} -: 598: -: 599: -: 600:/* if r!=NULL check for dir PerlOptions, otherwise check for server -: 601: * PerlOptions, (s must be always set) -: 602: */ -: 603:int modperl_config_is_perl_option_enabled(pTHX_ request_rec *r, -: 604: server_rec *s, const char *name) 13: 605:{ 13: 606: U32 flag; 13: 607: MP_dSCFG(s); -: 608: -: 609: /* XXX: should we test whether perl is disabled for this server? */ -: 610: /* if (!MpSrvENABLE(scfg)) { */ -: 611: /* return 0; */ -: 612: /* } */ -: 613: 13: 614: if (r) { 4: 615: if ((flag = modperl_flags_lookup_dir(name))) { 4: 616: MP_dDCFG; 4: 617: return MpDirFLAGS(dcfg) & flag ? 1 : 0; -: 618: } -: 619: else { #####: 620: Perl_croak(aTHX_ "PerlOptions %s is not a directory option", name); -: 621: } -: 622: } -: 623: else { 9: 624: if ((flag = modperl_flags_lookup_srv(name))) { 9: 625: return MpSrvFLAGS(scfg) & flag ? 1 : 0; -: 626: } -: 627: else { #####: 628: Perl_croak(aTHX_ "PerlOptions %s is not a server option", name); -: 629: } -: 630: } -: 631: -: 632:}