X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp_sys.c;h=2f674839e51b7c032fb22f93688e0fba68c64ac8;hb=9bc5fa8de0e98ff1317c3fdc7e35f6e13be0ac35;hp=90c12219f2e8ee9d82e622272608538a5f6fb980;hpb=8c99d73ee7ce90de2561496f683f3850d1269e1d;p=p5sagit%2Fp5-mst-13.2.git diff --git a/pp_sys.c b/pp_sys.c index 90c1221..2f67483 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -198,7 +198,6 @@ static char zero_but_true[ZBTLEN + 1] = "0 but true"; # if defined(I_SYS_SECURITY) # include # endif - /* XXX Configure test needed for eaccess */ # ifdef ACC_SELF /* HP SecureWare */ # define PERL_EFF_ACCESS_R_OK(p) (eaccess((p), R_OK, ACC_SELF)) @@ -470,7 +469,7 @@ PP(pp_die) GV *gv = gv_fetchmethod(stash, "PROPAGATE"); if (gv) { SV *file = sv_2mortal(newSVpv(CopFILE(PL_curcop),0)); - SV *line = sv_2mortal(newSViv(CopLINE(PL_curcop))); + SV *line = sv_2mortal(newSVuv(CopLINE(PL_curcop))); EXTEND(SP, 3); PUSHMARK(SP); PUSHs(error); @@ -864,9 +863,9 @@ PP(pp_dbmopen) PUSHs(sv); PUSHs(left); if (SvIV(right)) - PUSHs(sv_2mortal(newSViv(O_RDWR|O_CREAT))); + PUSHs(sv_2mortal(newSVuv(O_RDWR|O_CREAT))); else - PUSHs(sv_2mortal(newSViv(O_RDWR))); + PUSHs(sv_2mortal(newSVuv(O_RDWR))); PUSHs(right); PUTBACK; call_sv((SV*)GvCV(gv), G_SCALAR); @@ -877,7 +876,7 @@ PP(pp_dbmopen) PUSHMARK(SP); PUSHs(sv); PUSHs(left); - PUSHs(sv_2mortal(newSViv(O_RDONLY))); + PUSHs(sv_2mortal(newSVuv(O_RDONLY))); PUSHs(right); PUTBACK; call_sv((SV*)GvCV(gv), G_SCALAR); @@ -1616,11 +1615,11 @@ PP(pp_send) bufsv = *++MARK; buffer = SvPV(bufsv, blen); #if Size_t_size > IVSIZE - length = SvNVx(*++MARK); + length = (Size_t)SvNVx(*++MARK); #else - length = SvIVx(*++MARK); + length = (Size_t)SvIVx(*++MARK); #endif - if ((Size_t)length < 0) + if ((SSize_t)length < 0) DIE(aTHX_ "Negative length"); SETERRNO(0,0); io = GvIO(gv); @@ -1793,9 +1792,9 @@ PP(pp_sysseek) #if LSEEKSIZE > IVSIZE XPUSHs(sv_2mortal(newSVnv((NV) offset))); #else - XPUSHs(sv_2mortal(newSViv((IV) offset))); + XPUSHs(sv_2mortal(newSViv(offset))); #endif - XPUSHs(sv_2mortal(newSViv((IV) whence))); + XPUSHs(sv_2mortal(newSViv(whence))); PUTBACK; ENTER; call_method("SEEK", G_SCALAR); @@ -1807,15 +1806,15 @@ PP(pp_sysseek) if (PL_op->op_type == OP_SEEK) PUSHs(boolSV(do_seek(gv, offset, whence))); else { - Off_t n = do_sysseek(gv, offset, whence); - if (n < 0) + Off_t sought = do_sysseek(gv, offset, whence); + if (sought < 0) PUSHs(&PL_sv_undef); else { - SV* sv = n ? + SV* sv = sought ? #if LSEEKSIZE > IVSIZE - newSVnv((NV)n) + newSVnv((NV)sought) #else - newSViv((IV)n) + newSViv(sought) #endif : newSVpvn(zero_but_true, ZBTLEN); PUSHs(sv_2mortal(sv)); @@ -2541,17 +2540,25 @@ PP(pp_stat) EXTEND_MORTAL(max); PUSHs(sv_2mortal(newSViv(PL_statcache.st_dev))); PUSHs(sv_2mortal(newSViv(PL_statcache.st_ino))); - PUSHs(sv_2mortal(newSViv(PL_statcache.st_mode))); - PUSHs(sv_2mortal(newSViv(PL_statcache.st_nlink))); + PUSHs(sv_2mortal(newSVuv(PL_statcache.st_mode))); + PUSHs(sv_2mortal(newSVuv(PL_statcache.st_nlink))); #if Uid_t_size > IVSIZE PUSHs(sv_2mortal(newSVnv(PL_statcache.st_uid))); #else +# if Uid_t_sign <= 0 PUSHs(sv_2mortal(newSViv(PL_statcache.st_uid))); +# else + PUSHs(sv_2mortal(newSVuv(PL_statcache.st_uid))); +# endif #endif #if Gid_t_size > IVSIZE PUSHs(sv_2mortal(newSVnv(PL_statcache.st_gid))); #else +# if Gid_t_sign <= 0 PUSHs(sv_2mortal(newSViv(PL_statcache.st_gid))); +# else + PUSHs(sv_2mortal(newSVuv(PL_statcache.st_gid))); +# endif #endif #ifdef USE_STAT_RDEV PUSHs(sv_2mortal(newSViv(PL_statcache.st_rdev))); @@ -2573,8 +2580,8 @@ PP(pp_stat) PUSHs(sv_2mortal(newSViv(PL_statcache.st_ctime))); #endif #ifdef USE_STAT_BLOCKS - PUSHs(sv_2mortal(newSViv(PL_statcache.st_blksize))); - PUSHs(sv_2mortal(newSViv(PL_statcache.st_blocks))); + PUSHs(sv_2mortal(newSVuv(PL_statcache.st_blksize))); + PUSHs(sv_2mortal(newSVuv(PL_statcache.st_blocks))); #else PUSHs(sv_2mortal(newSVpvn("", 0))); PUSHs(sv_2mortal(newSVpvn("", 0))); @@ -3070,7 +3077,7 @@ PP(pp_fttext) (void)PerlIO_close(fp); RETPUSHUNDEF; } - do_binmode(fp, '<', TRUE); + do_binmode(fp, '<', O_BINARY); len = PerlIO_read(fp, tbuf, sizeof(tbuf)); (void)PerlIO_close(fp); if (len <= 0) { @@ -4078,14 +4085,14 @@ PP(pp_gmtime) SV *tsv; if (!tmbuf) RETPUSHUNDEF; - tsv = Perl_newSVpvf(aTHX_ "%s %s %2d %02d:%02d:%02d %d", + tsv = Perl_newSVpvf(aTHX_ "%s %s %2"IVdf" %02"IVdf":%02"IVdf":%02"IVdf" %"IVdf, dayname[tmbuf->tm_wday], monname[tmbuf->tm_mon], - tmbuf->tm_mday, - tmbuf->tm_hour, - tmbuf->tm_min, - tmbuf->tm_sec, - tmbuf->tm_year + 1900); + (IV)tmbuf->tm_mday, + (IV)tmbuf->tm_hour, + (IV)tmbuf->tm_min, + (IV)tmbuf->tm_sec, + (IV)tmbuf->tm_year + 1900); PUSHs(sv_2mortal(tsv)); } else if (tmbuf) { @@ -4762,46 +4769,40 @@ PP(pp_gpwent) #ifdef HAS_PASSWD I32 which = PL_op->op_type; register SV *sv; - struct passwd *pwent; STRLEN n_a; -#if defined(HAS_GETSPENT) || defined(HAS_GETSPNAM) - struct spwd *spwent = NULL; -#endif + struct passwd *pwent = NULL; +/* We do not use HAS_GETSPENT in pp_gpwent() but leave it here in the case + * somebody wants to write an XS to access the shadow passwords. --jhi */ +# ifdef HAS_GETSPNAM + struct spwd *spwent = NULL; +# endif - if (which == OP_GPWNAM) - pwent = getpwnam(POPpx); - else if (which == OP_GPWUID) - pwent = getpwuid(POPi); - else -#ifdef HAS_GETPWENT - pwent = (struct passwd *)getpwent(); -#else + switch (which) { + case OP_GPWNAM: + pwent = getpwnam(POPpx); + break; + case OP_GPWUID: + pwent = getpwuid((Uid_t)POPi); + break; + case OP_GPWENT: +# ifdef HAS_GETPWENT + pwent = getpwent(); +# else DIE(aTHX_ PL_no_func, "getpwent"); -#endif - -#ifdef HAS_GETSPNAM - if (which == OP_GPWNAM) { - if (pwent) - spwent = getspnam(pwent->pw_name); - } -# ifdef HAS_GETSPUID /* AFAIK there isn't any anywhere. --jhi */ - else if (which == OP_GPWUID) { - if (pwent) - spwent = getspnam(pwent->pw_name); +# endif + break; } -# endif -# ifdef HAS_GETSPENT - else - spwent = (struct spwd *)getspent(); -# endif -#endif EXTEND(SP, 10); if (GIMME != G_ARRAY) { PUSHs(sv = sv_newmortal()); if (pwent) { if (which == OP_GPWNAM) +# if Uid_t_sign <= 0 sv_setiv(sv, (IV)pwent->pw_uid); +# else + sv_setuv(sv, (UV)pwent->pw_uid); +# endif else sv_setpv(sv, pwent->pw_name); } @@ -4813,66 +4814,80 @@ PP(pp_gpwent) sv_setpv(sv, pwent->pw_name); PUSHs(sv = sv_mortalcopy(&PL_sv_no)); -#ifdef PWPASSWD -# if defined(HAS_GETSPENT) || defined(HAS_GETSPNAM) - if (spwent) - sv_setpv(sv, spwent->sp_pwdp); - else - sv_setpv(sv, pwent->pw_passwd); +# ifdef HAS_GETSPNAM + spwent = getspnam(pwent->pw_name); + if (spwent) + sv_setpv(sv, spwent->sp_pwdp); + else + sv_setpv(sv, pwent->pw_passwd); # else sv_setpv(sv, pwent->pw_passwd); # endif -#endif +# ifndef INCOMPLETE_TAINTS + /* passwd is tainted because user himself can diddle with it. */ + SvTAINTED_on(sv); +# endif PUSHs(sv = sv_mortalcopy(&PL_sv_no)); +# if Uid_t_sign <= 0 sv_setiv(sv, (IV)pwent->pw_uid); +# else + sv_setuv(sv, (UV)pwent->pw_uid); +# endif PUSHs(sv = sv_mortalcopy(&PL_sv_no)); +# if Uid_t_sign <= 0 sv_setiv(sv, (IV)pwent->pw_gid); - +# else + sv_setuv(sv, (UV)pwent->pw_gid); +# endif /* pw_change, pw_quota, and pw_age are mutually exclusive. */ PUSHs(sv = sv_mortalcopy(&PL_sv_no)); -#ifdef PWCHANGE +# ifdef PWCHANGE sv_setiv(sv, (IV)pwent->pw_change); -#else -# ifdef PWQUOTA - sv_setiv(sv, (IV)pwent->pw_quota); # else -# ifdef PWAGE +# ifdef PWQUOTA + sv_setiv(sv, (IV)pwent->pw_quota); +# else +# ifdef PWAGE sv_setpv(sv, pwent->pw_age); +# endif # endif # endif -#endif /* pw_class and pw_comment are mutually exclusive. */ PUSHs(sv = sv_mortalcopy(&PL_sv_no)); -#ifdef PWCLASS +# ifdef PWCLASS sv_setpv(sv, pwent->pw_class); -#else -# ifdef PWCOMMENT +# else +# ifdef PWCOMMENT sv_setpv(sv, pwent->pw_comment); +# endif # endif -#endif PUSHs(sv = sv_mortalcopy(&PL_sv_no)); -#ifdef PWGECOS +# ifdef PWGECOS sv_setpv(sv, pwent->pw_gecos); -#endif -#ifndef INCOMPLETE_TAINTS +# endif +# ifndef INCOMPLETE_TAINTS /* pw_gecos is tainted because user himself can diddle with it. */ SvTAINTED_on(sv); -#endif +# endif PUSHs(sv = sv_mortalcopy(&PL_sv_no)); sv_setpv(sv, pwent->pw_dir); PUSHs(sv = sv_mortalcopy(&PL_sv_no)); sv_setpv(sv, pwent->pw_shell); +# ifndef INCOMPLETE_TAINTS + /* pw_shell is tainted because user himself can diddle with it. */ + SvTAINTED_on(sv); +# endif -#ifdef PWEXPIRE +# ifdef PWEXPIRE PUSHs(sv = sv_mortalcopy(&PL_sv_no)); sv_setiv(sv, (IV)pwent->pw_expire); -#endif +# endif } RETURN; #else