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
|
|
|
|
|
|
|
|