diff options
author | Alexander Borisov <alexander.borisov@nginx.com> | 2018-01-31 15:47:00 +0300 |
---|---|---|
committer | Alexander Borisov <alexander.borisov@nginx.com> | 2018-01-31 15:47:00 +0300 |
commit | 960962ddce87f6b401523b4426e8b5c61544ec7b (patch) | |
tree | 3c6fa7d9871701bca291ea5899a98397dacc5a87 | |
parent | 311db93f006153c309b975942c2415655e2ff417 (diff) | |
download | unit-960962ddce87f6b401523b4426e8b5c61544ec7b.tar.gz unit-960962ddce87f6b401523b4426e8b5c61544ec7b.tar.bz2 |
Added Perl support.
-rw-r--r-- | auto/help | 3 | ||||
-rw-r--r-- | auto/modules/conf | 4 | ||||
-rw-r--r-- | auto/modules/perl | 201 | ||||
-rw-r--r-- | auto/os/conf | 2 | ||||
-rw-r--r-- | src/nxt_application.c | 6 | ||||
-rw-r--r-- | src/nxt_application.h | 9 | ||||
-rw-r--r-- | src/nxt_conf_validation.c | 11 | ||||
-rw-r--r-- | src/nxt_main_process.c | 44 | ||||
-rw-r--r-- | src/nxt_router.c | 97 | ||||
-rw-r--r-- | src/perl/nxt_perl_psgi.c | 1148 | ||||
-rw-r--r-- | src/perl/nxt_perl_psgi_layer.c | 436 | ||||
-rw-r--r-- | src/perl/nxt_perl_psgi_layer.h | 48 |
12 files changed, 1998 insertions, 11 deletions
@@ -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_ */ |