xref: /unit/src/perl/nxt_perl_psgi_layer.c (revision 510:4979fe09d9cd)
1 
2 /*
3  * Copyright (C) Alexander Borisov
4  * Copyright (C) NGINX, Inc.
5  */
6 
7 #include <perl/nxt_perl_psgi_layer.h>
8 
9 
10 typedef struct {
11     struct _PerlIO  base;
12 
13     SV              *var;
14 } nxt_perl_psgi_layer_stream_t;
15 
16 
17 static IV nxt_perl_psgi_layer_stream_pushed(pTHX_ PerlIO *f, const char *mode,
18     SV *arg, PerlIO_funcs *tab);
19 static IV nxt_perl_psgi_layer_stream_popped(pTHX_ PerlIO *f);
20 
21 static PerlIO *nxt_perl_psgi_layer_stream_open(pTHX_ PerlIO_funcs *self,
22     PerlIO_list_t *layers, IV n,
23     const char *mode, int fd, int imode, int perm,
24     PerlIO *f, int narg, SV **args);
25 
26 static IV nxt_perl_psgi_layer_stream_close(pTHX_ PerlIO *f);
27 
28 static SSize_t nxt_perl_psgi_layer_stream_read(pTHX_ PerlIO *f,
29     void *vbuf, Size_t count);
30 static SSize_t nxt_perl_psgi_layer_stream_write(pTHX_ PerlIO *f,
31     const void *vbuf, Size_t count);
32 
33 static IV nxt_perl_psgi_layer_stream_fileno(pTHX_ PerlIO *f);
34 static IV nxt_perl_psgi_layer_stream_seek(pTHX_ PerlIO *f,
35     Off_t offset, int whence);
36 static Off_t nxt_perl_psgi_layer_stream_tell(pTHX_ PerlIO *f);
37 static IV nxt_perl_psgi_layer_stream_fill(pTHX_ PerlIO *f);
38 static IV nxt_perl_psgi_layer_stream_flush(pTHX_ PerlIO *f);
39 
40 static SV *nxt_perl_psgi_layer_stream_arg(pTHX_ PerlIO *f,
41     CLONE_PARAMS *param, int flags);
42 
43 static PerlIO *nxt_perl_psgi_layer_stream_dup(pTHX_ PerlIO *f, PerlIO *o,
44     CLONE_PARAMS *param, int flags);
45 static IV nxt_perl_psgi_layer_stream_eof(pTHX_ PerlIO *f);
46 
47 static STDCHAR *nxt_perl_psgi_layer_stream_get_base(pTHX_ PerlIO *f);
48 static STDCHAR *nxt_perl_psgi_layer_stream_get_ptr(pTHX_ PerlIO *f);
49 static SSize_t nxt_perl_psgi_layer_stream_get_cnt(pTHX_ PerlIO *f);
50 static Size_t nxt_perl_psgi_layer_stream_buffersize(pTHX_ PerlIO *f);
51 static void nxt_perl_psgi_layer_stream_set_ptrcnt(pTHX_ PerlIO *f,
52     STDCHAR *ptr, SSize_t cnt);
53 
54 
55 static PERLIO_FUNCS_DECL(PerlIO_NGINX_Unit) = {
56     sizeof(PerlIO_funcs),
57     "NGINX_Unit_PSGI_Layer_Stream",
58     sizeof(nxt_perl_psgi_layer_stream_t),
59     PERLIO_K_BUFFERED | PERLIO_K_RAW,
60     nxt_perl_psgi_layer_stream_pushed,
61     nxt_perl_psgi_layer_stream_popped,
62     nxt_perl_psgi_layer_stream_open,
63     PerlIOBase_binmode,
64     nxt_perl_psgi_layer_stream_arg,
65     nxt_perl_psgi_layer_stream_fileno,
66     nxt_perl_psgi_layer_stream_dup,
67     nxt_perl_psgi_layer_stream_read,
68     NULL,
69     nxt_perl_psgi_layer_stream_write,
70     nxt_perl_psgi_layer_stream_seek,
71     nxt_perl_psgi_layer_stream_tell,
72     nxt_perl_psgi_layer_stream_close,
73     nxt_perl_psgi_layer_stream_flush,
74     nxt_perl_psgi_layer_stream_fill,
75     nxt_perl_psgi_layer_stream_eof,
76     PerlIOBase_error,
77     PerlIOBase_clearerr,
78     PerlIOBase_setlinebuf,
79     nxt_perl_psgi_layer_stream_get_base,
80     nxt_perl_psgi_layer_stream_buffersize,
81     nxt_perl_psgi_layer_stream_get_ptr,
82     nxt_perl_psgi_layer_stream_get_cnt,
83     nxt_perl_psgi_layer_stream_set_ptrcnt,
84 };
85 
86 
87 static IV
88 nxt_perl_psgi_layer_stream_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg,
89     PerlIO_funcs *tab)
90 {
91     nxt_perl_psgi_layer_stream_t  *unit_stream;
92 
93     unit_stream = PerlIOSelf(f, nxt_perl_psgi_layer_stream_t);
94 
95     if (arg != NULL && SvOK(arg)) {
96         unit_stream->var = arg;
97     }
98 
99     SvSETMAGIC(unit_stream->var);
100 
101     return PerlIOBase_pushed(aTHX_ f, mode, Nullsv, tab);
102 }
103 
104 
105 static IV
106 nxt_perl_psgi_layer_stream_popped(pTHX_ PerlIO *f)
107 {
108     nxt_perl_psgi_layer_stream_t  *unit_stream;
109 
110     unit_stream = PerlIOSelf(f, nxt_perl_psgi_layer_stream_t);
111 
112     if (unit_stream->var != NULL) {
113         SvREFCNT_dec(unit_stream->var);
114         unit_stream->var = Nullsv;
115     }
116 
117     return 0;
118 }
119 
120 
121 static PerlIO *
122 nxt_perl_psgi_layer_stream_open(pTHX_ PerlIO_funcs *self,
123     PerlIO_list_t *layers, IV n,
124     const char *mode, int fd, int imode, int perm,
125     PerlIO *f, int narg, SV **args)
126 {
127     SV  *arg;
128 
129     arg = (narg > 0) ? *args : PerlIOArg;
130 
131     PERL_UNUSED_ARG(fd);
132     PERL_UNUSED_ARG(imode);
133     PERL_UNUSED_ARG(perm);
134 
135     if (SvROK(arg) || SvPOK(arg)) {
136 
137         if (f == NULL) {
138             f = PerlIO_allocate(aTHX);
139         }
140 
141         f = PerlIO_push(aTHX_ f, self, mode, arg);
142 
143         if (f != NULL) {
144             PerlIOBase(f)->flags |= PERLIO_F_OPEN;
145         }
146 
147         return f;
148     }
149 
150     return NULL;
151 }
152 
153 
154 static IV
155 nxt_perl_psgi_layer_stream_close(pTHX_ PerlIO *f)
156 {
157     IV  code;
158 
159     code = PerlIOBase_close(aTHX_ f);
160     PerlIOBase(f)->flags &= ~(PERLIO_F_RDBUF | PERLIO_F_WRBUF);
161 
162     return code;
163 }
164 
165 
166 static IV
167 nxt_perl_psgi_layer_stream_fileno(pTHX_ PerlIO *f)
168 {
169     PERL_UNUSED_ARG(f);
170     return -1;
171 }
172 
173 
174 static SSize_t
175 nxt_perl_psgi_layer_stream_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
176 {
177     nxt_perl_psgi_io_arg_t        *arg;
178     nxt_perl_psgi_layer_stream_t  *unit_stream;
179 
180     if (f == NULL) {
181         return 0;
182     }
183 
184     unit_stream = PerlIOSelf(f, nxt_perl_psgi_layer_stream_t);
185     arg = (nxt_perl_psgi_io_arg_t *) (intptr_t) SvIV(SvRV(unit_stream->var));
186 
187     if ((PerlIOBase(f)->flags & PERLIO_F_CANREAD) == 0) {
188         PerlIOBase(f)->flags |= PERLIO_F_ERROR;
189 
190         SETERRNO(EBADF, SS_IVCHAN);
191 
192         return 0;
193     }
194 
195     return (SSize_t) arg->read(PERL_GET_CONTEXT, arg, vbuf, count);
196 }
197 
198 
199 static SSize_t
200 nxt_perl_psgi_layer_stream_write(pTHX_ PerlIO *f,
201     const void *vbuf, Size_t count)
202 {
203     nxt_perl_psgi_io_arg_t        *arg;
204     nxt_perl_psgi_layer_stream_t  *unit_stream;
205 
206     if (PerlIOBase(f)->flags & PERLIO_F_CANWRITE) {
207 
208         unit_stream = PerlIOSelf(f, nxt_perl_psgi_layer_stream_t);
209 
210         arg = (nxt_perl_psgi_io_arg_t *)
211             (intptr_t) SvIV(SvRV(unit_stream->var));
212 
213         return (SSize_t) arg->write(PERL_GET_CONTEXT, arg, vbuf, count);
214     }
215 
216     return 0;
217 }
218 
219 
220 static IV
221 nxt_perl_psgi_layer_stream_seek(pTHX_ PerlIO *f, Off_t offset, int whence)
222 {
223     PERL_UNUSED_ARG(f);
224     return 0;
225 }
226 
227 
228 static Off_t
229 nxt_perl_psgi_layer_stream_tell(pTHX_ PerlIO *f)
230 {
231     PERL_UNUSED_ARG(f);
232     return 0;
233 }
234 
235 
236 static IV
237 nxt_perl_psgi_layer_stream_fill(pTHX_ PerlIO *f)
238 {
239     PERL_UNUSED_ARG(f);
240     return -1;
241 }
242 
243 
244 static IV
245 nxt_perl_psgi_layer_stream_flush(pTHX_ PerlIO *f)
246 {
247     nxt_perl_psgi_io_arg_t        *arg;
248     nxt_perl_psgi_layer_stream_t  *unit_stream;
249 
250     unit_stream = PerlIOSelf(f, nxt_perl_psgi_layer_stream_t);
251     arg = (nxt_perl_psgi_io_arg_t *) (intptr_t) SvIV(SvRV(unit_stream->var));
252 
253     return (IV) arg->flush(PERL_GET_CONTEXT, arg);
254 }
255 
256 
257 static SV *
258 nxt_perl_psgi_layer_stream_arg(pTHX_ PerlIO * f,
259     CLONE_PARAMS *param, int flags)
260 {
261     SV                            *var;
262     nxt_perl_psgi_io_arg_t        *arg;
263     nxt_perl_psgi_layer_stream_t  *unit_stream;
264 
265     unit_stream = PerlIOSelf(f, nxt_perl_psgi_layer_stream_t);
266 
267     arg = (nxt_perl_psgi_io_arg_t *) (intptr_t) SvIV(SvRV(unit_stream->var));
268     var = unit_stream->var;
269 
270     if (flags & PERLIO_DUP_CLONE) {
271         var = PerlIO_sv_dup(aTHX_ var, param);
272 
273     } else if (flags & PERLIO_DUP_FD) {
274         var = newSV_type(SVt_RV);
275 
276         if (var == NULL) {
277             return NULL;
278         }
279 
280         sv_setptrref(var, arg);
281 
282     } else {
283         var = SvREFCNT_inc(var);
284     }
285 
286     return var;
287 }
288 
289 
290 static PerlIO *
291 nxt_perl_psgi_layer_stream_dup(pTHX_ PerlIO *f, PerlIO *o,
292     CLONE_PARAMS *param, int flags)
293 {
294     SV                            *var;
295     nxt_perl_psgi_layer_stream_t  *os, *fs;
296 
297     os = PerlIOSelf(o, nxt_perl_psgi_layer_stream_t);
298     fs = NULL;
299     var = os->var;
300 
301     os->var = newSV_type(SVt_RV);
302     f = PerlIOBase_dup(aTHX_ f, o, param, flags);
303 
304     if (f != NULL) {
305         fs = PerlIOSelf(f, nxt_perl_psgi_layer_stream_t);
306 
307         /* The "var" has been set by an implicit push and must be replaced. */
308         SvREFCNT_dec(fs->var);
309     }
310 
311     SvREFCNT_dec(os->var);
312     os->var = var;
313 
314     if (f != NULL) {
315         fs->var = nxt_perl_psgi_layer_stream_arg(aTHX_ o, param, flags);
316     }
317 
318     return f;
319 }
320 
321 
322 static IV
323 nxt_perl_psgi_layer_stream_eof(pTHX_ PerlIO *f)
324 {
325     return 1;
326 }
327 
328 
329 static STDCHAR *
330 nxt_perl_psgi_layer_stream_get_base(pTHX_ PerlIO *f)
331 {
332     return (STDCHAR *) NULL;
333 }
334 
335 
336 static STDCHAR *
337 nxt_perl_psgi_layer_stream_get_ptr(pTHX_ PerlIO *f)
338 {
339     return (STDCHAR *) NULL;
340 }
341 
342 
343 static SSize_t
344 nxt_perl_psgi_layer_stream_get_cnt(pTHX_ PerlIO *f)
345 {
346     return 0;
347 }
348 
349 
350 static Size_t
351 nxt_perl_psgi_layer_stream_buffersize(pTHX_ PerlIO *f)
352 {
353     return 0;
354 }
355 
356 
357 static void
358 nxt_perl_psgi_layer_stream_set_ptrcnt(pTHX_ PerlIO *f,
359     STDCHAR *ptr, SSize_t cnt)
360 {
361     /* Need some code. */
362 }
363 
364 
365 void
366 nxt_perl_psgi_layer_stream_init(pTHX)
367 {
368     PerlIO_define_layer(aTHX_ PERLIO_FUNCS_CAST(&PerlIO_NGINX_Unit));
369 }
370 
371 
372 PerlIO *
373 nxt_perl_psgi_layer_stream_fp_create(pTHX_ nxt_perl_psgi_io_arg_t *arg,
374     const char *mode)
375 {
376     SV      *arg_rv;
377     PerlIO  *fp;
378 
379     arg_rv = newSV_type(SVt_RV);
380 
381     if (arg_rv == NULL) {
382         return NULL;
383     }
384 
385     sv_setptrref(arg_rv, arg);
386 
387     fp = PerlIO_openn(aTHX_ "NGINX_Unit_PSGI_Layer_Stream",
388                       mode, 0, 0, 0, NULL, 1, &arg_rv);
389 
390     if (fp == NULL) {
391         SvREFCNT_dec(arg_rv);
392         return NULL;
393     }
394 
395     return fp;
396 }
397 
398 
399 void
400 nxt_perl_psgi_layer_stream_fp_destroy(pTHX_ PerlIO *io)
401 {
402     PerlIO_close(io);
403 }
404 
405 
406 SV *
407 nxt_perl_psgi_layer_stream_io_create(pTHX_ PerlIO *fp)
408 {
409     SV  *rvio;
410     IO  *thatio;
411 
412     thatio = newIO();
413 
414     if (thatio == NULL) {
415         return NULL;
416     }
417 
418     IoOFP(thatio) = fp;
419     IoIFP(thatio) = fp;
420 
421     rvio = newRV_noinc((SV *) thatio);
422 
423     if (rvio == NULL) {
424         SvREFCNT_dec(thatio);
425         return NULL;
426     }
427 
428     return rvio;
429 }
430 
431 
432 void
433 nxt_perl_psgi_layer_stream_io_destroy(pTHX_ SV *rvio)
434 {
435     SvREFCNT_dec(rvio);
436 }
437