This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Integrate mainline.
[perl5.git] / ext / Fcntl / Fcntl.xs
1 #define PERL_NO_GET_CONTEXT
2 #include "EXTERN.h"
3 #include "perl.h"
4 #include "XSUB.h"
5
6 #ifdef VMS
7 #  include <file.h>
8 #else
9 #if defined(__GNUC__) && defined(__cplusplus) && defined(WIN32)
10 #define _NO_OLDNAMES
11 #endif 
12 #  include <fcntl.h>
13 #if defined(__GNUC__) && defined(__cplusplus) && defined(WIN32)
14 #undef _NO_OLDNAMES
15 #endif 
16 #endif
17
18 #ifdef I_UNISTD
19 #include <unistd.h>
20 #endif
21
22 /* This comment is a kludge to get metaconfig to see the symbols
23     VAL_O_NONBLOCK
24     VAL_EAGAIN
25     RD_NODATA
26     EOF_NONBLOCK
27    and include the appropriate metaconfig unit
28    so that Configure will test how to turn on non-blocking I/O
29    for a file descriptor.  See config.h for how to use these
30    in your extension. 
31    
32    While I'm at it, I'll have metaconfig look for HAS_POLL too.
33    --AD  October 16, 1995
34 */
35
36 static int
37 not_here(char *s)
38 {
39     croak("%s not implemented on this architecture", s);
40     return -1;
41 }
42
43 static IV
44 constant(char *name)
45 {
46     errno = 0;
47     switch (*(name++)) {
48     case '_':
49         if (strEQ(name, "S_IFMT")) /* Yes, on name _S_IFMT return S_IFMT. */
50 #ifdef S_IFMT
51           return S_IFMT;
52 #else
53           goto not_there;
54 #endif
55         break;
56     case 'F':
57         if (*name == '_') {
58             name++;
59             if (strEQ(name, "ALLOCSP"))
60 #ifdef F_ALLOCSP
61                 return F_ALLOCSP;
62 #else
63                 goto not_there;
64 #endif
65             if (strEQ(name, "ALLOCSP64"))
66 #ifdef F_ALLOCSP64
67                 return F_ALLOCSP64;
68 #else
69                 goto not_there;
70 #endif
71             if (strEQ(name, "COMPAT"))
72 #ifdef F_COMPAT
73                 return F_COMPAT;
74 #else
75                 goto not_there;
76 #endif
77             if (strEQ(name, "DUP2FD"))
78 #ifdef F_DUP2FD
79                 return F_DUP2FD;
80 #else
81                 goto not_there;
82 #endif
83             if (strEQ(name, "DUPFD"))
84 #ifdef F_DUPFD
85                 return F_DUPFD;
86 #else
87                 goto not_there;
88 #endif
89             if (strEQ(name, "EXLCK"))
90 #ifdef F_EXLCK
91                 return F_EXLCK;
92 #else
93                 goto not_there;
94 #endif
95             if (strEQ(name, "FREESP"))
96 #ifdef F_FREESP
97                 return F_FREESP;
98 #else
99                 goto not_there;
100 #endif
101             if (strEQ(name, "FREESP64"))
102 #ifdef F_FREESP64
103                 return F_FREESP64;
104 #else
105                 goto not_there;
106 #endif
107             if (strEQ(name, "FSYNC"))
108 #ifdef F_FSYNC
109                 return F_FSYNC;
110 #else
111                 goto not_there;
112 #endif
113             if (strEQ(name, "FSYNC64"))
114 #ifdef F_FSYNC64
115                 return F_FSYNC64;
116 #else
117                 goto not_there;
118 #endif
119             if (strEQ(name, "GETFD"))
120 #ifdef F_GETFD
121                 return F_GETFD;
122 #else
123                 goto not_there;
124 #endif
125             if (strEQ(name, "GETFL"))
126 #ifdef F_GETFL
127                 return F_GETFL;
128 #else
129                 goto not_there;
130 #endif
131             if (strEQ(name, "GETLK"))
132 #ifdef F_GETLK
133                 return F_GETLK;
134 #else
135                 goto not_there;
136 #endif
137             if (strEQ(name, "GETLK64"))
138 #ifdef F_GETLK64
139                 return F_GETLK64;
140 #else
141                 goto not_there;
142 #endif
143             if (strEQ(name, "GETOWN"))
144 #ifdef F_GETOWN
145                 return F_GETOWN;
146 #else
147                 goto not_there;
148 #endif
149             if (strEQ(name, "NODNY"))
150 #ifdef F_NODNY
151                 return F_NODNY;
152 #else
153                 goto not_there;
154 #endif
155             if (strEQ(name, "POSIX"))
156 #ifdef F_POSIX
157                 return F_POSIX;
158 #else
159                 goto not_there;
160 #endif
161             if (strEQ(name, "RDACC"))
162 #ifdef F_RDACC
163                 return F_RDACC;
164 #else
165                 goto not_there;
166 #endif
167             if (strEQ(name, "RDDNY"))
168 #ifdef F_RDDNY
169                 return F_RDDNY;
170 #else
171                 goto not_there;
172 #endif
173             if (strEQ(name, "RDLCK"))
174 #ifdef F_RDLCK
175                 return F_RDLCK;
176 #else
177                 goto not_there;
178 #endif
179             if (strEQ(name, "RWACC"))
180 #ifdef F_RWACC
181                 return F_RWACC;
182 #else
183                 goto not_there;
184 #endif
185             if (strEQ(name, "RWDNY"))
186 #ifdef F_RWDNY
187                 return F_RWDNY;
188 #else
189                 goto not_there;
190 #endif
191             if (strEQ(name, "SETFD"))
192 #ifdef F_SETFD
193                 return F_SETFD;
194 #else
195                 goto not_there;
196 #endif
197             if (strEQ(name, "SETFL"))
198 #ifdef F_SETFL
199                 return F_SETFL;
200 #else
201                 goto not_there;
202 #endif
203             if (strEQ(name, "SETLK"))
204 #ifdef F_SETLK
205                 return F_SETLK;
206 #else
207                 goto not_there;
208 #endif
209             if (strEQ(name, "SETLK64"))
210 #ifdef F_SETLK64
211                 return F_SETLK64;
212 #else
213                 goto not_there;
214 #endif
215             if (strEQ(name, "SETLKW"))
216 #ifdef F_SETLKW
217                 return F_SETLKW;
218 #else
219                 goto not_there;
220 #endif
221             if (strEQ(name, "SETLKW64"))
222 #ifdef F_SETLKW64
223                 return F_SETLKW64;
224 #else
225                 goto not_there;
226 #endif
227             if (strEQ(name, "SETOWN"))
228 #ifdef F_SETOWN
229                 return F_SETOWN;
230 #else
231                 goto not_there;
232 #endif
233             if (strEQ(name, "SHARE"))
234 #ifdef F_SHARE
235                 return F_SHARE;
236 #else
237                 goto not_there;
238 #endif
239             if (strEQ(name, "SHLCK"))
240 #ifdef F_SHLCK
241                 return F_SHLCK;
242 #else
243                 goto not_there;
244 #endif
245             if (strEQ(name, "UNLCK"))
246 #ifdef F_UNLCK
247                 return F_UNLCK;
248 #else
249                 goto not_there;
250 #endif
251             if (strEQ(name, "UNSHARE"))
252 #ifdef F_UNSHARE
253                 return F_UNSHARE;
254 #else
255                 goto not_there;
256 #endif
257             if (strEQ(name, "WRACC"))
258 #ifdef F_WRACC
259                 return F_WRACC;
260 #else
261                 goto not_there;
262 #endif
263             if (strEQ(name, "WRDNY"))
264 #ifdef F_WRDNY
265                 return F_WRDNY;
266 #else
267                 goto not_there;
268 #endif
269             if (strEQ(name, "WRLCK"))
270 #ifdef F_WRLCK
271                 return F_WRLCK;
272 #else
273                 goto not_there;
274 #endif
275             errno = EINVAL;
276             return 0;
277         }
278         if (strEQ(name, "APPEND"))
279 #ifdef FAPPEND
280             return FAPPEND;
281 #else
282             goto not_there;
283 #endif
284         if (strEQ(name, "ASYNC"))
285 #ifdef FASYNC
286             return FASYNC;
287 #else
288             goto not_there;
289 #endif
290         if (strEQ(name, "CREAT"))
291 #ifdef FCREAT
292             return FCREAT;
293 #else
294             goto not_there;
295 #endif
296         if (strEQ(name, "D_CLOEXEC"))
297 #ifdef FD_CLOEXEC
298             return FD_CLOEXEC;
299 #else
300             goto not_there;
301 #endif
302         if (strEQ(name, "DEFER"))
303 #ifdef FDEFER
304             return FDEFER;
305 #else
306             goto not_there;
307 #endif
308         if (strEQ(name, "DSYNC"))
309 #ifdef FDSYNC
310             return FDSYNC;
311 #else
312             goto not_there;
313 #endif
314         if (strEQ(name, "EXCL"))
315 #ifdef FEXCL
316             return FEXCL;
317 #else
318             goto not_there;
319 #endif
320         if (strEQ(name, "LARGEFILE"))
321 #ifdef FLARGEFILE
322             return FLARGEFILE;
323 #else
324             goto not_there;
325 #endif
326         if (strEQ(name, "NDELAY"))
327 #ifdef FNDELAY
328             return FNDELAY;
329 #else
330             goto not_there;
331 #endif
332         if (strEQ(name, "NONBLOCK"))
333 #ifdef FNONBLOCK
334             return FNONBLOCK;
335 #else
336             goto not_there;
337 #endif
338         if (strEQ(name, "RSYNC"))
339 #ifdef FRSYNC
340             return FRSYNC;
341 #else
342             goto not_there;
343 #endif
344         if (strEQ(name, "SYNC"))
345 #ifdef FSYNC
346             return FSYNC;
347 #else
348             goto not_there;
349 #endif
350         if (strEQ(name, "TRUNC"))
351 #ifdef FTRUNC
352             return FTRUNC;
353 #else
354             goto not_there;
355 #endif
356         break;
357     case 'L':
358         if (strnEQ(name, "OCK_", 4)) {
359             /* We support flock() on systems which don't have it, so
360                always supply the constants. */
361             name += 4;
362             if (strEQ(name, "SH"))
363 #ifdef LOCK_SH
364                 return LOCK_SH;
365 #else
366                 return 1;
367 #endif
368             if (strEQ(name, "EX"))
369 #ifdef LOCK_EX
370                 return LOCK_EX;
371 #else
372                 return 2;
373 #endif
374             if (strEQ(name, "NB"))
375 #ifdef LOCK_NB
376                 return LOCK_NB;
377 #else
378                 return 4;
379 #endif
380             if (strEQ(name, "UN"))
381 #ifdef LOCK_UN
382                 return LOCK_UN;
383 #else
384                 return 8;
385 #endif
386         } else
387           goto not_there;
388         break;
389     case 'O':
390         if (name[0] == '_') {
391             name++;
392             if (strEQ(name, "ACCMODE"))
393 #ifdef O_ACCMODE
394                 return O_ACCMODE;
395 #else
396                 goto not_there;
397 #endif
398             if (strEQ(name, "APPEND"))
399 #ifdef O_APPEND
400                 return O_APPEND;
401 #else
402                 goto not_there;
403 #endif
404             if (strEQ(name, "ASYNC"))
405 #ifdef O_ASYNC
406                 return O_ASYNC;
407 #else
408                 goto not_there;
409 #endif
410             if (strEQ(name, "BINARY"))
411 #ifdef O_BINARY
412                 return O_BINARY;
413 #else
414                 goto not_there;
415 #endif
416             if (strEQ(name, "CREAT"))
417 #ifdef O_CREAT
418                 return O_CREAT;
419 #else
420                 goto not_there;
421 #endif
422             if (strEQ(name, "DEFER"))
423 #ifdef O_DEFER
424                 return O_DEFER;
425 #else
426                 goto not_there;
427 #endif
428             if (strEQ(name, "DIRECT"))
429 #ifdef O_DIRECT
430                 return O_DIRECT;
431 #else
432                 goto not_there;
433 #endif
434             if (strEQ(name, "DIRECTORY"))
435 #ifdef O_DIRECTORY
436                 return O_DIRECTORY;
437 #else
438                 goto not_there;
439 #endif
440             if (strEQ(name, "DSYNC"))
441 #ifdef O_DSYNC
442                 return O_DSYNC;
443 #else
444                 goto not_there;
445 #endif
446             if (strEQ(name, "EXCL"))
447 #ifdef O_EXCL
448                 return O_EXCL;
449 #else
450                 goto not_there;
451 #endif
452             if (strEQ(name, "EXLOCK"))
453 #ifdef O_EXLOCK
454                 return O_EXLOCK;
455 #else
456                 goto not_there;
457 #endif
458             if (strEQ(name, "LARGEFILE"))
459 #ifdef O_LARGEFILE
460                 return O_LARGEFILE;
461 #else
462                 goto not_there;
463 #endif
464             if (strEQ(name, "NDELAY"))
465 #ifdef O_NDELAY
466                 return O_NDELAY;
467 #else
468                 goto not_there;
469 #endif
470             if (strEQ(name, "NOCTTY"))
471 #ifdef O_NOCTTY
472                 return O_NOCTTY;
473 #else
474                 goto not_there;
475 #endif
476             if (strEQ(name, "NOFOLLOW"))
477 #ifdef O_NOFOLLOW
478                 return O_NOFOLLOW;
479 #else
480                 goto not_there;
481 #endif
482             if (strEQ(name, "NOINHERIT"))
483 #ifdef O_NOINHERIT
484                 return O_NOINHERIT;
485 #else
486                 goto not_there;
487 #endif
488             if (strEQ(name, "NONBLOCK"))
489 #ifdef O_NONBLOCK
490                 return O_NONBLOCK;
491 #else
492                 goto not_there;
493 #endif
494             if (strEQ(name, "RANDOM"))
495 #ifdef O_RANDOM
496                 return O_RANDOM;
497 #else
498                 goto not_there;
499 #endif
500             if (strEQ(name, "RAW"))
501 #ifdef O_RAW
502                 return O_RAW;
503 #else
504                 goto not_there;
505 #endif
506             if (strEQ(name, "RDONLY"))
507 #ifdef O_RDONLY
508                 return O_RDONLY;
509 #else
510                 goto not_there;
511 #endif
512             if (strEQ(name, "RDWR"))
513 #ifdef O_RDWR
514                 return O_RDWR;
515 #else
516                 goto not_there;
517 #endif
518             if (strEQ(name, "RSYNC"))
519 #ifdef O_RSYNC
520                 return O_RSYNC;
521 #else
522                 goto not_there;
523 #endif
524             if (strEQ(name, "SEQUENTIAL"))
525 #ifdef O_SEQUENTIAL
526                 return O_SEQUENTIAL;
527 #else
528                 goto not_there;
529 #endif
530             if (strEQ(name, "SHLOCK"))
531 #ifdef O_SHLOCK
532                 return O_SHLOCK;
533 #else
534                 goto not_there;
535 #endif
536             if (strEQ(name, "SYNC"))
537 #ifdef O_SYNC
538                 return O_SYNC;
539 #else
540                 goto not_there;
541 #endif
542             if (strEQ(name, "TEMPORARY"))
543 #ifdef O_TEMPORARY
544                 return O_TEMPORARY;
545 #else
546                 goto not_there;
547 #endif
548             if (strEQ(name, "TEXT"))
549 #ifdef O_TEXT
550                 return O_TEXT;
551 #else
552                 goto not_there;
553 #endif
554             if (strEQ(name, "TRUNC"))
555 #ifdef O_TRUNC
556                 return O_TRUNC;
557 #else
558                 goto not_there;
559 #endif
560             if (strEQ(name, "WRONLY"))
561 #ifdef O_WRONLY
562                 return O_WRONLY;
563 #else
564                 goto not_there;
565 #endif
566             if (strEQ(name, "ALIAS"))
567 #ifdef O_ALIAS
568                 return O_ALIAS;
569 #else
570                 goto not_there;
571 #endif
572             if (strEQ(name, "RSRC"))
573 #ifdef O_RSRC
574                 return O_RSRC;
575 #else
576                 goto not_there;
577 #endif
578         } else
579           goto not_there;
580         break;
581     case 'S':
582       switch (*(name++)) {
583       case '_':
584         if (strEQ(name, "ISUID"))
585 #ifdef S_ISUID
586           return S_ISUID;
587 #else
588           goto not_there;
589 #endif
590         if (strEQ(name, "ISGID"))
591 #ifdef S_ISGID
592           return S_ISGID;
593 #else
594           goto not_there;
595 #endif
596         if (strEQ(name, "ISVTX"))
597 #ifdef S_ISVTX
598           return S_ISVTX;
599 #else
600           goto not_there;
601 #endif
602         if (strEQ(name, "ISTXT"))
603 #ifdef S_ISTXT
604           return S_ISTXT;
605 #else
606           goto not_there;
607 #endif
608         if (strEQ(name, "IFREG"))
609 #ifdef S_IFREG
610           return S_IFREG;
611 #else
612           goto not_there;
613 #endif
614         if (strEQ(name, "IFDIR"))
615 #ifdef S_IFDIR
616           return S_IFDIR;
617 #else
618           goto not_there;
619 #endif
620         if (strEQ(name, "IFLNK"))
621 #ifdef S_IFLNK
622           return S_IFLNK;
623 #else
624           goto not_there;
625 #endif
626         if (strEQ(name, "IFSOCK"))
627 #ifdef S_IFSOCK
628           return S_IFSOCK;
629 #else
630           goto not_there;
631 #endif
632         if (strEQ(name, "IFBLK"))
633 #ifdef S_IFBLK
634           return S_IFBLK;
635 #else
636           goto not_there;
637 #endif
638         if (strEQ(name, "IFCHR"))
639 #ifdef S_IFCHR
640           return S_IFCHR;
641 #else
642           goto not_there;
643 #endif
644         if (strEQ(name, "IFIFO"))
645 #ifdef S_IFIFO
646           return S_IFIFO;
647 #else
648           goto not_there;
649 #endif
650         if (strEQ(name, "IFWHT"))
651 #ifdef S_IFWHT
652           return S_IFWHT;
653 #else
654           goto not_there;
655 #endif
656         if (strEQ(name, "ENFMT"))
657 #ifdef S_ENFMT
658           return S_ENFMT;
659 #else
660           goto not_there;
661 #endif
662         if (strEQ(name, "IRUSR"))
663 #ifdef S_IRUSR
664           return S_IRUSR;
665 #else
666           goto not_there;
667 #endif
668         if (strEQ(name, "IWUSR"))
669 #ifdef S_IWUSR
670           return S_IWUSR;
671 #else
672           goto not_there;
673 #endif
674         if (strEQ(name, "IXUSR"))
675 #ifdef S_IXUSR
676           return S_IXUSR;
677 #else
678           goto not_there;
679 #endif
680         if (strEQ(name, "IRWXU"))
681 #ifdef S_IRWXU
682           return S_IRWXU;
683 #else
684           goto not_there;
685 #endif
686         if (strEQ(name, "IRGRP"))
687 #ifdef S_IRGRP
688           return S_IRGRP;
689 #else
690           goto not_there;
691 #endif
692         if (strEQ(name, "IWGRP"))
693 #ifdef S_IWGRP
694           return S_IWGRP;
695 #else
696           goto not_there;
697 #endif
698         if (strEQ(name, "IXGRP"))
699 #ifdef S_IXGRP
700           return S_IXGRP;
701 #else
702           goto not_there;
703 #endif
704         if (strEQ(name, "IRWXG"))
705 #ifdef S_IRWXG
706           return S_IRWXG;
707 #else
708           goto not_there;
709 #endif
710         if (strEQ(name, "IROTH"))
711 #ifdef S_IROTH
712           return S_IROTH;
713 #else
714           goto not_there;
715 #endif
716         if (strEQ(name, "IWOTH"))
717 #ifdef S_IWOTH
718           return S_IWOTH;
719 #else
720           goto not_there;
721 #endif
722         if (strEQ(name, "IXOTH"))
723 #ifdef S_IXOTH
724           return S_IXOTH;
725 #else
726           goto not_there;
727 #endif
728         if (strEQ(name, "IRWXO"))
729 #ifdef S_IRWXO
730           return S_IRWXO;
731 #else
732           goto not_there;
733 #endif
734         if (strEQ(name, "IREAD"))
735 #ifdef S_IREAD
736           return S_IREAD;
737 #else
738           goto not_there;
739 #endif
740         if (strEQ(name, "IWRITE"))
741 #ifdef S_IWRITE
742           return S_IWRITE;
743 #else
744           goto not_there;
745 #endif
746         if (strEQ(name, "IEXEC"))
747 #ifdef S_IEXEC
748           return S_IEXEC;
749 #else
750           goto not_there;
751 #endif
752         break;
753       case 'E':
754           if (strEQ(name, "EK_CUR"))
755 #ifdef SEEK_CUR
756             return SEEK_CUR;
757 #else
758             return 1;
759 #endif
760         if (strEQ(name, "EK_END"))
761 #ifdef SEEK_END
762             return SEEK_END;
763 #else
764             return 2;
765 #endif
766         if (strEQ(name, "EK_SET"))
767 #ifdef SEEK_SET
768             return SEEK_SET;
769 #else
770             return 0;
771 #endif
772         break;
773       }    
774     }
775     errno = EINVAL;
776     return 0;
777
778 not_there:
779     errno = ENOENT;
780     return 0;
781 }
782
783
784 MODULE = Fcntl          PACKAGE = Fcntl
785
786 IV
787 constant(name)
788         char *          name
789