1 /* Licensed to the Apache Software Foundation (ASF) under one or more
2 * contributor license agreements. See the NOTICE file distributed with
3 * this work for additional information regarding copyright ownership.
4 * The ASF licenses this file to You under the Apache License, Version 2.0
5 * (the "License"); you may not use this file except in compliance with
6 * the License. You may obtain a copy of the License at
7 *
8 * http://www.apache.org/licenses/LICENSE-2.0
9 *
10 * Unless required by applicable law or agreed to in writing, software
11 * distributed under the License is distributed on an "AS IS" BASIS,
12 * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
13 * See the License for the specific language governing permissions and
14 * limitations under the License.
15 */
16
17 #include "mod_perl.h"
18
modperl_config_dir_create(apr_pool_t * p,char * dir)19 void *modperl_config_dir_create(apr_pool_t *p, char *dir)
20 {
21 modperl_config_dir_t *dcfg = modperl_config_dir_new(p);
22
23 dcfg->location = dir;
24
25 MP_TRACE_d(MP_FUNC, "dir %s", dir);
26
27 return dcfg;
28 }
29
30 #define merge_item(item) \
31 mrg->item = add->item ? add->item : base->item
32
modperl_table_overlap(apr_pool_t * p,apr_table_t * base,apr_table_t * add)33 static apr_table_t *modperl_table_overlap(apr_pool_t *p,
34 apr_table_t *base,
35 apr_table_t *add)
36 {
37 /* take the base (parent) values, and override with add (child) values,
38 * generating a new table. entries in add but not in base will be
39 * added to the new table. all using core apr table routines.
40 *
41 * note that this is equivalent to apr_table_overlap except a new
42 * table is generated, which is required (otherwise we would clobber
43 * the existing parent or child configurations)
44 *
45 * note that this is *not* equivalent to apr_table_overlap, although
46 * I think it should be, because apr_table_overlap seems to clear
47 * its first argument when the tables have different pools. I think
48 * this is wrong -- rici
49 */
50 apr_table_t *merge = apr_table_overlay(p, base, add);
51
52 /* compress will squash each key to the last value in the table. this
53 * is acceptable for all tables that expect only a single value per key
54 * such as PerlPassEnv and PerlSetEnv. PerlSetVar/PerlAddVar get their
55 * own, non-standard, merge routines in merge_table_config_vars.
56 */
57 apr_table_compress(merge, APR_OVERLAP_TABLES_SET);
58
59 return merge;
60 }
61
62 #define merge_table_overlap_item(item) \
63 mrg->item = modperl_table_overlap(p, base->item, add->item)
64
merge_config_add_vars(apr_pool_t * p,const apr_table_t * base,const apr_table_t * unset,const apr_table_t * add)65 static apr_table_t *merge_config_add_vars(apr_pool_t *p,
66 const apr_table_t *base,
67 const apr_table_t *unset,
68 const apr_table_t *add)
69 {
70 apr_table_t *temp = apr_table_copy(p, base);
71
72 const apr_array_header_t *arr;
73 apr_table_entry_t *entries;
74 int i;
75
76 /* for each key in unset do apr_table_unset(temp, key); */
77 arr = apr_table_elts(unset);
78 entries = (apr_table_entry_t *)arr->elts;
79
80 /* hopefully this is faster than using apr_table_do */
81 for (i = 0; i < arr->nelts; i++) {
82 if (entries[i].key) {
83 apr_table_unset(temp, entries[i].key);
84 }
85 }
86
87 return apr_table_overlay(p, temp, add);
88 }
89
90 #define merge_handlers(merge_flag, array) \
91 if (merge_flag(mrg)) { \
92 mrg->array = modperl_handler_array_merge(p, \
93 base->array, \
94 add->array); \
95 } \
96 else { \
97 merge_item(array); \
98 }
99
modperl_config_dir_merge(apr_pool_t * p,void * basev,void * addv)100 void *modperl_config_dir_merge(apr_pool_t *p, void *basev, void *addv)
101 {
102 int i;
103 modperl_config_dir_t
104 *base = (modperl_config_dir_t *)basev,
105 *add = (modperl_config_dir_t *)addv,
106 *mrg = modperl_config_dir_new(p);
107
108 MP_TRACE_d(MP_FUNC, "basev==0x%lx, addv==0x%lx, mrg==0x%lx",
109 (unsigned long)basev, (unsigned long)addv,
110 (unsigned long)mrg);
111
112 mrg->flags = modperl_options_merge(p, base->flags, add->flags);
113
114 merge_item(location);
115
116 merge_table_overlap_item(SetEnv);
117
118 /* this is where we merge PerlSetVar and PerlAddVar together */
119 mrg->configvars = merge_config_add_vars(p,
120 base->configvars,
121 add->setvars, add->configvars);
122 merge_table_overlap_item(setvars);
123
124 /* XXX: check if Perl*Handler is disabled */
125 for (i=0; i < MP_HANDLER_NUM_PER_DIR; i++) {
126 merge_handlers(MpDirMERGE_HANDLERS, handlers_per_dir[i]);
127 }
128
129 return mrg;
130 }
131
modperl_config_req_new(request_rec * r)132 modperl_config_req_t *modperl_config_req_new(request_rec *r)
133 {
134 modperl_config_req_t *rcfg =
135 (modperl_config_req_t *)apr_pcalloc(r->pool, sizeof(*rcfg));
136
137 MP_TRACE_d(MP_FUNC, "0x%lx", (unsigned long)rcfg);
138
139 return rcfg;
140 }
141
modperl_config_con_new(conn_rec * c)142 modperl_config_con_t *modperl_config_con_new(conn_rec *c)
143 {
144 modperl_config_con_t *ccfg =
145 (modperl_config_con_t *)apr_pcalloc(c->pool, sizeof(*ccfg));
146
147 MP_TRACE_d(MP_FUNC, "0x%lx", (unsigned long)ccfg);
148
149 return ccfg;
150 }
151
modperl_config_srv_new(apr_pool_t * p,server_rec * s)152 modperl_config_srv_t *modperl_config_srv_new(apr_pool_t *p, server_rec *s)
153 {
154 modperl_config_srv_t *scfg = (modperl_config_srv_t *)
155 apr_pcalloc(p, sizeof(*scfg));
156
157 scfg->flags = modperl_options_new(p, MpSrvType);
158 MpSrvENABLE_On(scfg); /* mod_perl enabled by default */
159 MpSrvHOOKS_ALL_On(scfg); /* all hooks enabled by default */
160
161 scfg->PerlModule = apr_array_make(p, 2, sizeof(char *));
162 scfg->PerlRequire = apr_array_make(p, 2, sizeof(char *));
163 scfg->PerlPostConfigRequire =
164 apr_array_make(p, 1, sizeof(modperl_require_file_t *));
165
166 scfg->argv = apr_array_make(p, 2, sizeof(char *));
167
168 scfg->setvars = apr_table_make(p, 2);
169 scfg->configvars = apr_table_make(p, 2);
170
171 scfg->PassEnv = apr_table_make(p, 2);
172 scfg->SetEnv = apr_table_make(p, 2);
173
174 #ifdef MP_USE_GTOP
175 scfg->gtop = modperl_gtop_new(p);
176 #endif
177
178 /* make sure httpd's argv[0] is the first argument so $0 is
179 * correctly connected to the real thing */
180 modperl_config_srv_argv_push(s->process->argv[0]);
181
182 MP_TRACE_d(MP_FUNC, "new scfg: 0x%lx", (unsigned long)scfg);
183
184 return scfg;
185 }
186
modperl_config_dir_new(apr_pool_t * p)187 modperl_config_dir_t *modperl_config_dir_new(apr_pool_t *p)
188 {
189 modperl_config_dir_t *dcfg = (modperl_config_dir_t *)
190 apr_pcalloc(p, sizeof(modperl_config_dir_t));
191
192 dcfg->flags = modperl_options_new(p, MpDirType);
193
194 dcfg->setvars = apr_table_make(p, 2);
195 dcfg->configvars = apr_table_make(p, 2);
196
197 dcfg->SetEnv = apr_table_make(p, 2);
198
199 MP_TRACE_d(MP_FUNC, "new dcfg: 0x%lx", (unsigned long)dcfg);
200
201 return dcfg;
202 }
203
204 #ifdef MP_TRACE
dump_argv(modperl_config_srv_t * scfg)205 static void dump_argv(modperl_config_srv_t *scfg)
206 {
207 int i;
208 char **argv = (char **)scfg->argv->elts;
209 modperl_trace(NULL, "modperl_config_srv_argv_init =>");
210 for (i=0; i<scfg->argv->nelts; i++) {
211 modperl_trace(NULL, " %d = %s", i, argv[i]);
212 }
213 }
214 #endif
215
modperl_config_srv_argv_init(modperl_config_srv_t * scfg,int * argc)216 char **modperl_config_srv_argv_init(modperl_config_srv_t *scfg, int *argc)
217 {
218 modperl_config_srv_argv_push("-e;0");
219
220 *argc = scfg->argv->nelts;
221
222 MP_TRACE_g_do(dump_argv(scfg));
223
224 return (char **)scfg->argv->elts;
225 }
226
modperl_config_srv_create(apr_pool_t * p,server_rec * s)227 void *modperl_config_srv_create(apr_pool_t *p, server_rec *s)
228 {
229 modperl_config_srv_t *scfg = modperl_config_srv_new(p, s);
230
231 if (!s->is_virtual) {
232
233 /* give a chance to MOD_PERL_TRACE env var to set
234 * PerlTrace. This place is the earliest point in mod_perl
235 * configuration parsing, when we have the server object
236 */
237 modperl_trace_level_set_apache(s, NULL);
238
239 /* Must store the global server record as early as possible,
240 * because if mod_perl happens to be started from within a
241 * vhost (e.g., PerlLoadModule) the base server record won't
242 * be available to vhost and things will blow up
243 */
244 modperl_init_globals(s, p);
245 }
246
247 MP_TRACE_d(MP_FUNC, "p=0x%lx, s=0x%lx, virtual=%d",
248 p, s, s->is_virtual);
249
250 #ifdef USE_ITHREADS
251
252 scfg->interp_pool_cfg =
253 (modperl_tipool_config_t *)
254 apr_pcalloc(p, sizeof(*scfg->interp_pool_cfg));
255
256 /* XXX: determine reasonable defaults */
257 scfg->interp_pool_cfg->start = 3;
258 scfg->interp_pool_cfg->max_spare = 3;
259 scfg->interp_pool_cfg->min_spare = 3;
260 scfg->interp_pool_cfg->max = 5;
261 scfg->interp_pool_cfg->max_requests = 2000;
262 #endif /* USE_ITHREADS */
263
264 scfg->server = s;
265
266 return scfg;
267 }
268
269 /* XXX: this is not complete */
modperl_config_srv_merge(apr_pool_t * p,void * basev,void * addv)270 void *modperl_config_srv_merge(apr_pool_t *p, void *basev, void *addv)
271 {
272 int i;
273 modperl_config_srv_t
274 *base = (modperl_config_srv_t *)basev,
275 *add = (modperl_config_srv_t *)addv,
276 *mrg = modperl_config_srv_new(p, add->server);
277
278 MP_TRACE_d(MP_FUNC, "basev==0x%lx, addv==0x%lx, mrg==0x%lx",
279 (unsigned long)basev, (unsigned long)addv,
280 (unsigned long)mrg);
281
282 merge_item(modules);
283 merge_item(PerlModule);
284 merge_item(PerlRequire);
285 merge_item(PerlPostConfigRequire);
286
287 merge_table_overlap_item(SetEnv);
288 merge_table_overlap_item(PassEnv);
289
290 /* this is where we merge PerlSetVar and PerlAddVar together */
291 mrg->configvars = merge_config_add_vars(p,
292 base->configvars,
293 add->setvars, add->configvars);
294 merge_table_overlap_item(setvars);
295
296 merge_item(server);
297
298 #ifdef USE_ITHREADS
299 merge_item(interp_pool_cfg);
300 #else
301 merge_item(perl);
302 #endif
303
304 if (MpSrvINHERIT_SWITCHES(add)) {
305 /* only inherit base PerlSwitches if explicitly told to */
306 mrg->argv = base->argv;
307 }
308 else {
309 mrg->argv = add->argv;
310 }
311
312 mrg->flags = modperl_options_merge(p, base->flags, add->flags);
313
314 /* XXX: check if Perl*Handler is disabled */
315 for (i=0; i < MP_HANDLER_NUM_PER_SRV; i++) {
316 merge_handlers(MpSrvMERGE_HANDLERS, handlers_per_srv[i]);
317 }
318 for (i=0; i < MP_HANDLER_NUM_FILES; i++) {
319 merge_handlers(MpSrvMERGE_HANDLERS, handlers_files[i]);
320 }
321 for (i=0; i < MP_HANDLER_NUM_PROCESS; i++) {
322 merge_handlers(MpSrvMERGE_HANDLERS, handlers_process[i]);
323 }
324 for (i=0; i < MP_HANDLER_NUM_PRE_CONNECTION; i++) {
325 merge_handlers(MpSrvMERGE_HANDLERS, handlers_pre_connection[i]);
326 }
327 for (i=0; i < MP_HANDLER_NUM_CONNECTION; i++) {
328 merge_handlers(MpSrvMERGE_HANDLERS, handlers_connection[i]);
329 }
330
331 if (modperl_is_running()) {
332 if (modperl_init_vhost(mrg->server, p, NULL) != OK) {
333 exit(1); /*XXX*/
334 }
335 }
336
337 #ifdef USE_ITHREADS
338 merge_item(mip);
339 #endif
340
341 return mrg;
342 }
343
344 /* any per-request cleanup goes here */
345
modperl_config_request_cleanup(pTHX_ request_rec * r)346 apr_status_t modperl_config_request_cleanup(pTHX_ request_rec *r)
347 {
348 apr_status_t retval;
349 MP_dRCFG;
350
351 retval = modperl_callback_per_dir(MP_CLEANUP_HANDLER, r, MP_HOOK_RUN_ALL);
352
353 /* undo changes to %ENV caused by +SetupEnv, perl-script, or
354 * $r->subprocess_env, so the values won't persist */
355 if (MpReqSETUP_ENV(rcfg)) {
356 modperl_env_request_unpopulate(aTHX_ r);
357 }
358
359 return retval;
360 }
361
modperl_config_req_cleanup(void * data)362 apr_status_t modperl_config_req_cleanup(void *data)
363 {
364 request_rec *r = (request_rec *)data;
365 apr_status_t rc;
366 MP_dINTERPa(r, NULL, NULL);
367
368 rc = modperl_config_request_cleanup(aTHX_ r);
369
370 MP_INTERP_PUTBACK(interp, aTHX);
371
372 return rc;
373 }
374
modperl_get_perl_module_config(ap_conf_vector_t * cv)375 void *modperl_get_perl_module_config(ap_conf_vector_t *cv)
376 {
377 return ap_get_module_config(cv, &perl_module);
378 }
379
modperl_set_perl_module_config(ap_conf_vector_t * cv,void * cfg)380 void modperl_set_perl_module_config(ap_conf_vector_t *cv, void *cfg)
381 {
382 ap_set_module_config(cv, &perl_module, cfg);
383 }
384
modperl_config_apply_PerlModule(server_rec * s,modperl_config_srv_t * scfg,PerlInterpreter * perl,apr_pool_t * p)385 int modperl_config_apply_PerlModule(server_rec *s,
386 modperl_config_srv_t *scfg,
387 PerlInterpreter *perl, apr_pool_t *p)
388 {
389 char **entries;
390 int i;
391 dTHXa(perl);
392
393 entries = (char **)scfg->PerlModule->elts;
394 for (i = 0; i < scfg->PerlModule->nelts; i++){
395 if (modperl_require_module(aTHX_ entries[i], TRUE)){
396 MP_TRACE_d(MP_FUNC, "loaded Perl module %s for server %s",
397 entries[i], modperl_server_desc(s,p));
398 }
399 else {
400 ap_log_error(APLOG_MARK, APLOG_ERR, 0, s,
401 "Can't load Perl module %s for server %s, exiting...",
402 entries[i], modperl_server_desc(s,p));
403 return FALSE;
404 }
405 }
406
407 return TRUE;
408 }
409
modperl_config_apply_PerlRequire(server_rec * s,modperl_config_srv_t * scfg,PerlInterpreter * perl,apr_pool_t * p)410 int modperl_config_apply_PerlRequire(server_rec *s,
411 modperl_config_srv_t *scfg,
412 PerlInterpreter *perl, apr_pool_t *p)
413 {
414 char **entries;
415 int i;
416 dTHXa(perl);
417
418 entries = (char **)scfg->PerlRequire->elts;
419 for (i = 0; i < scfg->PerlRequire->nelts; i++){
420 if (modperl_require_file(aTHX_ entries[i], TRUE)){
421 MP_TRACE_d(MP_FUNC, "loaded Perl file: %s for server %s",
422 entries[i], modperl_server_desc(s,p));
423 }
424 else {
425 ap_log_error(APLOG_MARK, APLOG_ERR, 0, s,
426 "Can't load Perl file: %s for server %s, exiting...",
427 entries[i], modperl_server_desc(s,p));
428 return FALSE;
429 }
430 }
431
432 return TRUE;
433 }
434
modperl_config_apply_PerlPostConfigRequire(server_rec * s,modperl_config_srv_t * scfg,apr_pool_t * p)435 int modperl_config_apply_PerlPostConfigRequire(server_rec *s,
436 modperl_config_srv_t *scfg,
437 apr_pool_t *p)
438 {
439 modperl_require_file_t **requires;
440 int i;
441 MP_PERL_CONTEXT_DECLARE;
442
443 requires = (modperl_require_file_t **)scfg->PerlPostConfigRequire->elts;
444 for (i = 0; i < scfg->PerlPostConfigRequire->nelts; i++){
445 int retval;
446
447 MP_PERL_CONTEXT_STORE_OVERRIDE(scfg->mip->parent->perl);
448 retval = modperl_require_file(aTHX_ requires[i]->file, TRUE);
449 modperl_env_sync_srv_env_hash2table(aTHX_ p, scfg);
450 modperl_env_sync_dir_env_hash2table(aTHX_ p, requires[i]->dcfg);
451 MP_PERL_CONTEXT_RESTORE;
452
453 if (retval) {
454 MP_TRACE_d(MP_FUNC, "loaded Perl file: %s for server %s",
455 requires[i]->file, modperl_server_desc(s, p));
456 }
457 else {
458 ap_log_error(APLOG_MARK, APLOG_ERR, 0, s,
459 "Can't load Perl file: %s for server %s, exiting...",
460 requires[i]->file, modperl_server_desc(s, p));
461
462 return FALSE;
463 }
464 }
465
466 return TRUE;
467 }
468
469 typedef struct {
470 AV *av;
471 I32 ix;
472 PerlInterpreter *perl;
473 } svav_param_t;
474
475 static
476 #if AP_MODULE_MAGIC_AT_LEAST(20110329,0)
477 apr_status_t
478 #else
479 void *
480 #endif
svav_getstr(void * buf,size_t bufsiz,void * param)481 svav_getstr(void *buf, size_t bufsiz, void *param)
482 {
483 svav_param_t *svav_param = (svav_param_t *)param;
484 dTHXa(svav_param->perl);
485 AV *av = svav_param->av;
486 SV *sv;
487 STRLEN n_a;
488
489 if (svav_param->ix > AvFILL(av)) {
490 #if AP_MODULE_MAGIC_AT_LEAST(20110329,0)
491 return APR_EOF;
492 #else
493 return NULL;
494 #endif
495 }
496
497 sv = AvARRAY(av)[svav_param->ix++];
498 SvPV_force(sv, n_a);
499
500 apr_cpystrn(buf, SvPVX(sv), bufsiz);
501
502 #if AP_MODULE_MAGIC_AT_LEAST(20110329,0)
503 return APR_SUCCESS;
504 #else
505 return buf;
506 #endif
507 }
508
modperl_config_insert(pTHX_ server_rec * s,apr_pool_t * p,apr_pool_t * ptmp,int override,char * path,int override_options,ap_conf_vector_t * conf,SV * lines)509 const char *modperl_config_insert(pTHX_ server_rec *s,
510 apr_pool_t *p,
511 apr_pool_t *ptmp,
512 int override,
513 char *path,
514 int override_options,
515 ap_conf_vector_t *conf,
516 SV *lines)
517 {
518 const char *errmsg;
519 cmd_parms parms;
520 svav_param_t svav_parms;
521 ap_directive_t *conftree = NULL;
522
523 memset(&parms, '\0', sizeof(parms));
524
525 parms.limited = -1;
526 parms.server = s;
527 parms.override = override;
528 parms.path = apr_pstrdup(p, path);
529 parms.pool = p;
530 #ifdef MP_HTTPD_HAS_OVERRIDE_OPTS
531 if (override_options == MP_HTTPD_OVERRIDE_OPTS_UNSET) {
532 parms.override_opts = MP_HTTPD_OVERRIDE_OPTS_DEFAULT;
533 }
534 else {
535 parms.override_opts = override_options;
536 }
537 #endif
538
539 if (ptmp) {
540 parms.temp_pool = ptmp;
541 }
542 else {
543 apr_pool_create(&parms.temp_pool, p);
544 }
545
546 if (!(SvROK(lines) && (SvTYPE(SvRV(lines)) == SVt_PVAV))) {
547 return "not an array reference";
548 }
549
550 svav_parms.av = (AV*)SvRV(lines);
551 svav_parms.ix = 0;
552 #ifdef USE_ITHREADS
553 svav_parms.perl = aTHX;
554 #endif
555
556 parms.config_file = ap_pcfg_open_custom(p, "mod_perl",
557 &svav_parms, NULL,
558 svav_getstr, NULL);
559
560 errmsg = ap_build_config(&parms, p, parms.temp_pool, &conftree);
561
562 if (!errmsg) {
563 errmsg = ap_walk_config(conftree, &parms, conf);
564 }
565
566 ap_cfg_closefile(parms.config_file);
567
568 if (ptmp != parms.temp_pool) {
569 apr_pool_destroy(parms.temp_pool);
570 }
571
572 return errmsg;
573 }
574
modperl_config_insert_parms(pTHX_ cmd_parms * parms,SV * lines)575 const char *modperl_config_insert_parms(pTHX_ cmd_parms *parms,
576 SV *lines)
577 {
578 return modperl_config_insert(aTHX_
579 parms->server,
580 parms->pool,
581 parms->temp_pool,
582 parms->override,
583 parms->path,
584 #ifdef MP_HTTPD_HAS_OVERRIDE_OPTS
585 parms->override_opts,
586 #else
587 MP_HTTPD_OVERRIDE_OPTS_UNSET,
588 #endif
589 parms->context,
590 lines);
591 }
592
593
modperl_config_insert_server(pTHX_ server_rec * s,SV * lines)594 const char *modperl_config_insert_server(pTHX_ server_rec *s, SV *lines)
595 {
596 int override = (RSRC_CONF | OR_ALL) & ~(OR_AUTHCFG | OR_LIMIT);
597 apr_pool_t *p = s->process->pconf;
598
599 return modperl_config_insert(aTHX_ s, p, NULL, override, NULL,
600 MP_HTTPD_OVERRIDE_OPTS_UNSET,
601 s->lookup_defaults, lines);
602 }
603
modperl_config_insert_request(pTHX_ request_rec * r,SV * lines,int override,char * path,int override_options)604 const char *modperl_config_insert_request(pTHX_
605 request_rec *r,
606 SV *lines,
607 int override,
608 char *path,
609 int override_options)
610 {
611 const char *errmsg;
612 ap_conf_vector_t *dconf = ap_create_per_dir_config(r->pool);
613
614 if (!path) {
615 /* pass a non-NULL path if nothing else given and for compatibility */
616 path = "/";
617 }
618
619 errmsg = modperl_config_insert(aTHX_
620 r->server, r->pool, r->pool,
621 override, path, override_options,
622 dconf, lines);
623
624 if (errmsg) {
625 return errmsg;
626 }
627
628 r->per_dir_config =
629 ap_merge_per_dir_configs(r->pool,
630 r->per_dir_config,
631 dconf);
632
633 return NULL;
634 }
635
636
637 /* if r!=NULL check for dir PerlOptions, otherwise check for server
638 * PerlOptions, (s must be always set)
639 */
modperl_config_is_perl_option_enabled(pTHX_ request_rec * r,server_rec * s,const char * name)640 int modperl_config_is_perl_option_enabled(pTHX_ request_rec *r,
641 server_rec *s, const char *name)
642 {
643 U32 flag;
644
645 /* XXX: should we test whether perl is disabled for this server? */
646 /* if (!MpSrvENABLE(scfg)) { */
647 /* return 0; */
648 /* } */
649
650 if (r) {
651 if ((flag = modperl_flags_lookup_dir(name)) != -1) {
652 MP_dDCFG;
653 return MpDirFLAGS(dcfg) & flag ? 1 : 0;
654 }
655 else {
656 Perl_croak(aTHX_ "PerlOptions %s is not a directory option", name);
657 }
658 }
659 else {
660 if ((flag = modperl_flags_lookup_srv(name)) != -1) {
661 MP_dSCFG(s);
662 return MpSrvFLAGS(scfg) & flag ? 1 : 0;
663 }
664 else {
665 Perl_croak(aTHX_ "PerlOptions %s is not a server option", name);
666 }
667 }
668
669 }
670
671 /*
672 * Local Variables:
673 * c-basic-offset: 4
674 * indent-tabs-mode: nil
675 * End:
676 */
677