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