This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Protect against pack/unpack repeat count overflows,
[perl5.git] / ext / Fcntl / Fcntl.xs
CommitLineData
c5be433b 1#define PERL_NO_GET_CONTEXT
a0d0e21e
LW
2#include "EXTERN.h"
3#include "perl.h"
4#include "XSUB.h"
5
75ced34b
PP
6#ifdef VMS
7# include <file.h>
8#else
cd661bb6
NIS
9#if defined(__GNUC__) && defined(__cplusplus) && defined(WIN32)
10#define _NO_OLDNAMES
11#endif
75ced34b 12# include <fcntl.h>
cd661bb6
NIS
13#if defined(__GNUC__) && defined(__cplusplus) && defined(WIN32)
14#undef _NO_OLDNAMES
15#endif
75ced34b 16#endif
a0d0e21e 17
8e07c86e
AD
18/* This comment is a kludge to get metaconfig to see the symbols
19 VAL_O_NONBLOCK
20 VAL_EAGAIN
21 RD_NODATA
22 EOF_NONBLOCK
23 and include the appropriate metaconfig unit
24 so that Configure will test how to turn on non-blocking I/O
25 for a file descriptor. See config.h for how to use these
26 in your extension.
27
28 While I'm at it, I'll have metaconfig look for HAS_POLL too.
29 --AD October 16, 1995
30*/
31
a0d0e21e 32static int
f0f333f4 33not_here(char *s)
a0d0e21e
LW
34{
35 croak("%s not implemented on this architecture", s);
36 return -1;
37}
38
39static double
f0f333f4 40constant(char *name, int arg)
a0d0e21e
LW
41{
42 errno = 0;
43 switch (*name) {
44 case 'F':
45 if (strnEQ(name, "F_", 2)) {
46 if (strEQ(name, "F_DUPFD"))
47#ifdef F_DUPFD
48 return F_DUPFD;
49#else
50 goto not_there;
51#endif
0fd60c2a
JH
52 if (strEQ(name, "F_EXLCK"))
53#ifdef F_EXLCK
54 return F_EXLCK;
55#else
56 goto not_there;
57#endif
a0d0e21e
LW
58 if (strEQ(name, "F_GETFD"))
59#ifdef F_GETFD
60 return F_GETFD;
61#else
62 goto not_there;
63#endif
0fd60c2a
JH
64 if (strEQ(name, "F_GETFL"))
65#ifdef F_GETFL
66 return F_GETFL;
67#else
68 goto not_there;
69#endif
a0d0e21e
LW
70 if (strEQ(name, "F_GETLK"))
71#ifdef F_GETLK
72 return F_GETLK;
73#else
74 goto not_there;
75#endif
5ff3f7a4
GS
76 if (strEQ(name, "F_GETLK64"))
77#ifdef F_GETLK64
78 return F_GETLK64;
79#else
80 goto not_there;
81#endif
5f832ef3
JH
82 if (strEQ(name, "F_GETOWN"))
83#ifdef F_GETOWN
84 return F_GETOWN;
85#else
86 goto not_there;
87#endif
0fd60c2a
JH
88 if (strEQ(name, "F_POSIX"))
89#ifdef F_POSIX
90 return F_POSIX;
a0d0e21e
LW
91#else
92 goto not_there;
93#endif
0fd60c2a
JH
94 if (strEQ(name, "F_RDLCK"))
95#ifdef F_RDLCK
96 return F_RDLCK;
a0d0e21e
LW
97#else
98 goto not_there;
99#endif
0fd60c2a
JH
100 if (strEQ(name, "F_SETFD"))
101#ifdef F_SETFD
102 return F_SETFD;
3e3baf6d
TB
103#else
104 goto not_there;
105#endif
232e078e
AD
106 if (strEQ(name, "F_SETFL"))
107#ifdef F_SETFL
108 return F_SETFL;
a0d0e21e
LW
109#else
110 goto not_there;
111#endif
d9fde92e
GS
112 if (strEQ(name, "F_SETLK"))
113#ifdef F_SETLK
114 return F_SETLK;
115#else
116 goto not_there;
117#endif
5ff3f7a4
GS
118 if (strEQ(name, "F_SETLK64"))
119#ifdef F_SETLK64
120 return F_SETLK64;
a0d0e21e
LW
121#else
122 goto not_there;
123#endif
124 if (strEQ(name, "F_SETLKW"))
125#ifdef F_SETLKW
126 return F_SETLKW;
127#else
128 goto not_there;
129#endif
5ff3f7a4
GS
130 if (strEQ(name, "F_SETLKW64"))
131#ifdef F_SETLKW64
132 return F_SETLKW64;
133#else
134 goto not_there;
135#endif
5f832ef3
JH
136 if (strEQ(name, "F_SETOWN"))
137#ifdef F_SETOWN
138 return F_SETOWN;
139#else
140 goto not_there;
141#endif
0fd60c2a
JH
142 if (strEQ(name, "F_SHLCK"))
143#ifdef F_SHLCK
144 return F_SHLCK;
a0d0e21e
LW
145#else
146 goto not_there;
147#endif
148 if (strEQ(name, "F_UNLCK"))
149#ifdef F_UNLCK
150 return F_UNLCK;
151#else
152 goto not_there;
153#endif
154 if (strEQ(name, "F_WRLCK"))
155#ifdef F_WRLCK
156 return F_WRLCK;
157#else
158 goto not_there;
159#endif
160 errno = EINVAL;
161 return 0;
3e3baf6d
TB
162 }
163 if (strEQ(name, "FAPPEND"))
164#ifdef FAPPEND
165 return FAPPEND;
166#else
167 goto not_there;
168#endif
169 if (strEQ(name, "FASYNC"))
170#ifdef FASYNC
171 return FASYNC;
172#else
173 goto not_there;
174#endif
175 if (strEQ(name, "FCREAT"))
176#ifdef FCREAT
177 return FCREAT;
178#else
179 goto not_there;
180#endif
181 if (strEQ(name, "FD_CLOEXEC"))
a0d0e21e
LW
182#ifdef FD_CLOEXEC
183 return FD_CLOEXEC;
184#else
185 goto not_there;
186#endif
0fd60c2a
JH
187 if (strEQ(name, "FDEFER"))
188#ifdef FDEFER
189 return FDEFER;
190#else
191 goto not_there;
192#endif
3e3baf6d
TB
193 if (strEQ(name, "FEXCL"))
194#ifdef FEXCL
195 return FEXCL;
196#else
197 goto not_there;
198#endif
199 if (strEQ(name, "FNDELAY"))
200#ifdef FNDELAY
201 return FNDELAY;
202#else
203 goto not_there;
204#endif
205 if (strEQ(name, "FNONBLOCK"))
206#ifdef FNONBLOCK
207 return FNONBLOCK;
208#else
209 goto not_there;
210#endif
211 if (strEQ(name, "FSYNC"))
212#ifdef FSYNC
213 return FSYNC;
214#else
215 goto not_there;
216#endif
217 if (strEQ(name, "FTRUNC"))
218#ifdef FTRUNC
219 return FTRUNC;
220#else
221 goto not_there;
222#endif
a0d0e21e 223 break;
7e1af8bc
PP
224 case 'L':
225 if (strnEQ(name, "LOCK_", 5)) {
226 /* We support flock() on systems which don't have it, so
227 always supply the constants. */
228 if (strEQ(name, "LOCK_SH"))
229#ifdef LOCK_SH
230 return LOCK_SH;
231#else
232 return 1;
233#endif
234 if (strEQ(name, "LOCK_EX"))
235#ifdef LOCK_EX
236 return LOCK_EX;
237#else
238 return 2;
239#endif
240 if (strEQ(name, "LOCK_NB"))
241#ifdef LOCK_NB
242 return LOCK_NB;
243#else
244 return 4;
245#endif
246 if (strEQ(name, "LOCK_UN"))
247#ifdef LOCK_UN
248 return LOCK_UN;
249#else
250 return 8;
251#endif
252 } else
253 goto not_there;
254 break;
a0d0e21e
LW
255 case 'O':
256 if (strnEQ(name, "O_", 2)) {
0fd60c2a
JH
257 if (strEQ(name, "O_ACCMODE"))
258#ifdef O_ACCMODE
259 return O_ACCMODE;
260#else
261 goto not_there;
262#endif
263 if (strEQ(name, "O_APPEND"))
264#ifdef O_APPEND
265 return O_APPEND;
266#else
267 goto not_there;
268#endif
269 if (strEQ(name, "O_ASYNC"))
270#ifdef O_ASYNC
271 return O_ASYNC;
272#else
273 goto not_there;
274#endif
275 if (strEQ(name, "O_BINARY"))
276#ifdef O_BINARY
277 return O_BINARY;
278#else
279 goto not_there;
280#endif
a0d0e21e
LW
281 if (strEQ(name, "O_CREAT"))
282#ifdef O_CREAT
283 return O_CREAT;
284#else
285 goto not_there;
286#endif
0fd60c2a
JH
287 if (strEQ(name, "O_DEFER"))
288#ifdef O_DEFER
289 return O_DEFER;
290#else
291 goto not_there;
292#endif
293 if (strEQ(name, "O_DSYNC"))
294#ifdef O_DSYNC
295 return O_DSYNC;
296#else
297 goto not_there;
298#endif
a0d0e21e
LW
299 if (strEQ(name, "O_EXCL"))
300#ifdef O_EXCL
301 return O_EXCL;
302#else
303 goto not_there;
304#endif
0fd60c2a
JH
305 if (strEQ(name, "O_EXLOCK"))
306#ifdef O_EXLOCK
307 return O_EXLOCK;
a0d0e21e
LW
308#else
309 goto not_there;
310#endif
5ff3f7a4
GS
311 if (strEQ(name, "O_LARGEFILE"))
312#ifdef O_LARGEFILE
313 return O_LARGEFILE;
314#else
315 goto not_there;
316#endif
0fd60c2a
JH
317 if (strEQ(name, "O_NDELAY"))
318#ifdef O_NDELAY
319 return O_NDELAY;
a0d0e21e
LW
320#else
321 goto not_there;
322#endif
0fd60c2a
JH
323 if (strEQ(name, "O_NOCTTY"))
324#ifdef O_NOCTTY
325 return O_NOCTTY;
a0d0e21e
LW
326#else
327 goto not_there;
328#endif
329 if (strEQ(name, "O_NONBLOCK"))
330#ifdef O_NONBLOCK
331 return O_NONBLOCK;
332#else
333 goto not_there;
334#endif
a0d0e21e
LW
335 if (strEQ(name, "O_RDONLY"))
336#ifdef O_RDONLY
337 return O_RDONLY;
338#else
339 goto not_there;
340#endif
341 if (strEQ(name, "O_RDWR"))
342#ifdef O_RDWR
343 return O_RDWR;
344#else
345 goto not_there;
346#endif
0fd60c2a
JH
347 if (strEQ(name, "O_RSYNC"))
348#ifdef O_RSYNC
349 return O_RSYNC;
705af498
JH
350#else
351 goto not_there;
352#endif
353 if (strEQ(name, "O_SHLOCK"))
354#ifdef O_SHLOCK
355 return O_SHLOCK;
356#else
357 goto not_there;
358#endif
0fd60c2a
JH
359 if (strEQ(name, "O_SYNC"))
360#ifdef O_SYNC
361 return O_SYNC;
705af498
JH
362#else
363 goto not_there;
364#endif
0fd60c2a
JH
365 if (strEQ(name, "O_TEXT"))
366#ifdef O_TEXT
367 return O_TEXT;
705af498
JH
368#else
369 goto not_there;
370#endif
0fd60c2a
JH
371 if (strEQ(name, "O_TRUNC"))
372#ifdef O_TRUNC
373 return O_TRUNC;
705af498
JH
374#else
375 goto not_there;
376#endif
0fd60c2a
JH
377 if (strEQ(name, "O_WRONLY"))
378#ifdef O_WRONLY
379 return O_WRONLY;
705af498
JH
380#else
381 goto not_there;
382#endif
a0d0e21e
LW
383 } else
384 goto not_there;
385 break;
386 }
387 errno = EINVAL;
388 return 0;
389
390not_there:
391 errno = ENOENT;
392 return 0;
393}
394
395
396MODULE = Fcntl PACKAGE = Fcntl
397
398double
399constant(name,arg)
400 char * name
401 int arg
402