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