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