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