nxt_perl_psgi.c (703:2d536dde84d2) nxt_perl_psgi.c (743:e0f0cd7d244a)
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>
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>
14
15
16typedef struct {
17
18
19typedef 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;
20 PerlInterpreter *my_perl;
21 nxt_unit_request_info_t *req;
24} nxt_perl_psgi_input_t;
25
26
22} nxt_perl_psgi_input_t;
23
24
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);
25typedef struct {
26 PerlInterpreter *my_perl;
27 SV *app;
28} nxt_perl_psgi_module_t;
30
29
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,
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,
56 SV *env, nxt_task_t *task);
53 SV *env, SV *app, nxt_unit_request_info_t *req);
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,
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,
67 char *script);
64 char *script, SV **app);
68
65
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);
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);
73
74
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
75
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
76static u_char *nxt_perl_psgi_module_create(nxt_task_t *task,
77 const char *script);
78
84static nxt_str_t nxt_perl_psgi_result_status(PerlInterpreter *my_perl,
79static nxt_int_t nxt_perl_psgi_result_status(PerlInterpreter *my_perl,
85 SV *result);
80 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);
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);
94
95static nxt_int_t nxt_perl_psgi_init(nxt_task_t *task,
96 nxt_common_app_conf_t *conf);
91
92static nxt_int_t nxt_perl_psgi_init(nxt_task_t *task,
93 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);
94static void nxt_perl_psgi_request_handler(nxt_unit_request_info_t *req);
95static void nxt_perl_psgi_atexit(void);
100
101typedef SV *(*nxt_perl_psgi_callback_f)(PerlInterpreter *my_perl,
102 SV *env, nxt_task_t *task);
103
96
97typedef SV *(*nxt_perl_psgi_callback_f)(PerlInterpreter *my_perl,
98 SV *env, nxt_task_t *task);
99
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
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
112NXT_EXPORT nxt_application_module_t nxt_app_module = {
107NXT_EXPORT nxt_app_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,
108 sizeof(nxt_perl_psgi_compat),
109 nxt_perl_psgi_compat,
110 nxt_string("perl"),
111 PERL_VERSION_STRING,
112 nxt_perl_psgi_init,
118 nxt_perl_psgi_run,
119 nxt_perl_psgi_atexit,
120};
121
122
113};
114
115
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{
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{
175 size_t copy_size;
176 nxt_perl_psgi_input_t *input;
177
178 input = (nxt_perl_psgi_input_t *) arg->ctx;
179
120 nxt_perl_psgi_input_t *input;
121
122 input = (nxt_perl_psgi_input_t *) arg->ctx;
123
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;
124 return nxt_unit_request_read(input->req, vbuf, length);
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;
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;
225 nxt_log_error(NXT_LOG_ERR, input->task->log, "Perl: %s", vbuf);
159 nxt_unit_req_error(input->req, "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,
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,
287 SV *env, nxt_task_t *task)
221 SV *env, SV *app, nxt_unit_request_info_t *req)
288{
289 SV *result;
290
291 dSP;
292
293 ENTER;
294 SAVETMPS;
295
296 PUSHMARK(sp);
297 XPUSHs(env);
298 PUTBACK;
299
222{
223 SV *result;
224
225 dSP;
226
227 ENTER;
228 SAVETMPS;
229
230 PUSHMARK(sp);
231 XPUSHs(env);
232 PUTBACK;
233
300 call_sv(nxt_perl_psgi_app, G_EVAL|G_SCALAR);
234 call_sv(app, G_EVAL|G_SCALAR);
301
302 SPAGAIN;
303
304 if (SvTRUE(ERRSV)) {
235
236 SPAGAIN;
237
238 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));
239 nxt_unit_req_error(req, "PSGI: Failed to run Perl Application: \n%s",
240 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 *
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 *
421nxt_perl_psgi_interpreter_init(nxt_task_t *task, char *script)
354nxt_perl_psgi_interpreter_init(nxt_task_t *task, char *script, SV **app)
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
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
488 nxt_perl_psgi_app = eval_pv((const char *) run_module, FALSE);
421 *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
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
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 *
447static SV *
569nxt_perl_psgi_env_create(PerlInterpreter *my_perl, nxt_task_t *task,
570 nxt_app_rmsg_t *rmsg, size_t *body_preread_size)
448nxt_perl_psgi_env_create(PerlInterpreter *my_perl,
449 nxt_unit_request_info_t *req, nxt_perl_psgi_input_t *input)
571{
450{
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;
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;
579
457
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();
458 hash_env = newHV();
584
585 if (nxt_slow_path(hash_env == NULL)) {
586 return NULL;
587 }
588
459 if (nxt_slow_path(hash_env == NULL)) {
460 return NULL;
461 }
462
589#define RC(FNS) \
590 do { \
591 if (nxt_slow_path((FNS) != NXT_OK)) \
592 goto fail; \
593 } while (0)
463#define RC(FNS) \
464 do { \
465 if (nxt_slow_path((FNS) != NXT_UNIT_OK)) \
466 goto fail; \
467 } while (0)
594
468
595#define GET_STR(ATTR) \
596 RC(nxt_perl_psgi_read_add_env(my_perl, task, rmsg, \
597 hash_env, ATTR, &str))
469#define NL(S) (S), sizeof(S)-1
598
470
599 RC(nxt_perl_psgi_env_append_str(my_perl, hash_env,
600 "SERVER_SOFTWARE", &nxt_server));
471 r = req->request;
601
472
602 GET_STR("REQUEST_METHOD");
603 GET_STR("REQUEST_URI");
473 RC(nxt_perl_psgi_add_str(my_perl, hash_env, NL("SERVER_SOFTWARE"),
474 (char *) nxt_server.start, nxt_server.length));
604
475
605 target = str;
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));
606
482
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
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
626 RC(nxt_perl_psgi_env_append(my_perl, hash_env, "psgi.version",
492 RC(nxt_perl_psgi_add_value(my_perl, hash_env, NL("psgi.version"),
627 newRV_noinc((SV *) array_version)));
493 newRV_noinc((SV *) array_version)));
628 RC(nxt_perl_psgi_env_append(my_perl, hash_env, "psgi.url_scheme",
494 RC(nxt_perl_psgi_add_value(my_perl, hash_env, NL("psgi.url_scheme"),
629 newSVpv("http", 4)));
495 newSVpv("http", 4)));
630 RC(nxt_perl_psgi_env_append(my_perl, hash_env, "psgi.input",
496 RC(nxt_perl_psgi_add_value(my_perl, hash_env, NL("psgi.input"),
631 SvREFCNT_inc(nxt_perl_psgi_arg_input.io)));
497 SvREFCNT_inc(nxt_perl_psgi_arg_input.io)));
632 RC(nxt_perl_psgi_env_append(my_perl, hash_env, "psgi.errors",
498 RC(nxt_perl_psgi_add_value(my_perl, hash_env, NL("psgi.errors"),
633 SvREFCNT_inc(nxt_perl_psgi_arg_error.io)));
499 SvREFCNT_inc(nxt_perl_psgi_arg_error.io)));
634 RC(nxt_perl_psgi_env_append(my_perl, hash_env, "psgi.multithread",
500 RC(nxt_perl_psgi_add_value(my_perl, hash_env, NL("psgi.multithread"),
635 &PL_sv_no));
501 &PL_sv_no));
636 RC(nxt_perl_psgi_env_append(my_perl, hash_env, "psgi.multiprocess",
502 RC(nxt_perl_psgi_add_value(my_perl, hash_env, NL("psgi.multiprocess"),
637 &PL_sv_yes));
503 &PL_sv_yes));
638 RC(nxt_perl_psgi_env_append(my_perl, hash_env, "psgi.run_once",
504 RC(nxt_perl_psgi_add_value(my_perl, hash_env, NL("psgi.run_once"),
639 &PL_sv_no));
505 &PL_sv_no));
640 RC(nxt_perl_psgi_env_append(my_perl, hash_env, "psgi.nonblocking",
506 RC(nxt_perl_psgi_add_value(my_perl, hash_env, NL("psgi.nonblocking"),
641 &PL_sv_no));
507 &PL_sv_no));
642 RC(nxt_perl_psgi_env_append(my_perl, hash_env, "psgi.streaming",
508 RC(nxt_perl_psgi_add_value(my_perl, hash_env, NL("psgi.streaming"),
643 &PL_sv_no));
644
509 &PL_sv_no));
510
645 if (query_size > 0) {
646 query_size--;
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));
647
521
648 if (nxt_slow_path(target.length < query_size)) {
649 goto fail;
650 }
522 for (i = 0; i < r->fields_count; i++) {
523 f = r->fields + i;
651
524
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));
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));
657 }
658
528 }
529
659 GET_STR("SERVER_PROTOCOL");
660 GET_STR("REMOTE_ADDR");
661 GET_STR("SERVER_ADDR");
530 if (r->content_length_field != NXT_UNIT_NONE_FIELD) {
531 f = r->fields + r->content_length_field;
662
532
663 RC(nxt_app_msg_read_str(task, rmsg, &host));
664
665 if (host.length == 0) {
666 host = def_host;
533 RC(nxt_perl_psgi_add_sptr(my_perl, hash_env, NL("CONTENT_LENGTH"),
534 &f->value, f->value_length));
667 }
668
535 }
536
669 colon = nxt_memchr(host.start, ':', host.length);
670 server_name = host;
537 if (r->content_type_field != NXT_UNIT_NONE_FIELD) {
538 f = r->fields + r->content_type_field;
671
539
672 if (colon != NULL) {
673 server_name.length = colon - host.start;
540 RC(nxt_perl_psgi_add_sptr(my_perl, hash_env, NL("CONTENT_TYPE"),
541 &f->value, f->value_length));
542 }
674
543
675 server_port.start = colon + 1;
676 server_port.length = host.length - server_name.length - 1;
544 if (r->host_field != NXT_UNIT_NONE_FIELD) {
545 f = r->fields + r->host_field;
677
546
547 host_start = nxt_unit_sptr_get(&f->value);
548 host_length = f->value_length;
549
678 } else {
550 } else {
679 server_port = def_port;
551 host_start = NULL;
552 host_length = 0;
680 }
681
553 }
554
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));
555 nxt_unit_split_host(host_start, host_length, &host_start, &host_length,
556 &port_start, &port_length);
686
557
687 GET_STR("CONTENT_TYPE");
688 GET_STR("CONTENT_LENGTH");
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));
689
562
690 for ( ;; ) {
691 rc = nxt_app_msg_read_str(task, rmsg, &str);
563#undef NL
564#undef RC
692
565
693 if (nxt_slow_path(rc != NXT_OK)) {
694 goto fail;
695 }
566 return newRV_noinc((SV *) hash_env);
696
567
697 if (nxt_slow_path(str.length == 0)) {
698 break;
699 }
568fail:
700
569
701 rc = nxt_app_msg_read_str(task, rmsg, &value);
570 SvREFCNT_dec(hash_env);
702
571
703 if (nxt_slow_path(rc != NXT_OK)) {
704 break;
705 }
572 return NULL;
573}
706
574
707 RC(nxt_perl_psgi_env_append_str(my_perl, hash_env,
708 (char *) str.start, &value));
709 }
710
575
711 RC(nxt_app_msg_read_size(task, rmsg, body_preread_size));
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}
712
583
713#undef GET_STR
714#undef RC
715
584
716 return newRV_noinc((SV *) hash_env);
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;
717
590
718fail:
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 }
719
596
720 SvREFCNT_dec(hash_env);
597 return NXT_UNIT_OK;
598}
721
599
722 return NULL;
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;
723}
724
725
613}
614
615
726static nxt_str_t
616static nxt_int_t
727nxt_perl_psgi_result_status(PerlInterpreter *my_perl, SV *result)
728{
729 SV **sv_status;
730 AV *array;
617nxt_perl_psgi_result_status(PerlInterpreter *my_perl, SV *result)
618{
619 SV **sv_status;
620 AV *array;
621 u_char *space;
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
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
738 return status;
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);
739}
740
741
635}
636
637
742static nxt_int_t
638static int
743nxt_perl_psgi_result_head(PerlInterpreter *my_perl, SV *sv_head,
639nxt_perl_psgi_result_head(PerlInterpreter *my_perl, SV *sv_head,
744 nxt_task_t *task, nxt_app_wmsg_t *wmsg)
640 nxt_unit_request_info_t *req, uint16_t status)
745{
746 AV *array_head;
747 SV **entry;
641{
642 AV *array_head;
643 SV **entry;
644 int rc;
748 long i, array_len;
645 long i, array_len;
749 nxt_int_t rc;
750 nxt_str_t body;
646 char *name, *value;
647 STRLEN name_len, value_len;
648 uint32_t fields, size;
751
752 if (nxt_slow_path(SvROK(sv_head) == 0
753 || SvTYPE(SvRV(sv_head)) != SVt_PVAV))
754 {
649
650 if (nxt_slow_path(SvROK(sv_head) == 0
651 || SvTYPE(SvRV(sv_head)) != SVt_PVAV))
652 {
755 nxt_log_error(NXT_LOG_ERR, task->log,
756 "PSGI: An unsupported format was received from "
757 "Perl Application for head part");
653 nxt_unit_req_error(req,
654 "PSGI: An unsupported format was received from "
655 "Perl Application for head part");
758
656
759 return NXT_ERROR;
657 return NXT_UNIT_ERROR;
760 }
761
762 array_head = (AV *) SvRV(sv_head);
763 array_len = av_len(array_head);
764
765 if (array_len < 1) {
658 }
659
660 array_head = (AV *) SvRV(sv_head);
661 array_len = av_len(array_head);
662
663 if (array_len < 1) {
766 return NXT_OK;
664 return nxt_unit_response_init(req, status, 0, 0);
767 }
768
769 if (nxt_slow_path((array_len % 2) == 0)) {
665 }
666
667 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");
668 nxt_unit_req_error(req, "PSGI: Bad format for head from "
669 "Perl Application");
773
670
774 return NXT_ERROR;
671 return NXT_UNIT_ERROR;
775 }
776
672 }
673
674 fields = 0;
675 size = 0;
676
777 for (i = 0; i <= array_len; i++) {
778 entry = av_fetch(array_head, i, 0);
779
780 if (nxt_fast_path(entry == NULL)) {
677 for (i = 0; i <= array_len; i++) {
678 entry = av_fetch(array_head, i, 0);
679
680 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");
681 nxt_unit_req_error(req, "PSGI: Failed to get head entry from "
682 "Perl Application");
784
683
785 return NXT_ERROR;
684 return NXT_UNIT_ERROR;
786 }
787
685 }
686
788 body.start = (u_char *) SvPV(*entry, body.length);
687 value = SvPV(*entry, value_len);
688 size += value_len;
789
689
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) {
690 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"));
691 fields++;
806 }
692 }
693 }
807
694
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");
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)) {
812 return rc;
813 }
814 }
815
709 return rc;
710 }
711 }
712
816 return NXT_OK;
713 return NXT_UNIT_OK;
817}
818
819
714}
715
716
820static nxt_int_t
717static int
821nxt_perl_psgi_result_body(PerlInterpreter *my_perl, SV *sv_body,
718nxt_perl_psgi_result_body(PerlInterpreter *my_perl, SV *sv_body,
822 nxt_task_t *task, nxt_app_wmsg_t *wmsg)
719 nxt_unit_request_info_t *req)
823{
824 SV **entry;
825 AV *body_array;
720{
721 SV **entry;
722 AV *body_array;
723 int rc;
826 long i;
724 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 {
725 nxt_str_t body;
726
727 if (nxt_slow_path(SvROK(sv_body) == 0
728 || SvTYPE(SvRV(sv_body)) != SVt_PVAV))
729 {
833 nxt_log_error(NXT_LOG_ERR, task->log,
834 "PSGI: An unsupported format was received from "
835 "Perl Application for a body part");
730 nxt_unit_req_error(req, "PSGI: An unsupported format was received from "
731 "Perl Application for a body part");
836
732
837 return NXT_ERROR;
733 return NXT_UNIT_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)) {
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)) {
847 nxt_log_error(NXT_LOG_ERR, task->log,
848 "PSGI: Failed to get body entry from "
849 "Perl Application");
850 return NXT_ERROR;
743 nxt_unit_req_error(req, "PSGI: Failed to get body entry from "
744 "Perl Application");
745
746 return NXT_UNIT_ERROR;
851 }
852
853 body.start = (u_char *) SvPV(*entry, body.length);
854
855 if (body.length == 0) {
856 continue;
857 }
858
747 }
748
749 body.start = (u_char *) SvPV(*entry, body.length);
750
751 if (body.length == 0) {
752 continue;
753 }
754
859 rc = nxt_app_msg_write_raw(task, wmsg,
860 (u_char *) body.start, body.length);
755 rc = nxt_unit_response_write(req, body.start, body.length);
861
756
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");
757 if (nxt_slow_path(rc != NXT_UNIT_OK)) {
758 nxt_unit_req_error(req, "PSGI: Failed to write content from "
759 "Perl Application");
866 return rc;
867 }
760 return rc;
761 }
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
762 }
763
879 return NXT_OK;
764 return NXT_UNIT_OK;
880}
881
882
765}
766
767
883static nxt_int_t
768typedef struct {
769 PerlInterpreter *my_perl;
770 PerlIO *fp;
771} nxt_perl_psgi_io_ctx_t;
772
773
774static int
884nxt_perl_psgi_result_body_ref(PerlInterpreter *my_perl, SV *sv_body,
775nxt_perl_psgi_result_body_ref(PerlInterpreter *my_perl, SV *sv_body,
885 nxt_task_t *task, nxt_app_wmsg_t *wmsg)
776 nxt_unit_request_info_t *req)
886{
777{
887 IO *io;
888 PerlIO *fp;
889 SSize_t n;
890 nxt_int_t rc;
891 u_char vbuf[8192];
778 IO *io;
779 nxt_unit_read_info_t read_info;
780 nxt_perl_psgi_io_ctx_t io_ctx;
892
893 io = GvIO(SvRV(sv_body));
894
895 if (io == NULL) {
781
782 io = GvIO(SvRV(sv_body));
783
784 if (io == NULL) {
896 return NXT_OK;
785 return NXT_UNIT_OK;
897 }
898
786 }
787
899 fp = IoIFP(io);
788 io_ctx.my_perl = my_perl;
789 io_ctx.fp = IoIFP(io);
900
790
901 for ( ;; ) {
902 n = PerlIO_read(fp, vbuf, 8192);
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;
903
795
904 if (n < 1) {
905 break;
906 }
796 return nxt_unit_response_write_cb(req, &read_info);
797}
907
798
908 rc = nxt_app_msg_write_raw(task, wmsg,
909 (u_char *) vbuf, (size_t) n);
910
799
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");
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;
915
806
916 return rc;
917 }
807 ctx = read_info->data;
808 my_perl = ctx->my_perl;
918
809
919 rc = nxt_app_msg_flush(task, wmsg, 0);
810 res = PerlIO_read(ctx->fp, dst, size);
920
811
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");
812 read_info->eof = PerlIO_eof(ctx->fp);
925
813
926 return rc;
927 }
928 }
929
930 return NXT_OK;
814 return res;
931}
932
933
815}
816
817
934static nxt_int_t
818static int
935nxt_perl_psgi_result_array(PerlInterpreter *my_perl, SV *result,
819nxt_perl_psgi_result_array(PerlInterpreter *my_perl, SV *result,
936 nxt_task_t *task, nxt_app_wmsg_t *wmsg)
820 nxt_unit_request_info_t *req)
937{
938 AV *array;
939 SV **sv_temp;
821{
822 AV *array;
823 SV **sv_temp;
824 int rc;
940 long array_len;
825 long array_len;
941 nxt_int_t rc;
942 nxt_str_t http_status;
826 nxt_int_t status;
943
944 array = (AV *) SvRV(result);
945 array_len = av_len(array);
946
947 if (nxt_slow_path(array_len < 0)) {
827
828 array = (AV *) SvRV(result);
829 array_len = av_len(array);
830
831 if (nxt_slow_path(array_len < 0)) {
948 nxt_log_error(NXT_LOG_ERR, task->log,
949 "PSGI: Invalid result format from Perl Application");
832 nxt_unit_req_error(req,
833 "PSGI: Invalid result format from Perl Application");
950
834
951 return NXT_ERROR;
835 return NXT_UNIT_ERROR;
952 }
953
836 }
837
954 http_status = nxt_perl_psgi_result_status(nxt_perl_psgi, result);
838 status = nxt_perl_psgi_result_status(my_perl, result);
955
839
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");
840 if (nxt_slow_path(status < 0)) {
841 nxt_unit_req_error(req,
842 "PSGI: An unexpected status was received "
843 "from Perl Application");
960
844
961 return NXT_ERROR;
845 return NXT_UNIT_ERROR;
962 }
963
846 }
847
964 rc = nxt_perl_psgi_http_write_status_str(task, wmsg, &http_status);
848 if (array_len >= 1) {
849 sv_temp = av_fetch(array, 1, 0);
965
850
966 if (nxt_slow_path(rc != NXT_OK)) {
967 nxt_log_error(NXT_LOG_ERR, task->log,
968 "PSGI: Failed to write HTTP Status");
851 if (nxt_slow_path(sv_temp == NULL)) {
852 nxt_unit_req_error(req, "PSGI: Failed to get head from "
853 "Perl ARRAY variable");
969
854
970 return rc;
971 }
855 return NXT_UNIT_ERROR;
856 }
972
857
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
858 rc = nxt_perl_psgi_result_head(my_perl, *sv_temp, req, status);
859 if (nxt_slow_path(rc != NXT_UNIT_OK)) {
981 return rc;
982 }
983
860 return rc;
861 }
862
984 return NXT_OK;
863 } else {
864 return nxt_unit_response_init(req, status, 0, 0);
985 }
986
865 }
866
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)) {
867 if (nxt_fast_path(array_len < 2)) {
1013 return NXT_OK;
868 return NXT_UNIT_OK;
1014 }
1015
1016 sv_temp = av_fetch(array, 2, 0);
1017
1018 if (nxt_slow_path(sv_temp == NULL || SvROK(*sv_temp) == FALSE)) {
869 }
870
871 sv_temp = av_fetch(array, 2, 0);
872
873 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");
874 nxt_unit_req_error(req,
875 "PSGI: Failed to get body from "
876 "Perl ARRAY variable");
1021
877
1022 return NXT_ERROR;
878 return NXT_UNIT_ERROR;
1023 }
1024
1025 if (SvTYPE(SvRV(*sv_temp)) == SVt_PVAV) {
879 }
880
881 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);
882 return nxt_perl_psgi_result_body(my_perl, *sv_temp, req);
1031 }
1032
883 }
884
1033 if (nxt_slow_path(rc != NXT_OK)) {
1034 return rc;
1035 }
1036
1037 return NXT_OK;
885 return nxt_perl_psgi_result_body_ref(my_perl, *sv_temp, req);
1038}
1039
1040
1041static nxt_int_t
1042nxt_perl_psgi_init(nxt_task_t *task, nxt_common_app_conf_t *conf)
1043{
886}
887
888
889static nxt_int_t
890nxt_perl_psgi_init(nxt_task_t *task, nxt_common_app_conf_t *conf)
891{
1044 PerlInterpreter *my_perl;
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;
1045
897
1046 my_perl = nxt_perl_psgi_interpreter_init(task, conf->u.perl.script);
898 my_perl = nxt_perl_psgi_interpreter_init(task, conf->u.perl.script,
899 &module.app);
1047
1048 if (nxt_slow_path(my_perl == NULL)) {
1049 return NXT_ERROR;
1050 }
1051
900
901 if (nxt_slow_path(my_perl == NULL)) {
902 return NXT_ERROR;
903 }
904
905 module.my_perl = my_perl;
1052 nxt_perl_psgi = my_perl;
1053
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
1054 return NXT_OK;
1055}
1056
1057
926 return NXT_OK;
927}
928
929
1058static nxt_int_t
1059nxt_perl_psgi_run(nxt_task_t *task, nxt_app_rmsg_t *rmsg, nxt_app_wmsg_t *wmsg)
930static void
931nxt_perl_psgi_request_handler(nxt_unit_request_info_t *req)
1060{
932{
1061 SV *env, *result;
1062 size_t body_preread_size;
1063 nxt_int_t rc;
1064 nxt_perl_psgi_input_t input;
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;
1065
938
1066 dTHXa(nxt_perl_psgi);
939 module = req->unit->data;
940 my_perl = module->my_perl;
1067
941
942 input.my_perl = my_perl;
943 input.req = req;
944
1068 /*
1069 * Create environ variable for perl sub "application".
1070 * > sub application {
1071 * > my ($environ) = @_;
1072 */
945 /*
946 * Create environ variable for perl sub "application".
947 * > sub application {
948 * > my ($environ) = @_;
949 */
1073 env = nxt_perl_psgi_env_create(nxt_perl_psgi, task, rmsg,
1074 &body_preread_size);
1075
950 env = nxt_perl_psgi_env_create(my_perl, req, &input);
1076 if (nxt_slow_path(env == NULL)) {
951 if (nxt_slow_path(env == NULL)) {
1077 nxt_log_error(NXT_LOG_ERR, task->log,
1078 "PSGI: Failed to create 'env' for Perl Application");
952 nxt_unit_req_error(req,
953 "PSGI: Failed to create 'env' for Perl Application");
954 nxt_unit_request_done(req, NXT_UNIT_ERROR);
1079
955
1080 return NXT_ERROR;
956 return;
1081 }
1082
957 }
958
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*. */
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*. */
1093 result = nxt_perl_psgi_call_var_application(nxt_perl_psgi, env, task);
963 result = nxt_perl_psgi_call_var_application(my_perl, env, module->app, req);
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 {
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 {
1102 nxt_log_error(NXT_LOG_ERR, task->log,
1103 "PSGI: An unexpected response was received from "
1104 "Perl Application");
1105 goto fail;
1106 }
972 nxt_unit_req_error(req, "PSGI: An unexpected response was received "
973 "from Perl Application");
1107
974
1108 rc = nxt_perl_psgi_result_array(nxt_perl_psgi, result, task, wmsg);
975 rc = NXT_UNIT_ERROR;
1109
976
1110 if (nxt_slow_path(rc != NXT_OK)) {
1111 goto fail;
977 } else {
978 rc = nxt_perl_psgi_result_array(my_perl, result, req);
1112 }
1113
979 }
980
1114 rc = nxt_app_msg_flush(task, wmsg, 1);
981 nxt_unit_request_done(req, rc);
1115
982
1116 if (nxt_slow_path(rc != NXT_OK)) {
1117 goto fail;
1118 }
1119
1120 SvREFCNT_dec(result);
1121 SvREFCNT_dec(env);
983 SvREFCNT_dec(result);
984 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
985}
986
987
988static void
1135nxt_perl_psgi_atexit(nxt_task_t *task)
989nxt_perl_psgi_atexit(void)
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}
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}