X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=doio.c;h=ef16b07906f19a2373d2c8d9cc66d37de3f3929e;hb=b2a156bd8e464af88881c77344280160fd844dcf;hp=a7dc9d9e2ab51c4b5fd7387082f8b3092c8b3fd3;hpb=294b3b3940051144b7e617afd7d93672b0fc2dfd;p=p5sagit%2Fp5-mst-13.2.git diff --git a/doio.c b/doio.c index a7dc9d9..ef16b07 100644 --- a/doio.c +++ b/doio.c @@ -76,7 +76,7 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw, bool was_fdopen = FALSE; bool in_raw = 0, in_crlf = 0, out_raw = 0, out_crlf = 0; char *type = NULL; - char mode[PERL_MODE_MAX]; /* stdio file mode ("r\0", "rb\0", "r+b\0" etc.) */ + char mode[PERL_MODE_MAX]; /* file mode ("r\0", "rb\0", "ab\0" etc.) */ SV *namesv; Zero(mode,sizeof(mode),char); @@ -188,7 +188,6 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw, STRLEN olen = len; char *tend; int dodup = 0; - PerlIO *that_fp = NULL; type = savepvn(oname, len); tend = type+len; @@ -259,17 +258,10 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw, } mode[0] = 'w'; writing = 1; -#ifdef HAS_STRLCAT if (out_raw) - strlcat(mode, "b", PERL_MODE_MAX); + my_strlcat(mode, "b", PERL_MODE_MAX - 1); else if (out_crlf) - strlcat(mode, "t", PERL_MODE_MAX); -#else - if (out_raw) - strcat(mode, "b"); - else if (out_crlf) - strcat(mode, "t"); -#endif + my_strlcat(mode, "t", PERL_MODE_MAX - 1); if (num_svs > 1) { fp = PerlProc_popen_list(mode, num_svs, svp); } @@ -297,17 +289,10 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw, } writing = 1; -#ifdef HAS_STRLCAT if (out_raw) - strlcat(mode, "b", PERL_MODE_MAX); + my_strlcat(mode, "b", PERL_MODE_MAX - 1); else if (out_crlf) - strlcat(mode, "t", PERL_MODE_MAX); -#else - if (out_raw) - strcat(mode, "b"); - else if (out_crlf) - strcat(mode, "t"); -#endif + my_strlcat(mode, "t", PERL_MODE_MAX - 1); if (*type == '&') { duplicity: dodup = PERLIO_DUP_FD; @@ -321,6 +306,7 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw, fp = supplied_fp; } else { + PerlIO *that_fp = NULL; if (num_svs > 1) { Perl_croak(aTHX_ "More than one argument to '%c&' open",IoTYPE(io)); } @@ -339,8 +325,7 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw, thatio = sv_2io(*svp); } else { - GV *thatgv; - thatgv = gv_fetchpvn_flags(type, tend - type, + GV * const thatgv = gv_fetchpvn_flags(type, tend - type, 0, SVt_PVIO); thatio = GvIO(thatgv); } @@ -430,17 +415,10 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw, type++; } while (isSPACE(*type)); mode[0] = 'r'; -#ifdef HAS_STRLCAT if (in_raw) - strlcat(mode, "b", PERL_MODE_MAX); + my_strlcat(mode, "b", PERL_MODE_MAX - 1); else if (in_crlf) - strlcat(mode, "t", PERL_MODE_MAX); -#else - if (in_raw) - strcat(mode, "b"); - else if (in_crlf) - strcat(mode, "t"); -#endif + my_strlcat(mode, "t", PERL_MODE_MAX - 1); if (*type == '&') { goto duplicity; } @@ -491,17 +469,10 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw, TAINT_PROPER("piped open"); mode[0] = 'r'; -#ifdef HAS_STRLCAT if (in_raw) - strlcat(mode, "b", PERL_MODE_MAX); + my_strlcat(mode, "b", PERL_MODE_MAX - 1); else if (in_crlf) - strlcat(mode, "t", PERL_MODE_MAX); -#else - if (in_raw) - strcat(mode, "b"); - else if (in_crlf) - strcat(mode, "t"); -#endif + my_strlcat(mode, "t", PERL_MODE_MAX - 1); if (num_svs > 1) { fp = PerlProc_popen_list(mode,num_svs,svp); @@ -529,17 +500,10 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw, ; mode[0] = 'r'; -#ifdef HAS_STRLCAT if (in_raw) - strlcat(mode, "b", PERL_MODE_MAX); + my_strlcat(mode, "b", PERL_MODE_MAX - 1); else if (in_crlf) - strlcat(mode, "t", PERL_MODE_MAX); -#else - if (in_raw) - strcat(mode, "b"); - else if (in_crlf) - strcat(mode, "t"); -#endif + my_strlcat(mode, "t", PERL_MODE_MAX - 1); if (*name == '-' && name[1] == '\0') { fp = PerlIO_stdin(); @@ -939,7 +903,7 @@ Perl_nextargv(pTHX_ register GV *gv) if (io && (IoFLAGS(io) & IOf_ARGV) && PL_argvout_stack && AvFILLp(PL_argvout_stack) >= 0) { - GV *oldout = (GV*)av_pop(PL_argvout_stack); + GV * const oldout = (GV*)av_pop(PL_argvout_stack); setdefout(oldout); SvREFCNT_dec(oldout); return NULL; @@ -1184,7 +1148,6 @@ my_chsize(int fd, Off_t length) /* code courtesy of William Kucharski */ #define HAS_CHSIZE - struct flock fl; Stat_t filebuf; if (PerlLIO_fstat(fd, &filebuf) < 0) @@ -1204,7 +1167,7 @@ my_chsize(int fd, Off_t length) } else { /* truncate length */ - + struct flock fl; fl.l_whence = 0; fl.l_len = 0; fl.l_start = length; @@ -1270,7 +1233,7 @@ Perl_do_print(pTHX_ register SV *sv, PerlIO *fp) else if (DO_UTF8(sv)) { STRLEN tmplen = len; bool utf8 = TRUE; - U8 *result = bytes_from_utf8((const U8*) tmps, &tmplen, &utf8); + U8 * const result = bytes_from_utf8((const U8*) tmps, &tmplen, &utf8); if (!utf8) { tmpbuf = result; tmps = (char *) tmpbuf; @@ -1294,8 +1257,7 @@ Perl_do_print(pTHX_ register SV *sv, PerlIO *fp) * io the write failure can be delayed until the flush/close. --jhi */ if (len && (PerlIO_write(fp,tmps,len) == 0)) happy = FALSE; - if (tmpbuf) - Safefree(tmpbuf); + Safefree(tmpbuf); return happy ? !PerlIO_error(fp) : FALSE; } @@ -1311,22 +1273,33 @@ Perl_my_stat(pTHX) EXTEND(SP,1); gv = cGVOP_gv; do_fstat: + if (gv == PL_defgv) + return PL_laststatval; io = GvIO(gv); - if (io && IoIFP(io)) { - PL_statgv = gv; - sv_setpvn(PL_statname,"", 0); - PL_laststype = OP_STAT; - return (PL_laststatval = PerlLIO_fstat(PerlIO_fileno(IoIFP(io)), &PL_statcache)); - } - else { - if (gv == PL_defgv) - return PL_laststatval; - if (ckWARN2(WARN_UNOPENED,WARN_CLOSED)) - report_evil_fh(gv, io, PL_op->op_type); - PL_statgv = NULL; - sv_setpvn(PL_statname,"", 0); - return (PL_laststatval = -1); - } + do_fstat_have_io: + PL_laststype = OP_STAT; + PL_statgv = gv; + sv_setpvn(PL_statname, "", 0); + if(io) { + if (IoIFP(io)) { + return (PL_laststatval = PerlLIO_fstat(PerlIO_fileno(IoIFP(io)), &PL_statcache)); + } else if (IoDIRP(io)) { +#ifdef HAS_DIRFD + return (PL_laststatval = PerlLIO_fstat(dirfd(IoDIRP(io)), &PL_statcache)); +#else + Perl_die(aTHX_ PL_no_func, "dirfd"); + NORETURN_FUNCTION_END; +#endif + } else { + if (ckWARN2(WARN_UNOPENED,WARN_CLOSED)) + report_evil_fh(gv, io, PL_op->op_type); + return (PL_laststatval = -1); + } + } else { + if (ckWARN2(WARN_UNOPENED,WARN_CLOSED)) + report_evil_fh(gv, io, PL_op->op_type); + return (PL_laststatval = -1); + } } else if (PL_op->op_private & OPpFT_STACKED) { return PL_laststatval; @@ -1344,6 +1317,11 @@ Perl_my_stat(pTHX) gv = (GV*)SvRV(sv); goto do_fstat; } + else if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVIO) { + io = (IO*)SvRV(sv); + gv = NULL; + goto do_fstat_have_io; + } s = SvPV_const(sv, len); PL_statgv = NULL; @@ -1355,6 +1333,8 @@ Perl_my_stat(pTHX) Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "stat"); return PL_laststatval; } + /* Should we warn/croak here? Or do something smart/useful? */ + return (PL_laststatval = -1); } @@ -1399,6 +1379,19 @@ Perl_my_lstat(pTHX) return PL_laststatval; } +static void +S_exec_failed(pTHX_ const char *cmd, int fd, int do_report) +{ + const int e = errno; + if (ckWARN(WARN_EXEC)) + Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't exec \"%s\": %s", + cmd, Strerror(e)); + if (do_report) { + PerlLIO_write(fd, (void*)&e, sizeof(int)); + PerlLIO_close(fd); + } +} + bool Perl_do_aexec5(pTHX_ SV *really, register SV **mark, register SV **sp, int fd, int do_report) @@ -1431,15 +1424,7 @@ Perl_do_aexec5(pTHX_ SV *really, register SV **mark, register SV **sp, else PerlProc_execvp(PL_Argv[0],EXEC_ARGV_CAST(PL_Argv)); PERL_FPU_POST_EXEC - if (ckWARN(WARN_EXEC)) - Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't exec \"%s\": %s", - (really ? tmps : PL_Argv[0]), Strerror(errno)); - if (do_report) { - const int e = errno; - - PerlLIO_write(fd, (void*)&e, sizeof(int)); - PerlLIO_close(fd); - } + S_exec_failed(aTHX_ (really ? tmps : PL_Argv[0]), fd, do_report); } do_execfree(); #endif @@ -1467,10 +1452,9 @@ Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report) char *cmd; /* Make a copy so we can change it */ - const int cmdlen = strlen(incmd); - Newx(cmd, cmdlen+1, char); - strncpy(cmd, incmd, cmdlen); - cmd[cmdlen] = 0; + const Size_t cmdlen = strlen(incmd) + 1; + Newx(cmd, cmdlen, char); + my_strlcpy(cmd, incmd, cmdlen); while (*cmd && isSPACE(*cmd)) cmd++; @@ -1482,19 +1466,11 @@ Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report) char flags[PERL_FLAGS_MAX]; if (strnEQ(cmd,PL_cshname,PL_cshlen) && strnEQ(cmd+PL_cshlen," -c",3)) { -#ifdef HAS_STRLCPY - strlcpy(flags, "-c", PERL_FLAGS_MAX); -#else - strcpy(flags,"-c"); -#endif + my_strlcpy(flags, "-c", PERL_FLAGS_MAX); s = cmd+PL_cshlen+3; if (*s == 'f') { s++; -#ifdef HAS_STRLCPY - strlcat(flags, "f", PERL_FLAGS_MAX); -#else - strcat(flags,"f"); -#endif + my_strlcat(flags, "f", PERL_FLAGS_MAX - 2); } if (*s == ' ') s++; @@ -1508,9 +1484,10 @@ Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report) if (s[-1] == '\'') { *--s = '\0'; PERL_FPU_PRE_EXEC - PerlProc_execl(PL_cshname,"csh", flags, ncmd, (char*)0); + PerlProc_execl(PL_cshname, "csh", flags, ncmd, (char*)NULL); PERL_FPU_POST_EXEC *s = '\''; + S_exec_failed(aTHX_ PL_cshname, fd, do_report); Safefree(cmd); return FALSE; } @@ -1556,8 +1533,9 @@ Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report) } doshell: PERL_FPU_PRE_EXEC - PerlProc_execl(PL_sh_path, "sh", "-c", cmd, (char*)0); + PerlProc_execl(PL_sh_path, "sh", "-c", cmd, (char *)NULL); PERL_FPU_POST_EXEC + S_exec_failed(aTHX_ PL_sh_path, fd, do_report); Safefree(cmd); return FALSE; } @@ -1585,14 +1563,7 @@ Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report) do_execfree(); goto doshell; } - if (ckWARN(WARN_EXEC)) - Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't exec \"%s\": %s", - PL_Argv[0], Strerror(errno)); - if (do_report) { - const int e = errno; - PerlLIO_write(fd, (const void*)&e, sizeof(int)); - PerlLIO_close(fd); - } + S_exec_failed(aTHX_ PL_Argv[0], fd, do_report); } do_execfree(); Safefree(cmd); @@ -2283,7 +2254,8 @@ Perl_do_shmio(pTHX_ I32 optype, SV **mark, SV **sp) SETERRNO(0,0); if (shmctl(id, IPC_STAT, &shmds) == -1) return -1; - if (mpos < 0 || msize < 0 || (size_t)mpos + msize > shmds.shm_segsz) { + if (mpos < 0 || msize < 0 + || (size_t)mpos + msize > (size_t)shmds.shm_segsz) { SETERRNO(EFAULT,SS_ACCVIO); /* can't do as caller requested */ return -1; } @@ -2308,12 +2280,10 @@ Perl_do_shmio(pTHX_ I32 optype, SV **mark, SV **sp) #endif } else { - I32 n; STRLEN len; const char *mbuf = SvPV_const(mstr, len); - if ((n = len) > msize) - n = msize; + const I32 n = ((I32)len > msize) ? msize : (I32)len; Copy(mbuf, shm + mpos, n, char); if (n < msize) memzero(shm + mpos + n, msize - n);