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