Added Perl support.

auto/help

@@ -45,4 +45,7 @@ cat << END
   go OPTIONS           configure Go module
                        run "./configure go --help" to see available options
 
+  perl OPTIONS         configure Perl module
+                       run "./configure perl --help" to see available options
+
 END

auto/modules/conf

@@ -17,6 +17,10 @@ case "$nxt_module" in
        . auto/modules/go
    ;;
 
+   perl)
+       . auto/modules/perl
+   ;;
+
    *)
        echo
        echo $0: error: invalid module \"$nxt_module\".

auto/modules/perl

@@ -0,0 +1,201 @@
+
+# Copyright (C) Alexander Borisov
+# Copyright (C) NGINX, Inc.
+
+
+shift
+
+for nxt_option; do
+
+    case "$nxt_option" in
+        -*=*) value=`echo "$nxt_option" | sed -e 's/[-_a-zA-Z0-9]*=//'`     ;;
+           *) value="" ;;
+    esac
+
+    case "$nxt_option" in
+        --perl=*)      NXT_PERL="$value"                                ;;
+        --include=*)   NXT_PERL_INCPATH="$value"                        ;;
+        --lib-path=*)  NXT_PERL_LIBPATH="$value"                        ;;
+        --lib=*)       NXT_PERL_LIBNAME="$value"                        ;;
+        --module=*)    NXT_PERL_MODULE="$value"                         ;;
+
+        --help)
+            cat << END
+
+    --perl=FILE           set perl executable, default: perl
+    --include=DIRECTORY   set directory path to perl headers
+    --lib-path=DIRECTORY  set directory path to perl library
+    --lib=NAME            set perl library name, default: perl
+    --module=NAME         set unit perl module name
+
+END
+            exit 0
+        ;;
+
+        *)
+            echo
+            echo $0: error: invalid Perl option \"$nxt_option\"
+            echo
+            exit 1
+        ;;
+    esac
+
+done
+
+
+if [ ! -f $NXT_AUTOCONF_DATA ]; then
+   echo
+   echo Please run common $0 before configuring module \"$nxt_module\".
+   echo
+   exit 1
+fi
+
+. $NXT_AUTOCONF_DATA
+
+$echo "configuring Perl module"
+$echo "configuring Perl module ..." >> $NXT_AUTOCONF_ERR
+
+NXT_PERL=${NXT_PERL=perl}
+NXT_PERL_LIBNAME=${NXT_PERL_LIBNAME=perl}
+NXT_PERL_MODULE=${NXT_PERL_MODULE=${NXT_PERL##*/}}
+NXT_PERL_LDLIBPATH=""
+
+nxt_found=no
+
+if /bin/sh -c "$NXT_PERL -MConfig -e 'print \"Perl version: \",
+    \$Config{version}, \"\\n\"'" >> $NXT_AUTOCONF_ERR 2>&1; then
+
+    NXT_PERL_INCPATH=${NXT_PERL_INCPATH=`$NXT_PERL -MConfig -e 'print $Config{archlib}, "/CORE"'`}
+    NXT_PERL_LIBPATH=${NXT_PERL_LIBPATH=`$NXT_PERL -MConfig -e 'print $Config{libspath}'`}
+
+    for nxt_src in $NXT_PERL_LIBPATH
+    do
+        NXT_PERL_LDLIBPATH="${NXT_PERL_LDLIBPATH} -L ${nxt_src}"
+    done
+
+    NXT_PERL_INCLUDE="-I ${NXT_PERL_INCPATH}"
+    NXT_PERL_LIBS="-L ${NXT_PERL_INCPATH} ${NXT_PERL_LDLIBPATH} -l${NXT_PERL_LIBNAME}"
+
+    nxt_feature="Perl"
+    nxt_feature_name=""
+    nxt_feature_run=no
+    nxt_feature_incs="${NXT_PERL_INCLUDE}"
+    nxt_feature_libs="${NXT_PERL_LIBS}"
+    nxt_feature_test="
+        #include <EXTERN.h>
+        #include <perl.h>
+
+        static PerlInterpreter *my_perl;
+
+        int main() {
+            char argv[] = \"\\0-e\\00\";
+            char *embedding[] = { &argv[0], &argv[1], &argv[4] };
+
+            int pargc = 0;
+            char **pargv = NULL, **penv = NULL;
+            PERL_SYS_INIT3(&pargc, &pargv, &penv);
+
+            my_perl = perl_alloc();
+            perl_construct(my_perl);
+            perl_parse(my_perl, NULL, 3, embedding, NULL);
+            PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
+            perl_run(my_perl);
+
+            perl_destruct(my_perl);
+            perl_free(my_perl);
+            PERL_SYS_TERM();
+
+            return 0;
+        }"
+
+    . auto/feature
+
+else
+    $echo "checking for Perl ... not found"
+fi
+
+if [ $nxt_found = no ]; then
+    $echo
+    $echo $0: error: no Perl found.
+    $echo
+    exit 1;
+fi
+
+NXT_PERL_VERSION=`$NXT_PERL -MConfig -e 'print $Config{version}'`
+$echo " + Perl version: ${NXT_PERL_VERSION}"
+
+if grep ^$NXT_PERL_MODULE: $NXT_MAKEFILE 2>&1 > /dev/null; then
+    $echo
+    $echo $0: error: duplicate \"$NXT_PERL_MODULE\" module configured.
+    $echo
+    exit 1;
+fi
+
+$echo " + Perl module: ${NXT_PERL_MODULE}.unit.so"
+
+. auto/cc/deps
+
+$echo >> $NXT_MAKEFILE
+
+NXT_PERL_MODULE_SRCS=" \
+    src/perl/nxt_perl_psgi.c \
+    src/perl/nxt_perl_psgi_layer.c
+"
+
+# The Perl module object files.
+
+nxt_objs=
+
+for nxt_src in $NXT_PERL_MODULE_SRCS; do
+
+    nxt_obj=${nxt_src%.c}-$NXT_PERL_MODULE.o
+    nxt_dep=${nxt_src%.c}-$NXT_PERL_MODULE.dep
+    nxt_dep_flags=`nxt_gen_dep_flags`
+    nxt_dep_post=`nxt_gen_dep_post`
+    nxt_objs="$nxt_objs $NXT_BUILD_DIR/$nxt_obj"
+
+    cat << END >> $NXT_MAKEFILE
+
+$NXT_BUILD_DIR/$nxt_obj:	$nxt_src
+	mkdir -p $NXT_BUILD_DIR/src/perl
+	\$(CC) -c \$(CFLAGS) \$(NXT_INCS) $NXT_PERL_INCLUDE \\
+	$nxt_dep_flags \\
+	-o $NXT_BUILD_DIR/$nxt_obj $nxt_src
+	$nxt_dep_post
+
+-include $NXT_BUILD_DIR/$nxt_dep
+
+END
+
+done
+
+cat << END >> $NXT_MAKEFILE
+
+.PHONY: ${NXT_PERL_MODULE}
+.PHONY: ${NXT_PERL_MODULE}-install
+.PHONY: ${NXT_PERL_MODULE}-uninstall
+
+all: ${NXT_PERL_MODULE}
+
+${NXT_PERL_MODULE}:	$NXT_BUILD_DIR/${NXT_PERL_MODULE}.unit.so
+
+$NXT_BUILD_DIR/${NXT_PERL_MODULE}.unit.so:	$nxt_objs
+	\$(NXT_MODULE_LINK) -o $NXT_BUILD_DIR/${NXT_PERL_MODULE}.unit.so \\
+	$nxt_objs $NXT_PERL_LIBS $NXT_LD_OPT
+
+
+install: ${NXT_PERL_MODULE}-install
+
+${NXT_PERL_MODULE}-install: ${NXT_PERL_MODULE}
+	install -d \$(DESTDIR)$NXT_MODULES
+	install -p $NXT_BUILD_DIR/${NXT_PERL_MODULE}.unit.so \\
+		\$(DESTDIR)$NXT_MODULES/
+
+
+uninstall: ${NXT_PERL_MODULE}-uninstall
+
+${NXT_PERL_MODULE}-uninstall:
+	rm -f \$(DESTDIR)$NXT_MODULES/${NXT_PERL_MODULE}.unit.so
+	@rmdir -p \$(DESTDIR)$NXT_MODULES 2>/dev/null || true
+
+END

auto/os/conf

@@ -104,7 +104,7 @@ case "$NXT_SYSTEM" in
         # MacOSX 10.7 (Lion) has deprecated system OpenSSL.
         # MAC_OS_X_VERSION_MIN_REQUIRED macro does not help.
         # "-rpath" is supported since MacOSX 10.5 (Leopard).
-        NXT_CFLAGS="$NXT_CFLAGS -mmacosx-version-min=10.5"
+        NXT_CFLAGS="$NXT_CFLAGS -mmacosx-version-min=10.6"
 
         NXT_STATIC_LINK="ar -r -c"
         NXT_SHARED_LINK="\$(CC) -dynamiclib"

src/nxt_application.c

@@ -28,8 +28,6 @@ static nxt_int_t nxt_discovery_module(nxt_task_t *task, nxt_mp_t *mp,
     nxt_array_t *modules, const char *name);
 static nxt_app_module_t *nxt_app_module_load(nxt_task_t *task,
     const char *name);
-static nxt_app_type_t nxt_app_parse_type(u_char *p, size_t length);
-
 
 static void nxt_app_http_release(nxt_task_t *task, void *obj, void *data);
 
@@ -841,7 +839,7 @@ nxt_app_lang_module(nxt_runtime_t *rt, nxt_str_t *name)
 }
 
 
-static nxt_app_type_t
+nxt_app_type_t
 nxt_app_parse_type(u_char *p, size_t length)
 {
     nxt_str_t str;
@@ -858,6 +856,8 @@ nxt_app_parse_type(u_char *p, size_t length)
     } else if (nxt_str_eq(&str, "go", 2)) {
         return NXT_APP_GO;
 
+    } else if (nxt_str_eq(&str, "perl", 4)) {
+        return NXT_APP_PERL;
     }
 
     return NXT_APP_UNKNOWN;

src/nxt_application.h

@@ -13,6 +13,7 @@ typedef enum {
     NXT_APP_PYTHON,
     NXT_APP_PHP,
     NXT_APP_GO,
+    NXT_APP_PERL,
 
     NXT_APP_UNKNOWN,
 } nxt_app_type_t;
@@ -52,6 +53,11 @@ typedef struct {
 } nxt_go_app_conf_t;
 
 
+typedef struct {
+    char       *script;
+} nxt_perl_app_conf_t;
+
+
 struct nxt_common_app_conf_s {
     nxt_str_t       name;
     nxt_str_t       type;
@@ -64,6 +70,7 @@ struct nxt_common_app_conf_s {
         nxt_python_app_conf_t  python;
         nxt_php_app_conf_t     php;
         nxt_go_app_conf_t      go;
+        nxt_perl_app_conf_t    perl;
     } u;
 };
 
@@ -289,7 +296,7 @@ nxt_app_msg_read_length(u_char *src, size_t *length)
 
 
 nxt_app_lang_module_t *nxt_app_lang_module(nxt_runtime_t *rt, nxt_str_t *name);
-
+nxt_app_type_t nxt_app_parse_type(u_char *p, size_t length);
 
 extern nxt_application_module_t  nxt_go_module;
 

src/nxt_conf_validation.c

@@ -214,6 +214,16 @@ static nxt_conf_vldt_object_t  nxt_conf_vldt_go_members[] = {
 };
 
 
+static nxt_conf_vldt_object_t  nxt_conf_vldt_perl_members[] = {
+    { nxt_string("script"),
+      NXT_CONF_VLDT_STRING,
+      NULL,
+      NULL },
+
+    NXT_CONF_VLDT_NEXT(&nxt_conf_vldt_common_members)
+};
+
+
 nxt_int_t
 nxt_conf_validate(nxt_conf_validation_t *vldt)
 {
@@ -402,6 +412,7 @@ nxt_conf_vldt_app(nxt_conf_validation_t *vldt, nxt_str_t *name,
         nxt_conf_vldt_python_members,
         nxt_conf_vldt_php_members,
         nxt_conf_vldt_go_members,
+        nxt_conf_vldt_perl_members,
     };
 
     ret = nxt_conf_vldt_type(vldt, name, value, NXT_CONF_VLDT_OBJECT);

src/nxt_main_process.c

@@ -20,6 +20,12 @@ typedef struct {
 } nxt_listening_socket_t;
 
 
+typedef struct {
+    nxt_int_t       size;
+    nxt_conf_map_t  *map;
+} nxt_common_app_member_t;
+
+
 static nxt_int_t nxt_main_process_port_create(nxt_task_t *task,
     nxt_runtime_t *rt);
 static void nxt_main_process_title(nxt_task_t *task);
@@ -113,7 +119,10 @@ static nxt_conf_map_t  nxt_common_app_conf[] = {
         NXT_CONF_MAP_CSTRZ,
         offsetof(nxt_common_app_conf_t, working_directory),
     },
+};
 
+
+static nxt_conf_map_t  nxt_common_python_app_conf[] = {
     {
         nxt_string("home"),
         NXT_CONF_MAP_CSTRZ,
@@ -131,7 +140,10 @@ static nxt_conf_map_t  nxt_common_app_conf[] = {
         NXT_CONF_MAP_STR,
         offsetof(nxt_common_app_conf_t, u.python.module),
     },
+};
 
+
+static nxt_conf_map_t  nxt_common_php_app_conf[] = {
     {
         nxt_string("root"),
         NXT_CONF_MAP_CSTRZ,
@@ -149,7 +161,10 @@ static nxt_conf_map_t  nxt_common_app_conf[] = {
         NXT_CONF_MAP_STR,
         offsetof(nxt_common_app_conf_t, u.php.index),
     },
+};
 
+
+static nxt_conf_map_t  nxt_common_go_app_conf[] = {
     {
         nxt_string("executable"),
         NXT_CONF_MAP_CSTRZ,
@@ -158,6 +173,23 @@ static nxt_conf_map_t  nxt_common_app_conf[] = {
 };
 
 
+static nxt_conf_map_t  nxt_common_perl_app_conf[] = {
+    {
+        nxt_string("script"),
+        NXT_CONF_MAP_CSTRZ,
+        offsetof(nxt_common_app_conf_t, u.perl.script),
+    },
+};
+
+
+static nxt_common_app_member_t  nxt_common_members[] = {
+    { nxt_nitems(nxt_common_python_app_conf), nxt_common_python_app_conf },
+    { nxt_nitems(nxt_common_php_app_conf),    nxt_common_php_app_conf },
+    { nxt_nitems(nxt_common_go_app_conf),     nxt_common_go_app_conf },
+    { nxt_nitems(nxt_common_perl_app_conf),   nxt_common_perl_app_conf },
+};
+
+
 static void
 nxt_port_main_data_handler(nxt_task_t *task, nxt_port_recv_msg_t *msg)
 {
@@ -171,7 +203,7 @@ nxt_port_main_start_worker_handler(nxt_task_t *task, nxt_port_recv_msg_t *msg)
 {
     u_char                 *start;
     nxt_mp_t               *mp;
-    nxt_int_t              ret;
+    nxt_int_t              ret, idx;
     nxt_buf_t              *b;
     nxt_port_t             *port;
     nxt_conf_value_t       *conf;
@@ -219,10 +251,18 @@ nxt_port_main_start_worker_handler(nxt_task_t *task, nxt_port_recv_msg_t *msg)
                               nxt_nitems(nxt_common_app_conf), &app_conf);
     if (ret != NXT_OK) {
         nxt_log(task, NXT_LOG_CRIT, "root map error");
-
         goto failed;
     }
 
+    idx = nxt_app_parse_type(app_conf.type.start, app_conf.type.length);
+
+    nxt_assert(ret != NXT_APP_UNKNOWN);
+
+    ret = nxt_conf_map_object(mp, conf, nxt_common_members[idx].map,
+                              nxt_common_members[idx].size, &app_conf);
+
+    nxt_assert(ret == NXT_OK);
+
     ret = nxt_main_start_worker_process(task, task->thread->runtime,
                                         &app_conf, msg->port_msg.stream);
 

src/nxt_router.c

@@ -223,6 +223,9 @@ static nxt_int_t nxt_php_prepare_msg(nxt_task_t *task, nxt_app_request_t *r,
     nxt_app_wmsg_t *wmsg);
 static nxt_int_t nxt_go_prepare_msg(nxt_task_t *task, nxt_app_request_t *r,
     nxt_app_wmsg_t *wmsg);
+static nxt_int_t nxt_perl_prepare_msg(nxt_task_t *task, nxt_app_request_t *r,
+    nxt_app_wmsg_t *wmsg);
+
 static void nxt_router_conn_free(nxt_task_t *task, void *obj, void *data);
 static void nxt_router_app_timeout(nxt_task_t *task, void *obj, void *data);
 static void nxt_router_adjust_idle_timer(nxt_task_t *task, void *obj,
@@ -242,6 +245,7 @@ static nxt_app_prepare_msg_t  nxt_app_prepare_msg[] = {
     nxt_python_prepare_msg,
     nxt_php_prepare_msg,
     nxt_go_prepare_msg,
+    nxt_perl_prepare_msg,
 };
 
 
@@ -3791,7 +3795,7 @@ nxt_python_prepare_msg(nxt_task_t *task, nxt_app_request_t *r,
 
     RC(nxt_app_msg_write_size(task, wmsg, r->body.preread_size));
 
-    for(b = r->body.buf; b != NULL; b = b->next) {
+    for (b = r->body.buf; b != NULL; b = b->next) {
         RC(nxt_app_msg_write_raw(task, wmsg, b->mem.pos,
                                  nxt_buf_mem_used_size(&b->mem)));
     }
@@ -3877,7 +3881,7 @@ nxt_php_prepare_msg(nxt_task_t *task, nxt_app_request_t *r,
                      && h->method.start[3] == 'T';
 
     if (method_is_post) {
-        for(b = r->body.buf; b != NULL; b = b->next) {
+        for (b = r->body.buf; b != NULL; b = b->next) {
             RC(nxt_app_msg_write_raw(task, wmsg, b->mem.pos,
                                      nxt_buf_mem_used_size(&b->mem)));
         }
@@ -3894,7 +3898,7 @@ nxt_php_prepare_msg(nxt_task_t *task, nxt_app_request_t *r,
     NXT_WRITE(&eof);
 
     if (!method_is_post) {
-        for(b = r->body.buf; b != NULL; b = b->next) {
+        for (b = r->body.buf; b != NULL; b = b->next) {
             RC(nxt_app_msg_write_raw(task, wmsg, b->mem.pos,
                                      nxt_buf_mem_used_size(&b->mem)));
         }
@@ -3974,7 +3978,92 @@ nxt_go_prepare_msg(nxt_task_t *task, nxt_app_request_t *r, nxt_app_wmsg_t *wmsg)
 
     RC(nxt_app_msg_write_size(task, wmsg, r->body.preread_size));
 
-    for(b = r->body.buf; b != NULL; b = b->next) {
+    for (b = r->body.buf; b != NULL; b = b->next) {
+        RC(nxt_app_msg_write_raw(task, wmsg, b->mem.pos,
+                                 nxt_buf_mem_used_size(&b->mem)));
+    }
+
+#undef NXT_WRITE
+#undef RC
+
+    return NXT_OK;
+
+fail:
+
+    return NXT_ERROR;
+}
+
+
+static nxt_int_t
+nxt_perl_prepare_msg(nxt_task_t *task, nxt_app_request_t *r,
+    nxt_app_wmsg_t *wmsg)
+{
+    nxt_int_t                 rc;
+    nxt_str_t                 str;
+    nxt_buf_t                 *b;
+    nxt_http_field_t          *field;
+    nxt_app_request_header_t  *h;
+
+    static const nxt_str_t prefix = nxt_string("HTTP_");
+    static const nxt_str_t eof = nxt_null_string;
+
+    h = &r->header;
+
+#define RC(S)                                                                 \
+    do {                                                                      \
+        rc = (S);                                                             \
+        if (nxt_slow_path(rc != NXT_OK)) {                                    \
+            goto fail;                                                        \
+        }                                                                     \
+    } while(0)
+
+#define NXT_WRITE(N)                                                          \
+    RC(nxt_app_msg_write_str(task, wmsg, N))
+
+    /* TODO error handle, async mmap buffer assignment */
+
+    NXT_WRITE(&h->method);
+    NXT_WRITE(&h->target);
+
+    if (h->query.length) {
+        str.start = h->target.start;
+        str.length = (h->target.length - h->query.length) - 1;
+
+        RC(nxt_app_msg_write_str(task, wmsg, &str));
+
+    } else {
+        NXT_WRITE(&eof);
+    }
+
+    if (h->query.start != NULL) {
+        RC(nxt_app_msg_write_size(task, wmsg,
+                                  h->query.start - h->target.start + 1));
+    } else {
+        RC(nxt_app_msg_write_size(task, wmsg, 0));
+    }
+
+    NXT_WRITE(&h->version);
+
+    NXT_WRITE(&r->remote);
+    NXT_WRITE(&r->local);
+
+    NXT_WRITE(&h->host);
+    NXT_WRITE(&h->content_type);
+    NXT_WRITE(&h->content_length);
+
+    nxt_list_each(field, h->fields) {
+        RC(nxt_app_msg_write_prefixed_upcase(task, wmsg, &prefix,
+                                             field->name, field->name_length));
+        RC(nxt_app_msg_write(task, wmsg, field->value, field->value_length));
+    } nxt_list_loop;
+
+    /* end-of-headers mark */
+    NXT_WRITE(&eof);
+
+    RC(nxt_app_msg_write_size(task, wmsg, r->body.preread_size));
+
+    for (b = r->body.buf; b != NULL; b = b->next) {
+
         RC(nxt_app_msg_write_raw(task, wmsg, b->mem.pos,
                                  nxt_buf_mem_used_size(&b->mem)));
     }

src/perl/nxt_perl_psgi_layer.c

@@ -0,0 +1,436 @@
+
+/*
+ * Copyright (C) Alexander Borisov
+ * Copyright (C) NGINX, Inc.
+ */
+
+#include <perl/nxt_perl_psgi_layer.h>
+
+
+typedef struct {
+    struct _PerlIO  base;
+
+    SV              *var;
+} nxt_perl_psgi_layer_stream_t;
+
+
+static IV nxt_perl_psgi_layer_stream_pushed(pTHX_ PerlIO *f, const char *mode,
+    SV *arg, PerlIO_funcs *tab);
+static IV nxt_perl_psgi_layer_stream_popped(pTHX_ PerlIO *f);
+
+static PerlIO *nxt_perl_psgi_layer_stream_open(pTHX_ PerlIO_funcs *self,
+    PerlIO_list_t *layers, IV n,
+    const char *mode, int fd, int imode, int perm,
+    PerlIO *f, int narg, SV **args);
+
+static IV nxt_perl_psgi_layer_stream_close(pTHX_ PerlIO *f);
+
+static SSize_t nxt_perl_psgi_layer_stream_read(pTHX_ PerlIO *f,
+    void *vbuf, Size_t count);
+static SSize_t nxt_perl_psgi_layer_stream_write(pTHX_ PerlIO *f,
+    const void *vbuf, Size_t count);
+
+static IV nxt_perl_psgi_layer_stream_fileno(pTHX_ PerlIO *f);
+static IV nxt_perl_psgi_layer_stream_seek(pTHX_ PerlIO *f,
+    Off_t offset, int whence);
+static Off_t nxt_perl_psgi_layer_stream_tell(pTHX_ PerlIO *f);
+static IV nxt_perl_psgi_layer_stream_fill(pTHX_ PerlIO *f);
+static IV nxt_perl_psgi_layer_stream_flush(pTHX_ PerlIO *f);
+
+static SV *nxt_perl_psgi_layer_stream_arg(pTHX_ PerlIO *f,
+    CLONE_PARAMS *param, int flags);
+
+static PerlIO *nxt_perl_psgi_layer_stream_dup(pTHX_ PerlIO *f, PerlIO *o,
+    CLONE_PARAMS *param, int flags);
+static IV nxt_perl_psgi_layer_stream_eof(pTHX_ PerlIO *f);
+
+static STDCHAR *nxt_perl_psgi_layer_stream_get_base(pTHX_ PerlIO *f);
+static STDCHAR *nxt_perl_psgi_layer_stream_get_ptr(pTHX_ PerlIO *f);
+static SSize_t nxt_perl_psgi_layer_stream_get_cnt(pTHX_ PerlIO *f);
+static Size_t nxt_perl_psgi_layer_stream_buffersize(pTHX_ PerlIO *f);
+static void nxt_perl_psgi_layer_stream_set_ptrcnt(pTHX_ PerlIO *f,
+    STDCHAR *ptr, SSize_t cnt);
+
+
+static PERLIO_FUNCS_DECL(PerlIO_NGINX_Unit) = {
+    sizeof(PerlIO_funcs),
+    "NGINX_Unit_PSGI_Layer_Stream",
+    sizeof(nxt_perl_psgi_layer_stream_t),
+    PERLIO_K_BUFFERED | PERLIO_K_RAW,
+    nxt_perl_psgi_layer_stream_pushed,
+    nxt_perl_psgi_layer_stream_popped,
+    nxt_perl_psgi_layer_stream_open,
+    PerlIOBase_binmode,
+    nxt_perl_psgi_layer_stream_arg,
+    nxt_perl_psgi_layer_stream_fileno,
+    nxt_perl_psgi_layer_stream_dup,
+    nxt_perl_psgi_layer_stream_read,
+    NULL,
+    nxt_perl_psgi_layer_stream_write,
+    nxt_perl_psgi_layer_stream_seek,
+    nxt_perl_psgi_layer_stream_tell,
+    nxt_perl_psgi_layer_stream_close,
+    nxt_perl_psgi_layer_stream_flush,
+    nxt_perl_psgi_layer_stream_fill,
+    nxt_perl_psgi_layer_stream_eof,
+    PerlIOBase_error,
+    PerlIOBase_clearerr,
+    PerlIOBase_setlinebuf,
+    nxt_perl_psgi_layer_stream_get_base,
+    nxt_perl_psgi_layer_stream_buffersize,
+    nxt_perl_psgi_layer_stream_get_ptr,
+    nxt_perl_psgi_layer_stream_get_cnt,
+    nxt_perl_psgi_layer_stream_set_ptrcnt,
+};
+
+
+static IV
+nxt_perl_psgi_layer_stream_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg,
+    PerlIO_funcs *tab)
+{
+    nxt_perl_psgi_layer_stream_t  *unit_stream;
+
+    unit_stream = PerlIOSelf(f, nxt_perl_psgi_layer_stream_t);
+
+    if (arg != NULL && SvOK(arg)) {
+        unit_stream->var = arg;
+    }
+
+    SvSETMAGIC(unit_stream->var);
+
+    return PerlIOBase_pushed(aTHX_ f, mode, Nullsv, tab);
+}
+
+
+static IV
+nxt_perl_psgi_layer_stream_popped(pTHX_ PerlIO *f)
+{
+    nxt_perl_psgi_layer_stream_t  *unit_stream;
+
+    unit_stream = PerlIOSelf(f, nxt_perl_psgi_layer_stream_t);
+
+    if (unit_stream->var != NULL) {
+        SvREFCNT_dec(unit_stream->var);
+        unit_stream->var = Nullsv;
+    }
+
+    return 0;
+}
+
+
+static PerlIO *
+nxt_perl_psgi_layer_stream_open(pTHX_ PerlIO_funcs *self,
+    PerlIO_list_t *layers, IV n,
+    const char *mode, int fd, int imode, int perm,
+    PerlIO *f, int narg, SV **args)
+{
+    SV  *arg;
+
+    arg = (narg > 0) ? *args : PerlIOArg;
+
+    PERL_UNUSED_ARG(fd);
+    PERL_UNUSED_ARG(imode);
+    PERL_UNUSED_ARG(perm);
+
+    if (SvROK(arg) || SvPOK(arg)) {
+
+        if (f == NULL) {
+            f = PerlIO_allocate(aTHX);
+        }
+
+        f = PerlIO_push(aTHX_ f, self, mode, arg);
+
+        if (f != NULL) {
+            PerlIOBase(f)->flags |= PERLIO_F_OPEN;
+        }
+
+        return f;
+    }
+
+    return NULL;
+}
+
+
+static IV
+nxt_perl_psgi_layer_stream_close(pTHX_ PerlIO *f)
+{
+    IV  code;
+
+    code = PerlIOBase_close(aTHX_ f);
+    PerlIOBase(f)->flags &= ~(PERLIO_F_RDBUF | PERLIO_F_WRBUF);
+
+    return code;
+}
+
+
+static IV
+nxt_perl_psgi_layer_stream_fileno(pTHX_ PerlIO *f)
+{
+    PERL_UNUSED_ARG(f);
+    return -1;
+}
+
+
+static SSize_t
+nxt_perl_psgi_layer_stream_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
+{
+    nxt_perl_psgi_io_arg_t        *arg;
+    nxt_perl_psgi_layer_stream_t  *unit_stream;
+
+    if (f == NULL) {
+        return 0;
+    }
+
+    unit_stream = PerlIOSelf(f, nxt_perl_psgi_layer_stream_t);
+    arg = (nxt_perl_psgi_io_arg_t *) (intptr_t) SvIV(SvRV(unit_stream->var));
+
+    if ((PerlIOBase(f)->flags & PERLIO_F_CANREAD) == 0) {
+        PerlIOBase(f)->flags |= PERLIO_F_ERROR;
+
+        SETERRNO(EBADF, SS_IVCHAN);
+
+        return 0;
+    }
+
+    return (SSize_t) arg->read(PERL_GET_CONTEXT, arg, vbuf, count);
+}
+
+
+static SSize_t
+nxt_perl_psgi_layer_stream_write(pTHX_ PerlIO *f,
+    const void *vbuf, Size_t count)
+{
+    nxt_perl_psgi_io_arg_t        *arg;
+    nxt_perl_psgi_layer_stream_t  *unit_stream;
+
+    if (PerlIOBase(f)->flags & PERLIO_F_CANWRITE) {
+
+        unit_stream = PerlIOSelf(f, nxt_perl_psgi_layer_stream_t);
+
+        arg = (nxt_perl_psgi_io_arg_t *)
+            (intptr_t) SvIV(SvRV(unit_stream->var));
+
+        return (SSize_t) arg->write(PERL_GET_CONTEXT, arg, vbuf, count);
+    }
+
+    return 0;
+}
+
+
+static IV
+nxt_perl_psgi_layer_stream_seek(pTHX_ PerlIO *f, Off_t offset, int whence)
+{
+    PERL_UNUSED_ARG(f);
+    return 0;
+}
+
+
+static Off_t
+nxt_perl_psgi_layer_stream_tell(pTHX_ PerlIO *f)
+{
+    PERL_UNUSED_ARG(f);
+    return 0;
+}
+
+
+static IV
+nxt_perl_psgi_layer_stream_fill(pTHX_ PerlIO *f)
+{
+    PERL_UNUSED_ARG(f);
+    return -1;
+}
+
+
+static IV
+nxt_perl_psgi_layer_stream_flush(pTHX_ PerlIO *f)
+{
+    nxt_perl_psgi_io_arg_t        *arg;
+    nxt_perl_psgi_layer_stream_t  *unit_stream;
+
+    unit_stream = PerlIOSelf(f, nxt_perl_psgi_layer_stream_t);
+    arg = (nxt_perl_psgi_io_arg_t *) (intptr_t) SvIV(SvRV(unit_stream->var));
+
+    return (IV) arg->flush(PERL_GET_CONTEXT, arg);
+}
+
+
+static SV *
+nxt_perl_psgi_layer_stream_arg(pTHX_ PerlIO * f,
+    CLONE_PARAMS *param, int flags)
+{
+    SV                            *var;
+    nxt_perl_psgi_io_arg_t        *arg;
+    nxt_perl_psgi_layer_stream_t  *unit_stream;
+
+    unit_stream = PerlIOSelf(f, nxt_perl_psgi_layer_stream_t);
+
+    arg = (nxt_perl_psgi_io_arg_t *) (intptr_t) SvIV(SvRV(unit_stream->var));
+    var = unit_stream->var;
+
+    if (flags & PERLIO_DUP_CLONE) {
+        var = PerlIO_sv_dup(aTHX_ var, param);
+
+    } else if (flags & PERLIO_DUP_FD) {
+        var = newSV_type(SVt_RV);
+
+        if (var == NULL) {
+            return NULL;
+        }
+
+        sv_setptrref(var, arg);
+
+    } else {
+        var = SvREFCNT_inc(var);
+    }
+
+    return var;
+}
+
+
+static PerlIO *
+nxt_perl_psgi_layer_stream_dup(pTHX_ PerlIO *f, PerlIO *o,
+    CLONE_PARAMS *param, int flags)
+{
+    SV                            *var;
+    nxt_perl_psgi_layer_stream_t  *os, *fs;
+
+    os = PerlIOSelf(o, nxt_perl_psgi_layer_stream_t);
+    fs = NULL;
+    var = os->var;
+
+    os->var = newSV_type(SVt_RV);
+    f = PerlIOBase_dup(aTHX_ f, o, param, flags);
+
+    if (f != NULL) {
+        fs = PerlIOSelf(f, nxt_perl_psgi_layer_stream_t);
+
+        /* The "var" has been set by an implicit push and must be replaced. */
+        SvREFCNT_dec(fs->var);
+    }
+
+    SvREFCNT_dec(os->var);
+    os->var = var;
+
+    if (f != NULL) {
+        fs->var = nxt_perl_psgi_layer_stream_arg(aTHX_ o, param, flags);
+    }
+
+    return f;
+}
+
+
+static IV
+nxt_perl_psgi_layer_stream_eof(pTHX_ PerlIO *f)
+{
+    return 1;
+}
+
+
+static STDCHAR *
+nxt_perl_psgi_layer_stream_get_base(pTHX_ PerlIO *f)
+{
+    return (STDCHAR *) NULL;
+}
+
+
+static STDCHAR *
+nxt_perl_psgi_layer_stream_get_ptr(pTHX_ PerlIO *f)
+{
+    return (STDCHAR *) NULL;
+}
+
+
+static SSize_t
+nxt_perl_psgi_layer_stream_get_cnt(pTHX_ PerlIO *f)
+{
+    return 0;
+}
+
+
+static Size_t
+nxt_perl_psgi_layer_stream_buffersize(pTHX_ PerlIO *f)
+{
+    return 0;
+}
+
+
+static void
+nxt_perl_psgi_layer_stream_set_ptrcnt(pTHX_ PerlIO *f,
+    STDCHAR *ptr, SSize_t cnt)
+{
+    /* Need some code. */
+}
+
+
+void
+nxt_perl_psgi_layer_stream_init(pTHX)
+{
+    PerlIO_define_layer(aTHX_ PERLIO_FUNCS_CAST(&PerlIO_NGINX_Unit));
+}
+
+
+PerlIO *
+nxt_perl_psgi_layer_stream_fp_create(pTHX_ nxt_perl_psgi_io_arg_t *arg,
+    const char *mode)
+{
+    SV      *arg_rv;
+    PerlIO  *fp;
+
+    arg_rv = newSV_type(SVt_RV);
+
+    if (arg_rv == NULL) {
+        return NULL;
+    }
+
+    sv_setptrref(arg_rv, arg);
+
+    fp = PerlIO_openn(aTHX_ "NGINX_Unit_PSGI_Layer_Stream",
+                      mode, 0, 0, 0, NULL, 1, &arg_rv);
+
+    if (fp == NULL) {
+        SvREFCNT_dec(arg_rv);
+        return NULL;
+    }
+
+    return fp;
+}
+
+
+void
+nxt_perl_psgi_layer_stream_fp_destroy(pTHX_ PerlIO *io)
+{
+    PerlIO_close(io);
+}
+
+
+SV *
+nxt_perl_psgi_layer_stream_io_create(pTHX_ PerlIO *fp)
+{
+    SV  *rvio;
+    IO  *thatio;
+
+    thatio = newIO();
+
+    if (thatio == NULL) {
+        return NULL;
+    }
+
+    IoOFP(thatio) = fp;
+    IoIFP(thatio) = fp;
+
+    rvio = newRV_noinc((SV *) thatio);
+
+    if (rvio == NULL) {
+        SvREFCNT_dec(thatio);
+        return NULL;
+    }
+
+    return rvio;
+}
+
+
+void
+nxt_perl_psgi_layer_stream_io_destroy(pTHX_ SV *rvio)
+{
+    SvREFCNT_dec(rvio);
+}

src/perl/nxt_perl_psgi_layer.h

@@ -0,0 +1,48 @@
+
+/*
+ * Copyright (C) Alexander Borisov
+ * Copyright (C) NGINX, Inc.
+ */
+
+#ifndef _NXT_PERL_PSGI_LAYER_H_INCLUDED_
+#define _NXT_PERL_PSGI_LAYER_H_INCLUDED_
+
+
+#include <EXTERN.h>
+#include <XSUB.h>
+#include <perl.h>
+#include <perliol.h>
+
+
+typedef struct nxt_perl_psgi_io_arg nxt_perl_psgi_io_arg_t;
+
+typedef long (*nxt_perl_psgi_io_read_f)(PerlInterpreter *my_perl,
+    nxt_perl_psgi_io_arg_t *arg, void *vbuf, size_t length);
+typedef long (*nxt_perl_psgi_io_write_f)(PerlInterpreter *my_perl,
+    nxt_perl_psgi_io_arg_t *arg, const void *vbuf, size_t length);
+typedef long (*nxt_perl_psgi_io_arg_f)(PerlInterpreter *my_perl,
+    nxt_perl_psgi_io_arg_t *arg);
+
+
+struct nxt_perl_psgi_io_arg {
+    SV                        *io;
+    PerlIO                    *fp;
+
+    nxt_perl_psgi_io_arg_f    flush;
+    nxt_perl_psgi_io_read_f   read;
+    nxt_perl_psgi_io_write_f  write;
+
+    void                      *ctx;
+};
+
+
+void nxt_perl_psgi_layer_stream_init(pTHX);
+
+PerlIO *nxt_perl_psgi_layer_stream_fp_create(pTHX_ nxt_perl_psgi_io_arg_t *arg,
+    const char *mode);
+void nxt_perl_psgi_layer_stream_fp_destroy(pTHX_ PerlIO *io);
+
+SV *nxt_perl_psgi_layer_stream_io_create(pTHX_ PerlIO *fp);
+void nxt_perl_psgi_layer_stream_io_destroy(pTHX_ SV *rvio);
+
+#endif /* _NXT_PERL_PSGI_LAYER_H_INCLUDED_ */