aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/core/nginx.h2
-rw-r--r--src/http/modules/ngx_http_referer_module.c4
-rw-r--r--src/http/modules/ngx_http_ssi_filter_module.c4
-rw-r--r--src/http/modules/ngx_http_ssl_module.c6
-rw-r--r--src/http/modules/perl/Makefile.PL35
-rw-r--r--src/http/modules/perl/nginx.pm70
-rw-r--r--src/http/modules/perl/nginx.xs551
-rw-r--r--src/http/modules/perl/ngx_http_perl_module.c980
-rw-r--r--src/http/modules/perl/ngx_http_perl_module.h49
-rw-r--r--src/http/modules/perl/typemap3
10 files changed, 1694 insertions, 10 deletions
diff --git a/src/core/nginx.h b/src/core/nginx.h
index cba4dbb56..ec125d60e 100644
--- a/src/core/nginx.h
+++ b/src/core/nginx.h
@@ -8,7 +8,7 @@
#define _NGINX_H_INCLUDED_
-#define NGINX_VER "nginx/0.3.20"
+#define NGINX_VER "nginx/0.3.21"
#define NGINX_VAR "NGINX"
#define NGX_OLDPID_EXT ".oldbin"
diff --git a/src/http/modules/ngx_http_referer_module.c b/src/http/modules/ngx_http_referer_module.c
index d5bb8aa2c..0d3ee6f7a 100644
--- a/src/http/modules/ngx_http_referer_module.c
+++ b/src/http/modules/ngx_http_referer_module.c
@@ -168,10 +168,6 @@ uri:
len = last - p;
- if (len == 0) {
- goto invalid;
- }
-
if (uri == NGX_HTTP_REFERER_NO_URI_PART) {
goto valid;
}
diff --git a/src/http/modules/ngx_http_ssi_filter_module.c b/src/http/modules/ngx_http_ssi_filter_module.c
index 18e8729ce..66b2b96dc 100644
--- a/src/http/modules/ngx_http_ssi_filter_module.c
+++ b/src/http/modules/ngx_http_ssi_filter_module.c
@@ -350,7 +350,7 @@ ngx_http_ssi_body_filter(ngx_http_request_t *r, ngx_chain_t *in)
ngx_http_ssi_command_t *cmd;
ngx_http_ssi_loc_conf_t *slcf;
ngx_http_ssi_main_conf_t *smcf;
- ngx_str_t *params[NGX_HTTP_SSI_MAX_PARAMS];
+ ngx_str_t *params[NGX_HTTP_SSI_MAX_PARAMS + 1];
ctx = ngx_http_get_module_ctx(r, ngx_http_ssi_filter_module);
@@ -534,7 +534,7 @@ ngx_http_ssi_body_filter(ngx_http_request_t *r, ngx_chain_t *in)
}
ngx_memzero(params,
- NGX_HTTP_SSI_MAX_PARAMS * sizeof(ngx_str_t *));
+ (NGX_HTTP_SSI_MAX_PARAMS + 1) * sizeof(ngx_str_t *));
param = ctx->params.elts;
diff --git a/src/http/modules/ngx_http_ssl_module.c b/src/http/modules/ngx_http_ssl_module.c
index d75b9e60d..55f7b48a7 100644
--- a/src/http/modules/ngx_http_ssl_module.c
+++ b/src/http/modules/ngx_http_ssl_module.c
@@ -40,21 +40,21 @@ static ngx_conf_bitmask_t ngx_http_ssl_protocols[] = {
static ngx_command_t ngx_http_ssl_commands[] = {
{ ngx_string("ssl"),
- NGX_HTTP_SRV_CONF|NGX_CONF_FLAG,
+ NGX_HTTP_MAIN_CONF|NGX_HTTP_SRV_CONF|NGX_CONF_FLAG,
ngx_conf_set_flag_slot,
NGX_HTTP_SRV_CONF_OFFSET,
offsetof(ngx_http_ssl_srv_conf_t, enable),
NULL },
{ ngx_string("ssl_certificate"),
- NGX_HTTP_SRV_CONF|NGX_CONF_TAKE1,
+ NGX_HTTP_MAIN_CONF|NGX_HTTP_SRV_CONF|NGX_CONF_TAKE1,
ngx_conf_set_str_slot,
NGX_HTTP_SRV_CONF_OFFSET,
offsetof(ngx_http_ssl_srv_conf_t, certificate),
NULL },
{ ngx_string("ssl_certificate_key"),
- NGX_HTTP_SRV_CONF|NGX_CONF_TAKE1,
+ NGX_HTTP_MAIN_CONF|NGX_HTTP_SRV_CONF|NGX_CONF_TAKE1,
ngx_conf_set_str_slot,
NGX_HTTP_SRV_CONF_OFFSET,
offsetof(ngx_http_ssl_srv_conf_t, certificate_key),
diff --git a/src/http/modules/perl/Makefile.PL b/src/http/modules/perl/Makefile.PL
new file mode 100644
index 000000000..6fa3df744
--- /dev/null
+++ b/src/http/modules/perl/Makefile.PL
@@ -0,0 +1,35 @@
+
+# Copyright (C) Igor Sysoev
+
+use 5.006001;
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+ NAME => 'nginx',
+ VERSION_FROM => 'nginx.pm', # finds $VERSION
+ PREREQ_PM => {}, # e.g., Module::Name => 1.1
+
+ ABSTRACT_FROM => 'nginx.pm', # retrieve abstract from module
+ AUTHOR => 'Igor Sysoev',
+
+ CCFLAGS => "$ENV{NGX_PERL_CFLAGS}",
+
+ INC => "-I ../../../../../src/core " .
+ "-I ../../../../../src/event " .
+ "-I ../../../../../src/os/unix " .
+ "-I ../../../../../src/http " .
+ "-I ../../../../../src/http/modules " .
+ "-I ../../../../../src/http/modules/perl " .
+ "-I ../../../../../$ENV{NGX_OBJS} " .
+ "-I ../../../../../$ENV{NGX_PCRE} " .
+ "-I ../../../../../$ENV{NGX_ZLIB} ",
+
+ depend => {
+ 'nginx.c' =>
+ "../../../../../src/http/modules/perl/ngx_http_perl_module.h"
+ },
+
+ PM => {
+ 'nginx.pm' => '$(INST_LIBDIR)/nginx.pm'
+ }
+);
diff --git a/src/http/modules/perl/nginx.pm b/src/http/modules/perl/nginx.pm
new file mode 100644
index 000000000..66ff64f9a
--- /dev/null
+++ b/src/http/modules/perl/nginx.pm
@@ -0,0 +1,70 @@
+package nginx;
+
+use 5.006001;
+use strict;
+use warnings;
+
+require Exporter;
+
+our @ISA = qw(Exporter);
+
+our @EXPORT = qw(
+ OK
+ DECLINED
+ HTTP_OK
+ HTTP_REDIRECT
+ HTTP_NOT_FOUND
+ HTTP_SERVER_ERROR
+);
+
+our $VERSION = '0.3.21';
+
+require XSLoader;
+XSLoader::load('nginx', $VERSION);
+
+# Preloaded methods go here.
+
+use constant OK => 0;
+use constant DECLINED => -5;
+
+use constant HTTP_OK => 200;
+use constant HTTP_REDIRECT => 302;
+use constant HTTP_NOT_FOUND => 404;
+use constant HTTP_SERVER_ERROR => 500;
+
+
+1;
+__END__
+
+=head1 NAME
+
+nginx - Perl interface to the nginx HTTP server API
+
+=head1 SYNOPSIS
+
+ use nginx;
+
+=head1 DESCRIPTION
+
+This module provides a Perl interface to the nginx HTTP server API.
+
+=head2 EXPORT
+
+None by default.
+
+
+
+=head1 SEE ALSO
+
+http://sysoev.ru/nginx/docs/http/ngx_http_perl_module.html
+
+=head1 AUTHOR
+
+Igor Sysoev
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) Igor Sysoev
+
+
+=cut
diff --git a/src/http/modules/perl/nginx.xs b/src/http/modules/perl/nginx.xs
new file mode 100644
index 000000000..21d2deb99
--- /dev/null
+++ b/src/http/modules/perl/nginx.xs
@@ -0,0 +1,551 @@
+
+/*
+ * Copyright (C) Igor Sysoev
+ */
+
+
+#define PERL_NO_GET_CONTEXT
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+#include <ngx_config.h>
+#include <ngx_core.h>
+#include <ngx_http.h>
+#include <ngx_http_perl_module.h>
+
+
+static ngx_int_t
+ngx_http_perl_sv2str(pTHX_ ngx_http_request_t *r, ngx_str_t *s, SV *sv)
+{
+ u_char *p;
+ STRLEN len;
+
+ if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PV) {
+ sv = SvRV(sv);
+ }
+
+ p = (u_char *) SvPV(sv, len);
+
+ s->len = len;
+
+ if (SvREADONLY(sv)) {
+ s->data = p;
+ return NGX_OK;
+ }
+
+ s->data = ngx_palloc(r->pool, len);
+ if (s->data == NULL) {
+ return NGX_ERROR;
+ }
+
+ ngx_memcpy(s->data, p, len);
+
+ return NGX_OK;
+}
+
+
+static ngx_int_t
+ngx_http_perl_output(ngx_http_request_t *r, ngx_buf_t *b)
+{
+ ngx_chain_t *cl, out;
+ ngx_http_perl_ctx_t *ctx;
+
+ ctx = ngx_http_get_module_ctx(r, ngx_http_perl_module);
+
+ if (ctx->ssi) {
+ cl = ngx_alloc_chain_link(r->pool);
+ if (cl == NULL) {
+ return NGX_ERROR;
+ }
+
+ cl->buf = b;
+ cl->next = NULL;
+ *ctx->ssi->last_out = cl;
+ ctx->ssi->last_out = &cl->next;
+
+ return NGX_OK;
+ }
+
+ out.buf = b;
+ out.next = NULL;
+
+ return ngx_http_output_filter(r, &out);
+}
+
+
+MODULE = nginx PACKAGE = nginx
+
+
+int
+send_http_header(r, ...)
+ nginx r
+
+ PREINIT:
+
+ SV *sv;
+
+ CODE:
+
+ if (r->headers_out.status == 0) {
+ r->headers_out.status = NGX_HTTP_OK;
+ }
+
+ if (items != 1) {
+ sv = ST(1);
+
+ if (ngx_http_perl_sv2str(aTHX_ r, &r->headers_out.content_type, sv)
+ != NGX_OK)
+ {
+ RETVAL = NGX_ERROR;
+ goto done;
+ }
+
+ } else {
+ if (r->headers_out.content_type.len == 0) {
+ if (ngx_http_set_content_type(r) != NGX_OK) {
+ RETVAL = NGX_ERROR;
+ goto done;
+ }
+ }
+ }
+
+ RETVAL = ngx_http_send_header(r);
+
+ done:
+
+ OUTPUT:
+ RETVAL
+
+
+int
+header_only(r)
+ nginx r
+
+ CODE:
+ RETVAL = r->header_only;
+
+ OUTPUT:
+ RETVAL
+
+
+# The returning "char *" is more quickly than creating SV, because SV returned
+# from XS is never used as permanent storage. Even in simple case:
+# "$uri = $r->uri" the SV returned by $r->uri is copied to $uri's SV.
+
+char *
+uri(r, ...)
+ nginx r
+
+ CODE:
+
+ if (items != 1) {
+ croak("$r->uri(text) is not implemented");
+ }
+
+ RETVAL = ngx_palloc(r->pool, r->uri.len + 1);
+ if (RETVAL == NULL) {
+ XSRETURN_UNDEF;
+ }
+
+ ngx_cpystrn((u_char *) RETVAL, r->uri.data, r->uri.len + 1);
+
+ OUTPUT:
+ RETVAL
+
+
+char *
+query_string(r, ...)
+ nginx r
+
+ CODE:
+
+ if (items != 1) {
+ croak("$r->query_string(text) is not implemented");
+ }
+
+ RETVAL = ngx_palloc(r->pool, r->args.len + 1);
+ if (RETVAL == NULL) {
+ XSRETURN_UNDEF;
+ }
+
+ ngx_cpystrn((u_char *) RETVAL, r->args.data, r->args.len + 1);
+
+ OUTPUT:
+ RETVAL
+
+
+char *
+header_in(r, key)
+ nginx r
+ SV *key
+
+ PREINIT:
+
+ u_char *p;
+ STRLEN len;
+ ngx_uint_t i;
+ ngx_list_part_t *part;
+ ngx_table_elt_t *header;
+
+ CODE:
+
+ if (SvROK(key) && SvTYPE(SvRV(key)) == SVt_PV) {
+ key = SvRV(key);
+ }
+
+ p = (u_char *) SvPV(key, len);
+
+ part = &r->headers_in.headers.part;
+ header = part->elts;
+
+ for (i = 0; /* void */ ; i++) {
+
+ if (i >= part->nelts) {
+ if (part->next == NULL) {
+ break;
+ }
+
+ part = part->next;
+ header = part->elts;
+ i = 0;
+ }
+
+ if (len != header[i].key.len
+ || ngx_strcasecmp(p, header[i].key.data) != 0)
+ {
+ continue;
+ }
+
+ RETVAL = (char *) header[i].value.data;
+
+ goto done;
+ }
+
+ XSRETURN_UNDEF;
+
+ done:
+
+ OUTPUT:
+ RETVAL
+
+
+int
+header_out(r, key, value)
+ nginx r
+ SV *key
+ SV *value
+
+ PREINIT:
+
+ ngx_table_elt_t *header;
+
+ CODE:
+
+ header = ngx_list_push(&r->headers_out.headers);
+ if (header == NULL) {
+ RETVAL = NGX_ERROR;
+ goto done;
+ }
+
+ header->hash = 1;
+
+ if (ngx_http_perl_sv2str(aTHX_ r, &header->key, key) != NGX_OK) {
+ RETVAL = NGX_ERROR;
+ goto done;
+ }
+
+ if (ngx_http_perl_sv2str(aTHX_ r, &header->value, value) != NGX_OK) {
+ RETVAL = NGX_ERROR;
+ goto done;
+ }
+
+ if (header->key.len == sizeof("Content-Length") - 1
+ && ngx_strncasecmp(header->key.data, "Content-Length",
+ sizeof("Content-Length") - 1) == 0
+ && SvIOK(value))
+ {
+ r->headers_out.content_length_n = (ssize_t) SvIV(value);;
+ r->headers_out.content_length = header;
+ }
+
+ RETVAL = NGX_OK;
+
+ done:
+
+ OUTPUT:
+ RETVAL
+
+
+char *
+filename(r)
+ nginx r
+
+ PREINIT:
+
+ ngx_str_t path;
+ ngx_http_perl_ctx_t *ctx;
+
+ CODE:
+
+ ctx = ngx_http_get_module_ctx(r, ngx_http_perl_module);
+ if (ctx->filename) {
+ goto done;
+ }
+
+ if (ngx_http_map_uri_to_path(r, &path, 0) == NULL) {
+ XSRETURN_UNDEF;
+ }
+
+ ctx->filename = (char *) path.data;
+
+ sv_setpv(PL_statname, ctx->filename);
+
+ done:
+
+ RETVAL = ctx->filename;
+
+ OUTPUT:
+ RETVAL
+
+
+int
+print(r, ...)
+ nginx r
+
+ PREINIT:
+
+ SV *sv;
+ int i;
+ u_char *p;
+ size_t size;
+ STRLEN len;
+ ngx_buf_t *b;
+
+ CODE:
+
+ RETVAL = NGX_OK;
+
+ if (items == 2) {
+
+ /*
+ * do zero copy for prolate single read-only SV:
+ * $r->print("some text\n");
+ */
+
+ sv = ST(1);
+
+ if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PV) {
+ sv = SvRV(sv);
+ }
+
+ if (SvREADONLY(sv)) {
+
+ p = (u_char *) SvPV(sv, len);
+
+ if (len == 0) {
+ goto done;
+ }
+
+ b = ngx_calloc_buf(r->pool);
+ if (b == NULL) {
+ RETVAL = NGX_ERROR;
+ goto done;
+ }
+
+ b->memory = 1;
+ b->pos = p;
+ b->last = p + len;
+ b->start = p;
+ b->end = b->last;
+
+ goto out;
+ }
+ }
+
+ size = 0;
+
+ for (i = 1; i < items; i++) {
+
+ sv = ST(i);
+
+ if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PV) {
+ sv = SvRV(sv);
+ }
+
+ ngx_log_debug3(NGX_LOG_DEBUG_HTTP, r->connection->log, 0,
+ "SV: %p %d %Xd",
+ sv, SvREFCNT(sv), SvREADONLY(sv));
+
+ (void) SvPV(sv, len);
+
+ size += len;
+ }
+
+ if (size == 0) {
+ goto done;
+ }
+
+ b = ngx_create_temp_buf(r->pool, size);
+ if (b == NULL) {
+ RETVAL = NGX_ERROR;
+ goto done;
+ }
+
+ for (i = 1; i < items; i++) {
+ sv = ST(i);
+
+ if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PV) {
+ sv = SvRV(sv);
+ }
+
+ p = (u_char *) SvPV(sv, len);
+ b->last = ngx_cpymem(b->last, p, len);
+ }
+
+ out:
+
+ RETVAL = ngx_http_perl_output(r, b);
+
+ done:
+
+ OUTPUT:
+ RETVAL
+
+
+int
+sendfile(r, filename)
+ nginx r
+ char *filename
+
+ PREINIT:
+
+ ngx_fd_t fd;
+ ngx_buf_t *b;
+ ngx_file_info_t fi;
+ ngx_pool_cleanup_t *cln;
+ ngx_pool_cleanup_file_t *clnf;
+
+ CODE:
+
+ if (filename == NULL) {
+ croak("sendfile(): NULL filename");
+ }
+
+ b = ngx_calloc_buf(r->pool);
+ if (b == NULL) {
+ RETVAL = NGX_ERROR;
+ goto done;
+ }
+
+ b->file = ngx_pcalloc(r->pool, sizeof(ngx_file_t));
+ if (b->file == NULL) {
+ RETVAL = NGX_ERROR;
+ goto done;
+ }
+
+ cln = ngx_pool_cleanup_add(r->pool, sizeof(ngx_pool_cleanup_file_t));
+ if (cln == NULL) {
+ RETVAL = NGX_ERROR;
+ goto done;
+ }
+
+ fd = ngx_open_file((u_char *) filename, NGX_FILE_RDONLY, NGX_FILE_OPEN);
+
+ if (fd == NGX_INVALID_FILE) {
+ ngx_log_error(NGX_LOG_CRIT, r->connection->log, ngx_errno,
+ ngx_open_file_n " \"%s\" failed", filename);
+ RETVAL = NGX_ERROR;
+ goto done;
+ }
+
+ if (ngx_fd_info(fd, &fi) == NGX_FILE_ERROR) {
+ ngx_log_error(NGX_LOG_CRIT, r->connection->log, ngx_errno,
+ ngx_fd_info_n " \"%s\" failed", filename);
+
+ if (ngx_close_file(fd) == NGX_FILE_ERROR) {
+ ngx_log_error(NGX_LOG_ALERT, r->connection->log, ngx_errno,
+ ngx_close_file_n " \"%s\" failed", filename);
+ }
+
+ RETVAL = NGX_ERROR;
+ goto done;
+ }
+
+ cln->handler = ngx_pool_cleanup_file;
+ clnf = cln->data;
+
+ clnf->fd = fd;
+ clnf->name = (u_char *) "";
+ clnf->log = r->pool->log;
+
+ b->in_file = 1;
+ b->file_pos = 0;
+ b->file_last = ngx_file_size(&fi);
+
+ b->file->fd = fd;
+ b->file->log = r->connection->log;
+
+ RETVAL = ngx_http_perl_output(r, b);
+
+ done:
+
+ OUTPUT:
+ RETVAL
+
+
+int
+rflush(r)
+ nginx r
+
+ PREINIT:
+
+ ngx_buf_t *b;
+
+ CODE:
+
+ b = ngx_calloc_buf(r->pool);
+ if (b == NULL) {
+ RETVAL = NGX_ERROR;
+ goto done;
+ }
+
+ b->flush = 1;
+
+ RETVAL = ngx_http_perl_output(r, b);
+
+ done:
+
+ OUTPUT:
+ RETVAL
+
+
+void
+internal_redirect(r, uri)
+ nginx r
+ SV *uri
+
+ PREINIT:
+
+ ngx_uint_t i;
+ ngx_http_perl_ctx_t *ctx;
+
+ CODE:
+
+ ctx = ngx_http_get_module_ctx(r, ngx_http_perl_module);
+
+ if (ngx_http_perl_sv2str(aTHX_ r, &ctx->redirect_uri, uri) != NGX_OK) {
+ XSRETURN_EMPTY;
+ }
+
+ for (i = 0; i < ctx->redirect_uri.len; i++) {
+ if (ctx->redirect_uri.data[i] == '?') {
+
+ ctx->redirect_args.len = ctx->redirect_uri.len - (i + 1);
+ ctx->redirect_args.data = &ctx->redirect_uri.data[i + 1];
+ ctx->redirect_uri.len = i;
+
+ XSRETURN_EMPTY;
+ }
+ }
diff --git a/src/http/modules/perl/ngx_http_perl_module.c b/src/http/modules/perl/ngx_http_perl_module.c
new file mode 100644
index 000000000..04f778790
--- /dev/null
+++ b/src/http/modules/perl/ngx_http_perl_module.c
@@ -0,0 +1,980 @@
+
+/*
+ * Copyright (C) Igor Sysoev
+ */
+
+
+#include <ngx_config.h>
+#include <ngx_core.h>
+#include <ngx_http.h>
+#include <ngx_http_perl_module.h>
+
+
+typedef struct {
+ PerlInterpreter **free_perls;
+ ngx_uint_t interp;
+ ngx_uint_t nalloc;
+ ngx_uint_t interp_max;
+
+ PerlInterpreter *perl;
+ ngx_str_t modules;
+ ngx_array_t requires;
+} ngx_http_perl_main_conf_t;
+
+
+typedef struct {
+ SV *sub;
+ ngx_str_t handler;
+} ngx_http_perl_loc_conf_t;
+
+
+typedef struct {
+ SV *sub;
+ ngx_str_t handler;
+} ngx_http_perl_variable_t;
+
+
+static ngx_int_t ngx_http_perl_ssi(ngx_http_request_t *r,
+ ngx_http_ssi_ctx_t *ssi_ctx, ngx_str_t **params);
+static ngx_int_t
+ ngx_http_perl_get_interpreter(ngx_http_perl_main_conf_t *pmcf,
+ PerlInterpreter **perl, ngx_log_t *log);
+static ngx_inline void
+ ngx_http_perl_free_interpreter(ngx_http_perl_main_conf_t *pmcf,
+ PerlInterpreter *perl);
+static char *ngx_http_perl_init_interpreter(ngx_conf_t *cf,
+ ngx_http_perl_main_conf_t *pmcf);
+static PerlInterpreter *
+ ngx_http_perl_create_interpreter(ngx_http_perl_main_conf_t *pmcf,
+ ngx_log_t *log);
+static ngx_int_t ngx_http_perl_call_handler(pTHX_ ngx_http_request_t *r,
+ SV *sub, ngx_str_t **args, ngx_str_t *handler, ngx_str_t *rv);
+static void ngx_http_perl_eval_anon_sub(pTHX_ ngx_str_t *handler, SV **sv);
+
+static ngx_int_t ngx_http_perl_preconfiguration(ngx_conf_t *cf);
+static void *ngx_http_perl_create_main_conf(ngx_conf_t *cf);
+static char *ngx_http_perl_init_main_conf(ngx_conf_t *cf, void *conf);
+static void *ngx_http_perl_create_loc_conf(ngx_conf_t *cf);
+static char *ngx_http_perl_merge_loc_conf(ngx_conf_t *cf, void *parent,
+ void *child);
+static char *ngx_http_perl_require(ngx_conf_t *cf, ngx_command_t *cmd,
+ void *conf);
+static char *ngx_http_perl(ngx_conf_t *cf, ngx_command_t *cmd, void *conf);
+static char *ngx_http_perl_set(ngx_conf_t *cf, ngx_command_t *cmd, void *conf);
+static char *ngx_http_perl_interp_max_unsupported(ngx_conf_t *cf, void *post,
+ void *data);
+static void ngx_http_perl_cleanup_perl(void *data);
+
+
+static ngx_conf_post_handler_pt ngx_http_perl_interp_max_p =
+ ngx_http_perl_interp_max_unsupported;
+
+
+static ngx_command_t ngx_http_perl_commands[] = {
+
+ { ngx_string("perl_modules"),
+ NGX_HTTP_MAIN_CONF|NGX_CONF_TAKE1,
+ ngx_conf_set_str_slot,
+ NGX_HTTP_MAIN_CONF_OFFSET,
+ offsetof(ngx_http_perl_main_conf_t, modules),
+ NULL },
+
+ { ngx_string("perl_require"),
+ NGX_HTTP_MAIN_CONF|NGX_CONF_TAKE1,
+ ngx_http_perl_require,
+ NGX_HTTP_MAIN_CONF_OFFSET,
+ 0,
+ NULL },
+
+ { ngx_string("perl_interp_max"),
+ NGX_HTTP_MAIN_CONF|NGX_CONF_TAKE1,
+ ngx_conf_set_num_slot,
+ NGX_HTTP_MAIN_CONF_OFFSET,
+ offsetof(ngx_http_perl_main_conf_t, interp_max),
+ &ngx_http_perl_interp_max_p },
+
+ { ngx_string("perl"),
+ NGX_HTTP_LOC_CONF|NGX_CONF_TAKE1,
+ ngx_http_perl,
+ NGX_HTTP_LOC_CONF_OFFSET,
+ 0,
+ NULL },
+
+ { ngx_string("perl_set"),
+ NGX_HTTP_MAIN_CONF|NGX_CONF_TAKE2,
+ ngx_http_perl_set,
+ NGX_HTTP_LOC_CONF_OFFSET,
+ 0,
+ NULL },
+
+ ngx_null_command
+};
+
+
+static ngx_http_module_t ngx_http_perl_module_ctx = {
+ ngx_http_perl_preconfiguration, /* preconfiguration */
+ NULL, /* postconfiguration */
+
+ ngx_http_perl_create_main_conf, /* create main configuration */
+ ngx_http_perl_init_main_conf, /* init main configuration */
+
+ NULL, /* create server configuration */
+ NULL, /* merge server configuration */
+
+ ngx_http_perl_create_loc_conf, /* create location configuration */
+ ngx_http_perl_merge_loc_conf /* merge location configuration */
+};
+
+
+ngx_module_t ngx_http_perl_module = {
+ NGX_MODULE_V1,
+ &ngx_http_perl_module_ctx, /* module context */
+ ngx_http_perl_commands, /* module directives */
+ NGX_HTTP_MODULE, /* module type */
+ NULL, /* init master */
+ NULL, /* init module */
+ NULL, /* init process */
+ NULL, /* init thread */
+ NULL, /* exit thread */
+ NULL, /* exit process */
+ NULL, /* exit master */
+ NGX_MODULE_V1_PADDING
+};
+
+
+#define NGX_HTTP_PERL_SSI_SUB 0
+#define NGX_HTTP_PERL_SSI_ARG 1
+
+
+static ngx_http_ssi_param_t ngx_http_perl_ssi_params[] = {
+ { ngx_string("sub"), NGX_HTTP_PERL_SSI_SUB, 1, 0 },
+ { ngx_string("arg"), NGX_HTTP_PERL_SSI_ARG, 0, 1 },
+ { ngx_null_string, 0, 0, 0 }
+};
+
+
+static ngx_http_ssi_command_t ngx_http_perl_ssi_command = {
+ ngx_string("perl"), ngx_http_perl_ssi, ngx_http_perl_ssi_params, 0, 1
+};
+
+
+static void
+ngx_http_perl_xs_init(pTHX)
+{
+ newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, __FILE__);
+}
+
+
+static ngx_int_t
+ngx_http_perl_handler(ngx_http_request_t *r)
+{
+ ngx_int_t rc;
+ ngx_str_t uri, args;
+ ngx_http_perl_ctx_t *ctx;
+ ngx_http_perl_loc_conf_t *plcf;
+ ngx_http_perl_main_conf_t *pmcf;
+
+ /* TODO: Win32 */
+ if (r->zero_in_uri) {
+ return NGX_HTTP_NOT_FOUND;
+ }
+
+ ngx_log_debug0(NGX_LOG_DEBUG_HTTP, r->connection->log, 0, "perl handler");
+
+ /* mod_perl's content handler assumes that content type was already set */
+
+ if (ngx_http_set_content_type(r) != NGX_OK) {
+ return NGX_HTTP_INTERNAL_SERVER_ERROR;
+ }
+
+ ctx = ngx_http_get_module_ctx(r, ngx_http_perl_module);
+
+ if (ctx == NULL) {
+ ctx = ngx_pcalloc(r->pool, sizeof(ngx_http_perl_ctx_t));
+ if (ctx == NULL) {
+ return NGX_ERROR;
+ }
+
+ ngx_http_set_ctx(r, ctx, ngx_http_perl_module);
+ }
+
+ pmcf = ngx_http_get_module_main_conf(r, ngx_http_perl_module);
+
+ rc = ngx_http_perl_get_interpreter(pmcf, &ctx->perl, r->connection->log);
+
+ if (rc != NGX_OK) {
+ return rc;
+ }
+
+ {
+
+ dTHXa(ctx->perl);
+
+ plcf = ngx_http_get_module_loc_conf(r, ngx_http_perl_module);
+
+ rc = ngx_http_perl_call_handler(aTHX_ r, plcf->sub, NULL,
+ &plcf->handler, NULL);
+
+ }
+
+ ngx_http_perl_free_interpreter(pmcf, ctx->perl);
+
+ if (rc > 600) {
+ rc = NGX_OK;
+ }
+
+ ngx_log_debug1(NGX_LOG_DEBUG_HTTP, r->connection->log, 0,
+ "perl handler done: %i", rc);
+
+ if (ctx->redirect_uri.len) {
+ uri = ctx->redirect_uri;
+ args = ctx->redirect_args;
+ }
+
+ ctx->filename = NULL;
+ ctx->redirect_uri.len = 0;
+
+ if (uri.len) {
+ return ngx_http_internal_redirect(r, &uri, &args);
+ }
+
+ if (rc == NGX_OK || rc == NGX_HTTP_OK) {
+ return ngx_http_send_special(r, NGX_HTTP_LAST);
+ }
+
+ return rc;
+}
+
+
+static ngx_int_t
+ngx_http_perl_variable(ngx_http_request_t *r, ngx_http_variable_value_t *v,
+ uintptr_t data)
+{
+ ngx_http_perl_variable_t *pv = (ngx_http_perl_variable_t *) data;
+
+ ngx_int_t rc;
+ ngx_str_t value;
+ ngx_http_perl_ctx_t *ctx;
+ ngx_http_perl_main_conf_t *pmcf;
+
+ ngx_log_debug0(NGX_LOG_DEBUG_HTTP, r->connection->log, 0,
+ "perl variable handler");
+
+ ctx = ngx_http_get_module_ctx(r, ngx_http_perl_module);
+
+ if (ctx == NULL) {
+ ctx = ngx_pcalloc(r->pool, sizeof(ngx_http_perl_ctx_t));
+ if (ctx == NULL) {
+ return NGX_ERROR;
+ }
+
+ ngx_http_set_ctx(r, ctx, ngx_http_perl_module);
+ }
+
+ pmcf = ngx_http_get_module_main_conf(r, ngx_http_perl_module);
+
+ rc = ngx_http_perl_get_interpreter(pmcf, &ctx->perl, r->connection->log);
+
+ if (rc != NGX_OK) {
+ return rc;
+ }
+
+ value.data = NULL;
+
+ {
+
+ dTHXa(ctx->perl);
+
+ rc = ngx_http_perl_call_handler(aTHX_ r, pv->sub, NULL,
+ &pv->handler, &value);
+
+ }
+
+ ngx_http_perl_free_interpreter(pmcf, ctx->perl);
+
+ if (value.data) {
+ v->len = value.len;
+ v->valid = 1;
+ v->no_cachable = 0;
+ v->not_found = 0;
+ v->data = value.data;
+
+ } else {
+ v->not_found = 1;
+ }
+
+ ctx->filename = NULL;
+ ctx->redirect_uri.len = 0;
+
+ return rc;
+}
+
+
+static ngx_int_t
+ngx_http_perl_ssi(ngx_http_request_t *r, ngx_http_ssi_ctx_t *ssi_ctx,
+ ngx_str_t **params)
+{
+ SV *sv;
+ ngx_int_t rc;
+ ngx_str_t *handler;
+ ngx_http_perl_ctx_t *ctx;
+ ngx_http_perl_main_conf_t *pmcf;
+
+ ngx_log_debug0(NGX_LOG_DEBUG_HTTP, r->connection->log, 0,
+ "perl ssi handler");
+
+ pmcf = ngx_http_get_module_main_conf(r, ngx_http_perl_module);
+
+ ctx = ngx_http_get_module_ctx(r, ngx_http_perl_module);
+
+ if (ctx == NULL) {
+ ctx = ngx_pcalloc(r->pool, sizeof(ngx_http_perl_ctx_t));
+ if (ctx == NULL) {
+ return NGX_ERROR;
+ }
+
+ ngx_http_set_ctx(r, ctx, ngx_http_perl_module);
+ }
+
+ rc = ngx_http_perl_get_interpreter(pmcf, &ctx->perl, r->connection->log);
+
+ if (rc != NGX_OK) {
+ return rc;
+ }
+
+ ctx->ssi = ssi_ctx;
+
+ handler = params[NGX_HTTP_PERL_SSI_SUB];
+ handler->data[handler->len] = '\0';
+
+ {
+
+ dTHXa(ctx->perl);
+
+#if 0
+
+ ngx_http_perl_eval_anon_sub(aTHX_ handler, &sv);
+
+ if (sv == &PL_sv_undef) {
+ ngx_log_error(NGX_LOG_ERR, r->connection->log, 0,
+ "eval_pv(\"%V\") failed", handler);
+ return NGX_ERROR;
+ }
+
+ if (sv == NULL) {
+ sv = newSVpvn((char *) handler->data, handler->len);
+ }
+
+#endif
+
+ sv = newSVpvn((char *) handler->data, handler->len);
+
+ rc = ngx_http_perl_call_handler(aTHX_ r, sv, &params[NGX_HTTP_PERL_SSI_ARG],
+ handler, NULL);
+
+ SvREFCNT_dec(sv);
+
+ }
+
+ ngx_http_perl_free_interpreter(pmcf, ctx->perl);
+
+ ctx->filename = NULL;
+ ctx->redirect_uri.len = 0;
+ ctx->ssi = NULL;
+
+ return rc;
+}
+
+
+static ngx_int_t
+ngx_http_perl_get_interpreter(ngx_http_perl_main_conf_t *pmcf,
+ PerlInterpreter **perl, ngx_log_t *log)
+{
+ if (pmcf->interp) {
+ pmcf->interp--;
+
+ *perl = pmcf->free_perls[pmcf->interp];
+
+ return NGX_OK;
+ }
+
+ if (pmcf->nalloc < pmcf->interp_max) {
+ *perl = ngx_http_perl_create_interpreter(pmcf, log);
+
+ if (*perl) {
+ return NGX_OK;
+ }
+
+ return NGX_HTTP_INTERNAL_SERVER_ERROR;
+ }
+
+ ngx_log_error(NGX_LOG_ALERT, log, 0, "no free perl interpreter");
+
+ return NGX_HTTP_SERVICE_UNAVAILABLE;
+}
+
+
+static ngx_inline void
+ngx_http_perl_free_interpreter(ngx_http_perl_main_conf_t *pmcf,
+ PerlInterpreter *perl)
+{
+ pmcf->free_perls[pmcf->interp++] = perl;
+}
+
+
+static char *
+ngx_http_perl_init_interpreter(ngx_conf_t *cf, ngx_http_perl_main_conf_t *pmcf)
+{
+ ngx_pool_cleanup_t *cln;
+
+ cln = ngx_pool_cleanup_add(cf->pool, 0);
+ if (cln == NULL) {
+ return NGX_CONF_ERROR;
+ }
+
+#ifdef NGX_PERL_MODULES
+ if (pmcf->modules.data == NULL) {
+ pmcf->modules.data = NGX_PERL_MODULES;
+ }
+#endif
+
+ PERL_SYS_INIT(&ngx_argc, &ngx_argv);
+
+ pmcf->perl = ngx_http_perl_create_interpreter(pmcf, cf->log);
+
+ if (pmcf->perl == NULL) {
+ PERL_SYS_TERM();
+ return NGX_CONF_ERROR;
+ }
+
+ cln->handler = ngx_http_perl_cleanup_perl;
+ cln->data = pmcf->perl;
+
+ return NGX_CONF_OK;
+}
+
+
+static PerlInterpreter *
+ngx_http_perl_create_interpreter(ngx_http_perl_main_conf_t *pmcf,
+ ngx_log_t *log)
+{
+ int n;
+ char *embedding[6];
+ char **script;
+ STRLEN len;
+ ngx_str_t err;
+ ngx_uint_t i;
+ PerlInterpreter *perl;
+
+ ngx_log_debug0(NGX_LOG_DEBUG_HTTP, log, 0, "create perl interpreter");
+
+#if (NGX_HAVE_PERL_CLONE)
+
+ if (pmcf->perl) {
+
+ perl = perl_clone(pmcf->perl, CLONEf_KEEP_PTR_TABLE);
+ if (perl == NULL) {
+ ngx_log_error(NGX_LOG_ALERT, log, 0, "perl_clone() failed");
+ return NULL;
+ }
+
+ {
+
+ dTHXa(perl);
+
+ ptr_table_free(PL_ptr_table);
+ PL_ptr_table = NULL;
+
+ }
+
+ pmcf->nalloc++;
+
+ return perl;
+ }
+
+#endif
+
+ perl = perl_alloc();
+ if (perl == NULL) {
+ ngx_log_error(NGX_LOG_ALERT, log, 0, "perl_alloc() failed");
+ return NULL;
+ }
+
+ perl_construct(perl);
+
+ {
+
+ dTHXa(perl);
+
+#ifdef PERL_EXIT_DESTRUCT_END
+ PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
+#endif
+
+ embedding[0] = "";
+
+ if (pmcf->modules.data) {
+ embedding[1] = "-I";
+ embedding[2] = (char *) pmcf->modules.data;
+ n = 3;
+
+ } else {
+ n = 1;
+ }
+
+ embedding[n++] = "-Mnginx";
+ embedding[n++] = "-e";
+ embedding[n++] = "0";
+
+ n = perl_parse(perl, ngx_http_perl_xs_init, n, embedding, NULL);
+
+ if (n != 0) {
+ ngx_log_error(NGX_LOG_ALERT, log, 0, "perl_parse() failed: %d", n);
+ goto fail;
+ }
+
+ script = pmcf->requires.elts;
+ for (i = 0; i < pmcf->requires.nelts; i++) {
+ require_pv(script[i]);
+
+ if (SvTRUE(ERRSV)) {
+
+ err.data = (u_char *) SvPV(ERRSV, len);
+ for (len--; err.data[len] == LF || err.data[len] == CR; len--) {
+ /* void */
+ }
+ err.len = len + 1;
+
+ ngx_log_error(NGX_LOG_EMERG, log, 0,
+ "require_pv(\"%s\") failed: \"%V\"", script[i], &err);
+ goto fail;
+ }
+ }
+
+ }
+
+ pmcf->nalloc++;
+
+ return perl;
+
+fail:
+
+ (void) perl_destruct(perl);
+
+ perl_free(perl);
+
+ return NULL;
+}
+
+
+#if (__INTEL_COMPILER)
+/*
+ * disable 'declaration hides parameter "my_perl"' warning for ENTER and LEAVE
+ */
+#pragma warning(disable:1599)
+#endif
+
+
+static ngx_int_t
+ngx_http_perl_call_handler(pTHX_ ngx_http_request_t *r, SV *sub,
+ ngx_str_t **args, ngx_str_t *handler, ngx_str_t *rv)
+{
+ SV *sv;
+ int n, status;
+ char *line;
+ STRLEN len, n_a;
+ ngx_str_t err;
+ ngx_uint_t i;
+
+ dSP;
+
+ status = 0;
+
+ ENTER;
+ SAVETMPS;
+
+ PUSHMARK(sp);
+
+ sv = sv_newmortal();
+ sv_setref_pv(sv, "nginx", r);
+ XPUSHs(sv);
+
+ if (args) {
+ for (i = 0; args[i]; i++) { /* void */ }
+
+ EXTEND(sp, (int) i);
+
+ for (i = 0; args[i]; i++) {
+ PUSHs(sv_2mortal(newSVpvn((char *) args[i]->data, args[i]->len)));
+ }
+ }
+
+ PUTBACK;
+
+ n = call_sv(sub, G_EVAL);
+
+ SPAGAIN;
+
+ if (n) {
+ if (rv == NULL) {
+ status = POPi;
+
+ ngx_log_debug1(NGX_LOG_DEBUG_HTTP, r->connection->log, 0,
+ "call_sv: %d", status);
+
+ } else {
+ line = POPpx;
+ rv->len = n_a;
+
+ rv->data = ngx_palloc(r->pool, n_a);
+ if (rv->data == NULL) {
+ return NGX_ERROR;
+ }
+
+ ngx_memcpy(rv->data, line, n_a);
+ }
+ }
+
+ PUTBACK;
+
+ FREETMPS;
+ LEAVE;
+
+ /* check $@ */
+
+ if (SvTRUE(ERRSV)) {
+
+ err.data = (u_char *) SvPV(ERRSV, len);
+ for (len--; err.data[len] == LF || err.data[len] == CR; len--) {
+ /* void */
+ }
+ err.len = len + 1;
+
+ ngx_log_error(NGX_LOG_ERR, r->connection->log, 0,
+ "call_sv(\"%V\") failed: \"%V\"",
+ handler, &err);
+
+ if (rv) {
+ return NGX_ERROR;
+ }
+
+ return NGX_HTTP_INTERNAL_SERVER_ERROR;
+ }
+
+ if (n != 1) {
+ ngx_log_error(NGX_LOG_ALERT, r->connection->log, 0,
+ "call_sv(\"%V\") returned %d results", handler, n);
+ status = NGX_OK;
+ }
+
+ if (rv) {
+ return NGX_OK;
+ }
+
+ return (ngx_int_t) status;
+}
+
+
+#if (__INTEL_COMPILER)
+#pragma warning(default:1599)
+#endif
+
+
+static void
+ngx_http_perl_eval_anon_sub(pTHX_ ngx_str_t *handler, SV **sv)
+{
+ if (ngx_strncmp(handler->data, "sub ", 4) == 0
+ || ngx_strncmp(handler->data, "use ", 4) == 0)
+ {
+ *sv = eval_pv((char *) handler->data, FALSE);
+
+ return;
+ }
+
+ *sv = NULL;
+}
+
+
+static void *
+ngx_http_perl_create_main_conf(ngx_conf_t *cf)
+{
+ ngx_http_perl_main_conf_t *pmcf;
+
+ pmcf = ngx_pcalloc(cf->pool, sizeof(ngx_http_perl_main_conf_t));
+ if (pmcf == NULL) {
+ return NGX_CONF_ERROR;
+ }
+
+ pmcf->interp_max = NGX_CONF_UNSET_UINT;
+
+ if (ngx_array_init(&pmcf->requires, cf->pool, 1, sizeof(u_char *))
+ != NGX_OK)
+ {
+ return NULL;
+ }
+
+ return pmcf;
+}
+
+
+static char *
+ngx_http_perl_init_main_conf(ngx_conf_t *cf, void *conf)
+{
+ ngx_http_perl_main_conf_t *pmcf = conf;
+
+#if (NGX_HAVE_PERL_CLONE || NGX_HAVE_PERL_MULTIPLICITY)
+ ngx_conf_init_unsigned_value(pmcf->interp_max, 10);
+#else
+ ngx_conf_init_unsigned_value(pmcf->interp_max, 1);
+#endif
+
+ pmcf->free_perls = ngx_pcalloc(cf->pool,
+ pmcf->interp_max * sizeof(PerlInterpreter *));
+ if (pmcf->free_perls == NULL) {
+ return NGX_CONF_ERROR;
+ }
+
+ if (pmcf->perl == NULL) {
+ if (ngx_http_perl_init_interpreter(cf, pmcf) != NGX_CONF_OK) {
+ return NGX_CONF_ERROR;
+ }
+ }
+
+#if !(NGX_HAVE_PERL_CLONE)
+ ngx_http_perl_free_interpreter(pmcf, pmcf->perl);
+#endif
+
+ return NGX_CONF_OK;
+}
+
+
+static void
+ngx_http_perl_cleanup_perl(void *data)
+{
+ PerlInterpreter *perl = data;
+
+ (void) perl_destruct(perl);
+
+ perl_free(perl);
+
+ PERL_SYS_TERM();
+}
+
+
+static ngx_int_t
+ngx_http_perl_preconfiguration(ngx_conf_t *cf)
+{
+ ngx_int_t rc;
+ ngx_http_ssi_main_conf_t *smcf;
+
+ smcf = ngx_http_conf_get_module_main_conf(cf, ngx_http_ssi_filter_module);
+
+ rc = ngx_hash_add_key(&smcf->commands, &ngx_http_perl_ssi_command.name,
+ &ngx_http_perl_ssi_command, NGX_HASH_READONLY_KEY);
+
+ if (rc != NGX_OK) {
+ if (rc == NGX_BUSY) {
+ ngx_conf_log_error(NGX_LOG_EMERG, cf, 0,
+ "conflicting SSI command \"%V\"",
+ &ngx_http_perl_ssi_command.name);
+ }
+
+ return NGX_ERROR;
+ }
+
+ return NGX_OK;
+}
+
+
+static void *
+ngx_http_perl_create_loc_conf(ngx_conf_t *cf)
+{
+ ngx_http_perl_loc_conf_t *plcf;
+
+ plcf = ngx_pcalloc(cf->pool, sizeof(ngx_http_perl_loc_conf_t));
+ if (plcf == NULL) {
+ return NGX_CONF_ERROR;
+ }
+
+ /*
+ * set by ngx_pcalloc():
+ *
+ * plcf->handler = { 0, NULL };
+ */
+
+ return plcf;
+}
+
+
+static char *
+ngx_http_perl_merge_loc_conf(ngx_conf_t *cf, void *parent, void *child)
+{
+ ngx_http_perl_loc_conf_t *prev = parent;
+ ngx_http_perl_loc_conf_t *conf = child;
+
+ if (conf->sub == NULL) {
+ conf->sub = prev->sub;
+ conf->handler = prev->handler;
+ }
+
+ return NGX_CONF_OK;
+}
+
+
+static char *
+ngx_http_perl_require(ngx_conf_t *cf, ngx_command_t *cmd, void *conf)
+{
+ ngx_http_perl_main_conf_t *pmcf = conf;
+
+ u_char **p;
+ ngx_str_t *value;
+
+ value = cf->args->elts;
+
+ p = ngx_array_push(&pmcf->requires);
+
+ if (p == NULL) {
+ return NGX_CONF_ERROR;
+ }
+
+ *p = value[1].data;
+
+ return NGX_CONF_OK;
+}
+
+
+static char *
+ngx_http_perl(ngx_conf_t *cf, ngx_command_t *cmd, void *conf)
+{
+ ngx_http_perl_loc_conf_t *plcf = conf;
+
+ ngx_str_t *value;
+ ngx_http_core_loc_conf_t *clcf;
+ ngx_http_perl_main_conf_t *pmcf;
+
+ value = cf->args->elts;
+
+ if (plcf->handler.data) {
+ ngx_conf_log_error(NGX_LOG_EMERG, cf, 0,
+ "duplicate perl handler \"%V\"", &value[1]);
+ return NGX_CONF_ERROR;
+ }
+
+ pmcf = ngx_http_conf_get_module_main_conf(cf, ngx_http_perl_module);
+
+ if (pmcf->perl == NULL) {
+ if (ngx_http_perl_init_interpreter(cf, pmcf) != NGX_CONF_OK) {
+ return NGX_CONF_ERROR;
+ }
+ }
+
+ plcf->handler = value[1];
+
+ {
+
+ dTHXa(pmcf->perl);
+
+ ngx_http_perl_eval_anon_sub(aTHX_ &value[1], &plcf->sub);
+
+ if (plcf->sub == &PL_sv_undef) {
+ ngx_conf_log_error(NGX_LOG_ERR, cf, 0,
+ "eval_pv(\"%V\") failed", &value[1]);
+ return NGX_CONF_ERROR;
+ }
+
+ if (plcf->sub == NULL) {
+ plcf->sub = newSVpvn((char *) value[1].data, value[1].len);
+ }
+
+ }
+
+ clcf = ngx_http_conf_get_module_loc_conf(cf, ngx_http_core_module);
+ clcf->handler = ngx_http_perl_handler;
+
+ return NGX_CONF_OK;
+}
+
+
+static char *
+ngx_http_perl_set(ngx_conf_t *cf, ngx_command_t *cmd, void *conf)
+{
+ ngx_int_t index;
+ ngx_str_t *value;
+ ngx_http_variable_t *v;
+ ngx_http_perl_variable_t *pv;
+ ngx_http_perl_main_conf_t *pmcf;
+
+ value = cf->args->elts;
+
+ if (value[1].data[0] != '$') {
+ ngx_conf_log_error(NGX_LOG_EMERG, cf, 0,
+ "invalid variable name \"%V\"", &value[1]);
+ return NGX_CONF_ERROR;
+ }
+
+ value[1].len--;
+ value[1].data++;
+
+ v = ngx_http_add_variable(cf, &value[1], NGX_HTTP_VAR_CHANGABLE);
+ if (v == NULL) {
+ return NGX_CONF_ERROR;
+ }
+
+ pv = ngx_palloc(cf->pool, sizeof(ngx_http_perl_variable_t));
+ if (pv == NULL) {
+ return NGX_CONF_ERROR;
+ }
+
+ index = ngx_http_get_variable_index(cf, &value[1]);
+ if (index == NGX_ERROR) {
+ return NGX_CONF_ERROR;
+ }
+
+ pmcf = ngx_http_conf_get_module_main_conf(cf, ngx_http_perl_module);
+
+ if (pmcf->perl == NULL) {
+ if (ngx_http_perl_init_interpreter(cf, pmcf) != NGX_CONF_OK) {
+ return NGX_CONF_ERROR;
+ }
+ }
+
+ pv->handler = value[2];
+
+ {
+
+ dTHXa(pmcf->perl);
+
+ ngx_http_perl_eval_anon_sub(aTHX_ &value[2], &pv->sub);
+
+ if (pv->sub == &PL_sv_undef) {
+ ngx_conf_log_error(NGX_LOG_ERR, cf, 0,
+ "eval_pv(\"%V\") failed", &value[2]);
+ return NGX_CONF_ERROR;
+ }
+
+ if (pv->sub == NULL) {
+ pv->sub = newSVpvn((char *) value[2].data, value[2].len);
+ }
+
+ }
+
+ v->handler = ngx_http_perl_variable;
+ v->data = (uintptr_t) pv;
+
+ return NGX_CONF_OK;
+}
+
+
+static char *
+ngx_http_perl_interp_max_unsupported(ngx_conf_t *cf, void *post, void *data)
+{
+#if (NGX_HAVE_PERL_CLONE || NGX_HAVE_PERL_MULTIPLICITY)
+
+ return NGX_CONF_OK;
+
+#else
+
+ return "to use perl_interp_max you have to build perl with "
+ "-Dusemultiplicity or -Dusethreads options";
+
+#endif
+}
diff --git a/src/http/modules/perl/ngx_http_perl_module.h b/src/http/modules/perl/ngx_http_perl_module.h
new file mode 100644
index 000000000..921917bd0
--- /dev/null
+++ b/src/http/modules/perl/ngx_http_perl_module.h
@@ -0,0 +1,49 @@
+
+/*
+ * Copyright (C) Igor Sysoev
+ */
+
+
+#ifndef _NGX_HTTP_PERL_MODULE_H_INCLUDED_
+#define _NGX_HTTP_PERL_MODULE_H_INCLUDED_
+
+
+#include <ngx_config.h>
+#include <ngx_core.h>
+#include <ngx_http.h>
+
+#include <EXTERN.h>
+#include <perl.h>
+
+
+typedef ngx_http_request_t *nginx;
+
+typedef struct {
+ PerlInterpreter *perl;
+
+ char *filename;
+
+ ngx_str_t redirect_uri;
+ ngx_str_t redirect_args;
+
+ ngx_http_ssi_ctx_t *ssi;
+} ngx_http_perl_ctx_t;
+
+
+extern ngx_module_t ngx_http_perl_module;
+
+
+/*
+ * workaround for "unused variable `Perl___notused'" warning
+ * when building with perl 5.6.1
+ */
+#ifndef PERL_IMPLICIT_CONTEXT
+#undef dTHXa
+#define dTHXa(a)
+#endif
+
+
+extern void boot_DynaLoader (pTHX_ CV* cv);
+
+
+#endif /* _NGX_HTTP_PERL_MODULE_H_INCLUDED_ */
diff --git a/src/http/modules/perl/typemap b/src/http/modules/perl/typemap
new file mode 100644
index 000000000..e2f1a4c6a
--- /dev/null
+++ b/src/http/modules/perl/typemap
@@ -0,0 +1,3 @@
+TYPEMAP
+
+nginx T_PTROBJ