-:    0:Source:modperl_interp.c
        -:    0:Object:modperl_interp.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:/*
        -:   19: * XXX: this is not the most efficent interpreter pool implementation
        -:   20: * but it will do for proof-of-concept
        -:   21: */
        -:   22:
        -:   23:#ifdef USE_ITHREADS
        -:   24:
        -:   25:static const char *MP_interp_scope_desc[] = {
        -:   26:    "undef", "handler", "subrequest", "request", "connection",
        -:   27:};
        -:   28:
        -:   29:const char *modperl_interp_scope_desc(modperl_interp_scope_e scope)
    #####:   30:{
    #####:   31:    return MP_interp_scope_desc[scope];
        -:   32:}
        -:   33:
        -:   34:void modperl_interp_clone_init(modperl_interp_t *interp)
    #####:   35:{
    #####:   36:    dTHXa(interp->perl);
        -:   37:
    #####:   38:    MpInterpCLONED_On(interp);
        -:   39:
    #####:   40:    PERL_SET_CONTEXT(aTHX);
        -:   41:
        -:   42:    /* XXX: hack for bug fixed in 5.6.1 */
    #####:   43:    if (PL_scopestack_ix == 0) {
    #####:   44:        ENTER;
        -:   45:    }
        -:   46:
        -:   47:    /* clear @DynaLoader::dl_librefs so we only dlclose() those
        -:   48:     * which are opened by the clone
        -:   49:     */
    #####:   50:    modperl_xs_dl_handles_clear(aTHX);
        -:   51:}
        -:   52:
        -:   53:modperl_interp_t *modperl_interp_new(modperl_interp_pool_t *mip,
        -:   54:                                     PerlInterpreter *perl)
       20:   55:{
       20:   56:    UV clone_flags = CLONEf_KEEP_PTR_TABLE;
       20:   57:    modperl_interp_t *interp = 
       20:   58:        (modperl_interp_t *)malloc(sizeof(*interp));
        -:   59:
       20:   60:    memset(interp, '\0', sizeof(*interp));
        -:   61:
       20:   62:    interp->mip = mip;
       20:   63:    interp->refcnt = 0; /* for use by APR::Pool->cleanup_register */
        -:   64:
       20:   65:    if (perl) {
        -:   66:#ifdef MP_USE_GTOP
        -:   67:        MP_dSCFG(mip->server);
        -:   68:        MP_TRACE_m_do(
        -:   69:            modperl_gtop_do_proc_mem_before(MP_FUNC, "perl_clone");
        -:   70:        );
        -:   71:#endif
        -:   72:
        -:   73:#if defined(WIN32) && defined(CLONEf_CLONE_HOST)
        -:   74:        clone_flags |= CLONEf_CLONE_HOST;
        -:   75:#endif
        -:   76:
    #####:   77:        PERL_SET_CONTEXT(perl);
        -:   78:
    #####:   79:        interp->perl = perl_clone(perl, clone_flags);
        -:   80:
        -:   81:#if PERL_REVISION == 5 && PERL_VERSION == 8 && PERL_SUBVERSION == 0 && \
        -:   82:    defined(USE_REENTRANT_API) && defined(HAS_CRYPT_R) && defined(__GLIBC__)
        -:   83:        {
        -:   84:            dTHXa(interp->perl);
        -:   85:            /* workaround 5.8.0 bug */
        -:   86:            PL_reentrant_buffer->_crypt_struct.current_saltbits = 0;
        -:   87:        }
        -:   88:#endif
        -:   89:
        -:   90:        {
    #####:   91:            PTR_TBL_t *source = modperl_module_config_table_get(perl, FALSE);
    #####:   92:            if (source) {
    #####:   93:                PTR_TBL_t *table = modperl_svptr_table_clone(interp->perl,
        -:   94:                                                             perl,
    #####:   95:                                                             source);
        -:   96:
    #####:   97:                modperl_module_config_table_set(interp->perl, table);
        -:   98:            }
        -:   99:        }
        -:  100:
        -:  101:        /*
        -:  102:         * we keep the PL_ptr_table past perl_clone so it can be used
        -:  103:         * within modperl_svptr_table_clone.
        -:  104:         */
    #####:  105:        if ((clone_flags & CLONEf_KEEP_PTR_TABLE)) {
    #####:  106:            dTHXa(interp->perl);
    #####:  107:            ptr_table_free(PL_ptr_table);
    #####:  108:            PL_ptr_table = NULL;
        -:  109:        }
        -:  110:
    #####:  111:        modperl_interp_clone_init(interp);
        -:  112:
    #####:  113:        PERL_SET_CONTEXT(perl);
        -:  114:
        -:  115:#ifdef MP_USE_GTOP
        -:  116:        MP_TRACE_m_do(
        -:  117:            modperl_gtop_do_proc_mem_after(MP_FUNC, "perl_clone");
        -:  118:        );
        -:  119:#endif
        -:  120:    }
        -:  121:
       20:  122:    MP_TRACE_i(MP_FUNC, "0x%lx\n", (unsigned long)interp);
        -:  123:
       20:  124:    return interp;
        -:  125:}
        -:  126:
        -:  127:void modperl_interp_destroy(modperl_interp_t *interp)
       10:  128:{
       10:  129:    void **handles;
       10:  130:    dTHXa(interp->perl);
        -:  131:
       10:  132:    PERL_SET_CONTEXT(interp->perl);
        -:  133:
       10:  134:    MP_TRACE_i(MP_FUNC, "interp == 0x%lx\n",
        -:  135:               (unsigned long)interp);
        -:  136:
       10:  137:    if (MpInterpIN_USE(interp)) {
    #####:  138:        MP_TRACE_i(MP_FUNC, "*error - still in use!*\n");
        -:  139:    }
        -:  140:
       10:  141:    handles = modperl_xs_dl_handles_get(aTHX);
        -:  142:
       10:  143:    modperl_perl_destruct(interp->perl);
        -:  144:
       10:  145:    modperl_xs_dl_handles_close(handles);
        -:  146:
       10:  147:    free(interp);
        -:  148:}
        -:  149:
        -:  150:apr_status_t modperl_interp_cleanup(void *data)
    #####:  151:{
    #####:  152:    modperl_interp_destroy((modperl_interp_t *)data);
    #####:  153:    return APR_SUCCESS;
        -:  154:}
        -:  155:
        -:  156:modperl_interp_t *modperl_interp_get(server_rec *s)
    #####:  157:{
    #####:  158:    MP_dSCFG(s);
    #####:  159:    modperl_interp_t *interp = NULL;
    #####:  160:    modperl_interp_pool_t *mip = scfg->mip;
    #####:  161:    modperl_list_t *head;
        -:  162:
    #####:  163:    head = modperl_tipool_pop(mip->tipool);
    #####:  164:    interp = (modperl_interp_t *)head->data;
        -:  165:
    #####:  166:    MP_TRACE_i(MP_FUNC, "head == 0x%lx, parent == 0x%lx\n",
        -:  167:               (unsigned long)head, (unsigned long)mip->parent);
        -:  168:
    #####:  169:    MP_TRACE_i(MP_FUNC, "selected 0x%lx (perl==0x%lx)\n",
        -:  170:               (unsigned long)interp,
        -:  171:               (unsigned long)interp->perl);
        -:  172:
        -:  173:#ifdef MP_TRACE
    #####:  174:    interp->tid = MP_TIDF;
    #####:  175:    MP_TRACE_i(MP_FUNC, "thread == 0x%lx\n", interp->tid);
        -:  176:#endif
        -:  177:
    #####:  178:    MpInterpIN_USE_On(interp);
        -:  179:
    #####:  180:    return interp;
        -:  181:}
        -:  182:
        -:  183:apr_status_t modperl_interp_pool_destroy(void *data)
       10:  184:{
       10:  185:    modperl_interp_pool_t *mip = (modperl_interp_pool_t *)data;
        -:  186:
       10:  187:    if (mip->tipool) {
    #####:  188:        modperl_tipool_destroy(mip->tipool);
    #####:  189:        mip->tipool = NULL;
        -:  190:    }
        -:  191:    
       10:  192:    if (MpInterpBASE(mip->parent)) {
        -:  193:        /* multiple mips might share the same parent
        -:  194:         * make sure its only destroyed once
        -:  195:         */
       10:  196:        MP_TRACE_i(MP_FUNC, "parent == 0x%lx\n",
        -:  197:                   (unsigned long)mip->parent);
        -:  198:
       10:  199:        modperl_interp_destroy(mip->parent);
        -:  200:    }
        -:  201:
       10:  202:    return APR_SUCCESS;
        -:  203:}
        -:  204:
        -:  205:static void *interp_pool_grow(modperl_tipool_t *tipool, void *data)
    #####:  206:{
    #####:  207:    modperl_interp_pool_t *mip = (modperl_interp_pool_t *)data;
    #####:  208:    MP_TRACE_i(MP_FUNC, "adding new interpreter to the pool\n");
    #####:  209:    return (void *)modperl_interp_new(mip, mip->parent->perl);
        -:  210:}
        -:  211:
        -:  212:static void interp_pool_shrink(modperl_tipool_t *tipool, void *data,
        -:  213:                               void *item)
    #####:  214:{
    #####:  215:    modperl_interp_destroy((modperl_interp_t *)item);
        -:  216:}
        -:  217:
        -:  218:static void interp_pool_dump(modperl_tipool_t *tipool, void *data,
        -:  219:                             modperl_list_t *listp)
    #####:  220:{
    #####:  221:    while (listp) {
    #####:  222:        modperl_interp_t *interp = (modperl_interp_t *)listp->data;
    #####:  223:        MP_TRACE_i(MP_FUNC, "listp==0x%lx, interp==0x%lx, requests=%d\n",
        -:  224:                 (unsigned long)listp, (unsigned long)interp,
        -:  225:                 interp->num_requests);
    #####:  226:        listp = listp->next;
        -:  227:    }
        -:  228:}
        -:  229:
        -:  230:static modperl_tipool_vtbl_t interp_pool_func = {
        -:  231:    interp_pool_grow,
        -:  232:    interp_pool_grow,
        -:  233:    interp_pool_shrink,
        -:  234:    interp_pool_shrink,
        -:  235:    interp_pool_dump,
        -:  236:};
        -:  237:
        -:  238:void modperl_interp_init(server_rec *s, apr_pool_t *p,
        -:  239:                         PerlInterpreter *perl)
       20:  240:{
       20:  241:    apr_pool_t *server_pool = modperl_server_pool();
       20:  242:    pTHX;
       20:  243:    MP_dSCFG(s);
       20:  244:    modperl_interp_pool_t *mip = 
       40:  245:        (modperl_interp_pool_t *)apr_pcalloc(p, sizeof(*mip));
        -:  246:
       20:  247:    MP_TRACE_i(MP_FUNC, "server=%s\n", modperl_server_desc(s, p));
        -:  248:    
       20:  249:    if (scfg->threaded_mpm) {
    #####:  250:        mip->tipool = modperl_tipool_new(p, scfg->interp_pool_cfg,
        -:  251:                                         &interp_pool_func, mip);
        -:  252:    }
        -:  253:    
       20:  254:    mip->server = s;
       20:  255:    mip->parent = modperl_interp_new(mip, NULL);
       20:  256:    aTHX = mip->parent->perl = perl;
        -:  257:    
        -:  258:    /* this happens post-config in mod_perl.c:modperl_init_clones() */
        -:  259:    /* modperl_tipool_init(tipool); */
        -:  260:
       20:  261:    apr_pool_cleanup_register(server_pool, (void*)mip,
        -:  262:                              modperl_interp_pool_destroy,
        -:  263:                              apr_pool_cleanup_null);
        -:  264:
       20:  265:    scfg->mip = mip;
        -:  266:}
        -:  267:
        -:  268:apr_status_t modperl_interp_unselect(void *data)
    #####:  269:{
    #####:  270:    modperl_interp_t *interp = (modperl_interp_t *)data;
    #####:  271:    modperl_interp_pool_t *mip = interp->mip;
        -:  272:
    #####:  273:    if (interp->refcnt != 0) {
    #####:  274:        --interp->refcnt;
    #####:  275:        MP_TRACE_i(MP_FUNC, "interp=0x%lx, refcnt=%d\n",
        -:  276:                   (unsigned long)interp, interp->refcnt);
    #####:  277:        return APR_SUCCESS;
        -:  278:    }
        -:  279:
    #####:  280:    if (interp->request) {
        -:  281:        /* ithreads + a threaded mpm + PerlInterpScope handler */
    #####:  282:        request_rec *r = interp->request;
    #####:  283:        MP_dRCFG;
    #####:  284:        modperl_config_request_cleanup(interp->perl, r);
    #####:  285:        MpReqCLEANUP_REGISTERED_Off(rcfg);
        -:  286:    }
        -:  287:
    #####:  288:    MpInterpIN_USE_Off(interp);
    #####:  289:    MpInterpPUTBACK_Off(interp);
        -:  290:
    #####:  291:    MP_THX_INTERP_SET(interp->perl, NULL);
        -:  292:
    #####:  293:    modperl_tipool_putback_data(mip->tipool, data, interp->num_requests);
        -:  294:
    #####:  295:    return APR_SUCCESS;
        -:  296:}
        -:  297:
        -:  298:/* XXX:
        -:  299: * interp is marked as in_use for the scope of the pool it is
        -:  300: * stashed in.  this is done to avoid the tipool->tlock whenever
        -:  301: * possible.  neither approach is ideal.
        -:  302: */
        -:  303:#define MP_INTERP_KEY "MODPERL_INTERP"
        -:  304:
        -:  305:#define get_interp(p) \
        -:  306:    (void)apr_pool_userdata_get((void **)&interp, MP_INTERP_KEY, p)
        -:  307:
        -:  308:#define set_interp(p) \
        -:  309:     (void)apr_pool_userdata_set((void *)interp, MP_INTERP_KEY, \
        -:  310:                                 modperl_interp_unselect, \
        -:  311:                                 p)
        -:  312:
        -:  313:modperl_interp_t *modperl_interp_pool_get(apr_pool_t *p)
       32:  314:{
       32:  315:    modperl_interp_t *interp = NULL;
       32:  316:    get_interp(p);
       32:  317:    return interp;
        -:  318:}
        -:  319:
        -:  320:void modperl_interp_pool_set(apr_pool_t *p,
        -:  321:                             modperl_interp_t *interp,
        -:  322:                             int cleanup)
        4:  323:{
        -:  324:    /* same as get_interp but optional cleanup  */
        4:  325:    (void)apr_pool_userdata_set((void *)interp, MP_INTERP_KEY,
        -:  326:                                cleanup ? modperl_interp_unselect : NULL,
        -:  327:                                p);
        -:  328:}
        -:  329:
        -:  330:/*
        -:  331: * used in the case where we don't have a request_rec or conn_rec,
        -:  332: * such as for directive handlers per-{dir,srv} create and merge.
        -:  333: * "request time pool" is most likely a request_rec->pool.
        -:  334: */
        -:  335:modperl_interp_t *modperl_interp_pool_select(apr_pool_t *p,
        -:  336:                                             server_rec *s)
      172:  337:{
      172:  338:    int is_startup = (p == s->process->pconf);
      172:  339:    MP_dSCFG(s);
      172:  340:    modperl_interp_t *interp = NULL;
        -:  341:
      172:  342:    if (scfg && (is_startup || !scfg->threaded_mpm)) {
      164:  343:        MP_TRACE_i(MP_FUNC, "using parent interpreter at %s\n",
        -:  344:                   is_startup ? "startup" : "request time (non-threaded MPM)");
        -:  345:
      164:  346:        if (!scfg->mip) {
        -:  347:            /* we get here if directive handlers are invoked
        -:  348:             * before server merge.
        -:  349:             */
        8:  350:            modperl_init_vhost(s, p, NULL);
        -:  351:        }
        -:  352:
      164:  353:        interp = scfg->mip->parent;
        -:  354:    }
        -:  355:    else {
        8:  356:        if (!(interp = modperl_interp_pool_get(p))) {
    #####:  357:            interp = modperl_interp_get(s);
    #####:  358:            modperl_interp_pool_set(p, interp, TRUE);
        -:  359:
    #####:  360:            MP_TRACE_i(MP_FUNC, "set interp in request time pool 0x%lx\n",
        -:  361:                       (unsigned long)p);
        -:  362:        }
        -:  363:        else {
        8:  364:            MP_TRACE_i(MP_FUNC, "found interp in request time pool 0x%lx\n",
        -:  365:                       (unsigned long)p);
        -:  366:        }
        -:  367:    }
        -:  368:
      172:  369:    return interp;
        -:  370:}
        -:  371:
        -:  372:modperl_interp_t *modperl_interp_select(request_rec *r, conn_rec *c,
        -:  373:                                        server_rec *s)
     2440:  374:{
     2440:  375:    MP_dSCFG(s);
     2440:  376:    MP_dRCFG;
     2440:  377:    modperl_config_dir_t *dcfg = modperl_config_dir_get(r);
     2440:  378:    const char *desc = NULL;
     2440:  379:    modperl_interp_t *interp = NULL;
     2440:  380:    apr_pool_t *p = NULL;
     2440:  381:    int is_subrequest = (r && r->main) ? 1 : 0;
     2440:  382:    modperl_interp_scope_e scope;
        -:  383:
     2440:  384:    if (!scfg->threaded_mpm) {
     2440:  385:        MP_TRACE_i(MP_FUNC,
        -:  386:                   "using parent 0x%lx for non-threaded mpm (%s:%d)\n",
        -:  387:                   (unsigned long)scfg->mip->parent,
        -:  388:                   s->server_hostname, s->port);
        -:  389:        /* XXX: if no VirtualHosts w/ PerlOptions +Parent we can skip this */
     2440:  390:        PERL_SET_CONTEXT(scfg->mip->parent->perl);
     2440:  391:        return scfg->mip->parent;
        -:  392:    }
        -:  393:
    #####:  394:    if (rcfg && rcfg->interp) {
        -:  395:        /* if scope is per-handler and something selected an interpreter
        -:  396:         * before modperl_callback_run_handlers() and is still holding it,
        -:  397:         * e.g. modperl_response_handler_cgi(), that interpreter will
        -:  398:         * be here
        -:  399:         */
    #####:  400:        MP_TRACE_i(MP_FUNC,
        -:  401:                   "found interp 0x%lx in request config\n",
        -:  402:                   (unsigned long)rcfg->interp);
    #####:  403:        return rcfg->interp;
        -:  404:    }
        -:  405:
        -:  406:    /*
        -:  407:     * if a per-dir PerlInterpScope is specified, use it.
        -:  408:     * else if r != NULL use per-server PerlInterpScope
        -:  409:     * else scope must be per-connection
        -:  410:     */
        -:  411:
    #####:  412:    scope = (dcfg && !modperl_interp_scope_undef(dcfg)) ? 
        -:  413:        dcfg->interp_scope :
        -:  414:        (r ? scfg->interp_scope : MP_INTERP_SCOPE_CONNECTION);
        -:  415:
    #####:  416:    MP_TRACE_i(MP_FUNC, "scope is per-%s\n",
        -:  417:               modperl_interp_scope_desc(scope));
        -:  418:
        -:  419:    /*
        -:  420:     * XXX: goto modperl_interp_get() if scope == handler ?
        -:  421:     */
        -:  422:
    #####:  423:    if (c && (scope == MP_INTERP_SCOPE_CONNECTION)) {
    #####:  424:        desc = "conn_rec pool";
    #####:  425:        get_interp(c->pool);
        -:  426:
    #####:  427:        if (interp) {
    #####:  428:            MP_TRACE_i(MP_FUNC,
        -:  429:                       "found interp 0x%lx in %s 0x%lx\n",
        -:  430:                       (unsigned long)interp, desc, (unsigned long)c->pool);
    #####:  431:            return interp;
        -:  432:        }
        -:  433:
    #####:  434:        p = c->pool;
        -:  435:    }
    #####:  436:    else if (r) {
    #####:  437:        if (is_subrequest && (scope == MP_INTERP_SCOPE_REQUEST)) {
        -:  438:            /* share 1 interpreter across sub-requests */
    #####:  439:            request_rec *main_r = r->main;
        -:  440:
    #####:  441:            while (main_r && !interp) {
    #####:  442:                p = main_r->pool;
    #####:  443:                get_interp(p);
    #####:  444:                MP_TRACE_i(MP_FUNC,
        -:  445:                           "looking for interp in main request for %s...%s\n",
        -:  446:                           main_r->uri, interp ? "found" : "not found");
    #####:  447:                main_r = main_r->main;
        -:  448:            }                
        -:  449:        }
        -:  450:        else {
    #####:  451:            p = r->pool;
    #####:  452:            get_interp(p);
        -:  453:        }
        -:  454:
    #####:  455:        desc = "request_rec pool";
        -:  456:
    #####:  457:        if (interp) {
    #####:  458:            MP_TRACE_i(MP_FUNC,
        -:  459:                       "found interp 0x%lx in %s 0x%lx (%s request for %s)\n",
        -:  460:                       (unsigned long)interp, desc, (unsigned long)p,
        -:  461:                       (is_subrequest ? "sub" : "main"), r->uri);
    #####:  462:            return interp;
        -:  463:        }
        -:  464:
        -:  465:        /* might have already been set by a ConnectionHandler */
    #####:  466:        get_interp(r->connection->pool);
        -:  467:
    #####:  468:        if (interp) {
    #####:  469:            desc = "r->connection pool";
    #####:  470:            MP_TRACE_i(MP_FUNC,
        -:  471:                       "found interp 0x%lx in %s 0x%lx\n",
        -:  472:                       (unsigned long)interp, desc,
        -:  473:                       (unsigned long)r->connection->pool);
    #####:  474:            return interp;
        -:  475:        }
        -:  476:    }
        -:  477:
    #####:  478:    interp = modperl_interp_get(s ? s : r->server);
    #####:  479:    ++interp->num_requests; /* should only get here once per request */
        -:  480:
    #####:  481:    if (scope == MP_INTERP_SCOPE_HANDLER) {
        -:  482:        /* caller is responsible for calling modperl_interp_unselect() */
    #####:  483:        interp->request = r;
    #####:  484:        MpReqCLEANUP_REGISTERED_On(rcfg);
    #####:  485:        MpInterpPUTBACK_On(interp);
        -:  486:    }
        -:  487:    else {
    #####:  488:        if (!p) {
        -:  489:            /* should never happen */
    #####:  490:            MP_TRACE_i(MP_FUNC, "no pool\n");
    #####:  491:            return NULL;
        -:  492:        }
        -:  493:
    #####:  494:        set_interp(p);
        -:  495:
    #####:  496:        MP_TRACE_i(MP_FUNC,
        -:  497:                   "set interp 0x%lx in %s 0x%lx (%s request for %s)\n",
        -:  498:                   (unsigned long)interp, desc, (unsigned long)p,
        -:  499:                   (r ? (is_subrequest ? "sub" : "main") : "conn"),
        -:  500:                   (r ? r->uri : c->remote_ip));
        -:  501:    }
        -:  502:
        -:  503:    /* set context (THX) for this thread */
    #####:  504:    PERL_SET_CONTEXT(interp->perl);
        -:  505:
    #####:  506:    MP_THX_INTERP_SET(interp->perl, interp);
        -:  507:
    #####:  508:    return interp;
        -:  509:}
        -:  510:
        -:  511:/* currently up to the caller if mip needs locking */
        -:  512:void modperl_interp_mip_walk(PerlInterpreter *current_perl,
        -:  513:                             PerlInterpreter *parent_perl,
        -:  514:                             modperl_interp_pool_t *mip,
        -:  515:                             modperl_interp_mip_walker_t walker,
        -:  516:                             void *data)
       10:  517:{
       10:  518:    modperl_list_t *head = mip->tipool ? mip->tipool->idle : NULL;
        -:  519:
       10:  520:    if (!current_perl) {
       10:  521:        current_perl = PERL_GET_CONTEXT;
        -:  522:    }
        -:  523:
       10:  524:    if (parent_perl) {
       10:  525:        PERL_SET_CONTEXT(parent_perl);
       10:  526:        walker(parent_perl, mip, data);
        -:  527:    }
        -:  528:
       10:  529:    while (head) {
    #####:  530:        PerlInterpreter *perl = ((modperl_interp_t *)head->data)->perl;
    #####:  531:        PERL_SET_CONTEXT(perl);
    #####:  532:        walker(perl, mip, data);
    #####:  533:        head = head->next;
        -:  534:    }
        -:  535:
       10:  536:    PERL_SET_CONTEXT(current_perl);
        -:  537:}
        -:  538:
        -:  539:void modperl_interp_mip_walk_servers(PerlInterpreter *current_perl,
        -:  540:                                     server_rec *base_server,
        -:  541:                                     modperl_interp_mip_walker_t walker,
        -:  542:                                     void *data)
        4:  543:{
        4:  544:    server_rec *s = base_server->next;
        4:  545:    modperl_config_srv_t *base_scfg = modperl_config_srv_get(base_server);
        4:  546:    PerlInterpreter *base_perl = base_scfg->mip->parent->perl;
        -:  547:
        4:  548:    modperl_interp_mip_walk(current_perl, base_perl,
        -:  549:                            base_scfg->mip, walker, data);
        -:  550:
        4:  551:    while (s) {
       42:  552:        MP_dSCFG(s);
       42:  553:        PerlInterpreter *perl = scfg->mip->parent->perl;
       42:  554:        modperl_interp_pool_t *mip = scfg->mip;
        -:  555:
        -:  556:        /* skip vhosts who share parent perl */
       42:  557:        if (perl == base_perl) {
       36:  558:            perl = NULL;
        -:  559:        }
        -:  560:
        -:  561:        /* skip vhosts who share parent mip */
       42:  562:        if (scfg->mip == base_scfg->mip) {
       36:  563:            mip = NULL;
        -:  564:        }
        -:  565:
       42:  566:        if (perl || mip) {
        6:  567:            modperl_interp_mip_walk(current_perl, perl,
        -:  568:                                    mip, walker, data);
        -:  569:        }
        -:  570:
       42:  571:        s = s->next;
        -:  572:    }
        -:  573:}
        -:  574:
        -:  575:#else
        -:  576:
        -:  577:void modperl_interp_init(server_rec *s, apr_pool_t *p,
        -:  578:                         PerlInterpreter *perl)
        -:  579:{
        -:  580:    MP_dSCFG(s);
        -:  581:    scfg->perl = perl;
        -:  582:}
        -:  583:
        -:  584:apr_status_t modperl_interp_cleanup(void *data)
        -:  585:{
        -:  586:    return APR_SUCCESS;
        -:  587:}
        -:  588:
        -:  589:#endif /* USE_ITHREADS */