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