xref: /unit/src/perl/nxt_perl_psgi.c (revision 2208:26af8eadc943)
1510Salexander.borisov@nginx.com 
2510Salexander.borisov@nginx.com /*
3510Salexander.borisov@nginx.com  * Copyright (C) Alexander Borisov
4510Salexander.borisov@nginx.com  * Copyright (C) NGINX, Inc.
5510Salexander.borisov@nginx.com  */
6510Salexander.borisov@nginx.com 
7510Salexander.borisov@nginx.com #include <perl/nxt_perl_psgi_layer.h>
8510Salexander.borisov@nginx.com 
9510Salexander.borisov@nginx.com #include <nxt_main.h>
10510Salexander.borisov@nginx.com #include <nxt_router.h>
11510Salexander.borisov@nginx.com #include <nxt_runtime.h>
12510Salexander.borisov@nginx.com #include <nxt_application.h>
13510Salexander.borisov@nginx.com #include <nxt_file.h>
14743Smax.romanov@nginx.com #include <nxt_unit.h>
15743Smax.romanov@nginx.com #include <nxt_unit_request.h>
16743Smax.romanov@nginx.com #include <nxt_unit_response.h>
17510Salexander.borisov@nginx.com 
18510Salexander.borisov@nginx.com 
19510Salexander.borisov@nginx.com typedef struct {
20743Smax.romanov@nginx.com     PerlInterpreter          *my_perl;
211689Smax.romanov@nginx.com     nxt_perl_psgi_io_arg_t   arg_input;
221689Smax.romanov@nginx.com     nxt_perl_psgi_io_arg_t   arg_error;
231689Smax.romanov@nginx.com     SV                       *app;
241689Smax.romanov@nginx.com     CV                       *cb;
25743Smax.romanov@nginx.com     nxt_unit_request_info_t  *req;
261689Smax.romanov@nginx.com     pthread_t                thread;
271689Smax.romanov@nginx.com     nxt_unit_ctx_t           *ctx;
281689Smax.romanov@nginx.com } nxt_perl_psgi_ctx_t;
29510Salexander.borisov@nginx.com 
30510Salexander.borisov@nginx.com 
312060Smax.romanov@nginx.com static SSize_t nxt_perl_psgi_io_input_read(PerlInterpreter *my_perl,
32510Salexander.borisov@nginx.com     nxt_perl_psgi_io_arg_t *arg, void *vbuf, size_t length);
332060Smax.romanov@nginx.com static SSize_t nxt_perl_psgi_io_input_write(PerlInterpreter *my_perl,
34510Salexander.borisov@nginx.com     nxt_perl_psgi_io_arg_t *arg, const void *vbuf, size_t length);
35510Salexander.borisov@nginx.com 
362060Smax.romanov@nginx.com static SSize_t nxt_perl_psgi_io_error_read(PerlInterpreter *my_perl,
37510Salexander.borisov@nginx.com     nxt_perl_psgi_io_arg_t *arg, void *vbuf, size_t length);
382060Smax.romanov@nginx.com static SSize_t nxt_perl_psgi_io_error_write(PerlInterpreter *my_perl,
39510Salexander.borisov@nginx.com     nxt_perl_psgi_io_arg_t *arg, const void *vbuf, size_t length);
40510Salexander.borisov@nginx.com 
41510Salexander.borisov@nginx.com /*
42510Salexander.borisov@nginx.com static void nxt_perl_psgi_xs_core_global_changes(PerlInterpreter *my_perl,
43510Salexander.borisov@nginx.com     const char *core, const char *sub, XSUBADDR_t sub_addr);
44510Salexander.borisov@nginx.com */
45510Salexander.borisov@nginx.com 
46510Salexander.borisov@nginx.com static void nxt_perl_psgi_xs_init(pTHX);
47510Salexander.borisov@nginx.com 
48510Salexander.borisov@nginx.com static SV *nxt_perl_psgi_call_var_application(PerlInterpreter *my_perl,
49743Smax.romanov@nginx.com     SV *env, SV *app, nxt_unit_request_info_t *req);
50969Salexander.borisov@nginx.com static SV *nxt_perl_psgi_call_method(PerlInterpreter *my_perl, SV *obj,
51969Salexander.borisov@nginx.com     const char *method, nxt_unit_request_info_t *req);
52510Salexander.borisov@nginx.com 
53510Salexander.borisov@nginx.com /* For currect load XS modules */
54510Salexander.borisov@nginx.com EXTERN_C void boot_DynaLoader(pTHX_ CV *cv);
55510Salexander.borisov@nginx.com 
562060Smax.romanov@nginx.com static int nxt_perl_psgi_io_init(PerlInterpreter *my_perl,
572060Smax.romanov@nginx.com     nxt_perl_psgi_io_arg_t *arg, const char *mode, void *req);
58510Salexander.borisov@nginx.com 
591689Smax.romanov@nginx.com static int nxt_perl_psgi_ctx_init(const char *script,
601689Smax.romanov@nginx.com     nxt_perl_psgi_ctx_t *pctx);
61510Salexander.borisov@nginx.com 
62743Smax.romanov@nginx.com static SV *nxt_perl_psgi_env_create(PerlInterpreter *my_perl,
631689Smax.romanov@nginx.com     nxt_unit_request_info_t *req);
64743Smax.romanov@nginx.com nxt_inline int nxt_perl_psgi_add_sptr(PerlInterpreter *my_perl, HV *hash_env,
65743Smax.romanov@nginx.com     const char *name, uint32_t name_len, nxt_unit_sptr_t *sptr, uint32_t len);
66743Smax.romanov@nginx.com nxt_inline int nxt_perl_psgi_add_str(PerlInterpreter *my_perl, HV *hash_env,
67967Svbart@nginx.com     const char *name, uint32_t name_len, const char *str, uint32_t len);
68743Smax.romanov@nginx.com nxt_inline int nxt_perl_psgi_add_value(PerlInterpreter *my_perl, HV *hash_env,
69743Smax.romanov@nginx.com     const char *name, uint32_t name_len, void *value);
70510Salexander.borisov@nginx.com 
71510Salexander.borisov@nginx.com 
721689Smax.romanov@nginx.com static char *nxt_perl_psgi_module_create(const char *script);
73510Salexander.borisov@nginx.com 
74743Smax.romanov@nginx.com static nxt_int_t nxt_perl_psgi_result_status(PerlInterpreter *my_perl,
75510Salexander.borisov@nginx.com     SV *result);
76743Smax.romanov@nginx.com static int nxt_perl_psgi_result_head(PerlInterpreter *my_perl,
77743Smax.romanov@nginx.com     SV *sv_head, nxt_unit_request_info_t *req, uint16_t status);
78743Smax.romanov@nginx.com static int nxt_perl_psgi_result_body(PerlInterpreter *my_perl,
79743Smax.romanov@nginx.com     SV *result, nxt_unit_request_info_t *req);
80743Smax.romanov@nginx.com static int nxt_perl_psgi_result_body_ref(PerlInterpreter *my_perl,
81743Smax.romanov@nginx.com     SV *sv_body, nxt_unit_request_info_t *req);
82969Salexander.borisov@nginx.com static int nxt_perl_psgi_result_body_fh(PerlInterpreter *my_perl, SV *sv_body,
83969Salexander.borisov@nginx.com     nxt_unit_request_info_t *req);
84969Salexander.borisov@nginx.com static ssize_t nxt_perl_psgi_io_read(nxt_unit_read_info_t *read_info, void *dst,
85969Salexander.borisov@nginx.com     size_t size);
86743Smax.romanov@nginx.com static int nxt_perl_psgi_result_array(PerlInterpreter *my_perl,
87743Smax.romanov@nginx.com     SV *result, nxt_unit_request_info_t *req);
88986Salexander.borisov@nginx.com static void nxt_perl_psgi_result_cb(PerlInterpreter *my_perl, SV *result,
89986Salexander.borisov@nginx.com     nxt_unit_request_info_t *req);
90510Salexander.borisov@nginx.com 
911488St.nateldemoura@f5.com static nxt_int_t nxt_perl_psgi_start(nxt_task_t *task,
921689Smax.romanov@nginx.com     nxt_process_data_t *data);
93743Smax.romanov@nginx.com static void nxt_perl_psgi_request_handler(nxt_unit_request_info_t *req);
941689Smax.romanov@nginx.com static int nxt_perl_psgi_ready_handler(nxt_unit_ctx_t *ctx);
951689Smax.romanov@nginx.com static void *nxt_perl_psgi_thread_func(void *main_ctx);
961689Smax.romanov@nginx.com static int nxt_perl_psgi_init_threads(nxt_perl_app_conf_t *c);
971689Smax.romanov@nginx.com static void nxt_perl_psgi_join_threads(nxt_unit_ctx_t *ctx,
981689Smax.romanov@nginx.com     nxt_perl_app_conf_t *c);
991689Smax.romanov@nginx.com static void nxt_perl_psgi_ctx_free(nxt_perl_psgi_ctx_t *pctx);
100510Salexander.borisov@nginx.com 
1011689Smax.romanov@nginx.com static CV                   *nxt_perl_psgi_write;
1021689Smax.romanov@nginx.com static CV                   *nxt_perl_psgi_close;
1031689Smax.romanov@nginx.com static CV                   *nxt_perl_psgi_cb;
1041689Smax.romanov@nginx.com static pthread_attr_t       *nxt_perl_psgi_thread_attr;
1051689Smax.romanov@nginx.com static nxt_perl_psgi_ctx_t  *nxt_perl_psgi_ctxs;
106510Salexander.borisov@nginx.com 
107510Salexander.borisov@nginx.com static uint32_t  nxt_perl_psgi_compat[] = {
108510Salexander.borisov@nginx.com     NXT_VERNUM, NXT_DEBUG,
109510Salexander.borisov@nginx.com };
110510Salexander.borisov@nginx.com 
111743Smax.romanov@nginx.com NXT_EXPORT nxt_app_module_t  nxt_app_module = {
112510Salexander.borisov@nginx.com     sizeof(nxt_perl_psgi_compat),
113510Salexander.borisov@nginx.com     nxt_perl_psgi_compat,
114510Salexander.borisov@nginx.com     nxt_string("perl"),
115612Salexander.borisov@nginx.com     PERL_VERSION_STRING,
1161489St.nateldemoura@f5.com     NULL,
1171489St.nateldemoura@f5.com     0,
118977Smax.romanov@gmail.com     NULL,
1191488St.nateldemoura@f5.com     nxt_perl_psgi_start,
120510Salexander.borisov@nginx.com };
121510Salexander.borisov@nginx.com 
1222060Smax.romanov@nginx.com const nxt_perl_psgi_io_tab_t nxt_perl_psgi_io_tab_input = {
1232060Smax.romanov@nginx.com     .read = nxt_perl_psgi_io_input_read,
1242060Smax.romanov@nginx.com     .write = nxt_perl_psgi_io_input_write,
1252060Smax.romanov@nginx.com };
126510Salexander.borisov@nginx.com 
1272060Smax.romanov@nginx.com const nxt_perl_psgi_io_tab_t nxt_perl_psgi_io_tab_error = {
1282060Smax.romanov@nginx.com     .read = nxt_perl_psgi_io_error_read,
1292060Smax.romanov@nginx.com     .write = nxt_perl_psgi_io_error_write,
1302060Smax.romanov@nginx.com };
1312060Smax.romanov@nginx.com 
1322060Smax.romanov@nginx.com 
1332060Smax.romanov@nginx.com static SSize_t
nxt_perl_psgi_io_input_read(PerlInterpreter * my_perl,nxt_perl_psgi_io_arg_t * arg,void * vbuf,size_t length)134510Salexander.borisov@nginx.com nxt_perl_psgi_io_input_read(PerlInterpreter *my_perl,
135510Salexander.borisov@nginx.com     nxt_perl_psgi_io_arg_t *arg, void *vbuf, size_t length)
136510Salexander.borisov@nginx.com {
1372060Smax.romanov@nginx.com     return nxt_unit_request_read(arg->req, vbuf, length);
138510Salexander.borisov@nginx.com }
139510Salexander.borisov@nginx.com 
140510Salexander.borisov@nginx.com 
1412060Smax.romanov@nginx.com static SSize_t
nxt_perl_psgi_io_input_write(PerlInterpreter * my_perl,nxt_perl_psgi_io_arg_t * arg,const void * vbuf,size_t length)142510Salexander.borisov@nginx.com nxt_perl_psgi_io_input_write(PerlInterpreter *my_perl,
143510Salexander.borisov@nginx.com     nxt_perl_psgi_io_arg_t *arg, const void *vbuf, size_t length)
144510Salexander.borisov@nginx.com {
145510Salexander.borisov@nginx.com     return 0;
146510Salexander.borisov@nginx.com }
147510Salexander.borisov@nginx.com 
148510Salexander.borisov@nginx.com 
1492060Smax.romanov@nginx.com static SSize_t
nxt_perl_psgi_io_error_read(PerlInterpreter * my_perl,nxt_perl_psgi_io_arg_t * arg,void * vbuf,size_t length)150510Salexander.borisov@nginx.com nxt_perl_psgi_io_error_read(PerlInterpreter *my_perl,
151510Salexander.borisov@nginx.com     nxt_perl_psgi_io_arg_t *arg, void *vbuf, size_t length)
152510Salexander.borisov@nginx.com {
153510Salexander.borisov@nginx.com     return 0;
154510Salexander.borisov@nginx.com }
155510Salexander.borisov@nginx.com 
156510Salexander.borisov@nginx.com 
1572060Smax.romanov@nginx.com static SSize_t
nxt_perl_psgi_io_error_write(PerlInterpreter * my_perl,nxt_perl_psgi_io_arg_t * arg,const void * vbuf,size_t length)158510Salexander.borisov@nginx.com nxt_perl_psgi_io_error_write(PerlInterpreter *my_perl,
159510Salexander.borisov@nginx.com     nxt_perl_psgi_io_arg_t *arg, const void *vbuf, size_t length)
160510Salexander.borisov@nginx.com {
1612060Smax.romanov@nginx.com     nxt_unit_req_error(arg->req, "Perl: %s", (const char*) vbuf);
162510Salexander.borisov@nginx.com 
1632060Smax.romanov@nginx.com     return (SSize_t) length;
164510Salexander.borisov@nginx.com }
165510Salexander.borisov@nginx.com 
166510Salexander.borisov@nginx.com 
167510Salexander.borisov@nginx.com /* In the future it will be necessary to change some Perl functions. */
168510Salexander.borisov@nginx.com /*
169510Salexander.borisov@nginx.com static void
170510Salexander.borisov@nginx.com nxt_perl_psgi_xs_core_global_changes(PerlInterpreter *my_perl,
171510Salexander.borisov@nginx.com     const char *core, const char *sub, XSUBADDR_t sub_addr)
172510Salexander.borisov@nginx.com {
173510Salexander.borisov@nginx.com     GV  *gv;
174510Salexander.borisov@nginx.com 
175510Salexander.borisov@nginx.com     gv = gv_fetchpv(core, TRUE, SVt_PVCV);
176510Salexander.borisov@nginx.com 
177510Salexander.borisov@nginx.com #ifdef MUTABLE_CV
178510Salexander.borisov@nginx.com     GvCV_set(gv, MUTABLE_CV(SvREFCNT_inc(get_cv(sub, TRUE))));
179510Salexander.borisov@nginx.com #else
180510Salexander.borisov@nginx.com     GvCV_set(gv, (CV *) (SvREFCNT_inc(get_cv(sub, TRUE))));
181510Salexander.borisov@nginx.com #endif
182510Salexander.borisov@nginx.com     GvIMPORTED_CV_on(gv);
183510Salexander.borisov@nginx.com 
184510Salexander.borisov@nginx.com     newXS(sub, sub_addr, __FILE__);
185510Salexander.borisov@nginx.com }
186510Salexander.borisov@nginx.com */
187510Salexander.borisov@nginx.com 
188510Salexander.borisov@nginx.com 
189510Salexander.borisov@nginx.com XS(XS_NGINX__Unit__PSGI_exit);
XS(XS_NGINX__Unit__PSGI_exit)190510Salexander.borisov@nginx.com XS(XS_NGINX__Unit__PSGI_exit)
191510Salexander.borisov@nginx.com {
192510Salexander.borisov@nginx.com     I32 ax = POPMARK;
193510Salexander.borisov@nginx.com     Perl_croak(aTHX_ (char *) NULL);
194510Salexander.borisov@nginx.com     XSRETURN_EMPTY;
195510Salexander.borisov@nginx.com }
196510Salexander.borisov@nginx.com 
197510Salexander.borisov@nginx.com 
198986Salexander.borisov@nginx.com XS(XS_NGINX__Unit__Sandbox_write);
XS(XS_NGINX__Unit__Sandbox_write)199986Salexander.borisov@nginx.com XS(XS_NGINX__Unit__Sandbox_write)
200986Salexander.borisov@nginx.com {
2011689Smax.romanov@nginx.com     int                  rc;
2021689Smax.romanov@nginx.com     char                 *body;
2031689Smax.romanov@nginx.com     size_t               len;
2041689Smax.romanov@nginx.com     nxt_perl_psgi_ctx_t  *pctx;
205986Salexander.borisov@nginx.com 
206986Salexander.borisov@nginx.com     dXSARGS;
207986Salexander.borisov@nginx.com 
208986Salexander.borisov@nginx.com     if (nxt_slow_path(items != 2)) {
209986Salexander.borisov@nginx.com         Perl_croak(aTHX_ "Wrong number of arguments. Need one string");
210986Salexander.borisov@nginx.com 
211986Salexander.borisov@nginx.com         XSRETURN_EMPTY;
212986Salexander.borisov@nginx.com     }
213986Salexander.borisov@nginx.com 
214986Salexander.borisov@nginx.com     body = SvPV(ST(1), len);
215986Salexander.borisov@nginx.com 
2161689Smax.romanov@nginx.com     pctx = CvXSUBANY(cv).any_ptr;
2171689Smax.romanov@nginx.com 
2181689Smax.romanov@nginx.com     rc = nxt_unit_response_write(pctx->req, body, len);
219986Salexander.borisov@nginx.com     if (nxt_slow_path(rc != NXT_UNIT_OK)) {
220986Salexander.borisov@nginx.com         Perl_croak(aTHX_ "Failed to write response body");
221986Salexander.borisov@nginx.com 
222986Salexander.borisov@nginx.com         XSRETURN_EMPTY;
223986Salexander.borisov@nginx.com     }
224986Salexander.borisov@nginx.com 
225986Salexander.borisov@nginx.com     XSRETURN_IV(len);
226986Salexander.borisov@nginx.com }
227986Salexander.borisov@nginx.com 
228986Salexander.borisov@nginx.com 
229986Salexander.borisov@nginx.com nxt_inline void
nxt_perl_psgi_cb_request_done(nxt_perl_psgi_ctx_t * pctx,int status)2301689Smax.romanov@nginx.com nxt_perl_psgi_cb_request_done(nxt_perl_psgi_ctx_t *pctx, int status)
231986Salexander.borisov@nginx.com {
2321689Smax.romanov@nginx.com     if (pctx->req != NULL) {
2331689Smax.romanov@nginx.com         nxt_unit_request_done(pctx->req, status);
2341689Smax.romanov@nginx.com         pctx->req = NULL;
235986Salexander.borisov@nginx.com     }
236986Salexander.borisov@nginx.com }
237986Salexander.borisov@nginx.com 
238986Salexander.borisov@nginx.com 
239986Salexander.borisov@nginx.com XS(XS_NGINX__Unit__Sandbox_close);
XS(XS_NGINX__Unit__Sandbox_close)240986Salexander.borisov@nginx.com XS(XS_NGINX__Unit__Sandbox_close)
241986Salexander.borisov@nginx.com {
242986Salexander.borisov@nginx.com     I32  ax;
243986Salexander.borisov@nginx.com 
244986Salexander.borisov@nginx.com     ax = POPMARK;
245986Salexander.borisov@nginx.com 
2461689Smax.romanov@nginx.com     nxt_perl_psgi_cb_request_done(CvXSUBANY(cv).any_ptr, NXT_UNIT_OK);
247986Salexander.borisov@nginx.com 
248986Salexander.borisov@nginx.com     XSRETURN_NO;
249986Salexander.borisov@nginx.com }
250986Salexander.borisov@nginx.com 
251986Salexander.borisov@nginx.com 
252986Salexander.borisov@nginx.com XS(XS_NGINX__Unit__Sandbox_cb);
XS(XS_NGINX__Unit__Sandbox_cb)253986Salexander.borisov@nginx.com XS(XS_NGINX__Unit__Sandbox_cb)
254986Salexander.borisov@nginx.com {
2551689Smax.romanov@nginx.com     SV                   *obj;
2561689Smax.romanov@nginx.com     int                  rc;
2571689Smax.romanov@nginx.com     long                 array_len;
2581689Smax.romanov@nginx.com     nxt_perl_psgi_ctx_t  *pctx;
259986Salexander.borisov@nginx.com 
260986Salexander.borisov@nginx.com     dXSARGS;
261986Salexander.borisov@nginx.com 
262986Salexander.borisov@nginx.com     if (nxt_slow_path(items != 1)) {
2631689Smax.romanov@nginx.com         nxt_perl_psgi_cb_request_done(CvXSUBANY(cv).any_ptr, NXT_UNIT_ERROR);
264986Salexander.borisov@nginx.com 
265986Salexander.borisov@nginx.com         Perl_croak(aTHX_ "Wrong number of arguments");
266986Salexander.borisov@nginx.com 
267986Salexander.borisov@nginx.com         XSRETURN_EMPTY;
268986Salexander.borisov@nginx.com     }
269986Salexander.borisov@nginx.com 
270986Salexander.borisov@nginx.com     if (nxt_slow_path(SvOK(ST(0)) == 0 || SvROK(ST(0)) == 0
271986Salexander.borisov@nginx.com                       || SvTYPE(SvRV(ST(0))) != SVt_PVAV))
272986Salexander.borisov@nginx.com     {
2731689Smax.romanov@nginx.com         nxt_perl_psgi_cb_request_done(CvXSUBANY(cv).any_ptr, NXT_UNIT_ERROR);
274986Salexander.borisov@nginx.com 
275986Salexander.borisov@nginx.com         Perl_croak(aTHX_ "PSGI: An unexpected response was received "
276986Salexander.borisov@nginx.com                    "from Perl Application");
277986Salexander.borisov@nginx.com 
278986Salexander.borisov@nginx.com         XSRETURN_EMPTY;
279986Salexander.borisov@nginx.com     }
280986Salexander.borisov@nginx.com 
2811689Smax.romanov@nginx.com     pctx = CvXSUBANY(cv).any_ptr;
2821689Smax.romanov@nginx.com 
2831689Smax.romanov@nginx.com     rc = nxt_perl_psgi_result_array(PERL_GET_CONTEXT, ST(0), pctx->req);
284986Salexander.borisov@nginx.com     if (nxt_slow_path(rc != NXT_UNIT_OK)) {
2851689Smax.romanov@nginx.com         nxt_perl_psgi_cb_request_done(CvXSUBANY(cv).any_ptr, NXT_UNIT_ERROR);
286986Salexander.borisov@nginx.com 
287986Salexander.borisov@nginx.com         Perl_croak(aTHX_ (char *) NULL);
288986Salexander.borisov@nginx.com 
289986Salexander.borisov@nginx.com         XSRETURN_EMPTY;
290986Salexander.borisov@nginx.com     }
291986Salexander.borisov@nginx.com 
292986Salexander.borisov@nginx.com     array_len = av_len((AV *) SvRV(ST(0)));
293986Salexander.borisov@nginx.com 
294986Salexander.borisov@nginx.com     if (array_len < 2) {
295986Salexander.borisov@nginx.com         obj = sv_bless(newRV_noinc((SV *) newHV()),
296986Salexander.borisov@nginx.com                        gv_stashpv("NGINX::Unit::Sandbox", GV_ADD));
297986Salexander.borisov@nginx.com         ST(0) = obj;
298986Salexander.borisov@nginx.com 
299986Salexander.borisov@nginx.com         XSRETURN(1);
300986Salexander.borisov@nginx.com     }
301986Salexander.borisov@nginx.com 
3021689Smax.romanov@nginx.com     nxt_perl_psgi_cb_request_done(CvXSUBANY(cv).any_ptr, NXT_UNIT_OK);
303986Salexander.borisov@nginx.com 
304986Salexander.borisov@nginx.com     XSRETURN_EMPTY;
305986Salexander.borisov@nginx.com }
306986Salexander.borisov@nginx.com 
307986Salexander.borisov@nginx.com 
308510Salexander.borisov@nginx.com static void
nxt_perl_psgi_xs_init(pTHX)309510Salexander.borisov@nginx.com nxt_perl_psgi_xs_init(pTHX)
310510Salexander.borisov@nginx.com {
311510Salexander.borisov@nginx.com /*
312510Salexander.borisov@nginx.com     nxt_perl_psgi_xs_core_global_changes(my_perl, "CORE::GLOBAL::exit",
313510Salexander.borisov@nginx.com                                          "NGINX::Unit::PSGI::exit",
314510Salexander.borisov@nginx.com                                          XS_NGINX__Unit__PSGI_exit);
315510Salexander.borisov@nginx.com */
316510Salexander.borisov@nginx.com     nxt_perl_psgi_layer_stream_init(aTHX);
317510Salexander.borisov@nginx.com 
318510Salexander.borisov@nginx.com     /* DynaLoader for Perl modules who use XS */
319510Salexander.borisov@nginx.com     newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, __FILE__);
320986Salexander.borisov@nginx.com 
3211689Smax.romanov@nginx.com     nxt_perl_psgi_write = newXS("NGINX::Unit::Sandbox::write",
3221689Smax.romanov@nginx.com                                 XS_NGINX__Unit__Sandbox_write, __FILE__);
3231689Smax.romanov@nginx.com 
3241689Smax.romanov@nginx.com     nxt_perl_psgi_close = newXS("NGINX::Unit::Sandbox::close",
3251689Smax.romanov@nginx.com                                 XS_NGINX__Unit__Sandbox_close, __FILE__);
326986Salexander.borisov@nginx.com 
327986Salexander.borisov@nginx.com     nxt_perl_psgi_cb = newXS("NGINX::Unit::Sandbox::cb",
328986Salexander.borisov@nginx.com                              XS_NGINX__Unit__Sandbox_cb, __FILE__);
329510Salexander.borisov@nginx.com }
330510Salexander.borisov@nginx.com 
331510Salexander.borisov@nginx.com 
332510Salexander.borisov@nginx.com static SV *
nxt_perl_psgi_call_var_application(PerlInterpreter * my_perl,SV * env,SV * app,nxt_unit_request_info_t * req)333510Salexander.borisov@nginx.com nxt_perl_psgi_call_var_application(PerlInterpreter *my_perl,
334743Smax.romanov@nginx.com     SV *env, SV *app, nxt_unit_request_info_t *req)
335510Salexander.borisov@nginx.com {
336510Salexander.borisov@nginx.com     SV  *result;
337510Salexander.borisov@nginx.com 
338510Salexander.borisov@nginx.com     dSP;
339510Salexander.borisov@nginx.com 
340510Salexander.borisov@nginx.com     ENTER;
341510Salexander.borisov@nginx.com     SAVETMPS;
342510Salexander.borisov@nginx.com 
343510Salexander.borisov@nginx.com     PUSHMARK(sp);
344510Salexander.borisov@nginx.com     XPUSHs(env);
345510Salexander.borisov@nginx.com     PUTBACK;
346510Salexander.borisov@nginx.com 
347743Smax.romanov@nginx.com     call_sv(app, G_EVAL|G_SCALAR);
348510Salexander.borisov@nginx.com 
349510Salexander.borisov@nginx.com     SPAGAIN;
350510Salexander.borisov@nginx.com 
351510Salexander.borisov@nginx.com     if (SvTRUE(ERRSV)) {
352743Smax.romanov@nginx.com         nxt_unit_req_error(req, "PSGI: Failed to run Perl Application: \n%s",
353743Smax.romanov@nginx.com                            SvPV_nolen(ERRSV));
354510Salexander.borisov@nginx.com     }
355510Salexander.borisov@nginx.com 
356510Salexander.borisov@nginx.com     result = POPs;
357510Salexander.borisov@nginx.com     SvREFCNT_inc(result);
358510Salexander.borisov@nginx.com 
359510Salexander.borisov@nginx.com     PUTBACK;
360510Salexander.borisov@nginx.com     FREETMPS;
361510Salexander.borisov@nginx.com     LEAVE;
362510Salexander.borisov@nginx.com 
363510Salexander.borisov@nginx.com     return result;
364510Salexander.borisov@nginx.com }
365510Salexander.borisov@nginx.com 
366510Salexander.borisov@nginx.com 
367969Salexander.borisov@nginx.com static SV *
nxt_perl_psgi_call_method(PerlInterpreter * my_perl,SV * obj,const char * method,nxt_unit_request_info_t * req)368969Salexander.borisov@nginx.com nxt_perl_psgi_call_method(PerlInterpreter *my_perl, SV *obj, const char *method,
369969Salexander.borisov@nginx.com     nxt_unit_request_info_t *req)
370969Salexander.borisov@nginx.com {
371969Salexander.borisov@nginx.com     SV  *result;
372969Salexander.borisov@nginx.com 
373969Salexander.borisov@nginx.com     dSP;
374969Salexander.borisov@nginx.com 
375969Salexander.borisov@nginx.com     ENTER;
376969Salexander.borisov@nginx.com     SAVETMPS;
377969Salexander.borisov@nginx.com 
378969Salexander.borisov@nginx.com     PUSHMARK(sp);
379969Salexander.borisov@nginx.com     XPUSHs(obj);
380969Salexander.borisov@nginx.com     PUTBACK;
381969Salexander.borisov@nginx.com 
382969Salexander.borisov@nginx.com     call_method(method, G_EVAL|G_SCALAR);
383969Salexander.borisov@nginx.com 
384969Salexander.borisov@nginx.com     SPAGAIN;
385969Salexander.borisov@nginx.com 
386969Salexander.borisov@nginx.com     if (SvTRUE(ERRSV)) {
387969Salexander.borisov@nginx.com         nxt_unit_req_error(req, "PSGI: Failed to call method '%s':\n%s",
388969Salexander.borisov@nginx.com                            method, SvPV_nolen(ERRSV));
389969Salexander.borisov@nginx.com         result = NULL;
390969Salexander.borisov@nginx.com 
391969Salexander.borisov@nginx.com     } else {
392969Salexander.borisov@nginx.com         result = SvREFCNT_inc(POPs);
393969Salexander.borisov@nginx.com     }
394969Salexander.borisov@nginx.com 
395969Salexander.borisov@nginx.com     PUTBACK;
396969Salexander.borisov@nginx.com     FREETMPS;
397969Salexander.borisov@nginx.com     LEAVE;
398969Salexander.borisov@nginx.com 
399969Salexander.borisov@nginx.com     return result;
400969Salexander.borisov@nginx.com }
401969Salexander.borisov@nginx.com 
402969Salexander.borisov@nginx.com 
4031689Smax.romanov@nginx.com static char *
nxt_perl_psgi_module_create(const char * script)4041689Smax.romanov@nginx.com nxt_perl_psgi_module_create(const char *script)
405510Salexander.borisov@nginx.com {
4061689Smax.romanov@nginx.com     char    *buf, *p;
407510Salexander.borisov@nginx.com     size_t  length;
408510Salexander.borisov@nginx.com 
409510Salexander.borisov@nginx.com     static nxt_str_t  prefix = nxt_string(
410510Salexander.borisov@nginx.com         "package NGINX::Unit::Sandbox;"
411986Salexander.borisov@nginx.com         "sub new {"
412986Salexander.borisov@nginx.com         "   return bless {}, $_[0];"
413986Salexander.borisov@nginx.com         "}"
414510Salexander.borisov@nginx.com         "{my $app = do \""
415510Salexander.borisov@nginx.com     );
416510Salexander.borisov@nginx.com 
417510Salexander.borisov@nginx.com     static nxt_str_t  suffix = nxt_string_zero(
418510Salexander.borisov@nginx.com         "\";"
419510Salexander.borisov@nginx.com         "unless ($app) {"
420510Salexander.borisov@nginx.com         "    if($@ || $1) {die $@ || $1}"
421510Salexander.borisov@nginx.com         "    else {die \"File not found or compilation error.\"}"
422510Salexander.borisov@nginx.com         "} "
423510Salexander.borisov@nginx.com         "return $app}"
424510Salexander.borisov@nginx.com     );
425510Salexander.borisov@nginx.com 
426510Salexander.borisov@nginx.com     length = strlen(script);
427510Salexander.borisov@nginx.com 
4281689Smax.romanov@nginx.com     buf = nxt_unit_malloc(NULL, prefix.length + length + suffix.length);
429510Salexander.borisov@nginx.com     if (nxt_slow_path(buf == NULL)) {
4301689Smax.romanov@nginx.com         nxt_unit_alert(NULL, "PSGI: Failed to allocate memory "
4311689Smax.romanov@nginx.com                        "for Perl script file %s", script);
4321689Smax.romanov@nginx.com 
433510Salexander.borisov@nginx.com         return NULL;
434510Salexander.borisov@nginx.com     }
435510Salexander.borisov@nginx.com 
436510Salexander.borisov@nginx.com     p = nxt_cpymem(buf, prefix.start, prefix.length);
437510Salexander.borisov@nginx.com     p = nxt_cpymem(p, script, length);
438510Salexander.borisov@nginx.com     nxt_memcpy(p, suffix.start, suffix.length);
439510Salexander.borisov@nginx.com 
440510Salexander.borisov@nginx.com     return buf;
441510Salexander.borisov@nginx.com }
442510Salexander.borisov@nginx.com 
443510Salexander.borisov@nginx.com 
4442060Smax.romanov@nginx.com static int
nxt_perl_psgi_io_init(PerlInterpreter * my_perl,nxt_perl_psgi_io_arg_t * arg,const char * mode,void * req)4452060Smax.romanov@nginx.com nxt_perl_psgi_io_init(PerlInterpreter *my_perl,
4462060Smax.romanov@nginx.com     nxt_perl_psgi_io_arg_t *arg, const char *mode, void *req)
447510Salexander.borisov@nginx.com {
448510Salexander.borisov@nginx.com     SV      *io;
449510Salexander.borisov@nginx.com     PerlIO  *fp;
450510Salexander.borisov@nginx.com 
4512060Smax.romanov@nginx.com     if (arg->io == NULL) {
4522060Smax.romanov@nginx.com         fp = nxt_perl_psgi_layer_stream_fp_create(aTHX_ arg->rv, mode);
4532060Smax.romanov@nginx.com         if (nxt_slow_path(fp == NULL)) {
4542060Smax.romanov@nginx.com             return NXT_UNIT_ERROR;
4552060Smax.romanov@nginx.com         }
456510Salexander.borisov@nginx.com 
4572060Smax.romanov@nginx.com         io = nxt_perl_psgi_layer_stream_io_create(aTHX_ fp);
4582060Smax.romanov@nginx.com         if (nxt_slow_path(io == NULL)) {
4592060Smax.romanov@nginx.com             nxt_perl_psgi_layer_stream_fp_destroy(aTHX_ fp);
4602060Smax.romanov@nginx.com             return NXT_UNIT_ERROR;
4612060Smax.romanov@nginx.com         }
4622060Smax.romanov@nginx.com 
4632060Smax.romanov@nginx.com         arg->io = io;
4642060Smax.romanov@nginx.com         arg->fp = fp;
465510Salexander.borisov@nginx.com     }
466510Salexander.borisov@nginx.com 
4672060Smax.romanov@nginx.com     arg->req = req;
468510Salexander.borisov@nginx.com 
4692060Smax.romanov@nginx.com     return NXT_UNIT_OK;
470510Salexander.borisov@nginx.com }
471510Salexander.borisov@nginx.com 
472510Salexander.borisov@nginx.com 
4732060Smax.romanov@nginx.com static void
nxt_perl_psgi_io_release(PerlInterpreter * my_perl,nxt_perl_psgi_io_arg_t * arg)4742060Smax.romanov@nginx.com nxt_perl_psgi_io_release(PerlInterpreter *my_perl, nxt_perl_psgi_io_arg_t *arg)
475510Salexander.borisov@nginx.com {
4762060Smax.romanov@nginx.com     if (arg->io != NULL) {
4772060Smax.romanov@nginx.com         SvREFCNT_dec(arg->io);
4782060Smax.romanov@nginx.com         arg->io = NULL;
479510Salexander.borisov@nginx.com     }
480510Salexander.borisov@nginx.com }
481510Salexander.borisov@nginx.com 
482510Salexander.borisov@nginx.com 
4831689Smax.romanov@nginx.com static int
nxt_perl_psgi_ctx_init(const char * script,nxt_perl_psgi_ctx_t * pctx)4841689Smax.romanov@nginx.com nxt_perl_psgi_ctx_init(const char *script, nxt_perl_psgi_ctx_t *pctx)
485510Salexander.borisov@nginx.com {
4862060Smax.romanov@nginx.com     int              status, res;
4871689Smax.romanov@nginx.com     char             *run_module;
488510Salexander.borisov@nginx.com     PerlInterpreter  *my_perl;
489510Salexander.borisov@nginx.com 
490510Salexander.borisov@nginx.com     static char  argv[] = "\0""-e\0""0";
491510Salexander.borisov@nginx.com     static char  *embedding[] = { &argv[0], &argv[1], &argv[4] };
492510Salexander.borisov@nginx.com 
493510Salexander.borisov@nginx.com     my_perl = perl_alloc();
494510Salexander.borisov@nginx.com 
495510Salexander.borisov@nginx.com     if (nxt_slow_path(my_perl == NULL)) {
4961689Smax.romanov@nginx.com         nxt_unit_alert(NULL,
4971689Smax.romanov@nginx.com                        "PSGI: Failed to allocate memory for Perl interpreter");
4981689Smax.romanov@nginx.com 
4991689Smax.romanov@nginx.com         return NXT_UNIT_ERROR;
500510Salexander.borisov@nginx.com     }
501510Salexander.borisov@nginx.com 
5021689Smax.romanov@nginx.com     pctx->my_perl = my_perl;
5031689Smax.romanov@nginx.com 
504510Salexander.borisov@nginx.com     run_module = NULL;
505510Salexander.borisov@nginx.com 
506510Salexander.borisov@nginx.com     perl_construct(my_perl);
507510Salexander.borisov@nginx.com     PERL_SET_CONTEXT(my_perl);
508510Salexander.borisov@nginx.com 
509510Salexander.borisov@nginx.com     status = perl_parse(my_perl, nxt_perl_psgi_xs_init, 3, embedding, NULL);
510510Salexander.borisov@nginx.com 
511510Salexander.borisov@nginx.com     if (nxt_slow_path(status != 0)) {
5121689Smax.romanov@nginx.com         nxt_unit_alert(NULL, "PSGI: Failed to parse Perl Script");
513510Salexander.borisov@nginx.com         goto fail;
514510Salexander.borisov@nginx.com     }
515510Salexander.borisov@nginx.com 
5161689Smax.romanov@nginx.com     CvXSUBANY(nxt_perl_psgi_write).any_ptr = pctx;
5171689Smax.romanov@nginx.com     CvXSUBANY(nxt_perl_psgi_close).any_ptr = pctx;
5181689Smax.romanov@nginx.com     CvXSUBANY(nxt_perl_psgi_cb).any_ptr = pctx;
5191689Smax.romanov@nginx.com 
5201689Smax.romanov@nginx.com     pctx->cb = nxt_perl_psgi_cb;
5211689Smax.romanov@nginx.com 
522510Salexander.borisov@nginx.com     PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
523510Salexander.borisov@nginx.com     PL_origalen = 1;
524510Salexander.borisov@nginx.com 
525510Salexander.borisov@nginx.com     status = perl_run(my_perl);
526510Salexander.borisov@nginx.com 
527510Salexander.borisov@nginx.com     if (nxt_slow_path(status != 0)) {
5281689Smax.romanov@nginx.com         nxt_unit_alert(NULL, "PSGI: Failed to run Perl");
529510Salexander.borisov@nginx.com         goto fail;
530510Salexander.borisov@nginx.com     }
531510Salexander.borisov@nginx.com 
532510Salexander.borisov@nginx.com     sv_setsv(get_sv("0", 0), newSVpv(script, 0));
533510Salexander.borisov@nginx.com 
5341689Smax.romanov@nginx.com     run_module = nxt_perl_psgi_module_create(script);
535510Salexander.borisov@nginx.com     if (nxt_slow_path(run_module == NULL)) {
536510Salexander.borisov@nginx.com         goto fail;
537510Salexander.borisov@nginx.com     }
538510Salexander.borisov@nginx.com 
5392060Smax.romanov@nginx.com     pctx->arg_input.rv = newSV_type(SVt_RV);
5402060Smax.romanov@nginx.com     sv_setptrref(pctx->arg_input.rv, &pctx->arg_input);
5412060Smax.romanov@nginx.com     SvSETMAGIC(pctx->arg_input.rv);
542510Salexander.borisov@nginx.com 
5432060Smax.romanov@nginx.com     pctx->arg_input.io_tab = &nxt_perl_psgi_io_tab_input;
5442060Smax.romanov@nginx.com 
5452060Smax.romanov@nginx.com     res = nxt_perl_psgi_io_init(my_perl, &pctx->arg_input, "r", NULL);
5462060Smax.romanov@nginx.com     if (nxt_slow_path(res != NXT_UNIT_OK)) {
5471689Smax.romanov@nginx.com         nxt_unit_alert(NULL, "PSGI: Failed to init io.psgi.input");
548510Salexander.borisov@nginx.com         goto fail;
549510Salexander.borisov@nginx.com     }
550510Salexander.borisov@nginx.com 
5512060Smax.romanov@nginx.com     pctx->arg_error.rv = newSV_type(SVt_RV);
5522060Smax.romanov@nginx.com     sv_setptrref(pctx->arg_error.rv, &pctx->arg_error);
5532060Smax.romanov@nginx.com     SvSETMAGIC(pctx->arg_error.rv);
554510Salexander.borisov@nginx.com 
5552060Smax.romanov@nginx.com     pctx->arg_error.io_tab = &nxt_perl_psgi_io_tab_error;
5562060Smax.romanov@nginx.com 
5572060Smax.romanov@nginx.com     res = nxt_perl_psgi_io_init(my_perl, &pctx->arg_error, "w", NULL);
5582060Smax.romanov@nginx.com     if (nxt_slow_path(res != NXT_UNIT_OK)) {
5592060Smax.romanov@nginx.com         nxt_unit_alert(NULL, "PSGI: Failed to init io.psgi.error");
560510Salexander.borisov@nginx.com         goto fail;
561510Salexander.borisov@nginx.com     }
562510Salexander.borisov@nginx.com 
5631689Smax.romanov@nginx.com     pctx->app = eval_pv(run_module, FALSE);
564510Salexander.borisov@nginx.com 
565510Salexander.borisov@nginx.com     if (SvTRUE(ERRSV)) {
5661689Smax.romanov@nginx.com         nxt_unit_alert(NULL, "PSGI: Failed to parse script: %s\n%s",
5671689Smax.romanov@nginx.com                        script, SvPV_nolen(ERRSV));
568510Salexander.borisov@nginx.com         goto fail;
569510Salexander.borisov@nginx.com     }
570510Salexander.borisov@nginx.com 
5711689Smax.romanov@nginx.com     nxt_unit_free(NULL, run_module);
572510Salexander.borisov@nginx.com 
5731689Smax.romanov@nginx.com     return NXT_UNIT_OK;
574510Salexander.borisov@nginx.com 
575510Salexander.borisov@nginx.com fail:
576510Salexander.borisov@nginx.com 
5772060Smax.romanov@nginx.com     nxt_perl_psgi_io_release(my_perl, &pctx->arg_input);
5782060Smax.romanov@nginx.com     nxt_perl_psgi_io_release(my_perl, &pctx->arg_error);
5792060Smax.romanov@nginx.com 
580510Salexander.borisov@nginx.com     if (run_module != NULL) {
5811689Smax.romanov@nginx.com         nxt_unit_free(NULL, run_module);
582510Salexander.borisov@nginx.com     }
583510Salexander.borisov@nginx.com 
584510Salexander.borisov@nginx.com     perl_destruct(my_perl);
585510Salexander.borisov@nginx.com     perl_free(my_perl);
586510Salexander.borisov@nginx.com 
5872060Smax.romanov@nginx.com     pctx->my_perl = NULL;
5882060Smax.romanov@nginx.com 
5891689Smax.romanov@nginx.com     return NXT_UNIT_ERROR;
590510Salexander.borisov@nginx.com }
591510Salexander.borisov@nginx.com 
592510Salexander.borisov@nginx.com 
593743Smax.romanov@nginx.com static SV *
nxt_perl_psgi_env_create(PerlInterpreter * my_perl,nxt_unit_request_info_t * req)594743Smax.romanov@nginx.com nxt_perl_psgi_env_create(PerlInterpreter *my_perl,
5951689Smax.romanov@nginx.com     nxt_unit_request_info_t *req)
596510Salexander.borisov@nginx.com {
5971689Smax.romanov@nginx.com     HV                   *hash_env;
5981689Smax.romanov@nginx.com     AV                   *array_version;
5991689Smax.romanov@nginx.com     uint32_t             i;
6001689Smax.romanov@nginx.com     nxt_unit_field_t     *f;
6011689Smax.romanov@nginx.com     nxt_unit_request_t   *r;
6021689Smax.romanov@nginx.com     nxt_perl_psgi_ctx_t  *pctx;
6031689Smax.romanov@nginx.com 
6041689Smax.romanov@nginx.com     pctx = req->ctx->data;
605510Salexander.borisov@nginx.com 
606510Salexander.borisov@nginx.com     hash_env = newHV();
607510Salexander.borisov@nginx.com     if (nxt_slow_path(hash_env == NULL)) {
608510Salexander.borisov@nginx.com         return NULL;
609510Salexander.borisov@nginx.com     }
610510Salexander.borisov@nginx.com 
611743Smax.romanov@nginx.com #define RC(FNS)                                                               \
612743Smax.romanov@nginx.com     do {                                                                      \
613743Smax.romanov@nginx.com         if (nxt_slow_path((FNS) != NXT_UNIT_OK))                              \
614743Smax.romanov@nginx.com             goto fail;                                                        \
6152078Salx.manpages@gmail.com     } while (0)
616510Salexander.borisov@nginx.com 
617743Smax.romanov@nginx.com #define NL(S) (S), sizeof(S)-1
618510Salexander.borisov@nginx.com 
619743Smax.romanov@nginx.com     r = req->request;
620673Svbart@nginx.com 
621743Smax.romanov@nginx.com     RC(nxt_perl_psgi_add_str(my_perl, hash_env, NL("SERVER_SOFTWARE"),
622743Smax.romanov@nginx.com                              (char *) nxt_server.start, nxt_server.length));
623510Salexander.borisov@nginx.com 
624743Smax.romanov@nginx.com     RC(nxt_perl_psgi_add_sptr(my_perl, hash_env, NL("REQUEST_METHOD"),
625743Smax.romanov@nginx.com                               &r->method, r->method_length));
626743Smax.romanov@nginx.com     RC(nxt_perl_psgi_add_sptr(my_perl, hash_env, NL("REQUEST_URI"),
627743Smax.romanov@nginx.com                               &r->target, r->target_length));
628743Smax.romanov@nginx.com     RC(nxt_perl_psgi_add_sptr(my_perl, hash_env, NL("PATH_INFO"),
629743Smax.romanov@nginx.com                               &r->path, r->path_length));
630580Salexander.borisov@nginx.com 
631510Salexander.borisov@nginx.com     array_version = newAV();
632510Salexander.borisov@nginx.com 
633510Salexander.borisov@nginx.com     if (nxt_slow_path(array_version == NULL)) {
634510Salexander.borisov@nginx.com         goto fail;
635510Salexander.borisov@nginx.com     }
636510Salexander.borisov@nginx.com 
637510Salexander.borisov@nginx.com     av_push(array_version, newSViv(1));
638510Salexander.borisov@nginx.com     av_push(array_version, newSViv(1));
639510Salexander.borisov@nginx.com 
640743Smax.romanov@nginx.com     RC(nxt_perl_psgi_add_value(my_perl, hash_env, NL("psgi.version"),
641580Salexander.borisov@nginx.com                                 newRV_noinc((SV *) array_version)));
6421011Smax.romanov@nginx.com 
643743Smax.romanov@nginx.com     RC(nxt_perl_psgi_add_value(my_perl, hash_env, NL("psgi.url_scheme"),
6441011Smax.romanov@nginx.com                                r->tls ? newSVpv("https", 5)
6451011Smax.romanov@nginx.com                                     : newSVpv("http", 4)));
6461011Smax.romanov@nginx.com 
6472060Smax.romanov@nginx.com     RC(nxt_perl_psgi_io_init(my_perl, &pctx->arg_input, "r", req));
648743Smax.romanov@nginx.com     RC(nxt_perl_psgi_add_value(my_perl, hash_env, NL("psgi.input"),
6492060Smax.romanov@nginx.com                                SvREFCNT_inc(pctx->arg_input.io)));
6502060Smax.romanov@nginx.com 
6512060Smax.romanov@nginx.com     RC(nxt_perl_psgi_io_init(my_perl, &pctx->arg_error, "w", req));
652743Smax.romanov@nginx.com     RC(nxt_perl_psgi_add_value(my_perl, hash_env, NL("psgi.errors"),
6532060Smax.romanov@nginx.com                                SvREFCNT_inc(pctx->arg_error.io)));
6542060Smax.romanov@nginx.com 
655743Smax.romanov@nginx.com     RC(nxt_perl_psgi_add_value(my_perl, hash_env, NL("psgi.multithread"),
6562060Smax.romanov@nginx.com                                nxt_perl_psgi_ctxs != NULL
6572060Smax.romanov@nginx.com                                    ? &PL_sv_yes : &PL_sv_no));
658743Smax.romanov@nginx.com     RC(nxt_perl_psgi_add_value(my_perl, hash_env, NL("psgi.multiprocess"),
6592060Smax.romanov@nginx.com                                &PL_sv_yes));
660743Smax.romanov@nginx.com     RC(nxt_perl_psgi_add_value(my_perl, hash_env, NL("psgi.run_once"),
6612060Smax.romanov@nginx.com                                &PL_sv_no));
662743Smax.romanov@nginx.com     RC(nxt_perl_psgi_add_value(my_perl, hash_env, NL("psgi.nonblocking"),
6632060Smax.romanov@nginx.com                                &PL_sv_no));
664743Smax.romanov@nginx.com     RC(nxt_perl_psgi_add_value(my_perl, hash_env, NL("psgi.streaming"),
6652060Smax.romanov@nginx.com                                &PL_sv_yes));
666510Salexander.borisov@nginx.com 
667981Svbart@nginx.com     RC(nxt_perl_psgi_add_sptr(my_perl, hash_env, NL("QUERY_STRING"),
668981Svbart@nginx.com                               &r->query, r->query_length));
669743Smax.romanov@nginx.com     RC(nxt_perl_psgi_add_sptr(my_perl, hash_env, NL("SERVER_PROTOCOL"),
670743Smax.romanov@nginx.com                               &r->version, r->version_length));
671743Smax.romanov@nginx.com     RC(nxt_perl_psgi_add_sptr(my_perl, hash_env, NL("REMOTE_ADDR"),
672743Smax.romanov@nginx.com                               &r->remote, r->remote_length));
673743Smax.romanov@nginx.com     RC(nxt_perl_psgi_add_sptr(my_perl, hash_env, NL("SERVER_ADDR"),
674*2208Sa.clayton@nginx.com                               &r->local_addr, r->local_addr_length));
675510Salexander.borisov@nginx.com 
676967Svbart@nginx.com     RC(nxt_perl_psgi_add_sptr(my_perl, hash_env, NL("SERVER_NAME"),
677967Svbart@nginx.com                               &r->server_name, r->server_name_length));
678967Svbart@nginx.com     RC(nxt_perl_psgi_add_str(my_perl, hash_env, NL("SERVER_PORT"), "80", 2));
679967Svbart@nginx.com 
680743Smax.romanov@nginx.com     for (i = 0; i < r->fields_count; i++) {
681743Smax.romanov@nginx.com         f = r->fields + i;
682510Salexander.borisov@nginx.com 
683743Smax.romanov@nginx.com         RC(nxt_perl_psgi_add_sptr(my_perl, hash_env,
684743Smax.romanov@nginx.com                                   nxt_unit_sptr_get(&f->name), f->name_length,
685743Smax.romanov@nginx.com                                   &f->value, f->value_length));
686510Salexander.borisov@nginx.com     }
687510Salexander.borisov@nginx.com 
688743Smax.romanov@nginx.com     if (r->content_length_field != NXT_UNIT_NONE_FIELD) {
689743Smax.romanov@nginx.com         f = r->fields + r->content_length_field;
690510Salexander.borisov@nginx.com 
691743Smax.romanov@nginx.com         RC(nxt_perl_psgi_add_sptr(my_perl, hash_env, NL("CONTENT_LENGTH"),
692743Smax.romanov@nginx.com                                   &f->value, f->value_length));
693743Smax.romanov@nginx.com     }
694510Salexander.borisov@nginx.com 
695743Smax.romanov@nginx.com     if (r->content_type_field != NXT_UNIT_NONE_FIELD) {
696743Smax.romanov@nginx.com         f = r->fields + r->content_type_field;
697743Smax.romanov@nginx.com 
698743Smax.romanov@nginx.com         RC(nxt_perl_psgi_add_sptr(my_perl, hash_env, NL("CONTENT_TYPE"),
699743Smax.romanov@nginx.com                                   &f->value, f->value_length));
700510Salexander.borisov@nginx.com     }
701510Salexander.borisov@nginx.com 
702743Smax.romanov@nginx.com #undef NL
703510Salexander.borisov@nginx.com #undef RC
704510Salexander.borisov@nginx.com 
705510Salexander.borisov@nginx.com     return newRV_noinc((SV *) hash_env);
706510Salexander.borisov@nginx.com 
707510Salexander.borisov@nginx.com fail:
708510Salexander.borisov@nginx.com 
709510Salexander.borisov@nginx.com     SvREFCNT_dec(hash_env);
710510Salexander.borisov@nginx.com 
711510Salexander.borisov@nginx.com     return NULL;
712510Salexander.borisov@nginx.com }
713510Salexander.borisov@nginx.com 
714510Salexander.borisov@nginx.com 
715743Smax.romanov@nginx.com nxt_inline int
nxt_perl_psgi_add_sptr(PerlInterpreter * my_perl,HV * hash_env,const char * name,uint32_t name_len,nxt_unit_sptr_t * sptr,uint32_t len)716743Smax.romanov@nginx.com nxt_perl_psgi_add_sptr(PerlInterpreter *my_perl, HV *hash_env,
717743Smax.romanov@nginx.com     const char *name, uint32_t name_len, nxt_unit_sptr_t *sptr, uint32_t len)
718743Smax.romanov@nginx.com {
719743Smax.romanov@nginx.com     return nxt_perl_psgi_add_str(my_perl, hash_env, name, name_len,
720743Smax.romanov@nginx.com                                  nxt_unit_sptr_get(sptr), len);
721743Smax.romanov@nginx.com }
722743Smax.romanov@nginx.com 
723743Smax.romanov@nginx.com 
724743Smax.romanov@nginx.com nxt_inline int
nxt_perl_psgi_add_str(PerlInterpreter * my_perl,HV * hash_env,const char * name,uint32_t name_len,const char * str,uint32_t len)725743Smax.romanov@nginx.com nxt_perl_psgi_add_str(PerlInterpreter *my_perl, HV *hash_env,
726967Svbart@nginx.com     const char *name, uint32_t name_len, const char *str, uint32_t len)
727743Smax.romanov@nginx.com {
728743Smax.romanov@nginx.com     SV  **ha;
729743Smax.romanov@nginx.com 
730743Smax.romanov@nginx.com     ha = hv_store(hash_env, name, (I32) name_len,
731743Smax.romanov@nginx.com                   newSVpv(str, (STRLEN) len), 0);
732743Smax.romanov@nginx.com     if (nxt_slow_path(ha == NULL)) {
733743Smax.romanov@nginx.com         return NXT_UNIT_ERROR;
734743Smax.romanov@nginx.com     }
735743Smax.romanov@nginx.com 
736743Smax.romanov@nginx.com     return NXT_UNIT_OK;
737743Smax.romanov@nginx.com }
738743Smax.romanov@nginx.com 
739743Smax.romanov@nginx.com 
740743Smax.romanov@nginx.com nxt_inline int
nxt_perl_psgi_add_value(PerlInterpreter * my_perl,HV * hash_env,const char * name,uint32_t name_len,void * value)741743Smax.romanov@nginx.com nxt_perl_psgi_add_value(PerlInterpreter *my_perl, HV *hash_env,
742743Smax.romanov@nginx.com     const char *name, uint32_t name_len, void *value)
743743Smax.romanov@nginx.com {
744743Smax.romanov@nginx.com     SV  **ha;
745743Smax.romanov@nginx.com 
746743Smax.romanov@nginx.com     ha = hv_store(hash_env, name, (I32) name_len, value, 0);
747743Smax.romanov@nginx.com     if (nxt_slow_path(ha == NULL)) {
748743Smax.romanov@nginx.com         return NXT_UNIT_ERROR;
749743Smax.romanov@nginx.com     }
750743Smax.romanov@nginx.com 
751743Smax.romanov@nginx.com     return NXT_UNIT_OK;
752743Smax.romanov@nginx.com }
753743Smax.romanov@nginx.com 
754743Smax.romanov@nginx.com 
755743Smax.romanov@nginx.com static nxt_int_t
nxt_perl_psgi_result_status(PerlInterpreter * my_perl,SV * result)756510Salexander.borisov@nginx.com nxt_perl_psgi_result_status(PerlInterpreter *my_perl, SV *result)
757510Salexander.borisov@nginx.com {
758510Salexander.borisov@nginx.com     SV         **sv_status;
759510Salexander.borisov@nginx.com     AV         *array;
760743Smax.romanov@nginx.com     u_char     *space;
761510Salexander.borisov@nginx.com     nxt_str_t  status;
762510Salexander.borisov@nginx.com 
763510Salexander.borisov@nginx.com     array = (AV *) SvRV(result);
764510Salexander.borisov@nginx.com     sv_status = av_fetch(array, 0, 0);
765510Salexander.borisov@nginx.com 
766510Salexander.borisov@nginx.com     status.start = (u_char *) SvPV(*sv_status, status.length);
767510Salexander.borisov@nginx.com 
768743Smax.romanov@nginx.com     space = nxt_memchr(status.start, ' ', status.length);
769743Smax.romanov@nginx.com     if (space != NULL) {
770743Smax.romanov@nginx.com         status.length = space - status.start;
771743Smax.romanov@nginx.com     }
772743Smax.romanov@nginx.com 
773743Smax.romanov@nginx.com     return nxt_int_parse(status.start, status.length);
774510Salexander.borisov@nginx.com }
775510Salexander.borisov@nginx.com 
776510Salexander.borisov@nginx.com 
777743Smax.romanov@nginx.com static int
nxt_perl_psgi_result_head(PerlInterpreter * my_perl,SV * sv_head,nxt_unit_request_info_t * req,uint16_t status)778510Salexander.borisov@nginx.com nxt_perl_psgi_result_head(PerlInterpreter *my_perl, SV *sv_head,
779743Smax.romanov@nginx.com     nxt_unit_request_info_t *req, uint16_t status)
780510Salexander.borisov@nginx.com {
781510Salexander.borisov@nginx.com     AV         *array_head;
782510Salexander.borisov@nginx.com     SV         **entry;
783743Smax.romanov@nginx.com     int        rc;
784510Salexander.borisov@nginx.com     long       i, array_len;
785743Smax.romanov@nginx.com     char       *name, *value;
786743Smax.romanov@nginx.com     STRLEN     name_len, value_len;
787743Smax.romanov@nginx.com     uint32_t   fields, size;
788510Salexander.borisov@nginx.com 
789510Salexander.borisov@nginx.com     if (nxt_slow_path(SvROK(sv_head) == 0
790510Salexander.borisov@nginx.com                       || SvTYPE(SvRV(sv_head)) != SVt_PVAV))
791510Salexander.borisov@nginx.com     {
792743Smax.romanov@nginx.com         nxt_unit_req_error(req,
793743Smax.romanov@nginx.com                            "PSGI: An unsupported format was received from "
794743Smax.romanov@nginx.com                            "Perl Application for head part");
795510Salexander.borisov@nginx.com 
796743Smax.romanov@nginx.com         return NXT_UNIT_ERROR;
797510Salexander.borisov@nginx.com     }
798510Salexander.borisov@nginx.com 
799510Salexander.borisov@nginx.com     array_head = (AV *) SvRV(sv_head);
800510Salexander.borisov@nginx.com     array_len = av_len(array_head);
801510Salexander.borisov@nginx.com 
802510Salexander.borisov@nginx.com     if (array_len < 1) {
803743Smax.romanov@nginx.com         return nxt_unit_response_init(req, status, 0, 0);
804510Salexander.borisov@nginx.com     }
805510Salexander.borisov@nginx.com 
806510Salexander.borisov@nginx.com     if (nxt_slow_path((array_len % 2) == 0)) {
807743Smax.romanov@nginx.com         nxt_unit_req_error(req, "PSGI: Bad format for head from "
808743Smax.romanov@nginx.com                            "Perl Application");
809510Salexander.borisov@nginx.com 
810743Smax.romanov@nginx.com         return NXT_UNIT_ERROR;
811510Salexander.borisov@nginx.com     }
812510Salexander.borisov@nginx.com 
813743Smax.romanov@nginx.com     fields = 0;
814743Smax.romanov@nginx.com     size = 0;
815743Smax.romanov@nginx.com 
816510Salexander.borisov@nginx.com     for (i = 0; i <= array_len; i++) {
817510Salexander.borisov@nginx.com         entry = av_fetch(array_head, i, 0);
818510Salexander.borisov@nginx.com 
819510Salexander.borisov@nginx.com         if (nxt_fast_path(entry == NULL)) {
820743Smax.romanov@nginx.com             nxt_unit_req_error(req, "PSGI: Failed to get head entry from "
821743Smax.romanov@nginx.com                                "Perl Application");
822510Salexander.borisov@nginx.com 
823743Smax.romanov@nginx.com             return NXT_UNIT_ERROR;
824510Salexander.borisov@nginx.com         }
825510Salexander.borisov@nginx.com 
826743Smax.romanov@nginx.com         value = SvPV(*entry, value_len);
827743Smax.romanov@nginx.com         size += value_len;
828510Salexander.borisov@nginx.com 
829510Salexander.borisov@nginx.com         if ((i % 2) == 0) {
830743Smax.romanov@nginx.com             fields++;
831510Salexander.borisov@nginx.com         }
832743Smax.romanov@nginx.com     }
833510Salexander.borisov@nginx.com 
834743Smax.romanov@nginx.com     rc = nxt_unit_response_init(req, status, fields, size);
835743Smax.romanov@nginx.com     if (nxt_slow_path(rc != NXT_UNIT_OK)) {
836743Smax.romanov@nginx.com         return rc;
837743Smax.romanov@nginx.com     }
838743Smax.romanov@nginx.com 
839743Smax.romanov@nginx.com     for (i = 0; i <= array_len; i += 2) {
840743Smax.romanov@nginx.com         entry = av_fetch(array_head, i, 0);
841743Smax.romanov@nginx.com         name = SvPV(*entry, name_len);
842743Smax.romanov@nginx.com 
843743Smax.romanov@nginx.com         entry = av_fetch(array_head, i + 1, 0);
844743Smax.romanov@nginx.com         value = SvPV(*entry, value_len);
845743Smax.romanov@nginx.com 
846743Smax.romanov@nginx.com         rc = nxt_unit_response_add_field(req, name, name_len, value, value_len);
847743Smax.romanov@nginx.com         if (nxt_slow_path(rc != NXT_UNIT_OK)) {
848510Salexander.borisov@nginx.com             return rc;
849510Salexander.borisov@nginx.com         }
850510Salexander.borisov@nginx.com     }
851510Salexander.borisov@nginx.com 
852743Smax.romanov@nginx.com     return NXT_UNIT_OK;
853510Salexander.borisov@nginx.com }
854510Salexander.borisov@nginx.com 
855510Salexander.borisov@nginx.com 
856743Smax.romanov@nginx.com static int
nxt_perl_psgi_result_body(PerlInterpreter * my_perl,SV * sv_body,nxt_unit_request_info_t * req)857510Salexander.borisov@nginx.com nxt_perl_psgi_result_body(PerlInterpreter *my_perl, SV *sv_body,
858743Smax.romanov@nginx.com     nxt_unit_request_info_t *req)
859510Salexander.borisov@nginx.com {
860510Salexander.borisov@nginx.com     SV         **entry;
861510Salexander.borisov@nginx.com     AV         *body_array;
862743Smax.romanov@nginx.com     int        rc;
863510Salexander.borisov@nginx.com     long       i;
864510Salexander.borisov@nginx.com     nxt_str_t  body;
865510Salexander.borisov@nginx.com 
866510Salexander.borisov@nginx.com     if (nxt_slow_path(SvROK(sv_body) == 0
867510Salexander.borisov@nginx.com                       || SvTYPE(SvRV(sv_body)) != SVt_PVAV))
868510Salexander.borisov@nginx.com     {
869743Smax.romanov@nginx.com         nxt_unit_req_error(req, "PSGI: An unsupported format was received from "
870743Smax.romanov@nginx.com                            "Perl Application for a body part");
871510Salexander.borisov@nginx.com 
872743Smax.romanov@nginx.com         return NXT_UNIT_ERROR;
873510Salexander.borisov@nginx.com     }
874510Salexander.borisov@nginx.com 
875510Salexander.borisov@nginx.com     body_array = (AV *) SvRV(sv_body);
876510Salexander.borisov@nginx.com 
877510Salexander.borisov@nginx.com     for (i = 0; i <= av_len(body_array); i++) {
878510Salexander.borisov@nginx.com 
879510Salexander.borisov@nginx.com         entry = av_fetch(body_array, i, 0);
880510Salexander.borisov@nginx.com 
881510Salexander.borisov@nginx.com         if (nxt_fast_path(entry == NULL)) {
882743Smax.romanov@nginx.com             nxt_unit_req_error(req, "PSGI: Failed to get body entry from "
883743Smax.romanov@nginx.com                                "Perl Application");
884743Smax.romanov@nginx.com 
885743Smax.romanov@nginx.com             return NXT_UNIT_ERROR;
886510Salexander.borisov@nginx.com         }
887510Salexander.borisov@nginx.com 
888510Salexander.borisov@nginx.com         body.start = (u_char *) SvPV(*entry, body.length);
889510Salexander.borisov@nginx.com 
890510Salexander.borisov@nginx.com         if (body.length == 0) {
891510Salexander.borisov@nginx.com             continue;
892510Salexander.borisov@nginx.com         }
893510Salexander.borisov@nginx.com 
894743Smax.romanov@nginx.com         rc = nxt_unit_response_write(req, body.start, body.length);
895510Salexander.borisov@nginx.com 
896743Smax.romanov@nginx.com         if (nxt_slow_path(rc != NXT_UNIT_OK)) {
897743Smax.romanov@nginx.com             nxt_unit_req_error(req, "PSGI: Failed to write content from "
898743Smax.romanov@nginx.com                                "Perl Application");
899510Salexander.borisov@nginx.com             return rc;
900510Salexander.borisov@nginx.com         }
901510Salexander.borisov@nginx.com     }
902510Salexander.borisov@nginx.com 
903743Smax.romanov@nginx.com     return NXT_UNIT_OK;
904510Salexander.borisov@nginx.com }
905510Salexander.borisov@nginx.com 
906510Salexander.borisov@nginx.com 
907969Salexander.borisov@nginx.com static int
nxt_perl_psgi_result_body_ref(PerlInterpreter * my_perl,SV * sv_body,nxt_unit_request_info_t * req)908969Salexander.borisov@nginx.com nxt_perl_psgi_result_body_ref(PerlInterpreter *my_perl, SV *sv_body,
909969Salexander.borisov@nginx.com     nxt_unit_request_info_t *req)
910969Salexander.borisov@nginx.com {
911969Salexander.borisov@nginx.com     SV          *data, *old_rs, *old_perl_rs;
912969Salexander.borisov@nginx.com     int         rc;
913969Salexander.borisov@nginx.com     size_t      len;
914969Salexander.borisov@nginx.com     const char  *body;
915969Salexander.borisov@nginx.com 
916969Salexander.borisov@nginx.com     /*
917969Salexander.borisov@nginx.com      * Servers should set the $/ special variable to the buffer size
918969Salexander.borisov@nginx.com      * when reading content from $body using the getline method.
919969Salexander.borisov@nginx.com      * This is done by setting $/ with a reference to an integer ($/ = \8192).
920969Salexander.borisov@nginx.com      */
921969Salexander.borisov@nginx.com 
922969Salexander.borisov@nginx.com     old_rs = PL_rs;
923969Salexander.borisov@nginx.com     old_perl_rs = get_sv("/", GV_ADD);
924969Salexander.borisov@nginx.com 
925969Salexander.borisov@nginx.com     PL_rs = sv_2mortal(newRV_noinc(newSViv(nxt_unit_buf_min())));
926969Salexander.borisov@nginx.com 
927969Salexander.borisov@nginx.com     sv_setsv(old_perl_rs, PL_rs);
928969Salexander.borisov@nginx.com 
929969Salexander.borisov@nginx.com     rc = NXT_UNIT_OK;
930969Salexander.borisov@nginx.com 
931969Salexander.borisov@nginx.com     for ( ;; ) {
932969Salexander.borisov@nginx.com         data = nxt_perl_psgi_call_method(my_perl, sv_body, "getline", req);
933969Salexander.borisov@nginx.com         if (nxt_slow_path(data == NULL)) {
934969Salexander.borisov@nginx.com             rc = NXT_UNIT_ERROR;
935969Salexander.borisov@nginx.com             break;
936969Salexander.borisov@nginx.com         }
937969Salexander.borisov@nginx.com 
938969Salexander.borisov@nginx.com         body = SvPV(data, len);
939969Salexander.borisov@nginx.com 
940969Salexander.borisov@nginx.com         if (len == 0) {
941969Salexander.borisov@nginx.com             SvREFCNT_dec(data);
942969Salexander.borisov@nginx.com 
943969Salexander.borisov@nginx.com             data = nxt_perl_psgi_call_method(my_perl, sv_body, "close", req);
944969Salexander.borisov@nginx.com             if (nxt_fast_path(data != NULL)) {
945969Salexander.borisov@nginx.com                 SvREFCNT_dec(data);
946969Salexander.borisov@nginx.com             }
947969Salexander.borisov@nginx.com 
948969Salexander.borisov@nginx.com             break;
949969Salexander.borisov@nginx.com         }
950969Salexander.borisov@nginx.com 
951969Salexander.borisov@nginx.com         rc = nxt_unit_response_write(req, body, len);
952969Salexander.borisov@nginx.com 
953969Salexander.borisov@nginx.com         SvREFCNT_dec(data);
954969Salexander.borisov@nginx.com 
955969Salexander.borisov@nginx.com         if (nxt_slow_path(rc != NXT_UNIT_OK)) {
956969Salexander.borisov@nginx.com             nxt_unit_req_error(req, "PSGI: Failed to write content from "
957969Salexander.borisov@nginx.com                                "Perl Application");
958969Salexander.borisov@nginx.com             break;
959969Salexander.borisov@nginx.com         }
960969Salexander.borisov@nginx.com     };
961969Salexander.borisov@nginx.com 
962969Salexander.borisov@nginx.com     PL_rs =  old_rs;
963969Salexander.borisov@nginx.com     sv_setsv(get_sv("/", GV_ADD), old_perl_rs);
964969Salexander.borisov@nginx.com 
965969Salexander.borisov@nginx.com     return rc;
966969Salexander.borisov@nginx.com }
967969Salexander.borisov@nginx.com 
968969Salexander.borisov@nginx.com 
969743Smax.romanov@nginx.com typedef struct {
970743Smax.romanov@nginx.com     PerlInterpreter  *my_perl;
971743Smax.romanov@nginx.com     PerlIO           *fp;
972743Smax.romanov@nginx.com } nxt_perl_psgi_io_ctx_t;
973743Smax.romanov@nginx.com 
974743