Back to home page

Nginx displayed by LXR

Source navigation ]
Diff markup ]
Identifier search ]
general search ]
 
 
Version: nginx-1.13.12 ]​[ nginx-1.12.2 ]​

0001 
0002 /*
0003  * Copyright (C) Igor Sysoev
0004  * Copyright (C) Nginx, Inc.
0005  */
0006 
0007 
0008 #include <ngx_config.h>
0009 #include <ngx_core.h>
0010 #include <ngx_http.h>
0011 #include <ngx_http_perl_module.h>
0012 
0013 
0014 typedef struct {
0015     PerlInterpreter   *perl;
0016     HV                *nginx;
0017     ngx_array_t       *modules;
0018     ngx_array_t       *requires;
0019 } ngx_http_perl_main_conf_t;
0020 
0021 
0022 typedef struct {
0023     SV                *sub;
0024     ngx_str_t          handler;
0025 } ngx_http_perl_loc_conf_t;
0026 
0027 
0028 typedef struct {
0029     SV                *sub;
0030     ngx_str_t          handler;
0031 } ngx_http_perl_variable_t;
0032 
0033 
0034 #if (NGX_HTTP_SSI)
0035 static ngx_int_t ngx_http_perl_ssi(ngx_http_request_t *r,
0036     ngx_http_ssi_ctx_t *ssi_ctx, ngx_str_t **params);
0037 #endif
0038 
0039 static char *ngx_http_perl_init_interpreter(ngx_conf_t *cf,
0040     ngx_http_perl_main_conf_t *pmcf);
0041 static PerlInterpreter *ngx_http_perl_create_interpreter(ngx_conf_t *cf,
0042     ngx_http_perl_main_conf_t *pmcf);
0043 static ngx_int_t ngx_http_perl_run_requires(pTHX_ ngx_array_t *requires,
0044     ngx_log_t *log);
0045 static ngx_int_t ngx_http_perl_call_handler(pTHX_ ngx_http_request_t *r,
0046     HV *nginx, SV *sub, SV **args, ngx_str_t *handler, ngx_str_t *rv);
0047 static void ngx_http_perl_eval_anon_sub(pTHX_ ngx_str_t *handler, SV **sv);
0048 
0049 static ngx_int_t ngx_http_perl_preconfiguration(ngx_conf_t *cf);
0050 static void *ngx_http_perl_create_main_conf(ngx_conf_t *cf);
0051 static char *ngx_http_perl_init_main_conf(ngx_conf_t *cf, void *conf);
0052 static void *ngx_http_perl_create_loc_conf(ngx_conf_t *cf);
0053 static char *ngx_http_perl_merge_loc_conf(ngx_conf_t *cf, void *parent,
0054     void *child);
0055 static char *ngx_http_perl(ngx_conf_t *cf, ngx_command_t *cmd, void *conf);
0056 static char *ngx_http_perl_set(ngx_conf_t *cf, ngx_command_t *cmd, void *conf);
0057 
0058 #if (NGX_HAVE_PERL_MULTIPLICITY)
0059 static void ngx_http_perl_cleanup_perl(void *data);
0060 #endif
0061 
0062 static ngx_int_t ngx_http_perl_init_worker(ngx_cycle_t *cycle);
0063 static void ngx_http_perl_exit(ngx_cycle_t *cycle);
0064 
0065 
0066 static ngx_command_t  ngx_http_perl_commands[] = {
0067 
0068     { ngx_string("perl_modules"),
0069       NGX_HTTP_MAIN_CONF|NGX_CONF_TAKE1,
0070       ngx_conf_set_str_array_slot,
0071       NGX_HTTP_MAIN_CONF_OFFSET,
0072       offsetof(ngx_http_perl_main_conf_t, modules),
0073       NULL },
0074 
0075     { ngx_string("perl_require"),
0076       NGX_HTTP_MAIN_CONF|NGX_CONF_TAKE1,
0077       ngx_conf_set_str_array_slot,
0078       NGX_HTTP_MAIN_CONF_OFFSET,
0079       offsetof(ngx_http_perl_main_conf_t, requires),
0080       NULL },
0081 
0082     { ngx_string("perl"),
0083       NGX_HTTP_LOC_CONF|NGX_HTTP_LMT_CONF|NGX_CONF_TAKE1,
0084       ngx_http_perl,
0085       NGX_HTTP_LOC_CONF_OFFSET,
0086       0,
0087       NULL },
0088 
0089     { ngx_string("perl_set"),
0090       NGX_HTTP_MAIN_CONF|NGX_CONF_TAKE2,
0091       ngx_http_perl_set,
0092       NGX_HTTP_LOC_CONF_OFFSET,
0093       0,
0094       NULL },
0095 
0096       ngx_null_command
0097 };
0098 
0099 
0100 static ngx_http_module_t  ngx_http_perl_module_ctx = {
0101     ngx_http_perl_preconfiguration,        /* preconfiguration */
0102     NULL,                                  /* postconfiguration */
0103 
0104     ngx_http_perl_create_main_conf,        /* create main configuration */
0105     ngx_http_perl_init_main_conf,          /* init main configuration */
0106 
0107     NULL,                                  /* create server configuration */
0108     NULL,                                  /* merge server configuration */
0109 
0110     ngx_http_perl_create_loc_conf,         /* create location configuration */
0111     ngx_http_perl_merge_loc_conf           /* merge location configuration */
0112 };
0113 
0114 
0115 ngx_module_t  ngx_http_perl_module = {
0116     NGX_MODULE_V1,
0117     &ngx_http_perl_module_ctx,             /* module context */
0118     ngx_http_perl_commands,                /* module directives */
0119     NGX_HTTP_MODULE,                       /* module type */
0120     NULL,                                  /* init master */
0121     NULL,                                  /* init module */
0122     ngx_http_perl_init_worker,             /* init process */
0123     NULL,                                  /* init thread */
0124     NULL,                                  /* exit thread */
0125     NULL,                                  /* exit process */
0126     ngx_http_perl_exit,                    /* exit master */
0127     NGX_MODULE_V1_PADDING
0128 };
0129 
0130 
0131 #if (NGX_HTTP_SSI)
0132 
0133 #define NGX_HTTP_PERL_SSI_SUB  0
0134 #define NGX_HTTP_PERL_SSI_ARG  1
0135 
0136 
0137 static ngx_http_ssi_param_t  ngx_http_perl_ssi_params[] = {
0138     { ngx_string("sub"), NGX_HTTP_PERL_SSI_SUB, 1, 0 },
0139     { ngx_string("arg"), NGX_HTTP_PERL_SSI_ARG, 0, 1 },
0140     { ngx_null_string, 0, 0, 0 }
0141 };
0142 
0143 static ngx_http_ssi_command_t  ngx_http_perl_ssi_command = {
0144     ngx_string("perl"), ngx_http_perl_ssi, ngx_http_perl_ssi_params, 0, 0, 1
0145 };
0146 
0147 #endif
0148 
0149 
0150 static ngx_str_t         ngx_null_name = ngx_null_string;
0151 static HV               *nginx_stash;
0152 
0153 #if (NGX_HAVE_PERL_MULTIPLICITY)
0154 static ngx_uint_t        ngx_perl_term;
0155 #else
0156 static PerlInterpreter  *perl;
0157 #endif
0158 
0159 
0160 static void
0161 ngx_http_perl_xs_init(pTHX)
0162 {
0163     newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, __FILE__);
0164 
0165     nginx_stash = gv_stashpv("nginx", TRUE);
0166 }
0167 
0168 
0169 static ngx_int_t
0170 ngx_http_perl_handler(ngx_http_request_t *r)
0171 {
0172     r->main->count++;
0173 
0174     ngx_http_perl_handle_request(r);
0175 
0176     return NGX_DONE;
0177 }
0178 
0179 
0180 void
0181 ngx_http_perl_handle_request(ngx_http_request_t *r)
0182 {
0183     SV                         *sub;
0184     ngx_int_t                   rc;
0185     ngx_str_t                   uri, args, *handler;
0186     ngx_http_perl_ctx_t        *ctx;
0187     ngx_http_perl_loc_conf_t   *plcf;
0188     ngx_http_perl_main_conf_t  *pmcf;
0189 
0190     ngx_log_debug0(NGX_LOG_DEBUG_HTTP, r->connection->log, 0, "perl handler");
0191 
0192     ctx = ngx_http_get_module_ctx(r, ngx_http_perl_module);
0193 
0194     if (ctx == NULL) {
0195         ctx = ngx_pcalloc(r->pool, sizeof(ngx_http_perl_ctx_t));
0196         if (ctx == NULL) {
0197             ngx_http_finalize_request(r, NGX_ERROR);
0198             return;
0199         }
0200 
0201         ngx_http_set_ctx(r, ctx, ngx_http_perl_module);
0202     }
0203 
0204     pmcf = ngx_http_get_module_main_conf(r, ngx_http_perl_module);
0205 
0206     {
0207 
0208     dTHXa(pmcf->perl);
0209     PERL_SET_CONTEXT(pmcf->perl);
0210     PERL_SET_INTERP(pmcf->perl);
0211 
0212     if (ctx->next == NULL) {
0213         plcf = ngx_http_get_module_loc_conf(r, ngx_http_perl_module);
0214         sub = plcf->sub;
0215         handler = &plcf->handler;
0216 
0217     } else {
0218         sub = ctx->next;
0219         handler = &ngx_null_name;
0220         ctx->next = NULL;
0221     }
0222 
0223     rc = ngx_http_perl_call_handler(aTHX_ r, pmcf->nginx, sub, NULL, handler,
0224                                     NULL);
0225 
0226     }
0227 
0228     ngx_log_debug1(NGX_LOG_DEBUG_HTTP, r->connection->log, 0,
0229                    "perl handler done: %i", rc);
0230 
0231     if (rc == NGX_DONE) {
0232         ngx_http_finalize_request(r, rc);
0233         return;
0234     }
0235 
0236     if (rc > 600) {
0237         rc = NGX_OK;
0238     }
0239 
0240     if (ctx->redirect_uri.len) {
0241         uri = ctx->redirect_uri;
0242         args = ctx->redirect_args;
0243 
0244     } else {
0245         uri.len = 0;
0246     }
0247 
0248     ctx->filename.data = NULL;
0249     ctx->redirect_uri.len = 0;
0250 
0251     if (ctx->done || ctx->next) {
0252         ngx_http_finalize_request(r, NGX_DONE);
0253         return;
0254     }
0255 
0256     if (uri.len) {
0257         ngx_http_internal_redirect(r, &uri, &args);
0258         ngx_http_finalize_request(r, NGX_DONE);
0259         return;
0260     }
0261 
0262     if (rc == NGX_OK || rc == NGX_HTTP_OK) {
0263         ngx_http_send_special(r, NGX_HTTP_LAST);
0264         ctx->done = 1;
0265     }
0266 
0267     ngx_http_finalize_request(r, rc);
0268 }
0269 
0270 
0271 void
0272 ngx_http_perl_sleep_handler(ngx_http_request_t *r)
0273 {
0274     ngx_event_t  *wev;
0275 
0276     ngx_log_debug0(NGX_LOG_DEBUG_HTTP, r->connection->log, 0,
0277                    "perl sleep handler");
0278 
0279     wev = r->connection->write;
0280 
0281     if (wev->delayed) {
0282 
0283         if (ngx_handle_write_event(wev, 0) != NGX_OK) {
0284             ngx_http_finalize_request(r, NGX_HTTP_INTERNAL_SERVER_ERROR);
0285         }
0286 
0287         return;
0288     }
0289 
0290     ngx_http_perl_handle_request(r);
0291 }
0292 
0293 
0294 static ngx_int_t
0295 ngx_http_perl_variable(ngx_http_request_t *r, ngx_http_variable_value_t *v,
0296     uintptr_t data)
0297 {
0298     ngx_http_perl_variable_t *pv = (ngx_http_perl_variable_t *) data;
0299 
0300     ngx_int_t                   rc;
0301     ngx_str_t                   value;
0302     ngx_http_perl_ctx_t        *ctx;
0303     ngx_http_perl_main_conf_t  *pmcf;
0304 
0305     ngx_log_debug0(NGX_LOG_DEBUG_HTTP, r->connection->log, 0,
0306                    "perl variable handler");
0307 
0308     ctx = ngx_http_get_module_ctx(r, ngx_http_perl_module);
0309 
0310     if (ctx == NULL) {
0311         ctx = ngx_pcalloc(r->pool, sizeof(ngx_http_perl_ctx_t));
0312         if (ctx == NULL) {
0313             return NGX_ERROR;
0314         }
0315 
0316         ngx_http_set_ctx(r, ctx, ngx_http_perl_module);
0317     }
0318 
0319     pmcf = ngx_http_get_module_main_conf(r, ngx_http_perl_module);
0320 
0321     value.data = NULL;
0322 
0323     {
0324 
0325     dTHXa(pmcf->perl);
0326     PERL_SET_CONTEXT(pmcf->perl);
0327     PERL_SET_INTERP(pmcf->perl);
0328 
0329     rc = ngx_http_perl_call_handler(aTHX_ r, pmcf->nginx, pv->sub, NULL,
0330                                     &pv->handler, &value);
0331 
0332     }
0333 
0334     if (value.data) {
0335         v->len = value.len;
0336         v->valid = 1;
0337         v->no_cacheable = 0;
0338         v->not_found = 0;
0339         v->data = value.data;
0340 
0341     } else {
0342         v->not_found = 1;
0343     }
0344 
0345     ctx->filename.data = NULL;
0346     ctx->redirect_uri.len = 0;
0347 
0348     ngx_log_debug0(NGX_LOG_DEBUG_HTTP, r->connection->log, 0,
0349                    "perl variable done");
0350 
0351     return rc;
0352 }
0353 
0354 
0355 #if (NGX_HTTP_SSI)
0356 
0357 static ngx_int_t
0358 ngx_http_perl_ssi(ngx_http_request_t *r, ngx_http_ssi_ctx_t *ssi_ctx,
0359     ngx_str_t **params)
0360 {
0361     SV                         *sv, **asv;
0362     ngx_int_t                   rc;
0363     ngx_str_t                  *handler, **args;
0364     ngx_uint_t                  i;
0365     ngx_http_perl_ctx_t        *ctx;
0366     ngx_http_perl_main_conf_t  *pmcf;
0367 
0368     ngx_log_debug0(NGX_LOG_DEBUG_HTTP, r->connection->log, 0,
0369                    "perl ssi handler");
0370 
0371     ctx = ngx_http_get_module_ctx(r, ngx_http_perl_module);
0372 
0373     if (ctx == NULL) {
0374         ctx = ngx_pcalloc(r->pool, sizeof(ngx_http_perl_ctx_t));
0375         if (ctx == NULL) {
0376             return NGX_ERROR;
0377         }
0378 
0379         ngx_http_set_ctx(r, ctx, ngx_http_perl_module);
0380     }
0381 
0382     pmcf = ngx_http_get_module_main_conf(r, ngx_http_perl_module);
0383 
0384     ctx->ssi = ssi_ctx;
0385 
0386     handler = params[NGX_HTTP_PERL_SSI_SUB];
0387     handler->data[handler->len] = '\0';
0388 
0389     {
0390 
0391     dTHXa(pmcf->perl);
0392     PERL_SET_CONTEXT(pmcf->perl);
0393     PERL_SET_INTERP(pmcf->perl);
0394 
0395 #if 0
0396 
0397     /* the code is disabled to force the precompiled perl code using only */
0398 
0399     ngx_http_perl_eval_anon_sub(aTHX_ handler, &sv);
0400 
0401     if (sv == &PL_sv_undef) {
0402         ngx_log_error(NGX_LOG_ERR, r->connection->log, 0,
0403                       "eval_pv(\"%V\") failed", handler);
0404         return NGX_ERROR;
0405     }
0406 
0407     if (sv == NULL) {
0408         sv = newSVpvn((char *) handler->data, handler->len);
0409     }
0410 
0411 #endif
0412 
0413     sv = newSVpvn((char *) handler->data, handler->len);
0414 
0415     args = &params[NGX_HTTP_PERL_SSI_ARG];
0416 
0417     if (args[0]) {
0418 
0419         for (i = 0; args[i]; i++) { /* void */ }
0420 
0421         asv = ngx_pcalloc(r->pool, (i + 1) * sizeof(SV *));
0422 
0423         if (asv == NULL) {
0424             SvREFCNT_dec(sv);
0425             return NGX_ERROR;
0426         }
0427 
0428         asv[0] = (SV *) (uintptr_t) i;
0429 
0430         for (i = 0; args[i]; i++) {
0431             asv[i + 1] = newSVpvn((char *) args[i]->data, args[i]->len);
0432         }
0433 
0434     } else {
0435         asv = NULL;
0436     }
0437 
0438     rc = ngx_http_perl_call_handler(aTHX_ r, pmcf->nginx, sv, asv, handler,
0439                                     NULL);
0440 
0441     SvREFCNT_dec(sv);
0442 
0443     }
0444 
0445     ctx->filename.data = NULL;
0446     ctx->redirect_uri.len = 0;
0447     ctx->ssi = NULL;
0448 
0449     ngx_log_debug0(NGX_LOG_DEBUG_HTTP, r->connection->log, 0, "perl ssi done");
0450 
0451     return rc;
0452 }
0453 
0454 #endif
0455 
0456 
0457 static char *
0458 ngx_http_perl_init_interpreter(ngx_conf_t *cf, ngx_http_perl_main_conf_t *pmcf)
0459 {
0460     ngx_str_t           *m;
0461     ngx_uint_t           i;
0462 #if (NGX_HAVE_PERL_MULTIPLICITY)
0463     ngx_pool_cleanup_t  *cln;
0464 
0465     cln = ngx_pool_cleanup_add(cf->pool, 0);
0466     if (cln == NULL) {
0467         return NGX_CONF_ERROR;
0468     }
0469 
0470 #endif
0471 
0472 #ifdef NGX_PERL_MODULES
0473     if (pmcf->modules == NGX_CONF_UNSET_PTR) {
0474 
0475         pmcf->modules = ngx_array_create(cf->pool, 1, sizeof(ngx_str_t));
0476         if (pmcf->modules == NULL) {
0477             return NGX_CONF_ERROR;
0478         }
0479 
0480         m = ngx_array_push(pmcf->modules);
0481         if (m == NULL) {
0482             return NGX_CONF_ERROR;
0483         }
0484 
0485         ngx_str_set(m, NGX_PERL_MODULES);
0486     }
0487 #endif
0488 
0489     if (pmcf->modules != NGX_CONF_UNSET_PTR) {
0490         m = pmcf->modules->elts;
0491         for (i = 0; i < pmcf->modules->nelts; i++) {
0492             if (ngx_conf_full_name(cf->cycle, &m[i], 0) != NGX_OK) {
0493                 return NGX_CONF_ERROR;
0494             }
0495         }
0496     }
0497 
0498 #if !(NGX_HAVE_PERL_MULTIPLICITY)
0499 
0500     if (perl) {
0501 
0502         if (ngx_set_environment(cf->cycle, NULL) == NULL) {
0503             return NGX_CONF_ERROR;
0504         }
0505 
0506         if (ngx_http_perl_run_requires(aTHX_ pmcf->requires, cf->log)
0507             != NGX_OK)
0508         {
0509             return NGX_CONF_ERROR;
0510         }
0511 
0512         pmcf->perl = perl;
0513         pmcf->nginx = nginx_stash;
0514 
0515         return NGX_CONF_OK;
0516     }
0517 
0518 #endif
0519 
0520     if (nginx_stash == NULL) {
0521         PERL_SYS_INIT(&ngx_argc, &ngx_argv);
0522     }
0523 
0524     pmcf->perl = ngx_http_perl_create_interpreter(cf, pmcf);
0525 
0526     if (pmcf->perl == NULL) {
0527         return NGX_CONF_ERROR;
0528     }
0529 
0530     pmcf->nginx = nginx_stash;
0531 
0532 #if (NGX_HAVE_PERL_MULTIPLICITY)
0533 
0534     cln->handler = ngx_http_perl_cleanup_perl;
0535     cln->data = pmcf->perl;
0536 
0537 #else
0538 
0539     perl = pmcf->perl;
0540 
0541 #endif
0542 
0543     return NGX_CONF_OK;
0544 }
0545 
0546 
0547 static PerlInterpreter *
0548 ngx_http_perl_create_interpreter(ngx_conf_t *cf,
0549     ngx_http_perl_main_conf_t *pmcf)
0550 {
0551     int                n;
0552     STRLEN             len;
0553     SV                *sv;
0554     char              *ver, **embedding;
0555     ngx_str_t         *m;
0556     ngx_uint_t         i;
0557     PerlInterpreter   *perl;
0558 
0559     ngx_log_debug0(NGX_LOG_DEBUG_HTTP, cf->log, 0, "create perl interpreter");
0560 
0561     if (ngx_set_environment(cf->cycle, NULL) == NULL) {
0562         return NULL;
0563     }
0564 
0565     perl = perl_alloc();
0566     if (perl == NULL) {
0567         ngx_log_error(NGX_LOG_ALERT, cf->log, 0, "perl_alloc() failed");
0568         return NULL;
0569     }
0570 
0571     {
0572 
0573     dTHXa(perl);
0574     PERL_SET_CONTEXT(perl);
0575     PERL_SET_INTERP(perl);
0576 
0577     perl_construct(perl);
0578 
0579 #ifdef PERL_EXIT_DESTRUCT_END
0580     PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
0581 #endif
0582 
0583     n = (pmcf->modules != NGX_CONF_UNSET_PTR) ? pmcf->modules->nelts * 2 : 0;
0584 
0585     embedding = ngx_palloc(cf->pool, (5 + n) * sizeof(char *));
0586     if (embedding == NULL) {
0587         goto fail;
0588     }
0589 
0590     embedding[0] = "";
0591 
0592     if (n++) {
0593         m = pmcf->modules->elts;
0594         for (i = 0; i < pmcf->modules->nelts; i++) {
0595             embedding[2 * i + 1] = "-I";
0596             embedding[2 * i + 2] = (char *) m[i].data;
0597         }
0598     }
0599 
0600     embedding[n++] = "-Mnginx";
0601     embedding[n++] = "-e";
0602     embedding[n++] = "0";
0603     embedding[n] = NULL;
0604 
0605     n = perl_parse(perl, ngx_http_perl_xs_init, n, embedding, NULL);
0606 
0607     if (n != 0) {
0608         ngx_log_error(NGX_LOG_ALERT, cf->log, 0, "perl_parse() failed: %d", n);
0609         goto fail;
0610     }
0611 
0612     sv = get_sv("nginx::VERSION", FALSE);
0613     ver = SvPV(sv, len);
0614 
0615     if (ngx_strcmp(ver, NGINX_VERSION) != 0) {
0616         ngx_log_error(NGX_LOG_ALERT, cf->log, 0,
0617                       "version " NGINX_VERSION " of nginx.pm is required, "
0618                       "but %s was found", ver);
0619         goto fail;
0620     }
0621 
0622     if (ngx_http_perl_run_requires(aTHX_ pmcf->requires, cf->log) != NGX_OK) {
0623         goto fail;
0624     }
0625 
0626     }
0627 
0628     return perl;
0629 
0630 fail:
0631 
0632     (void) perl_destruct(perl);
0633 
0634     perl_free(perl);
0635 
0636     return NULL;
0637 }
0638 
0639 
0640 static ngx_int_t
0641 ngx_http_perl_run_requires(pTHX_ ngx_array_t *requires, ngx_log_t *log)
0642 {
0643     u_char      *err;
0644     STRLEN       len;
0645     ngx_str_t   *script;
0646     ngx_uint_t   i;
0647 
0648     if (requires == NGX_CONF_UNSET_PTR) {
0649         return NGX_OK;
0650     }
0651 
0652     script = requires->elts;
0653     for (i = 0; i < requires->nelts; i++) {
0654 
0655         require_pv((char *) script[i].data);
0656 
0657         if (SvTRUE(ERRSV)) {
0658 
0659             err = (u_char *) SvPV(ERRSV, len);
0660             while (--len && (err[len] == CR || err[len] == LF)) { /* void */ }
0661 
0662             ngx_log_error(NGX_LOG_EMERG, log, 0,
0663                           "require_pv(\"%s\") failed: \"%*s\"",
0664                           script[i].data, len + 1, err);
0665 
0666             return NGX_ERROR;
0667         }
0668     }
0669 
0670     return NGX_OK;
0671 }
0672 
0673 
0674 static ngx_int_t
0675 ngx_http_perl_call_handler(pTHX_ ngx_http_request_t *r, HV *nginx, SV *sub,
0676     SV **args, ngx_str_t *handler, ngx_str_t *rv)
0677 {
0678     SV                *sv;
0679     int                n, status;
0680     char              *line;
0681     u_char            *err;
0682     STRLEN             len, n_a;
0683     ngx_uint_t         i;
0684     ngx_connection_t  *c;
0685 
0686     dSP;
0687 
0688     status = 0;
0689 
0690     ENTER;
0691     SAVETMPS;
0692 
0693     PUSHMARK(sp);
0694 
0695     sv = sv_2mortal(sv_bless(newRV_noinc(newSViv(PTR2IV(r))), nginx));
0696     XPUSHs(sv);
0697 
0698     if (args) {
0699         EXTEND(sp, (intptr_t) args[0]);
0700 
0701         for (i = 1; i <= (uintptr_t) args[0]; i++) {
0702             PUSHs(sv_2mortal(args[i]));
0703         }
0704     }
0705 
0706     PUTBACK;
0707 
0708     c = r->connection;
0709 
0710     n = call_sv(sub, G_EVAL);
0711 
0712     SPAGAIN;
0713 
0714     if (n) {
0715         if (rv == NULL) {
0716             status = POPi;
0717 
0718             ngx_log_debug1(NGX_LOG_DEBUG_HTTP, c->log, 0,
0719                            "call_sv: %d", status);
0720 
0721         } else {
0722             line = SvPVx(POPs, n_a);
0723             rv->len = n_a;
0724 
0725             rv->data = ngx_pnalloc(r->pool, n_a);
0726             if (rv->data == NULL) {
0727                 return NGX_ERROR;
0728             }
0729 
0730             ngx_memcpy(rv->data, line, n_a);
0731         }
0732     }
0733 
0734     PUTBACK;
0735 
0736     FREETMPS;
0737     LEAVE;
0738 
0739     /* check $@ */
0740 
0741     if (SvTRUE(ERRSV)) {
0742 
0743         err = (u_char *) SvPV(ERRSV, len);
0744         while (--len && (err[len] == CR || err[len] == LF)) { /* void */ }
0745 
0746         ngx_log_error(NGX_LOG_ERR, c->log, 0,
0747                       "call_sv(\"%V\") failed: \"%*s\"", handler, len + 1, err);
0748 
0749         if (rv) {
0750             return NGX_ERROR;
0751         }
0752 
0753         return NGX_HTTP_INTERNAL_SERVER_ERROR;
0754     }
0755 
0756     if (n != 1) {
0757         ngx_log_error(NGX_LOG_ALERT, c->log, 0,
0758                       "call_sv(\"%V\") returned %d results", handler, n);
0759         status = NGX_OK;
0760     }
0761 
0762     if (rv) {
0763         return NGX_OK;
0764     }
0765 
0766     return (ngx_int_t) status;
0767 }
0768 
0769 
0770 static void
0771 ngx_http_perl_eval_anon_sub(pTHX_ ngx_str_t *handler, SV **sv)
0772 {
0773     u_char  *p;
0774 
0775     for (p = handler->data; *p; p++) {
0776         if (*p != ' ' && *p != '\t' && *p != CR && *p != LF) {
0777             break;
0778         }
0779     }
0780 
0781     if (ngx_strncmp(p, "sub ", 4) == 0
0782         || ngx_strncmp(p, "sub{", 4) == 0
0783         || ngx_strncmp(p, "use ", 4) == 0)
0784     {
0785         *sv = eval_pv((char *) p, FALSE);
0786 
0787         /* eval_pv() does not set ERRSV on failure */
0788 
0789         return;
0790     }
0791 
0792     *sv = NULL;
0793 }
0794 
0795 
0796 static void *
0797 ngx_http_perl_create_main_conf(ngx_conf_t *cf)
0798 {
0799     ngx_http_perl_main_conf_t  *pmcf;
0800 
0801     pmcf = ngx_pcalloc(cf->pool, sizeof(ngx_http_perl_main_conf_t));
0802     if (pmcf == NULL) {
0803         return NULL;
0804     }
0805 
0806     pmcf->modules = NGX_CONF_UNSET_PTR;
0807     pmcf->requires = NGX_CONF_UNSET_PTR;
0808 
0809     return pmcf;
0810 }
0811 
0812 
0813 static char *
0814 ngx_http_perl_init_main_conf(ngx_conf_t *cf, void *conf)
0815 {
0816     ngx_http_perl_main_conf_t *pmcf = conf;
0817 
0818     if (pmcf->perl == NULL) {
0819         if (ngx_http_perl_init_interpreter(cf, pmcf) != NGX_CONF_OK) {
0820             return NGX_CONF_ERROR;
0821         }
0822     }
0823 
0824     return NGX_CONF_OK;
0825 }
0826 
0827 
0828 #if (NGX_HAVE_PERL_MULTIPLICITY)
0829 
0830 static void
0831 ngx_http_perl_cleanup_perl(void *data)
0832 {
0833     PerlInterpreter  *perl = data;
0834 
0835     PERL_SET_CONTEXT(perl);
0836     PERL_SET_INTERP(perl);
0837 
0838     (void) perl_destruct(perl);
0839 
0840     perl_free(perl);
0841 
0842     if (ngx_perl_term) {
0843         ngx_log_debug0(NGX_LOG_DEBUG_HTTP, ngx_cycle->log, 0, "perl term");
0844 
0845         PERL_SYS_TERM();
0846     }
0847 }
0848 
0849 #endif
0850 
0851 
0852 static ngx_int_t
0853 ngx_http_perl_preconfiguration(ngx_conf_t *cf)
0854 {
0855 #if (NGX_HTTP_SSI)
0856     ngx_int_t                  rc;
0857     ngx_http_ssi_main_conf_t  *smcf;
0858 
0859     smcf = ngx_http_conf_get_module_main_conf(cf, ngx_http_ssi_filter_module);
0860 
0861     rc = ngx_hash_add_key(&smcf->commands, &ngx_http_perl_ssi_command.name,
0862                           &ngx_http_perl_ssi_command, NGX_HASH_READONLY_KEY);
0863 
0864     if (rc != NGX_OK) {
0865         if (rc == NGX_BUSY) {
0866             ngx_conf_log_error(NGX_LOG_EMERG, cf, 0,
0867                                "conflicting SSI command \"%V\"",
0868                                &ngx_http_perl_ssi_command.name);
0869         }
0870 
0871         return NGX_ERROR;
0872     }
0873 #endif
0874 
0875     return NGX_OK;
0876 }
0877 
0878 
0879 static void *
0880 ngx_http_perl_create_loc_conf(ngx_conf_t *cf)
0881 {
0882     ngx_http_perl_loc_conf_t *plcf;
0883 
0884     plcf = ngx_pcalloc(cf->pool, sizeof(ngx_http_perl_loc_conf_t));
0885     if (plcf == NULL) {
0886         return NULL;
0887     }
0888 
0889     /*
0890      * set by ngx_pcalloc():
0891      *
0892      *     plcf->handler = { 0, NULL };
0893      */
0894 
0895     return plcf;
0896 }
0897 
0898 
0899 static char *
0900 ngx_http_perl_merge_loc_conf(ngx_conf_t *cf, void *parent, void *child)
0901 {
0902     ngx_http_perl_loc_conf_t *prev = parent;
0903     ngx_http_perl_loc_conf_t *conf = child;
0904 
0905     if (conf->sub == NULL) {
0906         conf->sub = prev->sub;
0907         conf->handler = prev->handler;
0908     }
0909 
0910     return NGX_CONF_OK;
0911 }
0912 
0913 
0914 static char *
0915 ngx_http_perl(ngx_conf_t *cf, ngx_command_t *cmd, void *conf)
0916 {
0917     ngx_http_perl_loc_conf_t *plcf = conf;
0918 
0919     ngx_str_t                  *value;
0920     ngx_http_core_loc_conf_t   *clcf;
0921     ngx_http_perl_main_conf_t  *pmcf;
0922 
0923     value = cf->args->elts;
0924 
0925     if (plcf->handler.data) {
0926         ngx_conf_log_error(NGX_LOG_EMERG, cf, 0,
0927                            "duplicate perl handler \"%V\"", &value[1]);
0928         return NGX_CONF_ERROR;
0929     }
0930 
0931     pmcf = ngx_http_conf_get_module_main_conf(cf, ngx_http_perl_module);
0932 
0933     if (pmcf->perl == NULL) {
0934         if (ngx_http_perl_init_interpreter(cf, pmcf) != NGX_CONF_OK) {
0935             return NGX_CONF_ERROR;
0936         }
0937     }
0938 
0939     plcf->handler = value[1];
0940 
0941     {
0942 
0943     dTHXa(pmcf->perl);
0944     PERL_SET_CONTEXT(pmcf->perl);
0945     PERL_SET_INTERP(pmcf->perl);
0946 
0947     ngx_http_perl_eval_anon_sub(aTHX_ &value[1], &plcf->sub);
0948 
0949     if (plcf->sub == &PL_sv_undef) {
0950         ngx_conf_log_error(NGX_LOG_ERR, cf, 0,
0951                            "eval_pv(\"%V\") failed", &value[1]);
0952         return NGX_CONF_ERROR;
0953     }
0954 
0955     if (plcf->sub == NULL) {
0956         plcf->sub = newSVpvn((char *) value[1].data, value[1].len);
0957     }
0958 
0959     }
0960 
0961     clcf = ngx_http_conf_get_module_loc_conf(cf, ngx_http_core_module);
0962     clcf->handler = ngx_http_perl_handler;
0963 
0964     return NGX_CONF_OK;
0965 }
0966 
0967 
0968 static char *
0969 ngx_http_perl_set(ngx_conf_t *cf, ngx_command_t *cmd, void *conf)
0970 {
0971     ngx_int_t                   index;
0972     ngx_str_t                  *value;
0973     ngx_http_variable_t        *v;
0974     ngx_http_perl_variable_t   *pv;
0975     ngx_http_perl_main_conf_t  *pmcf;
0976 
0977     value = cf->args->elts;
0978 
0979     if (value[1].data[0] != '$') {
0980         ngx_conf_log_error(NGX_LOG_EMERG, cf, 0,
0981                            "invalid variable name \"%V\"", &value[1]);
0982         return NGX_CONF_ERROR;
0983     }
0984 
0985     value[1].len--;
0986     value[1].data++;
0987 
0988     v = ngx_http_add_variable(cf, &value[1], NGX_HTTP_VAR_CHANGEABLE);
0989     if (v == NULL) {
0990         return NGX_CONF_ERROR;
0991     }
0992 
0993     pv = ngx_palloc(cf->pool, sizeof(ngx_http_perl_variable_t));
0994     if (pv == NULL) {
0995         return NGX_CONF_ERROR;
0996     }
0997 
0998     index = ngx_http_get_variable_index(cf, &value[1]);
0999     if (index == NGX_ERROR) {
1000         return NGX_CONF_ERROR;
1001     }
1002 
1003     pmcf = ngx_http_conf_get_module_main_conf(cf, ngx_http_perl_module);
1004 
1005     if (pmcf->perl == NULL) {
1006         if (ngx_http_perl_init_interpreter(cf, pmcf) != NGX_CONF_OK) {
1007             return NGX_CONF_ERROR;
1008         }
1009     }
1010 
1011     pv->handler = value[2];
1012 
1013     {
1014 
1015     dTHXa(pmcf->perl);
1016     PERL_SET_CONTEXT(pmcf->perl);
1017     PERL_SET_INTERP(pmcf->perl);
1018 
1019     ngx_http_perl_eval_anon_sub(aTHX_ &value[2], &pv->sub);
1020 
1021     if (pv->sub == &PL_sv_undef) {
1022         ngx_conf_log_error(NGX_LOG_ERR, cf, 0,
1023                            "eval_pv(\"%V\") failed", &value[2]);
1024         return NGX_CONF_ERROR;
1025     }
1026 
1027     if (pv->sub == NULL) {
1028         pv->sub = newSVpvn((char *) value[2].data, value[2].len);
1029     }
1030 
1031     }
1032 
1033     v->get_handler = ngx_http_perl_variable;
1034     v->data = (uintptr_t) pv;
1035 
1036     return NGX_CONF_OK;
1037 }
1038 
1039 
1040 static ngx_int_t
1041 ngx_http_perl_init_worker(ngx_cycle_t *cycle)
1042 {
1043     ngx_http_perl_main_conf_t  *pmcf;
1044 
1045     pmcf = ngx_http_cycle_get_module_main_conf(cycle, ngx_http_perl_module);
1046 
1047     if (pmcf) {
1048         dTHXa(pmcf->perl);
1049         PERL_SET_CONTEXT(pmcf->perl);
1050         PERL_SET_INTERP(pmcf->perl);
1051 
1052         /* set worker's $$ */
1053 
1054         sv_setiv(GvSV(gv_fetchpv("$", TRUE, SVt_PV)), (I32) ngx_pid);
1055     }
1056 
1057     return NGX_OK;
1058 }
1059 
1060 
1061 static void
1062 ngx_http_perl_exit(ngx_cycle_t *cycle)
1063 {
1064 #if (NGX_HAVE_PERL_MULTIPLICITY)
1065 
1066     /*
1067      * the master exit hook is run before global pool cleanup,
1068      * therefore just set flag here
1069      */
1070 
1071     ngx_perl_term = 1;
1072 
1073 #else
1074 
1075     if (nginx_stash) {
1076         ngx_log_debug0(NGX_LOG_DEBUG_HTTP, cycle->log, 0, "perl term");
1077 
1078         (void) perl_destruct(perl);
1079 
1080         perl_free(perl);
1081 
1082         PERL_SYS_TERM();
1083     }
1084 
1085 #endif
1086 }