ext/POSIX/POSIX.xs

   1 #define PERL_EXT_POSIX
   2
   3 #ifdef NETWARE
   4         #define _POSIX_
   5         /*
   6          * Ideally this should be somewhere down in the includes
   7          * but putting it in other places is giving compiler errors.
   8          * Also here I am unable to check for HAS_UNAME since it wouldn't have
   9          * yet come into the file at this stage - sgp 18th Oct 2000
  10          */
  11         #include <sys/utsname.h>
  12 #endif  /* NETWARE */
  13
  14 #define PERL_NO_GET_CONTEXT
  15
  16 #include "EXTERN.h"
  17 #define PERLIO_NOT_STDIO 1
  18 #include "perl.h"
  19 #include "XSUB.h"
  20 #if defined(PERL_IMPLICIT_SYS)
  21 #  undef signal
  22 #  undef open
  23 #  undef setmode
  24 #  define open PerlLIO_open3
  25 #endif
  26 #include <ctype.h>
  27 #ifdef I_DIRENT    /* XXX maybe better to just rely on perl.h? */
  28 #include <dirent.h>
  29 #endif
  30 #include <errno.h>
  31 #ifdef WIN32
  32 #include <sys/errno2.h>
  33 #endif
  34 #ifdef I_FLOAT
  35 #include <float.h>
  36 #endif
  37 #ifdef I_LIMITS
  38 #include <limits.h>
  39 #endif
  40 #include <locale.h>
  41 #include <math.h>
  42 #ifdef I_PWD
  43 #include <pwd.h>
  44 #endif
  45 #include <setjmp.h>
  46 #include <signal.h>
  47 #include <stdarg.h>
  48
  49 #ifdef I_STDDEF
  50 #include <stddef.h>
  51 #endif
  52
  53 #ifdef I_UNISTD
  54 #include <unistd.h>
  55 #endif
  56
  57 /* XXX This comment is just to make I_TERMIO and I_SGTTY visible to
  58    metaconfig for future extension writers.  We don't use them in POSIX.
  59    (This is really sneaky :-)  --AD
  60 */
  61 #if defined(I_TERMIOS)
  62 #include <termios.h>
  63 #endif
  64 #ifdef I_STDLIB
  65 #include <stdlib.h>
  66 #endif
  67 #ifndef __ultrix__
  68 #include <string.h>
  69 #endif
  70 #include <sys/stat.h>
  71 #include <sys/types.h>
  72 #include <time.h>
  73 #ifdef I_UNISTD
  74 #include <unistd.h>
  75 #endif
  76 #include <fcntl.h>
  77
  78 #ifdef HAS_TZNAME
  79 #  if !defined(WIN32) && !defined(__CYGWIN__) && !defined(NETWARE) && !defined(__UWIN__)
  80 extern char *tzname[];
  81 #  endif
  82 #else
  83 #if !defined(WIN32) && !defined(__UWIN__) || (defined(__MINGW32__) && !defined(tzname))
  84 char *tzname[] = { "" , "" };
  85 #endif
  86 #endif
  87
  88 #if defined(__VMS) && !defined(__POSIX_SOURCE)
  89
  90 #  include <utsname.h>
  91
  92 #  undef mkfifo
  93 #  define mkfifo(a,b) (not_here("mkfifo"),-1)
  94
  95    /* The POSIX notion of ttyname() is better served by getname() under VMS */
  96    static char ttnambuf[64];
  97 #  define ttyname(fd) (isatty(fd) > 0 ? getname(fd,ttnambuf,0) : NULL)
  98
  99 #else
 100 #if defined (__CYGWIN__)
 101 #    define tzname _tzname
 102 #endif
 103 #if defined (WIN32) || defined (NETWARE)
 104 #  undef mkfifo
 105 #  define mkfifo(a,b) not_here("mkfifo")
 106 #  define ttyname(a) (char*)not_here("ttyname")
 107 #  define sigset_t long
 108 #  define pid_t long
 109 #  ifdef _MSC_VER
 110 #    define mode_t short
 111 #  endif
 112 #  ifdef __MINGW32__
 113 #    define mode_t short
 114 #    ifndef tzset
 115 #      define tzset()           not_here("tzset")
 116 #    endif
 117 #    ifndef _POSIX_OPEN_MAX
 118 #      define _POSIX_OPEN_MAX   FOPEN_MAX       /* XXX bogus ? */
 119 #    endif
 120 #  endif
 121 #  define sigaction(a,b,c)      not_here("sigaction")
 122 #  define sigpending(a)         not_here("sigpending")
 123 #  define sigprocmask(a,b,c)    not_here("sigprocmask")
 124 #  define sigsuspend(a)         not_here("sigsuspend")
 125 #  define sigemptyset(a)        not_here("sigemptyset")
 126 #  define sigaddset(a,b)        not_here("sigaddset")
 127 #  define sigdelset(a,b)        not_here("sigdelset")
 128 #  define sigfillset(a)         not_here("sigfillset")
 129 #  define sigismember(a,b)      not_here("sigismember")
 130 #ifndef NETWARE
 131 #  undef setuid
 132 #  undef setgid
 133 #  define setuid(a)             not_here("setuid")
 134 #  define setgid(a)             not_here("setgid")
 135 #endif  /* NETWARE */
 136 #else
 137
 138 #  ifndef HAS_MKFIFO
 139 #    if defined(OS2)
 140 #      define mkfifo(a,b) not_here("mkfifo")
 141 #    else       /* !( defined OS2 ) */
 142 #      ifndef mkfifo
 143 #        define mkfifo(path, mode) (mknod((path), (mode) | S_IFIFO, 0))
 144 #      endif
 145 #    endif
 146 #  endif /* !HAS_MKFIFO */
 147
 148 #  ifdef I_GRP
 149 #    include <grp.h>
 150 #  endif
 151 #  include <sys/times.h>
 152 #  ifdef HAS_UNAME
 153 #    include <sys/utsname.h>
 154 #  endif
 155 #  include <sys/wait.h>
 156 #  ifdef I_UTIME
 157 #    include <utime.h>
 158 #  endif
 159 #endif /* WIN32 || NETWARE */
 160 #endif /* __VMS */
 161
 162 typedef int SysRet;
 163 typedef long SysRetLong;
 164 typedef sigset_t* POSIX__SigSet;
 165 typedef HV* POSIX__SigAction;
 166 #ifdef I_TERMIOS
 167 typedef struct termios* POSIX__Termios;
 168 #else /* Define termios types to int, and call not_here for the functions.*/
 169 #define POSIX__Termios int
 170 #define speed_t int
 171 #define tcflag_t int
 172 #define cc_t int
 173 #define cfgetispeed(x) not_here("cfgetispeed")
 174 #define cfgetospeed(x) not_here("cfgetospeed")
 175 #define tcdrain(x) not_here("tcdrain")
 176 #define tcflush(x,y) not_here("tcflush")
 177 #define tcsendbreak(x,y) not_here("tcsendbreak")
 178 #define cfsetispeed(x,y) not_here("cfsetispeed")
 179 #define cfsetospeed(x,y) not_here("cfsetospeed")
 180 #define ctermid(x) (char *) not_here("ctermid")
 181 #define tcflow(x,y) not_here("tcflow")
 182 #define tcgetattr(x,y) not_here("tcgetattr")
 183 #define tcsetattr(x,y,z) not_here("tcsetattr")
 184 #endif
 185
 186 /* Possibly needed prototypes */
 187 #ifndef WIN32
 188 START_EXTERN_C
 189 double strtod (const char *, char **);
 190 long strtol (const char *, char **, int);
 191 unsigned long strtoul (const char *, char **, int);
 192 END_EXTERN_C
 193 #endif
 194
 195 #ifndef HAS_DIFFTIME
 196 #ifndef difftime
 197 #define difftime(a,b) not_here("difftime")
 198 #endif
 199 #endif
 200 #ifndef HAS_FPATHCONF
 201 #define fpathconf(f,n)  (SysRetLong) not_here("fpathconf")
 202 #endif
 203 #ifndef HAS_MKTIME
 204 #define mktime(a) not_here("mktime")
 205 #endif
 206 #ifndef HAS_NICE
 207 #define nice(a) not_here("nice")
 208 #endif
 209 #ifndef HAS_PATHCONF
 210 #define pathconf(f,n)   (SysRetLong) not_here("pathconf")
 211 #endif
 212 #ifndef HAS_SYSCONF
 213 #define sysconf(n)      (SysRetLong) not_here("sysconf")
 214 #endif
 215 #ifndef HAS_READLINK
 216 #define readlink(a,b,c) not_here("readlink")
 217 #endif
 218 #ifndef HAS_SETPGID
 219 #define setpgid(a,b) not_here("setpgid")
 220 #endif
 221 #ifndef HAS_SETSID
 222 #define setsid() not_here("setsid")
 223 #endif
 224 #ifndef HAS_STRCOLL
 225 #define strcoll(s1,s2) not_here("strcoll")
 226 #endif
 227 #ifndef HAS_STRTOD
 228 #define strtod(s1,s2) not_here("strtod")
 229 #endif
 230 #ifndef HAS_STRTOL
 231 #define strtol(s1,s2,b) not_here("strtol")
 232 #endif
 233 #ifndef HAS_STRTOUL
 234 #define strtoul(s1,s2,b) not_here("strtoul")
 235 #endif
 236 #ifndef HAS_STRXFRM
 237 #define strxfrm(s1,s2,n) not_here("strxfrm")
 238 #endif
 239 #ifndef HAS_TCGETPGRP
 240 #define tcgetpgrp(a) not_here("tcgetpgrp")
 241 #endif
 242 #ifndef HAS_TCSETPGRP
 243 #define tcsetpgrp(a,b) not_here("tcsetpgrp")
 244 #endif
 245 #ifndef HAS_TIMES
 246 #ifndef NETWARE
 247 #define times(a) not_here("times")
 248 #endif  /* NETWARE */
 249 #endif
 250 #ifndef HAS_UNAME
 251 #define uname(a) not_here("uname")
 252 #endif
 253 #ifndef HAS_WAITPID
 254 #define waitpid(a,b,c) not_here("waitpid")
 255 #endif
 256
 257 #ifndef HAS_MBLEN
 258 #ifndef mblen
 259 #define mblen(a,b) not_here("mblen")
 260 #endif
 261 #endif
 262 #ifndef HAS_MBSTOWCS
 263 #define mbstowcs(s, pwcs, n) not_here("mbstowcs")
 264 #endif
 265 #ifndef HAS_MBTOWC
 266 #define mbtowc(pwc, s, n) not_here("mbtowc")
 267 #endif
 268 #ifndef HAS_WCSTOMBS
 269 #define wcstombs(s, pwcs, n) not_here("wcstombs")
 270 #endif
 271 #ifndef HAS_WCTOMB
 272 #define wctomb(s, wchar) not_here("wcstombs")
 273 #endif
 274 #if !defined(HAS_MBLEN) && !defined(HAS_MBSTOWCS) && !defined(HAS_MBTOWC) && !defined(HAS_WCSTOMBS) && !defined(HAS_WCTOMB)
 275 /* If we don't have these functions, then we wouldn't have gotten a typedef
 276    for wchar_t, the wide character type.  Defining wchar_t allows the
 277    functions referencing it to compile.  Its actual type is then meaningless,
 278    since without the above functions, all sections using it end up calling
 279    not_here() and croak.  --Kaveh Ghazi (ghazi@noc.rutgers.edu) 9/18/94. */
 280 #ifndef wchar_t
 281 #define wchar_t char
 282 #endif
 283 #endif
 284
 285 #ifdef HAS_LOCALECONV
 286 struct lconv_offset {
 287     const char *name;
 288     size_t offset;
 289 };
 290
 291 const struct lconv_offset lconv_strings[] = {
 292     {"decimal_point",     STRUCT_OFFSET(struct lconv, decimal_point)},
 293     {"thousands_sep",     STRUCT_OFFSET(struct lconv, thousands_sep)},
 294 #ifndef NO_LOCALECONV_GROUPING
 295     {"grouping",          STRUCT_OFFSET(struct lconv, grouping)},
 296 #endif
 297     {"int_curr_symbol",   STRUCT_OFFSET(struct lconv, int_curr_symbol)},
 298     {"currency_symbol",   STRUCT_OFFSET(struct lconv, currency_symbol)},
 299     {"mon_decimal_point", STRUCT_OFFSET(struct lconv, mon_decimal_point)},
 300 #ifndef NO_LOCALECONV_MON_THOUSANDS_SEP
 301     {"mon_thousands_sep", STRUCT_OFFSET(struct lconv, mon_thousands_sep)},
 302 #endif
 303 #ifndef NO_LOCALECONV_MON_GROUPING
 304     {"mon_grouping",      STRUCT_OFFSET(struct lconv, mon_grouping)},
 305 #endif
 306     {"positive_sign",     STRUCT_OFFSET(struct lconv, positive_sign)},
 307     {"negative_sign",     STRUCT_OFFSET(struct lconv, negative_sign)},
 308     {NULL, 0}
 309 };
 310
 311 const struct lconv_offset lconv_integers[] = {
 312     {"int_frac_digits",   STRUCT_OFFSET(struct lconv, int_frac_digits)},
 313     {"frac_digits",       STRUCT_OFFSET(struct lconv, frac_digits)},
 314     {"p_cs_precedes",     STRUCT_OFFSET(struct lconv, p_cs_precedes)},
 315     {"p_sep_by_space",    STRUCT_OFFSET(struct lconv, p_sep_by_space)},
 316     {"n_cs_precedes",     STRUCT_OFFSET(struct lconv, n_cs_precedes)},
 317     {"n_sep_by_space",    STRUCT_OFFSET(struct lconv, n_sep_by_space)},
 318     {"p_sign_posn",       STRUCT_OFFSET(struct lconv, p_sign_posn)},
 319     {"n_sign_posn",       STRUCT_OFFSET(struct lconv, n_sign_posn)},
 320     {NULL, 0}
 321 };
 322
 323 #else
 324 #define localeconv() not_here("localeconv")
 325 #endif
 326
 327 #ifdef HAS_LONG_DOUBLE
 328 #  if LONG_DOUBLESIZE > NVSIZE
 329 #    undef HAS_LONG_DOUBLE  /* XXX until we figure out how to use them */
 330 #  endif
 331 #endif
 332
 333 #ifndef HAS_LONG_DOUBLE
 334 #ifdef LDBL_MAX
 335 #undef LDBL_MAX
 336 #endif
 337 #ifdef LDBL_MIN
 338 #undef LDBL_MIN
 339 #endif
 340 #ifdef LDBL_EPSILON
 341 #undef LDBL_EPSILON
 342 #endif
 343 #endif
 344
 345 /* Background: in most systems the low byte of the wait status
 346  * is the signal (the lowest 7 bits) and the coredump flag is
 347  * the eight bit, and the second lowest byte is the exit status.
 348  * BeOS bucks the trend and has the bytes in different order.
 349  * See beos/beos.c for how the reality is bent even in BeOS
 350  * to follow the traditional.  However, to make the POSIX
 351  * wait W*() macros to work in BeOS, we need to unbend the
 352  * reality back in place. --jhi */
 353 /* In actual fact the code below is to blame here. Perl has an internal
 354  * representation of the exit status ($?), which it re-composes from the
 355  * OS's representation using the W*() POSIX macros. The code below
 356  * incorrectly uses the W*() macros on the internal representation,
 357  * which fails for OSs that have a different representation (namely BeOS
 358  * and Haiku). WMUNGE() is a hack that converts the internal
 359  * representation into the OS specific one, so that the W*() macros work
 360  * as expected. The better solution would be not to use the W*() macros
 361  * in the first place, though. -- Ingo Weinhold
 362  */
 363 #if defined(__HAIKU__)
 364 #    define WMUNGE(x) (((x) & 0xFF00) >> 8 | ((x) & 0x00FF) << 8)
 365 #else
 366 #    define WMUNGE(x) (x)
 367 #endif
 368
 369 static int
 370 not_here(const char *s)
 371 {
 372     croak("POSIX::%s not implemented on this architecture", s);
 373     return -1;
 374 }
 375
 376 #include "const-c.inc"
 377
 378 static void
 379 restore_sigmask(pTHX_ SV *osset_sv)
 380 {
 381      /* Fortunately, restoring the signal mask can't fail, because
 382       * there's nothing we can do about it if it does -- we're not
 383       * supposed to return -1 from sigaction unless the disposition
 384       * was unaffected.
 385       */
 386      sigset_t *ossetp = (sigset_t *) SvPV_nolen( osset_sv );
 387      (void)sigprocmask(SIG_SETMASK, ossetp, (sigset_t *)0);
 388 }
 389
 390 static void *
 391 allocate_struct(pTHX_ SV *rv, const STRLEN size, const char *packname) {
 392     SV *const t = newSVrv(rv, packname);
 393     void *const p = sv_grow(t, size + 1);
 394
 395     SvCUR_set(t, size);
 396     SvPOK_on(t);
 397     return p;
 398 }
 399
 400 #ifdef WIN32
 401
 402 /*
 403  * (1) The CRT maintains its own copy of the environment, separate from
 404  * the Win32API copy.
 405  *
 406  * (2) CRT getenv() retrieves from this copy. CRT putenv() updates this
 407  * copy, and then calls SetEnvironmentVariableA() to update the Win32API
 408  * copy.
 409  *
 410  * (3) win32_getenv() and win32_putenv() call GetEnvironmentVariableA() and
 411  * SetEnvironmentVariableA() directly, bypassing the CRT copy of the
 412  * environment.
 413  *
 414  * (4) The CRT strftime() "%Z" implementation calls __tzset(). That
 415  * calls CRT tzset(), but only the first time it is called, and in turn
 416  * that uses CRT getenv("TZ") to retrieve the timezone info from the CRT
 417  * local copy of the environment and hence gets the original setting as
 418  * perl never updates the CRT copy when assigning to $ENV{TZ}.
 419  *
 420  * Therefore, we need to retrieve the value of $ENV{TZ} and call CRT
 421  * putenv() to update the CRT copy of the environment (if it is different)
 422  * whenever we're about to call tzset().
 423  *
 424  * In addition to all that, when perl is built with PERL_IMPLICIT_SYS
 425  * defined:
 426  *
 427  * (a) Each interpreter has its own copy of the environment inside the
 428  * perlhost structure. That allows applications that host multiple
 429  * independent Perl interpreters to isolate environment changes from
 430  * each other. (This is similar to how the perlhost mechanism keeps a
 431  * separate working directory for each Perl interpreter, so that calling
 432  * chdir() will not affect other interpreters.)
 433  *
 434  * (b) Only the first Perl interpreter instantiated within a process will
 435  * "write through" environment changes to the process environment.
 436  *
 437  * (c) Even the primary Perl interpreter won't update the CRT copy of the
 438  * the environment, only the Win32API copy (it calls win32_putenv()).
 439  *
 440  * As with CPerlHost::Getenv() and CPerlHost::Putenv() themselves, it makes
 441  * sense to only update the process environment when inside the main
 442  * interpreter, but we don't have access to CPerlHost's m_bTopLevel member
 443  * from here so we'll just have to check PL_curinterp instead.
 444  *
 445  * Therefore, we can simply #undef getenv() and putenv() so that those names
 446  * always refer to the CRT functions, and explicitly call win32_getenv() to
 447  * access perl's %ENV.
 448  *
 449  * We also #undef malloc() and free() to be sure we are using the CRT
 450  * functions otherwise under PERL_IMPLICIT_SYS they are redefined to calls
 451  * into VMem::Malloc() and VMem::Free() and all allocations will be freed
 452  * when the Perl interpreter is being destroyed so we'd end up with a pointer
 453  * into deallocated memory in environ[] if a program embedding a Perl
 454  * interpreter continues to operate even after the main Perl interpreter has
 455  * been destroyed.
 456  *
 457  * Note that we don't free() the malloc()ed memory unless and until we call
 458  * malloc() again ourselves because the CRT putenv() function simply puts its
 459  * pointer argument into the environ[] array (it doesn't make a copy of it)
 460  * so this memory must otherwise be leaked.
 461  */
 462
 463 #undef getenv
 464 #undef putenv
 465 #undef malloc
 466 #undef free
 467
 468 static void
 469 fix_win32_tzenv(void)
 470 {
 471     static char* oldenv = NULL;
 472     char* newenv;
 473     const char* perl_tz_env = win32_getenv("TZ");
 474     const char* crt_tz_env = getenv("TZ");
 475     if (perl_tz_env == NULL)
 476         perl_tz_env = "";
 477     if (crt_tz_env == NULL)
 478         crt_tz_env = "";
 479     if (strcmp(perl_tz_env, crt_tz_env) != 0) {
 480         newenv = (char*)malloc((strlen(perl_tz_env) + 4) * sizeof(char));
 481         if (newenv != NULL) {
 482             sprintf(newenv, "TZ=%s", perl_tz_env);
 483             putenv(newenv);
 484             if (oldenv != NULL)
 485                 free(oldenv);
 486             oldenv = newenv;
 487         }
 488     }
 489 }
 490
 491 #endif
 492
 493 /*
 494  * my_tzset - wrapper to tzset() with a fix to make it work (better) on Win32.
 495  * This code is duplicated in the Time-Piece module, so any changes made here
 496  * should be made there too.
 497  */
 498 static void
 499 my_tzset(pTHX)
 500 {
 501 #ifdef WIN32
 502 #if defined(USE_ITHREADS) && defined(PERL_IMPLICIT_SYS)
 503     if (PL_curinterp == aTHX)
 504 #endif
 505         fix_win32_tzenv();
 506 #endif
 507     tzset();
 508 }
 509
 510 typedef int (*isfunc_t)(int);
 511 typedef void (*any_dptr_t)(void *);
 512
 513 /* This needs to be ALIASed in a custom way, hence can't easily be defined as
 514    a regular XSUB.  */
 515 static XSPROTO(is_common); /* prototype to pass -Wmissing-prototypes */
 516 static XSPROTO(is_common)
 517 {
 518     dXSARGS;
 519     static PTR_TBL_t * is_common_ptr_table;
 520
 521     if (items != 1)
 522        croak_xs_usage(cv,  "charstring");
 523
 524     {
 525         dXSTARG;
 526         STRLEN  len;
 527         /*int   RETVAL = 0;   YYY means uncomment this to return false on an
 528                             * empty string input */
 529         int     RETVAL;
 530         unsigned char *s = (unsigned char *) SvPV(ST(0), len);
 531         unsigned char *e = s + len;
 532         isfunc_t isfunc = (isfunc_t) XSANY.any_dptr;
 533
 534         if (ckWARN_d(WARN_DEPRECATED)) {
 535
 536             /* Warn exactly once for each lexical place this function is
 537              * called.  See thread at
 538              * http://markmail.org/thread/jhqcag5njmx7jpyu */
 539
 540             if (! is_common_ptr_table) {
 541                is_common_ptr_table = ptr_table_new();
 542             }
 543             if (! ptr_table_fetch(is_common_ptr_table, PL_op)) {
 544                 Perl_warner(aTHX_ packWARN(WARN_DEPRECATED),
 545                             "Calling POSIX::%"HEKf"() is deprecated",
 546                             HEKfARG(GvNAME_HEK(CvGV(cv))));
 547                 ptr_table_store(is_common_ptr_table, PL_op, (void *) 1);
 548             }
 549         }
 550
 551         /*if (e > s) { YYY */
 552         for (RETVAL = 1; RETVAL && s < e; s++)
 553             if (!isfunc(*s))
 554                 RETVAL = 0;
 555         /*} YYY */
 556         XSprePUSH;
 557         PUSHi((IV)RETVAL);
 558     }
 559     XSRETURN(1);
 560 }
 561
 562 MODULE = POSIX          PACKAGE = POSIX
 563
 564 BOOT:
 565 {
 566     CV *cv;
 567     const char *file = __FILE__;
 568
 569
 570     /* silence compiler warning about not_here() defined but not used */
 571     if (0) not_here("");
 572
 573     /* Ensure we get the function, not a macro implementation. Like the C89
 574        standard says we can...  */
 575 #undef isalnum
 576     cv = newXS("POSIX::isalnum", is_common, file);
 577     XSANY.any_dptr = (any_dptr_t) &isalnum;
 578 #undef isalpha
 579     cv = newXS("POSIX::isalpha", is_common, file);
 580     XSANY.any_dptr = (any_dptr_t) &isalpha;
 581 #undef iscntrl
 582     cv = newXS("POSIX::iscntrl", is_common, file);
 583     XSANY.any_dptr = (any_dptr_t) &iscntrl;
 584 #undef isdigit
 585     cv = newXS("POSIX::isdigit", is_common, file);
 586     XSANY.any_dptr = (any_dptr_t) &isdigit;
 587 #undef isgraph
 588     cv = newXS("POSIX::isgraph", is_common, file);
 589     XSANY.any_dptr = (any_dptr_t) &isgraph;
 590 #undef islower
 591     cv = newXS("POSIX::islower", is_common, file);
 592     XSANY.any_dptr = (any_dptr_t) &islower;
 593 #undef isprint
 594     cv = newXS("POSIX::isprint", is_common, file);
 595     XSANY.any_dptr = (any_dptr_t) &isprint;
 596 #undef ispunct
 597     cv = newXS("POSIX::ispunct", is_common, file);
 598     XSANY.any_dptr = (any_dptr_t) &ispunct;
 599 #undef isspace
 600     cv = newXS("POSIX::isspace", is_common, file);
 601     XSANY.any_dptr = (any_dptr_t) &isspace;
 602 #undef isupper
 603     cv = newXS("POSIX::isupper", is_common, file);
 604     XSANY.any_dptr = (any_dptr_t) &isupper;
 605 #undef isxdigit
 606     cv = newXS("POSIX::isxdigit", is_common, file);
 607     XSANY.any_dptr = (any_dptr_t) &isxdigit;
 608 }
 609
 610 MODULE = SigSet         PACKAGE = POSIX::SigSet         PREFIX = sig
 611
 612 void
 613 new(packname = "POSIX::SigSet", ...)
 614     const char *        packname
 615     CODE:
 616         {
 617             int i;
 618             sigset_t *const s
 619                 = (sigset_t *) allocate_struct(aTHX_ (ST(0) = sv_newmortal()),
 620                                                sizeof(sigset_t),
 621                                                packname);
 622             sigemptyset(s);
 623             for (i = 1; i < items; i++)
 624                 sigaddset(s, SvIV(ST(i)));
 625             XSRETURN(1);
 626         }
 627
 628 SysRet
 629 addset(sigset, sig)
 630         POSIX::SigSet   sigset
 631         int             sig
 632    ALIAS:
 633         delset = 1
 634    CODE:
 635         RETVAL = ix ? sigdelset(sigset, sig) : sigaddset(sigset, sig);
 636    OUTPUT:
 637         RETVAL
 638
 639 SysRet
 640 emptyset(sigset)
 641         POSIX::SigSet   sigset
 642    ALIAS:
 643         fillset = 1
 644    CODE:
 645         RETVAL = ix ? sigfillset(sigset) : sigemptyset(sigset);
 646    OUTPUT:
 647         RETVAL
 648
 649 int
 650 sigismember(sigset, sig)
 651         POSIX::SigSet   sigset
 652         int             sig
 653
 654 MODULE = Termios        PACKAGE = POSIX::Termios        PREFIX = cf
 655
 656 void
 657 new(packname = "POSIX::Termios", ...)
 658     const char *        packname
 659     CODE:
 660         {
 661 #ifdef I_TERMIOS
 662             void *const p = allocate_struct(aTHX_ (ST(0) = sv_newmortal()),
 663                                             sizeof(struct termios), packname);
 664             /* The previous implementation stored a pointer to an uninitialised
 665                struct termios. Seems safer to initialise it, particularly as
 666                this implementation exposes the struct to prying from perl-space.
 667             */
 668             memset(p, 0, 1 + sizeof(struct termios));
 669             XSRETURN(1);
 670 #else
 671             not_here("termios");
 672 #endif
 673         }
 674
 675 SysRet
 676 getattr(termios_ref, fd = 0)
 677         POSIX::Termios  termios_ref
 678         int             fd
 679     CODE:
 680         RETVAL = tcgetattr(fd, termios_ref);
 681     OUTPUT:
 682         RETVAL
 683
 684 # If we define TCSANOW here then both a found and not found constant sub
 685 # are created causing a Constant subroutine TCSANOW redefined warning
 686 #ifndef TCSANOW
 687 #  define DEF_SETATTR_ACTION 0
 688 #else
 689 #  define DEF_SETATTR_ACTION TCSANOW
 690 #endif
 691 SysRet
 692 setattr(termios_ref, fd = 0, optional_actions = DEF_SETATTR_ACTION)
 693         POSIX::Termios  termios_ref
 694         int             fd
 695         int             optional_actions
 696     CODE:
 697         /* The second argument to the call is mandatory, but we'd like to give
 698            it a useful default. 0 isn't valid on all operating systems - on
 699            Solaris (at least) TCSANOW, TCSADRAIN and TCSAFLUSH have the same
 700            values as the equivalent ioctls, TCSETS, TCSETSW and TCSETSF.  */
 701         RETVAL = tcsetattr(fd, optional_actions, termios_ref);
 702     OUTPUT:
 703         RETVAL
 704
 705 speed_t
 706 getispeed(termios_ref)
 707         POSIX::Termios  termios_ref
 708     ALIAS:
 709         getospeed = 1
 710     CODE:
 711         RETVAL = ix ? cfgetospeed(termios_ref) : cfgetispeed(termios_ref);
 712     OUTPUT:
 713         RETVAL
 714
 715 tcflag_t
 716 getiflag(termios_ref)
 717         POSIX::Termios  termios_ref
 718     ALIAS:
 719         getoflag = 1
 720         getcflag = 2
 721         getlflag = 3
 722     CODE:
 723 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
 724         switch(ix) {
 725         case 0:
 726             RETVAL = termios_ref->c_iflag;
 727             break;
 728         case 1:
 729             RETVAL = termios_ref->c_oflag;
 730             break;
 731         case 2:
 732             RETVAL = termios_ref->c_cflag;
 733             break;
 734         case 3:
 735             RETVAL = termios_ref->c_lflag;
 736             break;
 737         default:
 738             RETVAL = 0; /* silence compiler warning */
 739         }
 740 #else
 741         not_here(GvNAME(CvGV(cv)));
 742         RETVAL = 0;
 743 #endif
 744     OUTPUT:
 745         RETVAL
 746
 747 cc_t
 748 getcc(termios_ref, ccix)
 749         POSIX::Termios  termios_ref
 750         unsigned int    ccix
 751     CODE:
 752 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
 753         if (ccix >= NCCS)
 754             croak("Bad getcc subscript");
 755         RETVAL = termios_ref->c_cc[ccix];
 756 #else
 757      not_here("getcc");
 758      RETVAL = 0;
 759 #endif
 760     OUTPUT:
 761         RETVAL
 762
 763 SysRet
 764 setispeed(termios_ref, speed)
 765         POSIX::Termios  termios_ref
 766         speed_t         speed
 767     ALIAS:
 768         setospeed = 1
 769     CODE:
 770         RETVAL = ix
 771             ? cfsetospeed(termios_ref, speed) : cfsetispeed(termios_ref, speed);
 772     OUTPUT:
 773         RETVAL
 774
 775 void
 776 setiflag(termios_ref, flag)
 777         POSIX::Termios  termios_ref
 778         tcflag_t        flag
 779     ALIAS:
 780         setoflag = 1
 781         setcflag = 2
 782         setlflag = 3
 783     CODE:
 784 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
 785         switch(ix) {
 786         case 0:
 787             termios_ref->c_iflag = flag;
 788             break;
 789         case 1:
 790             termios_ref->c_oflag = flag;
 791             break;
 792         case 2:
 793             termios_ref->c_cflag = flag;
 794             break;
 795         case 3:
 796             termios_ref->c_lflag = flag;
 797             break;
 798         }
 799 #else
 800         not_here(GvNAME(CvGV(cv)));
 801 #endif
 802
 803 void
 804 setcc(termios_ref, ccix, cc)
 805         POSIX::Termios  termios_ref
 806         unsigned int    ccix
 807         cc_t            cc
 808     CODE:
 809 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
 810         if (ccix >= NCCS)
 811             croak("Bad setcc subscript");
 812         termios_ref->c_cc[ccix] = cc;
 813 #else
 814             not_here("setcc");
 815 #endif
 816
 817
 818 MODULE = POSIX          PACKAGE = POSIX
 819
 820 INCLUDE: const-xs.inc
 821
 822 int
 823 WEXITSTATUS(status)
 824         int status
 825     ALIAS:
 826         POSIX::WIFEXITED = 1
 827         POSIX::WIFSIGNALED = 2
 828         POSIX::WIFSTOPPED = 3
 829         POSIX::WSTOPSIG = 4
 830         POSIX::WTERMSIG = 5
 831     CODE:
 832 #if !defined(WEXITSTATUS) || !defined(WIFEXITED) || !defined(WIFSIGNALED) \
 833       || !defined(WIFSTOPPED) || !defined(WSTOPSIG) || !defined(WTERMSIG)
 834         RETVAL = 0; /* Silence compilers that notice this, but don't realise
 835                        that not_here() can't return.  */
 836 #endif
 837         switch(ix) {
 838         case 0:
 839 #ifdef WEXITSTATUS
 840             RETVAL = WEXITSTATUS(WMUNGE(status));
 841 #else
 842             not_here("WEXITSTATUS");
 843 #endif
 844             break;
 845         case 1:
 846 #ifdef WIFEXITED
 847             RETVAL = WIFEXITED(WMUNGE(status));
 848 #else
 849             not_here("WIFEXITED");
 850 #endif
 851             break;
 852         case 2:
 853 #ifdef WIFSIGNALED
 854             RETVAL = WIFSIGNALED(WMUNGE(status));
 855 #else
 856             not_here("WIFSIGNALED");
 857 #endif
 858             break;
 859         case 3:
 860 #ifdef WIFSTOPPED
 861             RETVAL = WIFSTOPPED(WMUNGE(status));
 862 #else
 863             not_here("WIFSTOPPED");
 864 #endif
 865             break;
 866         case 4:
 867 #ifdef WSTOPSIG
 868             RETVAL = WSTOPSIG(WMUNGE(status));
 869 #else
 870             not_here("WSTOPSIG");
 871 #endif
 872             break;
 873         case 5:
 874 #ifdef WTERMSIG
 875             RETVAL = WTERMSIG(WMUNGE(status));
 876 #else
 877             not_here("WTERMSIG");
 878 #endif
 879             break;
 880         default:
 881             Perl_croak(aTHX_ "Illegal alias %d for POSIX::W*", (int)ix);
 882         }
 883     OUTPUT:
 884         RETVAL
 885
 886 SysRet
 887 open(filename, flags = O_RDONLY, mode = 0666)
 888         char *          filename
 889         int             flags
 890         Mode_t          mode
 891     CODE:
 892         if (flags & (O_APPEND|O_CREAT|O_TRUNC|O_RDWR|O_WRONLY|O_EXCL))
 893             TAINT_PROPER("open");
 894         RETVAL = open(filename, flags, mode);
 895     OUTPUT:
 896         RETVAL
 897
 898
 899 HV *
 900 localeconv()
 901     CODE:
 902 #ifdef HAS_LOCALECONV
 903         struct lconv *lcbuf;
 904         RETVAL = newHV();
 905         sv_2mortal((SV*)RETVAL);
 906         if ((lcbuf = localeconv())) {
 907             const struct lconv_offset *strings = lconv_strings;
 908             const struct lconv_offset *integers = lconv_integers;
 909             const char *ptr = (const char *) lcbuf;
 910
 911             do {
 912                 const char *value = *((const char **)(ptr + strings->offset));
 913
 914                 if (value && *value)
 915                     (void) hv_store(RETVAL, strings->name, strlen(strings->name),
 916                                     newSVpv(value, 0), 0);
 917             } while ((++strings)->name);
 918
 919             do {
 920                 const char value = *((const char *)(ptr + integers->offset));
 921
 922                 if (value != CHAR_MAX)
 923                     (void) hv_store(RETVAL, integers->name,
 924                                     strlen(integers->name), newSViv(value), 0);
 925             } while ((++integers)->name);
 926         }
 927 #else
 928         localeconv(); /* A stub to call not_here(). */
 929 #endif
 930     OUTPUT:
 931         RETVAL
 932
 933 char *
 934 setlocale(category, locale = 0)
 935         int             category
 936         char *          locale
 937     PREINIT:
 938         char *          retval;
 939     CODE:
 940 #ifdef WIN32    /* Use wrapper on Windows */
 941         retval = Perl_my_setlocale(aTHX_ category, locale);
 942 #else
 943         retval = setlocale(category, locale);
 944 #endif
 945         if (! retval) {
 946             XSRETURN_UNDEF;
 947         }
 948         else {
 949             /* Save retval since subsequent setlocale() calls
 950              * may overwrite it. */
 951             RETVAL = savepv(retval);
 952 #ifdef USE_LOCALE_CTYPE
 953             if (category == LC_CTYPE
 954 #ifdef LC_ALL
 955                 || category == LC_ALL
 956 #endif
 957                 )
 958             {
 959                 char *newctype;
 960 #ifdef LC_ALL
 961                 if (category == LC_ALL)
 962                     newctype = setlocale(LC_CTYPE, NULL);
 963                 else
 964 #endif
 965                     newctype = RETVAL;
 966                 new_ctype(newctype);
 967             }
 968 #endif /* USE_LOCALE_CTYPE */
 969 #ifdef USE_LOCALE_COLLATE
 970             if (category == LC_COLLATE
 971 #ifdef LC_ALL
 972                 || category == LC_ALL
 973 #endif
 974                 )
 975             {
 976                 char *newcoll;
 977 #ifdef LC_ALL
 978                 if (category == LC_ALL)
 979                     newcoll = setlocale(LC_COLLATE, NULL);
 980                 else
 981 #endif
 982                     newcoll = RETVAL;
 983                 new_collate(newcoll);
 984             }
 985 #endif /* USE_LOCALE_COLLATE */
 986 #ifdef USE_LOCALE_NUMERIC
 987             if (category == LC_NUMERIC
 988 #ifdef LC_ALL
 989                 || category == LC_ALL
 990 #endif
 991                 )
 992             {
 993                 char *newnum;
 994 #ifdef LC_ALL
 995                 if (category == LC_ALL)
 996                     newnum = setlocale(LC_NUMERIC, NULL);
 997                 else
 998 #endif
 999                     newnum = RETVAL;
1000                 new_numeric(newnum);
1001             }
1002 #endif /* USE_LOCALE_NUMERIC */
1003         }
1004     OUTPUT:
1005         RETVAL
1006     CLEANUP:
1007         Safefree(RETVAL);
1008
1009 NV
1010 acos(x)
1011         NV              x
1012     ALIAS:
1013         asin = 1
1014         atan = 2
1015         ceil = 3
1016         cosh = 4
1017         floor = 5
1018         log10 = 6
1019         sinh = 7
1020         tan = 8
1021         tanh = 9
1022     CODE:
1023         switch (ix) {
1024         case 0:
1025             RETVAL = acos(x);
1026             break;
1027         case 1:
1028             RETVAL = asin(x);
1029             break;
1030         case 2:
1031             RETVAL = atan(x);
1032             break;
1033         case 3:
1034             RETVAL = ceil(x);
1035             break;
1036         case 4:
1037             RETVAL = cosh(x);
1038             break;
1039         case 5:
1040             RETVAL = floor(x);
1041             break;
1042         case 6:
1043             RETVAL = log10(x);
1044             break;
1045         case 7:
1046             RETVAL = sinh(x);
1047             break;
1048         case 8:
1049             RETVAL = tan(x);
1050             break;
1051         default:
1052             RETVAL = tanh(x);
1053         }
1054     OUTPUT:
1055         RETVAL
1056
1057 NV
1058 fmod(x,y)
1059         NV              x
1060         NV              y
1061
1062 void
1063 frexp(x)
1064         NV              x
1065     PPCODE:
1066         int expvar;
1067         /* (We already know stack is long enough.) */
1068         PUSHs(sv_2mortal(newSVnv(frexp(x,&expvar))));
1069         PUSHs(sv_2mortal(newSViv(expvar)));
1070
1071 NV
1072 ldexp(x,exp)
1073         NV              x
1074         int             exp
1075
1076 void
1077 modf(x)
1078         NV              x
1079     PPCODE:
1080         NV intvar;
1081         /* (We already know stack is long enough.) */
1082         PUSHs(sv_2mortal(newSVnv(Perl_modf(x,&intvar))));
1083         PUSHs(sv_2mortal(newSVnv(intvar)));
1084
1085 SysRet
1086 sigaction(sig, optaction, oldaction = 0)
1087         int                     sig
1088         SV *                    optaction
1089         POSIX::SigAction        oldaction
1090     CODE:
1091 #if defined(WIN32) || defined(NETWARE)
1092         RETVAL = not_here("sigaction");
1093 #else
1094 # This code is really grody because we're trying to make the signal
1095 # interface look beautiful, which is hard.
1096
1097         {
1098             dVAR;
1099             POSIX__SigAction action;
1100             GV *siggv = gv_fetchpvs("SIG", GV_ADD, SVt_PVHV);
1101             struct sigaction act;
1102             struct sigaction oact;
1103             sigset_t sset;
1104             SV *osset_sv;
1105             sigset_t osset;
1106             POSIX__SigSet sigset;
1107             SV** svp;
1108             SV** sigsvp;
1109
1110             if (sig < 0) {
1111                 croak("Negative signals are not allowed");
1112             }
1113
1114             if (sig == 0 && SvPOK(ST(0))) {
1115                 const char *s = SvPVX_const(ST(0));
1116                 int i = whichsig(s);
1117
1118                 if (i < 0 && memEQ(s, "SIG", 3))
1119                     i = whichsig(s + 3);
1120                 if (i < 0) {
1121                     if (ckWARN(WARN_SIGNAL))
1122                         Perl_warner(aTHX_ packWARN(WARN_SIGNAL),
1123                                     "No such signal: SIG%s", s);
1124                     XSRETURN_UNDEF;
1125                 }
1126                 else
1127                     sig = i;
1128             }
1129 #ifdef NSIG
1130             if (sig > NSIG) { /* NSIG - 1 is still okay. */
1131                 Perl_warner(aTHX_ packWARN(WARN_SIGNAL),
1132                             "No such signal: %d", sig);
1133                 XSRETURN_UNDEF;
1134             }
1135 #endif
1136             sigsvp = hv_fetch(GvHVn(siggv),
1137                               PL_sig_name[sig],
1138                               strlen(PL_sig_name[sig]),
1139                               TRUE);
1140
1141             /* Check optaction and set action */
1142             if(SvTRUE(optaction)) {
1143                 if(sv_isa(optaction, "POSIX::SigAction"))
1144                         action = (HV*)SvRV(optaction);
1145                 else
1146                         croak("action is not of type POSIX::SigAction");
1147             }
1148             else {
1149                 action=0;
1150             }
1151
1152             /* sigaction() is supposed to look atomic. In particular, any
1153              * signal handler invoked during a sigaction() call should
1154              * see either the old or the new disposition, and not something
1155              * in between. We use sigprocmask() to make it so.
1156              */
1157             sigfillset(&sset);
1158             RETVAL=sigprocmask(SIG_BLOCK, &sset, &osset);
1159             if(RETVAL == -1)
1160                XSRETURN_UNDEF;
1161             ENTER;
1162             /* Restore signal mask no matter how we exit this block. */
1163             osset_sv = newSVpvn((char *)(&osset), sizeof(sigset_t));
1164             SAVEFREESV( osset_sv );
1165             SAVEDESTRUCTOR_X(restore_sigmask, osset_sv);
1166
1167             RETVAL=-1; /* In case both oldaction and action are 0. */
1168
1169             /* Remember old disposition if desired. */
1170             if (oldaction) {
1171                 svp = hv_fetchs(oldaction, "HANDLER", TRUE);
1172                 if(!svp)
1173                     croak("Can't supply an oldaction without a HANDLER");
1174                 if(SvTRUE(*sigsvp)) { /* TBD: what if "0"? */
1175                         sv_setsv(*svp, *sigsvp);
1176                 }
1177                 else {
1178                         sv_setpvs(*svp, "DEFAULT");
1179                 }
1180                 RETVAL = sigaction(sig, (struct sigaction *)0, & oact);
1181                 if(RETVAL == -1) {
1182                    LEAVE;
1183                    XSRETURN_UNDEF;
1184                 }
1185                 /* Get back the mask. */
1186                 svp = hv_fetchs(oldaction, "MASK", TRUE);
1187                 if (sv_isa(*svp, "POSIX::SigSet")) {
1188                     sigset = (sigset_t *) SvPV_nolen(SvRV(*svp));
1189                 }
1190                 else {
1191                     sigset = (sigset_t *) allocate_struct(aTHX_ *svp,
1192                                                           sizeof(sigset_t),
1193                                                           "POSIX::SigSet");
1194                 }
1195                 *sigset = oact.sa_mask;
1196
1197                 /* Get back the flags. */
1198                 svp = hv_fetchs(oldaction, "FLAGS", TRUE);
1199                 sv_setiv(*svp, oact.sa_flags);
1200
1201                 /* Get back whether the old handler used safe signals. */
1202                 svp = hv_fetchs(oldaction, "SAFE", TRUE);
1203                 sv_setiv(*svp,
1204                 /* compare incompatible pointers by casting to integer */
1205                     PTR2nat(oact.sa_handler) == PTR2nat(PL_csighandlerp));
1206             }
1207
1208             if (action) {
1209                 /* Safe signals use "csighandler", which vectors through the
1210                    PL_sighandlerp pointer when it's safe to do so.
1211                    (BTW, "csighandler" is very different from "sighandler".) */
1212                 svp = hv_fetchs(action, "SAFE", FALSE);
1213                 act.sa_handler =
1214                         DPTR2FPTR(
1215                             void (*)(int),
1216                             (*svp && SvTRUE(*svp))
1217                                 ? PL_csighandlerp : PL_sighandlerp
1218                         );
1219
1220                 /* Vector new Perl handler through %SIG.
1221                    (The core signal handlers read %SIG to dispatch.) */
1222                 svp = hv_fetchs(action, "HANDLER", FALSE);
1223                 if (!svp)
1224                     croak("Can't supply an action without a HANDLER");
1225                 sv_setsv(*sigsvp, *svp);
1226
1227                 /* This call actually calls sigaction() with almost the
1228                    right settings, including appropriate interpretation
1229                    of DEFAULT and IGNORE.  However, why are we doing
1230                    this when we're about to do it again just below?  XXX */
1231                 SvSETMAGIC(*sigsvp);
1232
1233                 /* And here again we duplicate -- DEFAULT/IGNORE checking. */
1234                 if(SvPOK(*svp)) {
1235                         const char *s=SvPVX_const(*svp);
1236                         if(strEQ(s,"IGNORE")) {
1237                                 act.sa_handler = SIG_IGN;
1238                         }
1239                         else if(strEQ(s,"DEFAULT")) {
1240                                 act.sa_handler = SIG_DFL;
1241                         }
1242                 }
1243
1244                 /* Set up any desired mask. */
1245                 svp = hv_fetchs(action, "MASK", FALSE);
1246                 if (svp && sv_isa(*svp, "POSIX::SigSet")) {
1247                     sigset = (sigset_t *) SvPV_nolen(SvRV(*svp));
1248                     act.sa_mask = *sigset;
1249                 }
1250                 else
1251                     sigemptyset(& act.sa_mask);
1252
1253                 /* Set up any desired flags. */
1254                 svp = hv_fetchs(action, "FLAGS", FALSE);
1255                 act.sa_flags = svp ? SvIV(*svp) : 0;
1256
1257                 /* Don't worry about cleaning up *sigsvp if this fails,
1258                  * because that means we tried to disposition a
1259                  * nonblockable signal, in which case *sigsvp is
1260                  * essentially meaningless anyway.
1261                  */
1262                 RETVAL = sigaction(sig, & act, (struct sigaction *)0);
1263                 if(RETVAL == -1) {
1264                     LEAVE;
1265                     XSRETURN_UNDEF;
1266                 }
1267             }
1268
1269             LEAVE;
1270         }
1271 #endif
1272     OUTPUT:
1273         RETVAL
1274
1275 SysRet
1276 sigpending(sigset)
1277         POSIX::SigSet           sigset
1278     ALIAS:
1279         sigsuspend = 1
1280     CODE:
1281         RETVAL = ix ? sigsuspend(sigset) : sigpending(sigset);
1282     OUTPUT:
1283         RETVAL
1284     CLEANUP:
1285     PERL_ASYNC_CHECK();
1286
1287 SysRet
1288 sigprocmask(how, sigset, oldsigset = 0)
1289         int                     how
1290         POSIX::SigSet           sigset = NO_INIT
1291         POSIX::SigSet           oldsigset = NO_INIT
1292 INIT:
1293         if (! SvOK(ST(1))) {
1294             sigset = NULL;
1295         } else if (sv_isa(ST(1), "POSIX::SigSet")) {
1296             sigset = (sigset_t *) SvPV_nolen(SvRV(ST(1)));
1297         } else {
1298             croak("sigset is not of type POSIX::SigSet");
1299         }
1300
1301         if (items < 3 || ! SvOK(ST(2))) {
1302             oldsigset = NULL;
1303         } else if (sv_isa(ST(2), "POSIX::SigSet")) {
1304             oldsigset = (sigset_t *) SvPV_nolen(SvRV(ST(2)));
1305         } else {
1306             croak("oldsigset is not of type POSIX::SigSet");
1307         }
1308
1309 void
1310 _exit(status)
1311         int             status
1312
1313 SysRet
1314 dup2(fd1, fd2)
1315         int             fd1
1316         int             fd2
1317     CODE:
1318 #ifdef WIN32
1319         /* RT #98912 - More Microsoft muppetry - failing to actually implemented
1320            the well known documented POSIX behaviour for a POSIX API.
1321            http://msdn.microsoft.com/en-us/library/8syseb29.aspx   */
1322         RETVAL = dup2(fd1, fd2) == -1 ? -1 : fd2;
1323 #else
1324         RETVAL = dup2(fd1, fd2);
1325 #endif
1326     OUTPUT:
1327         RETVAL
1328
1329 SV *
1330 lseek(fd, offset, whence)
1331         int             fd
1332         Off_t           offset
1333         int             whence
1334     CODE:
1335         Off_t pos = PerlLIO_lseek(fd, offset, whence);
1336         RETVAL = sizeof(Off_t) > sizeof(IV)
1337                  ? newSVnv((NV)pos) : newSViv((IV)pos);
1338     OUTPUT:
1339         RETVAL
1340
1341 void
1342 nice(incr)
1343         int             incr
1344     PPCODE:
1345         errno = 0;
1346         if ((incr = nice(incr)) != -1 || errno == 0) {
1347             if (incr == 0)
1348                 XPUSHs(newSVpvs_flags("0 but true", SVs_TEMP));
1349             else
1350                 XPUSHs(sv_2mortal(newSViv(incr)));
1351         }
1352
1353 void
1354 pipe()
1355     PPCODE:
1356         int fds[2];
1357         if (pipe(fds) != -1) {
1358             EXTEND(SP,2);
1359             PUSHs(sv_2mortal(newSViv(fds[0])));
1360             PUSHs(sv_2mortal(newSViv(fds[1])));
1361         }
1362
1363 SysRet
1364 read(fd, buffer, nbytes)
1365     PREINIT:
1366         SV *sv_buffer = SvROK(ST(1)) ? SvRV(ST(1)) : ST(1);
1367     INPUT:
1368         int             fd
1369         size_t          nbytes
1370         char *          buffer = sv_grow( sv_buffer, nbytes+1 );
1371     CLEANUP:
1372         if (RETVAL >= 0) {
1373             SvCUR_set(sv_buffer, RETVAL);
1374             SvPOK_only(sv_buffer);
1375             *SvEND(sv_buffer) = '\0';
1376             SvTAINTED_on(sv_buffer);
1377         }
1378
1379 SysRet
1380 setpgid(pid, pgid)
1381         pid_t           pid
1382         pid_t           pgid
1383
1384 pid_t
1385 setsid()
1386
1387 pid_t
1388 tcgetpgrp(fd)
1389         int             fd
1390
1391 SysRet
1392 tcsetpgrp(fd, pgrp_id)
1393         int             fd
1394         pid_t           pgrp_id
1395
1396 void
1397 uname()
1398     PPCODE:
1399 #ifdef HAS_UNAME
1400         struct utsname buf;
1401         if (uname(&buf) >= 0) {
1402             EXTEND(SP, 5);
1403             PUSHs(newSVpvn_flags(buf.sysname, strlen(buf.sysname), SVs_TEMP));
1404             PUSHs(newSVpvn_flags(buf.nodename, strlen(buf.nodename), SVs_TEMP));
1405             PUSHs(newSVpvn_flags(buf.release, strlen(buf.release), SVs_TEMP));
1406             PUSHs(newSVpvn_flags(buf.version, strlen(buf.version), SVs_TEMP));
1407             PUSHs(newSVpvn_flags(buf.machine, strlen(buf.machine), SVs_TEMP));
1408         }
1409 #else
1410         uname((char *) 0); /* A stub to call not_here(). */
1411 #endif
1412
1413 SysRet
1414 write(fd, buffer, nbytes)
1415         int             fd
1416         char *          buffer
1417         size_t          nbytes
1418
1419 SV *
1420 tmpnam()
1421     PREINIT:
1422         STRLEN i;
1423         int len;
1424     CODE:
1425         RETVAL = newSVpvn("", 0);
1426         SvGROW(RETVAL, L_tmpnam);
1427         /* Yes, we know tmpnam() is bad.  So bad that some compilers
1428          * and linkers warn against using it.  But it is here for
1429          * completeness.  POSIX.pod warns against using it.
1430          *
1431          * Then again, maybe this should be removed at some point.
1432          * No point in enabling dangerous interfaces. */
1433         len = strlen(tmpnam(SvPV(RETVAL, i)));
1434         SvCUR_set(RETVAL, len);
1435     OUTPUT:
1436         RETVAL
1437
1438 void
1439 abort()
1440
1441 int
1442 mblen(s, n)
1443         char *          s
1444         size_t          n
1445
1446 size_t
1447 mbstowcs(s, pwcs, n)
1448         wchar_t *       s
1449         char *          pwcs
1450         size_t          n
1451
1452 int
1453 mbtowc(pwc, s, n)
1454         wchar_t *       pwc
1455         char *          s
1456         size_t          n
1457
1458 int
1459 wcstombs(s, pwcs, n)
1460         char *          s
1461         wchar_t *       pwcs
1462         size_t          n
1463
1464 int
1465 wctomb(s, wchar)
1466         char *          s
1467         wchar_t         wchar
1468
1469 int
1470 strcoll(s1, s2)
1471         char *          s1
1472         char *          s2
1473
1474 void
1475 strtod(str)
1476         char *          str
1477     PREINIT:
1478         double num;
1479         char *unparsed;
1480     PPCODE:
1481         STORE_NUMERIC_STANDARD_FORCE_LOCAL();
1482         num = strtod(str, &unparsed);
1483         PUSHs(sv_2mortal(newSVnv(num)));
1484         if (GIMME == G_ARRAY) {
1485             EXTEND(SP, 1);
1486             if (unparsed)
1487                 PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
1488             else
1489                 PUSHs(&PL_sv_undef);
1490         }
1491         RESTORE_NUMERIC_STANDARD();
1492
1493 void
1494 strtol(str, base = 0)
1495         char *          str
1496         int             base
1497     PREINIT:
1498         long num;
1499         char *unparsed;
1500     PPCODE:
1501         num = strtol(str, &unparsed, base);
1502 #if IVSIZE <= LONGSIZE
1503         if (num < IV_MIN || num > IV_MAX)
1504             PUSHs(sv_2mortal(newSVnv((double)num)));
1505         else
1506 #endif
1507             PUSHs(sv_2mortal(newSViv((IV)num)));
1508         if (GIMME == G_ARRAY) {
1509             EXTEND(SP, 1);
1510             if (unparsed)
1511                 PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
1512             else
1513                 PUSHs(&PL_sv_undef);
1514         }
1515
1516 void
1517 strtoul(str, base = 0)
1518         const char *    str
1519         int             base
1520     PREINIT:
1521         unsigned long num;
1522         char *unparsed;
1523     PPCODE:
1524         num = strtoul(str, &unparsed, base);
1525 #if IVSIZE <= LONGSIZE
1526         if (num > IV_MAX)
1527             PUSHs(sv_2mortal(newSVnv((double)num)));
1528         else
1529 #endif
1530             PUSHs(sv_2mortal(newSViv((IV)num)));
1531         if (GIMME == G_ARRAY) {
1532             EXTEND(SP, 1);
1533             if (unparsed)
1534                 PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
1535             else
1536                 PUSHs(&PL_sv_undef);
1537         }
1538
1539 void
1540 strxfrm(src)
1541         SV *            src
1542     CODE:
1543         {
1544           STRLEN srclen;
1545           STRLEN dstlen;
1546           char *p = SvPV(src,srclen);
1547           srclen++;
1548           ST(0) = sv_2mortal(newSV(srclen*4+1));
1549           dstlen = strxfrm(SvPVX(ST(0)), p, (size_t)srclen);
1550           if (dstlen > srclen) {
1551               dstlen++;
1552               SvGROW(ST(0), dstlen);
1553               strxfrm(SvPVX(ST(0)), p, (size_t)dstlen);
1554               dstlen--;
1555           }
1556           SvCUR_set(ST(0), dstlen);
1557             SvPOK_only(ST(0));
1558         }
1559
1560 SysRet
1561 mkfifo(filename, mode)
1562         char *          filename
1563         Mode_t          mode
1564     ALIAS:
1565         access = 1
1566     CODE:
1567         if(ix) {
1568             RETVAL = access(filename, mode);
1569         } else {
1570             TAINT_PROPER("mkfifo");
1571             RETVAL = mkfifo(filename, mode);
1572         }
1573     OUTPUT:
1574         RETVAL
1575
1576 SysRet
1577 tcdrain(fd)
1578         int             fd
1579     ALIAS:
1580         close = 1
1581         dup = 2
1582     CODE:
1583         RETVAL = ix == 1 ? close(fd)
1584             : (ix < 1 ? tcdrain(fd) : dup(fd));
1585     OUTPUT:
1586         RETVAL
1587
1588
1589 SysRet
1590 tcflow(fd, action)
1591         int             fd
1592         int             action
1593     ALIAS:
1594         tcflush = 1
1595         tcsendbreak = 2
1596     CODE:
1597         RETVAL = ix == 1 ? tcflush(fd, action)
1598             : (ix < 1 ? tcflow(fd, action) : tcsendbreak(fd, action));
1599     OUTPUT:
1600         RETVAL
1601
1602 void
1603 asctime(sec, min, hour, mday, mon, year, wday = 0, yday = 0, isdst = -1)
1604         int             sec
1605         int             min
1606         int             hour
1607         int             mday
1608         int             mon
1609         int             year
1610         int             wday
1611         int             yday
1612         int             isdst
1613     ALIAS:
1614         mktime = 1
1615     PPCODE:
1616         {
1617             dXSTARG;
1618             struct tm mytm;
1619             init_tm(&mytm);     /* XXX workaround - see init_tm() in core util.c */
1620             mytm.tm_sec = sec;
1621             mytm.tm_min = min;
1622             mytm.tm_hour = hour;
1623             mytm.tm_mday = mday;
1624             mytm.tm_mon = mon;
1625             mytm.tm_year = year;
1626             mytm.tm_wday = wday;
1627             mytm.tm_yday = yday;
1628             mytm.tm_isdst = isdst;
1629             if (ix) {
1630                 const time_t result = mktime(&mytm);
1631                 if (result == (time_t)-1)
1632                     SvOK_off(TARG);
1633                 else if (result == 0)
1634                     sv_setpvn(TARG, "0 but true", 10);
1635                 else
1636                     sv_setiv(TARG, (IV)result);
1637             } else {
1638                 sv_setpv(TARG, asctime(&mytm));
1639             }
1640             ST(0) = TARG;
1641             XSRETURN(1);
1642         }
1643
1644 long
1645 clock()
1646
1647 char *
1648 ctime(time)
1649         Time_t          &time
1650
1651 void
1652 times()
1653         PPCODE:
1654         struct tms tms;
1655         clock_t realtime;
1656         realtime = times( &tms );
1657         EXTEND(SP,5);
1658         PUSHs( sv_2mortal( newSViv( (IV) realtime ) ) );
1659         PUSHs( sv_2mortal( newSViv( (IV) tms.tms_utime ) ) );
1660         PUSHs( sv_2mortal( newSViv( (IV) tms.tms_stime ) ) );
1661         PUSHs( sv_2mortal( newSViv( (IV) tms.tms_cutime ) ) );
1662         PUSHs( sv_2mortal( newSViv( (IV) tms.tms_cstime ) ) );
1663
1664 double
1665 difftime(time1, time2)
1666         Time_t          time1
1667         Time_t          time2
1668
1669 #XXX: if $xsubpp::WantOptimize is always the default
1670 #     sv_setpv(TARG, ...) could be used rather than
1671 #     ST(0) = sv_2mortal(newSVpv(...))
1672 void
1673 strftime(fmt, sec, min, hour, mday, mon, year, wday = -1, yday = -1, isdst = -1)
1674         SV *            fmt
1675         int             sec
1676         int             min
1677         int             hour
1678         int             mday
1679         int             mon
1680         int             year
1681         int             wday
1682         int             yday
1683         int             isdst
1684     CODE:
1685         {
1686             char *buf;
1687
1688             /* allowing user-supplied (rather than literal) formats
1689              * is normally frowned upon as a potential security risk;
1690              * but this is part of the API so we have to allow it */
1691             GCC_DIAG_IGNORE(-Wformat-nonliteral);
1692             buf = my_strftime(SvPV_nolen(fmt), sec, min, hour, mday, mon, year, wday, yday, isdst);
1693             GCC_DIAG_RESTORE;
1694             if (buf) {
1695                 SV *const sv = sv_newmortal();
1696                 sv_usepvn_flags(sv, buf, strlen(buf), SV_HAS_TRAILING_NUL);
1697                 if (SvUTF8(fmt)) {
1698                     SvUTF8_on(sv);
1699                 }
1700                 ST(0) = sv;
1701             }
1702         }
1703
1704 void
1705 tzset()
1706   PPCODE:
1707     my_tzset(aTHX);
1708
1709 void
1710 tzname()
1711     PPCODE:
1712         EXTEND(SP,2);
1713         PUSHs(newSVpvn_flags(tzname[0], strlen(tzname[0]), SVs_TEMP));
1714         PUSHs(newSVpvn_flags(tzname[1], strlen(tzname[1]), SVs_TEMP));
1715
1716 char *
1717 ctermid(s = 0)
1718         char *          s = 0;
1719     CODE:
1720 #ifdef HAS_CTERMID_R
1721         s = (char *) safemalloc((size_t) L_ctermid);
1722 #endif
1723         RETVAL = ctermid(s);
1724     OUTPUT:
1725         RETVAL
1726     CLEANUP:
1727 #ifdef HAS_CTERMID_R
1728         Safefree(s);
1729 #endif
1730
1731 char *
1732 cuserid(s = 0)
1733         char *          s = 0;
1734     CODE:
1735 #ifdef HAS_CUSERID
1736   RETVAL = cuserid(s);
1737 #else
1738   RETVAL = 0;
1739   not_here("cuserid");
1740 #endif
1741     OUTPUT:
1742   RETVAL
1743
1744 SysRetLong
1745 fpathconf(fd, name)
1746         int             fd
1747         int             name
1748
1749 SysRetLong
1750 pathconf(filename, name)
1751         char *          filename
1752         int             name
1753
1754 SysRet
1755 pause()
1756     CLEANUP:
1757     PERL_ASYNC_CHECK();
1758
1759 unsigned int
1760 sleep(seconds)
1761         unsigned int    seconds
1762     CODE:
1763         RETVAL = PerlProc_sleep(seconds);
1764     OUTPUT:
1765         RETVAL
1766
1767 SysRet
1768 setgid(gid)
1769         Gid_t           gid
1770
1771 SysRet
1772 setuid(uid)
1773         Uid_t           uid
1774
1775 SysRetLong
1776 sysconf(name)
1777         int             name
1778
1779 char *
1780 ttyname(fd)
1781         int             fd
1782
1783 void
1784 getcwd()
1785     PPCODE:
1786       {
1787         dXSTARG;
1788         getcwd_sv(TARG);
1789         XSprePUSH; PUSHTARG;
1790       }
1791
1792 SysRet
1793 lchown(uid, gid, path)
1794        Uid_t           uid
1795        Gid_t           gid
1796        char *          path
1797     CODE:
1798 #ifdef HAS_LCHOWN
1799        /* yes, the order of arguments is different,
1800         * but consistent with CORE::chown() */
1801        RETVAL = lchown(path, uid, gid);
1802 #else
1803        RETVAL = not_here("lchown");
1804 #endif
1805     OUTPUT:
1806        RETVAL