nxt_perl_psgi.c (510:4979fe09d9cd) nxt_perl_psgi.c (519:743a347dfba3)
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
41static long nxt_perl_psgi_io_error_read(PerlInterpreter *my_perl,
42 nxt_perl_psgi_io_arg_t *arg, void *vbuf, size_t length);
43static long nxt_perl_psgi_io_error_write(PerlInterpreter *my_perl,
44 nxt_perl_psgi_io_arg_t *arg, const void *vbuf, size_t length);
45static long nxt_perl_psgi_io_error_flush(PerlInterpreter *my_perl,
46 nxt_perl_psgi_io_arg_t *arg);
47
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 nxt_string(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: ", (sizeof("Status: ") - 1), 0);
162 RC_WRT(http_status->start, http_status->length, 0);
163 RC_WRT((u_char *) "\r\n", (sizeof("\r\n") - 1), 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;
199}
200
201
202static long
203nxt_perl_psgi_io_input_flush(PerlInterpreter *my_perl,
204 nxt_perl_psgi_io_arg_t *arg)
205{
206 return 0;
207}
208
209
210static long
211nxt_perl_psgi_io_error_read(PerlInterpreter *my_perl,
212 nxt_perl_psgi_io_arg_t *arg, void *vbuf, size_t length)
213{
214 return 0;
215}
216
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)
234{
235 return 0;
236}
237
238
239/* In the future it will be necessary to change some Perl functions. */
240/*
241static void
242nxt_perl_psgi_xs_core_global_changes(PerlInterpreter *my_perl,
243 const char *core, const char *sub, XSUBADDR_t sub_addr)
244{
245 GV *gv;
246
247 gv = gv_fetchpv(core, TRUE, SVt_PVCV);
248
249#ifdef MUTABLE_CV
250 GvCV_set(gv, MUTABLE_CV(SvREFCNT_inc(get_cv(sub, TRUE))));
251#else
252 GvCV_set(gv, (CV *) (SvREFCNT_inc(get_cv(sub, TRUE))));
253#endif
254 GvIMPORTED_CV_on(gv);
255
256 newXS(sub, sub_addr, __FILE__);
257}
258*/
259
260
261XS(XS_NGINX__Unit__PSGI_exit);
262XS(XS_NGINX__Unit__PSGI_exit)
263{
264 I32 ax = POPMARK;
265 Perl_croak(aTHX_ (char *) NULL);
266 XSRETURN_EMPTY;
267}
268
269
270static void
271nxt_perl_psgi_xs_init(pTHX)
272{
273/*
274 nxt_perl_psgi_xs_core_global_changes(my_perl, "CORE::GLOBAL::exit",
275 "NGINX::Unit::PSGI::exit",
276 XS_NGINX__Unit__PSGI_exit);
277*/
278 nxt_perl_psgi_layer_stream_init(aTHX);
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;
316
317 return result;
318}
319
320
321static u_char *
322nxt_perl_psgi_module_create(nxt_task_t *task, const char *script)
323{
324 u_char *buf, *p;
325 size_t length;
326
327 static nxt_str_t prefix = nxt_string(
328 "package NGINX::Unit::Sandbox;"
329 "{my $app = do \""
330 );
331
332 static nxt_str_t suffix = nxt_string_zero(
333 "\";"
334 "unless ($app) {"
335 " if($@ || $1) {die $@ || $1}"
336 " else {die \"File not found or compilation error.\"}"
337 "} "
338 "return $app}"
339 );
340
341 length = strlen(script);
342
343 buf = nxt_malloc(prefix.length + length + suffix.length);
344
345 if (nxt_slow_path(buf == NULL)) {
346 nxt_log_error(NXT_LOG_ERR, task->log,
347 "PSGI: Failed to allocate memory "
348 "for Perl script file %s", script);
349 return NULL;
350 }
351
352 p = nxt_cpymem(buf, prefix.start, prefix.length);
353 p = nxt_cpymem(p, script, length);
354 nxt_memcpy(p, suffix.start, suffix.length);
355
356 return buf;
357}
358
359
360static nxt_int_t
361nxt_perl_psgi_io_input_init(PerlInterpreter *my_perl,
362 nxt_perl_psgi_io_arg_t *arg)
363{
364 SV *io;
365 PerlIO *fp;
366
367 fp = nxt_perl_psgi_layer_stream_fp_create(aTHX_ arg, "r");
368
369 if (nxt_slow_path(fp == NULL)) {
370 return NXT_ERROR;
371 }
372
373 io = nxt_perl_psgi_layer_stream_io_create(aTHX_ fp);
374
375 if (nxt_slow_path(io == NULL)) {
376 nxt_perl_psgi_layer_stream_fp_destroy(aTHX_ fp);
377 return NXT_ERROR;
378 }
379
380 arg->io = io;
381 arg->fp = fp;
382 arg->flush = nxt_perl_psgi_io_input_flush;
383 arg->read = nxt_perl_psgi_io_input_read;
384 arg->write = nxt_perl_psgi_io_input_write;
385
386 return NXT_OK;
387}
388
389
390static nxt_int_t
391nxt_perl_psgi_io_error_init(PerlInterpreter *my_perl,
392 nxt_perl_psgi_io_arg_t *arg)
393{
394 SV *io;
395 PerlIO *fp;
396
397 fp = nxt_perl_psgi_layer_stream_fp_create(aTHX_ arg, "w");
398
399 if (nxt_slow_path(fp == NULL)) {
400 return NXT_ERROR;
401 }
402
403 io = nxt_perl_psgi_layer_stream_io_create(aTHX_ fp);
404
405 if (nxt_slow_path(io == NULL)) {
406 nxt_perl_psgi_layer_stream_fp_destroy(aTHX_ fp);
407 return NXT_ERROR;
408 }
409
410 arg->io = io;
411 arg->fp = fp;
412 arg->flush = nxt_perl_psgi_io_error_flush;
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] };
430
431 pargc = 0;
432 pargv = NULL;
433 penv = NULL;
434
435 PERL_SYS_INIT3(&pargc, &pargv, &penv);
436
437 my_perl = perl_alloc();
438
439 if (nxt_slow_path(my_perl == NULL)) {
440 nxt_log_error(NXT_LOG_CRIT, task->log,
441 "PSGI: Failed to allocate memory for Perl interpreter");
442 return NULL;
443 }
444
445 run_module = NULL;
446
447 perl_construct(my_perl);
448 PERL_SET_CONTEXT(my_perl);
449
450 status = perl_parse(my_perl, nxt_perl_psgi_xs_init, 3, embedding, NULL);
451
452 if (nxt_slow_path(status != 0)) {
453 nxt_log_error(NXT_LOG_CRIT, task->log,
454 "PSGI: Failed to parse Perl Script");
455 goto fail;
456 }
457
458 PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
459 PL_origalen = 1;
460
461 status = perl_run(my_perl);
462
463 if (nxt_slow_path(status != 0)) {
464 nxt_log_error(NXT_LOG_CRIT, task->log,
465 "PSGI: Failed to run Perl");
466 goto fail;
467 }
468
469 sv_setsv(get_sv("0", 0), newSVpv(script, 0));
470
471 run_module = nxt_perl_psgi_module_create(task, script);
472
473 if (nxt_slow_path(run_module == NULL)) {
474 goto fail;
475 }
476
477 status = nxt_perl_psgi_io_input_init(my_perl, &nxt_perl_psgi_arg_input);
478
479 if (nxt_slow_path(status != NXT_OK)) {
480 nxt_log_error(NXT_LOG_CRIT, task->log,
481 "PSGI: Failed to init io.psgi.input");
482 goto fail;
483 }
484
485 status = nxt_perl_psgi_io_error_init(my_perl, &nxt_perl_psgi_arg_error);
486
487 if (nxt_slow_path(status != NXT_OK)) {
488 nxt_log_error(NXT_LOG_CRIT, task->log,
489 "PSGI: Failed to init io.psgi.errors");
490 goto fail;
491 }
492
493 nxt_perl_psgi_app = eval_pv((const char *) run_module, FALSE);
494
495 if (SvTRUE(ERRSV)) {
496 nxt_log_emerg(task->log, "PSGI: Failed to parse script: %s\n%s",
497 script, SvPV_nolen(ERRSV));
498 goto fail;
499 }
500
501 nxt_free(run_module);
502
503 return my_perl;
504
505fail:
506
507 if (run_module != NULL) {
508 nxt_free(run_module);
509 }
510
511 perl_destruct(my_perl);
512 perl_free(my_perl);
513 PERL_SYS_TERM();
514
515 return NULL;
516}
517
518
519nxt_inline nxt_int_t
520nxt_perl_psgi_env_append_str(PerlInterpreter *my_perl, HV *hash_env,
521 const char *name, nxt_str_t *str)
522{
523 SV **ha;
524
525 ha = hv_store(hash_env, name, (I32) strlen(name),
526 newSVpv((const char *) str->start, (STRLEN)str->length), 0);
527
528 if (nxt_slow_path(ha == NULL)) {
529 return NXT_ERROR;
530 }
531
532 return NXT_OK;
533}
534
535
536nxt_inline nxt_int_t
537nxt_perl_psgi_env_append(PerlInterpreter *my_perl, HV *hash_env,
538 const char *name, void *value)
539{
540 SV **ha;
541
542 ha = hv_store(hash_env, name, (I32) strlen(name), value, 0);
543
544 if (nxt_slow_path(ha == NULL)) {
545 return NXT_ERROR;
546 }
547
548 return NXT_OK;
549}
550
551
552nxt_inline nxt_int_t
553nxt_perl_psgi_read_add_env(PerlInterpreter *my_perl, nxt_task_t *task,
554 nxt_app_rmsg_t *rmsg, HV *hash_env,
555 const char *name, nxt_str_t *str)
556{
557 nxt_int_t rc;
558
559 rc = nxt_app_msg_read_str(task, rmsg, str);
560
561 if (nxt_slow_path(rc != NXT_OK)) {
562 return rc;
563 }
564
565 if (str->start == NULL) {
566 return NXT_OK;
567 }
568
569 return nxt_perl_psgi_env_append_str(my_perl, hash_env, name, str);
570}
571
572
573static SV *
574nxt_perl_psgi_env_create(PerlInterpreter *my_perl, nxt_task_t *task,
575 nxt_app_rmsg_t *rmsg, size_t *body_preread_size)
576{
577 HV *hash_env;
578 AV *array_version;
579 u_char *colon;
580 size_t query_size;
581 nxt_int_t rc;
582 nxt_str_t str, value, path, target;
583 nxt_str_t host, server_name, server_port;
584
585 static nxt_str_t def_host = nxt_string("localhost");
586 static nxt_str_t def_port = nxt_string("80");
587
588 hash_env = newHV();
589
590 if (nxt_slow_path(hash_env == NULL)) {
591 return NULL;
592 }
593
594#define RC(FNS) \
595 do { \
596 if (nxt_slow_path((FNS) != NXT_OK)) \
597 goto fail; \
598 } while (0)
599
600#define GET_STR(ATTR) \
601 RC(nxt_perl_psgi_read_add_env(my_perl, task, rmsg, \
602 hash_env, ATTR, &str))
603
604 GET_STR("REQUEST_METHOD");
605 GET_STR("REQUEST_URI");
606
607 target = str;
608
609 RC(nxt_app_msg_read_str(task, rmsg, &path));
610 RC(nxt_app_msg_read_size(task, rmsg, &query_size));
611
612 if (path.start == NULL || path.length == 0) {
613 path = target;
614 }
615
616 array_version = newAV();
617
618 if (nxt_slow_path(array_version == NULL)) {
619 goto fail;
620 }
621
622 av_push(array_version, newSViv(1));
623 av_push(array_version, newSViv(1));
624
625 RC(nxt_perl_psgi_env_append_str(my_perl, hash_env, "PATH_INFO",
626 &path));
627 RC(nxt_perl_psgi_env_append(my_perl, hash_env, "SCRIPT_NAME",
628 newSVpv("", 0)));
629 RC(nxt_perl_psgi_env_append(my_perl, hash_env, "psgi.run_once",
630 newSVpv("", 0)));
631 RC(nxt_perl_psgi_env_append(my_perl, hash_env, "psgi.streaming",
632 newSViv(0)));
633 RC(nxt_perl_psgi_env_append(my_perl, hash_env, "psgi.nonblocking",
634 newSVpv("", 0)));
635 RC(nxt_perl_psgi_env_append(my_perl, hash_env, "psgi.multithread",
636 newSVpv("", 0)));
637 RC(nxt_perl_psgi_env_append(my_perl, hash_env, "psgi.multiprocess",
638 newSVpv("", 0)));
639 RC(nxt_perl_psgi_env_append(my_perl, hash_env, "psgi.url_scheme",
640 newSVpv("http", 4)));
641 RC(nxt_perl_psgi_env_append(my_perl, hash_env, "psgi.input",
642 SvREFCNT_inc(nxt_perl_psgi_arg_input.io)));
643 RC(nxt_perl_psgi_env_append(my_perl, hash_env, "psgi.errors",
644 SvREFCNT_inc(nxt_perl_psgi_arg_error.io)));
645 RC(nxt_perl_psgi_env_append(my_perl, hash_env, "psgi.version",
646 newRV_noinc((SV *) array_version)));
647
648 if (query_size > 0) {
649 query_size--;
650
651 if (nxt_slow_path(target.length < query_size)) {
652 goto fail;
653 }
654
655 str.start = &target.start[query_size];
656 str.length = target.length - query_size;
657
658 RC(nxt_perl_psgi_env_append_str(my_perl, hash_env,
659 "QUERY_STRING", &str));
660 }
661
662 GET_STR("SERVER_PROTOCOL");
663 GET_STR("REMOTE_ADDR");
664 GET_STR("SERVER_ADDR");
665
666 RC(nxt_app_msg_read_str(task, rmsg, &host));
667
668 if (host.length == 0) {
669 host = def_host;
670 }
671
672 colon = nxt_memchr(host.start, ':', host.length);
673 server_name = host;
674
675 if (colon != NULL) {
676 server_name.length = colon - host.start;
677
678 server_port.start = colon + 1;
679 server_port.length = host.length - server_name.length - 1;
680
681 } else {
682 server_port = def_port;
683 }
684
685 RC(nxt_perl_psgi_env_append_str(my_perl, hash_env,
686 "SERVER_NAME", &server_name));
687 RC(nxt_perl_psgi_env_append_str(my_perl, hash_env,
688 "SERVER_PORT", &server_port));
689
690 GET_STR("CONTENT_TYPE");
691 GET_STR("CONTENT_LENGTH");
692
693 for ( ;; ) {
694 rc = nxt_app_msg_read_str(task, rmsg, &str);
695
696 if (nxt_slow_path(rc != NXT_OK)) {
697 goto fail;
698 }
699
700 if (nxt_slow_path(str.length == 0)) {
701 break;
702 }
703
704 rc = nxt_app_msg_read_str(task, rmsg, &value);
705
706 if (nxt_slow_path(rc != NXT_OK)) {
707 break;
708 }
709
710 RC(nxt_perl_psgi_env_append_str(my_perl, hash_env,
711 (char *) str.start, &value));
712 }
713
714 RC(nxt_app_msg_read_size(task, rmsg, body_preread_size));
715
716#undef GET_STR
717#undef RC
718
719 return newRV_noinc((SV *) hash_env);
720
721fail:
722
723 SvREFCNT_dec(hash_env);
724
725 return NULL;
726}
727
728
729static nxt_str_t
730nxt_perl_psgi_result_status(PerlInterpreter *my_perl, SV *result)
731{
732 SV **sv_status;
733 AV *array;
734 nxt_str_t status;
735
736 array = (AV *) SvRV(result);
737 sv_status = av_fetch(array, 0, 0);
738
739 status.start = (u_char *) SvPV(*sv_status, status.length);
740
741 return status;
742}
743
744
745static nxt_int_t
746nxt_perl_psgi_result_head(PerlInterpreter *my_perl, SV *sv_head,
747 nxt_task_t *task, nxt_app_wmsg_t *wmsg)
748{
749 AV *array_head;
750 SV **entry;
751 long i, array_len;
752 nxt_int_t rc;
753 nxt_str_t body;
754
755 if (nxt_slow_path(SvROK(sv_head) == 0
756 || SvTYPE(SvRV(sv_head)) != SVt_PVAV))
757 {
758 nxt_log_error(NXT_LOG_ERR, task->log,
759 "PSGI: An unsupported format was received from "
760 "Perl Application for head part");
761
762 return NXT_ERROR;
763 }
764
765 array_head = (AV *) SvRV(sv_head);
766 array_len = av_len(array_head);
767
768 if (array_len < 1) {
769 return NXT_OK;
770 }
771
772 if (nxt_slow_path((array_len % 2) == 0)) {
773 nxt_log_error(NXT_LOG_ERR, task->log,
774 "PSGI: Bad format for head from "
775 "Perl Application");
776
777 return NXT_ERROR;
778 }
779
780 for (i = 0; i <= array_len; i++) {
781 entry = av_fetch(array_head, i, 0);
782
783 if (nxt_fast_path(entry == NULL)) {
784 nxt_log_error(NXT_LOG_ERR, task->log,
785 "PSGI: Failed to get head entry from "
786 "Perl Application");
787
788 return NXT_ERROR;
789 }
790
791 body.start = (u_char *) SvPV(*entry, body.length);
792
793 rc = nxt_app_msg_write_raw(task, wmsg,
794 (u_char *) body.start, body.length);
795
796 if (nxt_slow_path(rc != NXT_OK)) {
797 nxt_log_error(NXT_LOG_ERR, task->log,
798 "PSGI: Failed to write head "
799 "from Perl Application");
800 return rc;
801 }
802
803 if ((i % 2) == 0) {
804 rc = nxt_app_msg_write_raw(task, wmsg,
805 (u_char *) ": ",
806 (sizeof(": ") - 1));
807 } else {
808 rc = nxt_app_msg_write_raw(task, wmsg,
809 (u_char *) "\r\n",
810 (sizeof("\r\n") - 1));
811 }
812
813 if (nxt_slow_path(rc != NXT_OK)) {
814 nxt_log_error(NXT_LOG_ERR, task->log,
815 "PSGI: Failed to write head from "
816 "Perl Application");
817 return rc;
818 }
819 }
820
821 return NXT_OK;
822}
823
824
825static nxt_int_t
826nxt_perl_psgi_result_body(PerlInterpreter *my_perl, SV *sv_body,
827 nxt_task_t *task, nxt_app_wmsg_t *wmsg)
828{
829 SV **entry;
830 AV *body_array;
831 long i;
832 nxt_int_t rc;
833 nxt_str_t body;
834
835 if (nxt_slow_path(SvROK(sv_body) == 0
836 || SvTYPE(SvRV(sv_body)) != SVt_PVAV))
837 {
838 nxt_log_error(NXT_LOG_ERR, task->log,
839 "PSGI: An unsupported format was received from "
840 "Perl Application for a body part");
841
842 return NXT_ERROR;
843 }
844
845 body_array = (AV *) SvRV(sv_body);
846
847 for (i = 0; i <= av_len(body_array); i++) {
848
849 entry = av_fetch(body_array, i, 0);
850
851 if (nxt_fast_path(entry == NULL)) {
852 nxt_log_error(NXT_LOG_ERR, task->log,
853 "PSGI: Failed to get body entry from "
854 "Perl Application");
855 return NXT_ERROR;
856 }
857
858 body.start = (u_char *) SvPV(*entry, body.length);
859
860 if (body.length == 0) {
861 continue;
862 }
863
864 rc = nxt_app_msg_write_raw(task, wmsg,
865 (u_char *) body.start, body.length);
866
867 if (nxt_slow_path(rc != NXT_OK)) {
868 nxt_log_error(NXT_LOG_ERR, task->log,
869 "PSGI: Failed to write 'body' from "
870 "Perl Application");
871 return rc;
872 }
873
874 rc = nxt_app_msg_flush(task, wmsg, 0);
875
876 if (nxt_slow_path(rc != NXT_OK)) {
877 nxt_log_error(NXT_LOG_ERR, task->log,
878 "PSGI: Failed to flush data for a 'body' "
879 "part from Perl Application");
880 return rc;
881 }
882 }
883
884 return NXT_OK;
885}
886
887
888static nxt_int_t
889nxt_perl_psgi_result_body_ref(PerlInterpreter *my_perl, SV *sv_body,
890 nxt_task_t *task, nxt_app_wmsg_t *wmsg)
891{
892 IO *io;
893 PerlIO *fp;
894 SSize_t n;
895 nxt_int_t rc;
896 u_char vbuf[8192];
897
898 io = GvIO(SvRV(sv_body));
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
41static long nxt_perl_psgi_io_error_read(PerlInterpreter *my_perl,
42 nxt_perl_psgi_io_arg_t *arg, void *vbuf, size_t length);
43static long nxt_perl_psgi_io_error_write(PerlInterpreter *my_perl,
44 nxt_perl_psgi_io_arg_t *arg, const void *vbuf, size_t length);
45static long nxt_perl_psgi_io_error_flush(PerlInterpreter *my_perl,
46 nxt_perl_psgi_io_arg_t *arg);
47
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 nxt_string(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: ", (sizeof("Status: ") - 1), 0);
162 RC_WRT(http_status->start, http_status->length, 0);
163 RC_WRT((u_char *) "\r\n", (sizeof("\r\n") - 1), 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;
199}
200
201
202static long
203nxt_perl_psgi_io_input_flush(PerlInterpreter *my_perl,
204 nxt_perl_psgi_io_arg_t *arg)
205{
206 return 0;
207}
208
209
210static long
211nxt_perl_psgi_io_error_read(PerlInterpreter *my_perl,
212 nxt_perl_psgi_io_arg_t *arg, void *vbuf, size_t length)
213{
214 return 0;
215}
216
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)
234{
235 return 0;
236}
237
238
239/* In the future it will be necessary to change some Perl functions. */
240/*
241static void
242nxt_perl_psgi_xs_core_global_changes(PerlInterpreter *my_perl,
243 const char *core, const char *sub, XSUBADDR_t sub_addr)
244{
245 GV *gv;
246
247 gv = gv_fetchpv(core, TRUE, SVt_PVCV);
248
249#ifdef MUTABLE_CV
250 GvCV_set(gv, MUTABLE_CV(SvREFCNT_inc(get_cv(sub, TRUE))));
251#else
252 GvCV_set(gv, (CV *) (SvREFCNT_inc(get_cv(sub, TRUE))));
253#endif
254 GvIMPORTED_CV_on(gv);
255
256 newXS(sub, sub_addr, __FILE__);
257}
258*/
259
260
261XS(XS_NGINX__Unit__PSGI_exit);
262XS(XS_NGINX__Unit__PSGI_exit)
263{
264 I32 ax = POPMARK;
265 Perl_croak(aTHX_ (char *) NULL);
266 XSRETURN_EMPTY;
267}
268
269
270static void
271nxt_perl_psgi_xs_init(pTHX)
272{
273/*
274 nxt_perl_psgi_xs_core_global_changes(my_perl, "CORE::GLOBAL::exit",
275 "NGINX::Unit::PSGI::exit",
276 XS_NGINX__Unit__PSGI_exit);
277*/
278 nxt_perl_psgi_layer_stream_init(aTHX);
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;
316
317 return result;
318}
319
320
321static u_char *
322nxt_perl_psgi_module_create(nxt_task_t *task, const char *script)
323{
324 u_char *buf, *p;
325 size_t length;
326
327 static nxt_str_t prefix = nxt_string(
328 "package NGINX::Unit::Sandbox;"
329 "{my $app = do \""
330 );
331
332 static nxt_str_t suffix = nxt_string_zero(
333 "\";"
334 "unless ($app) {"
335 " if($@ || $1) {die $@ || $1}"
336 " else {die \"File not found or compilation error.\"}"
337 "} "
338 "return $app}"
339 );
340
341 length = strlen(script);
342
343 buf = nxt_malloc(prefix.length + length + suffix.length);
344
345 if (nxt_slow_path(buf == NULL)) {
346 nxt_log_error(NXT_LOG_ERR, task->log,
347 "PSGI: Failed to allocate memory "
348 "for Perl script file %s", script);
349 return NULL;
350 }
351
352 p = nxt_cpymem(buf, prefix.start, prefix.length);
353 p = nxt_cpymem(p, script, length);
354 nxt_memcpy(p, suffix.start, suffix.length);
355
356 return buf;
357}
358
359
360static nxt_int_t
361nxt_perl_psgi_io_input_init(PerlInterpreter *my_perl,
362 nxt_perl_psgi_io_arg_t *arg)
363{
364 SV *io;
365 PerlIO *fp;
366
367 fp = nxt_perl_psgi_layer_stream_fp_create(aTHX_ arg, "r");
368
369 if (nxt_slow_path(fp == NULL)) {
370 return NXT_ERROR;
371 }
372
373 io = nxt_perl_psgi_layer_stream_io_create(aTHX_ fp);
374
375 if (nxt_slow_path(io == NULL)) {
376 nxt_perl_psgi_layer_stream_fp_destroy(aTHX_ fp);
377 return NXT_ERROR;
378 }
379
380 arg->io = io;
381 arg->fp = fp;
382 arg->flush = nxt_perl_psgi_io_input_flush;
383 arg->read = nxt_perl_psgi_io_input_read;
384 arg->write = nxt_perl_psgi_io_input_write;
385
386 return NXT_OK;
387}
388
389
390static nxt_int_t
391nxt_perl_psgi_io_error_init(PerlInterpreter *my_perl,
392 nxt_perl_psgi_io_arg_t *arg)
393{
394 SV *io;
395 PerlIO *fp;
396
397 fp = nxt_perl_psgi_layer_stream_fp_create(aTHX_ arg, "w");
398
399 if (nxt_slow_path(fp == NULL)) {
400 return NXT_ERROR;
401 }
402
403 io = nxt_perl_psgi_layer_stream_io_create(aTHX_ fp);
404
405 if (nxt_slow_path(io == NULL)) {
406 nxt_perl_psgi_layer_stream_fp_destroy(aTHX_ fp);
407 return NXT_ERROR;
408 }
409
410 arg->io = io;
411 arg->fp = fp;
412 arg->flush = nxt_perl_psgi_io_error_flush;
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] };
430
431 pargc = 0;
432 pargv = NULL;
433 penv = NULL;
434
435 PERL_SYS_INIT3(&pargc, &pargv, &penv);
436
437 my_perl = perl_alloc();
438
439 if (nxt_slow_path(my_perl == NULL)) {
440 nxt_log_error(NXT_LOG_CRIT, task->log,
441 "PSGI: Failed to allocate memory for Perl interpreter");
442 return NULL;
443 }
444
445 run_module = NULL;
446
447 perl_construct(my_perl);
448 PERL_SET_CONTEXT(my_perl);
449
450 status = perl_parse(my_perl, nxt_perl_psgi_xs_init, 3, embedding, NULL);
451
452 if (nxt_slow_path(status != 0)) {
453 nxt_log_error(NXT_LOG_CRIT, task->log,
454 "PSGI: Failed to parse Perl Script");
455 goto fail;
456 }
457
458 PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
459 PL_origalen = 1;
460
461 status = perl_run(my_perl);
462
463 if (nxt_slow_path(status != 0)) {
464 nxt_log_error(NXT_LOG_CRIT, task->log,
465 "PSGI: Failed to run Perl");
466 goto fail;
467 }
468
469 sv_setsv(get_sv("0", 0), newSVpv(script, 0));
470
471 run_module = nxt_perl_psgi_module_create(task, script);
472
473 if (nxt_slow_path(run_module == NULL)) {
474 goto fail;
475 }
476
477 status = nxt_perl_psgi_io_input_init(my_perl, &nxt_perl_psgi_arg_input);
478
479 if (nxt_slow_path(status != NXT_OK)) {
480 nxt_log_error(NXT_LOG_CRIT, task->log,
481 "PSGI: Failed to init io.psgi.input");
482 goto fail;
483 }
484
485 status = nxt_perl_psgi_io_error_init(my_perl, &nxt_perl_psgi_arg_error);
486
487 if (nxt_slow_path(status != NXT_OK)) {
488 nxt_log_error(NXT_LOG_CRIT, task->log,
489 "PSGI: Failed to init io.psgi.errors");
490 goto fail;
491 }
492
493 nxt_perl_psgi_app = eval_pv((const char *) run_module, FALSE);
494
495 if (SvTRUE(ERRSV)) {
496 nxt_log_emerg(task->log, "PSGI: Failed to parse script: %s\n%s",
497 script, SvPV_nolen(ERRSV));
498 goto fail;
499 }
500
501 nxt_free(run_module);
502
503 return my_perl;
504
505fail:
506
507 if (run_module != NULL) {
508 nxt_free(run_module);
509 }
510
511 perl_destruct(my_perl);
512 perl_free(my_perl);
513 PERL_SYS_TERM();
514
515 return NULL;
516}
517
518
519nxt_inline nxt_int_t
520nxt_perl_psgi_env_append_str(PerlInterpreter *my_perl, HV *hash_env,
521 const char *name, nxt_str_t *str)
522{
523 SV **ha;
524
525 ha = hv_store(hash_env, name, (I32) strlen(name),
526 newSVpv((const char *) str->start, (STRLEN)str->length), 0);
527
528 if (nxt_slow_path(ha == NULL)) {
529 return NXT_ERROR;
530 }
531
532 return NXT_OK;
533}
534
535
536nxt_inline nxt_int_t
537nxt_perl_psgi_env_append(PerlInterpreter *my_perl, HV *hash_env,
538 const char *name, void *value)
539{
540 SV **ha;
541
542 ha = hv_store(hash_env, name, (I32) strlen(name), value, 0);
543
544 if (nxt_slow_path(ha == NULL)) {
545 return NXT_ERROR;
546 }
547
548 return NXT_OK;
549}
550
551
552nxt_inline nxt_int_t
553nxt_perl_psgi_read_add_env(PerlInterpreter *my_perl, nxt_task_t *task,
554 nxt_app_rmsg_t *rmsg, HV *hash_env,
555 const char *name, nxt_str_t *str)
556{
557 nxt_int_t rc;
558
559 rc = nxt_app_msg_read_str(task, rmsg, str);
560
561 if (nxt_slow_path(rc != NXT_OK)) {
562 return rc;
563 }
564
565 if (str->start == NULL) {
566 return NXT_OK;
567 }
568
569 return nxt_perl_psgi_env_append_str(my_perl, hash_env, name, str);
570}
571
572
573static SV *
574nxt_perl_psgi_env_create(PerlInterpreter *my_perl, nxt_task_t *task,
575 nxt_app_rmsg_t *rmsg, size_t *body_preread_size)
576{
577 HV *hash_env;
578 AV *array_version;
579 u_char *colon;
580 size_t query_size;
581 nxt_int_t rc;
582 nxt_str_t str, value, path, target;
583 nxt_str_t host, server_name, server_port;
584
585 static nxt_str_t def_host = nxt_string("localhost");
586 static nxt_str_t def_port = nxt_string("80");
587
588 hash_env = newHV();
589
590 if (nxt_slow_path(hash_env == NULL)) {
591 return NULL;
592 }
593
594#define RC(FNS) \
595 do { \
596 if (nxt_slow_path((FNS) != NXT_OK)) \
597 goto fail; \
598 } while (0)
599
600#define GET_STR(ATTR) \
601 RC(nxt_perl_psgi_read_add_env(my_perl, task, rmsg, \
602 hash_env, ATTR, &str))
603
604 GET_STR("REQUEST_METHOD");
605 GET_STR("REQUEST_URI");
606
607 target = str;
608
609 RC(nxt_app_msg_read_str(task, rmsg, &path));
610 RC(nxt_app_msg_read_size(task, rmsg, &query_size));
611
612 if (path.start == NULL || path.length == 0) {
613 path = target;
614 }
615
616 array_version = newAV();
617
618 if (nxt_slow_path(array_version == NULL)) {
619 goto fail;
620 }
621
622 av_push(array_version, newSViv(1));
623 av_push(array_version, newSViv(1));
624
625 RC(nxt_perl_psgi_env_append_str(my_perl, hash_env, "PATH_INFO",
626 &path));
627 RC(nxt_perl_psgi_env_append(my_perl, hash_env, "SCRIPT_NAME",
628 newSVpv("", 0)));
629 RC(nxt_perl_psgi_env_append(my_perl, hash_env, "psgi.run_once",
630 newSVpv("", 0)));
631 RC(nxt_perl_psgi_env_append(my_perl, hash_env, "psgi.streaming",
632 newSViv(0)));
633 RC(nxt_perl_psgi_env_append(my_perl, hash_env, "psgi.nonblocking",
634 newSVpv("", 0)));
635 RC(nxt_perl_psgi_env_append(my_perl, hash_env, "psgi.multithread",
636 newSVpv("", 0)));
637 RC(nxt_perl_psgi_env_append(my_perl, hash_env, "psgi.multiprocess",
638 newSVpv("", 0)));
639 RC(nxt_perl_psgi_env_append(my_perl, hash_env, "psgi.url_scheme",
640 newSVpv("http", 4)));
641 RC(nxt_perl_psgi_env_append(my_perl, hash_env, "psgi.input",
642 SvREFCNT_inc(nxt_perl_psgi_arg_input.io)));
643 RC(nxt_perl_psgi_env_append(my_perl, hash_env, "psgi.errors",
644 SvREFCNT_inc(nxt_perl_psgi_arg_error.io)));
645 RC(nxt_perl_psgi_env_append(my_perl, hash_env, "psgi.version",
646 newRV_noinc((SV *) array_version)));
647
648 if (query_size > 0) {
649 query_size--;
650
651 if (nxt_slow_path(target.length < query_size)) {
652 goto fail;
653 }
654
655 str.start = &target.start[query_size];
656 str.length = target.length - query_size;
657
658 RC(nxt_perl_psgi_env_append_str(my_perl, hash_env,
659 "QUERY_STRING", &str));
660 }
661
662 GET_STR("SERVER_PROTOCOL");
663 GET_STR("REMOTE_ADDR");
664 GET_STR("SERVER_ADDR");
665
666 RC(nxt_app_msg_read_str(task, rmsg, &host));
667
668 if (host.length == 0) {
669 host = def_host;
670 }
671
672 colon = nxt_memchr(host.start, ':', host.length);
673 server_name = host;
674
675 if (colon != NULL) {
676 server_name.length = colon - host.start;
677
678 server_port.start = colon + 1;
679 server_port.length = host.length - server_name.length - 1;
680
681 } else {
682 server_port = def_port;
683 }
684
685 RC(nxt_perl_psgi_env_append_str(my_perl, hash_env,
686 "SERVER_NAME", &server_name));
687 RC(nxt_perl_psgi_env_append_str(my_perl, hash_env,
688 "SERVER_PORT", &server_port));
689
690 GET_STR("CONTENT_TYPE");
691 GET_STR("CONTENT_LENGTH");
692
693 for ( ;; ) {
694 rc = nxt_app_msg_read_str(task, rmsg, &str);
695
696 if (nxt_slow_path(rc != NXT_OK)) {
697 goto fail;
698 }
699
700 if (nxt_slow_path(str.length == 0)) {
701 break;
702 }
703
704 rc = nxt_app_msg_read_str(task, rmsg, &value);
705
706 if (nxt_slow_path(rc != NXT_OK)) {
707 break;
708 }
709
710 RC(nxt_perl_psgi_env_append_str(my_perl, hash_env,
711 (char *) str.start, &value));
712 }
713
714 RC(nxt_app_msg_read_size(task, rmsg, body_preread_size));
715
716#undef GET_STR
717#undef RC
718
719 return newRV_noinc((SV *) hash_env);
720
721fail:
722
723 SvREFCNT_dec(hash_env);
724
725 return NULL;
726}
727
728
729static nxt_str_t
730nxt_perl_psgi_result_status(PerlInterpreter *my_perl, SV *result)
731{
732 SV **sv_status;
733 AV *array;
734 nxt_str_t status;
735
736 array = (AV *) SvRV(result);
737 sv_status = av_fetch(array, 0, 0);
738
739 status.start = (u_char *) SvPV(*sv_status, status.length);
740
741 return status;
742}
743
744
745static nxt_int_t
746nxt_perl_psgi_result_head(PerlInterpreter *my_perl, SV *sv_head,
747 nxt_task_t *task, nxt_app_wmsg_t *wmsg)
748{
749 AV *array_head;
750 SV **entry;
751 long i, array_len;
752 nxt_int_t rc;
753 nxt_str_t body;
754
755 if (nxt_slow_path(SvROK(sv_head) == 0
756 || SvTYPE(SvRV(sv_head)) != SVt_PVAV))
757 {
758 nxt_log_error(NXT_LOG_ERR, task->log,
759 "PSGI: An unsupported format was received from "
760 "Perl Application for head part");
761
762 return NXT_ERROR;
763 }
764
765 array_head = (AV *) SvRV(sv_head);
766 array_len = av_len(array_head);
767
768 if (array_len < 1) {
769 return NXT_OK;
770 }
771
772 if (nxt_slow_path((array_len % 2) == 0)) {
773 nxt_log_error(NXT_LOG_ERR, task->log,
774 "PSGI: Bad format for head from "
775 "Perl Application");
776
777 return NXT_ERROR;
778 }
779
780 for (i = 0; i <= array_len; i++) {
781 entry = av_fetch(array_head, i, 0);
782
783 if (nxt_fast_path(entry == NULL)) {
784 nxt_log_error(NXT_LOG_ERR, task->log,
785 "PSGI: Failed to get head entry from "
786 "Perl Application");
787
788 return NXT_ERROR;
789 }
790
791 body.start = (u_char *) SvPV(*entry, body.length);
792
793 rc = nxt_app_msg_write_raw(task, wmsg,
794 (u_char *) body.start, body.length);
795
796 if (nxt_slow_path(rc != NXT_OK)) {
797 nxt_log_error(NXT_LOG_ERR, task->log,
798 "PSGI: Failed to write head "
799 "from Perl Application");
800 return rc;
801 }
802
803 if ((i % 2) == 0) {
804 rc = nxt_app_msg_write_raw(task, wmsg,
805 (u_char *) ": ",
806 (sizeof(": ") - 1));
807 } else {
808 rc = nxt_app_msg_write_raw(task, wmsg,
809 (u_char *) "\r\n",
810 (sizeof("\r\n") - 1));
811 }
812
813 if (nxt_slow_path(rc != NXT_OK)) {
814 nxt_log_error(NXT_LOG_ERR, task->log,
815 "PSGI: Failed to write head from "
816 "Perl Application");
817 return rc;
818 }
819 }
820
821 return NXT_OK;
822}
823
824
825static nxt_int_t
826nxt_perl_psgi_result_body(PerlInterpreter *my_perl, SV *sv_body,
827 nxt_task_t *task, nxt_app_wmsg_t *wmsg)
828{
829 SV **entry;
830 AV *body_array;
831 long i;
832 nxt_int_t rc;
833 nxt_str_t body;
834
835 if (nxt_slow_path(SvROK(sv_body) == 0
836 || SvTYPE(SvRV(sv_body)) != SVt_PVAV))
837 {
838 nxt_log_error(NXT_LOG_ERR, task->log,
839 "PSGI: An unsupported format was received from "
840 "Perl Application for a body part");
841
842 return NXT_ERROR;
843 }
844
845 body_array = (AV *) SvRV(sv_body);
846
847 for (i = 0; i <= av_len(body_array); i++) {
848
849 entry = av_fetch(body_array, i, 0);
850
851 if (nxt_fast_path(entry == NULL)) {
852 nxt_log_error(NXT_LOG_ERR, task->log,
853 "PSGI: Failed to get body entry from "
854 "Perl Application");
855 return NXT_ERROR;
856 }
857
858 body.start = (u_char *) SvPV(*entry, body.length);
859
860 if (body.length == 0) {
861 continue;
862 }
863
864 rc = nxt_app_msg_write_raw(task, wmsg,
865 (u_char *) body.start, body.length);
866
867 if (nxt_slow_path(rc != NXT_OK)) {
868 nxt_log_error(NXT_LOG_ERR, task->log,
869 "PSGI: Failed to write 'body' from "
870 "Perl Application");
871 return rc;
872 }
873
874 rc = nxt_app_msg_flush(task, wmsg, 0);
875
876 if (nxt_slow_path(rc != NXT_OK)) {
877 nxt_log_error(NXT_LOG_ERR, task->log,
878 "PSGI: Failed to flush data for a 'body' "
879 "part from Perl Application");
880 return rc;
881 }
882 }
883
884 return NXT_OK;
885}
886
887
888static nxt_int_t
889nxt_perl_psgi_result_body_ref(PerlInterpreter *my_perl, SV *sv_body,
890 nxt_task_t *task, nxt_app_wmsg_t *wmsg)
891{
892 IO *io;
893 PerlIO *fp;
894 SSize_t n;
895 nxt_int_t rc;
896 u_char vbuf[8192];
897
898 io = GvIO(SvRV(sv_body));
899
900 if (io == NULL) {
901 return NXT_OK;
902 }
903
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, (u_char *) "\r\n",
975 (sizeof("\r\n") - 1));
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, (u_char *) "\r\n",
1003 (sizeof("\r\n") - 1));
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
904 fp = IoIFP(io);
905
906 for ( ;; ) {
907 n = PerlIO_read(fp, vbuf, 8192);
908
909 if (n < 1) {
910 break;
911 }
912
913 rc = nxt_app_msg_write_raw(task, wmsg,
914 (u_char *) vbuf, (size_t) n);
915
916 if (nxt_slow_path(rc != NXT_OK)) {
917 nxt_log_error(NXT_LOG_ERR, task->log,
918 "PSGI: Failed to write 'body' from "
919 "Perl Application");
920
921 return rc;
922 }
923
924 rc = nxt_app_msg_flush(task, wmsg, 0);
925
926 if (nxt_slow_path(rc != NXT_OK)) {
927 nxt_log_error(NXT_LOG_ERR, task->log,
928 "PSGI: Failed to flush data for a body "
929 "part from Perl Application");
930
931 return rc;
932 }
933 }
934
935 return NXT_OK;
936}
937
938
939static nxt_int_t
940nxt_perl_psgi_result_array(PerlInterpreter *my_perl, SV *result,
941 nxt_task_t *task, nxt_app_wmsg_t *wmsg)
942{
943 AV *array;
944 SV **sv_temp;
945 long array_len;
946 nxt_int_t rc;
947 nxt_str_t http_status;
948
949 array = (AV *) SvRV(result);
950 array_len = av_len(array);
951
952 if (nxt_slow_path(array_len < 0)) {
953 nxt_log_error(NXT_LOG_ERR, task->log,
954 "PSGI: Invalid result format from Perl Application");
955
956 return NXT_ERROR;
957 }
958
959 http_status = nxt_perl_psgi_result_status(nxt_perl_psgi, result);
960
961 if (nxt_slow_path(http_status.start == NULL || http_status.length == 0)) {
962 nxt_log_error(NXT_LOG_ERR, task->log,
963 "PSGI: An unexpected status was received "
964 "from Perl Application");
965
966 return NXT_ERROR;
967 }
968
969 rc = nxt_perl_psgi_http_write_status_str(task, wmsg, &http_status);
970
971 if (nxt_slow_path(rc != NXT_OK)) {
972 nxt_log_error(NXT_LOG_ERR, task->log,
973 "PSGI: Failed to write HTTP Status");
974
975 return rc;
976 }
977
978 if (array_len < 1) {
979 rc = nxt_app_msg_write_raw(task, wmsg, (u_char *) "\r\n",
980 (sizeof("\r\n") - 1));
981
982 if (nxt_slow_path(rc != NXT_OK)) {
983 nxt_log_error(NXT_LOG_ERR, task->log,
984 "PSGI: Failed to write HTTP Headers");
985
986 return rc;
987 }
988
989 return NXT_OK;
990 }
991
992 sv_temp = av_fetch(array, 1, 0);
993
994 if (nxt_slow_path(sv_temp == NULL)) {
995 nxt_log_error(NXT_LOG_ERR, task->log,
996 "PSGI: Failed to get head from Perl ARRAY variable");
997
998 return NXT_ERROR;
999 }
1000
1001 rc = nxt_perl_psgi_result_head(nxt_perl_psgi, *sv_temp, task, wmsg);
1002
1003 if (nxt_slow_path(rc != NXT_OK)) {
1004 return rc;
1005 }
1006
1007 rc = nxt_app_msg_write_raw(task, wmsg, (u_char *) "\r\n",
1008 (sizeof("\r\n") - 1));
1009
1010 if (nxt_slow_path(rc != NXT_OK)) {
1011 nxt_log_error(NXT_LOG_ERR, task->log,
1012 "PSGI: Failed to write HTTP Headers");
1013
1014 return rc;
1015 }
1016
1017 if (nxt_fast_path(array_len < 2)) {
1018 return NXT_OK;
1019 }
1020
1021 sv_temp = av_fetch(array, 2, 0);
1022
1018 if (nxt_slow_path(sv_temp == NULL)) {
1023 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}
1024 nxt_log_error(NXT_LOG_ERR, task->log,
1025 "PSGI: Failed to get body from Perl ARRAY variable");
1026
1027 return NXT_ERROR;
1028 }
1029
1030 if (SvTYPE(SvRV(*sv_temp)) == SVt_PVAV) {
1031 rc = nxt_perl_psgi_result_body(nxt_perl_psgi, *sv_temp, task, wmsg);
1032
1033 } else {
1034 rc = nxt_perl_psgi_result_body_ref(nxt_perl_psgi, *sv_temp,
1035 task, wmsg);
1036 }
1037
1038 if (nxt_slow_path(rc != NXT_OK)) {
1039 return rc;
1040 }
1041
1042 return NXT_OK;
1043}
1044
1045
1046static nxt_int_t
1047nxt_perl_psgi_init(nxt_task_t *task, nxt_common_app_conf_t *conf)
1048{
1049 PerlInterpreter *my_perl;
1050
1051 my_perl = nxt_perl_psgi_interpreter_init(task, conf->u.perl.script);
1052
1053 if (nxt_slow_path(my_perl == NULL)) {
1054 return NXT_ERROR;
1055 }
1056
1057 nxt_perl_psgi = my_perl;
1058
1059 return NXT_OK;
1060}
1061
1062
1063static nxt_int_t
1064nxt_perl_psgi_run(nxt_task_t *task, nxt_app_rmsg_t *rmsg, nxt_app_wmsg_t *wmsg)
1065{
1066 SV *env, *result;
1067 size_t body_preread_size;
1068 nxt_int_t rc;
1069 nxt_perl_psgi_input_t input;
1070
1071 dTHXa(nxt_perl_psgi);
1072
1073 /*
1074 * Create environ variable for perl sub "application".
1075 * > sub application {
1076 * > my ($environ) = @_;
1077 */
1078 env = nxt_perl_psgi_env_create(nxt_perl_psgi, task, rmsg,
1079 &body_preread_size);
1080
1081 if (nxt_slow_path(env == NULL)) {
1082 nxt_log_error(NXT_LOG_ERR, task->log,
1083 "PSGI: Failed to create 'env' for Perl Application");
1084
1085 return NXT_ERROR;
1086 }
1087
1088 input.my_perl = nxt_perl_psgi;
1089 input.task = task;
1090 input.rmsg = rmsg;
1091 input.wmsg = wmsg;
1092 input.body_preread_size = body_preread_size;
1093
1094 nxt_perl_psgi_arg_input.ctx = &input;
1095 nxt_perl_psgi_arg_error.ctx = &input;
1096
1097 /* Call perl sub and get result as SV*. */
1098 result = nxt_perl_psgi_call_var_application(nxt_perl_psgi, env, task);
1099
1100 /*
1101 * We expect ARRAY ref like a
1102 * ['200', ['Content-Type' => "text/plain"], ["body"]]
1103 */
1104 if (nxt_slow_path(SvOK(result) == 0 || SvROK(result) == 0
1105 || SvTYPE(SvRV(result)) != SVt_PVAV))
1106 {
1107 nxt_log_error(NXT_LOG_ERR, task->log,
1108 "PSGI: An unexpected response was received from "
1109 "Perl Application");
1110 goto fail;
1111 }
1112
1113 rc = nxt_perl_psgi_result_array(nxt_perl_psgi, result, task, wmsg);
1114
1115 if (nxt_slow_path(rc != NXT_OK)) {
1116 goto fail;
1117 }
1118
1119 rc = nxt_app_msg_flush(task, wmsg, 1);
1120
1121 if (nxt_slow_path(rc != NXT_OK)) {
1122 goto fail;
1123 }
1124
1125 SvREFCNT_dec(result);
1126 SvREFCNT_dec(env);
1127
1128 return NXT_OK;
1129
1130fail:
1131
1132 SvREFCNT_dec(result);
1133 SvREFCNT_dec(env);
1134
1135 return NXT_ERROR;
1136}
1137
1138
1139static void
1140nxt_perl_psgi_atexit(nxt_task_t *task)
1141{
1142 dTHXa(nxt_perl_psgi);
1143
1144 nxt_perl_psgi_layer_stream_io_destroy(aTHX_ nxt_perl_psgi_arg_input.io);
1145 nxt_perl_psgi_layer_stream_fp_destroy(aTHX_ nxt_perl_psgi_arg_input.fp);
1146
1147 nxt_perl_psgi_layer_stream_io_destroy(aTHX_ nxt_perl_psgi_arg_error.io);
1148 nxt_perl_psgi_layer_stream_fp_destroy(aTHX_ nxt_perl_psgi_arg_error.fp);
1149
1150 perl_destruct(nxt_perl_psgi);
1151 perl_free(nxt_perl_psgi);
1152 PERL_SYS_TERM();
1153}