xref: /unit/src/perl/nxt_perl_psgi.c (revision 1980:43553aa72111)
1 
2 /*
3  * Copyright (C) Alexander Borisov
4  * Copyright (C) NGINX, Inc.
5  */
6 
7 #include <perl/nxt_perl_psgi_layer.h>
8 
9 #include <nxt_main.h>
10 #include <nxt_router.h>
11 #include <nxt_runtime.h>
12 #include <nxt_application.h>
13 #include <nxt_file.h>
14 #include <nxt_unit.h>
15 #include <nxt_unit_request.h>
16 #include <nxt_unit_response.h>
17 
18 
19 typedef struct {
20     PerlInterpreter          *my_perl;
21     nxt_perl_psgi_io_arg_t   arg_input;
22     nxt_perl_psgi_io_arg_t   arg_error;
23     SV                       *app;
24     CV                       *cb;
25     nxt_unit_request_info_t  *req;
26     pthread_t                thread;
27     nxt_unit_ctx_t           *ctx;
28 } nxt_perl_psgi_ctx_t;
29 
30 
31 static long nxt_perl_psgi_io_input_read(PerlInterpreter *my_perl,
32     nxt_perl_psgi_io_arg_t *arg, void *vbuf, size_t length);
33 static long nxt_perl_psgi_io_input_write(PerlInterpreter *my_perl,
34     nxt_perl_psgi_io_arg_t *arg, const void *vbuf, size_t length);
35 static long nxt_perl_psgi_io_input_flush(PerlInterpreter *my_perl,
36     nxt_perl_psgi_io_arg_t *arg);
37 
38 static long nxt_perl_psgi_io_error_read(PerlInterpreter *my_perl,
39     nxt_perl_psgi_io_arg_t *arg, void *vbuf, size_t length);
40 static long nxt_perl_psgi_io_error_write(PerlInterpreter *my_perl,
41     nxt_perl_psgi_io_arg_t *arg, const void *vbuf, size_t length);
42 static long nxt_perl_psgi_io_error_flush(PerlInterpreter *my_perl,
43     nxt_perl_psgi_io_arg_t *arg);
44 
45 /*
46 static void nxt_perl_psgi_xs_core_global_changes(PerlInterpreter *my_perl,
47     const char *core, const char *sub, XSUBADDR_t sub_addr);
48 */
49 
50 static void nxt_perl_psgi_xs_init(pTHX);
51 
52 static SV *nxt_perl_psgi_call_var_application(PerlInterpreter *my_perl,
53     SV *env, SV *app, nxt_unit_request_info_t *req);
54 static SV *nxt_perl_psgi_call_method(PerlInterpreter *my_perl, SV *obj,
55     const char *method, nxt_unit_request_info_t *req);
56 
57 /* For currect load XS modules */
58 EXTERN_C void boot_DynaLoader(pTHX_ CV *cv);
59 
60 static nxt_int_t nxt_perl_psgi_io_input_init(PerlInterpreter *my_perl,
61     nxt_perl_psgi_io_arg_t *arg);
62 static nxt_int_t nxt_perl_psgi_io_error_init(PerlInterpreter *my_perl,
63     nxt_perl_psgi_io_arg_t *arg);
64 
65 static int nxt_perl_psgi_ctx_init(const char *script,
66     nxt_perl_psgi_ctx_t *pctx);
67 
68 static SV *nxt_perl_psgi_env_create(PerlInterpreter *my_perl,
69     nxt_unit_request_info_t *req);
70 nxt_inline int nxt_perl_psgi_add_sptr(PerlInterpreter *my_perl, HV *hash_env,
71     const char *name, uint32_t name_len, nxt_unit_sptr_t *sptr, uint32_t len);
72 nxt_inline int nxt_perl_psgi_add_str(PerlInterpreter *my_perl, HV *hash_env,
73     const char *name, uint32_t name_len, const char *str, uint32_t len);
74 nxt_inline int nxt_perl_psgi_add_value(PerlInterpreter *my_perl, HV *hash_env,
75     const char *name, uint32_t name_len, void *value);
76 
77 
78 static char *nxt_perl_psgi_module_create(const char *script);
79 
80 static nxt_int_t nxt_perl_psgi_result_status(PerlInterpreter *my_perl,
81     SV *result);
82 static int nxt_perl_psgi_result_head(PerlInterpreter *my_perl,
83     SV *sv_head, nxt_unit_request_info_t *req, uint16_t status);
84 static int nxt_perl_psgi_result_body(PerlInterpreter *my_perl,
85     SV *result, nxt_unit_request_info_t *req);
86 static int nxt_perl_psgi_result_body_ref(PerlInterpreter *my_perl,
87     SV *sv_body, nxt_unit_request_info_t *req);
88 static int nxt_perl_psgi_result_body_fh(PerlInterpreter *my_perl, SV *sv_body,
89     nxt_unit_request_info_t *req);
90 static ssize_t nxt_perl_psgi_io_read(nxt_unit_read_info_t *read_info, void *dst,
91     size_t size);
92 static int nxt_perl_psgi_result_array(PerlInterpreter *my_perl,
93     SV *result, nxt_unit_request_info_t *req);
94 static void nxt_perl_psgi_result_cb(PerlInterpreter *my_perl, SV *result,
95     nxt_unit_request_info_t *req);
96 
97 static nxt_int_t nxt_perl_psgi_start(nxt_task_t *task,
98     nxt_process_data_t *data);
99 static void nxt_perl_psgi_request_handler(nxt_unit_request_info_t *req);
100 static int nxt_perl_psgi_ready_handler(nxt_unit_ctx_t *ctx);
101 static void *nxt_perl_psgi_thread_func(void *main_ctx);
102 static int nxt_perl_psgi_init_threads(nxt_perl_app_conf_t *c);
103 static void nxt_perl_psgi_join_threads(nxt_unit_ctx_t *ctx,
104     nxt_perl_app_conf_t *c);
105 static void nxt_perl_psgi_ctx_free(nxt_perl_psgi_ctx_t *pctx);
106 
107 static CV                   *nxt_perl_psgi_write;
108 static CV                   *nxt_perl_psgi_close;
109 static CV                   *nxt_perl_psgi_cb;
110 static pthread_attr_t       *nxt_perl_psgi_thread_attr;
111 static nxt_perl_psgi_ctx_t  *nxt_perl_psgi_ctxs;
112 
113 static uint32_t  nxt_perl_psgi_compat[] = {
114     NXT_VERNUM, NXT_DEBUG,
115 };
116 
117 NXT_EXPORT nxt_app_module_t  nxt_app_module = {
118     sizeof(nxt_perl_psgi_compat),
119     nxt_perl_psgi_compat,
120     nxt_string("perl"),
121     PERL_VERSION_STRING,
122     NULL,
123     0,
124     NULL,
125     nxt_perl_psgi_start,
126 };
127 
128 
129 static long
130 nxt_perl_psgi_io_input_read(PerlInterpreter *my_perl,
131     nxt_perl_psgi_io_arg_t *arg, void *vbuf, size_t length)
132 {
133     nxt_perl_psgi_ctx_t  *pctx;
134 
135     pctx = arg->pctx;
136 
137     return nxt_unit_request_read(pctx->req, vbuf, length);
138 }
139 
140 
141 static long
142 nxt_perl_psgi_io_input_write(PerlInterpreter *my_perl,
143     nxt_perl_psgi_io_arg_t *arg, const void *vbuf, size_t length)
144 {
145     return 0;
146 }
147 
148 
149 static long
150 nxt_perl_psgi_io_input_flush(PerlInterpreter *my_perl,
151     nxt_perl_psgi_io_arg_t *arg)
152 {
153     return 0;
154 }
155 
156 
157 static long
158 nxt_perl_psgi_io_error_read(PerlInterpreter *my_perl,
159     nxt_perl_psgi_io_arg_t *arg, void *vbuf, size_t length)
160 {
161     return 0;
162 }
163 
164 
165 static long
166 nxt_perl_psgi_io_error_write(PerlInterpreter *my_perl,
167     nxt_perl_psgi_io_arg_t *arg, const void *vbuf, size_t length)
168 {
169     nxt_perl_psgi_ctx_t  *pctx;
170 
171     pctx = arg->pctx;
172 
173     nxt_unit_req_error(pctx->req, "Perl: %s", (const char*) vbuf);
174 
175     return (long) length;
176 }
177 
178 
179 static long
180 nxt_perl_psgi_io_error_flush(PerlInterpreter *my_perl,
181     nxt_perl_psgi_io_arg_t *arg)
182 {
183     return 0;
184 }
185 
186 
187 /* In the future it will be necessary to change some Perl functions. */
188 /*
189 static void
190 nxt_perl_psgi_xs_core_global_changes(PerlInterpreter *my_perl,
191     const char *core, const char *sub, XSUBADDR_t sub_addr)
192 {
193     GV  *gv;
194 
195     gv = gv_fetchpv(core, TRUE, SVt_PVCV);
196 
197 #ifdef MUTABLE_CV
198     GvCV_set(gv, MUTABLE_CV(SvREFCNT_inc(get_cv(sub, TRUE))));
199 #else
200     GvCV_set(gv, (CV *) (SvREFCNT_inc(get_cv(sub, TRUE))));
201 #endif
202     GvIMPORTED_CV_on(gv);
203 
204     newXS(sub, sub_addr, __FILE__);
205 }
206 */
207 
208 
209 XS(XS_NGINX__Unit__PSGI_exit);
210 XS(XS_NGINX__Unit__PSGI_exit)
211 {
212     I32 ax = POPMARK;
213     Perl_croak(aTHX_ (char *) NULL);
214     XSRETURN_EMPTY;
215 }
216 
217 
218 XS(XS_NGINX__Unit__Sandbox_write);
219 XS(XS_NGINX__Unit__Sandbox_write)
220 {
221     int                  rc;
222     char                 *body;
223     size_t               len;
224     nxt_perl_psgi_ctx_t  *pctx;
225 
226     dXSARGS;
227 
228     if (nxt_slow_path(items != 2)) {
229         Perl_croak(aTHX_ "Wrong number of arguments. Need one string");
230 
231         XSRETURN_EMPTY;
232     }
233 
234     body = SvPV(ST(1), len);
235 
236     pctx = CvXSUBANY(cv).any_ptr;
237 
238     rc = nxt_unit_response_write(pctx->req, body, len);
239     if (nxt_slow_path(rc != NXT_UNIT_OK)) {
240         Perl_croak(aTHX_ "Failed to write response body");
241 
242         XSRETURN_EMPTY;
243     }
244 
245     XSRETURN_IV(len);
246 }
247 
248 
249 nxt_inline void
250 nxt_perl_psgi_cb_request_done(nxt_perl_psgi_ctx_t *pctx, int status)
251 {
252     if (pctx->req != NULL) {
253         nxt_unit_request_done(pctx->req, status);
254         pctx->req = NULL;
255     }
256 }
257 
258 
259 XS(XS_NGINX__Unit__Sandbox_close);
260 XS(XS_NGINX__Unit__Sandbox_close)
261 {
262     I32  ax;
263 
264     ax = POPMARK;
265 
266     nxt_perl_psgi_cb_request_done(CvXSUBANY(cv).any_ptr, NXT_UNIT_OK);
267 
268     XSRETURN_NO;
269 }
270 
271 
272 XS(XS_NGINX__Unit__Sandbox_cb);
273 XS(XS_NGINX__Unit__Sandbox_cb)
274 {
275     SV                   *obj;
276     int                  rc;
277     long                 array_len;
278     nxt_perl_psgi_ctx_t  *pctx;
279 
280     dXSARGS;
281 
282     if (nxt_slow_path(items != 1)) {
283         nxt_perl_psgi_cb_request_done(CvXSUBANY(cv).any_ptr, NXT_UNIT_ERROR);
284 
285         Perl_croak(aTHX_ "Wrong number of arguments");
286 
287         XSRETURN_EMPTY;
288     }
289 
290     if (nxt_slow_path(SvOK(ST(0)) == 0 || SvROK(ST(0)) == 0
291                       || SvTYPE(SvRV(ST(0))) != SVt_PVAV))
292     {
293         nxt_perl_psgi_cb_request_done(CvXSUBANY(cv).any_ptr, NXT_UNIT_ERROR);
294 
295         Perl_croak(aTHX_ "PSGI: An unexpected response was received "
296                    "from Perl Application");
297 
298         XSRETURN_EMPTY;
299     }
300 
301     pctx = CvXSUBANY(cv).any_ptr;
302 
303     rc = nxt_perl_psgi_result_array(PERL_GET_CONTEXT, ST(0), pctx->req);
304     if (nxt_slow_path(rc != NXT_UNIT_OK)) {
305         nxt_perl_psgi_cb_request_done(CvXSUBANY(cv).any_ptr, NXT_UNIT_ERROR);
306 
307         Perl_croak(aTHX_ (char *) NULL);
308 
309         XSRETURN_EMPTY;
310     }
311 
312     array_len = av_len((AV *) SvRV(ST(0)));
313 
314     if (array_len < 2) {
315         obj = sv_bless(newRV_noinc((SV *) newHV()),
316                        gv_stashpv("NGINX::Unit::Sandbox", GV_ADD));
317         ST(0) = obj;
318 
319         XSRETURN(1);
320     }
321 
322     nxt_perl_psgi_cb_request_done(CvXSUBANY(cv).any_ptr, NXT_UNIT_OK);
323 
324     XSRETURN_EMPTY;
325 }
326 
327 
328 static void
329 nxt_perl_psgi_xs_init(pTHX)
330 {
331 /*
332     nxt_perl_psgi_xs_core_global_changes(my_perl, "CORE::GLOBAL::exit",
333                                          "NGINX::Unit::PSGI::exit",
334                                          XS_NGINX__Unit__PSGI_exit);
335 */
336     nxt_perl_psgi_layer_stream_init(aTHX);
337 
338     /* DynaLoader for Perl modules who use XS */
339     newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, __FILE__);
340 
341     nxt_perl_psgi_write = newXS("NGINX::Unit::Sandbox::write",
342                                 XS_NGINX__Unit__Sandbox_write, __FILE__);
343 
344     nxt_perl_psgi_close = newXS("NGINX::Unit::Sandbox::close",
345                                 XS_NGINX__Unit__Sandbox_close, __FILE__);
346 
347     nxt_perl_psgi_cb = newXS("NGINX::Unit::Sandbox::cb",
348                              XS_NGINX__Unit__Sandbox_cb, __FILE__);
349 }
350 
351 
352 static SV *
353 nxt_perl_psgi_call_var_application(PerlInterpreter *my_perl,
354     SV *env, SV *app, nxt_unit_request_info_t *req)
355 {
356     SV  *result;
357 
358     dSP;
359 
360     ENTER;
361     SAVETMPS;
362 
363     PUSHMARK(sp);
364     XPUSHs(env);
365     PUTBACK;
366 
367     call_sv(app, G_EVAL|G_SCALAR);
368 
369     SPAGAIN;
370 
371     if (SvTRUE(ERRSV)) {
372         nxt_unit_req_error(req, "PSGI: Failed to run Perl Application: \n%s",
373                            SvPV_nolen(ERRSV));
374     }
375 
376     result = POPs;
377     SvREFCNT_inc(result);
378 
379     PUTBACK;
380     FREETMPS;
381     LEAVE;
382 
383     return result;
384 }
385 
386 
387 static SV *
388 nxt_perl_psgi_call_method(PerlInterpreter *my_perl, SV *obj, const char *method,
389     nxt_unit_request_info_t *req)
390 {
391     SV  *result;
392 
393     dSP;
394 
395     ENTER;
396     SAVETMPS;
397 
398     PUSHMARK(sp);
399     XPUSHs(obj);
400     PUTBACK;
401 
402     call_method(method, G_EVAL|G_SCALAR);
403 
404     SPAGAIN;
405 
406     if (SvTRUE(ERRSV)) {
407         nxt_unit_req_error(req, "PSGI: Failed to call method '%s':\n%s",
408                            method, SvPV_nolen(ERRSV));
409         result = NULL;
410 
411     } else {
412         result = SvREFCNT_inc(POPs);
413     }
414 
415     PUTBACK;
416     FREETMPS;
417     LEAVE;
418 
419     return result;
420 }
421 
422 
423 static char *
424 nxt_perl_psgi_module_create(const char *script)
425 {
426     char    *buf, *p;
427     size_t  length;
428 
429     static nxt_str_t  prefix = nxt_string(
430         "package NGINX::Unit::Sandbox;"
431         "sub new {"
432         "   return bless {}, $_[0];"
433         "}"
434         "{my $app = do \""
435     );
436 
437     static nxt_str_t  suffix = nxt_string_zero(
438         "\";"
439         "unless ($app) {"
440         "    if($@ || $1) {die $@ || $1}"
441         "    else {die \"File not found or compilation error.\"}"
442         "} "
443         "return $app}"
444     );
445 
446     length = strlen(script);
447 
448     buf = nxt_unit_malloc(NULL, prefix.length + length + suffix.length);
449     if (nxt_slow_path(buf == NULL)) {
450         nxt_unit_alert(NULL, "PSGI: Failed to allocate memory "
451                        "for Perl script file %s", script);
452 
453         return NULL;
454     }
455 
456     p = nxt_cpymem(buf, prefix.start, prefix.length);
457     p = nxt_cpymem(p, script, length);
458     nxt_memcpy(p, suffix.start, suffix.length);
459 
460     return buf;
461 }
462 
463 
464 static nxt_int_t
465 nxt_perl_psgi_io_input_init(PerlInterpreter *my_perl,
466     nxt_perl_psgi_io_arg_t *arg)
467 {
468     SV      *io;
469     PerlIO  *fp;
470 
471     fp = nxt_perl_psgi_layer_stream_fp_create(aTHX_ arg, "r");
472 
473     if (nxt_slow_path(fp == NULL)) {
474         return NXT_ERROR;
475     }
476 
477     io = nxt_perl_psgi_layer_stream_io_create(aTHX_ fp);
478 
479     if (nxt_slow_path(io == NULL)) {
480         nxt_perl_psgi_layer_stream_fp_destroy(aTHX_ fp);
481         return NXT_ERROR;
482     }
483 
484     arg->io = io;
485     arg->fp = fp;
486     arg->flush = nxt_perl_psgi_io_input_flush;
487     arg->read = nxt_perl_psgi_io_input_read;
488     arg->write = nxt_perl_psgi_io_input_write;
489 
490     return NXT_OK;
491 }
492 
493 
494 static nxt_int_t
495 nxt_perl_psgi_io_error_init(PerlInterpreter *my_perl,
496     nxt_perl_psgi_io_arg_t *arg)
497 {
498     SV      *io;
499     PerlIO  *fp;
500 
501     fp = nxt_perl_psgi_layer_stream_fp_create(aTHX_ arg, "w");
502 
503     if (nxt_slow_path(fp == NULL)) {
504         return NXT_ERROR;
505     }
506 
507     io = nxt_perl_psgi_layer_stream_io_create(aTHX_ fp);
508 
509     if (nxt_slow_path(io == NULL)) {
510         nxt_perl_psgi_layer_stream_fp_destroy(aTHX_ fp);
511         return NXT_ERROR;
512     }
513 
514     arg->io = io;
515     arg->fp = fp;
516     arg->flush = nxt_perl_psgi_io_error_flush;
517     arg->read = nxt_perl_psgi_io_error_read;
518     arg->write = nxt_perl_psgi_io_error_write;
519 
520     return NXT_OK;
521 }
522 
523 
524 static int
525 nxt_perl_psgi_ctx_init(const char *script, nxt_perl_psgi_ctx_t *pctx)
526 {
527     int              status;
528     char             *run_module;
529     PerlInterpreter  *my_perl;
530 
531     static char  argv[] = "\0""-e\0""0";
532     static char  *embedding[] = { &argv[0], &argv[1], &argv[4] };
533 
534     my_perl = perl_alloc();
535 
536     if (nxt_slow_path(my_perl == NULL)) {
537         nxt_unit_alert(NULL,
538                        "PSGI: Failed to allocate memory for Perl interpreter");
539 
540         return NXT_UNIT_ERROR;
541     }
542 
543     pctx->my_perl = my_perl;
544 
545     run_module = NULL;
546 
547     perl_construct(my_perl);
548     PERL_SET_CONTEXT(my_perl);
549 
550     status = perl_parse(my_perl, nxt_perl_psgi_xs_init, 3, embedding, NULL);
551 
552     if (nxt_slow_path(status != 0)) {
553         nxt_unit_alert(NULL, "PSGI: Failed to parse Perl Script");
554         goto fail;
555     }
556 
557     CvXSUBANY(nxt_perl_psgi_write).any_ptr = pctx;
558     CvXSUBANY(nxt_perl_psgi_close).any_ptr = pctx;
559     CvXSUBANY(nxt_perl_psgi_cb).any_ptr = pctx;
560 
561     pctx->cb = nxt_perl_psgi_cb;
562 
563     PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
564     PL_origalen = 1;
565 
566     status = perl_run(my_perl);
567 
568     if (nxt_slow_path(status != 0)) {
569         nxt_unit_alert(NULL, "PSGI: Failed to run Perl");
570         goto fail;
571     }
572 
573     sv_setsv(get_sv("0", 0), newSVpv(script, 0));
574 
575     run_module = nxt_perl_psgi_module_create(script);
576     if (nxt_slow_path(run_module == NULL)) {
577         goto fail;
578     }
579 
580     pctx->arg_input.pctx = pctx;
581 
582     status = nxt_perl_psgi_io_input_init(my_perl, &pctx->arg_input);
583     if (nxt_slow_path(status != NXT_OK)) {
584         nxt_unit_alert(NULL, "PSGI: Failed to init io.psgi.input");
585         goto fail;
586     }
587 
588     pctx->arg_error.pctx = pctx;
589 
590     status = nxt_perl_psgi_io_error_init(my_perl, &pctx->arg_error);
591     if (nxt_slow_path(status != NXT_OK)) {
592         nxt_unit_alert(NULL, "PSGI: Failed to init io.psgi.errors");
593         goto fail;
594     }
595 
596     pctx->app = eval_pv(run_module, FALSE);
597 
598     if (SvTRUE(ERRSV)) {
599         nxt_unit_alert(NULL, "PSGI: Failed to parse script: %s\n%s",
600                        script, SvPV_nolen(ERRSV));
601         goto fail;
602     }
603 
604     nxt_unit_free(NULL, run_module);
605 
606     return NXT_UNIT_OK;
607 
608 fail:
609 
610     if (run_module != NULL) {
611         nxt_unit_free(NULL, run_module);
612     }
613 
614     perl_destruct(my_perl);
615     perl_free(my_perl);
616 
617     return NXT_UNIT_ERROR;
618 }
619 
620 
621 static SV *
622 nxt_perl_psgi_env_create(PerlInterpreter *my_perl,
623     nxt_unit_request_info_t *req)
624 {
625     HV                   *hash_env;
626     AV                   *array_version;
627     uint32_t             i;
628     nxt_unit_field_t     *f;
629     nxt_unit_request_t   *r;
630     nxt_perl_psgi_ctx_t  *pctx;
631 
632     pctx = req->ctx->data;
633 
634     hash_env = newHV();
635     if (nxt_slow_path(hash_env == NULL)) {
636         return NULL;
637     }
638 
639 #define RC(FNS)                                                               \
640     do {                                                                      \
641         if (nxt_slow_path((FNS) != NXT_UNIT_OK))                              \
642             goto fail;                                                        \
643      } while (0)
644 
645 #define NL(S) (S), sizeof(S)-1
646 
647     r = req->request;
648 
649     RC(nxt_perl_psgi_add_str(my_perl, hash_env, NL("SERVER_SOFTWARE"),
650                              (char *) nxt_server.start, nxt_server.length));
651 
652     RC(nxt_perl_psgi_add_sptr(my_perl, hash_env, NL("REQUEST_METHOD"),
653                               &r->method, r->method_length));
654     RC(nxt_perl_psgi_add_sptr(my_perl, hash_env, NL("REQUEST_URI"),
655                               &r->target, r->target_length));
656     RC(nxt_perl_psgi_add_sptr(my_perl, hash_env, NL("PATH_INFO"),
657                               &r->path, r->path_length));
658 
659     array_version = newAV();
660 
661     if (nxt_slow_path(array_version == NULL)) {
662         goto fail;
663     }
664 
665     av_push(array_version, newSViv(1));
666     av_push(array_version, newSViv(1));
667 
668     RC(nxt_perl_psgi_add_value(my_perl, hash_env, NL("psgi.version"),
669                                 newRV_noinc((SV *) array_version)));
670 
671     RC(nxt_perl_psgi_add_value(my_perl, hash_env, NL("psgi.url_scheme"),
672                                r->tls ? newSVpv("https", 5)
673                                     : newSVpv("http", 4)));
674 
675     RC(nxt_perl_psgi_add_value(my_perl, hash_env, NL("psgi.input"),
676                                 SvREFCNT_inc(pctx->arg_input.io)));
677     RC(nxt_perl_psgi_add_value(my_perl, hash_env, NL("psgi.errors"),
678                                 SvREFCNT_inc(pctx->arg_error.io)));
679     RC(nxt_perl_psgi_add_value(my_perl, hash_env, NL("psgi.multithread"),
680                                 nxt_perl_psgi_ctxs != NULL
681                                     ? &PL_sv_yes : &PL_sv_no));
682     RC(nxt_perl_psgi_add_value(my_perl, hash_env, NL("psgi.multiprocess"),
683                                 &PL_sv_yes));
684     RC(nxt_perl_psgi_add_value(my_perl, hash_env, NL("psgi.run_once"),
685                                 &PL_sv_no));
686     RC(nxt_perl_psgi_add_value(my_perl, hash_env, NL("psgi.nonblocking"),
687                                 &PL_sv_no));
688     RC(nxt_perl_psgi_add_value(my_perl, hash_env, NL("psgi.streaming"),
689                                 &PL_sv_yes));
690 
691     RC(nxt_perl_psgi_add_sptr(my_perl, hash_env, NL("QUERY_STRING"),
692                               &r->query, r->query_length));
693     RC(nxt_perl_psgi_add_sptr(my_perl, hash_env, NL("SERVER_PROTOCOL"),
694                               &r->version, r->version_length));
695     RC(nxt_perl_psgi_add_sptr(my_perl, hash_env, NL("REMOTE_ADDR"),
696                               &r->remote, r->remote_length));
697     RC(nxt_perl_psgi_add_sptr(my_perl, hash_env, NL("SERVER_ADDR"),
698                               &r->local, r->local_length));
699 
700     RC(nxt_perl_psgi_add_sptr(my_perl, hash_env, NL("SERVER_NAME"),
701                               &r->server_name, r->server_name_length));
702     RC(nxt_perl_psgi_add_str(my_perl, hash_env, NL("SERVER_PORT"), "80", 2));
703 
704     for (i = 0; i < r->fields_count; i++) {
705         f = r->fields + i;
706 
707         RC(nxt_perl_psgi_add_sptr(my_perl, hash_env,
708                                   nxt_unit_sptr_get(&f->name), f->name_length,
709                                   &f->value, f->value_length));
710     }
711 
712     if (r->content_length_field != NXT_UNIT_NONE_FIELD) {
713         f = r->fields + r->content_length_field;
714 
715         RC(nxt_perl_psgi_add_sptr(my_perl, hash_env, NL("CONTENT_LENGTH"),
716                                   &f->value, f->value_length));
717     }
718 
719     if (r->content_type_field != NXT_UNIT_NONE_FIELD) {
720         f = r->fields + r->content_type_field;
721 
722         RC(nxt_perl_psgi_add_sptr(my_perl, hash_env, NL("CONTENT_TYPE"),
723                                   &f->value, f->value_length));
724     }
725 
726 #undef NL
727 #undef RC
728 
729     return newRV_noinc((SV *) hash_env);
730 
731 fail:
732 
733     SvREFCNT_dec(hash_env);
734 
735     return NULL;
736 }
737 
738 
739 nxt_inline int
740 nxt_perl_psgi_add_sptr(PerlInterpreter *my_perl, HV *hash_env,
741     const char *name, uint32_t name_len, nxt_unit_sptr_t *sptr, uint32_t len)
742 {
743     return nxt_perl_psgi_add_str(my_perl, hash_env, name, name_len,
744                                  nxt_unit_sptr_get(sptr), len);
745 }
746 
747 
748 nxt_inline int
749 nxt_perl_psgi_add_str(PerlInterpreter *my_perl, HV *hash_env,
750     const char *name, uint32_t name_len, const char *str, uint32_t len)
751 {
752     SV  **ha;
753 
754     ha = hv_store(hash_env, name, (I32) name_len,
755                   newSVpv(str, (STRLEN) len), 0);
756     if (nxt_slow_path(ha == NULL)) {
757         return NXT_UNIT_ERROR;
758     }
759 
760     return NXT_UNIT_OK;
761 }
762 
763 
764 nxt_inline int
765 nxt_perl_psgi_add_value(PerlInterpreter *my_perl, HV *hash_env,
766     const char *name, uint32_t name_len, void *value)
767 {
768     SV  **ha;
769 
770     ha = hv_store(hash_env, name, (I32) name_len, value, 0);
771     if (nxt_slow_path(ha == NULL)) {
772         return NXT_UNIT_ERROR;
773     }
774 
775     return NXT_UNIT_OK;
776 }
777 
778 
779 static nxt_int_t
780 nxt_perl_psgi_result_status(PerlInterpreter *my_perl, SV *result)
781 {
782     SV         **sv_status;
783     AV         *array;
784     u_char     *space;
785     nxt_str_t  status;
786 
787     array = (AV *) SvRV(result);
788     sv_status = av_fetch(array, 0, 0);
789 
790     status.start = (u_char *) SvPV(*sv_status, status.length);
791 
792     space = nxt_memchr(status.start, ' ', status.length);
793     if (space != NULL) {
794         status.length = space - status.start;
795     }
796 
797     return nxt_int_parse(status.start, status.length);
798 }
799 
800 
801 static int
802 nxt_perl_psgi_result_head(PerlInterpreter *my_perl, SV *sv_head,
803     nxt_unit_request_info_t *req, uint16_t status)
804 {
805     AV         *array_head;
806     SV         **entry;
807     int        rc;
808     long       i, array_len;
809     char       *name, *value;
810     STRLEN     name_len, value_len;
811     uint32_t   fields, size;
812 
813     if (nxt_slow_path(SvROK(sv_head) == 0
814                       || SvTYPE(SvRV(sv_head)) != SVt_PVAV))
815     {
816         nxt_unit_req_error(req,
817                            "PSGI: An unsupported format was received from "
818                            "Perl Application for head part");
819 
820         return NXT_UNIT_ERROR;
821     }
822 
823     array_head = (AV *) SvRV(sv_head);
824     array_len = av_len(array_head);
825 
826     if (array_len < 1) {
827         return nxt_unit_response_init(req, status, 0, 0);
828     }
829 
830     if (nxt_slow_path((array_len % 2) == 0)) {
831         nxt_unit_req_error(req, "PSGI: Bad format for head from "
832                            "Perl Application");
833 
834         return NXT_UNIT_ERROR;
835     }
836 
837     fields = 0;
838     size = 0;
839 
840     for (i = 0; i <= array_len; i++) {
841         entry = av_fetch(array_head, i, 0);
842 
843         if (nxt_fast_path(entry == NULL)) {
844             nxt_unit_req_error(req, "PSGI: Failed to get head entry from "
845                                "Perl Application");
846 
847             return NXT_UNIT_ERROR;
848         }
849 
850         value = SvPV(*entry, value_len);
851         size += value_len;
852 
853         if ((i % 2) == 0) {
854             fields++;
855         }
856     }
857 
858     rc = nxt_unit_response_init(req, status, fields, size);
859     if (nxt_slow_path(rc != NXT_UNIT_OK)) {
860         return rc;
861     }
862 
863     for (i = 0; i <= array_len; i += 2) {
864         entry = av_fetch(array_head, i, 0);
865         name = SvPV(*entry, name_len);
866 
867         entry = av_fetch(array_head, i + 1, 0);
868         value = SvPV(*entry, value_len);
869 
870         rc = nxt_unit_response_add_field(req, name, name_len, value, value_len);
871         if (nxt_slow_path(rc != NXT_UNIT_OK)) {
872             return rc;
873         }
874     }
875 
876     return NXT_UNIT_OK;
877 }
878 
879 
880 static int
881 nxt_perl_psgi_result_body(PerlInterpreter *my_perl, SV *sv_body,
882     nxt_unit_request_info_t *req)
883 {
884     SV         **entry;
885     AV         *body_array;
886     int        rc;
887     long       i;
888     nxt_str_t  body;
889 
890     if (nxt_slow_path(SvROK(sv_body) == 0
891                       || SvTYPE(SvRV(sv_body)) != SVt_PVAV))
892     {
893         nxt_unit_req_error(req, "PSGI: An unsupported format was received from "
894                            "Perl Application for a body part");
895 
896         return NXT_UNIT_ERROR;
897     }
898 
899     body_array = (AV *) SvRV(sv_body);
900 
901     for (i = 0; i <= av_len(body_array); i++) {
902 
903         entry = av_fetch(body_array, i, 0);
904 
905         if (nxt_fast_path(entry == NULL)) {
906             nxt_unit_req_error(req, "PSGI: Failed to get body entry from "
907                                "Perl Application");
908 
909             return NXT_UNIT_ERROR;
910         }
911 
912         body.start = (u_char *) SvPV(*entry, body.length);
913 
914         if (body.length == 0) {
915             continue;
916         }
917 
918         rc = nxt_unit_response_write(req, body.start, body.length);
919 
920         if (nxt_slow_path(rc != NXT_UNIT_OK)) {
921             nxt_unit_req_error(req, "PSGI: Failed to write content from "
922                                "Perl Application");
923             return rc;
924         }
925     }
926 
927     return NXT_UNIT_OK;
928 }
929 
930 
931 static int
932 nxt_perl_psgi_result_body_ref(PerlInterpreter *my_perl, SV *sv_body,
933     nxt_unit_request_info_t *req)
934 {
935     SV          *data, *old_rs, *old_perl_rs;
936     int         rc;
937     size_t      len;
938     const char  *body;
939 
940     /*
941      * Servers should set the $/ special variable to the buffer size
942      * when reading content from $body using the getline method.
943      * This is done by setting $/ with a reference to an integer ($/ = \8192).
944      */
945 
946     old_rs = PL_rs;
947     old_perl_rs = get_sv("/", GV_ADD);
948 
949     PL_rs = sv_2mortal(newRV_noinc(newSViv(nxt_unit_buf_min())));
950 
951     sv_setsv(old_perl_rs, PL_rs);
952 
953     rc = NXT_UNIT_OK;
954 
955     for ( ;; ) {
956         data = nxt_perl_psgi_call_method(my_perl, sv_body, "getline", req);
957         if (nxt_slow_path(data == NULL)) {
958             rc = NXT_UNIT_ERROR;
959             break;
960         }
961 
962         body = SvPV(data, len);
963 
964         if (len == 0) {
965             SvREFCNT_dec(data);
966 
967             data = nxt_perl_psgi_call_method(my_perl, sv_body, "close", req);
968             if (nxt_fast_path(data != NULL)) {
969                 SvREFCNT_dec(data);
970             }
971 
972             break;
973         }
974 
975         rc = nxt_unit_response_write(req, body, len);
976 
977         SvREFCNT_dec(data);
978 
979         if (nxt_slow_path(rc != NXT_UNIT_OK)) {
980             nxt_unit_req_error(req, "PSGI: Failed to write content from "
981                                "Perl Application");
982             break;
983         }
984     };
985 
986     PL_rs =  old_rs;
987     sv_setsv(get_sv("/", GV_ADD), old_perl_rs);
988 
989     return rc;
990 }
991 
992 
993 typedef struct {
994     PerlInterpreter  *my_perl;
995     PerlIO           *fp;
996 } nxt_perl_psgi_io_ctx_t;
997 
998 
999 static int
1000 nxt_perl_psgi_result_body_fh(PerlInterpreter *my_perl, SV *sv_body,
1001     nxt_unit_request_info_t *req)
1002 {
1003     IO                      *io;
1004     nxt_unit_read_info_t    read_info;
1005     nxt_perl_psgi_io_ctx_t  io_ctx;
1006 
1007     io = GvIO(SvRV(sv_body));
1008 
1009     if (io == NULL) {
1010         return NXT_UNIT_OK;
1011     }
1012 
1013     io_ctx.my_perl = my_perl;
1014     io_ctx.fp = IoIFP(io);
1015 
1016     read_info.read = nxt_perl_psgi_io_read;
1017     read_info.eof = PerlIO_eof(io_ctx.fp);
1018     read_info.buf_size = 8192;
1019     read_info.data = &io_ctx;
1020 
1021     return nxt_unit_response_write_cb(req, &read_info);
1022 }
1023 
1024 
1025 static ssize_t
1026 nxt_perl_psgi_io_read(nxt_unit_read_info_t *read_info, void *dst, size_t size)
1027 {
1028     ssize_t                 res;
1029     nxt_perl_psgi_io_ctx_t  *ctx;
1030 
1031     ctx = read_info->data;
1032 
1033     dTHXa(ctx->my_perl);
1034 
1035     res = PerlIO_read(ctx->fp, dst, size);
1036 
1037     read_info->eof = PerlIO_eof(ctx->fp);
1038 
1039     return res;
1040 }
1041 
1042 
1043 static int
1044 nxt_perl_psgi_result_array(PerlInterpreter *my_perl, SV *result,
1045     nxt_unit_request_info_t *req)
1046 {
1047     AV         *array;
1048     SV         **sv_temp;
1049     int        rc;
1050     long       array_len;
1051     nxt_int_t  status;
1052 
1053     array = (AV *) SvRV(result);
1054     array_len = av_len(array);
1055 
1056     if (nxt_slow_path(array_len < 0)) {
1057         nxt_unit_req_error(req,
1058                            "PSGI: Invalid result format from Perl Application");
1059 
1060         return NXT_UNIT_ERROR;
1061     }
1062 
1063     status = nxt_perl_psgi_result_status(my_perl, result);
1064 
1065     if (nxt_slow_path(status < 0)) {
1066         nxt_unit_req_error(req,
1067                            "PSGI: An unexpected status was received "
1068                            "from Perl Application");
1069 
1070         return NXT_UNIT_ERROR;
1071     }
1072 
1073     if (array_len >= 1) {
1074         sv_temp = av_fetch(array, 1, 0);
1075 
1076         if (nxt_slow_path(sv_temp == NULL)) {
1077             nxt_unit_req_error(req, "PSGI: Failed to get head from "
1078                                "Perl ARRAY variable");
1079 
1080             return NXT_UNIT_ERROR;
1081         }
1082 
1083         rc = nxt_perl_psgi_result_head(my_perl, *sv_temp, req, status);
1084         if (nxt_slow_path(rc != NXT_UNIT_OK)) {
1085             return rc;
1086         }
1087 
1088     } else {
1089         return nxt_unit_response_init(req, status, 0, 0);
1090     }
1091 
1092     if (nxt_fast_path(array_len < 2)) {
1093         return NXT_UNIT_OK;
1094     }
1095 
1096     sv_temp = av_fetch(array, 2, 0);
1097 
1098     if (nxt_slow_path(sv_temp == NULL || SvROK(*sv_temp) == FALSE)) {
1099         nxt_unit_req_error(req,
1100                            "PSGI: Failed to get body from "
1101                            "Perl ARRAY variable");
1102 
1103         return NXT_UNIT_ERROR;
1104     }
1105 
1106     if (SvTYPE(SvRV(*sv_temp)) == SVt_PVAV) {
1107         return nxt_perl_psgi_result_body(my_perl, *sv_temp, req);
1108     }
1109 
1110     if (SvTYPE(SvRV(*sv_temp)) == SVt_PVGV) {
1111         return nxt_perl_psgi_result_body_fh(my_perl, *sv_temp, req);
1112     }
1113 
1114     return nxt_perl_psgi_result_body_ref(my_perl, *sv_temp, req);
1115 }
1116 
1117 
1118 static void
1119 nxt_perl_psgi_result_cb(PerlInterpreter *my_perl, SV *result,
1120     nxt_unit_request_info_t *req)
1121 {
1122     nxt_perl_psgi_ctx_t  *pctx;
1123 
1124     dSP;
1125 
1126     pctx = req->ctx->data;
1127 
1128     ENTER;
1129     SAVETMPS;
1130 
1131     PUSHMARK(sp);
1132     XPUSHs(newRV_noinc((SV*) pctx->cb));
1133     PUTBACK;
1134 
1135     call_sv(result, G_EVAL|G_SCALAR);
1136 
1137     SPAGAIN;
1138 
1139     if (SvTRUE(ERRSV)) {
1140         nxt_unit_error(NULL, "PSGI: Failed to execute result callback: \n%s",
1141                        SvPV_nolen(ERRSV));
1142 
1143         nxt_perl_psgi_cb_request_done(pctx, NXT_UNIT_ERROR);
1144     }
1145 
1146     PUTBACK;
1147     FREETMPS;
1148     LEAVE;
1149 }
1150 
1151 
1152 static nxt_int_t
1153 nxt_perl_psgi_start(nxt_task_t *task, nxt_process_data_t *data)
1154 {
1155     int                    rc, pargc;
1156     char                   **pargv, **penv;
1157     nxt_unit_ctx_t         *unit_ctx;
1158     nxt_unit_init_t        perl_init;
1159     nxt_perl_psgi_ctx_t    pctx;
1160     nxt_perl_app_conf_t    *c;
1161     nxt_common_app_conf_t  *common_conf;
1162 
1163     common_conf = data->app;
1164     c = &common_conf->u.perl;
1165 
1166     pargc = 0;
1167     pargv = NULL;
1168     penv = NULL;
1169 
1170     PERL_SYS_INIT3(&pargc, &pargv, &penv);
1171 
1172     memset(&pctx, 0, sizeof(nxt_perl_psgi_ctx_t));
1173 
1174     rc = nxt_perl_psgi_ctx_init(c->script, &pctx);
1175     if (nxt_slow_path(rc != NXT_UNIT_OK)) {
1176         goto fail;
1177     }
1178 
1179     rc = nxt_perl_psgi_init_threads(c);
1180 
1181     PERL_SET_CONTEXT(pctx.my_perl);
1182 
1183     if (nxt_slow_path(rc != NXT_UNIT_OK)) {
1184         goto fail;
1185     }
1186 
1187     nxt_unit_default_init(task, &perl_init, common_conf);
1188 
1189     perl_init.callbacks.request_handler = nxt_perl_psgi_request_handler;
1190     perl_init.callbacks.ready_handler = nxt_perl_psgi_ready_handler;
1191     perl_init.data = c;
1192     perl_init.ctx_data = &pctx;
1193 
1194     unit_ctx = nxt_unit_init(&perl_init);
1195     if (nxt_slow_path(unit_ctx == NULL)) {
1196         goto fail;
1197     }
1198 
1199     rc = nxt_unit_run(unit_ctx);
1200 
1201     nxt_perl_psgi_join_threads(unit_ctx, c);
1202 
1203     nxt_unit_done(unit_ctx);
1204 
1205     nxt_perl_psgi_ctx_free(&pctx);
1206 
1207     PERL_SYS_TERM();
1208 
1209     exit(rc);
1210 
1211     return NXT_OK;
1212 
1213 fail:
1214 
1215     nxt_perl_psgi_join_threads(NULL, c);
1216 
1217     nxt_perl_psgi_ctx_free(&pctx);
1218 
1219     PERL_SYS_TERM();
1220 
1221     return NXT_ERROR;
1222 }
1223 
1224 
1225 static void
1226 nxt_perl_psgi_request_handler(nxt_unit_request_info_t *req)
1227 {
1228     SV                   *env, *result;
1229     nxt_int_t            rc;
1230     PerlInterpreter      *my_perl;
1231     nxt_perl_psgi_ctx_t  *pctx;
1232 
1233     pctx = req->ctx->data;
1234     my_perl = pctx->my_perl;
1235 
1236     pctx->req = req;
1237 
1238     /*
1239      * Create environ variable for perl sub "application".
1240      *  > sub application {
1241      *  >     my ($environ) = @_;
1242      */
1243     env = nxt_perl_psgi_env_create(my_perl, req);
1244     if (nxt_slow_path(env == NULL)) {
1245         nxt_unit_req_error(req,
1246                            "PSGI: Failed to create 'env' for Perl Application");
1247         nxt_unit_request_done(req, NXT_UNIT_ERROR);
1248         pctx->req = NULL;
1249 
1250         return;
1251     }
1252 
1253     /* Call perl sub and get result as SV*. */
1254     result = nxt_perl_psgi_call_var_application(my_perl, env, pctx->app,
1255                                                 req);
1256 
1257     if (nxt_fast_path(SvOK(result) != 0 && SvROK(result) != 0)) {
1258 
1259         if (SvTYPE(SvRV(result)) == SVt_PVAV) {
1260             rc = nxt_perl_psgi_result_array(my_perl, result, req);
1261             nxt_unit_request_done(req, rc);
1262             pctx->req = NULL;
1263 
1264             goto release;
1265         }
1266 
1267         if (SvTYPE(SvRV(result)) == SVt_PVCV) {
1268             nxt_perl_psgi_result_cb(my_perl, result, req);
1269             goto release;
1270         }
1271     }
1272 
1273     nxt_unit_req_error(req, "PSGI: An unexpected response was received "
1274                        "from Perl Application");
1275 
1276     nxt_unit_request_done(req, NXT_UNIT_ERROR);
1277     pctx->req = NULL;
1278 
1279 release:
1280 
1281     SvREFCNT_dec(result);
1282     SvREFCNT_dec(env);
1283 }
1284 
1285 
1286 static int
1287 nxt_perl_psgi_ready_handler(nxt_unit_ctx_t *ctx)
1288 {
1289     int                  res;
1290     uint32_t             i;
1291     nxt_perl_app_conf_t  *c;
1292     nxt_perl_psgi_ctx_t  *pctx;
1293 
1294     c = ctx->unit->data;
1295 
1296     if (c->threads <= 1) {
1297         return NXT_UNIT_OK;
1298     }
1299 
1300     for (i = 0; i < c->threads - 1; i++) {
1301         pctx = &nxt_perl_psgi_ctxs[i];
1302 
1303         pctx->ctx = ctx;
1304 
1305         res = pthread_create(&pctx->thread, nxt_perl_psgi_thread_attr,
1306                              nxt_perl_psgi_thread_func, pctx);
1307 
1308         if (nxt_fast_path(res == 0)) {
1309             nxt_unit_debug(ctx, "thread #%d created", (int) (i + 1));
1310 
1311         } else {
1312             nxt_unit_alert(ctx, "thread #%d create failed: %s (%d)",
1313                            (int) (i + 1), strerror(res), res);
1314 
1315             return NXT_UNIT_ERROR;
1316         }
1317     }
1318 
1319     return NXT_UNIT_OK;
1320 }
1321 
1322 
1323 static void *
1324 nxt_perl_psgi_thread_func(void *data)
1325 {
1326     nxt_unit_ctx_t       *ctx;
1327     nxt_perl_psgi_ctx_t  *pctx;
1328 
1329     pctx = data;
1330 
1331     nxt_unit_debug(pctx->ctx, "worker thread start");
1332 
1333     ctx = nxt_unit_ctx_alloc(pctx->ctx, pctx);
1334     if (nxt_slow_path(ctx == NULL)) {
1335         return NULL;
1336     }
1337 
1338     pctx->ctx = ctx;
1339 
1340     PERL_SET_CONTEXT(pctx->my_perl);
1341 
1342     (void) nxt_unit_run(ctx);
1343 
1344     nxt_unit_done(ctx);
1345 
1346     nxt_unit_debug(NULL, "worker thread end");
1347 
1348     return NULL;
1349 }
1350 
1351 
1352 static int
1353 nxt_perl_psgi_init_threads(nxt_perl_app_conf_t *c)
1354 {
1355     int                    rc;
1356     uint32_t               i;
1357     static pthread_attr_t  attr;
1358 
1359     if (c->threads <= 1) {
1360         return NXT_UNIT_OK;
1361     }
1362 
1363     if (c->thread_stack_size > 0) {
1364         rc = pthread_attr_init(&attr);
1365         if (nxt_slow_path(rc != 0)) {
1366             nxt_unit_alert(NULL, "thread attr init failed: %s (%d)",
1367                            strerror(rc), rc);
1368 
1369             return NXT_UNIT_ERROR;
1370         }
1371 
1372         rc = pthread_attr_setstacksize(&attr, c->thread_stack_size);
1373         if (nxt_slow_path(rc != 0)) {
1374             nxt_unit_alert(NULL, "thread attr set stack size failed: %s (%d)",
1375                            strerror(rc), rc);
1376 
1377             return NXT_UNIT_ERROR;
1378         }
1379 
1380         nxt_perl_psgi_thread_attr = &attr;
1381     }
1382 
1383     nxt_perl_psgi_ctxs = nxt_unit_malloc(NULL, sizeof(nxt_perl_psgi_ctx_t)
1384                                                * (c->threads - 1));
1385     if (nxt_slow_path(nxt_perl_psgi_ctxs == NULL)) {
1386         return NXT_UNIT_ERROR;
1387     }
1388 
1389     memset(nxt_perl_psgi_ctxs, 0, sizeof(nxt_perl_psgi_ctx_t)
1390                                   * (c->threads - 1));
1391 
1392     for (i = 0; i < c->threads - 1; i++) {
1393         rc = nxt_perl_psgi_ctx_init(c->script, &nxt_perl_psgi_ctxs[i]);
1394 
1395         if (nxt_slow_path(rc != NXT_UNIT_OK)) {
1396             return NXT_UNIT_ERROR;
1397         }
1398     }
1399 
1400     return NXT_UNIT_OK;
1401 }
1402 
1403 
1404 static void
1405 nxt_perl_psgi_join_threads(nxt_unit_ctx_t *ctx, nxt_perl_app_conf_t *c)
1406 {
1407     int                  res;
1408     uint32_t             i;
1409     nxt_perl_psgi_ctx_t  *pctx;
1410 
1411     if (nxt_perl_psgi_ctxs == NULL) {
1412         return;
1413     }
1414 
1415     for (i = 0; i < c->threads - 1; i++) {
1416         pctx = &nxt_perl_psgi_ctxs[i];
1417 
1418         res = pthread_join(pctx->thread, NULL);
1419 
1420         if (nxt_fast_path(res == 0)) {
1421             nxt_unit_debug(ctx, "thread #%d joined", (int) (i + 1));
1422 
1423         } else {
1424             nxt_unit_alert(ctx, "thread #%d join failed: %s (%d)",
1425                            (int) (i + 1), strerror(res), res);
1426         }
1427     }
1428 
1429     for (i = 0; i < c->threads - 1; i++) {
1430         nxt_perl_psgi_ctx_free(&nxt_perl_psgi_ctxs[i]);
1431     }
1432 
1433     nxt_unit_free(NULL, nxt_perl_psgi_ctxs);
1434 }
1435 
1436 
1437 static void
1438 nxt_perl_psgi_ctx_free(nxt_perl_psgi_ctx_t *pctx)
1439 {
1440     PerlInterpreter  *my_perl;
1441 
1442     my_perl = pctx->my_perl;
1443 
1444     if (nxt_slow_path(my_perl == NULL)) {
1445         return;
1446     }
1447 
1448     PERL_SET_CONTEXT(my_perl);
1449 
1450     nxt_perl_psgi_layer_stream_io_destroy(aTHX_ pctx->arg_input.io);
1451     nxt_perl_psgi_layer_stream_fp_destroy(aTHX_ pctx->arg_input.fp);
1452 
1453     nxt_perl_psgi_layer_stream_io_destroy(aTHX_ pctx->arg_error.io);
1454     nxt_perl_psgi_layer_stream_fp_destroy(aTHX_ pctx->arg_error.fp);
1455 
1456     perl_destruct(my_perl);
1457     perl_free(my_perl);
1458 }
1459