nxt_perl_psgi.c (1980:43553aa72111) nxt_perl_psgi.c (2060:a1991578c62e)
1
2/*
3 * Copyright (C) Alexander Borisov
4 * Copyright (C) NGINX, Inc.
5 */
6
7#include <perl/nxt_perl_psgi_layer.h>
8

--- 14 unchanged lines hidden (view full) ---

23 SV *app;
24 CV *cb;
25 nxt_unit_request_info_t *req;
26 pthread_t thread;
27 nxt_unit_ctx_t *ctx;
28} nxt_perl_psgi_ctx_t;
29
30
1
2/*
3 * Copyright (C) Alexander Borisov
4 * Copyright (C) NGINX, Inc.
5 */
6
7#include <perl/nxt_perl_psgi_layer.h>
8

--- 14 unchanged lines hidden (view full) ---

23 SV *app;
24 CV *cb;
25 nxt_unit_request_info_t *req;
26 pthread_t thread;
27 nxt_unit_ctx_t *ctx;
28} nxt_perl_psgi_ctx_t;
29
30
31static long nxt_perl_psgi_io_input_read(PerlInterpreter *my_perl,
31static SSize_t nxt_perl_psgi_io_input_read(PerlInterpreter *my_perl,
32 nxt_perl_psgi_io_arg_t *arg, void *vbuf, size_t length);
32 nxt_perl_psgi_io_arg_t *arg, void *vbuf, size_t length);
33static long nxt_perl_psgi_io_input_write(PerlInterpreter *my_perl,
33static SSize_t nxt_perl_psgi_io_input_write(PerlInterpreter *my_perl,
34 nxt_perl_psgi_io_arg_t *arg, const void *vbuf, size_t length);
34 nxt_perl_psgi_io_arg_t *arg, const void *vbuf, size_t length);
35static long nxt_perl_psgi_io_input_flush(PerlInterpreter *my_perl,
36 nxt_perl_psgi_io_arg_t *arg);
37
35
38static long nxt_perl_psgi_io_error_read(PerlInterpreter *my_perl,
36static SSize_t nxt_perl_psgi_io_error_read(PerlInterpreter *my_perl,
39 nxt_perl_psgi_io_arg_t *arg, void *vbuf, size_t length);
37 nxt_perl_psgi_io_arg_t *arg, void *vbuf, size_t length);
40static long nxt_perl_psgi_io_error_write(PerlInterpreter *my_perl,
38static SSize_t nxt_perl_psgi_io_error_write(PerlInterpreter *my_perl,
41 nxt_perl_psgi_io_arg_t *arg, const void *vbuf, size_t length);
39 nxt_perl_psgi_io_arg_t *arg, const void *vbuf, size_t length);
42static long nxt_perl_psgi_io_error_flush(PerlInterpreter *my_perl,
43 nxt_perl_psgi_io_arg_t *arg);
44
45/*
46static void nxt_perl_psgi_xs_core_global_changes(PerlInterpreter *my_perl,
47 const char *core, const char *sub, XSUBADDR_t sub_addr);
48*/
49
50static void nxt_perl_psgi_xs_init(pTHX);
51
52static SV *nxt_perl_psgi_call_var_application(PerlInterpreter *my_perl,
53 SV *env, SV *app, nxt_unit_request_info_t *req);
54static 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 */
58EXTERN_C void boot_DynaLoader(pTHX_ CV *cv);
59
40
41/*
42static void nxt_perl_psgi_xs_core_global_changes(PerlInterpreter *my_perl,
43 const char *core, const char *sub, XSUBADDR_t sub_addr);
44*/
45
46static void nxt_perl_psgi_xs_init(pTHX);
47
48static SV *nxt_perl_psgi_call_var_application(PerlInterpreter *my_perl,
49 SV *env, SV *app, nxt_unit_request_info_t *req);
50static SV *nxt_perl_psgi_call_method(PerlInterpreter *my_perl, SV *obj,
51 const char *method, nxt_unit_request_info_t *req);
52
53/* For currect load XS modules */
54EXTERN_C void boot_DynaLoader(pTHX_ CV *cv);
55
60static nxt_int_t nxt_perl_psgi_io_input_init(PerlInterpreter *my_perl,
61 nxt_perl_psgi_io_arg_t *arg);
62static nxt_int_t nxt_perl_psgi_io_error_init(PerlInterpreter *my_perl,
63 nxt_perl_psgi_io_arg_t *arg);
56static int nxt_perl_psgi_io_init(PerlInterpreter *my_perl,
57 nxt_perl_psgi_io_arg_t *arg, const char *mode, void *req);
64
65static int nxt_perl_psgi_ctx_init(const char *script,
66 nxt_perl_psgi_ctx_t *pctx);
67
68static SV *nxt_perl_psgi_env_create(PerlInterpreter *my_perl,
69 nxt_unit_request_info_t *req);
70nxt_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);

--- 48 unchanged lines hidden (view full) ---

120 nxt_string("perl"),
121 PERL_VERSION_STRING,
122 NULL,
123 0,
124 NULL,
125 nxt_perl_psgi_start,
126};
127
58
59static int nxt_perl_psgi_ctx_init(const char *script,
60 nxt_perl_psgi_ctx_t *pctx);
61
62static SV *nxt_perl_psgi_env_create(PerlInterpreter *my_perl,
63 nxt_unit_request_info_t *req);
64nxt_inline int nxt_perl_psgi_add_sptr(PerlInterpreter *my_perl, HV *hash_env,
65 const char *name, uint32_t name_len, nxt_unit_sptr_t *sptr, uint32_t len);

--- 48 unchanged lines hidden (view full) ---

114 nxt_string("perl"),
115 PERL_VERSION_STRING,
116 NULL,
117 0,
118 NULL,
119 nxt_perl_psgi_start,
120};
121
122const nxt_perl_psgi_io_tab_t nxt_perl_psgi_io_tab_input = {
123 .read = nxt_perl_psgi_io_input_read,
124 .write = nxt_perl_psgi_io_input_write,
125};
128
126
129static long
127const nxt_perl_psgi_io_tab_t nxt_perl_psgi_io_tab_error = {
128 .read = nxt_perl_psgi_io_error_read,
129 .write = nxt_perl_psgi_io_error_write,
130};
131
132
133static SSize_t
130nxt_perl_psgi_io_input_read(PerlInterpreter *my_perl,
131 nxt_perl_psgi_io_arg_t *arg, void *vbuf, size_t length)
132{
134nxt_perl_psgi_io_input_read(PerlInterpreter *my_perl,
135 nxt_perl_psgi_io_arg_t *arg, void *vbuf, size_t length)
136{
133 nxt_perl_psgi_ctx_t *pctx;
134
135 pctx = arg->pctx;
136
137 return nxt_unit_request_read(pctx->req, vbuf, length);
137 return nxt_unit_request_read(arg->req, vbuf, length);
138}
139
140
138}
139
140
141static long
141static SSize_t
142nxt_perl_psgi_io_input_write(PerlInterpreter *my_perl,
143 nxt_perl_psgi_io_arg_t *arg, const void *vbuf, size_t length)
144{
145 return 0;
146}
147
148
142nxt_perl_psgi_io_input_write(PerlInterpreter *my_perl,
143 nxt_perl_psgi_io_arg_t *arg, const void *vbuf, size_t length)
144{
145 return 0;
146}
147
148
149static long
150nxt_perl_psgi_io_input_flush(PerlInterpreter *my_perl,
151 nxt_perl_psgi_io_arg_t *arg)
152{
153 return 0;
154}
155
156
157static long
149static SSize_t
158nxt_perl_psgi_io_error_read(PerlInterpreter *my_perl,
159 nxt_perl_psgi_io_arg_t *arg, void *vbuf, size_t length)
160{
161 return 0;
162}
163
164
150nxt_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
165static long
157static SSize_t
166nxt_perl_psgi_io_error_write(PerlInterpreter *my_perl,
167 nxt_perl_psgi_io_arg_t *arg, const void *vbuf, size_t length)
168{
158nxt_perl_psgi_io_error_write(PerlInterpreter *my_perl,
159 nxt_perl_psgi_io_arg_t *arg, const void *vbuf, size_t length)
160{
169 nxt_perl_psgi_ctx_t *pctx;
161 nxt_unit_req_error(arg->req, "Perl: %s", (const char*) vbuf);
170
162
171 pctx = arg->pctx;
172
173 nxt_unit_req_error(pctx->req, "Perl: %s", (const char*) vbuf);
174
175 return (long) length;
163 return (SSize_t) length;
176}
177
178
164}
165
166
179static long
180nxt_perl_psgi_io_error_flush(PerlInterpreter *my_perl,
181 nxt_perl_psgi_io_arg_t *arg)
182{
183 return 0;
184}
185
186
187/* In the future it will be necessary to change some Perl functions. */
188/*
189static void
190nxt_perl_psgi_xs_core_global_changes(PerlInterpreter *my_perl,
191 const char *core, const char *sub, XSUBADDR_t sub_addr)
192{
193 GV *gv;
194

--- 261 unchanged lines hidden (view full) ---

456 p = nxt_cpymem(buf, prefix.start, prefix.length);
457 p = nxt_cpymem(p, script, length);
458 nxt_memcpy(p, suffix.start, suffix.length);
459
460 return buf;
461}
462
463
167/* In the future it will be necessary to change some Perl functions. */
168/*
169static void
170nxt_perl_psgi_xs_core_global_changes(PerlInterpreter *my_perl,
171 const char *core, const char *sub, XSUBADDR_t sub_addr)
172{
173 GV *gv;
174

--- 261 unchanged lines hidden (view full) ---

436 p = nxt_cpymem(buf, prefix.start, prefix.length);
437 p = nxt_cpymem(p, script, length);
438 nxt_memcpy(p, suffix.start, suffix.length);
439
440 return buf;
441}
442
443
464static nxt_int_t
465nxt_perl_psgi_io_input_init(PerlInterpreter *my_perl,
466 nxt_perl_psgi_io_arg_t *arg)
444static int
445nxt_perl_psgi_io_init(PerlInterpreter *my_perl,
446 nxt_perl_psgi_io_arg_t *arg, const char *mode, void *req)
467{
468 SV *io;
469 PerlIO *fp;
470
447{
448 SV *io;
449 PerlIO *fp;
450
471 fp = nxt_perl_psgi_layer_stream_fp_create(aTHX_ arg, "r");
451 if (arg->io == NULL) {
452 fp = nxt_perl_psgi_layer_stream_fp_create(aTHX_ arg->rv, mode);
453 if (nxt_slow_path(fp == NULL)) {
454 return NXT_UNIT_ERROR;
455 }
472
456
473 if (nxt_slow_path(fp == NULL)) {
474 return NXT_ERROR;
475 }
457 io = nxt_perl_psgi_layer_stream_io_create(aTHX_ fp);
458 if (nxt_slow_path(io == NULL)) {
459 nxt_perl_psgi_layer_stream_fp_destroy(aTHX_ fp);
460 return NXT_UNIT_ERROR;
461 }
476
462
477 io = nxt_perl_psgi_layer_stream_io_create(aTHX_ fp);
478
479 if (nxt_slow_path(io == NULL)) {
480 nxt_perl_psgi_layer_stream_fp_destroy(aTHX_ fp);
481 return NXT_ERROR;
463 arg->io = io;
464 arg->fp = fp;
482 }
483
465 }
466
484 arg->io = io;
485 arg->fp = fp;
486 arg->flush = nxt_perl_psgi_io_input_flush;
487 arg->read = nxt_perl_psgi_io_input_read;
488 arg->write = nxt_perl_psgi_io_input_write;
467 arg->req = req;
489
468
490 return NXT_OK;
469 return NXT_UNIT_OK;
491}
492
493
470}
471
472
494static nxt_int_t
495nxt_perl_psgi_io_error_init(PerlInterpreter *my_perl,
496 nxt_perl_psgi_io_arg_t *arg)
473static void
474nxt_perl_psgi_io_release(PerlInterpreter *my_perl, nxt_perl_psgi_io_arg_t *arg)
497{
475{
498 SV *io;
499 PerlIO *fp;
500
501 fp = nxt_perl_psgi_layer_stream_fp_create(aTHX_ arg, "w");
502
503 if (nxt_slow_path(fp == NULL)) {
504 return NXT_ERROR;
476 if (arg->io != NULL) {
477 SvREFCNT_dec(arg->io);
478 arg->io = NULL;
505 }
479 }
506
507 io = nxt_perl_psgi_layer_stream_io_create(aTHX_ fp);
508
509 if (nxt_slow_path(io == NULL)) {
510 nxt_perl_psgi_layer_stream_fp_destroy(aTHX_ fp);
511 return NXT_ERROR;
512 }
513
514 arg->io = io;
515 arg->fp = fp;
516 arg->flush = nxt_perl_psgi_io_error_flush;
517 arg->read = nxt_perl_psgi_io_error_read;
518 arg->write = nxt_perl_psgi_io_error_write;
519
520 return NXT_OK;
521}
522
523
524static int
525nxt_perl_psgi_ctx_init(const char *script, nxt_perl_psgi_ctx_t *pctx)
526{
480}
481
482
483static int
484nxt_perl_psgi_ctx_init(const char *script, nxt_perl_psgi_ctx_t *pctx)
485{
527 int status;
486 int status, res;
528 char *run_module;
529 PerlInterpreter *my_perl;
530
531 static char argv[] = "\0""-e\0""0";
532 static char *embedding[] = { &argv[0], &argv[1], &argv[4] };
533
534 my_perl = perl_alloc();
535

--- 36 unchanged lines hidden (view full) ---

572
573 sv_setsv(get_sv("0", 0), newSVpv(script, 0));
574
575 run_module = nxt_perl_psgi_module_create(script);
576 if (nxt_slow_path(run_module == NULL)) {
577 goto fail;
578 }
579
487 char *run_module;
488 PerlInterpreter *my_perl;
489
490 static char argv[] = "\0""-e\0""0";
491 static char *embedding[] = { &argv[0], &argv[1], &argv[4] };
492
493 my_perl = perl_alloc();
494

--- 36 unchanged lines hidden (view full) ---

531
532 sv_setsv(get_sv("0", 0), newSVpv(script, 0));
533
534 run_module = nxt_perl_psgi_module_create(script);
535 if (nxt_slow_path(run_module == NULL)) {
536 goto fail;
537 }
538
580 pctx->arg_input.pctx = pctx;
539 pctx->arg_input.rv = newSV_type(SVt_RV);
540 sv_setptrref(pctx->arg_input.rv, &pctx->arg_input);
541 SvSETMAGIC(pctx->arg_input.rv);
581
542
582 status = nxt_perl_psgi_io_input_init(my_perl, &pctx->arg_input);
583 if (nxt_slow_path(status != NXT_OK)) {
543 pctx->arg_input.io_tab = &nxt_perl_psgi_io_tab_input;
544
545 res = nxt_perl_psgi_io_init(my_perl, &pctx->arg_input, "r", NULL);
546 if (nxt_slow_path(res != NXT_UNIT_OK)) {
584 nxt_unit_alert(NULL, "PSGI: Failed to init io.psgi.input");
585 goto fail;
586 }
587
547 nxt_unit_alert(NULL, "PSGI: Failed to init io.psgi.input");
548 goto fail;
549 }
550
588 pctx->arg_error.pctx = pctx;
551 pctx->arg_error.rv = newSV_type(SVt_RV);
552 sv_setptrref(pctx->arg_error.rv, &pctx->arg_error);
553 SvSETMAGIC(pctx->arg_error.rv);
589
554
590 status = nxt_perl_psgi_io_error_init(my_perl, &pctx->arg_error);
591 if (nxt_slow_path(status != NXT_OK)) {
592 nxt_unit_alert(NULL, "PSGI: Failed to init io.psgi.errors");
555 pctx->arg_error.io_tab = &nxt_perl_psgi_io_tab_error;
556
557 res = nxt_perl_psgi_io_init(my_perl, &pctx->arg_error, "w", NULL);
558 if (nxt_slow_path(res != NXT_UNIT_OK)) {
559 nxt_unit_alert(NULL, "PSGI: Failed to init io.psgi.error");
593 goto fail;
594 }
595
596 pctx->app = eval_pv(run_module, FALSE);
597
598 if (SvTRUE(ERRSV)) {
599 nxt_unit_alert(NULL, "PSGI: Failed to parse script: %s\n%s",
600 script, SvPV_nolen(ERRSV));
601 goto fail;
602 }
603
604 nxt_unit_free(NULL, run_module);
605
606 return NXT_UNIT_OK;
607
608fail:
609
560 goto fail;
561 }
562
563 pctx->app = eval_pv(run_module, FALSE);
564
565 if (SvTRUE(ERRSV)) {
566 nxt_unit_alert(NULL, "PSGI: Failed to parse script: %s\n%s",
567 script, SvPV_nolen(ERRSV));
568 goto fail;
569 }
570
571 nxt_unit_free(NULL, run_module);
572
573 return NXT_UNIT_OK;
574
575fail:
576
577 nxt_perl_psgi_io_release(my_perl, &pctx->arg_input);
578 nxt_perl_psgi_io_release(my_perl, &pctx->arg_error);
579
610 if (run_module != NULL) {
611 nxt_unit_free(NULL, run_module);
612 }
613
614 perl_destruct(my_perl);
615 perl_free(my_perl);
616
580 if (run_module != NULL) {
581 nxt_unit_free(NULL, run_module);
582 }
583
584 perl_destruct(my_perl);
585 perl_free(my_perl);
586
587 pctx->my_perl = NULL;
588
617 return NXT_UNIT_ERROR;
618}
619
620
621static SV *
622nxt_perl_psgi_env_create(PerlInterpreter *my_perl,
623 nxt_unit_request_info_t *req)
624{

--- 42 unchanged lines hidden (view full) ---

667
668 RC(nxt_perl_psgi_add_value(my_perl, hash_env, NL("psgi.version"),
669 newRV_noinc((SV *) array_version)));
670
671 RC(nxt_perl_psgi_add_value(my_perl, hash_env, NL("psgi.url_scheme"),
672 r->tls ? newSVpv("https", 5)
673 : newSVpv("http", 4)));
674
589 return NXT_UNIT_ERROR;
590}
591
592
593static SV *
594nxt_perl_psgi_env_create(PerlInterpreter *my_perl,
595 nxt_unit_request_info_t *req)
596{

--- 42 unchanged lines hidden (view full) ---

639
640 RC(nxt_perl_psgi_add_value(my_perl, hash_env, NL("psgi.version"),
641 newRV_noinc((SV *) array_version)));
642
643 RC(nxt_perl_psgi_add_value(my_perl, hash_env, NL("psgi.url_scheme"),
644 r->tls ? newSVpv("https", 5)
645 : newSVpv("http", 4)));
646
647 RC(nxt_perl_psgi_io_init(my_perl, &pctx->arg_input, "r", req));
675 RC(nxt_perl_psgi_add_value(my_perl, hash_env, NL("psgi.input"),
648 RC(nxt_perl_psgi_add_value(my_perl, hash_env, NL("psgi.input"),
676 SvREFCNT_inc(pctx->arg_input.io)));
649 SvREFCNT_inc(pctx->arg_input.io)));
650
651 RC(nxt_perl_psgi_io_init(my_perl, &pctx->arg_error, "w", req));
677 RC(nxt_perl_psgi_add_value(my_perl, hash_env, NL("psgi.errors"),
652 RC(nxt_perl_psgi_add_value(my_perl, hash_env, NL("psgi.errors"),
678 SvREFCNT_inc(pctx->arg_error.io)));
653 SvREFCNT_inc(pctx->arg_error.io)));
654
679 RC(nxt_perl_psgi_add_value(my_perl, hash_env, NL("psgi.multithread"),
655 RC(nxt_perl_psgi_add_value(my_perl, hash_env, NL("psgi.multithread"),
680 nxt_perl_psgi_ctxs != NULL
681 ? &PL_sv_yes : &PL_sv_no));
656 nxt_perl_psgi_ctxs != NULL
657 ? &PL_sv_yes : &PL_sv_no));
682 RC(nxt_perl_psgi_add_value(my_perl, hash_env, NL("psgi.multiprocess"),
658 RC(nxt_perl_psgi_add_value(my_perl, hash_env, NL("psgi.multiprocess"),
683 &PL_sv_yes));
659 &PL_sv_yes));
684 RC(nxt_perl_psgi_add_value(my_perl, hash_env, NL("psgi.run_once"),
660 RC(nxt_perl_psgi_add_value(my_perl, hash_env, NL("psgi.run_once"),
685 &PL_sv_no));
661 &PL_sv_no));
686 RC(nxt_perl_psgi_add_value(my_perl, hash_env, NL("psgi.nonblocking"),
662 RC(nxt_perl_psgi_add_value(my_perl, hash_env, NL("psgi.nonblocking"),
687 &PL_sv_no));
663 &PL_sv_no));
688 RC(nxt_perl_psgi_add_value(my_perl, hash_env, NL("psgi.streaming"),
664 RC(nxt_perl_psgi_add_value(my_perl, hash_env, NL("psgi.streaming"),
689 &PL_sv_yes));
665 &PL_sv_yes));
690
691 RC(nxt_perl_psgi_add_sptr(my_perl, hash_env, NL("QUERY_STRING"),
692 &r->query, r->query_length));
693 RC(nxt_perl_psgi_add_sptr(my_perl, hash_env, NL("SERVER_PROTOCOL"),
694 &r->version, r->version_length));
695 RC(nxt_perl_psgi_add_sptr(my_perl, hash_env, NL("REMOTE_ADDR"),
696 &r->remote, r->remote_length));
697 RC(nxt_perl_psgi_add_sptr(my_perl, hash_env, NL("SERVER_ADDR"),

--- 744 unchanged lines hidden (view full) ---

1442 my_perl = pctx->my_perl;
1443
1444 if (nxt_slow_path(my_perl == NULL)) {
1445 return;
1446 }
1447
1448 PERL_SET_CONTEXT(my_perl);
1449
666
667 RC(nxt_perl_psgi_add_sptr(my_perl, hash_env, NL("QUERY_STRING"),
668 &r->query, r->query_length));
669 RC(nxt_perl_psgi_add_sptr(my_perl, hash_env, NL("SERVER_PROTOCOL"),
670 &r->version, r->version_length));
671 RC(nxt_perl_psgi_add_sptr(my_perl, hash_env, NL("REMOTE_ADDR"),
672 &r->remote, r->remote_length));
673 RC(nxt_perl_psgi_add_sptr(my_perl, hash_env, NL("SERVER_ADDR"),

--- 744 unchanged lines hidden (view full) ---

1418 my_perl = pctx->my_perl;
1419
1420 if (nxt_slow_path(my_perl == NULL)) {
1421 return;
1422 }
1423
1424 PERL_SET_CONTEXT(my_perl);
1425
1450 nxt_perl_psgi_layer_stream_io_destroy(aTHX_ pctx->arg_input.io);
1451 nxt_perl_psgi_layer_stream_fp_destroy(aTHX_ pctx->arg_input.fp);
1426 SvREFCNT_dec(pctx->arg_input.rv);
1427 SvREFCNT_dec(pctx->arg_error.rv);
1452
1428
1453 nxt_perl_psgi_layer_stream_io_destroy(aTHX_ pctx->arg_error.io);
1454 nxt_perl_psgi_layer_stream_fp_destroy(aTHX_ pctx->arg_error.fp);
1429 nxt_perl_psgi_io_release(my_perl, &pctx->arg_input);
1430 nxt_perl_psgi_io_release(my_perl, &pctx->arg_error);
1455
1456 perl_destruct(my_perl);
1457 perl_free(my_perl);
1458}
1431
1432 perl_destruct(my_perl);
1433 perl_free(my_perl);
1434}