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