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