nginx-0.3.21-RELEASE import

*) Feature: the ngx_http_perl_module.

    *) Change: the "valid_referers" directive allows the referreres without
       URI part.

auto/cc/gcc

@@ -172,3 +172,5 @@ CFLAGS="$CFLAGS -g"
 if [ ".$CPP" = "." ]; then
     CPP="$CC -E"
 fi
+
+NGX_PERL_CFLAGS="$CFLAGS"

auto/install

@@ -2,9 +2,23 @@
 # Copyright (C) Igor Sysoev
 
 
+if [ $USE_PERL = YES ]; then
+
+    cat << END                                                >> $NGX_MAKEFILE
+
+install_perl_modules:
+	cd $NGX_OBJS/src/http/modules/perl && make install
+END
+
+    NGX_INSTALL_PERL_MODULES=install_perl_modules
+
+fi
+
+
 cat << END                                                    >> $NGX_MAKEFILE
 
-install:	$NGX_OBJS${ngx_dirsep}nginx${ngx_binext}
+install:	$NGX_OBJS${ngx_dirsep}nginx${ngx_binext}	\
+		$NGX_INSTALL_PERL_MODULES
 	test -d '$NGX_PREFIX' || mkdir -p '$NGX_PREFIX'
 
 	test -d '`dirname "$NGX_SBIN_PATH"`' \

auto/lib/conf

@@ -26,3 +26,7 @@ fi
 if [ $USE_ZLIB = YES ]; then
     . auto/lib/zlib/conf
 fi
+
+if [ $USE_PERL = YES ]; then
+    . auto/lib/perl/conf
+fi

auto/lib/make

@@ -17,3 +17,7 @@ fi
 if [ $ZLIB != NONE -a $ZLIB != NO -a $ZLIB != YES ]; then
     . auto/lib/zlib/make
 fi
+
+if [ $USE_PERL = YES ]; then
+    . auto/lib/perl/make
+fi

auto/lib/perl/conf

@@ -0,0 +1,53 @@
+
+# Copyright (C) Igor Sysoev
+
+
+echo "checking for perl"
+
+
+NGX_PERL_VER=`$NGX_PERL -v 2>&1 | grep '^This is perl' 2>&1 \
+                                | sed -e 's/^This is perl, \(.*\)/\1/'`
+
+if test -n "$NGX_PERL_VER"; then
+    echo " + perl version: $NGX_PERL_VER"
+
+    if [ "`echo 'use 5.006001; print "OK"' | $NGX_PERL 2>&1`" != OK ]; then
+        echo
+        echo "$0: error: perl 5.6.1 or higher is required"
+        echo
+
+        exit 1;
+    fi
+
+    CFLAGS="$CFLAGS `$NGX_PERL -MExtUtils::Embed -e ccopts`"
+    ngx_perl_ldopts=`$NGX_PERL -MExtUtils::Embed -e ldopts`
+
+    if $NGX_PERL -V:usemultiplicity | grep define > /dev/null; then
+        have=NGX_HAVE_PERL_MULTIPLICITY . auto/have
+        echo " + perl interpreter multiplicity found"
+    fi
+
+    if $NGX_PERL -V:useithreads | grep define > /dev/null; then
+        have=NGX_HAVE_PERL_CLONE . auto/have
+        echo " + perl_clone() found"
+
+    else
+        # FreeBSD port wants to link with -pthread non-threaded perl
+        ngx_perl_ldopts=`echo $ngx_perl_ldopts | sed 's/ -pthread//'`
+    fi
+
+    CORE_LINK="$CORE_LINK $ngx_perl_ldopts"
+    LINK_DEPS="$LINK_DEPS $NGX_OBJS/src/http/modules/perl/blib/arch/auto/nginx/nginx.so"
+
+    if test -n "$NGX_PERL_MODULES"; then
+        have=NGX_PERL_MODULES value="(u_char *) \"$NGX_PERL_MODULES\""
+        . auto/define
+    fi
+
+else
+    echo
+    echo "$0: error: perl 5.6.1 or higher is required"
+    echo
+
+    exit 1;
+fi

auto/lib/perl/make

@@ -0,0 +1,33 @@
+
+# Copyright (C) Igor Sysoev
+
+
+cat << END                                                    >> $NGX_MAKEFILE
+
+$NGX_OBJS/src/http/modules/perl/blib/arch/auto/nginx/nginx.so:		\
+		src/http/modules/perl/nginx.pm				\
+		src/http/modules/perl/nginx.xs				\
+		src/http/modules/perl/ngx_http_perl_module.h		\
+		$NGX_OBJS/src/http/modules/perl/Makefile
+
+	cp -p src/http/modules/perl/nginx.* $NGX_OBJS/src/http/modules/perl/
+
+	cd $NGX_OBJS/src/http/modules/perl && make
+
+
+$NGX_OBJS/src/http/modules/perl/Makefile: src/http/modules/perl/Makefile.PL
+
+	cp -p src/http/modules/perl/nginx.* $NGX_OBJS/src/http/modules/perl/
+	cp -p src/http/modules/perl/typemap $NGX_OBJS/src/http/modules/perl/
+	cp -p src/http/modules/perl/Makefile.PL $NGX_OBJS/src/http/modules/perl/
+
+	cd $NGX_OBJS/src/http/modules/perl				\
+		&& NGX_PERL_CFLAGS="$NGX_PERL_CFLAGS"			\
+			NGX_PCRE=$PCRE					\
+			NGX_ZLIB=$ZLIB					\
+			NGX_OBJS=$NGX_OBJS				\
+		$NGX_PERL Makefile.PL					\
+			LIB=$NGX_PERL_MODULES
+
+
+END

auto/make

@@ -5,7 +5,7 @@
 mkdir -p $NGX_OBJS/src/core $NGX_OBJS/src/event $NGX_OBJS/src/event/modules \
          $NGX_OBJS/src/os/unix $NGX_OBJS/src/os/win32 \
          $NGX_OBJS/src/http $NGX_OBJS/src/http/modules \
-	 $NGX_OBJS/src/http/modules/proxy \
+	 $NGX_OBJS/src/http/modules/perl \
          $NGX_OBJS/src/imap
 
 

auto/modules

@@ -191,7 +191,6 @@ if [ $HTTP_PROXY = YES ]; then
     have=NGX_HTTP_PROXY . auto/have
     #USE_MD5=YES
     HTTP_MODULES="$HTTP_MODULES $HTTP_PROXY_MODULE"
-    HTTP_INCS="$HTTP_INCS $HTTP_PROXY_INCS"
     HTTP_DEPS="$HTTP_DEPS $HTTP_PROXY_DEPS"
     HTTP_SRCS="$HTTP_SRCS $HTTP_PROXY_SRCS"
 fi
@@ -201,6 +200,15 @@ if [ $HTTP_FASTCGI = YES ]; then
     HTTP_SRCS="$HTTP_SRCS $HTTP_FASTCGI_SRCS"
 fi
 
+if [ $HTTP_PERL = YES ]; then
+    USE_PERL=YES
+    have=NGX_HTTP_PERL . auto/have
+    HTTP_MODULES="$HTTP_MODULES $HTTP_PERL_MODULE"
+    HTTP_INCS="$HTTP_INCS $HTTP_PERL_INCS"
+    HTTP_DEPS="$HTTP_DEPS $HTTP_PERL_DEPS"
+    HTTP_SRCS="$HTTP_SRCS $HTTP_PERL_SRCS"
+fi
+
 if [ $HTTP_MEMCACHED = YES ]; then
     HTTP_MODULES="$HTTP_MODULES $HTTP_MEMCACHED_MODULE"
     HTTP_SRCS="$HTTP_SRCS $HTTP_MEMCACHED_SRCS"

auto/options

@@ -62,6 +62,7 @@ HTTP_REFERER=YES
 HTTP_REWRITE=YES
 HTTP_PROXY=YES
 HTTP_FASTCGI=YES
+HTTP_PERL=NO
 HTTP_MEMCACHED=YES
 HTTP_EMPTY_GIF=YES
 
@@ -90,6 +91,9 @@ ZLIB=NONE
 ZLIB_OPT=
 ZLIB_ASM=NO
 
+USE_PERL=NO
+NGX_PERL=perl
+
 NGX_CPU_CACHE_LINE=
 
 
@@ -150,6 +154,10 @@ do
         --without-http_memcached_module) HTTP_MEMCACHED=NO          ;;
         --without-http_empty_gif_module) HTTP_EMPTY_GIF=NO          ;;
 
+        --with-http_perl_module)         HTTP_PERL=YES              ;;
+        --with-perl_modules_path=*)      NGX_PERL_MODULES="$value"  ;;
+        --with-perl=*)                   NGX_PERL="$value"          ;;
+
         # STUB
         --with-http_stub_status_module)  HTTP_STUB_STATUS=YES       ;;
 
@@ -235,6 +243,10 @@ cat << END
   --without-http_memcached_module    disable ngx_http_memcached_module
   --without-http_empty_gif_module    disable ngx_http_empty_gif_module
 
+  --with-http_perl_module            enable ngx_http_perl_module
+  --with-perl_modules_path=PATH      set path to the perl modules
+  --with-perl=PATH                   set path to the perl binary
+
   --http-log-path=PATH               set path to the http access log
   --http-client-body-temp-path=PATH  set path to the http client request body
                                      temporary files path
@@ -414,3 +426,16 @@ case ".$NGX_HTTP_FASTCGI_TEMP_PATH" in
         NGX_HTTP_FASTCGI_TEMP_PATH=$NGX_PREFIX/$NGX_HTTP_FASTCGI_TEMP_PATH
     ;;
 esac
+
+
+case ".$NGX_PERL_MODULES" in
+    ./*)
+    ;;
+
+    .)
+    ;;
+
+    *)
+        NGX_PERL_MODULES=$NGX_PREFIX/$NGX_PERL_MODULES
+    ;;
+esac

auto/sources

@@ -360,6 +360,12 @@ HTTP_FASTCGI_MODULE=ngx_http_fastcgi_module
 HTTP_FASTCGI_SRCS=src/http/modules/ngx_http_fastcgi_module.c
 
 
+HTTP_PERL_MODULE=ngx_http_perl_module
+HTTP_PERL_INCS=src/http/modules/perl
+HTTP_PERL_DEPS=src/http/modules/perl/ngx_http_perl_module.h
+HTTP_PERL_SRCS=src/http/modules/perl/ngx_http_perl_module.c
+
+
 HTTP_MEMCACHED_MODULE=ngx_http_memcached_module
 HTTP_MEMCACHED_SRCS=src/http/modules/ngx_http_memcached_module.c
 

docs/xml/nginx/changes.xml

@@ -9,6 +9,29 @@
 <title lang="en">nginx changelog</title>
 
 
+<changes ver="0.3.21" date="16.01.2006">
+
+<change type="feature">
+<para lang="ru">
+ÍÏÄÕÌØ ngx_http_perl_module.
+</para>
+<para lang="en">
+the ngx_http_perl_module.
+</para>
+</change>
+
+<change type="change">
+<para lang="ru">
+ÄÉÒÅËÔÉ×Á valid_referers ÒÁÚÒÅÛÁÅÔ ÉÓÐÏÌØÚÏ×ÁÔØ ÒÅÆÅÒÅÒÙ cÏ×ÓÅÍ ÂÅÚ URI.
+</para>
+<para lang="en">
+the "valid_referers" directive allows the referreres without URI part.
+</para>
+</change>
+
+</changes>
+
+
 <changes ver="0.3.20" date="11.01.2006">
 
 <change type="bugfix">

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"

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;
     }

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;
 

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),

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'
+    }
+);

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

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;
+        }
+    }

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
+}

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_ */

src/http/modules/perl/typemap

@@ -0,0 +1,3 @@
+TYPEMAP
+
+nginx	T_PTROBJ