File Coverage

schmorp.h
Criterion Covered Total %
statement 11 97 11.3
branch 6 90 6.6
condition n/a
subroutine n/a
pod n/a
total 17 187 9.0


line stmt bran cond sub pod time code
1             #ifndef SCHMORP_PERL_H_
2             #define SCHMORP_PERL_H_
3              
4             /* WARNING
5             * This header file is a shared resource between many modules.
6             * perl header files MUST already be included.
7             */
8              
9             #include
10             #include
11              
12             #if defined(WIN32 ) || defined(_MINIX)
13             # define SCHMORP_H_PREFER_SELECT 1
14             #endif
15              
16             #if !SCHMORP_H_PREFER_SELECT
17             # include
18             #endif
19              
20             /* useful stuff, used by schmorp mostly */
21              
22             #include "patchlevel.h"
23              
24             #define PERL_VERSION_ATLEAST(a,b,c) \
25             (PERL_REVISION > (a) \
26             || (PERL_REVISION == (a) \
27             && (PERL_VERSION > (b) \
28             || (PERL_VERSION == (b) && PERL_SUBVERSION >= (c)))))
29              
30             #ifndef PERL_MAGIC_ext
31             # define PERL_MAGIC_ext '~'
32             #endif
33              
34             #if !PERL_VERSION_ATLEAST (5,6,0)
35             # ifndef PL_ppaddr
36             # define PL_ppaddr ppaddr
37             # endif
38             # ifndef call_sv
39             # define call_sv perl_call_sv
40             # endif
41             # ifndef get_sv
42             # define get_sv perl_get_sv
43             # endif
44             # ifndef get_cv
45             # define get_cv perl_get_cv
46             # endif
47             # ifndef IS_PADGV
48             # define IS_PADGV(v) 0
49             # endif
50             # ifndef IS_PADCONST
51             # define IS_PADCONST(v) 0
52             # endif
53             #endif
54              
55             /* use NV for 32 bit perls as it allows larger offsets */
56             #if IVSIZE >= 8
57             typedef IV VAL64;
58             # define SvVAL64(sv) SvIV (sv)
59             # define newSVval64(i64) newSViv (i64)
60             # define sv_setval64(sv,i64) sv_setiv ((sv), (i64))
61             #else
62             typedef NV VAL64;
63             # define SvVAL64(sv) SvNV (sv)
64             # define newSVval64(i64) newSVnv (i64)
65             # define sv_setval64(sv,i64) sv_setnv ((sv), (i64))
66             #endif
67              
68             /* typemap for the above */
69             /*
70             VAL64 T_VAL64
71              
72             INPUT
73              
74             T_VAL64
75             $var = ($type)SvVAL64 ($arg);
76              
77             OUTPUT
78              
79             T_VAL64
80             $arg = newSVval64 ($var);
81             */
82              
83             /* 5.11 */
84             #ifndef CxHASARGS
85             # define CxHASARGS(cx) (cx)->blk_sub.hasargs
86             #endif
87              
88             /* 5.10.0 */
89             #ifndef SvREFCNT_inc_NN
90             # define SvREFCNT_inc_NN(sv) SvREFCNT_inc (sv)
91             #endif
92              
93             /* 5.8.8 */
94             #ifndef GV_NOTQUAL
95             # define GV_NOTQUAL 0
96             #endif
97             #ifndef newSV
98             # define newSV(l) NEWSV(0,l)
99             #endif
100             #ifndef CvISXSUB_on
101             # define CvISXSUB_on(cv) (void)cv
102             #endif
103             #ifndef CvISXSUB
104             # define CvISXSUB(cv) (CvXSUB (cv) ? TRUE : FALSE)
105             #endif
106             #ifndef Newx
107             # define Newx(ptr,nitems,type) New (0,ptr,nitems,type)
108             #endif
109              
110             /* 5.8.7 */
111             #ifndef SvRV_set
112             # define SvRV_set(s,v) SvRV(s) = (v)
113             #endif
114              
115             static int
116 15           s_signum (SV *sig)
117             {
118             #ifndef SIG_SIZE
119             /* kudos to Slaven Rezic for the idea */
120             static char sig_size [] = { SIG_NUM };
121             # define SIG_SIZE (sizeof (sig_size) + 1)
122             #endif
123             dTHX;
124             int signum;
125              
126 15 50         SvGETMAGIC (sig);
    0          
127              
128 140 50         for (signum = 1; signum < SIG_SIZE; ++signum)
129 140 50         if (strEQ (SvPV_nolen (sig), PL_sig_name [signum]))
    100          
130 15           return signum;
131              
132 0 0         signum = SvIV (sig);
133              
134 0 0         if (signum > 0 && signum < SIG_SIZE)
    0          
135 0           return signum;
136              
137 0           return -1;
138             }
139              
140             static int
141 0           s_signum_croak (SV *sig)
142             {
143 0           int signum = s_signum (sig);
144              
145 0 0         if (signum < 0)
146             {
147             dTHX;
148 0 0         croak ("%s: invalid signal name or number", SvPV_nolen (sig));
149             }
150              
151 0           return signum;
152             }
153              
154             static int
155 0           s_fileno (SV *fh, int wr)
156             {
157             dTHX;
158 0 0         SvGETMAGIC (fh);
    0          
159              
160 0 0         if (SvROK (fh))
161             {
162 0           fh = SvRV (fh);
163 0 0         SvGETMAGIC (fh);
    0          
164             }
165              
166 0 0         if (SvTYPE (fh) == SVt_PVGV)
167 0 0         return PerlIO_fileno (wr ? IoOFP (sv_2io (fh)) : IoIFP (sv_2io (fh)));
168              
169 0 0         if (SvOK (fh) && (SvIV (fh) >= 0) && (SvIV (fh) < 0x7fffffffL))
    0          
    0          
    0          
    0          
    0          
    0          
170 0 0         return SvIV (fh);
171              
172 0           return -1;
173             }
174              
175             static int
176 0           s_fileno_croak (SV *fh, int wr)
177             {
178 0           int fd = s_fileno (fh, wr);
179              
180 0 0         if (fd < 0)
181             {
182             dTHX;
183 0 0         croak ("%s: illegal fh argument, either not an OS file or read/write mode mismatch", SvPV_nolen (fh));
184             }
185              
186 0           return fd;
187             }
188              
189             static SV *
190 30           s_get_cv (SV *cb_sv)
191             {
192             dTHX;
193             HV *st;
194             GV *gvp;
195            
196 30           return (SV *)sv_2cv (cb_sv, &st, &gvp, 0);
197             }
198              
199             static SV *
200 30           s_get_cv_croak (SV *cb_sv)
201             {
202 30           SV *cv = s_get_cv (cb_sv);
203              
204 30 50         if (!cv)
205             {
206             dTHX;
207 0 0         croak ("%s: callback must be a CODE reference or another callable object", SvPV_nolen (cb_sv));
208             }
209              
210 30           return cv;
211             }
212              
213             /*****************************************************************************/
214             /* gensub: simple closure generation utility */
215              
216             #define S_GENSUB_ARG CvXSUBANY (cv).any_ptr
217              
218             /* create a closure from XS, returns a code reference */
219             /* the arg can be accessed via GENSUB_ARG from the callback */
220             /* the callback must use dXSARGS/XSRETURN */
221             static SV *
222 0           s_gensub (pTHX_ void (*xsub)(pTHX_ CV *), void *arg)
223             {
224 0           CV *cv = (CV *)newSV (0);
225              
226 0           sv_upgrade ((SV *)cv, SVt_PVCV);
227              
228 0           CvANON_on (cv);
229 0           CvISXSUB_on (cv);
230 0           CvXSUB (cv) = xsub;
231 0           S_GENSUB_ARG = arg;
232              
233 0           return newRV_noinc ((SV *)cv);
234             }
235              
236             /*****************************************************************************/
237             /* portable pipe/socketpair */
238              
239             #if defined(USE_SOCKETS_AS_HANDLES) || PERL_VERSION_ATLEAST(5,18,0)
240             # define S_TO_HANDLE(x) ((HANDLE)win32_get_osfhandle (x))
241             #else
242             # define S_TO_HANDLE(x) ((HANDLE)x)
243             #endif
244              
245             #ifdef _WIN32
246             /* taken almost verbatim from libev's ev_win32.c */
247             /* oh, the humanity! */
248             static int
249             s_pipe (int filedes [2])
250             {
251             dTHX;
252              
253             struct sockaddr_in addr = { 0 };
254             int addr_size = sizeof (addr);
255             struct sockaddr_in adr2;
256             int adr2_size = sizeof (adr2);
257             SOCKET listener;
258             SOCKET sock [2] = { -1, -1 };
259              
260             if ((listener = socket (AF_INET, SOCK_STREAM, 0)) == INVALID_SOCKET)
261             return -1;
262              
263             addr.sin_family = AF_INET;
264             addr.sin_addr.s_addr = htonl (INADDR_LOOPBACK);
265             addr.sin_port = 0;
266              
267             if (bind (listener, (struct sockaddr *)&addr, addr_size))
268             goto fail;
269              
270             if (getsockname (listener, (struct sockaddr *)&addr, &addr_size))
271             goto fail;
272              
273             if (listen (listener, 1))
274             goto fail;
275              
276             if ((sock [0] = socket (AF_INET, SOCK_STREAM, 0)) == INVALID_SOCKET)
277             goto fail;
278              
279             if (connect (sock [0], (struct sockaddr *)&addr, addr_size))
280             goto fail;
281              
282             if ((sock [1] = accept (listener, 0, 0)) < 0)
283             goto fail;
284              
285             /* windows vista returns fantasy port numbers for getpeername.
286             * example for two interconnected tcp sockets:
287             *
288             * (Socket::unpack_sockaddr_in getsockname $sock0)[0] == 53364
289             * (Socket::unpack_sockaddr_in getpeername $sock0)[0] == 53363
290             * (Socket::unpack_sockaddr_in getsockname $sock1)[0] == 53363
291             * (Socket::unpack_sockaddr_in getpeername $sock1)[0] == 53365
292             *
293             * wow! tridirectional sockets!
294             *
295             * this way of checking ports seems to work:
296             */
297             if (getpeername (sock [0], (struct sockaddr *)&addr, &addr_size))
298             goto fail;
299              
300             if (getsockname (sock [1], (struct sockaddr *)&adr2, &adr2_size))
301             goto fail;
302              
303             errno = WSAEINVAL;
304             if (addr_size != adr2_size
305             || addr.sin_addr.s_addr != adr2.sin_addr.s_addr /* just to be sure, I mean, it's windows */
306             || addr.sin_port != adr2.sin_port)
307             goto fail;
308              
309             closesocket (listener);
310              
311             #if defined(USE_SOCKETS_AS_HANDLES) || PERL_VERSION_ATLEAST(5,18,0)
312             /* when select isn't winsocket, we also expect socket, connect, accept etc.
313             * to work on fds */
314             filedes [0] = sock [0];
315             filedes [1] = sock [1];
316             #else
317             filedes [0] = _open_osfhandle (sock [0], 0);
318             filedes [1] = _open_osfhandle (sock [1], 0);
319             #endif
320              
321             return 0;
322              
323             fail:
324             closesocket (listener);
325              
326             if (sock [0] != INVALID_SOCKET) closesocket (sock [0]);
327             if (sock [1] != INVALID_SOCKET) closesocket (sock [1]);
328              
329             return -1;
330             }
331              
332             #define s_socketpair(domain,type,protocol,filedes) s_pipe (filedes)
333              
334             static int
335             s_fd_blocking (int fd, int blocking)
336             {
337             u_long nonblocking = !blocking;
338              
339             return ioctlsocket ((SOCKET)S_TO_HANDLE (fd), FIONBIO, &nonblocking);
340             }
341              
342             #define s_fd_prepare(fd) s_fd_blocking (fd, 0)
343              
344             #else
345              
346             #define s_socketpair(domain,type,protocol,filedes) socketpair (domain, type, protocol, filedes)
347             #define s_pipe(filedes) pipe (filedes)
348              
349             static int
350 0           s_fd_blocking (int fd, int blocking)
351             {
352 0 0         return fcntl (fd, F_SETFL, blocking ? 0 : O_NONBLOCK);
353             }
354              
355             static int
356 0           s_fd_prepare (int fd)
357             {
358 0           return s_fd_blocking (fd, 0)
359 0 0         || fcntl (fd, F_SETFD, FD_CLOEXEC);
    0          
360             }
361              
362             #endif
363              
364             #if HAVE_EVENTFD
365             # include
366             #else
367             # if __linux && (__GLIBC__ > 2 || (__GLIBC__ == 2 && __GLIBC_MINOR__ >= 7))
368             # define SCHMORP_H_HAVE_EVENTFD 1
369             /* our minimum requirement is glibc 2.7 which has the stub, but not the header */
370             # include
371             # ifdef __cplusplus
372             extern "C" {
373             # endif
374             int eventfd (unsigned int initval, int flags);
375             # ifdef __cplusplus
376             }
377             # endif
378             # else
379             # define eventfd(initval,flags) -1
380             # endif
381             #endif
382              
383             typedef struct {
384             int fd[2]; /* read, write fd, might be equal */
385             int len; /* write length (1 pipe/socket, 8 eventfd) */
386             } s_epipe;
387              
388             static int
389 0           s_epipe_new (s_epipe *epp)
390             {
391             s_epipe ep;
392              
393 0           ep.fd [0] = ep.fd [1] = eventfd (0, 0);
394              
395 0 0         if (ep.fd [0] >= 0)
396             {
397 0           s_fd_prepare (ep.fd [0]);
398 0           ep.len = 8;
399             }
400             else
401             {
402 0 0         if (s_pipe (ep.fd))
403 0           return -1;
404              
405 0 0         if (s_fd_prepare (ep.fd [0])
406 0 0         || s_fd_prepare (ep.fd [1]))
407             {
408             dTHX;
409              
410 0           close (ep.fd [0]);
411 0           close (ep.fd [1]);
412 0           return -1;
413             }
414              
415 0           ep.len = 1;
416             }
417              
418 0           *epp = ep;
419 0           return 0;
420             }
421              
422             static void
423 0           s_epipe_destroy (s_epipe *epp)
424             {
425             dTHX;
426              
427 0           close (epp->fd [0]);
428              
429 0 0         if (epp->fd [1] != epp->fd [0])
430 0           close (epp->fd [1]);
431              
432 0           epp->len = 0;
433 0           }
434              
435             static void
436 0           s_epipe_signal (s_epipe *epp)
437             {
438             #ifdef _WIN32
439             /* perl overrides send with a function that crashes in other threads.
440             * unfortunately, it overrides it with an argument-less macro, so
441             * there is no way to force usage of the real send function.
442             * incompetent windows programmers - is this redundant?
443             */
444             DWORD dummy;
445             WriteFile (S_TO_HANDLE (epp->fd [1]), (LPCVOID)&dummy, 1, &dummy, 0);
446             #else
447             static uint64_t counter = 1;
448             /* some modules accept fd's from outside, support eventfd here */
449 0 0         if (write (epp->fd [1], &counter, epp->len) < 0
450 0 0         && errno == EINVAL
451 0 0         && epp->len != 8)
452 0           write (epp->fd [1], &counter, (epp->len = 8));
453             #endif
454 0           }
455              
456             static void
457 0           s_epipe_drain (s_epipe *epp)
458             {
459             dTHX;
460             char buf [9];
461              
462             #ifdef _WIN32
463             recv (epp->fd [0], buf, sizeof (buf), 0);
464             #else
465 0           read (epp->fd [0], buf, sizeof (buf));
466             #endif
467 0           }
468              
469             /* like new, but dups over old */
470             static int
471 0           s_epipe_renew (s_epipe *epp)
472             {
473             dTHX;
474             s_epipe epn;
475              
476 0 0         if (epp->fd [1] != epp->fd [0])
477 0           close (epp->fd [1]);
478              
479 0 0         if (s_epipe_new (&epn))
480 0           return -1;
481              
482 0 0         if (epp->len)
483             {
484 0 0         if (dup2 (epn.fd [0], epp->fd [0]) < 0)
485 0           croak ("unable to dup over old event pipe"); /* should not croak */
486              
487 0           close (epn.fd [0]);
488              
489 0 0         if (epn.fd [0] == epn.fd [1])
490 0           epn.fd [1] = epp->fd [0];
491              
492 0           epn.fd [0] = epp->fd [0];
493             }
494              
495 0           *epp = epn;
496              
497 0           return 0;
498             }
499              
500             #define s_epipe_fd(epp) ((epp)->fd [0])
501              
502             static int
503 0           s_epipe_wait (s_epipe *epp)
504             {
505             dTHX;
506             #if SCHMORP_H_PREFER_SELECT
507             fd_set rfd;
508             int fd = s_epipe_fd (epp);
509              
510             FD_ZERO (&rfd);
511             FD_SET (fd, &rfd);
512              
513             return PerlSock_select (fd + 1, &rfd, 0, 0, 0);
514             #else
515             /* poll is preferable on posix systems */
516             struct pollfd pfd;
517              
518 0           pfd.fd = s_epipe_fd (epp);
519 0           pfd.events = POLLIN;
520              
521 0           return poll (&pfd, 1, -1);
522             #endif
523             }
524              
525             #endif
526