src/http/modules/perl/ngx_http_perl_module.c - nginx-1.31.4 nginx/ @ 8d9666701

Global variables defined

Data types defined

Functions defined

Macros defined

Source code


  1. /*
  2. * Copyright (C) Igor Sysoev
  3. * Copyright (C) Nginx, Inc.
  4. */


  5. #include <ngx_config.h>
  6. #include <ngx_core.h>
  7. #include <ngx_http.h>
  8. #include <ngx_http_perl_module.h>


  9. typedef struct {
  10.     PerlInterpreter   *perl;
  11.     HV                *nginx;
  12.     ngx_array_t       *modules;
  13.     ngx_array_t       *requires;
  14. } ngx_http_perl_main_conf_t;


  15. typedef struct {
  16.     SV                *sub;
  17.     ngx_str_t          handler;
  18. } ngx_http_perl_loc_conf_t;


  19. typedef struct {
  20.     SV                *sub;
  21.     ngx_str_t          handler;
  22. } ngx_http_perl_variable_t;


  23. #if (NGX_HTTP_SSI)
  24. static ngx_int_t ngx_http_perl_ssi(ngx_http_request_t *r,
  25.     ngx_http_ssi_ctx_t *ssi_ctx, ngx_str_t **params);
  26. #endif

  27. static char *ngx_http_perl_init_interpreter(ngx_conf_t *cf,
  28.     ngx_http_perl_main_conf_t *pmcf);
  29. static PerlInterpreter *ngx_http_perl_create_interpreter(ngx_conf_t *cf,
  30.     ngx_http_perl_main_conf_t *pmcf);
  31. static ngx_int_t ngx_http_perl_run_requires(pTHX_ ngx_array_t *requires,
  32.     ngx_log_t *log);
  33. static ngx_int_t ngx_http_perl_call_handler(pTHX_ ngx_http_request_t *r,
  34.     ngx_http_perl_ctx_t *ctx, HV *nginx, SV *sub, SV **args,
  35.     ngx_str_t *handler, ngx_str_t *rv);
  36. static void ngx_http_perl_eval_anon_sub(pTHX_ ngx_str_t *handler, SV **sv);

  37. static ngx_int_t ngx_http_perl_preconfiguration(ngx_conf_t *cf);
  38. static void *ngx_http_perl_create_main_conf(ngx_conf_t *cf);
  39. static char *ngx_http_perl_init_main_conf(ngx_conf_t *cf, void *conf);
  40. static void *ngx_http_perl_create_loc_conf(ngx_conf_t *cf);
  41. static char *ngx_http_perl_merge_loc_conf(ngx_conf_t *cf, void *parent,
  42.     void *child);
  43. static char *ngx_http_perl(ngx_conf_t *cf, ngx_command_t *cmd, void *conf);
  44. static char *ngx_http_perl_set(ngx_conf_t *cf, ngx_command_t *cmd, void *conf);

  45. #if (NGX_HAVE_PERL_MULTIPLICITY)
  46. static void ngx_http_perl_cleanup_perl(void *data);
  47. #endif

  48. static ngx_int_t ngx_http_perl_init_worker(ngx_cycle_t *cycle);
  49. static void ngx_http_perl_exit(ngx_cycle_t *cycle);


  50. static ngx_command_t  ngx_http_perl_commands[] = {

  51.     { ngx_string("perl_modules"),
  52.       NGX_HTTP_MAIN_CONF|NGX_CONF_TAKE1,
  53.       ngx_conf_set_str_array_slot,
  54.       NGX_HTTP_MAIN_CONF_OFFSET,
  55.       offsetof(ngx_http_perl_main_conf_t, modules),
  56.       NULL },

  57.     { ngx_string("perl_require"),
  58.       NGX_HTTP_MAIN_CONF|NGX_CONF_TAKE1,
  59.       ngx_conf_set_str_array_slot,
  60.       NGX_HTTP_MAIN_CONF_OFFSET,
  61.       offsetof(ngx_http_perl_main_conf_t, requires),
  62.       NULL },

  63.     { ngx_string("perl"),
  64.       NGX_HTTP_LOC_CONF|NGX_HTTP_LMT_CONF|NGX_CONF_TAKE1,
  65.       ngx_http_perl,
  66.       NGX_HTTP_LOC_CONF_OFFSET,
  67.       0,
  68.       NULL },

  69.     { ngx_string("perl_set"),
  70.       NGX_HTTP_MAIN_CONF|NGX_CONF_TAKE2,
  71.       ngx_http_perl_set,
  72.       NGX_HTTP_LOC_CONF_OFFSET,
  73.       0,
  74.       NULL },

  75.       ngx_null_command
  76. };


  77. static ngx_http_module_t  ngx_http_perl_module_ctx = {
  78.     ngx_http_perl_preconfiguration,        /* preconfiguration */
  79.     NULL,                                  /* postconfiguration */

  80.     ngx_http_perl_create_main_conf,        /* create main configuration */
  81.     ngx_http_perl_init_main_conf,          /* init main configuration */

  82.     NULL,                                  /* create server configuration */
  83.     NULL,                                  /* merge server configuration */

  84.     ngx_http_perl_create_loc_conf,         /* create location configuration */
  85.     ngx_http_perl_merge_loc_conf           /* merge location configuration */
  86. };


  87. ngx_module_t  ngx_http_perl_module = {
  88.     NGX_MODULE_V1,
  89.     &ngx_http_perl_module_ctx,             /* module context */
  90.     ngx_http_perl_commands,                /* module directives */
  91.     NGX_HTTP_MODULE,                       /* module type */
  92.     NULL,                                  /* init master */
  93.     NULL,                                  /* init module */
  94.     ngx_http_perl_init_worker,             /* init process */
  95.     NULL,                                  /* init thread */
  96.     NULL,                                  /* exit thread */
  97.     NULL,                                  /* exit process */
  98.     ngx_http_perl_exit,                    /* exit master */
  99.     NGX_MODULE_V1_PADDING
  100. };


  101. #if (NGX_HTTP_SSI)

  102. #define NGX_HTTP_PERL_SSI_SUB  0
  103. #define NGX_HTTP_PERL_SSI_ARG  1


  104. static ngx_http_ssi_param_t  ngx_http_perl_ssi_params[] = {
  105.     { ngx_string("sub"), NGX_HTTP_PERL_SSI_SUB, 1, 0 },
  106.     { ngx_string("arg"), NGX_HTTP_PERL_SSI_ARG, 0, 1 },
  107.     { ngx_null_string, 0, 0, 0 }
  108. };

  109. static ngx_http_ssi_command_t  ngx_http_perl_ssi_command = {
  110.     ngx_string("perl"), ngx_http_perl_ssi, ngx_http_perl_ssi_params, 0, 0, 1
  111. };

  112. #endif


  113. ngx_http_perl_ctx_t     *ngx_http_perl_active_context;


  114. static ngx_str_t         ngx_null_name = ngx_null_string;
  115. static HV               *nginx_stash;

  116. #if (NGX_HAVE_PERL_MULTIPLICITY)
  117. static ngx_uint_t        ngx_perl_term;
  118. #else
  119. static PerlInterpreter  *perl;
  120. #endif


  121. static void
  122. ngx_http_perl_xs_init(pTHX)
  123. {
  124.     newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, __FILE__);

  125.     nginx_stash = gv_stashpv("nginx", TRUE);
  126. }


  127. static ngx_int_t
  128. ngx_http_perl_handler(ngx_http_request_t *r)
  129. {
  130.     r->main->count++;

  131.     ngx_http_perl_handle_request(r);

  132.     return NGX_DONE;
  133. }


  134. void
  135. ngx_http_perl_handle_request(ngx_http_request_t *r)
  136. {
  137.     SV                         *sub;
  138.     ngx_int_t                   rc;
  139.     ngx_str_t                   uri, args, *handler;
  140.     ngx_uint_t                  flags;
  141.     ngx_http_perl_ctx_t        *ctx;
  142.     ngx_http_perl_loc_conf_t   *plcf;
  143.     ngx_http_perl_main_conf_t  *pmcf;

  144.     ngx_log_debug0(NGX_LOG_DEBUG_HTTP, r->connection->log, 0, "perl handler");

  145.     ctx = ngx_http_get_module_ctx(r, ngx_http_perl_module);

  146.     if (ctx == NULL) {
  147.         ctx = ngx_pcalloc(r->pool, sizeof(ngx_http_perl_ctx_t));
  148.         if (ctx == NULL) {
  149.             ngx_http_finalize_request(r, NGX_ERROR);
  150.             return;
  151.         }

  152.         ngx_http_set_ctx(r, ctx, ngx_http_perl_module);

  153.         ctx->request = r;
  154.     }

  155.     pmcf = ngx_http_get_module_main_conf(r, ngx_http_perl_module);

  156.     {

  157.     dTHXa(pmcf->perl);
  158.     PERL_SET_CONTEXT(pmcf->perl);
  159.     PERL_SET_INTERP(pmcf->perl);

  160.     if (ctx->next == NULL) {
  161.         plcf = ngx_http_get_module_loc_conf(r, ngx_http_perl_module);
  162.         sub = plcf->sub;
  163.         handler = &plcf->handler;

  164.     } else {
  165.         sub = ctx->next;
  166.         handler = &ngx_null_name;
  167.         ctx->next = NULL;
  168.     }

  169.     rc = ngx_http_perl_call_handler(aTHX_ r, ctx, pmcf->nginx, sub, NULL,
  170.                                     handler, NULL);

  171.     }

  172.     ngx_log_debug1(NGX_LOG_DEBUG_HTTP, r->connection->log, 0,
  173.                    "perl handler done: %i", rc);

  174.     if (rc > 600) {
  175.         rc = NGX_OK;
  176.     }

  177.     if (ctx->redirect_uri.len) {
  178.         uri = ctx->redirect_uri;

  179.     } else {
  180.         uri.len = 0;
  181.     }

  182.     ctx->filename.data = NULL;
  183.     ctx->redirect_uri.len = 0;

  184.     if (rc == NGX_ERROR) {
  185.         ngx_http_finalize_request(r, rc);
  186.         return;
  187.     }

  188.     if (ctx->done || ctx->next) {
  189.         ngx_http_finalize_request(r, NGX_DONE);
  190.         return;
  191.     }

  192.     if (uri.len) {
  193.         if (uri.data[0] == '@') {
  194.             ngx_http_named_location(r, &uri);

  195.         } else {
  196.             ngx_str_null(&args);
  197.             flags = NGX_HTTP_LOG_UNSAFE;

  198.             if (ngx_http_parse_unsafe_uri(r, &uri, &args, &flags) != NGX_OK) {
  199.                 ngx_http_finalize_request(r, NGX_HTTP_INTERNAL_SERVER_ERROR);
  200.                 return;
  201.             }

  202.             ngx_http_internal_redirect(r, &uri, &args);
  203.         }

  204.         ngx_http_finalize_request(r, NGX_DONE);
  205.         return;
  206.     }

  207.     if (rc == NGX_OK || rc == NGX_HTTP_OK) {
  208.         ngx_http_send_special(r, NGX_HTTP_LAST);
  209.         ctx->done = 1;
  210.     }

  211.     ngx_http_finalize_request(r, rc);
  212. }


  213. void
  214. ngx_http_perl_sleep_handler(ngx_http_request_t *r)
  215. {
  216.     ngx_event_t  *wev;

  217.     ngx_log_debug0(NGX_LOG_DEBUG_HTTP, r->connection->log, 0,
  218.                    "perl sleep handler");

  219.     wev = r->connection->write;

  220.     if (wev->delayed) {

  221.         if (ngx_handle_write_event(wev, 0) != NGX_OK) {
  222.             ngx_http_finalize_request(r, NGX_HTTP_INTERNAL_SERVER_ERROR);
  223.         }

  224.         return;
  225.     }

  226.     ngx_http_perl_handle_request(r);
  227. }


  228. void
  229. ngx_http_perl_refcount_cleanup(void *data)
  230. {
  231.     ngx_http_perl_cleanup_t  *clnp = data;

  232.     ngx_http_request_t         *r;
  233.     ngx_http_perl_main_conf_t  *pmcf;

  234.     r = clnp->request;
  235.     pmcf = ngx_http_get_module_main_conf(r, ngx_http_perl_module);

  236.     {

  237.     dTHXa(pmcf->perl);
  238.     PERL_SET_CONTEXT(pmcf->perl);
  239.     PERL_SET_INTERP(pmcf->perl);

  240.     SvREFCNT_dec(clnp->sv);

  241.     }
  242. }


  243. static ngx_int_t
  244. ngx_http_perl_variable(ngx_http_request_t *r, ngx_http_variable_value_t *v,
  245.     uintptr_t data)
  246. {
  247.     ngx_http_perl_variable_t *pv = (ngx_http_perl_variable_t *) data;

  248.     ngx_int_t                   rc;
  249.     ngx_str_t                   value;
  250.     ngx_uint_t                  saved;
  251.     ngx_http_perl_ctx_t        *ctx;
  252.     ngx_http_perl_main_conf_t  *pmcf;

  253.     ngx_log_debug0(NGX_LOG_DEBUG_HTTP, r->connection->log, 0,
  254.                    "perl variable handler");

  255.     ctx = ngx_http_get_module_ctx(r, ngx_http_perl_module);

  256.     if (ctx == NULL) {
  257.         ctx = ngx_pcalloc(r->pool, sizeof(ngx_http_perl_ctx_t));
  258.         if (ctx == NULL) {
  259.             return NGX_ERROR;
  260.         }

  261.         ngx_http_set_ctx(r, ctx, ngx_http_perl_module);

  262.         ctx->request = r;
  263.     }

  264.     saved = ctx->variable;
  265.     ctx->variable = 1;

  266.     pmcf = ngx_http_get_module_main_conf(r, ngx_http_perl_module);

  267.     value.data = NULL;

  268.     {

  269.     dTHXa(pmcf->perl);
  270.     PERL_SET_CONTEXT(pmcf->perl);
  271.     PERL_SET_INTERP(pmcf->perl);

  272.     rc = ngx_http_perl_call_handler(aTHX_ r, ctx, pmcf->nginx, pv->sub, NULL,
  273.                                     &pv->handler, &value);

  274.     }

  275.     if (value.data) {
  276.         v->len = value.len;
  277.         v->valid = 1;
  278.         v->no_cacheable = 0;
  279.         v->not_found = 0;
  280.         v->data = value.data;

  281.     } else {
  282.         v->not_found = 1;
  283.     }

  284.     ctx->variable = saved;
  285.     ctx->filename.data = NULL;
  286.     ctx->redirect_uri.len = 0;

  287.     ngx_log_debug0(NGX_LOG_DEBUG_HTTP, r->connection->log, 0,
  288.                    "perl variable done");

  289.     return rc;
  290. }


  291. #if (NGX_HTTP_SSI)

  292. static ngx_int_t
  293. ngx_http_perl_ssi(ngx_http_request_t *r, ngx_http_ssi_ctx_t *ssi_ctx,
  294.     ngx_str_t **params)
  295. {
  296.     SV                         *sv, **asv;
  297.     ngx_int_t                   rc;
  298.     ngx_str_t                  *handler, **args;
  299.     ngx_uint_t                  i;
  300.     ngx_http_perl_ctx_t        *ctx;
  301.     ngx_http_perl_main_conf_t  *pmcf;

  302.     ngx_log_debug0(NGX_LOG_DEBUG_HTTP, r->connection->log, 0,
  303.                    "perl ssi handler");

  304.     ctx = ngx_http_get_module_ctx(r, ngx_http_perl_module);

  305.     if (ctx == NULL) {
  306.         ctx = ngx_pcalloc(r->pool, sizeof(ngx_http_perl_ctx_t));
  307.         if (ctx == NULL) {
  308.             return NGX_ERROR;
  309.         }

  310.         ngx_http_set_ctx(r, ctx, ngx_http_perl_module);

  311.         ctx->request = r;
  312.     }

  313.     pmcf = ngx_http_get_module_main_conf(r, ngx_http_perl_module);

  314.     ctx->ssi = ssi_ctx;
  315.     ctx->header_sent = 1;

  316.     handler = params[NGX_HTTP_PERL_SSI_SUB];
  317.     handler->data[handler->len] = '\0';

  318.     {

  319.     dTHXa(pmcf->perl);
  320.     PERL_SET_CONTEXT(pmcf->perl);
  321.     PERL_SET_INTERP(pmcf->perl);

  322. #if 0

  323.     /* the code is disabled to force the precompiled perl code using only */

  324.     ngx_http_perl_eval_anon_sub(aTHX_ handler, &sv);

  325.     if (sv == &PL_sv_undef) {
  326.         ngx_log_error(NGX_LOG_ERR, r->connection->log, 0,
  327.                       "eval_pv(\"%V\") failed", handler);
  328.         return NGX_ERROR;
  329.     }

  330.     if (sv == NULL) {
  331.         sv = newSVpvn((char *) handler->data, handler->len);
  332.     }

  333. #endif

  334.     sv = newSVpvn((char *) handler->data, handler->len);

  335.     args = &params[NGX_HTTP_PERL_SSI_ARG];

  336.     if (args[0]) {

  337.         for (i = 0; args[i]; i++) { /* void */ }

  338.         asv = ngx_pcalloc(r->pool, (i + 1) * sizeof(SV *));

  339.         if (asv == NULL) {
  340.             SvREFCNT_dec(sv);
  341.             return NGX_ERROR;
  342.         }

  343.         asv[0] = (SV *) (uintptr_t) i;

  344.         for (i = 0; args[i]; i++) {
  345.             asv[i + 1] = newSVpvn((char *) args[i]->data, args[i]->len);
  346.         }

  347.     } else {
  348.         asv = NULL;
  349.     }

  350.     rc = ngx_http_perl_call_handler(aTHX_ r, ctx, pmcf->nginx, sv, asv,
  351.                                     handler, NULL);

  352.     SvREFCNT_dec(sv);

  353.     }

  354.     ctx->filename.data = NULL;
  355.     ctx->redirect_uri.len = 0;
  356.     ctx->ssi = NULL;

  357.     ngx_log_debug0(NGX_LOG_DEBUG_HTTP, r->connection->log, 0, "perl ssi done");

  358.     return rc;
  359. }

  360. #endif


  361. static char *
  362. ngx_http_perl_init_interpreter(ngx_conf_t *cf, ngx_http_perl_main_conf_t *pmcf)
  363. {
  364.     ngx_str_t           *m;
  365.     ngx_uint_t           i;
  366. #if (NGX_HAVE_PERL_MULTIPLICITY)
  367.     ngx_pool_cleanup_t  *cln;

  368.     cln = ngx_pool_cleanup_add(cf->pool, 0);
  369.     if (cln == NULL) {
  370.         return NGX_CONF_ERROR;
  371.     }

  372. #endif

  373. #ifdef NGX_PERL_MODULES
  374.     if (pmcf->modules == NGX_CONF_UNSET_PTR) {

  375.         pmcf->modules = ngx_array_create(cf->pool, 1, sizeof(ngx_str_t));
  376.         if (pmcf->modules == NULL) {
  377.             return NGX_CONF_ERROR;
  378.         }

  379.         m = ngx_array_push(pmcf->modules);
  380.         if (m == NULL) {
  381.             return NGX_CONF_ERROR;
  382.         }

  383.         ngx_str_set(m, NGX_PERL_MODULES);
  384.     }
  385. #endif

  386.     if (pmcf->modules != NGX_CONF_UNSET_PTR) {
  387.         m = pmcf->modules->elts;
  388.         for (i = 0; i < pmcf->modules->nelts; i++) {
  389.             if (ngx_conf_full_name(cf->cycle, &m[i], 0) != NGX_OK) {
  390.                 return NGX_CONF_ERROR;
  391.             }
  392.         }
  393.     }

  394. #if !(NGX_HAVE_PERL_MULTIPLICITY)

  395.     if (perl) {

  396.         if (ngx_set_environment(cf->cycle, NULL) == NULL) {
  397.             return NGX_CONF_ERROR;
  398.         }

  399.         if (ngx_http_perl_run_requires(aTHX_ pmcf->requires, cf->log)
  400.             != NGX_OK)
  401.         {
  402.             return NGX_CONF_ERROR;
  403.         }

  404.         pmcf->perl = perl;
  405.         pmcf->nginx = nginx_stash;

  406.         return NGX_CONF_OK;
  407.     }

  408. #endif

  409.     if (nginx_stash == NULL) {
  410.         PERL_SYS_INIT(&ngx_argc, &ngx_argv);
  411.     }

  412.     pmcf->perl = ngx_http_perl_create_interpreter(cf, pmcf);

  413.     if (pmcf->perl == NULL) {
  414.         return NGX_CONF_ERROR;
  415.     }

  416.     pmcf->nginx = nginx_stash;

  417. #if (NGX_HAVE_PERL_MULTIPLICITY)

  418.     cln->handler = ngx_http_perl_cleanup_perl;
  419.     cln->data = pmcf->perl;

  420. #else

  421.     perl = pmcf->perl;

  422. #endif

  423.     return NGX_CONF_OK;
  424. }


  425. static PerlInterpreter *
  426. ngx_http_perl_create_interpreter(ngx_conf_t *cf,
  427.     ngx_http_perl_main_conf_t *pmcf)
  428. {
  429.     int                n;
  430.     STRLEN             len;
  431.     SV                *sv;
  432.     char              *ver, **embedding;
  433.     ngx_str_t         *m;
  434.     ngx_uint_t         i;
  435.     PerlInterpreter   *perl;

  436.     ngx_log_debug0(NGX_LOG_DEBUG_HTTP, cf->log, 0, "create perl interpreter");

  437.     if (ngx_set_environment(cf->cycle, NULL) == NULL) {
  438.         return NULL;
  439.     }

  440.     perl = perl_alloc();
  441.     if (perl == NULL) {
  442.         ngx_log_error(NGX_LOG_ALERT, cf->log, 0, "perl_alloc() failed");
  443.         return NULL;
  444.     }

  445.     {

  446.     dTHXa(perl);
  447.     PERL_SET_CONTEXT(perl);
  448.     PERL_SET_INTERP(perl);

  449.     perl_construct(perl);

  450. #ifdef PERL_EXIT_DESTRUCT_END
  451.     PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
  452. #endif

  453.     n = (pmcf->modules != NGX_CONF_UNSET_PTR) ? pmcf->modules->nelts * 2 : 0;

  454.     embedding = ngx_palloc(cf->pool, (5 + n) * sizeof(char *));
  455.     if (embedding == NULL) {
  456.         goto fail;
  457.     }

  458.     embedding[0] = "";

  459.     if (n++) {
  460.         m = pmcf->modules->elts;
  461.         for (i = 0; i < pmcf->modules->nelts; i++) {
  462.             embedding[2 * i + 1] = "-I";
  463.             embedding[2 * i + 2] = (char *) m[i].data;
  464.         }
  465.     }

  466.     embedding[n++] = "-Mnginx";
  467.     embedding[n++] = "-e";
  468.     embedding[n++] = "0";
  469.     embedding[n] = NULL;

  470.     n = perl_parse(perl, ngx_http_perl_xs_init, n, embedding, NULL);

  471.     if (n != 0) {
  472.         ngx_log_error(NGX_LOG_ALERT, cf->log, 0, "perl_parse() failed: %d", n);
  473.         goto fail;
  474.     }

  475.     sv = get_sv("nginx::VERSION", FALSE);
  476.     ver = SvPV(sv, len);

  477.     if (ngx_strcmp(ver, NGINX_VERSION) != 0) {
  478.         ngx_log_error(NGX_LOG_ALERT, cf->log, 0,
  479.                       "version " NGINX_VERSION " of nginx.pm is required, "
  480.                       "but %s was found", ver);
  481.         goto fail;
  482.     }

  483.     if (ngx_http_perl_run_requires(aTHX_ pmcf->requires, cf->log) != NGX_OK) {
  484.         goto fail;
  485.     }

  486.     }

  487.     return perl;

  488. fail:

  489.     (void) perl_destruct(perl);

  490.     perl_free(perl);

  491.     return NULL;
  492. }


  493. static ngx_int_t
  494. ngx_http_perl_run_requires(pTHX_ ngx_array_t *requires, ngx_log_t *log)
  495. {
  496.     u_char      *err;
  497.     STRLEN       len;
  498.     ngx_str_t   *script;
  499.     ngx_uint_t   i;

  500.     if (requires == NGX_CONF_UNSET_PTR) {
  501.         return NGX_OK;
  502.     }

  503.     script = requires->elts;
  504.     for (i = 0; i < requires->nelts; i++) {

  505.         require_pv((char *) script[i].data);

  506.         if (SvTRUE(ERRSV)) {

  507.             err = (u_char *) SvPV(ERRSV, len);
  508.             while (--len && (err[len] == CR || err[len] == LF)) { /* void */ }

  509.             ngx_log_error(NGX_LOG_EMERG, log, 0,
  510.                           "require_pv(\"%s\") failed: \"%*s\"",
  511.                           script[i].data, len + 1, err);

  512.             return NGX_ERROR;
  513.         }
  514.     }

  515.     return NGX_OK;
  516. }


  517. static ngx_int_t
  518. ngx_http_perl_call_handler(pTHX_ ngx_http_request_t *r,
  519.     ngx_http_perl_ctx_t *ctx, HV *nginx, SV *sub, SV **args,
  520.     ngx_str_t *handler, ngx_str_t *rv)
  521. {
  522.     SV                *sv;
  523.     int                n, status;
  524.     char              *line;
  525.     u_char            *err;
  526.     STRLEN             len, n_a;
  527.     ngx_uint_t         i;
  528.     ngx_connection_t  *c;

  529.     dSP;

  530.     status = 0;

  531.     ctx->error = 0;
  532.     ctx->status = NGX_OK;

  533.     ENTER;
  534.     SAVETMPS;

  535.     PUSHMARK(sp);

  536.     ngx_http_perl_active_context = ctx;

  537.     sv = sv_2mortal(sv_bless(newRV_noinc(newSViv(PTR2IV(ctx))), nginx));
  538.     XPUSHs(sv);

  539.     if (args) {
  540.         EXTEND(sp, (intptr_t) args[0]);

  541.         for (i = 1; i <= (uintptr_t) args[0]; i++) {
  542.             PUSHs(sv_2mortal(args[i]));
  543.         }
  544.     }

  545.     PUTBACK;

  546.     c = r->connection;

  547.     n = call_sv(sub, G_EVAL);

  548.     SPAGAIN;

  549.     if (n) {
  550.         if (rv == NULL) {
  551.             status = POPi;

  552.             ngx_log_debug1(NGX_LOG_DEBUG_HTTP, c->log, 0,
  553.                            "call_sv: %d", status);

  554.         } else {
  555.             line = SvPVx(POPs, n_a);
  556.             rv->len = n_a;

  557.             rv->data = ngx_pnalloc(r->pool, n_a);
  558.             if (rv->data == NULL) {
  559.                 return NGX_ERROR;
  560.             }

  561.             ngx_memcpy(rv->data, line, n_a);
  562.         }
  563.     }

  564.     PUTBACK;

  565.     FREETMPS;
  566.     LEAVE;

  567.     ngx_http_perl_active_context = NULL;

  568.     if (ctx->error) {

  569.         ngx_log_debug1(NGX_LOG_DEBUG_HTTP, c->log, 0,
  570.                        "call_sv: error, %d", ctx->status);

  571.         if (ctx->status != NGX_OK) {
  572.             return ctx->status;
  573.         }

  574.         return NGX_ERROR;
  575.     }

  576.     /* check $@ */

  577.     if (SvTRUE(ERRSV)) {

  578.         err = (u_char *) SvPV(ERRSV, len);
  579.         while (--len && (err[len] == CR || err[len] == LF)) { /* void */ }

  580.         ngx_log_error(NGX_LOG_ERR, c->log, 0,
  581.                       "call_sv(\"%V\") failed: \"%*s\"", handler, len + 1, err);

  582.         if (rv) {
  583.             return NGX_ERROR;
  584.         }

  585.         ctx->redirect_uri.len = 0;

  586.         if (ctx->header_sent) {
  587.             return NGX_ERROR;
  588.         }

  589.         return NGX_HTTP_INTERNAL_SERVER_ERROR;
  590.     }

  591.     if (n != 1) {
  592.         ngx_log_error(NGX_LOG_ALERT, c->log, 0,
  593.                       "call_sv(\"%V\") returned %d results", handler, n);
  594.         status = NGX_OK;
  595.     }

  596.     if (rv) {
  597.         return NGX_OK;
  598.     }

  599.     return (ngx_int_t) status;
  600. }


  601. static void
  602. ngx_http_perl_eval_anon_sub(pTHX_ ngx_str_t *handler, SV **sv)
  603. {
  604.     u_char  *p;

  605.     for (p = handler->data; *p; p++) {
  606.         if (*p != ' ' && *p != '\t' && *p != CR && *p != LF) {
  607.             break;
  608.         }
  609.     }

  610.     if (ngx_strncmp(p, "sub ", 4) == 0
  611.         || ngx_strncmp(p, "sub{", 4) == 0
  612.         || ngx_strncmp(p, "use ", 4) == 0)
  613.     {
  614.         *sv = eval_pv((char *) p, FALSE);

  615.         /* eval_pv() does not set ERRSV on failure */

  616.         return;
  617.     }

  618.     *sv = NULL;
  619. }


  620. static void *
  621. ngx_http_perl_create_main_conf(ngx_conf_t *cf)
  622. {
  623.     ngx_http_perl_main_conf_t  *pmcf;

  624.     pmcf = ngx_pcalloc(cf->pool, sizeof(ngx_http_perl_main_conf_t));
  625.     if (pmcf == NULL) {
  626.         return NULL;
  627.     }

  628.     pmcf->modules = NGX_CONF_UNSET_PTR;
  629.     pmcf->requires = NGX_CONF_UNSET_PTR;

  630.     return pmcf;
  631. }


  632. static char *
  633. ngx_http_perl_init_main_conf(ngx_conf_t *cf, void *conf)
  634. {
  635.     ngx_http_perl_main_conf_t *pmcf = conf;

  636.     if (pmcf->perl == NULL) {
  637.         if (ngx_http_perl_init_interpreter(cf, pmcf) != NGX_CONF_OK) {
  638.             return NGX_CONF_ERROR;
  639.         }
  640.     }

  641.     return NGX_CONF_OK;
  642. }


  643. #if (NGX_HAVE_PERL_MULTIPLICITY)

  644. static void
  645. ngx_http_perl_cleanup_perl(void *data)
  646. {
  647.     PerlInterpreter  *perl = data;

  648.     PERL_SET_CONTEXT(perl);
  649.     PERL_SET_INTERP(perl);

  650.     (void) perl_destruct(perl);

  651.     perl_free(perl);

  652.     if (ngx_perl_term) {
  653.         ngx_log_debug0(NGX_LOG_DEBUG_HTTP, ngx_cycle->log, 0, "perl term");

  654.         PERL_SYS_TERM();
  655.     }
  656. }

  657. #endif


  658. static ngx_int_t
  659. ngx_http_perl_preconfiguration(ngx_conf_t *cf)
  660. {
  661. #if (NGX_HTTP_SSI)
  662.     ngx_int_t                  rc;
  663.     ngx_http_ssi_main_conf_t  *smcf;

  664.     smcf = ngx_http_conf_get_module_main_conf(cf, ngx_http_ssi_filter_module);

  665.     rc = ngx_hash_add_key(&smcf->commands, &ngx_http_perl_ssi_command.name,
  666.                           &ngx_http_perl_ssi_command, NGX_HASH_READONLY_KEY);

  667.     if (rc != NGX_OK) {
  668.         if (rc == NGX_BUSY) {
  669.             ngx_conf_log_error(NGX_LOG_EMERG, cf, 0,
  670.                                "conflicting SSI command \"%V\"",
  671.                                &ngx_http_perl_ssi_command.name);
  672.         }

  673.         return NGX_ERROR;
  674.     }
  675. #endif

  676.     return NGX_OK;
  677. }


  678. static void *
  679. ngx_http_perl_create_loc_conf(ngx_conf_t *cf)
  680. {
  681.     ngx_http_perl_loc_conf_t *plcf;

  682.     plcf = ngx_pcalloc(cf->pool, sizeof(ngx_http_perl_loc_conf_t));
  683.     if (plcf == NULL) {
  684.         return NULL;
  685.     }

  686.     /*
  687.      * set by ngx_pcalloc():
  688.      *
  689.      *     plcf->handler = { 0, NULL };
  690.      */

  691.     return plcf;
  692. }


  693. static char *
  694. ngx_http_perl_merge_loc_conf(ngx_conf_t *cf, void *parent, void *child)
  695. {
  696.     ngx_http_perl_loc_conf_t *prev = parent;
  697.     ngx_http_perl_loc_conf_t *conf = child;

  698.     if (conf->sub == NULL) {
  699.         conf->sub = prev->sub;
  700.         conf->handler = prev->handler;
  701.     }

  702.     return NGX_CONF_OK;
  703. }


  704. static char *
  705. ngx_http_perl(ngx_conf_t *cf, ngx_command_t *cmd, void *conf)
  706. {
  707.     ngx_http_perl_loc_conf_t *plcf = conf;

  708.     ngx_str_t                  *value;
  709.     ngx_http_core_loc_conf_t   *clcf;
  710.     ngx_http_perl_main_conf_t  *pmcf;

  711.     value = cf->args->elts;

  712.     if (plcf->handler.data) {
  713.         ngx_conf_log_error(NGX_LOG_EMERG, cf, 0,
  714.                            "duplicate perl handler \"%V\"", &value[1]);
  715.         return NGX_CONF_ERROR;
  716.     }

  717.     pmcf = ngx_http_conf_get_module_main_conf(cf, ngx_http_perl_module);

  718.     if (pmcf->perl == NULL) {
  719.         if (ngx_http_perl_init_interpreter(cf, pmcf) != NGX_CONF_OK) {
  720.             return NGX_CONF_ERROR;
  721.         }
  722.     }

  723.     plcf->handler = value[1];

  724.     {

  725.     dTHXa(pmcf->perl);
  726.     PERL_SET_CONTEXT(pmcf->perl);
  727.     PERL_SET_INTERP(pmcf->perl);

  728.     ngx_http_perl_eval_anon_sub(aTHX_ &value[1], &plcf->sub);

  729.     if (plcf->sub == &PL_sv_undef) {
  730.         ngx_conf_log_error(NGX_LOG_ERR, cf, 0,
  731.                            "eval_pv(\"%V\") failed", &value[1]);
  732.         return NGX_CONF_ERROR;
  733.     }

  734.     if (plcf->sub == NULL) {
  735.         plcf->sub = newSVpvn((char *) value[1].data, value[1].len);
  736.     }

  737.     }

  738.     clcf = ngx_http_conf_get_module_loc_conf(cf, ngx_http_core_module);
  739.     clcf->handler = ngx_http_perl_handler;

  740.     return NGX_CONF_OK;
  741. }


  742. static char *
  743. ngx_http_perl_set(ngx_conf_t *cf, ngx_command_t *cmd, void *conf)
  744. {
  745.     ngx_int_t                   index;
  746.     ngx_str_t                  *value;
  747.     ngx_http_variable_t        *v;
  748.     ngx_http_perl_variable_t   *pv;
  749.     ngx_http_perl_main_conf_t  *pmcf;

  750.     value = cf->args->elts;

  751.     if (value[1].data[0] != '$') {
  752.         ngx_conf_log_error(NGX_LOG_EMERG, cf, 0,
  753.                            "invalid variable name \"%V\"", &value[1]);
  754.         return NGX_CONF_ERROR;
  755.     }

  756.     value[1].len--;
  757.     value[1].data++;

  758.     v = ngx_http_add_variable(cf, &value[1], NGX_HTTP_VAR_CHANGEABLE);
  759.     if (v == NULL) {
  760.         return NGX_CONF_ERROR;
  761.     }

  762.     pv = ngx_palloc(cf->pool, sizeof(ngx_http_perl_variable_t));
  763.     if (pv == NULL) {
  764.         return NGX_CONF_ERROR;
  765.     }

  766.     index = ngx_http_get_variable_index(cf, &value[1]);
  767.     if (index == NGX_ERROR) {
  768.         return NGX_CONF_ERROR;
  769.     }

  770.     pmcf = ngx_http_conf_get_module_main_conf(cf, ngx_http_perl_module);

  771.     if (pmcf->perl == NULL) {
  772.         if (ngx_http_perl_init_interpreter(cf, pmcf) != NGX_CONF_OK) {
  773.             return NGX_CONF_ERROR;
  774.         }
  775.     }

  776.     pv->handler = value[2];

  777.     {

  778.     dTHXa(pmcf->perl);
  779.     PERL_SET_CONTEXT(pmcf->perl);
  780.     PERL_SET_INTERP(pmcf->perl);

  781.     ngx_http_perl_eval_anon_sub(aTHX_ &value[2], &pv->sub);

  782.     if (pv->sub == &PL_sv_undef) {
  783.         ngx_conf_log_error(NGX_LOG_ERR, cf, 0,
  784.                            "eval_pv(\"%V\") failed", &value[2]);
  785.         return NGX_CONF_ERROR;
  786.     }

  787.     if (pv->sub == NULL) {
  788.         pv->sub = newSVpvn((char *) value[2].data, value[2].len);
  789.     }

  790.     }

  791.     v->get_handler = ngx_http_perl_variable;
  792.     v->data = (uintptr_t) pv;

  793.     return NGX_CONF_OK;
  794. }


  795. static ngx_int_t
  796. ngx_http_perl_init_worker(ngx_cycle_t *cycle)
  797. {
  798.     ngx_http_perl_main_conf_t  *pmcf;

  799.     pmcf = ngx_http_cycle_get_module_main_conf(cycle, ngx_http_perl_module);

  800.     if (pmcf) {
  801.         dTHXa(pmcf->perl);
  802.         PERL_SET_CONTEXT(pmcf->perl);
  803.         PERL_SET_INTERP(pmcf->perl);

  804.         /* set worker's $$ */

  805.         sv_setiv(GvSV(gv_fetchpv("$", TRUE, SVt_PV)), (I32) ngx_pid);
  806.     }

  807.     return NGX_OK;
  808. }


  809. static void
  810. ngx_http_perl_exit(ngx_cycle_t *cycle)
  811. {
  812. #if (NGX_HAVE_PERL_MULTIPLICITY)

  813.     /*
  814.      * the master exit hook is run before global pool cleanup,
  815.      * therefore just set flag here
  816.      */

  817.     ngx_perl_term = 1;

  818. #else

  819.     if (nginx_stash) {
  820.         ngx_log_debug0(NGX_LOG_DEBUG_HTTP, cycle->log, 0, "perl term");

  821.         (void) perl_destruct(perl);

  822.         perl_free(perl);

  823.         PERL_SYS_TERM();
  824.     }

  825. #endif
  826. }