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 nxt_string(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: ", (sizeof("Status: ") - 1), 0); 162 RC_WRT(http_status->start, http_status->length, 0); 163 RC_WRT((u_char *) "\r\n", (sizeof("\r\n") - 1), 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_log_error(NXT_LOG_CRIT, task->log, 441 "PSGI: Failed to allocate memory for Perl interpreter"); 442 return NULL; 443 } 444 445 run_module = NULL; 446 447 perl_construct(my_perl); 448 PERL_SET_CONTEXT(my_perl); 449 450 status = perl_parse(my_perl, nxt_perl_psgi_xs_init, 3, embedding, NULL); 451 452 if (nxt_slow_path(status != 0)) { 453 nxt_log_error(NXT_LOG_CRIT, task->log, 454 "PSGI: Failed to parse Perl Script"); 455 goto fail; 456 } 457 458 PL_exit_flags |= PERL_EXIT_DESTRUCT_END; 459 PL_origalen = 1; 460 461 status = perl_run(my_perl); 462 463 if (nxt_slow_path(status != 0)) { 464 nxt_log_error(NXT_LOG_CRIT, task->log, 465 "PSGI: Failed to run Perl"); 466 goto fail; 467 } 468 469 sv_setsv(get_sv("0", 0), newSVpv(script, 0)); 470 471 run_module = nxt_perl_psgi_module_create(task, script); 472 473 if (nxt_slow_path(run_module == NULL)) { 474 goto fail; 475 } 476 477 status = nxt_perl_psgi_io_input_init(my_perl, &nxt_perl_psgi_arg_input); 478 479 if (nxt_slow_path(status != NXT_OK)) { 480 nxt_log_error(NXT_LOG_CRIT, task->log, 481 "PSGI: Failed to init io.psgi.input"); 482 goto fail; 483 } 484 485 status = nxt_perl_psgi_io_error_init(my_perl, &nxt_perl_psgi_arg_error); 486 487 if (nxt_slow_path(status != NXT_OK)) { 488 nxt_log_error(NXT_LOG_CRIT, task->log, 489 "PSGI: Failed to init io.psgi.errors"); 490 goto fail; 491 } 492 493 nxt_perl_psgi_app = eval_pv((const char *) run_module, FALSE); 494 495 if (SvTRUE(ERRSV)) { 496 nxt_log_emerg(task->log, "PSGI: Failed to parse script: %s\n%s", 497 script, SvPV_nolen(ERRSV)); 498 goto fail; 499 } 500 501 nxt_free(run_module); 502 503 return my_perl; 504 505 fail: 506 507 if (run_module != NULL) { 508 nxt_free(run_module); 509 } 510 511 perl_destruct(my_perl); 512 perl_free(my_perl); 513 PERL_SYS_TERM(); 514 515 return NULL; 516 } 517 518 519 nxt_inline nxt_int_t 520 nxt_perl_psgi_env_append_str(PerlInterpreter *my_perl, HV *hash_env, 521 const char *name, nxt_str_t *str) 522 { 523 SV **ha; 524 525 ha = hv_store(hash_env, name, (I32) strlen(name), 526 newSVpv((const char *) str->start, (STRLEN)str->length), 0); 527 528 if (nxt_slow_path(ha == NULL)) { 529 return NXT_ERROR; 530 } 531 532 return NXT_OK; 533 } 534 535 536 nxt_inline nxt_int_t 537 nxt_perl_psgi_env_append(PerlInterpreter *my_perl, HV *hash_env, 538 const char *name, void *value) 539 { 540 SV **ha; 541 542 ha = hv_store(hash_env, name, (I32) strlen(name), value, 0); 543 544 if (nxt_slow_path(ha == NULL)) { 545 return NXT_ERROR; 546 } 547 548 return NXT_OK; 549 } 550 551 552 nxt_inline nxt_int_t 553 nxt_perl_psgi_read_add_env(PerlInterpreter *my_perl, nxt_task_t *task, 554 nxt_app_rmsg_t *rmsg, HV *hash_env, 555 const char *name, nxt_str_t *str) 556 { 557 nxt_int_t rc; 558 559 rc = nxt_app_msg_read_str(task, rmsg, str); 560 561 if (nxt_slow_path(rc != NXT_OK)) { 562 return rc; 563 } 564 565 if (str->start == NULL) { 566 return NXT_OK; 567 } 568 569 return nxt_perl_psgi_env_append_str(my_perl, hash_env, name, str); 570 } 571 572 573 static SV * 574 nxt_perl_psgi_env_create(PerlInterpreter *my_perl, nxt_task_t *task, 575 nxt_app_rmsg_t *rmsg, size_t *body_preread_size) 576 { 577 HV *hash_env; 578 AV *array_version; 579 u_char *colon; 580 size_t query_size; 581 nxt_int_t rc; 582 nxt_str_t str, value, path, target; 583 nxt_str_t host, server_name, server_port; 584 585 static nxt_str_t def_host = nxt_string("localhost"); 586 static nxt_str_t def_port = nxt_string("80"); 587 588 hash_env = newHV(); 589 590 if (nxt_slow_path(hash_env == NULL)) { 591 return NULL; 592 } 593 594 #define RC(FNS) \ 595 do { \ 596 if (nxt_slow_path((FNS) != NXT_OK)) \ 597 goto fail; \ 598 } while (0) 599 600 #define GET_STR(ATTR) \ 601 RC(nxt_perl_psgi_read_add_env(my_perl, task, rmsg, \ 602 hash_env, ATTR, &str)) 603 604 GET_STR("REQUEST_METHOD"); 605 GET_STR("REQUEST_URI"); 606 607 target = str; 608 609 RC(nxt_app_msg_read_str(task, rmsg, &path)); 610 RC(nxt_app_msg_read_size(task, rmsg, &query_size)); 611 612 if (path.start == NULL || path.length == 0) { 613 path = target; 614 } 615 616 array_version = newAV(); 617 618 if (nxt_slow_path(array_version == NULL)) { 619 goto fail; 620 } 621 622 av_push(array_version, newSViv(1)); 623 av_push(array_version, newSViv(1)); 624 625 RC(nxt_perl_psgi_env_append_str(my_perl, hash_env, "PATH_INFO", 626 &path)); 627 RC(nxt_perl_psgi_env_append(my_perl, hash_env, "SCRIPT_NAME", 628 newSVpv("", 0))); 629 RC(nxt_perl_psgi_env_append(my_perl, hash_env, "psgi.run_once", 630 newSVpv("", 0))); 631 RC(nxt_perl_psgi_env_append(my_perl, hash_env, "psgi.streaming", 632 newSViv(0))); 633 RC(nxt_perl_psgi_env_append(my_perl, hash_env, "psgi.nonblocking", 634 newSVpv("", 0))); 635 RC(nxt_perl_psgi_env_append(my_perl, hash_env, "psgi.multithread", 636 newSVpv("", 0))); 637 RC(nxt_perl_psgi_env_append(my_perl, hash_env, "psgi.multiprocess", 638 newSVpv("", 0))); 639 RC(nxt_perl_psgi_env_append(my_perl, hash_env, "psgi.url_scheme", 640 newSVpv("http", 4))); 641 RC(nxt_perl_psgi_env_append(my_perl, hash_env, "psgi.input", 642 SvREFCNT_inc(nxt_perl_psgi_arg_input.io))); 643 RC(nxt_perl_psgi_env_append(my_perl, hash_env, "psgi.errors", 644 SvREFCNT_inc(nxt_perl_psgi_arg_error.io))); 645 RC(nxt_perl_psgi_env_append(my_perl, hash_env, "psgi.version", 646 newRV_noinc((SV *) array_version))); 647 648 if (query_size > 0) { 649 query_size--; 650 651 if (nxt_slow_path(target.length < query_size)) { 652 goto fail; 653 } 654 655 str.start = &target.start[query_size]; 656 str.length = target.length - query_size; 657 658 RC(nxt_perl_psgi_env_append_str(my_perl, hash_env, 659 "QUERY_STRING", &str)); 660 } 661 662 GET_STR("SERVER_PROTOCOL"); 663 GET_STR("REMOTE_ADDR"); 664 GET_STR("SERVER_ADDR"); 665 666 RC(nxt_app_msg_read_str(task, rmsg, &host)); 667 668 if (host.length == 0) { 669 host = def_host; 670 } 671 672 colon = nxt_memchr(host.start, ':', host.length); 673 server_name = host; 674 675 if (colon != NULL) { 676 server_name.length = colon - host.start; 677 678 server_port.start = colon + 1; 679 server_port.length = host.length - server_name.length - 1; 680 681 } else { 682 server_port = def_port; 683 } 684 685 RC(nxt_perl_psgi_env_append_str(my_perl, hash_env, 686 "SERVER_NAME", &server_name)); 687 RC(nxt_perl_psgi_env_append_str(my_perl, hash_env, 688 "SERVER_PORT", &server_port)); 689 690 GET_STR("CONTENT_TYPE"); 691 GET_STR("CONTENT_LENGTH"); 692 693 for ( ;; ) { 694 rc = nxt_app_msg_read_str(task, rmsg, &str); 695 696 if (nxt_slow_path(rc != NXT_OK)) { 697 goto fail; 698 } 699 700 if (nxt_slow_path(str.length == 0)) { 701 break; 702 } 703 704 rc = nxt_app_msg_read_str(task, rmsg, &value); 705 706 if (nxt_slow_path(rc != NXT_OK)) { 707 break; 708 } 709 710 RC(nxt_perl_psgi_env_append_str(my_perl, hash_env, 711 (char *) str.start, &value)); 712 } 713 714 RC(nxt_app_msg_read_size(task, rmsg, body_preread_size)); 715 716 #undef GET_STR 717 #undef RC 718 719 return newRV_noinc((SV *) hash_env); 720 721 fail: 722 723 SvREFCNT_dec(hash_env); 724 725 return NULL; 726 } 727 728 729 static nxt_str_t 730 nxt_perl_psgi_result_status(PerlInterpreter *my_perl, SV *result) 731 { 732 SV **sv_status; 733 AV *array; 734 nxt_str_t status; 735 736 array = (AV *) SvRV(result); 737 sv_status = av_fetch(array, 0, 0); 738 739 status.start = (u_char *) SvPV(*sv_status, status.length); 740 741 return status; 742 } 743 744 745 static nxt_int_t 746 nxt_perl_psgi_result_head(PerlInterpreter *my_perl, SV *sv_head, 747 nxt_task_t *task, nxt_app_wmsg_t *wmsg) 748 { 749 AV *array_head; 750 SV **entry; 751 long i, array_len; 752 nxt_int_t rc; 753 nxt_str_t body; 754 755 if (nxt_slow_path(SvROK(sv_head) == 0 756 || SvTYPE(SvRV(sv_head)) != SVt_PVAV)) 757 { 758 nxt_log_error(NXT_LOG_ERR, task->log, 759 "PSGI: An unsupported format was received from " 760 "Perl Application for head part"); 761 762 return NXT_ERROR; 763 } 764 765 array_head = (AV *) SvRV(sv_head); 766 array_len = av_len(array_head); 767 768 if (array_len < 1) { 769 return NXT_OK; 770 } 771 772 if (nxt_slow_path((array_len % 2) == 0)) { 773 nxt_log_error(NXT_LOG_ERR, task->log, 774 "PSGI: Bad format for head from " 775 "Perl Application"); 776 777 return NXT_ERROR; 778 } 779 780 for (i = 0; i <= array_len; i++) { 781 entry = av_fetch(array_head, i, 0); 782 783 if (nxt_fast_path(entry == NULL)) { 784 nxt_log_error(NXT_LOG_ERR, task->log, 785 "PSGI: Failed to get head entry from " 786 "Perl Application"); 787 788 return NXT_ERROR; 789 } 790 791 body.start = (u_char *) SvPV(*entry, body.length); 792 793 rc = nxt_app_msg_write_raw(task, wmsg, 794 (u_char *) body.start, body.length); 795 796 if (nxt_slow_path(rc != NXT_OK)) { 797 nxt_log_error(NXT_LOG_ERR, task->log, 798 "PSGI: Failed to write head " 799 "from Perl Application"); 800 return rc; 801 } 802 803 if ((i % 2) == 0) { 804 rc = nxt_app_msg_write_raw(task, wmsg, 805 (u_char *) ": ", 806 (sizeof(": ") - 1)); 807 } else { 808 rc = nxt_app_msg_write_raw(task, wmsg, 809 (u_char *) "\r\n", 810 (sizeof("\r\n") - 1)); 811 } 812 813 if (nxt_slow_path(rc != NXT_OK)) { 814 nxt_log_error(NXT_LOG_ERR, task->log, 815 "PSGI: Failed to write head from " 816 "Perl Application"); 817 return rc; 818 } 819 } 820 821 return NXT_OK; 822 } 823 824 825 static nxt_int_t 826 nxt_perl_psgi_result_body(PerlInterpreter *my_perl, SV *sv_body, 827 nxt_task_t *task, nxt_app_wmsg_t *wmsg) 828 { 829 SV **entry; 830 AV *body_array; 831 long i; 832 nxt_int_t rc; 833 nxt_str_t body; 834 835 if (nxt_slow_path(SvROK(sv_body) == 0 836 || SvTYPE(SvRV(sv_body)) != SVt_PVAV)) 837 { 838 nxt_log_error(NXT_LOG_ERR, task->log, 839 "PSGI: An unsupported format was received from " 840 "Perl Application for a body part"); 841 842 return NXT_ERROR; 843 } 844 845 body_array = (AV *) SvRV(sv_body); 846 847 for (i = 0; i <= av_len(body_array); i++) { 848 849 entry = av_fetch(body_array, i, 0); 850 851 if (nxt_fast_path(entry == NULL)) { 852 nxt_log_error(NXT_LOG_ERR, task->log, 853 "PSGI: Failed to get body entry from " 854 "Perl Application"); 855 return NXT_ERROR; 856 } 857 858 body.start = (u_char *) SvPV(*entry, body.length); 859 860 if (body.length == 0) { 861 continue; 862 } 863 864 rc = nxt_app_msg_write_raw(task, wmsg, 865 (u_char *) body.start, body.length); 866 867 if (nxt_slow_path(rc != NXT_OK)) { 868 nxt_log_error(NXT_LOG_ERR, task->log, 869 "PSGI: Failed to write 'body' from " 870 "Perl Application"); 871 return rc; 872 } 873 874 rc = nxt_app_msg_flush(task, wmsg, 0); 875 876 if (nxt_slow_path(rc != NXT_OK)) { 877 nxt_log_error(NXT_LOG_ERR, task->log, 878 "PSGI: Failed to flush data for a 'body' " 879 "part from Perl Application"); 880 return rc; 881 } 882 } 883 884 return NXT_OK; 885 } 886 887 888 static nxt_int_t 889 nxt_perl_psgi_result_body_ref(PerlInterpreter *my_perl, SV *sv_body, 890 nxt_task_t *task, nxt_app_wmsg_t *wmsg) 891 { 892 IO *io; 893 PerlIO *fp; 894 SSize_t n; 895 nxt_int_t rc; 896 u_char vbuf[8192]; 897 898 io = GvIO(SvRV(sv_body)); 899 900 if (io == NULL) { 901 return NXT_OK; 902 } 903 904 fp = IoIFP(io); 905 906 for ( ;; ) { 907 n = PerlIO_read(fp, vbuf, 8192); 908 909 if (n < 1) { 910 break; 911 } 912 913 rc = nxt_app_msg_write_raw(task, wmsg, 914 (u_char *) vbuf, (size_t) n); 915 916 if (nxt_slow_path(rc != NXT_OK)) { 917 nxt_log_error(NXT_LOG_ERR, task->log, 918 "PSGI: Failed to write 'body' from " 919 "Perl Application"); 920 921 return rc; 922 } 923 924 rc = nxt_app_msg_flush(task, wmsg, 0); 925 926 if (nxt_slow_path(rc != NXT_OK)) { 927 nxt_log_error(NXT_LOG_ERR, task->log, 928 "PSGI: Failed to flush data for a body " 929 "part from Perl Application"); 930 931 return rc; 932 } 933 } 934 935 return NXT_OK; 936 } 937 938 939 static nxt_int_t 940 nxt_perl_psgi_result_array(PerlInterpreter *my_perl, SV *result, 941 nxt_task_t *task, nxt_app_wmsg_t *wmsg) 942 { 943 AV *array; 944 SV **sv_temp; 945 long array_len; 946 nxt_int_t rc; 947 nxt_str_t http_status; 948 949 array = (AV *) SvRV(result); 950 array_len = av_len(array); 951 952 if (nxt_slow_path(array_len < 0)) { 953 nxt_log_error(NXT_LOG_ERR, task->log, 954 "PSGI: Invalid result format from Perl Application"); 955 956 return NXT_ERROR; 957 } 958 959 http_status = nxt_perl_psgi_result_status(nxt_perl_psgi, result); 960 961 if (nxt_slow_path(http_status.start == NULL || http_status.length == 0)) { 962 nxt_log_error(NXT_LOG_ERR, task->log, 963 "PSGI: An unexpected status was received " 964 "from Perl Application"); 965 966 return NXT_ERROR; 967 } 968 969 rc = nxt_perl_psgi_http_write_status_str(task, wmsg, &http_status); 970 971 if (nxt_slow_path(rc != NXT_OK)) { 972 nxt_log_error(NXT_LOG_ERR, task->log, 973 "PSGI: Failed to write HTTP Status"); 974 975 return rc; 976 } 977 978 if (array_len < 1) { 979 rc = nxt_app_msg_write_raw(task, wmsg, (u_char *) "\r\n", 980 (sizeof("\r\n") - 1)); 981 982 if (nxt_slow_path(rc != NXT_OK)) { 983 nxt_log_error(NXT_LOG_ERR, task->log, 984 "PSGI: Failed to write HTTP Headers"); 985 986 return rc; 987 } 988 989 return NXT_OK; 990 } 991 992 sv_temp = av_fetch(array, 1, 0); 993 994 if (nxt_slow_path(sv_temp == NULL)) { 995 nxt_log_error(NXT_LOG_ERR, task->log, 996 "PSGI: Failed to get head from Perl ARRAY variable"); 997 998 return NXT_ERROR; 999 } 1000 1001 rc = nxt_perl_psgi_result_head(nxt_perl_psgi, *sv_temp, task, wmsg); 1002 1003 if (nxt_slow_path(rc != NXT_OK)) { 1004 return rc; 1005 } 1006 1007 rc = nxt_app_msg_write_raw(task, wmsg, (u_char *) "\r\n", 1008 (sizeof("\r\n") - 1)); 1009 1010 if (nxt_slow_path(rc != NXT_OK)) { 1011 nxt_log_error(NXT_LOG_ERR, task->log, 1012 "PSGI: Failed to write HTTP Headers"); 1013 1014 return rc; 1015 } 1016 1017 if (nxt_fast_path(array_len < 2)) { 1018 return NXT_OK; 1019 } 1020 1021 sv_temp = av_fetch(array, 2, 0); 1022 1023 if (nxt_slow_path(sv_temp == NULL || SvROK(*sv_temp) == FALSE)) { 1024 nxt_log_error(NXT_LOG_ERR, task->log, 1025 "PSGI: Failed to get body from Perl ARRAY variable"); 1026 1027 return NXT_ERROR; 1028 } 1029 1030 if (SvTYPE(SvRV(*sv_temp)) == SVt_PVAV) { 1031 rc = nxt_perl_psgi_result_body(nxt_perl_psgi, *sv_temp, task, wmsg); 1032 1033 } else { 1034 rc = nxt_perl_psgi_result_body_ref(nxt_perl_psgi, *sv_temp, 1035 task, wmsg); 1036 } 1037 1038 if (nxt_slow_path(rc != NXT_OK)) { 1039 return rc; 1040 } 1041 1042 return NXT_OK; 1043 } 1044 1045 1046 static nxt_int_t 1047 nxt_perl_psgi_init(nxt_task_t *task, nxt_common_app_conf_t *conf) 1048 { 1049 PerlInterpreter *my_perl; 1050 1051 my_perl = nxt_perl_psgi_interpreter_init(task, conf->u.perl.script); 1052 1053 if (nxt_slow_path(my_perl == NULL)) { 1054 return NXT_ERROR; 1055 } 1056 1057 nxt_perl_psgi = my_perl; 1058 1059 return NXT_OK; 1060 } 1061 1062 1063 static nxt_int_t 1064 nxt_perl_psgi_run(nxt_task_t *task, nxt_app_rmsg_t *rmsg, nxt_app_wmsg_t *wmsg) 1065 { 1066 SV *env, *result; 1067 size_t body_preread_size; 1068 nxt_int_t rc; 1069 nxt_perl_psgi_input_t input; 1070 1071 dTHXa(nxt_perl_psgi); 1072 1073 /* 1074 * Create environ variable for perl sub "application". 1075 * > sub application { 1076 * > my ($environ) = @_; 1077 */ 1078 env = nxt_perl_psgi_env_create(nxt_perl_psgi, task, rmsg, 1079 &body_preread_size); 1080 1081 if (nxt_slow_path(env == NULL)) { 1082 nxt_log_error(NXT_LOG_ERR, task->log, 1083 "PSGI: Failed to create 'env' for Perl Application"); 1084 1085 return NXT_ERROR; 1086 } 1087 1088 input.my_perl = nxt_perl_psgi; 1089 input.task = task; 1090 input.rmsg = rmsg; 1091 input.wmsg = wmsg; 1092 input.body_preread_size = body_preread_size; 1093 1094 nxt_perl_psgi_arg_input.ctx = &input; 1095 nxt_perl_psgi_arg_error.ctx = &input; 1096 1097 /* Call perl sub and get result as SV*. */ 1098 result = nxt_perl_psgi_call_var_application(nxt_perl_psgi, env, task); 1099 1100 /* 1101 * We expect ARRAY ref like a 1102 * ['200', ['Content-Type' => "text/plain"], ["body"]] 1103 */ 1104 if (nxt_slow_path(SvOK(result) == 0 || SvROK(result) == 0 1105 || SvTYPE(SvRV(result)) != SVt_PVAV)) 1106 { 1107 nxt_log_error(NXT_LOG_ERR, task->log, 1108 "PSGI: An unexpected response was received from " 1109 "Perl Application"); 1110 goto fail; 1111 } 1112 1113 rc = nxt_perl_psgi_result_array(nxt_perl_psgi, result, task, wmsg); 1114 1115 if (nxt_slow_path(rc != NXT_OK)) { 1116 goto fail; 1117 } 1118 1119 rc = nxt_app_msg_flush(task, wmsg, 1); 1120 1121 if (nxt_slow_path(rc != NXT_OK)) { 1122 goto fail; 1123 } 1124 1125 SvREFCNT_dec(result); 1126 SvREFCNT_dec(env); 1127 1128 return NXT_OK; 1129 1130 fail: 1131 1132 SvREFCNT_dec(result); 1133 SvREFCNT_dec(env); 1134 1135 return NXT_ERROR; 1136 } 1137 1138 1139 static void 1140 nxt_perl_psgi_atexit(nxt_task_t *task) 1141 { 1142 dTHXa(nxt_perl_psgi); 1143 1144 nxt_perl_psgi_layer_stream_io_destroy(aTHX_ nxt_perl_psgi_arg_input.io); 1145 nxt_perl_psgi_layer_stream_fp_destroy(aTHX_ nxt_perl_psgi_arg_input.fp); 1146 1147 nxt_perl_psgi_layer_stream_io_destroy(aTHX_ nxt_perl_psgi_arg_error.io); 1148 nxt_perl_psgi_layer_stream_fp_destroy(aTHX_ nxt_perl_psgi_arg_error.fp); 1149 1150 perl_destruct(nxt_perl_psgi); 1151 perl_free(nxt_perl_psgi); 1152 PERL_SYS_TERM(); 1153 } 1154