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 15 16 typedef struct { 17 PerlInterpreter *my_perl; 18 19 nxt_task_t *task; 20 nxt_app_rmsg_t *rmsg; 21 nxt_app_wmsg_t *wmsg; 22 23 size_t body_preread_size; 24 } nxt_perl_psgi_input_t; 25 26 27 nxt_inline nxt_int_t nxt_perl_psgi_write(nxt_task_t *task, nxt_app_wmsg_t *wmsg, 28 const u_char *data, size_t len, 29 nxt_bool_t flush, nxt_bool_t last); 30 31 nxt_inline nxt_int_t nxt_perl_psgi_http_write_status_str(nxt_task_t *task, 32 nxt_app_wmsg_t *wmsg, nxt_str_t *http_status); 33 34 static long nxt_perl_psgi_io_input_read(PerlInterpreter *my_perl, 35 nxt_perl_psgi_io_arg_t *arg, void *vbuf, size_t length); 36 static long nxt_perl_psgi_io_input_write(PerlInterpreter *my_perl, 37 nxt_perl_psgi_io_arg_t *arg, const void *vbuf, size_t length); 38 static long nxt_perl_psgi_io_input_flush(PerlInterpreter *my_perl, 39 nxt_perl_psgi_io_arg_t *arg); 40 41 static long nxt_perl_psgi_io_error_read(PerlInterpreter *my_perl, 42 nxt_perl_psgi_io_arg_t *arg, void *vbuf, size_t length); 43 static long nxt_perl_psgi_io_error_write(PerlInterpreter *my_perl, 44 nxt_perl_psgi_io_arg_t *arg, const void *vbuf, size_t length); 45 static long nxt_perl_psgi_io_error_flush(PerlInterpreter *my_perl, 46 nxt_perl_psgi_io_arg_t *arg); 47 48 /* 49 static void nxt_perl_psgi_xs_core_global_changes(PerlInterpreter *my_perl, 50 const char *core, const char *sub, XSUBADDR_t sub_addr); 51 */ 52 53 static void nxt_perl_psgi_xs_init(pTHX); 54 55 static SV *nxt_perl_psgi_call_var_application(PerlInterpreter *my_perl, 56 SV *env, nxt_task_t *task); 57 58 /* For currect load XS modules */ 59 EXTERN_C void boot_DynaLoader(pTHX_ CV *cv); 60 61 static nxt_int_t nxt_perl_psgi_io_input_init(PerlInterpreter *my_perl, 62 nxt_perl_psgi_io_arg_t *arg); 63 static nxt_int_t nxt_perl_psgi_io_error_init(PerlInterpreter *my_perl, 64 nxt_perl_psgi_io_arg_t *arg); 65 66 static PerlInterpreter *nxt_perl_psgi_interpreter_init(nxt_task_t *task, 67 char *script); 68 69 nxt_inline nxt_int_t nxt_perl_psgi_env_append_str(PerlInterpreter *my_perl, 70 HV *hash_env, const char *name, nxt_str_t *str); 71 nxt_inline nxt_int_t nxt_perl_psgi_env_append(PerlInterpreter *my_perl, 72 HV *hash_env, const char *name, void *value); 73 74 static SV *nxt_perl_psgi_env_create(PerlInterpreter *my_perl, nxt_task_t *task, 75 nxt_app_rmsg_t *rmsg, size_t *body_preread_size); 76 77 nxt_inline nxt_int_t nxt_perl_psgi_read_add_env(PerlInterpreter *my_perl, 78 nxt_task_t *task, nxt_app_rmsg_t *rmsg, HV *hash_env, 79 const char *name, nxt_str_t *str); 80 81 static u_char *nxt_perl_psgi_module_create(nxt_task_t *task, 82 const char *script); 83 84 static nxt_str_t nxt_perl_psgi_result_status(PerlInterpreter *my_perl, 85 SV *result); 86 static nxt_int_t nxt_perl_psgi_result_head(PerlInterpreter *my_perl, 87 SV *sv_head, nxt_task_t *task, nxt_app_wmsg_t *wmsg); 88 static nxt_int_t nxt_perl_psgi_result_body(PerlInterpreter *my_perl, 89 SV *result, nxt_task_t *task, nxt_app_wmsg_t *wmsg); 90 static nxt_int_t nxt_perl_psgi_result_body_ref(PerlInterpreter *my_perl, 91 SV *sv_body, nxt_task_t *task, nxt_app_wmsg_t *wmsg); 92 static nxt_int_t nxt_perl_psgi_result_array(PerlInterpreter *my_perl, 93 SV *result, nxt_task_t *task, nxt_app_wmsg_t *wmsg); 94 95 static nxt_int_t nxt_perl_psgi_init(nxt_task_t *task, 96 nxt_common_app_conf_t *conf); 97 static nxt_int_t nxt_perl_psgi_run(nxt_task_t *task, 98 nxt_app_rmsg_t *rmsg, nxt_app_wmsg_t *wmsg); 99 static void nxt_perl_psgi_atexit(nxt_task_t *task); 100 101 typedef SV *(*nxt_perl_psgi_callback_f)(PerlInterpreter *my_perl, 102 SV *env, nxt_task_t *task); 103 104 static SV *nxt_perl_psgi_app; 105 static PerlInterpreter *nxt_perl_psgi; 106 static nxt_perl_psgi_io_arg_t nxt_perl_psgi_arg_input, nxt_perl_psgi_arg_error; 107 108 static uint32_t nxt_perl_psgi_compat[] = { 109 NXT_VERNUM, NXT_DEBUG, 110 }; 111 112 NXT_EXPORT nxt_application_module_t nxt_app_module = { 113 sizeof(nxt_perl_psgi_compat), 114 nxt_perl_psgi_compat, 115 nxt_string("perl"), 116 PERL_VERSION_STRING, 117 nxt_perl_psgi_init, 118 nxt_perl_psgi_run, 119 nxt_perl_psgi_atexit, 120 }; 121 122 123 nxt_inline nxt_int_t 124 nxt_perl_psgi_write(nxt_task_t *task, nxt_app_wmsg_t *wmsg, 125 const u_char *data, size_t len, 126 nxt_bool_t flush, nxt_bool_t last) 127 { 128 nxt_int_t rc; 129 130 rc = nxt_app_msg_write_raw(task, wmsg, data, len); 131 132 if (nxt_slow_path(rc != NXT_OK)) { 133 return rc; 134 } 135 136 if (flush || last) { 137 rc = nxt_app_msg_flush(task, wmsg, last); 138 } 139 140 return rc; 141 } 142 143 144 nxt_inline nxt_int_t 145 nxt_perl_psgi_http_write_status_str(nxt_task_t *task, nxt_app_wmsg_t *wmsg, 146 nxt_str_t *http_status) 147 { 148 nxt_int_t rc; 149 150 rc = NXT_OK; 151 152 #define RC_WRT(DATA, DATALEN, FLUSH) \ 153 do { \ 154 rc = nxt_perl_psgi_write(task, wmsg, DATA, \ 155 DATALEN, FLUSH, 0); \ 156 if (nxt_slow_path(rc != NXT_OK)) \ 157 return rc; \ 158 \ 159 } while (0) 160 161 RC_WRT((const u_char *) "Status: ", nxt_length("Status: "), 0); 162 RC_WRT(http_status->start, http_status->length, 0); 163 RC_WRT((u_char *) "\r\n", nxt_length("\r\n"), 0); 164 165 #undef RC_WRT 166 167 return rc; 168 } 169 170 171 static long 172 nxt_perl_psgi_io_input_read(PerlInterpreter *my_perl, 173 nxt_perl_psgi_io_arg_t *arg, void *vbuf, size_t length) 174 { 175 size_t copy_size; 176 nxt_perl_psgi_input_t *input; 177 178 input = (nxt_perl_psgi_input_t *) arg->ctx; 179 180 if (input->body_preread_size == 0) { 181 return 0; 182 } 183 184 copy_size = nxt_min(length, input->body_preread_size); 185 copy_size = nxt_app_msg_read_raw(input->task, input->rmsg, 186 vbuf, copy_size); 187 188 input->body_preread_size -= copy_size; 189 190 return copy_size; 191 } 192 193 194 static long 195 nxt_perl_psgi_io_input_write(PerlInterpreter *my_perl, 196 nxt_perl_psgi_io_arg_t *arg, const void *vbuf, size_t length) 197 { 198 return 0; 199 } 200 201 202 static long 203 nxt_perl_psgi_io_input_flush(PerlInterpreter *my_perl, 204 nxt_perl_psgi_io_arg_t *arg) 205 { 206 return 0; 207 } 208 209 210 static long 211 nxt_perl_psgi_io_error_read(PerlInterpreter *my_perl, 212 nxt_perl_psgi_io_arg_t *arg, void *vbuf, size_t length) 213 { 214 return 0; 215 } 216 217 218 static long 219 nxt_perl_psgi_io_error_write(PerlInterpreter *my_perl, 220 nxt_perl_psgi_io_arg_t *arg, const void *vbuf, size_t length) 221 { 222 nxt_perl_psgi_input_t *input; 223 224 input = (nxt_perl_psgi_input_t *) arg->ctx; 225 nxt_log_error(NXT_LOG_ERR, input->task->log, "Perl: %s", vbuf); 226 227 return (long) length; 228 } 229 230 231 static long 232 nxt_perl_psgi_io_error_flush(PerlInterpreter *my_perl, 233 nxt_perl_psgi_io_arg_t *arg) 234 { 235 return 0; 236 } 237 238 239 /* In the future it will be necessary to change some Perl functions. */ 240 /* 241 static void 242 nxt_perl_psgi_xs_core_global_changes(PerlInterpreter *my_perl, 243 const char *core, const char *sub, XSUBADDR_t sub_addr) 244 { 245 GV *gv; 246 247 gv = gv_fetchpv(core, TRUE, SVt_PVCV); 248 249 #ifdef MUTABLE_CV 250 GvCV_set(gv, MUTABLE_CV(SvREFCNT_inc(get_cv(sub, TRUE)))); 251 #else 252 GvCV_set(gv, (CV *) (SvREFCNT_inc(get_cv(sub, TRUE)))); 253 #endif 254 GvIMPORTED_CV_on(gv); 255 256 newXS(sub, sub_addr, __FILE__); 257 } 258 */ 259 260 261 XS(XS_NGINX__Unit__PSGI_exit); 262 XS(XS_NGINX__Unit__PSGI_exit) 263 { 264 I32 ax = POPMARK; 265 Perl_croak(aTHX_ (char *) NULL); 266 XSRETURN_EMPTY; 267 } 268 269 270 static void 271 nxt_perl_psgi_xs_init(pTHX) 272 { 273 /* 274 nxt_perl_psgi_xs_core_global_changes(my_perl, "CORE::GLOBAL::exit", 275 "NGINX::Unit::PSGI::exit", 276 XS_NGINX__Unit__PSGI_exit); 277 */ 278 nxt_perl_psgi_layer_stream_init(aTHX); 279 280 /* DynaLoader for Perl modules who use XS */ 281 newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, __FILE__); 282 } 283 284 285 static SV * 286 nxt_perl_psgi_call_var_application(PerlInterpreter *my_perl, 287 SV *env, nxt_task_t *task) 288 { 289 SV *result; 290 291 dSP; 292 293 ENTER; 294 SAVETMPS; 295 296 PUSHMARK(sp); 297 XPUSHs(env); 298 PUTBACK; 299 300 call_sv(nxt_perl_psgi_app, G_EVAL|G_SCALAR); 301 302 SPAGAIN; 303 304 if (SvTRUE(ERRSV)) { 305 nxt_log_error(NXT_LOG_ERR, task->log, 306 "PSGI: Failed to run Perl Application: \n%s", 307 SvPV_nolen(ERRSV)); 308 } 309 310 result = POPs; 311 SvREFCNT_inc(result); 312 313 PUTBACK; 314 FREETMPS; 315 LEAVE; 316 317 return result; 318 } 319 320 321 static u_char * 322 nxt_perl_psgi_module_create(nxt_task_t *task, const char *script) 323 { 324 u_char *buf, *p; 325 size_t length; 326 327 static nxt_str_t prefix = nxt_string( 328 "package NGINX::Unit::Sandbox;" 329 "{my $app = do \"" 330 ); 331 332 static nxt_str_t suffix = nxt_string_zero( 333 "\";" 334 "unless ($app) {" 335 " if($@ || $1) {die $@ || $1}" 336 " else {die \"File not found or compilation error.\"}" 337 "} " 338 "return $app}" 339 ); 340 341 length = strlen(script); 342 343 buf = nxt_malloc(prefix.length + length + suffix.length); 344 345 if (nxt_slow_path(buf == NULL)) { 346 nxt_log_error(NXT_LOG_ERR, task->log, 347 "PSGI: Failed to allocate memory " 348 "for Perl script file %s", script); 349 return NULL; 350 } 351 352 p = nxt_cpymem(buf, prefix.start, prefix.length); 353 p = nxt_cpymem(p, script, length); 354 nxt_memcpy(p, suffix.start, suffix.length); 355 356 return buf; 357 } 358 359 360 static nxt_int_t 361 nxt_perl_psgi_io_input_init(PerlInterpreter *my_perl, 362 nxt_perl_psgi_io_arg_t *arg) 363 { 364 SV *io; 365 PerlIO *fp; 366 367 fp = nxt_perl_psgi_layer_stream_fp_create(aTHX_ arg, "r"); 368 369 if (nxt_slow_path(fp == NULL)) { 370 return NXT_ERROR; 371 } 372 373 io = nxt_perl_psgi_layer_stream_io_create(aTHX_ fp); 374 375 if (nxt_slow_path(io == NULL)) { 376 nxt_perl_psgi_layer_stream_fp_destroy(aTHX_ fp); 377 return NXT_ERROR; 378 } 379 380 arg->io = io; 381 arg->fp = fp; 382 arg->flush = nxt_perl_psgi_io_input_flush; 383 arg->read = nxt_perl_psgi_io_input_read; 384 arg->write = nxt_perl_psgi_io_input_write; 385 386 return NXT_OK; 387 } 388 389 390 static nxt_int_t 391 nxt_perl_psgi_io_error_init(PerlInterpreter *my_perl, 392 nxt_perl_psgi_io_arg_t *arg) 393 { 394 SV *io; 395 PerlIO *fp; 396 397 fp = nxt_perl_psgi_layer_stream_fp_create(aTHX_ arg, "w"); 398 399 if (nxt_slow_path(fp == NULL)) { 400 return NXT_ERROR; 401 } 402 403 io = nxt_perl_psgi_layer_stream_io_create(aTHX_ fp); 404 405 if (nxt_slow_path(io == NULL)) { 406 nxt_perl_psgi_layer_stream_fp_destroy(aTHX_ fp); 407 return NXT_ERROR; 408 } 409 410 arg->io = io; 411 arg->fp = fp; 412 arg->flush = nxt_perl_psgi_io_error_flush; 413 arg->read = nxt_perl_psgi_io_error_read; 414 arg->write = nxt_perl_psgi_io_error_write; 415 416 return NXT_OK; 417 } 418 419 420 static PerlInterpreter * 421 nxt_perl_psgi_interpreter_init(nxt_task_t *task, char *script) 422 { 423 int status, pargc; 424 char **pargv, **penv; 425 u_char *run_module; 426 PerlInterpreter *my_perl; 427 428 static char argv[] = "\0""-e\0""0"; 429 static char *embedding[] = { &argv[0], &argv[1], &argv[4] }; 430 431 pargc = 0; 432 pargv = NULL; 433 penv = NULL; 434 435 PERL_SYS_INIT3(&pargc, &pargv, &penv); 436 437 my_perl = perl_alloc(); 438 439 if (nxt_slow_path(my_perl == NULL)) { 440 nxt_alert(task, "PSGI: Failed to allocate memory for Perl interpreter"); 441 return NULL; 442 } 443 444 run_module = NULL; 445 446 perl_construct(my_perl); 447 PERL_SET_CONTEXT(my_perl); 448 449 status = perl_parse(my_perl, nxt_perl_psgi_xs_init, 3, embedding, NULL); 450 451 if (nxt_slow_path(status != 0)) { 452 nxt_alert(task, "PSGI: Failed to parse Perl Script"); 453 goto fail; 454 } 455 456 PL_exit_flags |= PERL_EXIT_DESTRUCT_END; 457 PL_origalen = 1; 458 459 status = perl_run(my_perl); 460 461 if (nxt_slow_path(status != 0)) { 462 nxt_alert(task, "PSGI: Failed to run Perl"); 463 goto fail; 464 } 465 466 sv_setsv(get_sv("0", 0), newSVpv(script, 0)); 467 468 run_module = nxt_perl_psgi_module_create(task, script); 469 470 if (nxt_slow_path(run_module == NULL)) { 471 goto fail; 472 } 473 474 status = nxt_perl_psgi_io_input_init(my_perl, &nxt_perl_psgi_arg_input); 475 476 if (nxt_slow_path(status != NXT_OK)) { 477 nxt_alert(task, "PSGI: Failed to init io.psgi.input"); 478 goto fail; 479 } 480 481 status = nxt_perl_psgi_io_error_init(my_perl, &nxt_perl_psgi_arg_error); 482 483 if (nxt_slow_path(status != NXT_OK)) { 484 nxt_alert(task, "PSGI: Failed to init io.psgi.errors"); 485 goto fail; 486 } 487 488 nxt_perl_psgi_app = eval_pv((const char *) run_module, FALSE); 489 490 if (SvTRUE(ERRSV)) { 491 nxt_alert(task, "PSGI: Failed to parse script: %s\n%s", 492 script, SvPV_nolen(ERRSV)); 493 goto fail; 494 } 495 496 nxt_free(run_module); 497 498 return my_perl; 499 500 fail: 501 502 if (run_module != NULL) { 503 nxt_free(run_module); 504 } 505 506 perl_destruct(my_perl); 507 perl_free(my_perl); 508 PERL_SYS_TERM(); 509 510 return NULL; 511 } 512 513 514 nxt_inline nxt_int_t 515 nxt_perl_psgi_env_append_str(PerlInterpreter *my_perl, HV *hash_env, 516 const char *name, nxt_str_t *str) 517 { 518 SV **ha; 519 520 ha = hv_store(hash_env, name, (I32) strlen(name), 521 newSVpv((const char *) str->start, (STRLEN) str->length), 0); 522 523 if (nxt_slow_path(ha == NULL)) { 524 return NXT_ERROR; 525 } 526 527 return NXT_OK; 528 } 529 530 531 nxt_inline nxt_int_t 532 nxt_perl_psgi_env_append(PerlInterpreter *my_perl, HV *hash_env, 533 const char *name, void *value) 534 { 535 SV **ha; 536 537 ha = hv_store(hash_env, name, (I32) strlen(name), value, 0); 538 539 if (nxt_slow_path(ha == NULL)) { 540 return NXT_ERROR; 541 } 542 543 return NXT_OK; 544 } 545 546 547 nxt_inline nxt_int_t 548 nxt_perl_psgi_read_add_env(PerlInterpreter *my_perl, nxt_task_t *task, 549 nxt_app_rmsg_t *rmsg, HV *hash_env, 550 const char *name, nxt_str_t *str) 551 { 552 nxt_int_t rc; 553 554 rc = nxt_app_msg_read_str(task, rmsg, str); 555 556 if (nxt_slow_path(rc != NXT_OK)) { 557 return rc; 558 } 559 560 if (str->start == NULL) { 561 return NXT_OK; 562 } 563 564 return nxt_perl_psgi_env_append_str(my_perl, hash_env, name, str); 565 } 566 567 568 static SV * 569 nxt_perl_psgi_env_create(PerlInterpreter *my_perl, nxt_task_t *task, 570 nxt_app_rmsg_t *rmsg, size_t *body_preread_size) 571 { 572 HV *hash_env; 573 AV *array_version; 574 u_char *colon; 575 size_t query_size; 576 nxt_int_t rc; 577 nxt_str_t str, value, path, target; 578 nxt_str_t host, server_name, server_port; 579 580 static nxt_str_t def_host = nxt_string("localhost"); 581 static nxt_str_t def_port = nxt_string("80"); 582 583 hash_env = newHV(); 584 585 if (nxt_slow_path(hash_env == NULL)) { 586 return NULL; 587 } 588 589 #define RC(FNS) \ 590 do { \ 591 if (nxt_slow_path((FNS) != NXT_OK)) \ 592 goto fail; \ 593 } while (0) 594 595 #define GET_STR(ATTR) \ 596 RC(nxt_perl_psgi_read_add_env(my_perl, task, rmsg, \ 597 hash_env, ATTR, &str)) 598 599 RC(nxt_perl_psgi_env_append_str(my_perl, hash_env, 600 "SERVER_SOFTWARE", &nxt_server)); 601 602 GET_STR("REQUEST_METHOD"); 603 GET_STR("REQUEST_URI"); 604 605 target = str; 606 607 RC(nxt_app_msg_read_str(task, rmsg, &path)); 608 RC(nxt_app_msg_read_size(task, rmsg, &query_size)); 609 610 if (path.start == NULL || path.length == 0) { 611 path = target; 612 } 613 614 RC(nxt_perl_psgi_env_append_str(my_perl, hash_env, "PATH_INFO", 615 &path)); 616 617 array_version = newAV(); 618 619 if (nxt_slow_path(array_version == NULL)) { 620 goto fail; 621 } 622 623 av_push(array_version, newSViv(1)); 624 av_push(array_version, newSViv(1)); 625 626 RC(nxt_perl_psgi_env_append(my_perl, hash_env, "psgi.version", 627 newRV_noinc((SV *) array_version))); 628 RC(nxt_perl_psgi_env_append(my_perl, hash_env, "psgi.url_scheme", 629 newSVpv("http", 4))); 630 RC(nxt_perl_psgi_env_append(my_perl, hash_env, "psgi.input", 631 SvREFCNT_inc(nxt_perl_psgi_arg_input.io))); 632 RC(nxt_perl_psgi_env_append(my_perl, hash_env, "psgi.errors", 633 SvREFCNT_inc(nxt_perl_psgi_arg_error.io))); 634 RC(nxt_perl_psgi_env_append(my_perl, hash_env, "psgi.multithread", 635 &PL_sv_no)); 636 RC(nxt_perl_psgi_env_append(my_perl, hash_env, "psgi.multiprocess", 637 &PL_sv_yes)); 638 RC(nxt_perl_psgi_env_append(my_perl, hash_env, "psgi.run_once", 639 &PL_sv_no)); 640 RC(nxt_perl_psgi_env_append(my_perl, hash_env, "psgi.nonblocking", 641 &PL_sv_no)); 642 RC(nxt_perl_psgi_env_append(my_perl, hash_env, "psgi.streaming", 643 &PL_sv_no)); 644 645 if (query_size > 0) { 646 query_size--; 647 648 if (nxt_slow_path(target.length < query_size)) { 649 goto fail; 650 } 651 652 str.start = &target.start[query_size]; 653 str.length = target.length - query_size; 654 655 RC(nxt_perl_psgi_env_append_str(my_perl, hash_env, 656 "QUERY_STRING", &str)); 657 } 658 659 GET_STR("SERVER_PROTOCOL"); 660 GET_STR("REMOTE_ADDR"); 661 GET_STR("SERVER_ADDR"); 662 663 RC(nxt_app_msg_read_str(task, rmsg, &host)); 664 665 if (host.length == 0) { 666 host = def_host; 667 } 668 669 colon = nxt_memchr(host.start, ':', host.length); 670 server_name = host; 671 672 if (colon != NULL) { 673 server_name.length = colon - host.start; 674 675 server_port.start = colon + 1; 676 server_port.length = host.length - server_name.length - 1; 677 678 } else { 679 server_port = def_port; 680 } 681 682 RC(nxt_perl_psgi_env_append_str(my_perl, hash_env, 683 "SERVER_NAME", &server_name)); 684 RC(nxt_perl_psgi_env_append_str(my_perl, hash_env, 685 "SERVER_PORT", &server_port)); 686 687 GET_STR("CONTENT_TYPE"); 688 GET_STR("CONTENT_LENGTH"); 689 690 for ( ;; ) { 691 rc = nxt_app_msg_read_str(task, rmsg, &str); 692 693 if (nxt_slow_path(rc != NXT_OK)) { 694 goto fail; 695 } 696 697 if (nxt_slow_path(str.length == 0)) { 698 break; 699 } 700 701 rc = nxt_app_msg_read_str(task, rmsg, &value); 702 703 if (nxt_slow_path(rc != NXT_OK)) { 704 break; 705 } 706 707 RC(nxt_perl_psgi_env_append_str(my_perl, hash_env, 708 (char *) str.start, &value)); 709 } 710 711 RC(nxt_app_msg_read_size(task, rmsg, body_preread_size)); 712 713 #undef GET_STR 714 #undef RC 715 716 return newRV_noinc((SV *) hash_env); 717 718 fail: 719 720 SvREFCNT_dec(hash_env); 721 722 return NULL; 723 } 724 725 726 static nxt_str_t 727 nxt_perl_psgi_result_status(PerlInterpreter *my_perl, SV *result) 728 { 729 SV **sv_status; 730 AV *array; 731 nxt_str_t status; 732 733 array = (AV *) SvRV(result); 734 sv_status = av_fetch(array, 0, 0); 735 736 status.start = (u_char *) SvPV(*sv_status, status.length); 737 738 return status; 739 } 740 741 742 static nxt_int_t 743 nxt_perl_psgi_result_head(PerlInterpreter *my_perl, SV *sv_head, 744 nxt_task_t *task, nxt_app_wmsg_t *wmsg) 745 { 746 AV *array_head; 747 SV **entry; 748 long i, array_len; 749 nxt_int_t rc; 750 nxt_str_t body; 751 752 if (nxt_slow_path(SvROK(sv_head) == 0 753 || SvTYPE(SvRV(sv_head)) != SVt_PVAV)) 754 { 755 nxt_log_error(NXT_LOG_ERR, task->log, 756 "PSGI: An unsupported format was received from " 757 "Perl Application for head part"); 758 759 return NXT_ERROR; 760 } 761 762 array_head = (AV *) SvRV(sv_head); 763 array_len = av_len(array_head); 764 765 if (array_len < 1) { 766 return NXT_OK; 767 } 768 769 if (nxt_slow_path((array_len % 2) == 0)) { 770 nxt_log_error(NXT_LOG_ERR, task->log, 771 "PSGI: Bad format for head from " 772 "Perl Application"); 773 774 return NXT_ERROR; 775 } 776 777 for (i = 0; i <= array_len; i++) { 778 entry = av_fetch(array_head, i, 0); 779 780 if (nxt_fast_path(entry == NULL)) { 781 nxt_log_error(NXT_LOG_ERR, task->log, 782 "PSGI: Failed to get head entry from " 783 "Perl Application"); 784 785 return NXT_ERROR; 786 } 787 788 body.start = (u_char *) SvPV(*entry, body.length); 789 790 rc = nxt_app_msg_write_raw(task, wmsg, 791 (u_char *) body.start, body.length); 792 793 if (nxt_slow_path(rc != NXT_OK)) { 794 nxt_log_error(NXT_LOG_ERR, task->log, 795 "PSGI: Failed to write head " 796 "from Perl Application"); 797 return rc; 798 } 799 800 if ((i % 2) == 0) { 801 rc = nxt_app_msg_write_raw(task, wmsg, 802 (u_char *) ": ", nxt_length(": ")); 803 } else { 804 rc = nxt_app_msg_write_raw(task, wmsg, 805 (u_char *) "\r\n", nxt_length("\r\n")); 806 } 807 808 if (nxt_slow_path(rc != NXT_OK)) { 809 nxt_log_error(NXT_LOG_ERR, task->log, 810 "PSGI: Failed to write head from " 811 "Perl Application"); 812 return rc; 813 } 814 } 815 816 return NXT_OK; 817 } 818 819 820 static nxt_int_t 821 nxt_perl_psgi_result_body(PerlInterpreter *my_perl, SV *sv_body, 822 nxt_task_t *task, nxt_app_wmsg_t *wmsg) 823 { 824 SV **entry; 825 AV *body_array; 826 long i; 827 nxt_int_t rc; 828 nxt_str_t body; 829 830 if (nxt_slow_path(SvROK(sv_body) == 0 831 || SvTYPE(SvRV(sv_body)) != SVt_PVAV)) 832 { 833 nxt_log_error(NXT_LOG_ERR, task->log, 834 "PSGI: An unsupported format was received from " 835 "Perl Application for a body part"); 836 837 return NXT_ERROR; 838 } 839 840 body_array = (AV *) SvRV(sv_body); 841 842 for (i = 0; i <= av_len(body_array); i++) { 843 844 entry = av_fetch(body_array, i, 0); 845 846 if (nxt_fast_path(entry == NULL)) { 847 nxt_log_error(NXT_LOG_ERR, task->log, 848 "PSGI: Failed to get body entry from " 849 "Perl Application"); 850 return NXT_ERROR; 851 } 852 853 body.start = (u_char *) SvPV(*entry, body.length); 854 855 if (body.length == 0) { 856 continue; 857 } 858 859 rc = nxt_app_msg_write_raw(task, wmsg, 860 (u_char *) body.start, body.length); 861 862 if (nxt_slow_path(rc != NXT_OK)) { 863 nxt_log_error(NXT_LOG_ERR, task->log, 864 "PSGI: Failed to write 'body' from " 865 "Perl Application"); 866 return rc; 867 } 868 869 rc = nxt_app_msg_flush(task, wmsg, 0); 870 871 if (nxt_slow_path(rc != NXT_OK)) { 872 nxt_log_error(NXT_LOG_ERR, task->log, 873 "PSGI: Failed to flush data for a 'body' " 874 "part from Perl Application"); 875 return rc; 876 } 877 } 878 879 return NXT_OK; 880 } 881 882 883 static nxt_int_t 884 nxt_perl_psgi_result_body_ref(PerlInterpreter *my_perl, SV *sv_body, 885 nxt_task_t *task, nxt_app_wmsg_t *wmsg) 886 { 887 IO *io; 888 PerlIO *fp; 889 SSize_t n; 890 nxt_int_t rc; 891 u_char vbuf[8192]; 892 893 io = GvIO(SvRV(sv_body)); 894 895 if (io == NULL) { 896 return NXT_OK; 897 } 898 899 fp = IoIFP(io); 900 901 for ( ;; ) { 902 n = PerlIO_read(fp, vbuf, 8192); 903 904 if (n < 1) { 905 break; 906 } 907 908 rc = nxt_app_msg_write_raw(task, wmsg, 909 (u_char *) vbuf, (size_t) n); 910 911 if (nxt_slow_path(rc != NXT_OK)) { 912 nxt_log_error(NXT_LOG_ERR, task->log, 913 "PSGI: Failed to write 'body' from " 914 "Perl Application"); 915 916 return rc; 917 } 918 919 rc = nxt_app_msg_flush(task, wmsg, 0); 920 921 if (nxt_slow_path(rc != NXT_OK)) { 922 nxt_log_error(NXT_LOG_ERR, task->log, 923 "PSGI: Failed to flush data for a body " 924 "part from Perl Application"); 925 926 return rc; 927 } 928 } 929 930 return NXT_OK; 931 } 932 933 934 static nxt_int_t 935 nxt_perl_psgi_result_array(PerlInterpreter *my_perl, SV *result, 936 nxt_task_t *task, nxt_app_wmsg_t *wmsg) 937 { 938 AV *array; 939 SV **sv_temp; 940 long array_len; 941 nxt_int_t rc; 942 nxt_str_t http_status; 943 944 array = (AV *) SvRV(result); 945 array_len = av_len(array); 946 947 if (nxt_slow_path(array_len < 0)) { 948 nxt_log_error(NXT_LOG_ERR, task->log, 949 "PSGI: Invalid result format from Perl Application"); 950 951 return NXT_ERROR; 952 } 953 954 http_status = nxt_perl_psgi_result_status(nxt_perl_psgi, result); 955 956 if (nxt_slow_path(http_status.start == NULL || http_status.length == 0)) { 957 nxt_log_error(NXT_LOG_ERR, task->log, 958 "PSGI: An unexpected status was received " 959 "from Perl Application"); 960 961 return NXT_ERROR; 962 } 963 964 rc = nxt_perl_psgi_http_write_status_str(task, wmsg, &http_status); 965 966 if (nxt_slow_path(rc != NXT_OK)) { 967 nxt_log_error(NXT_LOG_ERR, task->log, 968 "PSGI: Failed to write HTTP Status"); 969 970 return rc; 971 } 972 973 if (array_len < 1) { 974 rc = nxt_app_msg_write_raw(task, wmsg, 975 (u_char *) "\r\n", nxt_length("\r\n")); 976 977 if (nxt_slow_path(rc != NXT_OK)) { 978 nxt_log_error(NXT_LOG_ERR, task->log, 979 "PSGI: Failed to write HTTP Headers"); 980 981 return rc; 982 } 983 984 return NXT_OK; 985 } 986 987 sv_temp = av_fetch(array, 1, 0); 988 989 if (nxt_slow_path(sv_temp == NULL)) { 990 nxt_log_error(NXT_LOG_ERR, task->log, 991 "PSGI: Failed to get head from Perl ARRAY variable"); 992 993 return NXT_ERROR; 994 } 995 996 rc = nxt_perl_psgi_result_head(nxt_perl_psgi, *sv_temp, task, wmsg); 997 998 if (nxt_slow_path(rc != NXT_OK)) { 999 return rc; 1000 } 1001 1002 rc = nxt_app_msg_write_raw(task, wmsg, 1003 (u_char *) "\r\n", nxt_length("\r\n")); 1004 1005 if (nxt_slow_path(rc != NXT_OK)) { 1006 nxt_log_error(NXT_LOG_ERR, task->log, 1007 "PSGI: Failed to write HTTP Headers"); 1008 1009 return rc; 1010 } 1011 1012 if (nxt_fast_path(array_len < 2)) { 1013 return NXT_OK; 1014 } 1015 1016 sv_temp = av_fetch(array, 2, 0); 1017 1018 if (nxt_slow_path(sv_temp == NULL || SvROK(*sv_temp) == FALSE)) { 1019 nxt_log_error(NXT_LOG_ERR, task->log, 1020 "PSGI: Failed to get body from Perl ARRAY variable"); 1021 1022 return NXT_ERROR; 1023 } 1024 1025 if (SvTYPE(SvRV(*sv_temp)) == SVt_PVAV) { 1026 rc = nxt_perl_psgi_result_body(nxt_perl_psgi, *sv_temp, task, wmsg); 1027 1028 } else { 1029 rc = nxt_perl_psgi_result_body_ref(nxt_perl_psgi, *sv_temp, 1030 task, wmsg); 1031 } 1032 1033 if (nxt_slow_path(rc != NXT_OK)) { 1034 return rc; 1035 } 1036 1037 return NXT_OK; 1038 } 1039 1040 1041 static nxt_int_t 1042 nxt_perl_psgi_init(nxt_task_t *task, nxt_common_app_conf_t *conf) 1043 { 1044 PerlInterpreter *my_perl; 1045 1046 my_perl = nxt_perl_psgi_interpreter_init(task, conf->u.perl.script); 1047 1048 if (nxt_slow_path(my_perl == NULL)) { 1049 return NXT_ERROR; 1050 } 1051 1052 nxt_perl_psgi = my_perl; 1053 1054 return NXT_OK; 1055 } 1056 1057 1058 static nxt_int_t 1059 nxt_perl_psgi_run(nxt_task_t *task, nxt_app_rmsg_t *rmsg, nxt_app_wmsg_t *wmsg) 1060 { 1061 SV *env, *result; 1062 size_t body_preread_size; 1063 nxt_int_t rc; 1064 nxt_perl_psgi_input_t input; 1065 1066 dTHXa(nxt_perl_psgi); 1067 1068 /* 1069 * Create environ variable for perl sub "application". 1070 * > sub application { 1071 * > my ($environ) = @_; 1072 */ 1073 env = nxt_perl_psgi_env_create(nxt_perl_psgi, task, rmsg, 1074 &body_preread_size); 1075 1076 if (nxt_slow_path(env == NULL)) { 1077 nxt_log_error(NXT_LOG_ERR, task->log, 1078 "PSGI: Failed to create 'env' for Perl Application"); 1079 1080 return NXT_ERROR; 1081 } 1082 1083 input.my_perl = nxt_perl_psgi; 1084 input.task = task; 1085 input.rmsg = rmsg; 1086 input.wmsg = wmsg; 1087 input.body_preread_size = body_preread_size; 1088 1089 nxt_perl_psgi_arg_input.ctx = &input; 1090 nxt_perl_psgi_arg_error.ctx = &input; 1091 1092 /* Call perl sub and get result as SV*. */ 1093 result = nxt_perl_psgi_call_var_application(nxt_perl_psgi, env, task); 1094 1095 /* 1096 * We expect ARRAY ref like a 1097 * ['200', ['Content-Type' => "text/plain"], ["body"]] 1098 */ 1099 if (nxt_slow_path(SvOK(result) == 0 || SvROK(result) == 0 1100 || SvTYPE(SvRV(result)) != SVt_PVAV)) 1101 { 1102 nxt_log_error(NXT_LOG_ERR, task->log, 1103 "PSGI: An unexpected response was received from " 1104 "Perl Application"); 1105 goto fail; 1106 } 1107 1108 rc = nxt_perl_psgi_result_array(nxt_perl_psgi, result, task, wmsg); 1109 1110 if (nxt_slow_path(rc != NXT_OK)) { 1111 goto fail; 1112 } 1113 1114 rc = nxt_app_msg_flush(task, wmsg, 1); 1115 1116 if (nxt_slow_path(rc != NXT_OK)) { 1117 goto fail; 1118 } 1119 1120 SvREFCNT_dec(result); 1121 SvREFCNT_dec(env); 1122 1123 return NXT_OK; 1124 1125 fail: 1126 1127 SvREFCNT_dec(result); 1128 SvREFCNT_dec(env); 1129 1130 return NXT_ERROR; 1131 } 1132 1133 1134 static void 1135 nxt_perl_psgi_atexit(nxt_task_t *task) 1136 { 1137 dTHXa(nxt_perl_psgi); 1138 1139 nxt_perl_psgi_layer_stream_io_destroy(aTHX_ nxt_perl_psgi_arg_input.io); 1140 nxt_perl_psgi_layer_stream_fp_destroy(aTHX_ nxt_perl_psgi_arg_input.fp); 1141 1142 nxt_perl_psgi_layer_stream_io_destroy(aTHX_ nxt_perl_psgi_arg_error.io); 1143 nxt_perl_psgi_layer_stream_fp_destroy(aTHX_ nxt_perl_psgi_arg_error.fp); 1144 1145 perl_destruct(nxt_perl_psgi); 1146 perl_free(nxt_perl_psgi); 1147 PERL_SYS_TERM(); 1148 } 1149