X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/13ec70afab644813396652ff23a6e02fbd3d00d7..87d46f97c572fcb76df491a3f99f2a7106164f04:/ext/POSIX/POSIX.xs diff --git a/ext/POSIX/POSIX.xs b/ext/POSIX/POSIX.xs index 3b39038..3c7b0b8 100644 --- a/ext/POSIX/POSIX.xs +++ b/ext/POSIX/POSIX.xs @@ -51,7 +51,7 @@ #include #endif -/* XXX This comment is just to make I_TERMIO and I_SGTTY visible to +/* XXX This comment is just to make I_TERMIO and I_SGTTY visible to metaconfig for future extension writers. We don't use them in POSIX. (This is really sneaky :-) --AD */ @@ -85,6 +85,26 @@ char *tzname[] = { "" , "" }; #endif #endif +#ifndef PERL_UNUSED_DECL +# ifdef HASATTRIBUTE +# if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER) +# define PERL_UNUSED_DECL +# else +# define PERL_UNUSED_DECL __attribute__((unused)) +# endif +# else +# define PERL_UNUSED_DECL +# endif +#endif + +#ifndef dNOOP +#define dNOOP extern int Perl___notused PERL_UNUSED_DECL +#endif + +#ifndef dVAR +#define dVAR dNOOP +#endif + #if defined(__VMS) && !defined(__POSIX_SOURCE) # include /* LIB$_INVARG constant */ # include /* prototype for lib$ediv() */ @@ -178,7 +198,7 @@ char *tzname[] = { "" , "" }; # ifndef HAS_MKFIFO # if defined(OS2) || defined(MACOS_TRADITIONAL) # define mkfifo(a,b) not_here("mkfifo") -# else /* !( defined OS2 ) */ +# else /* !( defined OS2 ) */ # ifndef mkfifo # define mkfifo(path, mode) (mknod((path), (mode) | S_IFIFO, 0)) # endif @@ -189,7 +209,9 @@ char *tzname[] = { "" , "" }; # define ttyname(a) (char*)not_here("ttyname") # define tzset() not_here("tzset") # else -# include +# ifdef I_GRP +# include +# endif # include # ifdef HAS_UNAME # include @@ -243,7 +265,7 @@ unsigned long strtoul (const char *, char **, int); #endif #endif #ifndef HAS_FPATHCONF -#define fpathconf(f,n) (SysRetLong) not_here("fpathconf") +#define fpathconf(f,n) (SysRetLong) not_here("fpathconf") #endif #ifndef HAS_MKTIME #define mktime(a) not_here("mktime") @@ -252,10 +274,10 @@ unsigned long strtoul (const char *, char **, int); #define nice(a) not_here("nice") #endif #ifndef HAS_PATHCONF -#define pathconf(f,n) (SysRetLong) not_here("pathconf") +#define pathconf(f,n) (SysRetLong) not_here("pathconf") #endif #ifndef HAS_SYSCONF -#define sysconf(n) (SysRetLong) not_here("sysconf") +#define sysconf(n) (SysRetLong) not_here("sysconf") #endif #ifndef HAS_READLINK #define readlink(a,b,c) not_here("readlink") @@ -391,7 +413,6 @@ foreach (C_constant ("POSIX", 'int_macro_int', 'IV', $types, undef, 5, @names) ) } print "#### XS Section:\n"; print XS_constant ("POSIX", $types); -__END__ */ switch (len) { @@ -565,7 +586,7 @@ new(packname = "POSIX::SigSet", ...) CODE: { int i; - New(0, RETVAL, 1, sigset_t); + Newx(RETVAL, 1, sigset_t); sigemptyset(RETVAL); for (i = 1; i < items; i++) sigaddset(RETVAL, SvIV(ST(i))); @@ -602,7 +623,6 @@ sigismember(sigset, sig) POSIX::SigSet sigset int sig - MODULE = Termios PACKAGE = POSIX::Termios PREFIX = cf POSIX::Termios @@ -611,7 +631,7 @@ new(packname = "POSIX::Termios", ...) CODE: { #ifdef I_TERMIOS - New(0, RETVAL, 1, struct termios); + Newx(RETVAL, 1, struct termios); #else not_here("termios"); RETVAL = 0; @@ -712,7 +732,7 @@ getlflag(termios_ref) cc_t getcc(termios_ref, ccix) POSIX::Termios termios_ref - int ccix + unsigned int ccix CODE: #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */ if (ccix >= NCCS) @@ -782,7 +802,7 @@ setlflag(termios_ref, lflag) void setcc(termios_ref, ccix, cc) POSIX::Termios termios_ref - int ccix + unsigned int ccix cc_t cc CODE: #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */ @@ -1013,6 +1033,7 @@ localeconv() #ifdef HAS_LOCALECONV struct lconv *lcbuf; RETVAL = newHV(); + sv_2mortal((SV*)RETVAL); if ((lcbuf = localeconv())) { /* the strings */ if (lcbuf->decimal_point && *lcbuf->decimal_point) @@ -1039,7 +1060,7 @@ localeconv() if (lcbuf->mon_thousands_sep && *lcbuf->mon_thousands_sep) hv_store(RETVAL, "mon_thousands_sep", 17, newSVpv(lcbuf->mon_thousands_sep, 0), 0); -#endif +#endif #ifndef NO_LOCALECONV_MON_GROUPING if (lcbuf->mon_grouping && *lcbuf->mon_grouping) hv_store(RETVAL, "mon_grouping", 12, @@ -1227,6 +1248,7 @@ sigaction(sig, optaction, oldaction = 0) # interface look beautiful, which is hard. { + dVAR; POSIX__SigAction action; GV *siggv = gv_fetchpv("SIG", TRUE, SVt_PVHV); struct sigaction act; @@ -1237,8 +1259,13 @@ sigaction(sig, optaction, oldaction = 0) POSIX__SigSet sigset; SV** svp; SV** sigsvp; + + if (sig < 0) { + croak("Negative signals are not allowed"); + } + if (sig == 0 && SvPOK(ST(0))) { - char *s = SvPVX(ST(0)); + const char *s = SvPVX_const(ST(0)); int i = whichsig(s); if (i < 0 && memEQ(s, "SIG", 3)) @@ -1252,6 +1279,13 @@ sigaction(sig, optaction, oldaction = 0) else sig = i; } +#ifdef NSIG + if (sig > NSIG) { /* NSIG - 1 is still okay. */ + Perl_warner(aTHX_ packWARN(WARN_SIGNAL), + "No such signal: %d", sig); + XSRETURN_UNDEF; + } +#endif sigsvp = hv_fetch(GvHVn(siggv), PL_sig_name[sig], strlen(PL_sig_name[sig]), @@ -1287,7 +1321,7 @@ sigaction(sig, optaction, oldaction = 0) /* Remember old disposition if desired. */ if (oldaction) { - svp = hv_fetch(oldaction, "HANDLER", 7, TRUE); + svp = hv_fetchs(oldaction, "HANDLER", TRUE); if(!svp) croak("Can't supply an oldaction without a HANDLER"); if(SvTRUE(*sigsvp)) { /* TBD: what if "0"? */ @@ -1300,37 +1334,43 @@ sigaction(sig, optaction, oldaction = 0) if(RETVAL == -1) XSRETURN_UNDEF; /* Get back the mask. */ - svp = hv_fetch(oldaction, "MASK", 4, TRUE); + svp = hv_fetchs(oldaction, "MASK", TRUE); if (sv_isa(*svp, "POSIX::SigSet")) { IV tmp = SvIV((SV*)SvRV(*svp)); sigset = INT2PTR(sigset_t*, tmp); } else { - New(0, sigset, 1, sigset_t); + Newx(sigset, 1, sigset_t); sv_setptrobj(*svp, sigset, "POSIX::SigSet"); } *sigset = oact.sa_mask; /* Get back the flags. */ - svp = hv_fetch(oldaction, "FLAGS", 5, TRUE); + svp = hv_fetchs(oldaction, "FLAGS", TRUE); sv_setiv(*svp, oact.sa_flags); /* Get back whether the old handler used safe signals. */ - svp = hv_fetch(oldaction, "SAFE", 4, TRUE); - sv_setiv(*svp, oact.sa_handler == PL_csighandlerp); + svp = hv_fetchs(oldaction, "SAFE", TRUE); + sv_setiv(*svp, + /* compare incompatible pointers by casting to integer */ + PTR2nat(oact.sa_handler) == PTR2nat(PL_csighandlerp)); } if (action) { /* Safe signals use "csighandler", which vectors through the PL_sighandlerp pointer when it's safe to do so. (BTW, "csighandler" is very different from "sighandler".) */ - svp = hv_fetch(action, "SAFE", 4, FALSE); - act.sa_handler = (*svp && SvTRUE(*svp)) - ? PL_csighandlerp : PL_sighandlerp; + svp = hv_fetchs(action, "SAFE", FALSE); + act.sa_handler = + DPTR2FPTR( + void (*)(int), + (*svp && SvTRUE(*svp)) + ? PL_csighandlerp : PL_sighandlerp + ); /* Vector new Perl handler through %SIG. (The core signal handlers read %SIG to dispatch.) */ - svp = hv_fetch(action, "HANDLER", 7, FALSE); + svp = hv_fetchs(action, "HANDLER", FALSE); if (!svp) croak("Can't supply an action without a HANDLER"); sv_setsv(*sigsvp, *svp); @@ -1343,7 +1383,7 @@ sigaction(sig, optaction, oldaction = 0) /* And here again we duplicate -- DEFAULT/IGNORE checking. */ if(SvPOK(*svp)) { - char *s=SvPVX(*svp); + const char *s=SvPVX_const(*svp); if(strEQ(s,"IGNORE")) { act.sa_handler = SIG_IGN; } @@ -1353,7 +1393,7 @@ sigaction(sig, optaction, oldaction = 0) } /* Set up any desired mask. */ - svp = hv_fetch(action, "MASK", 4, FALSE); + svp = hv_fetchs(action, "MASK", FALSE); if (svp && sv_isa(*svp, "POSIX::SigSet")) { IV tmp = SvIV((SV*)SvRV(*svp)); sigset = INT2PTR(sigset_t*, tmp); @@ -1363,7 +1403,7 @@ sigaction(sig, optaction, oldaction = 0) sigemptyset(& act.sa_mask); /* Set up any desired flags. */ - svp = hv_fetch(action, "FLAGS", 5, FALSE); + svp = hv_fetchs(action, "FLAGS", FALSE); act.sa_flags = svp ? SvIV(*svp) : 0; /* Don't worry about cleaning up *sigsvp if this fails, @@ -1372,8 +1412,8 @@ sigaction(sig, optaction, oldaction = 0) * essentially meaningless anyway. */ RETVAL = sigaction(sig, & act, (struct sigaction *)0); - if(RETVAL == -1) - XSRETURN_UNDEF; + if(RETVAL == -1) + XSRETURN_UNDEF; } LEAVE; @@ -1389,20 +1429,25 @@ sigpending(sigset) SysRet sigprocmask(how, sigset, oldsigset = 0) int how - POSIX::SigSet sigset + POSIX::SigSet sigset = NO_INIT POSIX::SigSet oldsigset = NO_INIT INIT: - if ( items < 3 ) { - oldsigset = 0; + if (! SvOK(ST(1))) { + sigset = NULL; + } else if (sv_isa(ST(1), "POSIX::SigSet")) { + IV tmp = SvIV((SV*)SvRV(ST(1))); + sigset = INT2PTR(POSIX__SigSet,tmp); + } else { + croak("sigset is not of type POSIX::SigSet"); } - else if (sv_derived_from(ST(2), "POSIX::SigSet")) { + + if (items < 3 || ! SvOK(ST(2))) { + oldsigset = NULL; + } else if (sv_isa(ST(2), "POSIX::SigSet")) { IV tmp = SvIV((SV*)SvRV(ST(2))); oldsigset = INT2PTR(POSIX__SigSet,tmp); - } - else { - New(0, oldsigset, 1, sigset_t); - sigemptyset(oldsigset); - sv_setref_pv(ST(2), "POSIX::SigSet", (void*)oldsigset); + } else { + croak("oldsigset is not of type POSIX::SigSet"); } SysRet @@ -1470,7 +1515,7 @@ read(fd, buffer, nbytes) char * buffer = sv_grow( sv_buffer, nbytes+1 ); CLEANUP: if (RETVAL >= 0) { - SvCUR(sv_buffer) = RETVAL; + SvCUR_set(sv_buffer, RETVAL); SvPOK_only(sv_buffer); *SvEND(sv_buffer) = '\0'; SvTAINTED_on(sv_buffer); @@ -1638,7 +1683,7 @@ strxfrm(src) STRLEN dstlen; char *p = SvPV(src,srclen); srclen++; - ST(0) = sv_2mortal(NEWSV(800,srclen*4+1)); + ST(0) = sv_2mortal(newSV(srclen*4+1)); dstlen = strxfrm(SvPVX(ST(0)), p, (size_t)srclen); if (dstlen > srclen) { dstlen++; @@ -1646,7 +1691,7 @@ strxfrm(src) strxfrm(SvPVX(ST(0)), p, (size_t)dstlen); dstlen--; } - SvCUR(ST(0)) = dstlen; + SvCUR_set(ST(0), dstlen); SvPOK_only(ST(0)); } @@ -1805,7 +1850,18 @@ access(filename, mode) char * ctermid(s = 0) - char * s = 0; + char * s = 0; + CODE: +#ifdef HAS_CTERMID_R + s = safemalloc((size_t) L_ctermid); +#endif + RETVAL = ctermid(s); + OUTPUT: + RETVAL + CLEANUP: +#ifdef HAS_CTERMID_R + Safefree(s); +#endif char * cuserid(s = 0) @@ -1828,19 +1884,23 @@ SysRet setgid(gid) Gid_t gid CLEANUP: +#ifndef WIN32 if (RETVAL >= 0) { PL_gid = getgid(); PL_egid = getegid(); } +#endif SysRet setuid(uid) Uid_t uid CLEANUP: +#ifndef WIN32 if (RETVAL >= 0) { PL_uid = getuid(); PL_euid = geteuid(); } +#endif SysRetLong sysconf(name) @@ -1859,3 +1919,18 @@ getcwd() XSprePUSH; PUSHTARG; } +SysRet +lchown(uid, gid, path) + Uid_t uid + Gid_t gid + char * path + CODE: +#ifdef HAS_LCHOWN + /* yes, the order of arguments is different, + * but consistent with CORE::chown() */ + RETVAL = lchown(path, uid, gid); +#else + RETVAL = not_here("lchown"); +#endif + OUTPUT: + RETVAL