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
15
16typedef struct {
17 PerlInterpreter *my_perl;
18
19 nxt_task_t *task;
20 nxt_app_rmsg_t *rmsg;
21 nxt_app_wmsg_t *wmsg;
22
23 size_t body_preread_size;
24} nxt_perl_psgi_input_t;
25
26
27nxt_inline nxt_int_t nxt_perl_psgi_write(nxt_task_t *task, nxt_app_wmsg_t *wmsg,
28 const u_char *data, size_t len,
29 nxt_bool_t flush, nxt_bool_t last);
30
31nxt_inline nxt_int_t nxt_perl_psgi_http_write_status_str(nxt_task_t *task,
32 nxt_app_wmsg_t *wmsg, nxt_str_t *http_status);
33
34static long nxt_perl_psgi_io_input_read(PerlInterpreter *my_perl,
35 nxt_perl_psgi_io_arg_t *arg, void *vbuf, size_t length);
36static long nxt_perl_psgi_io_input_write(PerlInterpreter *my_perl,
37 nxt_perl_psgi_io_arg_t *arg, const void *vbuf, size_t length);
38static long nxt_perl_psgi_io_input_flush(PerlInterpreter *my_perl,
39 nxt_perl_psgi_io_arg_t *arg);
40

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

48/*
49static void nxt_perl_psgi_xs_core_global_changes(PerlInterpreter *my_perl,
50 const char *core, const char *sub, XSUBADDR_t sub_addr);
51*/
52
53static void nxt_perl_psgi_xs_init(pTHX);
54
55static SV *nxt_perl_psgi_call_var_application(PerlInterpreter *my_perl,
56 SV *env, nxt_task_t *task);
57
58/* For currect load XS modules */
59EXTERN_C void boot_DynaLoader(pTHX_ CV *cv);
60
61static nxt_int_t nxt_perl_psgi_io_input_init(PerlInterpreter *my_perl,
62 nxt_perl_psgi_io_arg_t *arg);
63static nxt_int_t nxt_perl_psgi_io_error_init(PerlInterpreter *my_perl,
64 nxt_perl_psgi_io_arg_t *arg);
65
66static PerlInterpreter *nxt_perl_psgi_interpreter_init(nxt_task_t *task,
67 char *script);
68
69nxt_inline nxt_int_t nxt_perl_psgi_env_append_str(PerlInterpreter *my_perl,
70 HV *hash_env, const char *name, nxt_str_t *str);
71nxt_inline nxt_int_t nxt_perl_psgi_env_append(PerlInterpreter *my_perl,
72 HV *hash_env, const char *name, void *value);
73
74static SV *nxt_perl_psgi_env_create(PerlInterpreter *my_perl, nxt_task_t *task,
75 nxt_app_rmsg_t *rmsg, size_t *body_preread_size);
76
77nxt_inline nxt_int_t nxt_perl_psgi_read_add_env(PerlInterpreter *my_perl,
78 nxt_task_t *task, nxt_app_rmsg_t *rmsg, HV *hash_env,
79 const char *name, nxt_str_t *str);
80
81static u_char *nxt_perl_psgi_module_create(nxt_task_t *task,
82 const char *script);
83
84static nxt_str_t nxt_perl_psgi_result_status(PerlInterpreter *my_perl,
85 SV *result);
86static nxt_int_t nxt_perl_psgi_result_head(PerlInterpreter *my_perl,
87 SV *sv_head, nxt_task_t *task, nxt_app_wmsg_t *wmsg);
88static nxt_int_t nxt_perl_psgi_result_body(PerlInterpreter *my_perl,
89 SV *result, nxt_task_t *task, nxt_app_wmsg_t *wmsg);
90static nxt_int_t nxt_perl_psgi_result_body_ref(PerlInterpreter *my_perl,
91 SV *sv_body, nxt_task_t *task, nxt_app_wmsg_t *wmsg);
92static nxt_int_t nxt_perl_psgi_result_array(PerlInterpreter *my_perl,
93 SV *result, nxt_task_t *task, nxt_app_wmsg_t *wmsg);
94
95static nxt_int_t nxt_perl_psgi_init(nxt_task_t *task,
96 nxt_common_app_conf_t *conf);
97static nxt_int_t nxt_perl_psgi_run(nxt_task_t *task,
98 nxt_app_rmsg_t *rmsg, nxt_app_wmsg_t *wmsg);
99static void nxt_perl_psgi_atexit(nxt_task_t *task);
100
101typedef SV *(*nxt_perl_psgi_callback_f)(PerlInterpreter *my_perl,
102 SV *env, nxt_task_t *task);
103
104static SV *nxt_perl_psgi_app;
105static PerlInterpreter *nxt_perl_psgi;
106static nxt_perl_psgi_io_arg_t nxt_perl_psgi_arg_input, nxt_perl_psgi_arg_error;
107
108static uint32_t nxt_perl_psgi_compat[] = {
109 NXT_VERNUM, NXT_DEBUG,
110};
111
112NXT_EXPORT nxt_application_module_t nxt_app_module = {
113 sizeof(nxt_perl_psgi_compat),
114 nxt_perl_psgi_compat,
115 nxt_string("perl"),
116 PERL_VERSION_STRING,
117 nxt_perl_psgi_init,
118 nxt_perl_psgi_run,
119 nxt_perl_psgi_atexit,
120};
121
122
123nxt_inline nxt_int_t
124nxt_perl_psgi_write(nxt_task_t *task, nxt_app_wmsg_t *wmsg,
125 const u_char *data, size_t len,
126 nxt_bool_t flush, nxt_bool_t last)
127{
128 nxt_int_t rc;
129
130 rc = nxt_app_msg_write_raw(task, wmsg, data, len);
131
132 if (nxt_slow_path(rc != NXT_OK)) {
133 return rc;
134 }
135
136 if (flush || last) {
137 rc = nxt_app_msg_flush(task, wmsg, last);
138 }
139
140 return rc;
141}
142
143
144nxt_inline nxt_int_t
145nxt_perl_psgi_http_write_status_str(nxt_task_t *task, nxt_app_wmsg_t *wmsg,
146 nxt_str_t *http_status)
147{
148 nxt_int_t rc;
149
150 rc = NXT_OK;
151
152#define RC_WRT(DATA, DATALEN, FLUSH) \
153 do { \
154 rc = nxt_perl_psgi_write(task, wmsg, DATA, \
155 DATALEN, FLUSH, 0); \
156 if (nxt_slow_path(rc != NXT_OK)) \
157 return rc; \
158 \
159 } while (0)
160
161 RC_WRT((const u_char *) "Status: ", nxt_length("Status: "), 0);
162 RC_WRT(http_status->start, http_status->length, 0);
163 RC_WRT((u_char *) "\r\n", nxt_length("\r\n"), 0);
164
165#undef RC_WRT
166
167 return rc;
168}
169
170
171static long
172nxt_perl_psgi_io_input_read(PerlInterpreter *my_perl,
173 nxt_perl_psgi_io_arg_t *arg, void *vbuf, size_t length)
174{
175 size_t copy_size;
176 nxt_perl_psgi_input_t *input;
177
178 input = (nxt_perl_psgi_input_t *) arg->ctx;
179
180 if (input->body_preread_size == 0) {
181 return 0;
182 }
183
184 copy_size = nxt_min(length, input->body_preread_size);
185 copy_size = nxt_app_msg_read_raw(input->task, input->rmsg,
186 vbuf, copy_size);
187
188 input->body_preread_size -= copy_size;
189
190 return copy_size;
191}
192
193
194static long
195nxt_perl_psgi_io_input_write(PerlInterpreter *my_perl,
196 nxt_perl_psgi_io_arg_t *arg, const void *vbuf, size_t length)
197{
198 return 0;

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

217
218static long
219nxt_perl_psgi_io_error_write(PerlInterpreter *my_perl,
220 nxt_perl_psgi_io_arg_t *arg, const void *vbuf, size_t length)
221{
222 nxt_perl_psgi_input_t *input;
223
224 input = (nxt_perl_psgi_input_t *) arg->ctx;
225 nxt_log_error(NXT_LOG_ERR, input->task->log, "Perl: %s", vbuf);
226
227 return (long) length;
228}
229
230
231static long
232nxt_perl_psgi_io_error_flush(PerlInterpreter *my_perl,
233 nxt_perl_psgi_io_arg_t *arg)

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

279
280 /* DynaLoader for Perl modules who use XS */
281 newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, __FILE__);
282}
283
284
285static SV *
286nxt_perl_psgi_call_var_application(PerlInterpreter *my_perl,
287 SV *env, nxt_task_t *task)
288{
289 SV *result;
290
291 dSP;
292
293 ENTER;
294 SAVETMPS;
295
296 PUSHMARK(sp);
297 XPUSHs(env);
298 PUTBACK;
299
300 call_sv(nxt_perl_psgi_app, G_EVAL|G_SCALAR);
301
302 SPAGAIN;
303
304 if (SvTRUE(ERRSV)) {
305 nxt_log_error(NXT_LOG_ERR, task->log,
306 "PSGI: Failed to run Perl Application: \n%s",
307 SvPV_nolen(ERRSV));
308 }
309
310 result = POPs;
311 SvREFCNT_inc(result);
312
313 PUTBACK;
314 FREETMPS;
315 LEAVE;

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

413 arg->read = nxt_perl_psgi_io_error_read;
414 arg->write = nxt_perl_psgi_io_error_write;
415
416 return NXT_OK;
417}
418
419
420static PerlInterpreter *
421nxt_perl_psgi_interpreter_init(nxt_task_t *task, char *script)
422{
423 int status, pargc;
424 char **pargv, **penv;
425 u_char *run_module;
426 PerlInterpreter *my_perl;
427
428 static char argv[] = "\0""-e\0""0";
429 static char *embedding[] = { &argv[0], &argv[1], &argv[4] };

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

480
481 status = nxt_perl_psgi_io_error_init(my_perl, &nxt_perl_psgi_arg_error);
482
483 if (nxt_slow_path(status != NXT_OK)) {
484 nxt_alert(task, "PSGI: Failed to init io.psgi.errors");
485 goto fail;
486 }
487
488 nxt_perl_psgi_app = eval_pv((const char *) run_module, FALSE);
489
490 if (SvTRUE(ERRSV)) {
491 nxt_alert(task, "PSGI: Failed to parse script: %s\n%s",
492 script, SvPV_nolen(ERRSV));
493 goto fail;
494 }
495
496 nxt_free(run_module);

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

506 perl_destruct(my_perl);
507 perl_free(my_perl);
508 PERL_SYS_TERM();
509
510 return NULL;
511}
512
513
514nxt_inline nxt_int_t
515nxt_perl_psgi_env_append_str(PerlInterpreter *my_perl, HV *hash_env,
516 const char *name, nxt_str_t *str)
517{
518 SV **ha;
519
520 ha = hv_store(hash_env, name, (I32) strlen(name),
521 newSVpv((const char *) str->start, (STRLEN) str->length), 0);
522
523 if (nxt_slow_path(ha == NULL)) {
524 return NXT_ERROR;
525 }
526
527 return NXT_OK;
528}
529
530
531nxt_inline nxt_int_t
532nxt_perl_psgi_env_append(PerlInterpreter *my_perl, HV *hash_env,
533 const char *name, void *value)
534{
535 SV **ha;
536
537 ha = hv_store(hash_env, name, (I32) strlen(name), value, 0);
538
539 if (nxt_slow_path(ha == NULL)) {
540 return NXT_ERROR;
541 }
542
543 return NXT_OK;
544}
545
546
547nxt_inline nxt_int_t
548nxt_perl_psgi_read_add_env(PerlInterpreter *my_perl, nxt_task_t *task,
549 nxt_app_rmsg_t *rmsg, HV *hash_env,
550 const char *name, nxt_str_t *str)
551{
552 nxt_int_t rc;
553
554 rc = nxt_app_msg_read_str(task, rmsg, str);
555
556 if (nxt_slow_path(rc != NXT_OK)) {
557 return rc;
558 }
559
560 if (str->start == NULL) {
561 return NXT_OK;
562 }
563
564 return nxt_perl_psgi_env_append_str(my_perl, hash_env, name, str);
565}
566
567
568static SV *
569nxt_perl_psgi_env_create(PerlInterpreter *my_perl, nxt_task_t *task,
570 nxt_app_rmsg_t *rmsg, size_t *body_preread_size)
571{
572 HV *hash_env;
573 AV *array_version;
574 u_char *colon;
575 size_t query_size;
576 nxt_int_t rc;
577 nxt_str_t str, value, path, target;
578 nxt_str_t host, server_name, server_port;
579
580 static nxt_str_t def_host = nxt_string("localhost");
581 static nxt_str_t def_port = nxt_string("80");
582
583 hash_env = newHV();
584
585 if (nxt_slow_path(hash_env == NULL)) {
586 return NULL;
587 }
588
589#define RC(FNS) \
590 do { \
591 if (nxt_slow_path((FNS) != NXT_OK)) \
592 goto fail; \
593 } while (0)
594
595#define GET_STR(ATTR) \
596 RC(nxt_perl_psgi_read_add_env(my_perl, task, rmsg, \
597 hash_env, ATTR, &str))
598
599 RC(nxt_perl_psgi_env_append_str(my_perl, hash_env,
600 "SERVER_SOFTWARE", &nxt_server));
601
602 GET_STR("REQUEST_METHOD");
603 GET_STR("REQUEST_URI");
604
605 target = str;
606
607 RC(nxt_app_msg_read_str(task, rmsg, &path));
608 RC(nxt_app_msg_read_size(task, rmsg, &query_size));
609
610 if (path.start == NULL || path.length == 0) {
611 path = target;
612 }
613
614 RC(nxt_perl_psgi_env_append_str(my_perl, hash_env, "PATH_INFO",
615 &path));
616
617 array_version = newAV();
618
619 if (nxt_slow_path(array_version == NULL)) {
620 goto fail;
621 }
622
623 av_push(array_version, newSViv(1));
624 av_push(array_version, newSViv(1));
625
626 RC(nxt_perl_psgi_env_append(my_perl, hash_env, "psgi.version",
627 newRV_noinc((SV *) array_version)));
628 RC(nxt_perl_psgi_env_append(my_perl, hash_env, "psgi.url_scheme",
629 newSVpv("http", 4)));
630 RC(nxt_perl_psgi_env_append(my_perl, hash_env, "psgi.input",
631 SvREFCNT_inc(nxt_perl_psgi_arg_input.io)));
632 RC(nxt_perl_psgi_env_append(my_perl, hash_env, "psgi.errors",
633 SvREFCNT_inc(nxt_perl_psgi_arg_error.io)));
634 RC(nxt_perl_psgi_env_append(my_perl, hash_env, "psgi.multithread",
635 &PL_sv_no));
636 RC(nxt_perl_psgi_env_append(my_perl, hash_env, "psgi.multiprocess",
637 &PL_sv_yes));
638 RC(nxt_perl_psgi_env_append(my_perl, hash_env, "psgi.run_once",
639 &PL_sv_no));
640 RC(nxt_perl_psgi_env_append(my_perl, hash_env, "psgi.nonblocking",
641 &PL_sv_no));
642 RC(nxt_perl_psgi_env_append(my_perl, hash_env, "psgi.streaming",
643 &PL_sv_no));
644
645 if (query_size > 0) {
646 query_size--;
647
648 if (nxt_slow_path(target.length < query_size)) {
649 goto fail;
650 }
651
652 str.start = &target.start[query_size];
653 str.length = target.length - query_size;
654
655 RC(nxt_perl_psgi_env_append_str(my_perl, hash_env,
656 "QUERY_STRING", &str));
657 }
658
659 GET_STR("SERVER_PROTOCOL");
660 GET_STR("REMOTE_ADDR");
661 GET_STR("SERVER_ADDR");
662
663 RC(nxt_app_msg_read_str(task, rmsg, &host));
664
665 if (host.length == 0) {
666 host = def_host;
667 }
668
669 colon = nxt_memchr(host.start, ':', host.length);
670 server_name = host;
671
672 if (colon != NULL) {
673 server_name.length = colon - host.start;
674
675 server_port.start = colon + 1;
676 server_port.length = host.length - server_name.length - 1;
677
678 } else {
679 server_port = def_port;
680 }
681
682 RC(nxt_perl_psgi_env_append_str(my_perl, hash_env,
683 "SERVER_NAME", &server_name));
684 RC(nxt_perl_psgi_env_append_str(my_perl, hash_env,
685 "SERVER_PORT", &server_port));
686
687 GET_STR("CONTENT_TYPE");
688 GET_STR("CONTENT_LENGTH");
689
690 for ( ;; ) {
691 rc = nxt_app_msg_read_str(task, rmsg, &str);
692
693 if (nxt_slow_path(rc != NXT_OK)) {
694 goto fail;
695 }
696
697 if (nxt_slow_path(str.length == 0)) {
698 break;
699 }
700
701 rc = nxt_app_msg_read_str(task, rmsg, &value);
702
703 if (nxt_slow_path(rc != NXT_OK)) {
704 break;
705 }
706
707 RC(nxt_perl_psgi_env_append_str(my_perl, hash_env,
708 (char *) str.start, &value));
709 }
710
711 RC(nxt_app_msg_read_size(task, rmsg, body_preread_size));
712
713#undef GET_STR
714#undef RC
715
716 return newRV_noinc((SV *) hash_env);
717
718fail:
719
720 SvREFCNT_dec(hash_env);
721
722 return NULL;
723}
724
725
726static nxt_str_t
727nxt_perl_psgi_result_status(PerlInterpreter *my_perl, SV *result)
728{
729 SV **sv_status;
730 AV *array;
731 nxt_str_t status;
732
733 array = (AV *) SvRV(result);
734 sv_status = av_fetch(array, 0, 0);
735
736 status.start = (u_char *) SvPV(*sv_status, status.length);
737
738 return status;
739}
740
741
742static nxt_int_t
743nxt_perl_psgi_result_head(PerlInterpreter *my_perl, SV *sv_head,
744 nxt_task_t *task, nxt_app_wmsg_t *wmsg)
745{
746 AV *array_head;
747 SV **entry;
748 long i, array_len;
749 nxt_int_t rc;
750 nxt_str_t body;
751
752 if (nxt_slow_path(SvROK(sv_head) == 0
753 || SvTYPE(SvRV(sv_head)) != SVt_PVAV))
754 {
755 nxt_log_error(NXT_LOG_ERR, task->log,
756 "PSGI: An unsupported format was received from "
757 "Perl Application for head part");
758
759 return NXT_ERROR;
760 }
761
762 array_head = (AV *) SvRV(sv_head);
763 array_len = av_len(array_head);
764
765 if (array_len < 1) {
766 return NXT_OK;
767 }
768
769 if (nxt_slow_path((array_len % 2) == 0)) {
770 nxt_log_error(NXT_LOG_ERR, task->log,
771 "PSGI: Bad format for head from "
772 "Perl Application");
773
774 return NXT_ERROR;
775 }
776
777 for (i = 0; i <= array_len; i++) {
778 entry = av_fetch(array_head, i, 0);
779
780 if (nxt_fast_path(entry == NULL)) {
781 nxt_log_error(NXT_LOG_ERR, task->log,
782 "PSGI: Failed to get head entry from "
783 "Perl Application");
784
785 return NXT_ERROR;
786 }
787
788 body.start = (u_char *) SvPV(*entry, body.length);
789
790 rc = nxt_app_msg_write_raw(task, wmsg,
791 (u_char *) body.start, body.length);
792
793 if (nxt_slow_path(rc != NXT_OK)) {
794 nxt_log_error(NXT_LOG_ERR, task->log,
795 "PSGI: Failed to write head "
796 "from Perl Application");
797 return rc;
798 }
799
800 if ((i % 2) == 0) {
801 rc = nxt_app_msg_write_raw(task, wmsg,
802 (u_char *) ": ", nxt_length(": "));
803 } else {
804 rc = nxt_app_msg_write_raw(task, wmsg,
805 (u_char *) "\r\n", nxt_length("\r\n"));
806 }
807
808 if (nxt_slow_path(rc != NXT_OK)) {
809 nxt_log_error(NXT_LOG_ERR, task->log,
810 "PSGI: Failed to write head from "
811 "Perl Application");
812 return rc;
813 }
814 }
815
816 return NXT_OK;
817}
818
819
820static nxt_int_t
821nxt_perl_psgi_result_body(PerlInterpreter *my_perl, SV *sv_body,
822 nxt_task_t *task, nxt_app_wmsg_t *wmsg)
823{
824 SV **entry;
825 AV *body_array;
826 long i;
827 nxt_int_t rc;
828 nxt_str_t body;
829
830 if (nxt_slow_path(SvROK(sv_body) == 0
831 || SvTYPE(SvRV(sv_body)) != SVt_PVAV))
832 {
833 nxt_log_error(NXT_LOG_ERR, task->log,
834 "PSGI: An unsupported format was received from "
835 "Perl Application for a body part");
836
837 return NXT_ERROR;
838 }
839
840 body_array = (AV *) SvRV(sv_body);
841
842 for (i = 0; i <= av_len(body_array); i++) {
843
844 entry = av_fetch(body_array, i, 0);
845
846 if (nxt_fast_path(entry == NULL)) {
847 nxt_log_error(NXT_LOG_ERR, task->log,
848 "PSGI: Failed to get body entry from "
849 "Perl Application");
850 return NXT_ERROR;
851 }
852
853 body.start = (u_char *) SvPV(*entry, body.length);
854
855 if (body.length == 0) {
856 continue;
857 }
858
859 rc = nxt_app_msg_write_raw(task, wmsg,
860 (u_char *) body.start, body.length);
861
862 if (nxt_slow_path(rc != NXT_OK)) {
863 nxt_log_error(NXT_LOG_ERR, task->log,
864 "PSGI: Failed to write 'body' from "
865 "Perl Application");
866 return rc;
867 }
868
869 rc = nxt_app_msg_flush(task, wmsg, 0);
870
871 if (nxt_slow_path(rc != NXT_OK)) {
872 nxt_log_error(NXT_LOG_ERR, task->log,
873 "PSGI: Failed to flush data for a 'body' "
874 "part from Perl Application");
875 return rc;
876 }
877 }
878
879 return NXT_OK;
880}
881
882
883static nxt_int_t
884nxt_perl_psgi_result_body_ref(PerlInterpreter *my_perl, SV *sv_body,
885 nxt_task_t *task, nxt_app_wmsg_t *wmsg)
886{
887 IO *io;
888 PerlIO *fp;
889 SSize_t n;
890 nxt_int_t rc;
891 u_char vbuf[8192];
892
893 io = GvIO(SvRV(sv_body));
894
895 if (io == NULL) {
896 return NXT_OK;
897 }
898
899 fp = IoIFP(io);
900
901 for ( ;; ) {
902 n = PerlIO_read(fp, vbuf, 8192);
903
904 if (n < 1) {
905 break;
906 }
907
908 rc = nxt_app_msg_write_raw(task, wmsg,
909 (u_char *) vbuf, (size_t) n);
910
911 if (nxt_slow_path(rc != NXT_OK)) {
912 nxt_log_error(NXT_LOG_ERR, task->log,
913 "PSGI: Failed to write 'body' from "
914 "Perl Application");
915
916 return rc;
917 }
918
919 rc = nxt_app_msg_flush(task, wmsg, 0);
920
921 if (nxt_slow_path(rc != NXT_OK)) {
922 nxt_log_error(NXT_LOG_ERR, task->log,
923 "PSGI: Failed to flush data for a body "
924 "part from Perl Application");
925
926 return rc;
927 }
928 }
929
930 return NXT_OK;
931}
932
933
934static nxt_int_t
935nxt_perl_psgi_result_array(PerlInterpreter *my_perl, SV *result,
936 nxt_task_t *task, nxt_app_wmsg_t *wmsg)
937{
938 AV *array;
939 SV **sv_temp;
940 long array_len;
941 nxt_int_t rc;
942 nxt_str_t http_status;
943
944 array = (AV *) SvRV(result);
945 array_len = av_len(array);
946
947 if (nxt_slow_path(array_len < 0)) {
948 nxt_log_error(NXT_LOG_ERR, task->log,
949 "PSGI: Invalid result format from Perl Application");
950
951 return NXT_ERROR;
952 }
953
954 http_status = nxt_perl_psgi_result_status(nxt_perl_psgi, result);
955
956 if (nxt_slow_path(http_status.start == NULL || http_status.length == 0)) {
957 nxt_log_error(NXT_LOG_ERR, task->log,
958 "PSGI: An unexpected status was received "
959 "from Perl Application");
960
961 return NXT_ERROR;
962 }
963
964 rc = nxt_perl_psgi_http_write_status_str(task, wmsg, &http_status);
965
966 if (nxt_slow_path(rc != NXT_OK)) {
967 nxt_log_error(NXT_LOG_ERR, task->log,
968 "PSGI: Failed to write HTTP Status");
969
970 return rc;
971 }
972
973 if (array_len < 1) {
974 rc = nxt_app_msg_write_raw(task, wmsg,
975 (u_char *) "\r\n", nxt_length("\r\n"));
976
977 if (nxt_slow_path(rc != NXT_OK)) {
978 nxt_log_error(NXT_LOG_ERR, task->log,
979 "PSGI: Failed to write HTTP Headers");
980
981 return rc;
982 }
983
984 return NXT_OK;
985 }
986
987 sv_temp = av_fetch(array, 1, 0);
988
989 if (nxt_slow_path(sv_temp == NULL)) {
990 nxt_log_error(NXT_LOG_ERR, task->log,
991 "PSGI: Failed to get head from Perl ARRAY variable");
992
993 return NXT_ERROR;
994 }
995
996 rc = nxt_perl_psgi_result_head(nxt_perl_psgi, *sv_temp, task, wmsg);
997
998 if (nxt_slow_path(rc != NXT_OK)) {
999 return rc;
1000 }
1001
1002 rc = nxt_app_msg_write_raw(task, wmsg,
1003 (u_char *) "\r\n", nxt_length("\r\n"));
1004
1005 if (nxt_slow_path(rc != NXT_OK)) {
1006 nxt_log_error(NXT_LOG_ERR, task->log,
1007 "PSGI: Failed to write HTTP Headers");
1008
1009 return rc;
1010 }
1011
1012 if (nxt_fast_path(array_len < 2)) {
1013 return NXT_OK;
1014 }
1015
1016 sv_temp = av_fetch(array, 2, 0);
1017
1018 if (nxt_slow_path(sv_temp == NULL || SvROK(*sv_temp) == FALSE)) {
1019 nxt_log_error(NXT_LOG_ERR, task->log,
1020 "PSGI: Failed to get body from Perl ARRAY variable");
1021
1022 return NXT_ERROR;
1023 }
1024
1025 if (SvTYPE(SvRV(*sv_temp)) == SVt_PVAV) {
1026 rc = nxt_perl_psgi_result_body(nxt_perl_psgi, *sv_temp, task, wmsg);
1027
1028 } else {
1029 rc = nxt_perl_psgi_result_body_ref(nxt_perl_psgi, *sv_temp,
1030 task, wmsg);
1031 }
1032
1033 if (nxt_slow_path(rc != NXT_OK)) {
1034 return rc;
1035 }
1036
1037 return NXT_OK;
1038}
1039
1040
1041static nxt_int_t
1042nxt_perl_psgi_init(nxt_task_t *task, nxt_common_app_conf_t *conf)
1043{
1044 PerlInterpreter *my_perl;
1045
1046 my_perl = nxt_perl_psgi_interpreter_init(task, conf->u.perl.script);
1047
1048 if (nxt_slow_path(my_perl == NULL)) {
1049 return NXT_ERROR;
1050 }
1051
1052 nxt_perl_psgi = my_perl;
1053
1054 return NXT_OK;
1055}
1056
1057
1058static nxt_int_t
1059nxt_perl_psgi_run(nxt_task_t *task, nxt_app_rmsg_t *rmsg, nxt_app_wmsg_t *wmsg)
1060{
1061 SV *env, *result;
1062 size_t body_preread_size;
1063 nxt_int_t rc;
1064 nxt_perl_psgi_input_t input;
1065
1066 dTHXa(nxt_perl_psgi);
1067
1068 /*
1069 * Create environ variable for perl sub "application".
1070 * > sub application {
1071 * > my ($environ) = @_;
1072 */
1073 env = nxt_perl_psgi_env_create(nxt_perl_psgi, task, rmsg,
1074 &body_preread_size);
1075
1076 if (nxt_slow_path(env == NULL)) {
1077 nxt_log_error(NXT_LOG_ERR, task->log,
1078 "PSGI: Failed to create 'env' for Perl Application");
1079
1080 return NXT_ERROR;
1081 }
1082
1083 input.my_perl = nxt_perl_psgi;
1084 input.task = task;
1085 input.rmsg = rmsg;
1086 input.wmsg = wmsg;
1087 input.body_preread_size = body_preread_size;
1088
1089 nxt_perl_psgi_arg_input.ctx = &input;
1090 nxt_perl_psgi_arg_error.ctx = &input;
1091
1092 /* Call perl sub and get result as SV*. */
1093 result = nxt_perl_psgi_call_var_application(nxt_perl_psgi, env, task);
1094
1095 /*
1096 * We expect ARRAY ref like a
1097 * ['200', ['Content-Type' => "text/plain"], ["body"]]
1098 */
1099 if (nxt_slow_path(SvOK(result) == 0 || SvROK(result) == 0
1100 || SvTYPE(SvRV(result)) != SVt_PVAV))
1101 {
1102 nxt_log_error(NXT_LOG_ERR, task->log,
1103 "PSGI: An unexpected response was received from "
1104 "Perl Application");
1105 goto fail;
1106 }
1107
1108 rc = nxt_perl_psgi_result_array(nxt_perl_psgi, result, task, wmsg);
1109
1110 if (nxt_slow_path(rc != NXT_OK)) {
1111 goto fail;
1112 }
1113
1114 rc = nxt_app_msg_flush(task, wmsg, 1);
1115
1116 if (nxt_slow_path(rc != NXT_OK)) {
1117 goto fail;
1118 }
1119
1120 SvREFCNT_dec(result);
1121 SvREFCNT_dec(env);
1122
1123 return NXT_OK;
1124
1125fail:
1126
1127 SvREFCNT_dec(result);
1128 SvREFCNT_dec(env);
1129
1130 return NXT_ERROR;
1131}
1132
1133
1134static void
1135nxt_perl_psgi_atexit(nxt_task_t *task)
1136{
1137 dTHXa(nxt_perl_psgi);
1138
1139 nxt_perl_psgi_layer_stream_io_destroy(aTHX_ nxt_perl_psgi_arg_input.io);
1140 nxt_perl_psgi_layer_stream_fp_destroy(aTHX_ nxt_perl_psgi_arg_input.fp);
1141
1142 nxt_perl_psgi_layer_stream_io_destroy(aTHX_ nxt_perl_psgi_arg_error.io);
1143 nxt_perl_psgi_layer_stream_fp_destroy(aTHX_ nxt_perl_psgi_arg_error.fp);
1144
1145 perl_destruct(nxt_perl_psgi);
1146 perl_free(nxt_perl_psgi);
1147 PERL_SYS_TERM();
1148}