summaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--auto/help3
-rw-r--r--auto/modules/conf4
-rw-r--r--auto/modules/perl201
-rw-r--r--auto/os/conf2
-rw-r--r--src/nxt_application.c6
-rw-r--r--src/nxt_application.h9
-rw-r--r--src/nxt_conf_validation.c11
-rw-r--r--src/nxt_main_process.c44
-rw-r--r--src/nxt_router.c97
-rw-r--r--src/perl/nxt_perl_psgi.c1148
-rw-r--r--src/perl/nxt_perl_psgi_layer.c436
-rw-r--r--src/perl/nxt_perl_psgi_layer.h48
12 files changed, 1998 insertions, 11 deletions
diff --git a/auto/help b/auto/help
index e768a228..2e7a1f38 100644
--- a/auto/help
+++ b/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
diff --git a/auto/modules/conf b/auto/modules/conf
index 8c0b7c0c..df77309e 100644
--- a/auto/modules/conf
+++ b/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\".
diff --git a/auto/modules/perl b/auto/modules/perl
new file mode 100644
index 00000000..2d1f92a9
--- /dev/null
+++ b/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
diff --git a/auto/os/conf b/auto/os/conf
index 67db5df1..6811a453 100644
--- a/auto/os/conf
+++ b/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"
diff --git a/src/nxt_application.c b/src/nxt_application.c
index c9d577cc..7fecd70d 100644
--- a/src/nxt_application.c
+++ b/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;
diff --git a/src/nxt_application.h b/src/nxt_application.h
index d36d8cd1..b6391149 100644
--- a/src/nxt_application.h
+++ b/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;
diff --git a/src/nxt_conf_validation.c b/src/nxt_conf_validation.c
index e4109b00..33e739ea 100644
--- a/src/nxt_conf_validation.c
+++ b/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);
diff --git a/src/nxt_main_process.c b/src/nxt_main_process.c
index fedd30cd..d5978d7e 100644
--- a/src/nxt_main_process.c
+++ b/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);
diff --git a/src/nxt_router.c b/src/nxt_router.c
index 19a37c69..5fbdeded 100644
--- a/src/nxt_router.c
+++ b/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)));
}
diff --git a/src/perl/nxt_perl_psgi.c b/src/perl/nxt_perl_psgi.c
new file mode 100644
index 00000000..21cd0b8a
--- /dev/null
+++ b/src/perl/nxt_perl_psgi.c
@@ -0,0 +1,1148 @@
+
+/*
+ * Copyright (C) Alexander Borisov
+ * Copyright (C) NGINX, Inc.
+ */
+
+#include <perl/nxt_perl_psgi_layer.h>
+
+#include <nxt_main.h>
+#include <nxt_router.h>
+#include <nxt_runtime.h>
+#include <nxt_application.h>
+#include <nxt_file.h>
+
+
+typedef struct {
+ PerlInterpreter *my_perl;
+
+ nxt_task_t *task;
+ nxt_app_rmsg_t *rmsg;
+ nxt_app_wmsg_t *wmsg;
+
+ size_t body_preread_size;
+} nxt_perl_psgi_input_t;
+
+
+nxt_inline nxt_int_t nxt_perl_psgi_write(nxt_task_t *task,nxt_app_wmsg_t *wmsg,
+ const u_char *data, size_t len,
+ nxt_bool_t flush, nxt_bool_t last);
+
+nxt_inline nxt_int_t nxt_perl_psgi_http_write_status_str(nxt_task_t *task,
+ nxt_app_wmsg_t *wmsg, nxt_str_t *http_status);
+
+static long nxt_perl_psgi_io_input_read(PerlInterpreter *my_perl,
+ nxt_perl_psgi_io_arg_t *arg, void *vbuf, size_t length);
+static long nxt_perl_psgi_io_input_write(PerlInterpreter *my_perl,
+ nxt_perl_psgi_io_arg_t *arg, const void *vbuf, size_t length);
+static long nxt_perl_psgi_io_input_flush(PerlInterpreter *my_perl,
+ nxt_perl_psgi_io_arg_t *arg);
+
+static long nxt_perl_psgi_io_error_read(PerlInterpreter *my_perl,
+ nxt_perl_psgi_io_arg_t *arg, void *vbuf, size_t length);
+static long nxt_perl_psgi_io_error_write(PerlInterpreter *my_perl,
+ nxt_perl_psgi_io_arg_t *arg, const void *vbuf, size_t length);
+static long nxt_perl_psgi_io_error_flush(PerlInterpreter *my_perl,
+ nxt_perl_psgi_io_arg_t *arg);
+
+/*
+static void nxt_perl_psgi_xs_core_global_changes(PerlInterpreter *my_perl,
+ const char *core, const char *sub, XSUBADDR_t sub_addr);
+*/
+
+static void nxt_perl_psgi_xs_init(pTHX);
+
+static SV *nxt_perl_psgi_call_var_application(PerlInterpreter *my_perl,
+ SV *env, nxt_task_t *task);
+
+/* For currect load XS modules */
+EXTERN_C void boot_DynaLoader(pTHX_ CV *cv);
+
+static nxt_int_t nxt_perl_psgi_io_input_init(PerlInterpreter *my_perl,
+ nxt_perl_psgi_io_arg_t *arg);
+static nxt_int_t nxt_perl_psgi_io_error_init(PerlInterpreter *my_perl,
+ nxt_perl_psgi_io_arg_t *arg);
+
+static PerlInterpreter *nxt_perl_psgi_interpreter_init(nxt_task_t *task,
+ char *script);
+
+nxt_inline nxt_int_t nxt_perl_psgi_env_append_str(PerlInterpreter *my_perl,
+ HV *hash_env, const char *name, nxt_str_t *str);
+nxt_inline nxt_int_t nxt_perl_psgi_env_append(PerlInterpreter *my_perl,
+ HV *hash_env, const char *name, void *value);
+
+static SV *nxt_perl_psgi_env_create(PerlInterpreter *my_perl, nxt_task_t *task,
+ nxt_app_rmsg_t *rmsg, size_t *body_preread_size);
+
+nxt_inline nxt_int_t nxt_perl_psgi_read_add_env(PerlInterpreter *my_perl,
+ nxt_task_t *task, nxt_app_rmsg_t *rmsg, HV *hash_env,
+ const char *name, nxt_str_t *str);
+
+static u_char *nxt_perl_psgi_module_create(nxt_task_t *task,
+ const char *script);
+
+static nxt_str_t nxt_perl_psgi_result_status(PerlInterpreter *my_perl,
+ SV *result);
+static nxt_int_t nxt_perl_psgi_result_head(PerlInterpreter *my_perl,
+ SV *sv_head, nxt_task_t *task, nxt_app_wmsg_t *wmsg);
+static nxt_int_t nxt_perl_psgi_result_body(PerlInterpreter *my_perl,
+ SV *result, nxt_task_t *task, nxt_app_wmsg_t *wmsg);
+static nxt_int_t nxt_perl_psgi_result_body_ref(PerlInterpreter *my_perl,
+ SV *sv_body, nxt_task_t *task, nxt_app_wmsg_t *wmsg);
+static nxt_int_t nxt_perl_psgi_result_array(PerlInterpreter *my_perl,
+ SV *result, nxt_task_t *task, nxt_app_wmsg_t *wmsg);
+
+static nxt_int_t nxt_perl_psgi_init(nxt_task_t *task,
+ nxt_common_app_conf_t *conf);
+static nxt_int_t nxt_perl_psgi_run(nxt_task_t *task,
+ nxt_app_rmsg_t *rmsg, nxt_app_wmsg_t *wmsg);
+static void nxt_perl_psgi_atexit(nxt_task_t *task);
+
+typedef SV *(*nxt_perl_psgi_callback_f)(PerlInterpreter *my_perl,
+ SV *env, nxt_task_t *task);
+
+static SV *nxt_perl_psgi_app;
+static PerlInterpreter *nxt_perl_psgi;
+static nxt_perl_psgi_io_arg_t nxt_perl_psgi_arg_input, nxt_perl_psgi_arg_error;
+
+static uint32_t nxt_perl_psgi_compat[] = {
+ NXT_VERNUM, NXT_DEBUG,
+};
+
+NXT_EXPORT nxt_application_module_t nxt_app_module = {
+ sizeof(nxt_perl_psgi_compat),
+ nxt_perl_psgi_compat,
+ nxt_string("perl"),
+ nxt_string(PERL_VERSION_STRING),
+ nxt_perl_psgi_init,
+ nxt_perl_psgi_run,
+ nxt_perl_psgi_atexit,
+};
+
+
+nxt_inline nxt_int_t
+nxt_perl_psgi_write(nxt_task_t *task, nxt_app_wmsg_t *wmsg,
+ const u_char *data, size_t len,
+ nxt_bool_t flush, nxt_bool_t last)
+{
+ nxt_int_t rc;
+
+ rc = nxt_app_msg_write_raw(task, wmsg, data, len);
+
+ if (nxt_slow_path(rc != NXT_OK)) {
+ return rc;
+ }
+
+ if (flush || last) {
+ rc = nxt_app_msg_flush(task, wmsg, last);
+ }
+
+ return rc;
+}
+
+
+nxt_inline nxt_int_t
+nxt_perl_psgi_http_write_status_str(nxt_task_t *task, nxt_app_wmsg_t *wmsg,
+ nxt_str_t *http_status)
+{
+ nxt_int_t rc;
+
+ rc = NXT_OK;
+
+#define RC_WRT(DATA, DATALEN, FLUSH) \
+ do { \
+ rc = nxt_perl_psgi_write(task, wmsg, DATA, \
+ DATALEN, FLUSH, 0); \
+ if (nxt_slow_path(rc != NXT_OK)) \
+ return rc; \
+ \
+ } while (0)
+
+ RC_WRT((const u_char *) "Status: ", (sizeof("Status: ") - 1), 0);
+ RC_WRT(http_status->start, http_status->length, 0);
+ RC_WRT((u_char *) "\r\n", (sizeof("\r\n") - 1), 0);
+
+#undef RC_WRT
+
+ return rc;
+}
+
+
+static long
+nxt_perl_psgi_io_input_read(PerlInterpreter *my_perl,
+ nxt_perl_psgi_io_arg_t *arg, void *vbuf, size_t length)
+{
+ size_t copy_size;
+ nxt_perl_psgi_input_t *input;
+
+ input = (nxt_perl_psgi_input_t *) arg->ctx;
+
+ if (input->body_preread_size == 0) {
+ return 0;
+ }
+
+ copy_size = nxt_min(length, input->body_preread_size);
+ copy_size = nxt_app_msg_read_raw(input->task, input->rmsg,
+ vbuf, copy_size);
+
+ input->body_preread_size -= copy_size;
+
+ return copy_size;
+}
+
+
+static long
+nxt_perl_psgi_io_input_write(PerlInterpreter *my_perl,
+ nxt_perl_psgi_io_arg_t *arg, const void *vbuf, size_t length)
+{
+ return 0;
+}
+
+
+static long
+nxt_perl_psgi_io_input_flush(PerlInterpreter *my_perl,
+ nxt_perl_psgi_io_arg_t *arg)
+{
+ return 0;
+}
+
+
+static long
+nxt_perl_psgi_io_error_read(PerlInterpreter *my_perl,
+ nxt_perl_psgi_io_arg_t *arg, void *vbuf, size_t length)
+{
+ return 0;
+}
+
+
+static long
+nxt_perl_psgi_io_error_write(PerlInterpreter *my_perl,
+ nxt_perl_psgi_io_arg_t *arg, const void *vbuf, size_t length)
+{
+ nxt_perl_psgi_input_t *input;
+
+ input = (nxt_perl_psgi_input_t *) arg->ctx;
+ nxt_log_error(NXT_LOG_ERR, input->task->log, "Perl: %s", vbuf);
+
+ return (long) length;
+}
+
+
+static long
+nxt_perl_psgi_io_error_flush(PerlInterpreter *my_perl,
+ nxt_perl_psgi_io_arg_t *arg)
+{
+ return 0;
+}
+
+
+/* In the future it will be necessary to change some Perl functions. */
+/*
+static void
+nxt_perl_psgi_xs_core_global_changes(PerlInterpreter *my_perl,
+ const char *core, const char *sub, XSUBADDR_t sub_addr)
+{
+ GV *gv;
+
+ gv = gv_fetchpv(core, TRUE, SVt_PVCV);
+
+#ifdef MUTABLE_CV
+ GvCV_set(gv, MUTABLE_CV(SvREFCNT_inc(get_cv(sub, TRUE))));
+#else
+ GvCV_set(gv, (CV *) (SvREFCNT_inc(get_cv(sub, TRUE))));
+#endif
+ GvIMPORTED_CV_on(gv);
+
+ newXS(sub, sub_addr, __FILE__);
+}
+*/
+
+
+XS(XS_NGINX__Unit__PSGI_exit);
+XS(XS_NGINX__Unit__PSGI_exit)
+{
+ I32 ax = POPMARK;
+ Perl_croak(aTHX_ (char *) NULL);
+ XSRETURN_EMPTY;
+}
+
+
+static void
+nxt_perl_psgi_xs_init(pTHX)
+{
+/*
+ nxt_perl_psgi_xs_core_global_changes(my_perl, "CORE::GLOBAL::exit",
+ "NGINX::Unit::PSGI::exit",
+ XS_NGINX__Unit__PSGI_exit);
+*/
+ nxt_perl_psgi_layer_stream_init(aTHX);
+
+ /* DynaLoader for Perl modules who use XS */
+ newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, __FILE__);
+}
+
+
+static SV *
+nxt_perl_psgi_call_var_application(PerlInterpreter *my_perl,
+ SV *env, nxt_task_t *task)
+{
+ SV *result;
+
+ dSP;
+
+ ENTER;
+ SAVETMPS;
+
+ PUSHMARK(sp);
+ XPUSHs(env);
+ PUTBACK;
+
+ call_sv(nxt_perl_psgi_app, G_EVAL|G_SCALAR);
+
+ SPAGAIN;
+
+ if (SvTRUE(ERRSV)) {
+ nxt_log_error(NXT_LOG_ERR, task->log,
+ "PSGI: Failed to run Perl Application: \n%s",
+ SvPV_nolen(ERRSV));
+ }
+
+ result = POPs;
+ SvREFCNT_inc(result);
+
+ PUTBACK;
+ FREETMPS;
+ LEAVE;
+
+ return result;
+}
+
+
+static u_char *
+nxt_perl_psgi_module_create(nxt_task_t *task, const char *script)
+{
+ u_char *buf, *p;
+ size_t length;
+
+ static nxt_str_t prefix = nxt_string(
+ "package NGINX::Unit::Sandbox;"
+ "{my $app = do \""
+ );
+
+ static nxt_str_t suffix = nxt_string_zero(
+ "\";"
+ "unless ($app) {"
+ " if($@ || $1) {die $@ || $1}"
+ " else {die \"File not found or compilation error.\"}"
+ "} "
+ "return $app}"
+ );
+
+ length = strlen(script);
+
+ buf = nxt_malloc(prefix.length + length + suffix.length);
+
+ if (nxt_slow_path(buf == NULL)) {
+ nxt_log_error(NXT_LOG_ERR, task->log,
+ "PSGI: Failed to allocate memory "
+ "for Perl script file %s", script);
+ return NULL;
+ }
+
+ p = nxt_cpymem(buf, prefix.start, prefix.length);
+ p = nxt_cpymem(p, script, length);
+ nxt_memcpy(p, suffix.start, suffix.length);
+
+ return buf;
+}
+
+
+static nxt_int_t
+nxt_perl_psgi_io_input_init(PerlInterpreter *my_perl,
+ nxt_perl_psgi_io_arg_t *arg)
+{
+ SV *io;
+ PerlIO *fp;
+
+ fp = nxt_perl_psgi_layer_stream_fp_create(aTHX_ arg, "r");
+
+ if (nxt_slow_path(fp == NULL)) {
+ return NXT_ERROR;
+ }
+
+ io = nxt_perl_psgi_layer_stream_io_create(aTHX_ fp);
+
+ if (nxt_slow_path(io == NULL)) {
+ nxt_perl_psgi_layer_stream_fp_destroy(aTHX_ fp);
+ return NXT_ERROR;
+ }
+
+ arg->io = io;
+ arg->fp = fp;
+ arg->flush = nxt_perl_psgi_io_input_flush;
+ arg->read = nxt_perl_psgi_io_input_read;
+ arg->write = nxt_perl_psgi_io_input_write;
+
+ return NXT_OK;
+}
+
+
+static nxt_int_t
+nxt_perl_psgi_io_error_init(PerlInterpreter *my_perl,
+ nxt_perl_psgi_io_arg_t *arg)
+{
+ SV *io;
+ PerlIO *fp;
+
+ fp = nxt_perl_psgi_layer_stream_fp_create(aTHX_ arg, "w");
+
+ if (nxt_slow_path(fp == NULL)) {
+ return NXT_ERROR;
+ }
+
+ io = nxt_perl_psgi_layer_stream_io_create(aTHX_ fp);
+
+ if (nxt_slow_path(io == NULL)) {
+ nxt_perl_psgi_layer_stream_fp_destroy(aTHX_ fp);
+ return NXT_ERROR;
+ }
+
+ arg->io = io;
+ arg->fp = fp;
+ arg->flush = nxt_perl_psgi_io_error_flush;
+ arg->read = nxt_perl_psgi_io_error_read;
+ arg->write = nxt_perl_psgi_io_error_write;
+
+ return NXT_OK;
+}
+
+
+static PerlInterpreter *
+nxt_perl_psgi_interpreter_init(nxt_task_t *task, char *script)
+{
+ int status, pargc;
+ char **pargv, **penv;
+ u_char *run_module;
+ PerlInterpreter *my_perl;
+
+ static char argv[] = "\0""-e\0""0";
+ static char *embedding[] = { &argv[0], &argv[1], &argv[4] };
+
+ pargc = 0;
+ pargv = NULL;
+ penv = NULL;
+
+ PERL_SYS_INIT3(&pargc, &pargv, &penv);
+
+ my_perl = perl_alloc();
+
+ if (nxt_slow_path(my_perl == NULL)) {
+ nxt_log_error(NXT_LOG_CRIT, task->log,
+ "PSGI: Failed to allocate memory for Perl interpreter");
+ return NULL;
+ }
+
+ run_module = NULL;
+
+ perl_construct(my_perl);
+ PERL_SET_CONTEXT(my_perl);
+
+ status = perl_parse(my_perl, nxt_perl_psgi_xs_init, 3, embedding, NULL);
+
+ if (nxt_slow_path(status != 0)) {
+ nxt_log_error(NXT_LOG_CRIT, task->log,
+ "PSGI: Failed to parse Perl Script");
+ goto fail;
+ }
+
+ PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
+ PL_origalen = 1;
+
+ status = perl_run(my_perl);
+
+ if (nxt_slow_path(status != 0)) {
+ nxt_log_error(NXT_LOG_CRIT, task->log,
+ "PSGI: Failed to run Perl");
+ goto fail;
+ }
+
+ sv_setsv(get_sv("0", 0), newSVpv(script, 0));
+
+ run_module = nxt_perl_psgi_module_create(task, script);
+
+ if (nxt_slow_path(run_module == NULL)) {
+ goto fail;
+ }
+
+ status = nxt_perl_psgi_io_input_init(my_perl, &nxt_perl_psgi_arg_input);
+
+ if (nxt_slow_path(status != NXT_OK)) {
+ nxt_log_error(NXT_LOG_CRIT, task->log,
+ "PSGI: Failed to init io.psgi.input");
+ goto fail;
+ }
+
+ status = nxt_perl_psgi_io_error_init(my_perl, &nxt_perl_psgi_arg_error);
+
+ if (nxt_slow_path(status != NXT_OK)) {
+ nxt_log_error(NXT_LOG_CRIT, task->log,
+ "PSGI: Failed to init io.psgi.errors");
+ goto fail;
+ }
+
+ nxt_perl_psgi_app = eval_pv((const char *) run_module, FALSE);
+
+ if (SvTRUE(ERRSV)) {
+ nxt_log_emerg(task->log, "PSGI: Failed to parse script: %s\n%s",
+ script, SvPV_nolen(ERRSV));
+ goto fail;
+ }
+
+ nxt_free(run_module);
+
+ return my_perl;
+
+fail:
+
+ if (run_module != NULL) {
+ nxt_free(run_module);
+ }
+
+ perl_destruct(my_perl);
+ perl_free(my_perl);
+ PERL_SYS_TERM();
+
+ return NULL;
+}
+
+
+nxt_inline nxt_int_t
+nxt_perl_psgi_env_append_str(PerlInterpreter *my_perl, HV *hash_env,
+ const char *name, nxt_str_t *str)
+{
+ SV **ha;
+
+ ha = hv_store(hash_env, name, (I32) strlen(name),
+ newSVpv((const char *) str->start, (STRLEN)str->length), 0);
+
+ if (nxt_slow_path(ha == NULL)) {
+ return NXT_ERROR;
+ }
+
+ return NXT_OK;
+}
+
+
+nxt_inline nxt_int_t
+nxt_perl_psgi_env_append(PerlInterpreter *my_perl, HV *hash_env,
+ const char *name, void *value)
+{
+ SV **ha;
+
+ ha = hv_store(hash_env, name, (I32) strlen(name), value, 0);
+
+ if (nxt_slow_path(ha == NULL)) {
+ return NXT_ERROR;
+ }
+
+ return NXT_OK;
+}
+
+
+nxt_inline nxt_int_t
+nxt_perl_psgi_read_add_env(PerlInterpreter *my_perl, nxt_task_t *task,
+ nxt_app_rmsg_t *rmsg, HV *hash_env,
+ const char *name, nxt_str_t *str)
+{
+ nxt_int_t rc;
+
+ rc = nxt_app_msg_read_str(task, rmsg, str);
+
+ if (nxt_slow_path(rc != NXT_OK)) {
+ return rc;
+ }
+
+ if (str->start == NULL) {
+ return NXT_OK;
+ }
+
+ return nxt_perl_psgi_env_append_str(my_perl, hash_env, name, str);
+}
+
+
+static SV *
+nxt_perl_psgi_env_create(PerlInterpreter *my_perl, nxt_task_t *task,
+ nxt_app_rmsg_t *rmsg, size_t *body_preread_size)
+{
+ HV *hash_env;
+ AV *array_version;
+ u_char *colon;
+ size_t query_size;
+ nxt_int_t rc;
+ nxt_str_t str, value, path, target;
+ nxt_str_t host, server_name, server_port;
+
+ static nxt_str_t def_host = nxt_string("localhost");
+ static nxt_str_t def_port = nxt_string("80");
+
+ hash_env = newHV();
+
+ if (nxt_slow_path(hash_env == NULL)) {
+ return NULL;
+ }
+
+#define RC(FNS) \
+ do { \
+ if (nxt_slow_path((FNS) != NXT_OK)) \
+ goto fail; \
+ } while (0)
+
+#define GET_STR(ATTR) \
+ RC(nxt_perl_psgi_read_add_env(my_perl, task, rmsg, \
+ hash_env, ATTR, &str))
+
+ GET_STR("REQUEST_METHOD");
+ GET_STR("REQUEST_URI");
+
+ target = str;
+
+ RC(nxt_app_msg_read_str(task, rmsg, &path));
+ RC(nxt_app_msg_read_size(task, rmsg, &query_size));
+
+ if (path.start == NULL || path.length == 0) {
+ path = target;
+ }
+
+ array_version = newAV();
+
+ if (nxt_slow_path(array_version == NULL)) {
+ goto fail;
+ }
+
+ av_push(array_version, newSViv(1));
+ av_push(array_version, newSViv(1));
+
+ RC(nxt_perl_psgi_env_append_str(my_perl, hash_env, "PATH_INFO",
+ &path));
+ RC(nxt_perl_psgi_env_append(my_perl, hash_env, "SCRIPT_NAME",
+ newSVpv("", 0)));
+ RC(nxt_perl_psgi_env_append(my_perl, hash_env, "psgi.run_once",
+ newSVpv("", 0)));
+ RC(nxt_perl_psgi_env_append(my_perl, hash_env, "psgi.streaming",
+ newSViv(0)));
+ RC(nxt_perl_psgi_env_append(my_perl, hash_env, "psgi.nonblocking",
+ newSVpv("", 0)));
+ RC(nxt_perl_psgi_env_append(my_perl, hash_env, "psgi.multithread",
+ newSVpv("", 0)));
+ RC(nxt_perl_psgi_env_append(my_perl, hash_env, "psgi.multiprocess",
+ newSVpv("", 0)));
+ RC(nxt_perl_psgi_env_append(my_perl, hash_env, "psgi.url_scheme",
+ newSVpv("http", 4)));
+ RC(nxt_perl_psgi_env_append(my_perl, hash_env, "psgi.input",
+ SvREFCNT_inc(nxt_perl_psgi_arg_input.io)));
+ RC(nxt_perl_psgi_env_append(my_perl, hash_env, "psgi.errors",
+ SvREFCNT_inc(nxt_perl_psgi_arg_error.io)));
+ RC(nxt_perl_psgi_env_append(my_perl, hash_env, "psgi.version",
+ newRV_noinc((SV *) array_version)));
+
+ if (query_size > 0) {
+ query_size--;
+
+ if (nxt_slow_path(target.length < query_size)) {
+ goto fail;
+ }
+
+ str.start = &target.start[query_size];
+ str.length = target.length - query_size;
+
+ RC(nxt_perl_psgi_env_append_str(my_perl, hash_env,
+ "QUERY_STRING", &str));
+ }
+
+ GET_STR("SERVER_PROTOCOL");
+ GET_STR("REMOTE_ADDR");
+ GET_STR("SERVER_ADDR");
+
+ RC(nxt_app_msg_read_str(task, rmsg, &host));
+
+ if (host.length == 0) {
+ host = def_host;
+ }
+
+ colon = nxt_memchr(host.start, ':', host.length);
+ server_name = host;
+
+ if (colon != NULL) {
+ server_name.length = colon - host.start;
+
+ server_port.start = colon + 1;
+ server_port.length = host.length - server_name.length - 1;
+
+ } else {
+ server_port = def_port;
+ }
+
+ RC(nxt_perl_psgi_env_append_str(my_perl, hash_env,
+ "SERVER_NAME", &server_name));
+ RC(nxt_perl_psgi_env_append_str(my_perl, hash_env,
+ "SERVER_PORT", &server_port));
+
+ GET_STR("CONTENT_TYPE");
+ GET_STR("CONTENT_LENGTH");
+
+ for ( ;; ) {
+ rc = nxt_app_msg_read_str(task, rmsg, &str);
+
+ if (nxt_slow_path(rc != NXT_OK)) {
+ goto fail;
+ }
+
+ if (nxt_slow_path(str.length == 0)) {
+ break;
+ }
+
+ rc = nxt_app_msg_read_str(task, rmsg, &value);
+
+ if (nxt_slow_path(rc != NXT_OK)) {
+ break;
+ }
+
+ RC(nxt_perl_psgi_env_append_str(my_perl, hash_env,
+ (char *) str.start, &value));
+ }
+
+ RC(nxt_app_msg_read_size(task, rmsg, body_preread_size));
+
+#undef GET_STR
+#undef RC
+
+ return newRV_noinc((SV *) hash_env);
+
+fail:
+
+ SvREFCNT_dec(hash_env);
+
+ return NULL;
+}
+
+
+static nxt_str_t
+nxt_perl_psgi_result_status(PerlInterpreter *my_perl, SV *result)
+{
+ SV **sv_status;
+ AV *array;
+ nxt_str_t status;
+
+ array = (AV *) SvRV(result);
+ sv_status = av_fetch(array, 0, 0);
+
+ status.start = (u_char *) SvPV(*sv_status, status.length);
+
+ return status;
+}
+
+
+static nxt_int_t
+nxt_perl_psgi_result_head(PerlInterpreter *my_perl, SV *sv_head,
+ nxt_task_t *task, nxt_app_wmsg_t *wmsg)
+{
+ AV *array_head;
+ SV **entry;
+ long i, array_len;
+ nxt_int_t rc;
+ nxt_str_t body;
+
+ if (nxt_slow_path(SvROK(sv_head) == 0
+ || SvTYPE(SvRV(sv_head)) != SVt_PVAV))
+ {
+ nxt_log_error(NXT_LOG_ERR, task->log,
+ "PSGI: An unsupported format was received from "
+ "Perl Application for head part");
+
+ return NXT_ERROR;
+ }
+
+ array_head = (AV *) SvRV(sv_head);
+ array_len = av_len(array_head);
+
+ if (array_len < 1) {
+ return NXT_OK;
+ }
+
+ if (nxt_slow_path((array_len % 2) == 0)) {
+ nxt_log_error(NXT_LOG_ERR, task->log,
+ "PSGI: Bad format for head from "
+ "Perl Application");
+
+ return NXT_ERROR;
+ }
+
+ for (i = 0; i <= array_len; i++) {
+ entry = av_fetch(array_head, i, 0);
+
+ if (nxt_fast_path(entry == NULL)) {
+ nxt_log_error(NXT_LOG_ERR, task->log,
+ "PSGI: Failed to get head entry from "
+ "Perl Application");
+
+ return NXT_ERROR;
+ }
+
+ body.start = (u_char *) SvPV(*entry, body.length);
+
+ rc = nxt_app_msg_write_raw(task, wmsg,
+ (u_char *) body.start, body.length);
+
+ if (nxt_slow_path(rc != NXT_OK)) {
+ nxt_log_error(NXT_LOG_ERR, task->log,
+ "PSGI: Failed to write head "
+ "from Perl Application");
+ return rc;
+ }
+
+ if ((i % 2) == 0) {
+ rc = nxt_app_msg_write_raw(task, wmsg,
+ (u_char *) ": ",
+ (sizeof(": ") - 1));
+ } else {
+ rc = nxt_app_msg_write_raw(task, wmsg,
+ (u_char *) "\r\n",
+ (sizeof("\r\n") - 1));
+ }
+
+ if (nxt_slow_path(rc != NXT_OK)) {
+ nxt_log_error(NXT_LOG_ERR, task->log,
+ "PSGI: Failed to write head from "
+ "Perl Application");
+ return rc;
+ }
+ }
+
+ return NXT_OK;
+}
+
+
+static nxt_int_t
+nxt_perl_psgi_result_body(PerlInterpreter *my_perl, SV *sv_body,
+ nxt_task_t *task, nxt_app_wmsg_t *wmsg)
+{
+ SV **entry;
+ AV *body_array;
+ long i;
+ nxt_int_t rc;
+ nxt_str_t body;
+
+ if (nxt_slow_path(SvROK(sv_body) == 0
+ || SvTYPE(SvRV(sv_body)) != SVt_PVAV))
+ {
+ nxt_log_error(NXT_LOG_ERR, task->log,
+ "PSGI: An unsupported format was received from "
+ "Perl Application for a body part");
+
+ return NXT_ERROR;
+ }
+
+ body_array = (AV *) SvRV(sv_body);
+
+ for (i = 0; i <= av_len(body_array); i++) {
+
+ entry = av_fetch(body_array, i, 0);
+
+ if (nxt_fast_path(entry == NULL)) {
+ nxt_log_error(NXT_LOG_ERR, task->log,
+ "PSGI: Failed to get body entry from "
+ "Perl Application");
+ return NXT_ERROR;
+ }
+
+ body.start = (u_char *) SvPV(*entry, body.length);
+
+ if (body.length == 0) {
+ continue;
+ }
+
+ rc = nxt_app_msg_write_raw(task, wmsg,
+ (u_char *) body.start, body.length);
+
+ if (nxt_slow_path(rc != NXT_OK)) {
+ nxt_log_error(NXT_LOG_ERR, task->log,
+ "PSGI: Failed to write 'body' from "
+ "Perl Application");
+ return rc;
+ }
+
+ rc = nxt_app_msg_flush(task, wmsg, 0);
+
+ if (nxt_slow_path(rc != NXT_OK)) {
+ nxt_log_error(NXT_LOG_ERR, task->log,
+ "PSGI: Failed to flush data for a 'body' "
+ "part from Perl Application");
+ return rc;
+ }
+ }
+
+ return NXT_OK;
+}
+
+
+static nxt_int_t
+nxt_perl_psgi_result_body_ref(PerlInterpreter *my_perl, SV *sv_body,
+ nxt_task_t *task, nxt_app_wmsg_t *wmsg)
+{
+ IO *io;
+ PerlIO *fp;
+ SSize_t n;
+ nxt_int_t rc;
+ u_char vbuf[8192];
+
+ io = GvIO(SvRV(sv_body));
+ fp = IoIFP(io);
+
+ for ( ;; ) {
+ n = PerlIO_read(fp, vbuf, 8192);
+
+ if (n < 1) {
+ break;
+ }
+
+ rc = nxt_app_msg_write_raw(task, wmsg,
+ (u_char *) vbuf, (size_t) n);
+
+ if (nxt_slow_path(rc != NXT_OK)) {
+ nxt_log_error(NXT_LOG_ERR, task->log,
+ "PSGI: Failed to write 'body' from "
+ "Perl Application");
+
+ return rc;
+ }
+
+ rc = nxt_app_msg_flush(task, wmsg, 0);
+
+ if (nxt_slow_path(rc != NXT_OK)) {
+ nxt_log_error(NXT_LOG_ERR, task->log,
+ "PSGI: Failed to flush data for a body "
+ "part from Perl Application");
+
+ return rc;
+ }
+ }
+
+ return NXT_OK;
+}
+
+
+static nxt_int_t
+nxt_perl_psgi_result_array(PerlInterpreter *my_perl, SV *result,
+ nxt_task_t *task, nxt_app_wmsg_t *wmsg)
+{
+ AV *array;
+ SV **sv_temp;
+ long array_len;
+ nxt_int_t rc;
+ nxt_str_t http_status;
+
+ array = (AV *) SvRV(result);
+ array_len = av_len(array);
+
+ if (nxt_slow_path(array_len < 0)) {
+ nxt_log_error(NXT_LOG_ERR, task->log,
+ "PSGI: Invalid result format from Perl Application");
+
+ return NXT_ERROR;
+ }
+
+ http_status = nxt_perl_psgi_result_status(nxt_perl_psgi, result);
+
+ if (nxt_slow_path(http_status.start == NULL || http_status.length == 0)) {
+ nxt_log_error(NXT_LOG_ERR, task->log,
+ "PSGI: An unexpected status was received "
+ "from Perl Application");
+
+ return NXT_ERROR;
+ }
+
+ rc = nxt_perl_psgi_http_write_status_str(task, wmsg, &http_status);
+
+ if (nxt_slow_path(rc != NXT_OK)) {
+ nxt_log_error(NXT_LOG_ERR, task->log,
+ "PSGI: Failed to write HTTP Status");
+
+ return rc;
+ }
+
+ if (array_len < 1) {
+ rc = nxt_app_msg_write_raw(task, wmsg, (u_char *) "\r\n",
+ (sizeof("\r\n") - 1));
+
+ if (nxt_slow_path(rc != NXT_OK)) {
+ nxt_log_error(NXT_LOG_ERR, task->log,
+ "PSGI: Failed to write HTTP Headers");
+
+ return rc;
+ }
+
+ return NXT_OK;
+ }
+
+ sv_temp = av_fetch(array, 1, 0);
+
+ if (nxt_slow_path(sv_temp == NULL)) {
+ nxt_log_error(NXT_LOG_ERR, task->log,
+ "PSGI: Failed to get head from Perl ARRAY variable");
+
+ return NXT_ERROR;
+ }
+
+ rc = nxt_perl_psgi_result_head(nxt_perl_psgi, *sv_temp, task, wmsg);
+
+ if (nxt_slow_path(rc != NXT_OK)) {
+ return rc;
+ }
+
+ rc = nxt_app_msg_write_raw(task, wmsg, (u_char *) "\r\n",
+ (sizeof("\r\n") - 1));
+
+ if (nxt_slow_path(rc != NXT_OK)) {
+ nxt_log_error(NXT_LOG_ERR, task->log,
+ "PSGI: Failed to write HTTP Headers");
+
+ return rc;
+ }
+
+ if (nxt_fast_path(array_len < 2)) {
+ return NXT_OK;
+ }
+
+ sv_temp = av_fetch(array, 2, 0);
+
+ if (nxt_slow_path(sv_temp == NULL)) {
+ nxt_log_error(NXT_LOG_ERR, task->log,
+ "PSGI: Failed to get body from Perl ARRAY variable");
+
+ return NXT_ERROR;
+ }
+
+ if (SvTYPE(SvRV(*sv_temp)) == SVt_PVAV) {
+ rc = nxt_perl_psgi_result_body(nxt_perl_psgi, *sv_temp, task, wmsg);
+
+ } else {
+ rc = nxt_perl_psgi_result_body_ref(nxt_perl_psgi, *sv_temp,
+ task, wmsg);
+ }
+
+ if (nxt_slow_path(rc != NXT_OK)) {
+ return rc;
+ }
+
+ return NXT_OK;
+}
+
+
+static nxt_int_t
+nxt_perl_psgi_init(nxt_task_t *task, nxt_common_app_conf_t *conf)
+{
+ PerlInterpreter *my_perl;
+
+ my_perl = nxt_perl_psgi_interpreter_init(task, conf->u.perl.script);
+
+ if (nxt_slow_path(my_perl == NULL)) {
+ return NXT_ERROR;
+ }
+
+ nxt_perl_psgi = my_perl;
+
+ return NXT_OK;
+}
+
+
+static nxt_int_t
+nxt_perl_psgi_run(nxt_task_t *task, nxt_app_rmsg_t *rmsg, nxt_app_wmsg_t *wmsg)
+{
+ SV *env, *result;
+ size_t body_preread_size;
+ nxt_int_t rc;
+ nxt_perl_psgi_input_t input;
+
+ dTHXa(nxt_perl_psgi);
+
+ /*
+ * Create environ variable for perl sub "application".
+ * > sub application {
+ * > my ($environ) = @_;
+ */
+ env = nxt_perl_psgi_env_create(nxt_perl_psgi, task, rmsg,
+ &body_preread_size);
+
+ if (nxt_slow_path(env == NULL)) {
+ nxt_log_error(NXT_LOG_ERR, task->log,
+ "PSGI: Failed to create 'env' for Perl Application");
+
+ return NXT_ERROR;
+ }
+
+ input.my_perl = nxt_perl_psgi;
+ input.task = task;
+ input.rmsg = rmsg;
+ input.wmsg = wmsg;
+ input.body_preread_size = body_preread_size;
+
+ nxt_perl_psgi_arg_input.ctx = &input;
+ nxt_perl_psgi_arg_error.ctx = &input;
+
+ /* Call perl sub and get result as SV*. */
+ result = nxt_perl_psgi_call_var_application(nxt_perl_psgi, env, task);
+
+ /*
+ * We expect ARRAY ref like a
+ * ['200', ['Content-Type' => "text/plain"], ["body"]]
+ */
+ if (nxt_slow_path(SvOK(result) == 0 || SvROK(result) == 0
+ || SvTYPE(SvRV(result)) != SVt_PVAV))
+ {
+ nxt_log_error(NXT_LOG_ERR, task->log,
+ "PSGI: An unexpected response was received from "
+ "Perl Application");
+ goto fail;
+ }
+
+ rc = nxt_perl_psgi_result_array(nxt_perl_psgi, result, task, wmsg);
+
+ if (nxt_slow_path(rc != NXT_OK)) {
+ goto fail;
+ }
+
+ rc = nxt_app_msg_flush(task, wmsg, 1);
+
+ if (nxt_slow_path(rc != NXT_OK)) {
+ goto fail;
+ }
+
+ SvREFCNT_dec(result);
+ SvREFCNT_dec(env);
+
+ return NXT_OK;
+
+fail:
+
+ SvREFCNT_dec(result);
+ SvREFCNT_dec(env);
+
+ return NXT_ERROR;
+}
+
+
+static void
+nxt_perl_psgi_atexit(nxt_task_t *task)
+{
+ dTHXa(nxt_perl_psgi);
+
+ nxt_perl_psgi_layer_stream_io_destroy(aTHX_ nxt_perl_psgi_arg_input.io);
+ nxt_perl_psgi_layer_stream_fp_destroy(aTHX_ nxt_perl_psgi_arg_input.fp);
+
+ nxt_perl_psgi_layer_stream_io_destroy(aTHX_ nxt_perl_psgi_arg_error.io);
+ nxt_perl_psgi_layer_stream_fp_destroy(aTHX_ nxt_perl_psgi_arg_error.fp);
+
+ perl_destruct(nxt_perl_psgi);
+ perl_free(nxt_perl_psgi);
+ PERL_SYS_TERM();
+}
diff --git a/src/perl/nxt_perl_psgi_layer.c b/src/perl/nxt_perl_psgi_layer.c
new file mode 100644
index 00000000..c4d50e48
--- /dev/null
+++ b/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);
+}
diff --git a/src/perl/nxt_perl_psgi_layer.h b/src/perl/nxt_perl_psgi_layer.h
new file mode 100644
index 00000000..3fa349c0
--- /dev/null
+++ b/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_ */
generated by cgit (git 2.34.1) at 2024-11-18 18:49:03 +0000