Deleted Added
1
2/*
3 * Copyright (C) Alexander Borisov
4 * Copyright (C) NGINX, Inc.
5 */
6
7#include <perl/nxt_perl_psgi_layer.h>
8
9#include <nxt_main.h>
10#include <nxt_router.h>
11#include <nxt_runtime.h>
12#include <nxt_application.h>
13#include <nxt_file.h>
14#include <nxt_unit.h>
15#include <nxt_unit_request.h>
16#include <nxt_unit_response.h>
17
18
19typedef struct {
20 PerlInterpreter *my_perl;
21 nxt_unit_request_info_t *req;
22} nxt_perl_psgi_input_t;
23
24
25typedef struct {
26 PerlInterpreter *my_perl;
27 SV *app;
28} nxt_perl_psgi_module_t;
29
30
31static long nxt_perl_psgi_io_input_read(PerlInterpreter *my_perl,
32 nxt_perl_psgi_io_arg_t *arg, void *vbuf, size_t length);
33static long nxt_perl_psgi_io_input_write(PerlInterpreter *my_perl,
34 nxt_perl_psgi_io_arg_t *arg, const void *vbuf, size_t length);
35static long nxt_perl_psgi_io_input_flush(PerlInterpreter *my_perl,
36 nxt_perl_psgi_io_arg_t *arg);
37

--- 7 unchanged lines hidden (view full) ---

45/*
46static void nxt_perl_psgi_xs_core_global_changes(PerlInterpreter *my_perl,
47 const char *core, const char *sub, XSUBADDR_t sub_addr);
48*/
49
50static void nxt_perl_psgi_xs_init(pTHX);
51
52static SV *nxt_perl_psgi_call_var_application(PerlInterpreter *my_perl,
53 SV *env, SV *app, nxt_unit_request_info_t *req);
54
55/* For currect load XS modules */
56EXTERN_C void boot_DynaLoader(pTHX_ CV *cv);
57
58static nxt_int_t nxt_perl_psgi_io_input_init(PerlInterpreter *my_perl,
59 nxt_perl_psgi_io_arg_t *arg);
60static nxt_int_t nxt_perl_psgi_io_error_init(PerlInterpreter *my_perl,
61 nxt_perl_psgi_io_arg_t *arg);
62
63static PerlInterpreter *nxt_perl_psgi_interpreter_init(nxt_task_t *task,
64 char *script, SV **app);
65
66static SV *nxt_perl_psgi_env_create(PerlInterpreter *my_perl,
67 nxt_unit_request_info_t *req, nxt_perl_psgi_input_t *input);
68nxt_inline int nxt_perl_psgi_add_sptr(PerlInterpreter *my_perl, HV *hash_env,
69 const char *name, uint32_t name_len, nxt_unit_sptr_t *sptr, uint32_t len);
70nxt_inline int nxt_perl_psgi_add_str(PerlInterpreter *my_perl, HV *hash_env,
71 const char *name, uint32_t name_len, char *str, uint32_t len);
72nxt_inline int nxt_perl_psgi_add_value(PerlInterpreter *my_perl, HV *hash_env,
73 const char *name, uint32_t name_len, void *value);
74
75
76static u_char *nxt_perl_psgi_module_create(nxt_task_t *task,
77 const char *script);
78
79static nxt_int_t nxt_perl_psgi_result_status(PerlInterpreter *my_perl,
80 SV *result);
81static int nxt_perl_psgi_result_head(PerlInterpreter *my_perl,
82 SV *sv_head, nxt_unit_request_info_t *req, uint16_t status);
83static int nxt_perl_psgi_result_body(PerlInterpreter *my_perl,
84 SV *result, nxt_unit_request_info_t *req);
85static int nxt_perl_psgi_result_body_ref(PerlInterpreter *my_perl,
86 SV *sv_body, nxt_unit_request_info_t *req);
87static ssize_t nxt_perl_psgi_io_read(nxt_unit_read_info_t *read_info,
88 void *dst, size_t size);
89static int nxt_perl_psgi_result_array(PerlInterpreter *my_perl,
90 SV *result, nxt_unit_request_info_t *req);
91
92static nxt_int_t nxt_perl_psgi_init(nxt_task_t *task,
93 nxt_common_app_conf_t *conf);
94static void nxt_perl_psgi_request_handler(nxt_unit_request_info_t *req);
95static void nxt_perl_psgi_atexit(void);
96
97typedef SV *(*nxt_perl_psgi_callback_f)(PerlInterpreter *my_perl,
98 SV *env, nxt_task_t *task);
99
100static PerlInterpreter *nxt_perl_psgi;
101static nxt_perl_psgi_io_arg_t nxt_perl_psgi_arg_input, nxt_perl_psgi_arg_error;
102
103static uint32_t nxt_perl_psgi_compat[] = {
104 NXT_VERNUM, NXT_DEBUG,
105};
106
107NXT_EXPORT nxt_app_module_t nxt_app_module = {
108 sizeof(nxt_perl_psgi_compat),
109 nxt_perl_psgi_compat,
110 nxt_string("perl"),
111 PERL_VERSION_STRING,
112 nxt_perl_psgi_init,
113};
114
115
116static long
117nxt_perl_psgi_io_input_read(PerlInterpreter *my_perl,
118 nxt_perl_psgi_io_arg_t *arg, void *vbuf, size_t length)
119{
120 nxt_perl_psgi_input_t *input;
121
122 input = (nxt_perl_psgi_input_t *) arg->ctx;
123
124 return nxt_unit_request_read(input->req, vbuf, length);
125}
126
127
128static long
129nxt_perl_psgi_io_input_write(PerlInterpreter *my_perl,
130 nxt_perl_psgi_io_arg_t *arg, const void *vbuf, size_t length)
131{
132 return 0;

--- 18 unchanged lines hidden (view full) ---

151
152static long
153nxt_perl_psgi_io_error_write(PerlInterpreter *my_perl,
154 nxt_perl_psgi_io_arg_t *arg, const void *vbuf, size_t length)
155{
156 nxt_perl_psgi_input_t *input;
157
158 input = (nxt_perl_psgi_input_t *) arg->ctx;
159 nxt_unit_req_error(input->req, "Perl: %s", vbuf);
160
161 return (long) length;
162}
163
164
165static long
166nxt_perl_psgi_io_error_flush(PerlInterpreter *my_perl,
167 nxt_perl_psgi_io_arg_t *arg)

--- 45 unchanged lines hidden (view full) ---

213
214 /* DynaLoader for Perl modules who use XS */
215 newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, __FILE__);
216}
217
218
219static SV *
220nxt_perl_psgi_call_var_application(PerlInterpreter *my_perl,
221 SV *env, SV *app, nxt_unit_request_info_t *req)
222{
223 SV *result;
224
225 dSP;
226
227 ENTER;
228 SAVETMPS;
229
230 PUSHMARK(sp);
231 XPUSHs(env);
232 PUTBACK;
233
234 call_sv(app, G_EVAL|G_SCALAR);
235
236 SPAGAIN;
237
238 if (SvTRUE(ERRSV)) {
239 nxt_unit_req_error(req, "PSGI: Failed to run Perl Application: \n%s",
240 SvPV_nolen(ERRSV));
241 }
242
243 result = POPs;
244 SvREFCNT_inc(result);
245
246 PUTBACK;
247 FREETMPS;
248 LEAVE;

--- 97 unchanged lines hidden (view full) ---

346 arg->read = nxt_perl_psgi_io_error_read;
347 arg->write = nxt_perl_psgi_io_error_write;
348
349 return NXT_OK;
350}
351
352
353static PerlInterpreter *
354nxt_perl_psgi_interpreter_init(nxt_task_t *task, char *script, SV **app)
355{
356 int status, pargc;
357 char **pargv, **penv;
358 u_char *run_module;
359 PerlInterpreter *my_perl;
360
361 static char argv[] = "\0""-e\0""0";
362 static char *embedding[] = { &argv[0], &argv[1], &argv[4] };

--- 50 unchanged lines hidden (view full) ---

413
414 status = nxt_perl_psgi_io_error_init(my_perl, &nxt_perl_psgi_arg_error);
415
416 if (nxt_slow_path(status != NXT_OK)) {
417 nxt_alert(task, "PSGI: Failed to init io.psgi.errors");
418 goto fail;
419 }
420
421 *app = eval_pv((const char *) run_module, FALSE);
422
423 if (SvTRUE(ERRSV)) {
424 nxt_alert(task, "PSGI: Failed to parse script: %s\n%s",
425 script, SvPV_nolen(ERRSV));
426 goto fail;
427 }
428
429 nxt_free(run_module);

--- 9 unchanged lines hidden (view full) ---

439 perl_destruct(my_perl);
440 perl_free(my_perl);
441 PERL_SYS_TERM();
442
443 return NULL;
444}
445
446
447static SV *
448nxt_perl_psgi_env_create(PerlInterpreter *my_perl,
449 nxt_unit_request_info_t *req, nxt_perl_psgi_input_t *input)
450{
451 HV *hash_env;
452 AV *array_version;
453 char *host_start, *port_start;
454 uint32_t i, host_length, port_length;
455 nxt_unit_field_t *f;
456 nxt_unit_request_t *r;
457
458 hash_env = newHV();
459 if (nxt_slow_path(hash_env == NULL)) {
460 return NULL;
461 }
462
463#define RC(FNS) \
464 do { \
465 if (nxt_slow_path((FNS) != NXT_UNIT_OK)) \
466 goto fail; \
467 } while (0)
468
469#define NL(S) (S), sizeof(S)-1
470
471 r = req->request;
472
473 RC(nxt_perl_psgi_add_str(my_perl, hash_env, NL("SERVER_SOFTWARE"),
474 (char *) nxt_server.start, nxt_server.length));
475
476 RC(nxt_perl_psgi_add_sptr(my_perl, hash_env, NL("REQUEST_METHOD"),
477 &r->method, r->method_length));
478 RC(nxt_perl_psgi_add_sptr(my_perl, hash_env, NL("REQUEST_URI"),
479 &r->target, r->target_length));
480 RC(nxt_perl_psgi_add_sptr(my_perl, hash_env, NL("PATH_INFO"),
481 &r->path, r->path_length));
482
483 array_version = newAV();
484
485 if (nxt_slow_path(array_version == NULL)) {
486 goto fail;
487 }
488
489 av_push(array_version, newSViv(1));
490 av_push(array_version, newSViv(1));
491
492 RC(nxt_perl_psgi_add_value(my_perl, hash_env, NL("psgi.version"),
493 newRV_noinc((SV *) array_version)));
494 RC(nxt_perl_psgi_add_value(my_perl, hash_env, NL("psgi.url_scheme"),
495 newSVpv("http", 4)));
496 RC(nxt_perl_psgi_add_value(my_perl, hash_env, NL("psgi.input"),
497 SvREFCNT_inc(nxt_perl_psgi_arg_input.io)));
498 RC(nxt_perl_psgi_add_value(my_perl, hash_env, NL("psgi.errors"),
499 SvREFCNT_inc(nxt_perl_psgi_arg_error.io)));
500 RC(nxt_perl_psgi_add_value(my_perl, hash_env, NL("psgi.multithread"),
501 &PL_sv_no));
502 RC(nxt_perl_psgi_add_value(my_perl, hash_env, NL("psgi.multiprocess"),
503 &PL_sv_yes));
504 RC(nxt_perl_psgi_add_value(my_perl, hash_env, NL("psgi.run_once"),
505 &PL_sv_no));
506 RC(nxt_perl_psgi_add_value(my_perl, hash_env, NL("psgi.nonblocking"),
507 &PL_sv_no));
508 RC(nxt_perl_psgi_add_value(my_perl, hash_env, NL("psgi.streaming"),
509 &PL_sv_no));
510
511 if (r->query.offset) {
512 RC(nxt_perl_psgi_add_sptr(my_perl, hash_env, NL("QUERY_STRING"),
513 &r->query, r->query_length));
514 }
515 RC(nxt_perl_psgi_add_sptr(my_perl, hash_env, NL("SERVER_PROTOCOL"),
516 &r->version, r->version_length));
517 RC(nxt_perl_psgi_add_sptr(my_perl, hash_env, NL("REMOTE_ADDR"),
518 &r->remote, r->remote_length));
519 RC(nxt_perl_psgi_add_sptr(my_perl, hash_env, NL("SERVER_ADDR"),
520 &r->local, r->local_length));
521
522 for (i = 0; i < r->fields_count; i++) {
523 f = r->fields + i;
524
525 RC(nxt_perl_psgi_add_sptr(my_perl, hash_env,
526 nxt_unit_sptr_get(&f->name), f->name_length,
527 &f->value, f->value_length));
528 }
529
530 if (r->content_length_field != NXT_UNIT_NONE_FIELD) {
531 f = r->fields + r->content_length_field;
532
533 RC(nxt_perl_psgi_add_sptr(my_perl, hash_env, NL("CONTENT_LENGTH"),
534 &f->value, f->value_length));
535 }
536
537 if (r->content_type_field != NXT_UNIT_NONE_FIELD) {
538 f = r->fields + r->content_type_field;
539
540 RC(nxt_perl_psgi_add_sptr(my_perl, hash_env, NL("CONTENT_TYPE"),
541 &f->value, f->value_length));
542 }
543
544 if (r->host_field != NXT_UNIT_NONE_FIELD) {
545 f = r->fields + r->host_field;
546
547 host_start = nxt_unit_sptr_get(&f->value);
548 host_length = f->value_length;
549
550 } else {
551 host_start = NULL;
552 host_length = 0;
553 }
554
555 nxt_unit_split_host(host_start, host_length, &host_start, &host_length,
556 &port_start, &port_length);
557
558 RC(nxt_perl_psgi_add_str(my_perl, hash_env, NL("SERVER_NAME"),
559 host_start, host_length));
560 RC(nxt_perl_psgi_add_str(my_perl, hash_env, NL("SERVER_PORT"),
561 port_start, port_length));
562
563#undef NL
564#undef RC
565
566 return newRV_noinc((SV *) hash_env);
567
568fail:
569
570 SvREFCNT_dec(hash_env);
571
572 return NULL;
573}
574
575
576nxt_inline int
577nxt_perl_psgi_add_sptr(PerlInterpreter *my_perl, HV *hash_env,
578 const char *name, uint32_t name_len, nxt_unit_sptr_t *sptr, uint32_t len)
579{
580 return nxt_perl_psgi_add_str(my_perl, hash_env, name, name_len,
581 nxt_unit_sptr_get(sptr), len);
582}
583
584
585nxt_inline int
586nxt_perl_psgi_add_str(PerlInterpreter *my_perl, HV *hash_env,
587 const char *name, uint32_t name_len, char *str, uint32_t len)
588{
589 SV **ha;
590
591 ha = hv_store(hash_env, name, (I32) name_len,
592 newSVpv(str, (STRLEN) len), 0);
593 if (nxt_slow_path(ha == NULL)) {
594 return NXT_UNIT_ERROR;
595 }
596
597 return NXT_UNIT_OK;
598}
599
600
601nxt_inline int
602nxt_perl_psgi_add_value(PerlInterpreter *my_perl, HV *hash_env,
603 const char *name, uint32_t name_len, void *value)
604{
605 SV **ha;
606
607 ha = hv_store(hash_env, name, (I32) name_len, value, 0);
608 if (nxt_slow_path(ha == NULL)) {
609 return NXT_UNIT_ERROR;
610 }
611
612 return NXT_UNIT_OK;
613}
614
615
616static nxt_int_t
617nxt_perl_psgi_result_status(PerlInterpreter *my_perl, SV *result)
618{
619 SV **sv_status;
620 AV *array;
621 u_char *space;
622 nxt_str_t status;
623
624 array = (AV *) SvRV(result);
625 sv_status = av_fetch(array, 0, 0);
626
627 status.start = (u_char *) SvPV(*sv_status, status.length);
628
629 space = nxt_memchr(status.start, ' ', status.length);
630 if (space != NULL) {
631 status.length = space - status.start;
632 }
633
634 return nxt_int_parse(status.start, status.length);
635}
636
637
638static int
639nxt_perl_psgi_result_head(PerlInterpreter *my_perl, SV *sv_head,
640 nxt_unit_request_info_t *req, uint16_t status)
641{
642 AV *array_head;
643 SV **entry;
644 int rc;
645 long i, array_len;
646 char *name, *value;
647 STRLEN name_len, value_len;
648 uint32_t fields, size;
649
650 if (nxt_slow_path(SvROK(sv_head) == 0
651 || SvTYPE(SvRV(sv_head)) != SVt_PVAV))
652 {
653 nxt_unit_req_error(req,
654 "PSGI: An unsupported format was received from "
655 "Perl Application for head part");
656
657 return NXT_UNIT_ERROR;
658 }
659
660 array_head = (AV *) SvRV(sv_head);
661 array_len = av_len(array_head);
662
663 if (array_len < 1) {
664 return nxt_unit_response_init(req, status, 0, 0);
665 }
666
667 if (nxt_slow_path((array_len % 2) == 0)) {
668 nxt_unit_req_error(req, "PSGI: Bad format for head from "
669 "Perl Application");
670
671 return NXT_UNIT_ERROR;
672 }
673
674 fields = 0;
675 size = 0;
676
677 for (i = 0; i <= array_len; i++) {
678 entry = av_fetch(array_head, i, 0);
679
680 if (nxt_fast_path(entry == NULL)) {
681 nxt_unit_req_error(req, "PSGI: Failed to get head entry from "
682 "Perl Application");
683
684 return NXT_UNIT_ERROR;
685 }
686
687 value = SvPV(*entry, value_len);
688 size += value_len;
689
690 if ((i % 2) == 0) {
691 fields++;
692 }
693 }
694
695 rc = nxt_unit_response_init(req, status, fields, size);
696 if (nxt_slow_path(rc != NXT_UNIT_OK)) {
697 return rc;
698 }
699
700 for (i = 0; i <= array_len; i += 2) {
701 entry = av_fetch(array_head, i, 0);
702 name = SvPV(*entry, name_len);
703
704 entry = av_fetch(array_head, i + 1, 0);
705 value = SvPV(*entry, value_len);
706
707 rc = nxt_unit_response_add_field(req, name, name_len, value, value_len);
708 if (nxt_slow_path(rc != NXT_UNIT_OK)) {
709 return rc;
710 }
711 }
712
713 return NXT_UNIT_OK;
714}
715
716
717static int
718nxt_perl_psgi_result_body(PerlInterpreter *my_perl, SV *sv_body,
719 nxt_unit_request_info_t *req)
720{
721 SV **entry;
722 AV *body_array;
723 int rc;
724 long i;
725 nxt_str_t body;
726
727 if (nxt_slow_path(SvROK(sv_body) == 0
728 || SvTYPE(SvRV(sv_body)) != SVt_PVAV))
729 {
730 nxt_unit_req_error(req, "PSGI: An unsupported format was received from "
731 "Perl Application for a body part");
732
733 return NXT_UNIT_ERROR;
734 }
735
736 body_array = (AV *) SvRV(sv_body);
737
738 for (i = 0; i <= av_len(body_array); i++) {
739
740 entry = av_fetch(body_array, i, 0);
741
742 if (nxt_fast_path(entry == NULL)) {
743 nxt_unit_req_error(req, "PSGI: Failed to get body entry from "
744 "Perl Application");
745
746 return NXT_UNIT_ERROR;
747 }
748
749 body.start = (u_char *) SvPV(*entry, body.length);
750
751 if (body.length == 0) {
752 continue;
753 }
754
755 rc = nxt_unit_response_write(req, body.start, body.length);
756
757 if (nxt_slow_path(rc != NXT_UNIT_OK)) {
758 nxt_unit_req_error(req, "PSGI: Failed to write content from "
759 "Perl Application");
760 return rc;
761 }
762 }
763
764 return NXT_UNIT_OK;
765}
766
767
768typedef struct {
769 PerlInterpreter *my_perl;
770 PerlIO *fp;
771} nxt_perl_psgi_io_ctx_t;
772
773
774static int
775nxt_perl_psgi_result_body_ref(PerlInterpreter *my_perl, SV *sv_body,
776 nxt_unit_request_info_t *req)
777{
778 IO *io;
779 nxt_unit_read_info_t read_info;
780 nxt_perl_psgi_io_ctx_t io_ctx;
781
782 io = GvIO(SvRV(sv_body));
783
784 if (io == NULL) {
785 return NXT_UNIT_OK;
786 }
787
788 io_ctx.my_perl = my_perl;
789 io_ctx.fp = IoIFP(io);
790
791 read_info.read = nxt_perl_psgi_io_read;
792 read_info.eof = PerlIO_eof(io_ctx.fp);
793 read_info.buf_size = 8192;
794 read_info.data = &io_ctx;
795
796 return nxt_unit_response_write_cb(req, &read_info);
797}
798
799
800static ssize_t
801nxt_perl_psgi_io_read(nxt_unit_read_info_t *read_info, void *dst, size_t size)
802{
803 ssize_t res;
804 PerlInterpreter *my_perl;
805 nxt_perl_psgi_io_ctx_t *ctx;
806
807 ctx = read_info->data;
808 my_perl = ctx->my_perl;
809
810 res = PerlIO_read(ctx->fp, dst, size);
811
812 read_info->eof = PerlIO_eof(ctx->fp);
813
814 return res;
815}
816
817
818static int
819nxt_perl_psgi_result_array(PerlInterpreter *my_perl, SV *result,
820 nxt_unit_request_info_t *req)
821{
822 AV *array;
823 SV **sv_temp;
824 int rc;
825 long array_len;
826 nxt_int_t status;
827
828 array = (AV *) SvRV(result);
829 array_len = av_len(array);
830
831 if (nxt_slow_path(array_len < 0)) {
832 nxt_unit_req_error(req,
833 "PSGI: Invalid result format from Perl Application");
834
835 return NXT_UNIT_ERROR;
836 }
837
838 status = nxt_perl_psgi_result_status(my_perl, result);
839
840 if (nxt_slow_path(status < 0)) {
841 nxt_unit_req_error(req,
842 "PSGI: An unexpected status was received "
843 "from Perl Application");
844
845 return NXT_UNIT_ERROR;
846 }
847
848 if (array_len >= 1) {
849 sv_temp = av_fetch(array, 1, 0);
850
851 if (nxt_slow_path(sv_temp == NULL)) {
852 nxt_unit_req_error(req, "PSGI: Failed to get head from "
853 "Perl ARRAY variable");
854
855 return NXT_UNIT_ERROR;
856 }
857
858 rc = nxt_perl_psgi_result_head(my_perl, *sv_temp, req, status);
859 if (nxt_slow_path(rc != NXT_UNIT_OK)) {
860 return rc;
861 }
862
863 } else {
864 return nxt_unit_response_init(req, status, 0, 0);
865 }
866
867 if (nxt_fast_path(array_len < 2)) {
868 return NXT_UNIT_OK;
869 }
870
871 sv_temp = av_fetch(array, 2, 0);
872
873 if (nxt_slow_path(sv_temp == NULL || SvROK(*sv_temp) == FALSE)) {
874 nxt_unit_req_error(req,
875 "PSGI: Failed to get body from "
876 "Perl ARRAY variable");
877
878 return NXT_UNIT_ERROR;
879 }
880
881 if (SvTYPE(SvRV(*sv_temp)) == SVt_PVAV) {
882 return nxt_perl_psgi_result_body(my_perl, *sv_temp, req);
883 }
884
885 return nxt_perl_psgi_result_body_ref(my_perl, *sv_temp, req);
886}
887
888
889static nxt_int_t
890nxt_perl_psgi_init(nxt_task_t *task, nxt_common_app_conf_t *conf)
891{
892 int rc;
893 nxt_unit_ctx_t *unit_ctx;
894 nxt_unit_init_t perl_init;
895 PerlInterpreter *my_perl;
896 nxt_perl_psgi_module_t module;
897
898 my_perl = nxt_perl_psgi_interpreter_init(task, conf->u.perl.script,
899 &module.app);
900
901 if (nxt_slow_path(my_perl == NULL)) {
902 return NXT_ERROR;
903 }
904
905 module.my_perl = my_perl;
906 nxt_perl_psgi = my_perl;
907
908 nxt_unit_default_init(task, &perl_init);
909
910 perl_init.callbacks.request_handler = nxt_perl_psgi_request_handler;
911 perl_init.data = &module;
912
913 unit_ctx = nxt_unit_init(&perl_init);
914 if (nxt_slow_path(unit_ctx == NULL)) {
915 return NXT_ERROR;
916 }
917
918 rc = nxt_unit_run(unit_ctx);
919
920 nxt_unit_done(unit_ctx);
921
922 nxt_perl_psgi_atexit();
923
924 exit(rc);
925
926 return NXT_OK;
927}
928
929
930static void
931nxt_perl_psgi_request_handler(nxt_unit_request_info_t *req)
932{
933 SV *env, *result;
934 nxt_int_t rc;
935 PerlInterpreter *my_perl;
936 nxt_perl_psgi_input_t input;
937 nxt_perl_psgi_module_t *module;
938
939 module = req->unit->data;
940 my_perl = module->my_perl;
941
942 input.my_perl = my_perl;
943 input.req = req;
944
945 /*
946 * Create environ variable for perl sub "application".
947 * > sub application {
948 * > my ($environ) = @_;
949 */
950 env = nxt_perl_psgi_env_create(my_perl, req, &input);
951 if (nxt_slow_path(env == NULL)) {
952 nxt_unit_req_error(req,
953 "PSGI: Failed to create 'env' for Perl Application");
954 nxt_unit_request_done(req, NXT_UNIT_ERROR);
955
956 return;
957 }
958
959 nxt_perl_psgi_arg_input.ctx = &input;
960 nxt_perl_psgi_arg_error.ctx = &input;
961
962 /* Call perl sub and get result as SV*. */
963 result = nxt_perl_psgi_call_var_application(my_perl, env, module->app, req);
964
965 /*
966 * We expect ARRAY ref like a
967 * ['200', ['Content-Type' => "text/plain"], ["body"]]
968 */
969 if (nxt_slow_path(SvOK(result) == 0 || SvROK(result) == 0
970 || SvTYPE(SvRV(result)) != SVt_PVAV))
971 {
972 nxt_unit_req_error(req, "PSGI: An unexpected response was received "
973 "from Perl Application");
974
975 rc = NXT_UNIT_ERROR;
976
977 } else {
978 rc = nxt_perl_psgi_result_array(my_perl, result, req);
979 }
980
981 nxt_unit_request_done(req, rc);
982
983 SvREFCNT_dec(result);
984 SvREFCNT_dec(env);
985}
986
987
988static void
989nxt_perl_psgi_atexit(void)
990{
991 dTHXa(nxt_perl_psgi);
992
993 nxt_perl_psgi_layer_stream_io_destroy(aTHX_ nxt_perl_psgi_arg_input.io);
994 nxt_perl_psgi_layer_stream_fp_destroy(aTHX_ nxt_perl_psgi_arg_input.fp);
995
996 nxt_perl_psgi_layer_stream_io_destroy(aTHX_ nxt_perl_psgi_arg_error.io);
997 nxt_perl_psgi_layer_stream_fp_destroy(aTHX_ nxt_perl_psgi_arg_error.fp);
998
999 perl_destruct(nxt_perl_psgi);
1000 perl_free(nxt_perl_psgi);
1001 PERL_SYS_TERM();
1002}