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 16typedef 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 27nxt_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 31nxt_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 34static long nxt_perl_psgi_io_input_read(PerlInterpreter *my_perl, 35 nxt_perl_psgi_io_arg_t *arg, void *vbuf, size_t length); 36static long nxt_perl_psgi_io_input_write(PerlInterpreter *my_perl, 37 nxt_perl_psgi_io_arg_t *arg, const void *vbuf, size_t length); 38static long nxt_perl_psgi_io_input_flush(PerlInterpreter *my_perl, 39 nxt_perl_psgi_io_arg_t *arg); 40 41static long nxt_perl_psgi_io_error_read(PerlInterpreter *my_perl, 42 nxt_perl_psgi_io_arg_t *arg, void *vbuf, size_t length); 43static long nxt_perl_psgi_io_error_write(PerlInterpreter *my_perl, 44 nxt_perl_psgi_io_arg_t *arg, const void *vbuf, size_t length); 45static long nxt_perl_psgi_io_error_flush(PerlInterpreter *my_perl, 46 nxt_perl_psgi_io_arg_t *arg); 47 48/* 49static void nxt_perl_psgi_xs_core_global_changes(PerlInterpreter *my_perl, 50 const char *core, const char *sub, XSUBADDR_t sub_addr); 51*/ 52 53static void nxt_perl_psgi_xs_init(pTHX); 54 55static SV *nxt_perl_psgi_call_var_application(PerlInterpreter *my_perl, 56 SV *env, nxt_task_t *task); 57 58/* For currect load XS modules */ 59EXTERN_C void boot_DynaLoader(pTHX_ CV *cv); 60 61static nxt_int_t nxt_perl_psgi_io_input_init(PerlInterpreter *my_perl, 62 nxt_perl_psgi_io_arg_t *arg); 63static nxt_int_t nxt_perl_psgi_io_error_init(PerlInterpreter *my_perl, 64 nxt_perl_psgi_io_arg_t *arg); 65 66static PerlInterpreter *nxt_perl_psgi_interpreter_init(nxt_task_t *task, 67 char *script); 68 69nxt_inline nxt_int_t nxt_perl_psgi_env_append_str(PerlInterpreter *my_perl, 70 HV *hash_env, const char *name, nxt_str_t *str); 71nxt_inline nxt_int_t nxt_perl_psgi_env_append(PerlInterpreter *my_perl, 72 HV *hash_env, const char *name, void *value); 73 74static 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 77nxt_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 81static u_char *nxt_perl_psgi_module_create(nxt_task_t *task, 82 const char *script); 83 84static nxt_str_t nxt_perl_psgi_result_status(PerlInterpreter *my_perl, 85 SV *result); 86static nxt_int_t nxt_perl_psgi_result_head(PerlInterpreter *my_perl, 87 SV *sv_head, nxt_task_t *task, nxt_app_wmsg_t *wmsg); 88static nxt_int_t nxt_perl_psgi_result_body(PerlInterpreter *my_perl, 89 SV *result, nxt_task_t *task, nxt_app_wmsg_t *wmsg); 90static 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); 92static nxt_int_t nxt_perl_psgi_result_array(PerlInterpreter *my_perl, 93 SV *result, nxt_task_t *task, nxt_app_wmsg_t *wmsg); 94 95static nxt_int_t nxt_perl_psgi_init(nxt_task_t *task, 96 nxt_common_app_conf_t *conf); 97static nxt_int_t nxt_perl_psgi_run(nxt_task_t *task, 98 nxt_app_rmsg_t *rmsg, nxt_app_wmsg_t *wmsg); 99static void nxt_perl_psgi_atexit(nxt_task_t *task); 100 101typedef SV *(*nxt_perl_psgi_callback_f)(PerlInterpreter *my_perl, 102 SV *env, nxt_task_t *task); 103 104static SV *nxt_perl_psgi_app; 105static PerlInterpreter *nxt_perl_psgi; 106static nxt_perl_psgi_io_arg_t nxt_perl_psgi_arg_input, nxt_perl_psgi_arg_error; 107 108static uint32_t nxt_perl_psgi_compat[] = { 109 NXT_VERNUM, NXT_DEBUG, 110}; 111 112NXT_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 123nxt_inline nxt_int_t 124nxt_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 144nxt_inline nxt_int_t 145nxt_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 171static long 172nxt_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 194static long 195nxt_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 202static long 203nxt_perl_psgi_io_input_flush(PerlInterpreter *my_perl, 204 nxt_perl_psgi_io_arg_t *arg) 205{ 206 return 0; 207} 208 209 210static long 211nxt_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 218static long 219nxt_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 231static long 232nxt_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/* 241static void 242nxt_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 261XS(XS_NGINX__Unit__PSGI_exit); 262XS(XS_NGINX__Unit__PSGI_exit) 263{ 264 I32 ax = POPMARK; 265 Perl_croak(aTHX_ (char *) NULL); 266 XSRETURN_EMPTY; 267} 268 269 270static void 271nxt_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 285static SV * 286nxt_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 321static u_char * 322nxt_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 360static nxt_int_t 361nxt_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 390static nxt_int_t 391nxt_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 420static PerlInterpreter * 421nxt_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 505fail: 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 519nxt_inline nxt_int_t 520nxt_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 536nxt_inline nxt_int_t 537nxt_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 552nxt_inline nxt_int_t 553nxt_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 573static SV * 574nxt_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 721fail: 722 723 SvREFCNT_dec(hash_env); 724 725 return NULL; 726} 727 728 729static nxt_str_t 730nxt_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 745static nxt_int_t 746nxt_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 825static nxt_int_t 826nxt_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 888static nxt_int_t 889nxt_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));
| 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 16typedef 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 27nxt_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 31nxt_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 34static long nxt_perl_psgi_io_input_read(PerlInterpreter *my_perl, 35 nxt_perl_psgi_io_arg_t *arg, void *vbuf, size_t length); 36static long nxt_perl_psgi_io_input_write(PerlInterpreter *my_perl, 37 nxt_perl_psgi_io_arg_t *arg, const void *vbuf, size_t length); 38static long nxt_perl_psgi_io_input_flush(PerlInterpreter *my_perl, 39 nxt_perl_psgi_io_arg_t *arg); 40 41static long nxt_perl_psgi_io_error_read(PerlInterpreter *my_perl, 42 nxt_perl_psgi_io_arg_t *arg, void *vbuf, size_t length); 43static long nxt_perl_psgi_io_error_write(PerlInterpreter *my_perl, 44 nxt_perl_psgi_io_arg_t *arg, const void *vbuf, size_t length); 45static long nxt_perl_psgi_io_error_flush(PerlInterpreter *my_perl, 46 nxt_perl_psgi_io_arg_t *arg); 47 48/* 49static void nxt_perl_psgi_xs_core_global_changes(PerlInterpreter *my_perl, 50 const char *core, const char *sub, XSUBADDR_t sub_addr); 51*/ 52 53static void nxt_perl_psgi_xs_init(pTHX); 54 55static SV *nxt_perl_psgi_call_var_application(PerlInterpreter *my_perl, 56 SV *env, nxt_task_t *task); 57 58/* For currect load XS modules */ 59EXTERN_C void boot_DynaLoader(pTHX_ CV *cv); 60 61static nxt_int_t nxt_perl_psgi_io_input_init(PerlInterpreter *my_perl, 62 nxt_perl_psgi_io_arg_t *arg); 63static nxt_int_t nxt_perl_psgi_io_error_init(PerlInterpreter *my_perl, 64 nxt_perl_psgi_io_arg_t *arg); 65 66static PerlInterpreter *nxt_perl_psgi_interpreter_init(nxt_task_t *task, 67 char *script); 68 69nxt_inline nxt_int_t nxt_perl_psgi_env_append_str(PerlInterpreter *my_perl, 70 HV *hash_env, const char *name, nxt_str_t *str); 71nxt_inline nxt_int_t nxt_perl_psgi_env_append(PerlInterpreter *my_perl, 72 HV *hash_env, const char *name, void *value); 73 74static 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 77nxt_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 81static u_char *nxt_perl_psgi_module_create(nxt_task_t *task, 82 const char *script); 83 84static nxt_str_t nxt_perl_psgi_result_status(PerlInterpreter *my_perl, 85 SV *result); 86static nxt_int_t nxt_perl_psgi_result_head(PerlInterpreter *my_perl, 87 SV *sv_head, nxt_task_t *task, nxt_app_wmsg_t *wmsg); 88static nxt_int_t nxt_perl_psgi_result_body(PerlInterpreter *my_perl, 89 SV *result, nxt_task_t *task, nxt_app_wmsg_t *wmsg); 90static 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); 92static nxt_int_t nxt_perl_psgi_result_array(PerlInterpreter *my_perl, 93 SV *result, nxt_task_t *task, nxt_app_wmsg_t *wmsg); 94 95static nxt_int_t nxt_perl_psgi_init(nxt_task_t *task, 96 nxt_common_app_conf_t *conf); 97static nxt_int_t nxt_perl_psgi_run(nxt_task_t *task, 98 nxt_app_rmsg_t *rmsg, nxt_app_wmsg_t *wmsg); 99static void nxt_perl_psgi_atexit(nxt_task_t *task); 100 101typedef SV *(*nxt_perl_psgi_callback_f)(PerlInterpreter *my_perl, 102 SV *env, nxt_task_t *task); 103 104static SV *nxt_perl_psgi_app; 105static PerlInterpreter *nxt_perl_psgi; 106static nxt_perl_psgi_io_arg_t nxt_perl_psgi_arg_input, nxt_perl_psgi_arg_error; 107 108static uint32_t nxt_perl_psgi_compat[] = { 109 NXT_VERNUM, NXT_DEBUG, 110}; 111 112NXT_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 123nxt_inline nxt_int_t 124nxt_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 144nxt_inline nxt_int_t 145nxt_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 171static long 172nxt_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 194static long 195nxt_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 202static long 203nxt_perl_psgi_io_input_flush(PerlInterpreter *my_perl, 204 nxt_perl_psgi_io_arg_t *arg) 205{ 206 return 0; 207} 208 209 210static long 211nxt_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 218static long 219nxt_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 231static long 232nxt_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/* 241static void 242nxt_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 261XS(XS_NGINX__Unit__PSGI_exit); 262XS(XS_NGINX__Unit__PSGI_exit) 263{ 264 I32 ax = POPMARK; 265 Perl_croak(aTHX_ (char *) NULL); 266 XSRETURN_EMPTY; 267} 268 269 270static void 271nxt_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 285static SV * 286nxt_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 321static u_char * 322nxt_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 360static nxt_int_t 361nxt_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 390static nxt_int_t 391nxt_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 420static PerlInterpreter * 421nxt_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 505fail: 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 519nxt_inline nxt_int_t 520nxt_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 536nxt_inline nxt_int_t 537nxt_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 552nxt_inline nxt_int_t 553nxt_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 573static SV * 574nxt_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 721fail: 722 723 SvREFCNT_dec(hash_env); 724 725 return NULL; 726} 727 728 729static nxt_str_t 730nxt_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 745static nxt_int_t 746nxt_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 825static nxt_int_t 826nxt_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 888static nxt_int_t 889nxt_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));
|