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