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