[PATCH] Coverity: check for negative return values from/to library calls

[p5pRT]

Migrated from rt.perl.org#121743 (status was 'resolved')

Searchable as RT121743$

[p5pRT]

From @jhi

Dozens of too trusting fileno calls (and then using the returned fds for fstat etc.)\, plus two similar cases for getgroups().

Attached.

[p5pRT]

From @jhi

0001-Fix-for-Coverity-perl5-CIDs-28990.29003-29005.29011-.patch

```diff From c0b207e73c8a503a10759b56243fc02cb43fdbfb Mon Sep 17 00:00:00 2001 From: Jarkko Hietaniemi Date: Wed, 23 Apr 2014 17:43:15 -0400 Subject: [PATCH] Fix for Coverity perl5 CIDs 28990..29003,29005..29011,29013: Argument cannot be negative (NEGATIVE_RETURNS) fd is passed to a parameter that cannot be negative. and CIDs 29004, 29012: Argument cannot be negative (NEGATIVE_RETURNS) num_groups is passed to a parameter that cannot be negative and because of CIDs 29005 and 29006 also CID 28924. In the first set of issues a fd is retrieved from PerlIO_fileno, and that is then used in places like fstat(), fchown(), dup(), etc., without checking whether the fd is valid (>=0). In the second set of issues a potentially negative number is potentially passed to getgroups(). The CIDs 29005 and 29006 were a bit messy: fixing them needed also resolving CID 28924 where the return value of fstat() was ignored, and for completeness adding two croak calls (with perldiag updates): a bit of a waste since it's suidperl code. --- dist/IO/IO.xs | 12 ++++-- doio.c | 81 +++++++++++++++++++++++------------- ext/PerlIO-mmap/mmap.xs | 5 ++- mg.c | 15 ++++--- perl.c | 31 +++++++++----- perlio.c | 16 +++++++- pod/perldiag.pod | 4 ++ pp_sys.c | 106 +++++++++++++++++++++++++++++++++--------------- util.c | 13 +++--- 9 files changed, 194 insertions(+), 89 deletions(-) diff --git a/dist/IO/IO.xs b/dist/IO/IO.xs index 9056cb6..d7fe0a0 100644 --- a/dist/IO/IO.xs +++ b/dist/IO/IO.xs @@ -524,9 +524,15 @@ fsync(arg) handle = IoOFP(sv_2io(arg)); if (!handle) handle = IoIFP(sv_2io(arg)); - if(handle) - RETVAL = fsync(PerlIO_fileno(handle)); - else { + if (handle) { + int fd = PerlIO_fileno(handle); + if (fd >= 0) { + RETVAL = fsync(fd); + } else { + RETVAL = -1; + errno = EINVAL; + } + } else { RETVAL = -1; errno = EINVAL; } diff --git a/doio.c b/doio.c index e2bfda5..0dfbf1b 100644 --- a/doio.c +++ b/doio.c @@ -646,6 +646,8 @@ S_openn_cleanup(pTHX_ GV *gv, IO *io, PerlIO *fp, char *mode, const char *oname, } fd = PerlIO_fileno(fp); + if (fd < 0) + goto say_false; /* If there is no fd (e.g. PerlIO::scalar) assume it isn't a * socket - this covers PerlIO::scalar - otherwise unless we "know" the * type probe for socket-ness. @@ -732,13 +734,23 @@ S_openn_cleanup(pTHX_ GV *gv, IO *io, PerlIO *fp, char *mode, const char *oname, if (was_fdopen) { /* need to close fp without closing underlying fd */ int ofd = PerlIO_fileno(fp); - int dupfd = PerlLIO_dup(ofd); + int dupfd = ofd >= 0 ? PerlLIO_dup(ofd) : -1; #if defined(HAS_FCNTL) && defined(F_SETFD) /* Assume if we have F_SETFD we have F_GETFD */ - int coe = fcntl(ofd,F_GETFD); + int coe = ofd >= 0 ? fcntl(ofd, F_GETFD) : -1; + if (coe < 0) { + if (dupfd >= 0) + PerlLIO_close(dupfd); + goto say_false; + } #endif + if (ofd < 0 || dupfd < 0) { + if (dupfd >= 0) + PerlLIO_close(dupfd); + goto say_false; + } PerlIO_close(fp); - PerlLIO_dup2(dupfd,ofd); + PerlLIO_dup2(dupfd, ofd); #if defined(HAS_FCNTL) && defined(F_SETFD) /* The dup trick has lost close-on-exec on ofd */ fcntl(ofd,F_SETFD, coe); @@ -956,23 +968,25 @@ Perl_nextargv(pTHX_ GV *gv) } setdefout(PL_argvoutgv); PL_lastfd = PerlIO_fileno(IoIFP(GvIOp(PL_argvoutgv))); - (void)PerlLIO_fstat(PL_lastfd,&PL_statbuf); + if (PL_lastfd >= 0) { + (void)PerlLIO_fstat(PL_lastfd,&PL_statbuf); #ifdef HAS_FCHMOD - (void)fchmod(PL_lastfd,PL_filemode); + (void)fchmod(PL_lastfd,PL_filemode); #else - (void)PerlLIO_chmod(PL_oldname,PL_filemode); + (void)PerlLIO_chmod(PL_oldname,PL_filemode); #endif - if (fileuid != PL_statbuf.st_uid || filegid != PL_statbuf.st_gid) { - int rc = 0; + if (fileuid != PL_statbuf.st_uid || filegid != PL_statbuf.st_gid) { + int rc = 0; #ifdef HAS_FCHOWN - rc = fchown(PL_lastfd,fileuid,filegid); + rc = fchown(PL_lastfd,fileuid,filegid); #else #ifdef HAS_CHOWN - rc = PerlLIO_chown(PL_oldname,fileuid,filegid); + rc = PerlLIO_chown(PL_oldname,fileuid,filegid); #endif #endif - /* XXX silently ignore failures */ - PERL_UNUSED_VAR(rc); + /* XXX silently ignore failures */ + PERL_UNUSED_VAR(rc); + } } return IoIFP(GvIOp(gv)); } @@ -1169,8 +1183,12 @@ Perl_do_sysseek(pTHX_ GV *gv, Off_t pos, int whence) PERL_ARGS_ASSERT_DO_SYSSEEK; - if (io && (fp = IoIFP(io))) - return PerlLIO_lseek(PerlIO_fileno(fp), pos, whence); + if (io && (fp = IoIFP(io))) { + int fd = PerlIO_fileno(fp); + if (fd >= 0) { + return PerlLIO_lseek(fd, pos, whence); + } + } report_evil_fh(gv); SETERRNO(EBADF,RMS_IFI); return (Off_t)-1; @@ -1376,7 +1394,10 @@ Perl_my_stat_flags(pTHX_ const U32 flags) sv_setpvs(PL_statname, ""); if(io) { if (IoIFP(io)) { - return (PL_laststatval = PerlLIO_fstat(PerlIO_fileno(IoIFP(io)), &PL_statcache)); + int fd = PerlIO_fileno(IoIFP(io)); + if (fd >= 0) { + return (PL_laststatval = PerlLIO_fstat(fd, &PL_statcache)); + } } else if (IoDIRP(io)) { return (PL_laststatval = PerlLIO_fstat(my_dirfd(IoDIRP(io)), &PL_statcache)); } @@ -1739,9 +1760,10 @@ Perl_apply(pTHX_ I32 type, SV **mark, SV **sp) if ((gv = MAYBE_DEREF_GV(*mark))) { if (GvIO(gv) && IoIFP(GvIOp(gv))) { #ifdef HAS_FCHMOD + int fd = PerlIO_fileno(IoIFP(GvIOn(gv))); APPLY_TAINT_PROPER(); - if (fchmod(PerlIO_fileno(IoIFP(GvIOn(gv))), val)) - tot--; + if (fd >= 0 && fchmod(fd, val)) + tot--; #else Perl_die(aTHX_ PL_no_func, "fchmod"); #endif @@ -1775,8 +1797,9 @@ Perl_apply(pTHX_ I32 type, SV **mark, SV **sp) if ((gv = MAYBE_DEREF_GV(*mark))) { if (GvIO(gv) && IoIFP(GvIOp(gv))) { #ifdef HAS_FCHOWN + int fd = PerlIO_fileno(IoIFP(GvIOn(gv))); APPLY_TAINT_PROPER(); - if (fchown(PerlIO_fileno(IoIFP(GvIOn(gv))), val, val2)) + if (fd >= 0 && fchown(fd, val, val2)) tot--; #else Perl_die(aTHX_ PL_no_func, "fchown"); @@ -1965,9 +1988,9 @@ nothing in the core. if ((gv = MAYBE_DEREF_GV(*mark))) { if (GvIO(gv) && IoIFP(GvIOp(gv))) { #ifdef HAS_FUTIMES + int fd = PerlIO_fileno(IoIFP(GvIOn(gv))); APPLY_TAINT_PROPER(); - if (futimes(PerlIO_fileno(IoIFP(GvIOn(gv))), - (struct timeval *) utbufp)) + if (fd >= 0 && futimes(fd, (struct timeval *) utbufp)) tot--; #else Perl_die(aTHX_ PL_no_func, "futimes"); @@ -2082,15 +2105,17 @@ S_ingroup(pTHX_ Gid_t testgid, bool effective) bool rc = FALSE; anum = getgroups(0, gary); - Newx(gary, anum, Groups_t); - anum = getgroups(anum, gary); - while (--anum >= 0) - if (gary[anum] == testgid) { - rc = TRUE; - break; - } + if (anum > 0) { + Newx(gary, anum, Groups_t); + anum = getgroups(anum, gary); + while (--anum >= 0) + if (gary[anum] == testgid) { + rc = TRUE; + break; + } - Safefree(gary); + Safefree(gary); + } return rc; } #else diff --git a/ext/PerlIO-mmap/mmap.xs b/ext/PerlIO-mmap/mmap.xs index 4c96da8..c96e4ff 100644 --- a/ext/PerlIO-mmap/mmap.xs +++ b/ext/PerlIO-mmap/mmap.xs @@ -40,8 +40,11 @@ PerlIOMmap_map(pTHX_ PerlIO *f) abort(); if (flags & PERLIO_F_CANREAD) { PerlIOBuf * const b = PerlIOSelf(f, PerlIOBuf); - const int fd = PerlIO_fileno(f); Stat_t st; + const int fd = PerlIO_fileno(f); + if (fd < 0) { + return -1; + } code = Fstat(fd, &st); if (code == 0 && S_ISREG(st.st_mode)) { SSize_t len = st.st_size - b->posn; diff --git a/mg.c b/mg.c index 76912bd..6414349 100644 --- a/mg.c +++ b/mg.c @@ -1120,12 +1120,15 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg) #ifdef HAS_GETGROUPS { Groups_t *gary = NULL; - I32 i, num_groups = getgroups(0, gary); - Newx(gary, num_groups, Groups_t); - num_groups = getgroups(num_groups, gary); - for (i = 0; i < num_groups; i++) - Perl_sv_catpvf(aTHX_ sv, " %"IVdf, (IV)gary[i]); - Safefree(gary); + I32 i; + I32 num_groups = getgroups(0, gary); + if (num_groups > 0) { + Newx(gary, num_groups, Groups_t); + num_groups = getgroups(num_groups, gary); + for (i = 0; i < num_groups; i++) + Perl_sv_catpvf(aTHX_ sv, " %"IVdf, (IV)gary[i]); + Safefree(gary); + } } (void)SvIOK_on(sv); /* what a wonderful hack! */ #endif diff --git a/perl.c b/perl.c index 27d0d9e..925da89 100644 --- a/perl.c +++ b/perl.c @@ -3691,6 +3691,7 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch, bool *suidscript) PerlIO *rsfp = NULL; dVAR; Stat_t tmpstatbuf; + int fd; PERL_ARGS_ASSERT_OPEN_SCRIPT; @@ -3796,13 +3797,17 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch, bool *suidscript) Perl_croak(aTHX_ "Can't open perl script \"%s\": %s\n", CopFILE(PL_curcop), Strerror(errno)); } + fd = PerlIO_fileno(rsfp); #if defined(HAS_FCNTL) && defined(F_SETFD) - /* ensure close-on-exec */ - fcntl(PerlIO_fileno(rsfp), F_SETFD, 1); + if (fd >= 0) { + /* ensure close-on-exec */ + fcntl(fd, F_SETFD, 1); + } #endif - if (PerlLIO_fstat(PerlIO_fileno(rsfp), &tmpstatbuf) >= 0 - && S_ISDIR(tmpstatbuf.st_mode)) + if (fd < 0 || + (PerlLIO_fstat(fd, &tmpstatbuf) >= 0 + && S_ISDIR(tmpstatbuf.st_mode))) Perl_croak(aTHX_ "Can't open perl script \"%s\": %s\n", CopFILE(PL_curcop), Strerror(EISDIR)); @@ -3833,12 +3838,18 @@ S_validate_suid(pTHX_ PerlIO *rsfp) if (my_euid != my_uid || my_egid != my_gid) { /* (suidperl doesn't exist, in fact) */ dVAR; - - PerlLIO_fstat(PerlIO_fileno(rsfp),&PL_statbuf); /* may be either wrapped or real suid */ - if ((my_euid != my_uid && my_euid == PL_statbuf.st_uid && PL_statbuf.st_mode & S_ISUID) - || - (my_egid != my_gid && my_egid == PL_statbuf.st_gid && PL_statbuf.st_mode & S_ISGID) - ) + int fd = PerlIO_fileno(rsfp); + if (fd < 0) { + Perl_croak("Illegal suidscript"); + } else { + if (PerlLIO_fstat(fd, &PL_statbuf) < 0) { /* may be either wrapped or real suid */ + Perl_croak("Illegal suidscript"); + } + } + if ((my_euid != my_uid && my_euid == PL_statbuf.st_uid && PL_statbuf.st_mode & S_ISUID) + || + (my_egid != my_gid && my_egid == PL_statbuf.st_gid && PL_statbuf.st_mode & S_ISGID) + ) if (!PL_do_undump) Perl_croak(aTHX_ "YOU HAVEN'T DISABLED SET-ID SCRIPTS IN THE KERNEL YET!\n\ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n"); diff --git a/perlio.c b/perlio.c index 0ae0a43..83c8463 100644 --- a/perlio.c +++ b/perlio.c @@ -2922,6 +2922,10 @@ PerlIO_importFILE(FILE *stdio, const char *mode) PerlIO *f = NULL; if (stdio) { PerlIOStdio *s; + int fd0 = fileno(stdio); + if (fd0 < 0) { + return NULL; + } if (!mode || !*mode) { /* We need to probe to see how we can open the stream so start with read/write and then try write and read @@ -2930,8 +2934,12 @@ PerlIO_importFILE(FILE *stdio, const char *mode) Note that the errno value set by a failing fdopen varies between stdio implementations. */ - const int fd = PerlLIO_dup(fileno(stdio)); - FILE *f2 = PerlSIO_fdopen(fd, (mode = "r+")); + const int fd = PerlLIO_dup(fd0); + FILE *f2; + if (fd < 0) { + return f; + } + f2 = PerlSIO_fdopen(fd, (mode = "r+")); if (!f2) { f2 = PerlSIO_fdopen(fd, (mode = "w")); } @@ -3667,6 +3675,10 @@ PerlIO_exportFILE(PerlIO * f, const char *mode) FILE *stdio = NULL; if (PerlIOValid(f)) { char buf[8]; + int fd = PerlIO_fileno(f); + if (fd < 0) { + return NULL; + } PerlIO_flush(f); if (!mode || !*mode) { mode = PerlIO_modestr(f, buf); diff --git a/pod/perldiag.pod b/pod/perldiag.pod index 00700c5..b7c1942 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -2292,6 +2292,10 @@ The C<"+"> is valid only when followed by digits, indicating a capturing group. See L)>|perlre/(?PARNO) (?-PARNO) (?+PARNO) (?R) (?0)>. +=item Illegal suidscript + +(F) The script run under suidperl was somehow illegal. + =item Illegal switch in PERL5OPT: -%c (X) The PERL5OPT environment variable may only be used to set the diff --git a/pp_sys.c b/pp_sys.c index 9f97177..96a444f 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -1616,7 +1616,7 @@ PP(pp_sysread) char *buffer; STRLEN orig_size; SSize_t length; - SSize_t count; + SSize_t count = -1; SV *bufsv; STRLEN blen; int fp_utf8; @@ -1682,6 +1682,9 @@ PP(pp_sysread) if (PL_op->op_type == OP_RECV) { Sock_size_t bufsize; char namebuf[MAXPATHLEN]; + int fd = PerlIO_fileno(IoIFP(io)); + if (fd < 0) + RETPUSHUNDEF; #if (defined(VMS_DO_SOCKETS) && defined(DECCRTL_SOCKETS)) || defined(__QNXNTO__) bufsize = sizeof (struct sockaddr_in); #else @@ -1693,7 +1696,7 @@ PP(pp_sysread) #endif buffer = SvGROW(bufsv, (STRLEN)(length+1)); /* 'offset' means 'flags' here */ - count = PerlSock_recvfrom(PerlIO_fileno(IoIFP(io)), buffer, length, offset, + count = PerlSock_recvfrom(fd, buffer, length, offset, (struct sockaddr *)namebuf, &bufsize); if (count < 0) RETPUSHUNDEF; @@ -1771,8 +1774,10 @@ PP(pp_sysread) else #endif { - count = PerlLIO_read(PerlIO_fileno(IoIFP(io)), - buffer, length); + int fd = PerlIO_fileno(IoIFP(io)); + if (fd >= 0) { + count = PerlLIO_read(fd, buffer, length); + } } } else @@ -1848,7 +1853,7 @@ PP(pp_syswrite) dVAR; dSP; dMARK; dORIGMARK; dTARGET; SV *bufsv; const char *buffer; - SSize_t retval; + SSize_t retval = -1; STRLEN blen; STRLEN orig_blen_bytes; const int op_type = PL_op->op_type; @@ -1856,6 +1861,7 @@ PP(pp_syswrite) U8 *tmpbuf = NULL; GV *const gv = MUTABLE_GV(*++MARK); IO *const io = GvIO(gv); + int fd; if (op_type == OP_SYSWRITE && io) { const MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar); @@ -1915,17 +1921,19 @@ PP(pp_syswrite) } #ifdef HAS_SOCKET + fd = PerlIO_fileno(IoIFP(io)); + if (fd < 0) + goto say_undef; if (op_type == OP_SEND) { const int flags = SvIVx(*++MARK); if (SP > MARK) { STRLEN mlen; char * const sockbuf = SvPVx(*++MARK, mlen); - retval = PerlSock_sendto(PerlIO_fileno(IoIFP(io)), buffer, blen, + retval = PerlSock_sendto(fd, buffer, blen, flags, (struct sockaddr *)sockbuf, mlen); } else { - retval - = PerlSock_send(PerlIO_fileno(IoIFP(io)), buffer, blen, flags); + retval = PerlSock_send(fd, buffer, blen, flags); } } else @@ -2008,15 +2016,13 @@ PP(pp_syswrite) } #ifdef PERL_SOCK_SYSWRITE_IS_SEND if (IoTYPE(io) == IoTYPE_SOCKET) { - retval = PerlSock_send(PerlIO_fileno(IoIFP(io)), - buffer, length, 0); + retval = PerlSock_send(fd, buffer, length, 0); } else #endif { /* See the note at doio.c:do_print about filesize limits. --jhi */ - retval = PerlLIO_write(PerlIO_fileno(IoIFP(io)), - buffer, length); + retval = PerlLIO_write(fd, buffer, length); } } @@ -2224,13 +2230,16 @@ PP(pp_truncate) result = 0; } else { - PerlIO_flush(fp); + int fd = PerlIO_fileno(fp); + if (fd >= 0) { + PerlIO_flush(fp); #ifdef HAS_TRUNCATE - if (ftruncate(PerlIO_fileno(fp), len) < 0) + if (ftruncate(fd, len) < 0) #else - if (my_chsize(PerlIO_fileno(fp), len) < 0) + if (my_chsize(fd, len) < 0) #endif - result = 0; + result = 0; + } } } } @@ -2467,16 +2476,20 @@ PP(pp_bind) IO * const io = GvIOn(gv); STRLEN len; int op_type; + int fd; if (!IoIFP(io)) goto nuts; + fd = PerlIO_fileno(IoIFP(io)); + if (fd < 0) + goto nuts; addr = SvPV_const(addrsv, len); op_type = PL_op->op_type; TAINT_PROPER(PL_op_desc[op_type]); if ((op_type == OP_BIND - ? PerlSock_bind(PerlIO_fileno(IoIFP(io)), (struct sockaddr *)addr, len) - : PerlSock_connect(PerlIO_fileno(IoIFP(io)), (struct sockaddr *)addr, len)) + ? PerlSock_bind(fd, (struct sockaddr *)addr, len) + : PerlSock_connect(fd, (struct sockaddr *)addr, len)) >= 0) RETPUSHYES; else @@ -2608,6 +2621,8 @@ PP(pp_ssockopt) goto nuts; fd = PerlIO_fileno(IoIFP(io)); + if (fd < 0) + goto nuts; switch (optype) { case OP_GSOCKOPT: SvGROW(sv, 257); @@ -2683,6 +2698,8 @@ PP(pp_getpeername) SvCUR_set(sv, len); *SvEND(sv) ='\0'; fd = PerlIO_fileno(IoIFP(io)); + if (fd < 0) + goto nuts2; switch (optype) { case OP_GETSOCKNAME: if (PerlSock_getsockname(fd, (struct sockaddr *)SvPVX(sv), &len) < 0) @@ -2764,9 +2781,14 @@ PP(pp_stat) } if (io) { if (IoIFP(io)) { - PL_laststatval = - PerlLIO_fstat(PerlIO_fileno(IoIFP(io)), &PL_statcache); - havefp = TRUE; + int fd = PerlIO_fileno(IoIFP(io)); + if (fd < 0) { + PL_laststatval = -1; + } else { + PL_laststatval = + PerlLIO_fstat(fd, &PL_statcache); + havefp = TRUE; + } } else if (IoDIRP(io)) { PL_laststatval = PerlLIO_fstat(my_dirfd(IoDIRP(io)), &PL_statcache); @@ -3256,9 +3278,11 @@ PP(pp_fttty) if (GvIO(gv) && IoIFP(GvIOp(gv))) fd = PerlIO_fileno(IoIFP(GvIOp(gv))); else if (name && isDIGIT(*name)) - fd = atoi(name); + fd = atoi(name); else FT_RETURNUNDEF; + if (fd < 0) + FT_RETURNUNDEF; if (PerlLIO_isatty(fd)) FT_RETURNYES; FT_RETURNNO; @@ -3307,9 +3331,13 @@ PP(pp_fttext) PL_laststatval = -1; PL_laststype = OP_STAT; if (io && IoIFP(io)) { + int fd; if (! PerlIO_has_base(IoIFP(io))) DIE(aTHX_ "-T and -B not implemented on filehandles"); - PL_laststatval = PerlLIO_fstat(PerlIO_fileno(IoIFP(io)), &PL_statcache); + fd = PerlIO_fileno(IoIFP(io)); + if (fd < 0) + FT_RETURNUNDEF; + PL_laststatval = PerlLIO_fstat(fd, &PL_statcache); if (PL_laststatval < 0) FT_RETURNUNDEF; if (S_ISDIR(PL_statcache.st_mode)) { /* handle NFS glitch */ @@ -3339,6 +3367,7 @@ PP(pp_fttext) } } else { + int fd; sv_setpv(PL_statname, SvPV_nomg_const_nolen(sv)); really_filename: PL_statgv = NULL; @@ -3358,7 +3387,12 @@ PP(pp_fttext) FT_RETURNUNDEF; } PL_laststype = OP_STAT; - PL_laststatval = PerlLIO_fstat(PerlIO_fileno(fp), &PL_statcache); + fd = PerlIO_fileno(fp); + if (fd < 0) { + (void)PerlIO_close(fp); + FT_RETURNUNDEF; + } + PL_laststatval = PerlLIO_fstat(fd, &PL_statcache); if (PL_laststatval < 0) { (void)PerlIO_close(fp); FT_RETURNUNDEF; @@ -3475,19 +3509,19 @@ PP(pp_chdir) if (IoDIRP(io)) { PUSHi(fchdir(my_dirfd(IoDIRP(io))) >= 0); } else if (IoIFP(io)) { - PUSHi(fchdir(PerlIO_fileno(IoIFP(io))) >= 0); + int fd = PerlIO_fileno(IoIFP(io)); + if (fd < 0) { + goto nuts; + } + PUSHi(fchdir(fd) >= 0); } else { - report_evil_fh(gv); - SETERRNO(EBADF, RMS_IFI); - PUSHi(0); + goto nuts; } + } else { + goto nuts; } - else { - report_evil_fh(gv); - SETERRNO(EBADF,RMS_IFI); - PUSHi(0); - } + #else DIE(aTHX_ PL_no_func, "fchdir"); #endif @@ -3500,6 +3534,12 @@ PP(pp_chdir) hv_delete(GvHVn(PL_envgv),"DEFAULT",7,G_DISCARD); #endif RETURN; + + nuts: + report_evil_fh(gv); + SETERRNO(EBADF,RMS_IFI); + PUSHi(0); + RETURN; } PP(pp_chown) diff --git a/util.c b/util.c index 0a0ee40..17be9a5 100644 --- a/util.c +++ b/util.c @@ -1710,13 +1710,14 @@ void Perl_croak_no_mem(void) { dTHX; - int rc; - /* Can't use PerlIO to write as it allocates memory */ - rc = PerlLIO_write(PerlIO_fileno(Perl_error_log), - PL_no_mem, sizeof(PL_no_mem)-1); - /* silently ignore failures */ - PERL_UNUSED_VAR(rc); + int fd = PerlIO_fileno(Perl_error_log); + if (fd >= 0) { + /* Can't use PerlIO to write as it allocates memory */ + int rc = PerlLIO_write(fd, PL_no_mem, sizeof(PL_no_mem)-1); + /* silently ignore failures */ + PERL_UNUSED_VAR(rc); + } my_exit(1); } -- 1.9.2 ```

[p5pRT]

From @jhi

Attached.

[p5pRT]

From @jhi

0001-Fix-for-Coverity-perl5-CIDs-29813-29814-29819-29821..patch

```diff From 9b4739a6f95d91657d94e249f08d03cff6cb1a1d Mon Sep 17 00:00:00 2001 From: Jarkko Hietaniemi Date: Thu, 24 Apr 2014 12:10:44 -0400 Subject: [PATCH] Fix for Coverity perl5 CIDs 29813, 29814, 29819,29821..29823, 28930: Unchecked return value from library (CHECKED_RETURN) check_return: Calling fcntl(...) without checking return value. and CID 29820: Unchecked return value from library (CHECKED_RETURN) check_return: Calling fgetc(...) without checking return value. The fcntl() calls are doing FD_SETFD (for fds larger than PL_maxsysfd) and FD_CLOEXEC. It is debatable whether these failing are serious enough offenses to return undef (or otherwise fail), but this patch makes it so, and no tests start failing. --- doio.c | 3 ++- perlio.c | 4 ++-- pp_sys.c | 21 ++++++++++++++------- util.c | 6 ++++-- 4 files changed, 22 insertions(+), 12 deletions(-) diff --git a/doio.c b/doio.c index e2bfda5..c4415cf 100644 --- a/doio.c +++ b/doio.c @@ -755,7 +755,8 @@ S_openn_cleanup(pTHX_ GV *gv, IO *io, PerlIO *fp, char *mode, const char *oname, #if defined(HAS_FCNTL) && defined(F_SETFD) if (fd >= 0) { dSAVE_ERRNO; - fcntl(fd,F_SETFD,fd > PL_maxsysfd); /* can change errno */ + if (fcntl(fd,F_SETFD,fd > PL_maxsysfd) < 0) /* can change errno */ + goto say_false; RESTORE_ERRNO; } #endif diff --git a/perlio.c b/perlio.c index 0ae0a43..375911f 100644 --- a/perlio.c +++ b/perlio.c @@ -3350,8 +3350,8 @@ PerlIOStdio_unread(pTHX_ PerlIO *f, const void *vbuf, Size_t count) } if ((STDCHAR*)PerlSIO_get_ptr(s) != --eptr || ((*eptr & 0xFF) != ch)) { /* Did not change pointer as expected */ - fgetc(s); /* get char back again */ - break; + if (fgetc(s) != EOF) /* get char back again */ + break; } /* It worked ! */ count--; diff --git a/pp_sys.c b/pp_sys.c index 9f97177..abfee72 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -715,8 +715,10 @@ PP(pp_pipe_op) goto badexit; } #if defined(HAS_FCNTL) && defined(F_SETFD) - fcntl(fd[0],F_SETFD,fd[0] > PL_maxsysfd); /* ensure close-on-exec */ - fcntl(fd[1],F_SETFD,fd[1] > PL_maxsysfd); /* ensure close-on-exec */ + /* ensure close-on-exec */ + if ((fcntl(fd[0], F_SETFD,fd[0] > PL_maxsysfd) < 0) || + (fcntl(fd[1], F_SETFD,fd[1] > PL_maxsysfd) < 0)) + goto badexit; #endif RETPUSHYES; @@ -2400,7 +2402,8 @@ PP(pp_socket) RETPUSHUNDEF; } #if defined(HAS_FCNTL) && defined(F_SETFD) - fcntl(fd, F_SETFD, fd > PL_maxsysfd); /* ensure close-on-exec */ + if (fcntl(fd, F_SETFD, fd > PL_maxsysfd) < 0) /* ensure close-on-exec */ + RETPUSHUNDEF; #endif RETPUSHYES; @@ -2445,8 +2448,10 @@ PP(pp_sockpair) RETPUSHUNDEF; } #if defined(HAS_FCNTL) && defined(F_SETFD) - fcntl(fd[0],F_SETFD,fd[0] > PL_maxsysfd); /* ensure close-on-exec */ - fcntl(fd[1],F_SETFD,fd[1] > PL_maxsysfd); /* ensure close-on-exec */ + /* ensure close-on-exec */ + if ((fcntl(fd[0],F_SETFD,fd[0] > PL_maxsysfd) < 0) || + (fcntl(fd[1],F_SETFD,fd[1] > PL_maxsysfd) < 0)) + RETPUSHUNDEF; #endif RETPUSHYES; @@ -2554,7 +2559,8 @@ PP(pp_accept) goto badexit; } #if defined(HAS_FCNTL) && defined(F_SETFD) - fcntl(fd, F_SETFD, fd > PL_maxsysfd); /* ensure close-on-exec */ + if (fcntl(fd, F_SETFD, fd > PL_maxsysfd) < 0) /* ensure close-on-exec */ + goto badexit; #endif #ifdef __SCO_VERSION__ @@ -4194,7 +4200,8 @@ PP(pp_system) if (did_pipes) { PerlLIO_close(pp[0]); #if defined(HAS_FCNTL) && defined(F_SETFD) - fcntl(pp[1], F_SETFD, FD_CLOEXEC); + if (fcntl(pp[1], F_SETFD, FD_CLOEXEC) < 0) + RETPUSHUNDEF; #endif } if (PL_op->op_flags & OPf_STACKED) { diff --git a/util.c b/util.c index 0a0ee40..b8524a8 100644 --- a/util.c +++ b/util.c @@ -2308,7 +2308,8 @@ Perl_my_popen_list(pTHX_ const char *mode, int n, SV **args) PerlLIO_close(pp[0]); #if defined(HAS_FCNTL) && defined(F_SETFD) /* Close error pipe automatically if exec works */ - fcntl(pp[1], F_SETFD, FD_CLOEXEC); + if (fcntl(pp[1], F_SETFD, FD_CLOEXEC) < 0) + return NULL; #endif } /* Now dup our end of _the_ pipe to right position */ @@ -2453,7 +2454,8 @@ Perl_my_popen(pTHX_ const char *cmd, const char *mode) if (did_pipes) { PerlLIO_close(pp[0]); #if defined(HAS_FCNTL) && defined(F_SETFD) - fcntl(pp[1], F_SETFD, FD_CLOEXEC); + if (fcntl(pp[1], F_SETFD, FD_CLOEXEC) < 0) + return NULL; #endif } if (p[THIS] != (*mode == 'r')) { -- 1.9.2 ```

[p5pRT]

From @tonycoz

On Sat Apr 26 12​:58​:05 2014\, jhi wrote​:

Dozens of too trusting fileno calls (and then using the returned fds for fstat etc.)\, plus two similar cases for getgroups().

Attached.

Fails to build with -Duseithreads due to missing aTHX_ in​:

  if (fd \< 0) {   Perl_croak("Illegal suidscript");   } else {   if (PerlLIO_fstat(fd\, &PL_statbuf) \< 0) { /* may be either wrapped or real suid */   Perl_croak("Illegal suidscript");   }   }

Some other issues\, the original code here for example (doio.c)​:

@​@​ -1775\,8 +1797\,9 @​@​ Perl_apply(pTHX_ I32 type\, SV **mark\, SV **sp)   if ((gv = MAYBE_DEREF_GV(*mark))) {   if (GvIO(gv) && IoIFP(GvIOp(gv))) { #ifdef HAS_FCHOWN + int fd = PerlIO_fileno(IoIFP(GvIOn(gv)));   APPLY_TAINT_PROPER(); - if (fchown(PerlIO_fileno(IoIFP(GvIOn(gv)))\, val\, val2)) + if (fd >= 0 && fchown(fd\, val\, val2))   tot--; #else   Perl_die(aTHX_ PL_no_func\, "fchown");

will sensibly set errno to EBADF when fchown() fails\, but the modified code doesn't.

Similarly for the others in Perl_apply()\, pp_sysread()\, pp_syswrite()\, pp_truncate()\, pp_getpeername()\, pp_stat()\, pp_fttty()\, pp_fttext() and possibly for PerlIO​::mmap.

Tony

[p5pRT]

The RT System itself - Status changed from 'new' to 'open'

[p5pRT]

From @tonycoz

On Sat Apr 26 13​:01​:39 2014\, jhi wrote​:

Attached.

--- a/doio.c +++ b/doio.c @​@​ -755\,7 +755\,8 @​@​ S_openn_cleanup(pTHX_ GV *gv\, IO *io\, PerlIO *fp\, char *mode\, const char *oname\, #if defined(HAS_FCNTL) && defined(F_SETFD)   if (fd >= 0) {   dSAVE_ERRNO; - fcntl(fd\,F_SETFD\,fd > PL_maxsysfd); /* can change errno */ + if (fcntl(fd\,F_SETFD\,fd > PL_maxsysfd) \< 0) /* can change errno */ + goto say_false;   RESTORE_ERRNO;   } #endif

Should this PerlIO_close() the handle before C\< goto say_false > ?

I suspect we should be using FD_CLOEXEC in a few other places\, but that's not made any worse by your patch.

Tony

[p5pRT]

The RT System itself - Status changed from 'new' to 'open'

[p5pRT]

From @jhi

On Sunday-201404-27\, 23​:48\, Tony Cook via RT wrote​:

On Sat Apr 26 13​:01​:39 2014\, jhi wrote​:

Attached.

--- a/doio.c +++ b/doio.c @​@​ -755\,7 +755\,8 @​@​ S_openn_cleanup(pTHX_ GV *gv\, IO *io\, PerlIO *fp\, char *mode\, const char *oname\, #if defined(HAS_FCNTL) && defined(F_SETFD) if (fd >= 0) { dSAVE_ERRNO; - fcntl(fd\,F_SETFD\,fd > PL_maxsysfd); /* can change errno */ + if (fcntl(fd\,F_SETFD\,fd > PL_maxsysfd) \< 0) /* can change errno */ + goto say_false; RESTORE_ERRNO; } #endif

Should this PerlIO_close() the handle before C\< goto say_false > ?

Refreshed patch attached. (Also now doing the RESTORE_ERRNO before that goto say_false.)

Regarding SAVE/RESTORE_ERRNO​: I am of two strongly conflicting minds...

(1) is that really worth the dance? we stomp all over it all over the place\, we rarely (if ever) do only once syscall/libcall whatever we do\, so the errno is mostly bogus anyway...

(2) we should be doing the dance in much more regimented way so that the errno would be more reliable.

And then there's of course my more blue-sky mind thinking that the return values from such things should be dual (or more) value\, so that it would be e.g. (pseudocode\, not really a hashref)

  { bool => undef\, I32 => ENOENT\, ... }

That is\, the reason for failure would be embedded in the return value. And we could obsolete $! altogether... though of course we could never deprecate it. Sigh.

I suspect we should be using FD_CLOEXEC in a few other places\, but that's not made any worse by your patch.

Yeah. The FD_CLOEXEC seems to be common thing to do whenever acquiring more fds\, it probably should be wrapped into a routine.

Tony

[p5pRT]

From @jhi

0001-Fix-for-Coverity-perl5-CIDs-29813-29814-29819-29821..patch

```diff From fa18b49cc3cc3cbc5006b12f43011227d99b8c74 Mon Sep 17 00:00:00 2001 From: Jarkko Hietaniemi Date: Thu, 24 Apr 2014 12:10:44 -0400 Subject: [PATCH] Fix for Coverity perl5 CIDs 29813, 29814, 29819,29821..29823, 28930: Unchecked return value from library (CHECKED_RETURN) check_return: Calling fcntl(...) without checking return value. and CID 29820: Unchecked return value from library (CHECKED_RETURN) check_return: Calling fgetc(...) without checking return value. The fcntl() calls are doing FD_SETFD (for fds larger than PL_maxsysfd) and FD_CLOEXEC. It is debatable whether these failing are serious enough offenses to return undef (or otherwise fail), but this patch makes it so, and no tests start failing. --- doio.c | 6 +++++- perlio.c | 4 ++-- pp_sys.c | 21 ++++++++++++++------- util.c | 6 ++++-- 4 files changed, 25 insertions(+), 12 deletions(-) diff --git a/doio.c b/doio.c index e2bfda5..2bcdbb9 100644 --- a/doio.c +++ b/doio.c @@ -755,8 +755,12 @@ S_openn_cleanup(pTHX_ GV *gv, IO *io, PerlIO *fp, char *mode, const char *oname, #if defined(HAS_FCNTL) && defined(F_SETFD) if (fd >= 0) { dSAVE_ERRNO; - fcntl(fd,F_SETFD,fd > PL_maxsysfd); /* can change errno */ + int rc = fcntl(fd,F_SETFD,fd > PL_maxsysfd); /* can change errno */ RESTORE_ERRNO; + if (rc < 0) { + PerlLIO_close(fd); + goto say_false; + } } #endif IoIFP(io) = fp; diff --git a/perlio.c b/perlio.c index 0ae0a43..375911f 100644 --- a/perlio.c +++ b/perlio.c @@ -3350,8 +3350,8 @@ PerlIOStdio_unread(pTHX_ PerlIO *f, const void *vbuf, Size_t count) } if ((STDCHAR*)PerlSIO_get_ptr(s) != --eptr || ((*eptr & 0xFF) != ch)) { /* Did not change pointer as expected */ - fgetc(s); /* get char back again */ - break; + if (fgetc(s) != EOF) /* get char back again */ + break; } /* It worked ! */ count--; diff --git a/pp_sys.c b/pp_sys.c index 9f97177..abfee72 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -715,8 +715,10 @@ PP(pp_pipe_op) goto badexit; } #if defined(HAS_FCNTL) && defined(F_SETFD) - fcntl(fd[0],F_SETFD,fd[0] > PL_maxsysfd); /* ensure close-on-exec */ - fcntl(fd[1],F_SETFD,fd[1] > PL_maxsysfd); /* ensure close-on-exec */ + /* ensure close-on-exec */ + if ((fcntl(fd[0], F_SETFD,fd[0] > PL_maxsysfd) < 0) || + (fcntl(fd[1], F_SETFD,fd[1] > PL_maxsysfd) < 0)) + goto badexit; #endif RETPUSHYES; @@ -2400,7 +2402,8 @@ PP(pp_socket) RETPUSHUNDEF; } #if defined(HAS_FCNTL) && defined(F_SETFD) - fcntl(fd, F_SETFD, fd > PL_maxsysfd); /* ensure close-on-exec */ + if (fcntl(fd, F_SETFD, fd > PL_maxsysfd) < 0) /* ensure close-on-exec */ + RETPUSHUNDEF; #endif RETPUSHYES; @@ -2445,8 +2448,10 @@ PP(pp_sockpair) RETPUSHUNDEF; } #if defined(HAS_FCNTL) && defined(F_SETFD) - fcntl(fd[0],F_SETFD,fd[0] > PL_maxsysfd); /* ensure close-on-exec */ - fcntl(fd[1],F_SETFD,fd[1] > PL_maxsysfd); /* ensure close-on-exec */ + /* ensure close-on-exec */ + if ((fcntl(fd[0],F_SETFD,fd[0] > PL_maxsysfd) < 0) || + (fcntl(fd[1],F_SETFD,fd[1] > PL_maxsysfd) < 0)) + RETPUSHUNDEF; #endif RETPUSHYES; @@ -2554,7 +2559,8 @@ PP(pp_accept) goto badexit; } #if defined(HAS_FCNTL) && defined(F_SETFD) - fcntl(fd, F_SETFD, fd > PL_maxsysfd); /* ensure close-on-exec */ + if (fcntl(fd, F_SETFD, fd > PL_maxsysfd) < 0) /* ensure close-on-exec */ + goto badexit; #endif #ifdef __SCO_VERSION__ @@ -4194,7 +4200,8 @@ PP(pp_system) if (did_pipes) { PerlLIO_close(pp[0]); #if defined(HAS_FCNTL) && defined(F_SETFD) - fcntl(pp[1], F_SETFD, FD_CLOEXEC); + if (fcntl(pp[1], F_SETFD, FD_CLOEXEC) < 0) + RETPUSHUNDEF; #endif } if (PL_op->op_flags & OPf_STACKED) { diff --git a/util.c b/util.c index 0a0ee40..b8524a8 100644 --- a/util.c +++ b/util.c @@ -2308,7 +2308,8 @@ Perl_my_popen_list(pTHX_ const char *mode, int n, SV **args) PerlLIO_close(pp[0]); #if defined(HAS_FCNTL) && defined(F_SETFD) /* Close error pipe automatically if exec works */ - fcntl(pp[1], F_SETFD, FD_CLOEXEC); + if (fcntl(pp[1], F_SETFD, FD_CLOEXEC) < 0) + return NULL; #endif } /* Now dup our end of _the_ pipe to right position */ @@ -2453,7 +2454,8 @@ Perl_my_popen(pTHX_ const char *cmd, const char *mode) if (did_pipes) { PerlLIO_close(pp[0]); #if defined(HAS_FCNTL) && defined(F_SETFD) - fcntl(pp[1], F_SETFD, FD_CLOEXEC); + if (fcntl(pp[1], F_SETFD, FD_CLOEXEC) < 0) + return NULL; #endif } if (p[THIS] != (*mode == 'r')) { -- 1.9.2 ```

[p5pRT]

From @jhi

will sensibly set errno to EBADF when fchown() fails\, but the modified code doesn't.

Similarly for the others in Perl_apply()\, pp_sysread()\, pp_syswrite()\, pp_truncate()\, pp_getpeername()\, pp_stat()\, pp_fttty()\, pp_fttext() and possibly for PerlIO​::mmap.

Yeah. Amended the patch to set EBADF when applicable.

Also now getting failures from tests\, will see what's up with them. Better hold off on this until the dust settles.

Tony

[p5pRT]

From @jhi

will sensibly set errno to EBADF when fchown() fails\, but the modified code doesn't.

I now explictly set errno to EBADF if fd is zero (if necessary\, some places have their own "failure goto" that sets errno)\, and return -1/undef/failure goto\, and do not even attempt the fchown() etc. That seemed saner than letting e.g. fchown() on a bad fd first happen and then setting errno to EBADF if the fd was bad.

Also now getting failures from tests\, will see what's up with them.

One stray "goto failure;" too many broke PerlIO​::scalar. Now passing all tests. Refreshed patch attached.

Better hold off on this until the dust settles.

[p5pRT]

From @jhi

0001-Fix-for-Coverity-perl5-CIDs-28990.29003-29005.29011-.patch

```diff From 5c22c14b9f4e61ae885182da2e0a12420849d3a6 Mon Sep 17 00:00:00 2001 From: Jarkko Hietaniemi Date: Wed, 23 Apr 2014 17:43:15 -0400 Subject: [PATCH] Fix for Coverity perl5 CIDs 28990..29003,29005..29011,29013: Argument cannot be negative (NEGATIVE_RETURNS) fd is passed to a parameter that cannot be negative. and CIDs 29004, 29012: Argument cannot be negative (NEGATIVE_RETURNS) num_groups is passed to a parameter that cannot be negative and because of CIDs 29005 and 29006 also CID 28924. In the first set of issues a fd is retrieved from PerlIO_fileno, and that is then used in places like fstat(), fchown(), dup(), etc., without checking whether the fd is valid (>=0). In the second set of issues a potentially negative number is potentially passed to getgroups(). The CIDs 29005 and 29006 were a bit messy: fixing them needed also resolving CID 28924 where the return value of fstat() was ignored, and for completeness adding two croak calls (with perldiag updates): a bit of a waste since it's suidperl code. --- dist/IO/IO.xs | 12 +++-- doio.c | 94 +++++++++++++++++++++++------------ ext/PerlIO-mmap/mmap.xs | 6 ++- mg.c | 15 +++--- perl.c | 31 ++++++++---- perlio.c | 16 +++++- pod/perldiag.pod | 4 ++ pp_sys.c | 128 ++++++++++++++++++++++++++++++++++-------------- util.c | 15 +++--- 9 files changed, 226 insertions(+), 95 deletions(-) diff --git a/dist/IO/IO.xs b/dist/IO/IO.xs index 9056cb6..d7fe0a0 100644 --- a/dist/IO/IO.xs +++ b/dist/IO/IO.xs @@ -524,9 +524,15 @@ fsync(arg) handle = IoOFP(sv_2io(arg)); if (!handle) handle = IoIFP(sv_2io(arg)); - if(handle) - RETVAL = fsync(PerlIO_fileno(handle)); - else { + if (handle) { + int fd = PerlIO_fileno(handle); + if (fd >= 0) { + RETVAL = fsync(fd); + } else { + RETVAL = -1; + errno = EINVAL; + } + } else { RETVAL = -1; errno = EINVAL; } diff --git a/doio.c b/doio.c index e2bfda5..7dd4f79 100644 --- a/doio.c +++ b/doio.c @@ -646,9 +646,9 @@ S_openn_cleanup(pTHX_ GV *gv, IO *io, PerlIO *fp, char *mode, const char *oname, } fd = PerlIO_fileno(fp); - /* If there is no fd (e.g. PerlIO::scalar) assume it isn't a - * socket - this covers PerlIO::scalar - otherwise unless we "know" the - * type probe for socket-ness. + /* Do NOT do: "if (fd < 0) goto say_false;" here. If there is no + * fd assume it isn't a socket - this covers PerlIO::scalar - + * otherwise unless we "know" the type probe for socket-ness. */ if (IoTYPE(io) && IoTYPE(io) != IoTYPE_PIPE && IoTYPE(io) != IoTYPE_STD && fd >= 0) { if (PerlLIO_fstat(fd,&PL_statbuf) < 0) { @@ -732,13 +732,23 @@ S_openn_cleanup(pTHX_ GV *gv, IO *io, PerlIO *fp, char *mode, const char *oname, if (was_fdopen) { /* need to close fp without closing underlying fd */ int ofd = PerlIO_fileno(fp); - int dupfd = PerlLIO_dup(ofd); + int dupfd = ofd >= 0 ? PerlLIO_dup(ofd) : -1; #if defined(HAS_FCNTL) && defined(F_SETFD) /* Assume if we have F_SETFD we have F_GETFD */ - int coe = fcntl(ofd,F_GETFD); + int coe = ofd >= 0 ? fcntl(ofd, F_GETFD) : -1; + if (coe < 0) { + if (dupfd >= 0) + PerlLIO_close(dupfd); + goto say_false; + } #endif + if (ofd < 0 || dupfd < 0) { + if (dupfd >= 0) + PerlLIO_close(dupfd); + goto say_false; + } PerlIO_close(fp); - PerlLIO_dup2(dupfd,ofd); + PerlLIO_dup2(dupfd, ofd); #if defined(HAS_FCNTL) && defined(F_SETFD) /* The dup trick has lost close-on-exec on ofd */ fcntl(ofd,F_SETFD, coe); @@ -956,23 +966,25 @@ Perl_nextargv(pTHX_ GV *gv) } setdefout(PL_argvoutgv); PL_lastfd = PerlIO_fileno(IoIFP(GvIOp(PL_argvoutgv))); - (void)PerlLIO_fstat(PL_lastfd,&PL_statbuf); + if (PL_lastfd >= 0) { + (void)PerlLIO_fstat(PL_lastfd,&PL_statbuf); #ifdef HAS_FCHMOD - (void)fchmod(PL_lastfd,PL_filemode); + (void)fchmod(PL_lastfd,PL_filemode); #else - (void)PerlLIO_chmod(PL_oldname,PL_filemode); + (void)PerlLIO_chmod(PL_oldname,PL_filemode); #endif - if (fileuid != PL_statbuf.st_uid || filegid != PL_statbuf.st_gid) { - int rc = 0; + if (fileuid != PL_statbuf.st_uid || filegid != PL_statbuf.st_gid) { + int rc = 0; #ifdef HAS_FCHOWN - rc = fchown(PL_lastfd,fileuid,filegid); + rc = fchown(PL_lastfd,fileuid,filegid); #else #ifdef HAS_CHOWN - rc = PerlLIO_chown(PL_oldname,fileuid,filegid); + rc = PerlLIO_chown(PL_oldname,fileuid,filegid); #endif #endif - /* XXX silently ignore failures */ - PERL_UNUSED_VAR(rc); + /* XXX silently ignore failures */ + PERL_UNUSED_VAR(rc); + } } return IoIFP(GvIOp(gv)); } @@ -1169,8 +1181,12 @@ Perl_do_sysseek(pTHX_ GV *gv, Off_t pos, int whence) PERL_ARGS_ASSERT_DO_SYSSEEK; - if (io && (fp = IoIFP(io))) - return PerlLIO_lseek(PerlIO_fileno(fp), pos, whence); + if (io && (fp = IoIFP(io))) { + int fd = PerlIO_fileno(fp); + if (fd >= 0) { + return PerlLIO_lseek(fd, pos, whence); + } + } report_evil_fh(gv); SETERRNO(EBADF,RMS_IFI); return (Off_t)-1; @@ -1376,7 +1392,10 @@ Perl_my_stat_flags(pTHX_ const U32 flags) sv_setpvs(PL_statname, ""); if(io) { if (IoIFP(io)) { - return (PL_laststatval = PerlLIO_fstat(PerlIO_fileno(IoIFP(io)), &PL_statcache)); + int fd = PerlIO_fileno(IoIFP(io)); + if (fd >= 0) { + return (PL_laststatval = PerlLIO_fstat(fd, &PL_statcache)); + } } else if (IoDIRP(io)) { return (PL_laststatval = PerlLIO_fstat(my_dirfd(IoDIRP(io)), &PL_statcache)); } @@ -1739,9 +1758,13 @@ Perl_apply(pTHX_ I32 type, SV **mark, SV **sp) if ((gv = MAYBE_DEREF_GV(*mark))) { if (GvIO(gv) && IoIFP(GvIOp(gv))) { #ifdef HAS_FCHMOD + int fd = PerlIO_fileno(IoIFP(GvIOn(gv))); APPLY_TAINT_PROPER(); - if (fchmod(PerlIO_fileno(IoIFP(GvIOn(gv))), val)) - tot--; + if (fd < 0) { + SETERRNO(EBADF,RMS_IFI); + tot--; + } else if (fchmod(fd, val)) + tot--; #else Perl_die(aTHX_ PL_no_func, "fchmod"); #endif @@ -1775,8 +1798,12 @@ Perl_apply(pTHX_ I32 type, SV **mark, SV **sp) if ((gv = MAYBE_DEREF_GV(*mark))) { if (GvIO(gv) && IoIFP(GvIOp(gv))) { #ifdef HAS_FCHOWN + int fd = PerlIO_fileno(IoIFP(GvIOn(gv))); APPLY_TAINT_PROPER(); - if (fchown(PerlIO_fileno(IoIFP(GvIOn(gv))), val, val2)) + if (fd < 0) { + SETERRNO(EBADF,RMS_IFI); + tot--; + } else if (fchown(fd, val, val2)) tot--; #else Perl_die(aTHX_ PL_no_func, "fchown"); @@ -1965,9 +1992,12 @@ nothing in the core. if ((gv = MAYBE_DEREF_GV(*mark))) { if (GvIO(gv) && IoIFP(GvIOp(gv))) { #ifdef HAS_FUTIMES + int fd = PerlIO_fileno(IoIFP(GvIOn(gv))); APPLY_TAINT_PROPER(); - if (futimes(PerlIO_fileno(IoIFP(GvIOn(gv))), - (struct timeval *) utbufp)) + if (fd < 0) { + SETERRNO(EBADF,RMS_IFI); + tot--; + } else if (futimes(fd, (struct timeval *) utbufp)) tot--; #else Perl_die(aTHX_ PL_no_func, "futimes"); @@ -2082,15 +2112,17 @@ S_ingroup(pTHX_ Gid_t testgid, bool effective) bool rc = FALSE; anum = getgroups(0, gary); - Newx(gary, anum, Groups_t); - anum = getgroups(anum, gary); - while (--anum >= 0) - if (gary[anum] == testgid) { - rc = TRUE; - break; - } + if (anum > 0) { + Newx(gary, anum, Groups_t); + anum = getgroups(anum, gary); + while (--anum >= 0) + if (gary[anum] == testgid) { + rc = TRUE; + break; + } - Safefree(gary); + Safefree(gary); + } return rc; } #else diff --git a/ext/PerlIO-mmap/mmap.xs b/ext/PerlIO-mmap/mmap.xs index 4c96da8..6632544 100644 --- a/ext/PerlIO-mmap/mmap.xs +++ b/ext/PerlIO-mmap/mmap.xs @@ -40,8 +40,12 @@ PerlIOMmap_map(pTHX_ PerlIO *f) abort(); if (flags & PERLIO_F_CANREAD) { PerlIOBuf * const b = PerlIOSelf(f, PerlIOBuf); - const int fd = PerlIO_fileno(f); Stat_t st; + const int fd = PerlIO_fileno(f); + if (fd < 0) { + SETERRNO(EBADF,RMS_IFI); + return -1; + } code = Fstat(fd, &st); if (code == 0 && S_ISREG(st.st_mode)) { SSize_t len = st.st_size - b->posn; diff --git a/mg.c b/mg.c index 76912bd..6414349 100644 --- a/mg.c +++ b/mg.c @@ -1120,12 +1120,15 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg) #ifdef HAS_GETGROUPS { Groups_t *gary = NULL; - I32 i, num_groups = getgroups(0, gary); - Newx(gary, num_groups, Groups_t); - num_groups = getgroups(num_groups, gary); - for (i = 0; i < num_groups; i++) - Perl_sv_catpvf(aTHX_ sv, " %"IVdf, (IV)gary[i]); - Safefree(gary); + I32 i; + I32 num_groups = getgroups(0, gary); + if (num_groups > 0) { + Newx(gary, num_groups, Groups_t); + num_groups = getgroups(num_groups, gary); + for (i = 0; i < num_groups; i++) + Perl_sv_catpvf(aTHX_ sv, " %"IVdf, (IV)gary[i]); + Safefree(gary); + } } (void)SvIOK_on(sv); /* what a wonderful hack! */ #endif diff --git a/perl.c b/perl.c index 27d0d9e..4dd4821 100644 --- a/perl.c +++ b/perl.c @@ -3691,6 +3691,7 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch, bool *suidscript) PerlIO *rsfp = NULL; dVAR; Stat_t tmpstatbuf; + int fd; PERL_ARGS_ASSERT_OPEN_SCRIPT; @@ -3796,13 +3797,17 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch, bool *suidscript) Perl_croak(aTHX_ "Can't open perl script \"%s\": %s\n", CopFILE(PL_curcop), Strerror(errno)); } + fd = PerlIO_fileno(rsfp); #if defined(HAS_FCNTL) && defined(F_SETFD) - /* ensure close-on-exec */ - fcntl(PerlIO_fileno(rsfp), F_SETFD, 1); + if (fd >= 0) { + /* ensure close-on-exec */ + fcntl(fd, F_SETFD, 1); + } #endif - if (PerlLIO_fstat(PerlIO_fileno(rsfp), &tmpstatbuf) >= 0 - && S_ISDIR(tmpstatbuf.st_mode)) + if (fd < 0 || + (PerlLIO_fstat(fd, &tmpstatbuf) >= 0 + && S_ISDIR(tmpstatbuf.st_mode))) Perl_croak(aTHX_ "Can't open perl script \"%s\": %s\n", CopFILE(PL_curcop), Strerror(EISDIR)); @@ -3833,12 +3838,18 @@ S_validate_suid(pTHX_ PerlIO *rsfp) if (my_euid != my_uid || my_egid != my_gid) { /* (suidperl doesn't exist, in fact) */ dVAR; - - PerlLIO_fstat(PerlIO_fileno(rsfp),&PL_statbuf); /* may be either wrapped or real suid */ - if ((my_euid != my_uid && my_euid == PL_statbuf.st_uid && PL_statbuf.st_mode & S_ISUID) - || - (my_egid != my_gid && my_egid == PL_statbuf.st_gid && PL_statbuf.st_mode & S_ISGID) - ) + int fd = PerlIO_fileno(rsfp); + if (fd < 0) { + Perl_croak(aTHX_ "Illegal suidscript"); + } else { + if (PerlLIO_fstat(fd, &PL_statbuf) < 0) { /* may be either wrapped or real suid */ + Perl_croak(aTHX_ "Illegal suidscript"); + } + } + if ((my_euid != my_uid && my_euid == PL_statbuf.st_uid && PL_statbuf.st_mode & S_ISUID) + || + (my_egid != my_gid && my_egid == PL_statbuf.st_gid && PL_statbuf.st_mode & S_ISGID) + ) if (!PL_do_undump) Perl_croak(aTHX_ "YOU HAVEN'T DISABLED SET-ID SCRIPTS IN THE KERNEL YET!\n\ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n"); diff --git a/perlio.c b/perlio.c index 0ae0a43..83c8463 100644 --- a/perlio.c +++ b/perlio.c @@ -2922,6 +2922,10 @@ PerlIO_importFILE(FILE *stdio, const char *mode) PerlIO *f = NULL; if (stdio) { PerlIOStdio *s; + int fd0 = fileno(stdio); + if (fd0 < 0) { + return NULL; + } if (!mode || !*mode) { /* We need to probe to see how we can open the stream so start with read/write and then try write and read @@ -2930,8 +2934,12 @@ PerlIO_importFILE(FILE *stdio, const char *mode) Note that the errno value set by a failing fdopen varies between stdio implementations. */ - const int fd = PerlLIO_dup(fileno(stdio)); - FILE *f2 = PerlSIO_fdopen(fd, (mode = "r+")); + const int fd = PerlLIO_dup(fd0); + FILE *f2; + if (fd < 0) { + return f; + } + f2 = PerlSIO_fdopen(fd, (mode = "r+")); if (!f2) { f2 = PerlSIO_fdopen(fd, (mode = "w")); } @@ -3667,6 +3675,10 @@ PerlIO_exportFILE(PerlIO * f, const char *mode) FILE *stdio = NULL; if (PerlIOValid(f)) { char buf[8]; + int fd = PerlIO_fileno(f); + if (fd < 0) { + return NULL; + } PerlIO_flush(f); if (!mode || !*mode) { mode = PerlIO_modestr(f, buf); diff --git a/pod/perldiag.pod b/pod/perldiag.pod index 00700c5..b7c1942 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -2292,6 +2292,10 @@ The C<"+"> is valid only when followed by digits, indicating a capturing group. See L)>|perlre/(?PARNO) (?-PARNO) (?+PARNO) (?R) (?0)>. +=item Illegal suidscript + +(F) The script run under suidperl was somehow illegal. + =item Illegal switch in PERL5OPT: -%c (X) The PERL5OPT environment variable may only be used to set the diff --git a/pp_sys.c b/pp_sys.c index 9f97177..40464bb 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -1616,7 +1616,7 @@ PP(pp_sysread) char *buffer; STRLEN orig_size; SSize_t length; - SSize_t count; + SSize_t count = -1; SV *bufsv; STRLEN blen; int fp_utf8; @@ -1682,6 +1682,11 @@ PP(pp_sysread) if (PL_op->op_type == OP_RECV) { Sock_size_t bufsize; char namebuf[MAXPATHLEN]; + int fd = PerlIO_fileno(IoIFP(io)); + if (fd < 0) { + SETERRNO(EBADF,RMS_IFI); + RETPUSHUNDEF; + } #if (defined(VMS_DO_SOCKETS) && defined(DECCRTL_SOCKETS)) || defined(__QNXNTO__) bufsize = sizeof (struct sockaddr_in); #else @@ -1693,7 +1698,7 @@ PP(pp_sysread) #endif buffer = SvGROW(bufsv, (STRLEN)(length+1)); /* 'offset' means 'flags' here */ - count = PerlSock_recvfrom(PerlIO_fileno(IoIFP(io)), buffer, length, offset, + count = PerlSock_recvfrom(fd, buffer, length, offset, (struct sockaddr *)namebuf, &bufsize); if (count < 0) RETPUSHUNDEF; @@ -1771,8 +1776,11 @@ PP(pp_sysread) else #endif { - count = PerlLIO_read(PerlIO_fileno(IoIFP(io)), - buffer, length); + int fd = PerlIO_fileno(IoIFP(io)); + if (fd < 0) + SETERRNO(EBADF,RMS_IFI); + else + count = PerlLIO_read(fd, buffer, length); } } else @@ -1848,7 +1856,7 @@ PP(pp_syswrite) dVAR; dSP; dMARK; dORIGMARK; dTARGET; SV *bufsv; const char *buffer; - SSize_t retval; + SSize_t retval = -1; STRLEN blen; STRLEN orig_blen_bytes; const int op_type = PL_op->op_type; @@ -1856,6 +1864,7 @@ PP(pp_syswrite) U8 *tmpbuf = NULL; GV *const gv = MUTABLE_GV(*++MARK); IO *const io = GvIO(gv); + int fd; if (op_type == OP_SYSWRITE && io) { const MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar); @@ -1915,17 +1924,21 @@ PP(pp_syswrite) } #ifdef HAS_SOCKET + fd = PerlIO_fileno(IoIFP(io)); + if (fd < 0) { + SETERRNO(EBADF,SS_IVCHAN); + goto say_undef; + } if (op_type == OP_SEND) { const int flags = SvIVx(*++MARK); if (SP > MARK) { STRLEN mlen; char * const sockbuf = SvPVx(*++MARK, mlen); - retval = PerlSock_sendto(PerlIO_fileno(IoIFP(io)), buffer, blen, + retval = PerlSock_sendto(fd, buffer, blen, flags, (struct sockaddr *)sockbuf, mlen); } else { - retval - = PerlSock_send(PerlIO_fileno(IoIFP(io)), buffer, blen, flags); + retval = PerlSock_send(fd, buffer, blen, flags); } } else @@ -2008,15 +2021,13 @@ PP(pp_syswrite) } #ifdef PERL_SOCK_SYSWRITE_IS_SEND if (IoTYPE(io) == IoTYPE_SOCKET) { - retval = PerlSock_send(PerlIO_fileno(IoIFP(io)), - buffer, length, 0); + retval = PerlSock_send(fd, buffer, length, 0); } else #endif { /* See the note at doio.c:do_print about filesize limits. --jhi */ - retval = PerlLIO_write(PerlIO_fileno(IoIFP(io)), - buffer, length); + retval = PerlLIO_write(fd, buffer, length); } } @@ -2224,13 +2235,18 @@ PP(pp_truncate) result = 0; } else { - PerlIO_flush(fp); + int fd = PerlIO_fileno(fp); + if (fd < 0) + SETERRNO(EBADF,RMS_IFI); + else { + PerlIO_flush(fp); #ifdef HAS_TRUNCATE - if (ftruncate(PerlIO_fileno(fp), len) < 0) + if (ftruncate(fd, len) < 0) #else - if (my_chsize(PerlIO_fileno(fp), len) < 0) + if (my_chsize(fd, len) < 0) #endif - result = 0; + result = 0; + } } } } @@ -2248,9 +2264,10 @@ PP(pp_truncate) { const int tmpfd = PerlLIO_open(name, O_RDWR); - if (tmpfd < 0) + if (tmpfd < 0) { + SETERRNO(EBADF,RMS_IFI); result = 0; - else { + } else { if (my_chsize(tmpfd, len) < 0) result = 0; PerlLIO_close(tmpfd); @@ -2388,8 +2405,10 @@ PP(pp_socket) TAINT_PROPER("socket"); fd = PerlSock_socket(domain, type, protocol); - if (fd < 0) + if (fd < 0) { + SETERRNO(EBADF,RMS_IFI); RETPUSHUNDEF; + } IoIFP(io) = PerlIO_fdopen(fd, "r"SOCKET_OPEN_MODE); /* stdio gets confused about sockets */ IoOFP(io) = PerlIO_fdopen(fd, "w"SOCKET_OPEN_MODE); IoTYPE(io) = IoTYPE_SOCKET; @@ -2467,16 +2486,20 @@ PP(pp_bind) IO * const io = GvIOn(gv); STRLEN len; int op_type; + int fd; if (!IoIFP(io)) goto nuts; + fd = PerlIO_fileno(IoIFP(io)); + if (fd < 0) + goto nuts; addr = SvPV_const(addrsv, len); op_type = PL_op->op_type; TAINT_PROPER(PL_op_desc[op_type]); if ((op_type == OP_BIND - ? PerlSock_bind(PerlIO_fileno(IoIFP(io)), (struct sockaddr *)addr, len) - : PerlSock_connect(PerlIO_fileno(IoIFP(io)), (struct sockaddr *)addr, len)) + ? PerlSock_bind(fd, (struct sockaddr *)addr, len) + : PerlSock_connect(fd, (struct sockaddr *)addr, len)) >= 0) RETPUSHYES; else @@ -2608,6 +2631,8 @@ PP(pp_ssockopt) goto nuts; fd = PerlIO_fileno(IoIFP(io)); + if (fd < 0) + goto nuts; switch (optype) { case OP_GSOCKOPT: SvGROW(sv, 257); @@ -2683,6 +2708,8 @@ PP(pp_getpeername) SvCUR_set(sv, len); *SvEND(sv) ='\0'; fd = PerlIO_fileno(IoIFP(io)); + if (fd < 0) + goto nuts; switch (optype) { case OP_GETSOCKNAME: if (PerlSock_getsockname(fd, (struct sockaddr *)SvPVX(sv), &len) < 0) @@ -2764,9 +2791,14 @@ PP(pp_stat) } if (io) { if (IoIFP(io)) { - PL_laststatval = - PerlLIO_fstat(PerlIO_fileno(IoIFP(io)), &PL_statcache); - havefp = TRUE; + int fd = PerlIO_fileno(IoIFP(io)); + if (fd < 0) { + PL_laststatval = -1; + SETERRNO(EBADF,RMS_IFI); + } else { + PL_laststatval = PerlLIO_fstat(fd, &PL_statcache); + havefp = TRUE; + } } else if (IoDIRP(io)) { PL_laststatval = PerlLIO_fstat(my_dirfd(IoDIRP(io)), &PL_statcache); @@ -3256,9 +3288,13 @@ PP(pp_fttty) if (GvIO(gv) && IoIFP(GvIOp(gv))) fd = PerlIO_fileno(IoIFP(GvIOp(gv))); else if (name && isDIGIT(*name)) - fd = atoi(name); + fd = atoi(name); else FT_RETURNUNDEF; + if (fd < 0) { + SETERRNO(EBADF,RMS_IFI); + FT_RETURNUNDEF; + } if (PerlLIO_isatty(fd)) FT_RETURNYES; FT_RETURNNO; @@ -3307,9 +3343,15 @@ PP(pp_fttext) PL_laststatval = -1; PL_laststype = OP_STAT; if (io && IoIFP(io)) { + int fd; if (! PerlIO_has_base(IoIFP(io))) DIE(aTHX_ "-T and -B not implemented on filehandles"); - PL_laststatval = PerlLIO_fstat(PerlIO_fileno(IoIFP(io)), &PL_statcache); + fd = PerlIO_fileno(IoIFP(io)); + if (fd < 0) { + SETERRNO(EBADF,RMS_IFI); + FT_RETURNUNDEF; + } + PL_laststatval = PerlLIO_fstat(fd, &PL_statcache); if (PL_laststatval < 0) FT_RETURNUNDEF; if (S_ISDIR(PL_statcache.st_mode)) { /* handle NFS glitch */ @@ -3339,6 +3381,7 @@ PP(pp_fttext) } } else { + int fd; sv_setpv(PL_statname, SvPV_nomg_const_nolen(sv)); really_filename: PL_statgv = NULL; @@ -3358,9 +3401,16 @@ PP(pp_fttext) FT_RETURNUNDEF; } PL_laststype = OP_STAT; - PL_laststatval = PerlLIO_fstat(PerlIO_fileno(fp), &PL_statcache); + fd = PerlIO_fileno(fp); + if (fd < 0) { + (void)PerlIO_close(fp); + SETERRNO(EBADF,RMS_IFI); + FT_RETURNUNDEF; + } + PL_laststatval = PerlLIO_fstat(fd, &PL_statcache); if (PL_laststatval < 0) { (void)PerlIO_close(fp); + SETERRNO(EBADF,RMS_IFI); FT_RETURNUNDEF; } PerlIO_binmode(aTHX_ fp, '<', O_BINARY, NULL); @@ -3475,19 +3525,19 @@ PP(pp_chdir) if (IoDIRP(io)) { PUSHi(fchdir(my_dirfd(IoDIRP(io))) >= 0); } else if (IoIFP(io)) { - PUSHi(fchdir(PerlIO_fileno(IoIFP(io))) >= 0); + int fd = PerlIO_fileno(IoIFP(io)); + if (fd < 0) { + goto nuts; + } + PUSHi(fchdir(fd) >= 0); } else { - report_evil_fh(gv); - SETERRNO(EBADF, RMS_IFI); - PUSHi(0); + goto nuts; } + } else { + goto nuts; } - else { - report_evil_fh(gv); - SETERRNO(EBADF,RMS_IFI); - PUSHi(0); - } + #else DIE(aTHX_ PL_no_func, "fchdir"); #endif @@ -3500,6 +3550,12 @@ PP(pp_chdir) hv_delete(GvHVn(PL_envgv),"DEFAULT",7,G_DISCARD); #endif RETURN; + + nuts: + report_evil_fh(gv); + SETERRNO(EBADF,RMS_IFI); + PUSHi(0); + RETURN; } PP(pp_chown) diff --git a/util.c b/util.c index 0a0ee40..cfb2ecc 100644 --- a/util.c +++ b/util.c @@ -1710,13 +1710,16 @@ void Perl_croak_no_mem(void) { dTHX; - int rc; - /* Can't use PerlIO to write as it allocates memory */ - rc = PerlLIO_write(PerlIO_fileno(Perl_error_log), - PL_no_mem, sizeof(PL_no_mem)-1); - /* silently ignore failures */ - PERL_UNUSED_VAR(rc); + int fd = PerlIO_fileno(Perl_error_log); + if (fd < 0) + SETERRNO(EBADF,RMS_IFI); + else { + /* Can't use PerlIO to write as it allocates memory */ + int rc = PerlLIO_write(fd, PL_no_mem, sizeof(PL_no_mem)-1); + /* silently ignore failures */ + PERL_UNUSED_VAR(rc); + } my_exit(1); } -- 1.9.2 ```

[p5pRT]

From @bulk88

On Sat Apr 26 12​:58​:05 2014\, jhi wrote​:

Dozens of too trusting fileno calls (and then using the returned fds for fstat etc.)\, plus two similar cases for getgroups().

Attached.

Why this isn't a horrible perf degradation?

-- bulk88 ~ bulk88 at hotmail.com

[p5pRT]

From @bulk88

It seems this patch changes user visible behavior\, when previously true was returned\, is now undef. What are the pros and cons of this?

-- bulk88 ~ bulk88 at hotmail.com

[p5pRT]

From @jhi

On Wednesday-201404-30\, 1​:23\, bulk88 via RT wrote​:

Why this isn't a horrible perf degradation?

Huh? Before​:

fileno was called it returned -1 fstat (e.g.) was called on the -1 it failed because of the bogus fd (hopefully) checked for fstat failing and returned undef/false/whatever

After​: fileno was called it returned -1 we test against the -1 and if so return undef/false/whatever if we are still here\, we call fstat (e.g.) (hopefully) checked for fstat failing and returned undef/false/whatever

(Above showing only the failure paths\, not success paths.)

So it's an earlier return in case we are fed broken fds.

The only extra I see is one extra test against the returned fd. I don't think that's going to kill us.

[p5pRT]

From @jhi

On Wednesday-201404-30\, 1​:31\, bulk88 via RT wrote​:

It seems this patch changes user visible behavior\, when previously true was returned\, is now undef. What are the pros and cons of this?

Could you be more detailed? Where is the user visible behavior changed?   That was not the intention. If there's a change\, there should not be.

[p5pRT]

From @bulk88

On Wed Apr 30 03​:43​:33 2014\, jhi wrote​:

On Wednesday-201404-30\, 1​:31\, bulk88 via RT wrote​:

It seems this patch changes user visible behavior\, when previously true was returned\, is now undef. What are the pros and cons of this?

Could you be more detailed? Where is the user visible behavior changed? That was not the intention. If there's a change\, there should not be.

pp_socket currently

---

  if (!IoIFP(io) || !IoOFP(io)) {   if (IoIFP(io)) PerlIO_close(IoIFP(io));   if (IoOFP(io)) PerlIO_close(IoOFP(io));   if (!IoIFP(io) && !IoOFP(io)) PerlLIO_close(fd);   RETPUSHUNDEF;   } #if defined(HAS_FCNTL) && defined(F_SETFD)   fcntl(fd\, F_SETFD\, fd > PL_maxsysfd); /* ensure close-on-exec */ #endif

  RETPUSHYES; } #endif

---

Your patch is

---

@​@​ -2400\,7 +2402\,8 @​@​ PP(pp_socket)   RETPUSHUNDEF;   } #if defined(HAS_FCNTL) && defined(F_SETFD) - fcntl(fd\, F_SETFD\, fd > PL_maxsysfd); /* ensure close-on-exec */ + if (fcntl(fd\, F_SETFD\, fd > PL_maxsysfd) \< 0) /* ensure close-on-exec */ + RETPUSHUNDEF; #endif

---

Previously\, if fnctl executed\, regardless if it failed\, the functioned returned SV * YES/true. Now it might in some rare condition (IDK what it would be\, can someone give an example why PerlIO_fdopen would succeed but fnctl fail later?) return undef. On the otherhand\, P5P has failed to documented the return value of socket() since forever http​://perl5.git.perl.org/perl.git/blob/HEAD​:/pod/perlfunc.pod#l6569 (I'd file a bug but dont have time to go hunting for all other retval not doced in perlfunc cases ATM).

I picked pp_socket above since it was the easiest one to write up.

Also\, I'm not a *nix person\, why do we call F_SETFD with "fd > PL_maxsysfd" instead of a proper C constant\, optimization? will the constant always be 1?

-- bulk88 ~ bulk88 at hotmail.com

[p5pRT]

From @jhi

On Wednesday-201404-30\, 16​:06\, bulk88 via RT wrote​:

Previously\, if fnctl executed\, regardless if it failed\, the functioned returned SV * YES/true. Now it might in some rare condition (IDK what it would be\, can someone give an example why PerlIO_fdopen would succeed but fnctl fail later?) return undef. On the otherhand\, P5P has failed to documented the return value of socket() since foreverhttp​://perl5.git.perl.org/perl.git/blob/HEAD​:/pod/perlfunc.pod#l6569 (I'd file a bug but dont have time to go hunting for all other retval not doced in perlfunc cases ATM).

Ahh\, I see what you mean. Well\, this is kind of fuzzy area... if you look just before the fcntl dance\, if the fps were dubious (either we internally messed up something\, or if the app messed up its logic\, it e.g. closed the handle)\, we did (and do) return undef.

So I extended that "if the file handle is dubious" logic to include also the fcntl failure. (Here and elsewhere in the patch.)

Also\, I'm not a *nix person\, why do we call F_SETFD with "fd > PL_maxsysfd" instead of a proper C constant\, optimization? will the constant always be 1?

The PL_maxsysfd is initialized from #define MAXSYSFD which is by default always two (covering stdin\, stdout\, stderr). So whether we F_SETFD depends on whether the fd is beyond those. I think *officially* we should be using for the third argument the FD_CLOEXEC (which is one) for true (close-on-exec).

FWIW\, we should probably use the O_CLOEXEC flag where available\, when getting the fd in the first place. I think it's only defined for open()\, not for e.g. socket() etc. which limits its usefulness.

[p5pRT]

From @Leont

On Wed\, Apr 30\, 2014 at 10​:47 PM\, Jarkko Hietaniemi \jhi@&#8203;iki\.fi wrote​:

Also\, I'm not a *nix person\, why do we call F_SETFD with "fd > PL_maxsysfd" instead of a proper C constant\, optimization? will the constant always be 1?

The PL_maxsysfd is initialized from #define MAXSYSFD which is by default always two (covering stdin\, stdout\, stderr). So whether we F_SETFD depends on whether the fd is beyond those. I think *officially* we should be using for the third argument the FD_CLOEXEC (which is one) for true (close-on-exec).

Technically yes\, though I share the impression it's universally 1.

FWIW\, we should probably use the O_CLOEXEC flag where available\, when getting the fd in the first place. I think it's only defined for open()\, not for e.g. socket() etc. which limits its usefulness.

AFAIK that's a Linuxism (though BSDs seem to be implementing it too now)\, but it's definitely a good idea in multi-threaded situations (we have to keep the fcntl to un-cloexec if fd \< PL_maxsysfd though). And actually\, it is available for sockets by or-ing the socket type argument with SOCK_CLOEXEC.

Leon

[p5pRT]

From @jhi

On Wednesday-201404-30\, 17​:57\, Leon Timmermans wrote​:

AFAIK that's a Linuxism (though BSDs seem to be implementing it too now)

It's Official\, don't know exactly since when​:

http​://pubs.opengroup.org/onlinepubs/9699919799/functions/open.html

[p5pRT]

From @jhi

Yet again refreshed patch\, found two more spots with the same potentially negative fd use.

[p5pRT]

From @jhi

0001-Fix-for-Coverity-perl5-CIDs-28990.29003-29005.29011-.patch

```diff From f883ae96667b0521489a69a57381a6d22f554bb0 Mon Sep 17 00:00:00 2001 From: Jarkko Hietaniemi Date: Wed, 23 Apr 2014 17:43:15 -0400 Subject: [PATCH] Fix for Coverity perl5 CIDs 28990..29003,29005..29011,29013, 45354,45363,49926: Argument cannot be negative (NEGATIVE_RETURNS) fd is passed to a parameter that cannot be negative. and CIDs 29004, 29012: Argument cannot be negative (NEGATIVE_RETURNS) num_groups is passed to a parameter that cannot be negative and because of CIDs 29005 and 29006 also CID 28924. In the first set of issues a fd is retrieved from PerlIO_fileno, and that is then used in places like fstat(), fchown(), dup(), etc., without checking whether the fd is valid (>=0). In the second set of issues a potentially negative number is potentially passed to getgroups(). The CIDs 29005 and 29006 were a bit messy: fixing them needed also resolving CID 28924 where the return value of fstat() was ignored, and for completeness adding two croak calls (with perldiag updates): a bit of a waste since it's suidperl code. --- dist/IO/IO.xs | 12 +++-- dist/threads/threads.xs | 9 ++-- doio.c | 99 +++++++++++++++++++++++++------------ ext/PerlIO-mmap/mmap.xs | 6 ++- mg.c | 15 +++--- perl.c | 31 ++++++++---- perlio.c | 16 +++++- pod/perldiag.pod | 4 ++ pp_sys.c | 128 ++++++++++++++++++++++++++++++++++-------------- util.c | 15 +++--- 10 files changed, 235 insertions(+), 100 deletions(-) diff --git a/dist/IO/IO.xs b/dist/IO/IO.xs index 9056cb6..d7fe0a0 100644 --- a/dist/IO/IO.xs +++ b/dist/IO/IO.xs @@ -524,9 +524,15 @@ fsync(arg) handle = IoOFP(sv_2io(arg)); if (!handle) handle = IoIFP(sv_2io(arg)); - if(handle) - RETVAL = fsync(PerlIO_fileno(handle)); - else { + if (handle) { + int fd = PerlIO_fileno(handle); + if (fd >= 0) { + RETVAL = fsync(fd); + } else { + RETVAL = -1; + errno = EINVAL; + } + } else { RETVAL = -1; errno = EINVAL; } diff --git a/dist/threads/threads.xs b/dist/threads/threads.xs index 8537165..cfcf98b 100644 --- a/dist/threads/threads.xs +++ b/dist/threads/threads.xs @@ -713,11 +713,12 @@ S_ithread_create( } PERL_SET_CONTEXT(aTHX); if (!thread) { - int rc; MUTEX_UNLOCK(&MY_POOL.create_destruct_mutex); - rc = PerlLIO_write(PerlIO_fileno(Perl_error_log), - PL_no_mem, strlen(PL_no_mem)); - PERL_UNUSED_VAR(rc); + int fd = PerlIO_fileno(Perl_error_log); + if (fd < 0) { + int rc = PerlLIO_write(fd, PL_no_mem, strlen(PL_no_mem)); + PERL_UNUSED_VAR(rc); + } my_exit(1); } Zero(thread, 1, ithread); diff --git a/doio.c b/doio.c index e2bfda5..5268be3 100644 --- a/doio.c +++ b/doio.c @@ -646,9 +646,9 @@ S_openn_cleanup(pTHX_ GV *gv, IO *io, PerlIO *fp, char *mode, const char *oname, } fd = PerlIO_fileno(fp); - /* If there is no fd (e.g. PerlIO::scalar) assume it isn't a - * socket - this covers PerlIO::scalar - otherwise unless we "know" the - * type probe for socket-ness. + /* Do NOT do: "if (fd < 0) goto say_false;" here. If there is no + * fd assume it isn't a socket - this covers PerlIO::scalar - + * otherwise unless we "know" the type probe for socket-ness. */ if (IoTYPE(io) && IoTYPE(io) != IoTYPE_PIPE && IoTYPE(io) != IoTYPE_STD && fd >= 0) { if (PerlLIO_fstat(fd,&PL_statbuf) < 0) { @@ -696,7 +696,10 @@ S_openn_cleanup(pTHX_ GV *gv, IO *io, PerlIO *fp, char *mode, const char *oname, is assigned to (say) STDOUT - for now let dup2() fail and provide the error */ - if (PerlLIO_dup2(fd, savefd) < 0) { + if (fd < 0) { + SETERRNO(EBADF,RMS_IFI); + goto say_false; + } else if (PerlLIO_dup2(fd, savefd) < 0) { (void)PerlIO_close(fp); goto say_false; } @@ -732,13 +735,23 @@ S_openn_cleanup(pTHX_ GV *gv, IO *io, PerlIO *fp, char *mode, const char *oname, if (was_fdopen) { /* need to close fp without closing underlying fd */ int ofd = PerlIO_fileno(fp); - int dupfd = PerlLIO_dup(ofd); + int dupfd = ofd >= 0 ? PerlLIO_dup(ofd) : -1; #if defined(HAS_FCNTL) && defined(F_SETFD) /* Assume if we have F_SETFD we have F_GETFD */ - int coe = fcntl(ofd,F_GETFD); + int coe = ofd >= 0 ? fcntl(ofd, F_GETFD) : -1; + if (coe < 0) { + if (dupfd >= 0) + PerlLIO_close(dupfd); + goto say_false; + } #endif + if (ofd < 0 || dupfd < 0) { + if (dupfd >= 0) + PerlLIO_close(dupfd); + goto say_false; + } PerlIO_close(fp); - PerlLIO_dup2(dupfd,ofd); + PerlLIO_dup2(dupfd, ofd); #if defined(HAS_FCNTL) && defined(F_SETFD) /* The dup trick has lost close-on-exec on ofd */ fcntl(ofd,F_SETFD, coe); @@ -956,23 +969,25 @@ Perl_nextargv(pTHX_ GV *gv) } setdefout(PL_argvoutgv); PL_lastfd = PerlIO_fileno(IoIFP(GvIOp(PL_argvoutgv))); - (void)PerlLIO_fstat(PL_lastfd,&PL_statbuf); + if (PL_lastfd >= 0) { + (void)PerlLIO_fstat(PL_lastfd,&PL_statbuf); #ifdef HAS_FCHMOD - (void)fchmod(PL_lastfd,PL_filemode); + (void)fchmod(PL_lastfd,PL_filemode); #else - (void)PerlLIO_chmod(PL_oldname,PL_filemode); + (void)PerlLIO_chmod(PL_oldname,PL_filemode); #endif - if (fileuid != PL_statbuf.st_uid || filegid != PL_statbuf.st_gid) { - int rc = 0; + if (fileuid != PL_statbuf.st_uid || filegid != PL_statbuf.st_gid) { + int rc = 0; #ifdef HAS_FCHOWN - rc = fchown(PL_lastfd,fileuid,filegid); + rc = fchown(PL_lastfd,fileuid,filegid); #else #ifdef HAS_CHOWN - rc = PerlLIO_chown(PL_oldname,fileuid,filegid); + rc = PerlLIO_chown(PL_oldname,fileuid,filegid); #endif #endif - /* XXX silently ignore failures */ - PERL_UNUSED_VAR(rc); + /* XXX silently ignore failures */ + PERL_UNUSED_VAR(rc); + } } return IoIFP(GvIOp(gv)); } @@ -1169,8 +1184,12 @@ Perl_do_sysseek(pTHX_ GV *gv, Off_t pos, int whence) PERL_ARGS_ASSERT_DO_SYSSEEK; - if (io && (fp = IoIFP(io))) - return PerlLIO_lseek(PerlIO_fileno(fp), pos, whence); + if (io && (fp = IoIFP(io))) { + int fd = PerlIO_fileno(fp); + if (fd >= 0) { + return PerlLIO_lseek(fd, pos, whence); + } + } report_evil_fh(gv); SETERRNO(EBADF,RMS_IFI); return (Off_t)-1; @@ -1376,7 +1395,10 @@ Perl_my_stat_flags(pTHX_ const U32 flags) sv_setpvs(PL_statname, ""); if(io) { if (IoIFP(io)) { - return (PL_laststatval = PerlLIO_fstat(PerlIO_fileno(IoIFP(io)), &PL_statcache)); + int fd = PerlIO_fileno(IoIFP(io)); + if (fd >= 0) { + return (PL_laststatval = PerlLIO_fstat(fd, &PL_statcache)); + } } else if (IoDIRP(io)) { return (PL_laststatval = PerlLIO_fstat(my_dirfd(IoDIRP(io)), &PL_statcache)); } @@ -1739,9 +1761,13 @@ Perl_apply(pTHX_ I32 type, SV **mark, SV **sp) if ((gv = MAYBE_DEREF_GV(*mark))) { if (GvIO(gv) && IoIFP(GvIOp(gv))) { #ifdef HAS_FCHMOD + int fd = PerlIO_fileno(IoIFP(GvIOn(gv))); APPLY_TAINT_PROPER(); - if (fchmod(PerlIO_fileno(IoIFP(GvIOn(gv))), val)) - tot--; + if (fd < 0) { + SETERRNO(EBADF,RMS_IFI); + tot--; + } else if (fchmod(fd, val)) + tot--; #else Perl_die(aTHX_ PL_no_func, "fchmod"); #endif @@ -1775,8 +1801,12 @@ Perl_apply(pTHX_ I32 type, SV **mark, SV **sp) if ((gv = MAYBE_DEREF_GV(*mark))) { if (GvIO(gv) && IoIFP(GvIOp(gv))) { #ifdef HAS_FCHOWN + int fd = PerlIO_fileno(IoIFP(GvIOn(gv))); APPLY_TAINT_PROPER(); - if (fchown(PerlIO_fileno(IoIFP(GvIOn(gv))), val, val2)) + if (fd < 0) { + SETERRNO(EBADF,RMS_IFI); + tot--; + } else if (fchown(fd, val, val2)) tot--; #else Perl_die(aTHX_ PL_no_func, "fchown"); @@ -1965,9 +1995,12 @@ nothing in the core. if ((gv = MAYBE_DEREF_GV(*mark))) { if (GvIO(gv) && IoIFP(GvIOp(gv))) { #ifdef HAS_FUTIMES + int fd = PerlIO_fileno(IoIFP(GvIOn(gv))); APPLY_TAINT_PROPER(); - if (futimes(PerlIO_fileno(IoIFP(GvIOn(gv))), - (struct timeval *) utbufp)) + if (fd < 0) { + SETERRNO(EBADF,RMS_IFI); + tot--; + } else if (futimes(fd, (struct timeval *) utbufp)) tot--; #else Perl_die(aTHX_ PL_no_func, "futimes"); @@ -2082,15 +2115,17 @@ S_ingroup(pTHX_ Gid_t testgid, bool effective) bool rc = FALSE; anum = getgroups(0, gary); - Newx(gary, anum, Groups_t); - anum = getgroups(anum, gary); - while (--anum >= 0) - if (gary[anum] == testgid) { - rc = TRUE; - break; - } + if (anum > 0) { + Newx(gary, anum, Groups_t); + anum = getgroups(anum, gary); + while (--anum >= 0) + if (gary[anum] == testgid) { + rc = TRUE; + break; + } - Safefree(gary); + Safefree(gary); + } return rc; } #else diff --git a/ext/PerlIO-mmap/mmap.xs b/ext/PerlIO-mmap/mmap.xs index 4c96da8..6632544 100644 --- a/ext/PerlIO-mmap/mmap.xs +++ b/ext/PerlIO-mmap/mmap.xs @@ -40,8 +40,12 @@ PerlIOMmap_map(pTHX_ PerlIO *f) abort(); if (flags & PERLIO_F_CANREAD) { PerlIOBuf * const b = PerlIOSelf(f, PerlIOBuf); - const int fd = PerlIO_fileno(f); Stat_t st; + const int fd = PerlIO_fileno(f); + if (fd < 0) { + SETERRNO(EBADF,RMS_IFI); + return -1; + } code = Fstat(fd, &st); if (code == 0 && S_ISREG(st.st_mode)) { SSize_t len = st.st_size - b->posn; diff --git a/mg.c b/mg.c index 76912bd..6414349 100644 --- a/mg.c +++ b/mg.c @@ -1120,12 +1120,15 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg) #ifdef HAS_GETGROUPS { Groups_t *gary = NULL; - I32 i, num_groups = getgroups(0, gary); - Newx(gary, num_groups, Groups_t); - num_groups = getgroups(num_groups, gary); - for (i = 0; i < num_groups; i++) - Perl_sv_catpvf(aTHX_ sv, " %"IVdf, (IV)gary[i]); - Safefree(gary); + I32 i; + I32 num_groups = getgroups(0, gary); + if (num_groups > 0) { + Newx(gary, num_groups, Groups_t); + num_groups = getgroups(num_groups, gary); + for (i = 0; i < num_groups; i++) + Perl_sv_catpvf(aTHX_ sv, " %"IVdf, (IV)gary[i]); + Safefree(gary); + } } (void)SvIOK_on(sv); /* what a wonderful hack! */ #endif diff --git a/perl.c b/perl.c index 27d0d9e..4dd4821 100644 --- a/perl.c +++ b/perl.c @@ -3691,6 +3691,7 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch, bool *suidscript) PerlIO *rsfp = NULL; dVAR; Stat_t tmpstatbuf; + int fd; PERL_ARGS_ASSERT_OPEN_SCRIPT; @@ -3796,13 +3797,17 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch, bool *suidscript) Perl_croak(aTHX_ "Can't open perl script \"%s\": %s\n", CopFILE(PL_curcop), Strerror(errno)); } + fd = PerlIO_fileno(rsfp); #if defined(HAS_FCNTL) && defined(F_SETFD) - /* ensure close-on-exec */ - fcntl(PerlIO_fileno(rsfp), F_SETFD, 1); + if (fd >= 0) { + /* ensure close-on-exec */ + fcntl(fd, F_SETFD, 1); + } #endif - if (PerlLIO_fstat(PerlIO_fileno(rsfp), &tmpstatbuf) >= 0 - && S_ISDIR(tmpstatbuf.st_mode)) + if (fd < 0 || + (PerlLIO_fstat(fd, &tmpstatbuf) >= 0 + && S_ISDIR(tmpstatbuf.st_mode))) Perl_croak(aTHX_ "Can't open perl script \"%s\": %s\n", CopFILE(PL_curcop), Strerror(EISDIR)); @@ -3833,12 +3838,18 @@ S_validate_suid(pTHX_ PerlIO *rsfp) if (my_euid != my_uid || my_egid != my_gid) { /* (suidperl doesn't exist, in fact) */ dVAR; - - PerlLIO_fstat(PerlIO_fileno(rsfp),&PL_statbuf); /* may be either wrapped or real suid */ - if ((my_euid != my_uid && my_euid == PL_statbuf.st_uid && PL_statbuf.st_mode & S_ISUID) - || - (my_egid != my_gid && my_egid == PL_statbuf.st_gid && PL_statbuf.st_mode & S_ISGID) - ) + int fd = PerlIO_fileno(rsfp); + if (fd < 0) { + Perl_croak(aTHX_ "Illegal suidscript"); + } else { + if (PerlLIO_fstat(fd, &PL_statbuf) < 0) { /* may be either wrapped or real suid */ + Perl_croak(aTHX_ "Illegal suidscript"); + } + } + if ((my_euid != my_uid && my_euid == PL_statbuf.st_uid && PL_statbuf.st_mode & S_ISUID) + || + (my_egid != my_gid && my_egid == PL_statbuf.st_gid && PL_statbuf.st_mode & S_ISGID) + ) if (!PL_do_undump) Perl_croak(aTHX_ "YOU HAVEN'T DISABLED SET-ID SCRIPTS IN THE KERNEL YET!\n\ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n"); diff --git a/perlio.c b/perlio.c index 0ae0a43..83c8463 100644 --- a/perlio.c +++ b/perlio.c @@ -2922,6 +2922,10 @@ PerlIO_importFILE(FILE *stdio, const char *mode) PerlIO *f = NULL; if (stdio) { PerlIOStdio *s; + int fd0 = fileno(stdio); + if (fd0 < 0) { + return NULL; + } if (!mode || !*mode) { /* We need to probe to see how we can open the stream so start with read/write and then try write and read @@ -2930,8 +2934,12 @@ PerlIO_importFILE(FILE *stdio, const char *mode) Note that the errno value set by a failing fdopen varies between stdio implementations. */ - const int fd = PerlLIO_dup(fileno(stdio)); - FILE *f2 = PerlSIO_fdopen(fd, (mode = "r+")); + const int fd = PerlLIO_dup(fd0); + FILE *f2; + if (fd < 0) { + return f; + } + f2 = PerlSIO_fdopen(fd, (mode = "r+")); if (!f2) { f2 = PerlSIO_fdopen(fd, (mode = "w")); } @@ -3667,6 +3675,10 @@ PerlIO_exportFILE(PerlIO * f, const char *mode) FILE *stdio = NULL; if (PerlIOValid(f)) { char buf[8]; + int fd = PerlIO_fileno(f); + if (fd < 0) { + return NULL; + } PerlIO_flush(f); if (!mode || !*mode) { mode = PerlIO_modestr(f, buf); diff --git a/pod/perldiag.pod b/pod/perldiag.pod index 00700c5..b7c1942 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -2292,6 +2292,10 @@ The C<"+"> is valid only when followed by digits, indicating a capturing group. See L)>|perlre/(?PARNO) (?-PARNO) (?+PARNO) (?R) (?0)>. +=item Illegal suidscript + +(F) The script run under suidperl was somehow illegal. + =item Illegal switch in PERL5OPT: -%c (X) The PERL5OPT environment variable may only be used to set the diff --git a/pp_sys.c b/pp_sys.c index 9f97177..40464bb 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -1616,7 +1616,7 @@ PP(pp_sysread) char *buffer; STRLEN orig_size; SSize_t length; - SSize_t count; + SSize_t count = -1; SV *bufsv; STRLEN blen; int fp_utf8; @@ -1682,6 +1682,11 @@ PP(pp_sysread) if (PL_op->op_type == OP_RECV) { Sock_size_t bufsize; char namebuf[MAXPATHLEN]; + int fd = PerlIO_fileno(IoIFP(io)); + if (fd < 0) { + SETERRNO(EBADF,RMS_IFI); + RETPUSHUNDEF; + } #if (defined(VMS_DO_SOCKETS) && defined(DECCRTL_SOCKETS)) || defined(__QNXNTO__) bufsize = sizeof (struct sockaddr_in); #else @@ -1693,7 +1698,7 @@ PP(pp_sysread) #endif buffer = SvGROW(bufsv, (STRLEN)(length+1)); /* 'offset' means 'flags' here */ - count = PerlSock_recvfrom(PerlIO_fileno(IoIFP(io)), buffer, length, offset, + count = PerlSock_recvfrom(fd, buffer, length, offset, (struct sockaddr *)namebuf, &bufsize); if (count < 0) RETPUSHUNDEF; @@ -1771,8 +1776,11 @@ PP(pp_sysread) else #endif { - count = PerlLIO_read(PerlIO_fileno(IoIFP(io)), - buffer, length); + int fd = PerlIO_fileno(IoIFP(io)); + if (fd < 0) + SETERRNO(EBADF,RMS_IFI); + else + count = PerlLIO_read(fd, buffer, length); } } else @@ -1848,7 +1856,7 @@ PP(pp_syswrite) dVAR; dSP; dMARK; dORIGMARK; dTARGET; SV *bufsv; const char *buffer; - SSize_t retval; + SSize_t retval = -1; STRLEN blen; STRLEN orig_blen_bytes; const int op_type = PL_op->op_type; @@ -1856,6 +1864,7 @@ PP(pp_syswrite) U8 *tmpbuf = NULL; GV *const gv = MUTABLE_GV(*++MARK); IO *const io = GvIO(gv); + int fd; if (op_type == OP_SYSWRITE && io) { const MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar); @@ -1915,17 +1924,21 @@ PP(pp_syswrite) } #ifdef HAS_SOCKET + fd = PerlIO_fileno(IoIFP(io)); + if (fd < 0) { + SETERRNO(EBADF,SS_IVCHAN); + goto say_undef; + } if (op_type == OP_SEND) { const int flags = SvIVx(*++MARK); if (SP > MARK) { STRLEN mlen; char * const sockbuf = SvPVx(*++MARK, mlen); - retval = PerlSock_sendto(PerlIO_fileno(IoIFP(io)), buffer, blen, + retval = PerlSock_sendto(fd, buffer, blen, flags, (struct sockaddr *)sockbuf, mlen); } else { - retval - = PerlSock_send(PerlIO_fileno(IoIFP(io)), buffer, blen, flags); + retval = PerlSock_send(fd, buffer, blen, flags); } } else @@ -2008,15 +2021,13 @@ PP(pp_syswrite) } #ifdef PERL_SOCK_SYSWRITE_IS_SEND if (IoTYPE(io) == IoTYPE_SOCKET) { - retval = PerlSock_send(PerlIO_fileno(IoIFP(io)), - buffer, length, 0); + retval = PerlSock_send(fd, buffer, length, 0); } else #endif { /* See the note at doio.c:do_print about filesize limits. --jhi */ - retval = PerlLIO_write(PerlIO_fileno(IoIFP(io)), - buffer, length); + retval = PerlLIO_write(fd, buffer, length); } } @@ -2224,13 +2235,18 @@ PP(pp_truncate) result = 0; } else { - PerlIO_flush(fp); + int fd = PerlIO_fileno(fp); + if (fd < 0) + SETERRNO(EBADF,RMS_IFI); + else { + PerlIO_flush(fp); #ifdef HAS_TRUNCATE - if (ftruncate(PerlIO_fileno(fp), len) < 0) + if (ftruncate(fd, len) < 0) #else - if (my_chsize(PerlIO_fileno(fp), len) < 0) + if (my_chsize(fd, len) < 0) #endif - result = 0; + result = 0; + } } } } @@ -2248,9 +2264,10 @@ PP(pp_truncate) { const int tmpfd = PerlLIO_open(name, O_RDWR); - if (tmpfd < 0) + if (tmpfd < 0) { + SETERRNO(EBADF,RMS_IFI); result = 0; - else { + } else { if (my_chsize(tmpfd, len) < 0) result = 0; PerlLIO_close(tmpfd); @@ -2388,8 +2405,10 @@ PP(pp_socket) TAINT_PROPER("socket"); fd = PerlSock_socket(domain, type, protocol); - if (fd < 0) + if (fd < 0) { + SETERRNO(EBADF,RMS_IFI); RETPUSHUNDEF; + } IoIFP(io) = PerlIO_fdopen(fd, "r"SOCKET_OPEN_MODE); /* stdio gets confused about sockets */ IoOFP(io) = PerlIO_fdopen(fd, "w"SOCKET_OPEN_MODE); IoTYPE(io) = IoTYPE_SOCKET; @@ -2467,16 +2486,20 @@ PP(pp_bind) IO * const io = GvIOn(gv); STRLEN len; int op_type; + int fd; if (!IoIFP(io)) goto nuts; + fd = PerlIO_fileno(IoIFP(io)); + if (fd < 0) + goto nuts; addr = SvPV_const(addrsv, len); op_type = PL_op->op_type; TAINT_PROPER(PL_op_desc[op_type]); if ((op_type == OP_BIND - ? PerlSock_bind(PerlIO_fileno(IoIFP(io)), (struct sockaddr *)addr, len) - : PerlSock_connect(PerlIO_fileno(IoIFP(io)), (struct sockaddr *)addr, len)) + ? PerlSock_bind(fd, (struct sockaddr *)addr, len) + : PerlSock_connect(fd, (struct sockaddr *)addr, len)) >= 0) RETPUSHYES; else @@ -2608,6 +2631,8 @@ PP(pp_ssockopt) goto nuts; fd = PerlIO_fileno(IoIFP(io)); + if (fd < 0) + goto nuts; switch (optype) { case OP_GSOCKOPT: SvGROW(sv, 257); @@ -2683,6 +2708,8 @@ PP(pp_getpeername) SvCUR_set(sv, len); *SvEND(sv) ='\0'; fd = PerlIO_fileno(IoIFP(io)); + if (fd < 0) + goto nuts; switch (optype) { case OP_GETSOCKNAME: if (PerlSock_getsockname(fd, (struct sockaddr *)SvPVX(sv), &len) < 0) @@ -2764,9 +2791,14 @@ PP(pp_stat) } if (io) { if (IoIFP(io)) { - PL_laststatval = - PerlLIO_fstat(PerlIO_fileno(IoIFP(io)), &PL_statcache); - havefp = TRUE; + int fd = PerlIO_fileno(IoIFP(io)); + if (fd < 0) { + PL_laststatval = -1; + SETERRNO(EBADF,RMS_IFI); + } else { + PL_laststatval = PerlLIO_fstat(fd, &PL_statcache); + havefp = TRUE; + } } else if (IoDIRP(io)) { PL_laststatval = PerlLIO_fstat(my_dirfd(IoDIRP(io)), &PL_statcache); @@ -3256,9 +3288,13 @@ PP(pp_fttty) if (GvIO(gv) && IoIFP(GvIOp(gv))) fd = PerlIO_fileno(IoIFP(GvIOp(gv))); else if (name && isDIGIT(*name)) - fd = atoi(name); + fd = atoi(name); else FT_RETURNUNDEF; + if (fd < 0) { + SETERRNO(EBADF,RMS_IFI); + FT_RETURNUNDEF; + } if (PerlLIO_isatty(fd)) FT_RETURNYES; FT_RETURNNO; @@ -3307,9 +3343,15 @@ PP(pp_fttext) PL_laststatval = -1; PL_laststype = OP_STAT; if (io && IoIFP(io)) { + int fd; if (! PerlIO_has_base(IoIFP(io))) DIE(aTHX_ "-T and -B not implemented on filehandles"); - PL_laststatval = PerlLIO_fstat(PerlIO_fileno(IoIFP(io)), &PL_statcache); + fd = PerlIO_fileno(IoIFP(io)); + if (fd < 0) { + SETERRNO(EBADF,RMS_IFI); + FT_RETURNUNDEF; + } + PL_laststatval = PerlLIO_fstat(fd, &PL_statcache); if (PL_laststatval < 0) FT_RETURNUNDEF; if (S_ISDIR(PL_statcache.st_mode)) { /* handle NFS glitch */ @@ -3339,6 +3381,7 @@ PP(pp_fttext) } } else { + int fd; sv_setpv(PL_statname, SvPV_nomg_const_nolen(sv)); really_filename: PL_statgv = NULL; @@ -3358,9 +3401,16 @@ PP(pp_fttext) FT_RETURNUNDEF; } PL_laststype = OP_STAT; - PL_laststatval = PerlLIO_fstat(PerlIO_fileno(fp), &PL_statcache); + fd = PerlIO_fileno(fp); + if (fd < 0) { + (void)PerlIO_close(fp); + SETERRNO(EBADF,RMS_IFI); + FT_RETURNUNDEF; + } + PL_laststatval = PerlLIO_fstat(fd, &PL_statcache); if (PL_laststatval < 0) { (void)PerlIO_close(fp); + SETERRNO(EBADF,RMS_IFI); FT_RETURNUNDEF; } PerlIO_binmode(aTHX_ fp, '<', O_BINARY, NULL); @@ -3475,19 +3525,19 @@ PP(pp_chdir) if (IoDIRP(io)) { PUSHi(fchdir(my_dirfd(IoDIRP(io))) >= 0); } else if (IoIFP(io)) { - PUSHi(fchdir(PerlIO_fileno(IoIFP(io))) >= 0); + int fd = PerlIO_fileno(IoIFP(io)); + if (fd < 0) { + goto nuts; + } + PUSHi(fchdir(fd) >= 0); } else { - report_evil_fh(gv); - SETERRNO(EBADF, RMS_IFI); - PUSHi(0); + goto nuts; } + } else { + goto nuts; } - else { - report_evil_fh(gv); - SETERRNO(EBADF,RMS_IFI); - PUSHi(0); - } + #else DIE(aTHX_ PL_no_func, "fchdir"); #endif @@ -3500,6 +3550,12 @@ PP(pp_chdir) hv_delete(GvHVn(PL_envgv),"DEFAULT",7,G_DISCARD); #endif RETURN; + + nuts: + report_evil_fh(gv); + SETERRNO(EBADF,RMS_IFI); + PUSHi(0); + RETURN; } PP(pp_chown) diff --git a/util.c b/util.c index 0a0ee40..cfb2ecc 100644 --- a/util.c +++ b/util.c @@ -1710,13 +1710,16 @@ void Perl_croak_no_mem(void) { dTHX; - int rc; - /* Can't use PerlIO to write as it allocates memory */ - rc = PerlLIO_write(PerlIO_fileno(Perl_error_log), - PL_no_mem, sizeof(PL_no_mem)-1); - /* silently ignore failures */ - PERL_UNUSED_VAR(rc); + int fd = PerlIO_fileno(Perl_error_log); + if (fd < 0) + SETERRNO(EBADF,RMS_IFI); + else { + /* Can't use PerlIO to write as it allocates memory */ + int rc = PerlLIO_write(fd, PL_no_mem, sizeof(PL_no_mem)-1); + /* silently ignore failures */ + PERL_UNUSED_VAR(rc); + } my_exit(1); } -- 1.9.2 ```

[p5pRT]

From @jhi

On Thursday-201405-01\, 17​:05\, Jarkko Hietaniemi wrote​:

Yet again refreshed patch\, found two more spots with the same potentially negative fd use.

And one more spot added (missed that a new Coverity scan had found more). Also hopefully better "summary line" now.

[p5pRT]

From @jhi

0001-fcntl-and-fgetc-calls-unchecked-for-failure.patch

```diff From 998ff75995abae05d829ac06d7c73a3af848ca9b Mon Sep 17 00:00:00 2001 From: Jarkko Hietaniemi Date: Thu, 24 Apr 2014 12:10:44 -0400 Subject: [PATCH] fcntl and fgetc calls unchecked for failure. Fix for Coverity perl5 CIDs 29813, 29814, 29819,29821..29823, 28930: Unchecked return value from library (CHECKED_RETURN) check_return: Calling fcntl(...) without checking return value. and CID 29820: Unchecked return value from library (CHECKED_RETURN) check_return: Calling fgetc(...) without checking return value. The fcntl() calls are doing FD_SETFD (for fds larger than PL_maxsysfd) and FD_CLOEXEC. It is debatable whether these failing are serious enough offenses to return undef (or otherwise fail), but this patch makes it so, and no tests start failing. --- doio.c | 6 +++++- perl.c | 6 +++++- perlio.c | 4 ++-- pp_sys.c | 21 ++++++++++++++------- util.c | 6 ++++-- 5 files changed, 30 insertions(+), 13 deletions(-) diff --git a/doio.c b/doio.c index e2bfda5..2bcdbb9 100644 --- a/doio.c +++ b/doio.c @@ -755,8 +755,12 @@ S_openn_cleanup(pTHX_ GV *gv, IO *io, PerlIO *fp, char *mode, const char *oname, #if defined(HAS_FCNTL) && defined(F_SETFD) if (fd >= 0) { dSAVE_ERRNO; - fcntl(fd,F_SETFD,fd > PL_maxsysfd); /* can change errno */ + int rc = fcntl(fd,F_SETFD,fd > PL_maxsysfd); /* can change errno */ RESTORE_ERRNO; + if (rc < 0) { + PerlLIO_close(fd); + goto say_false; + } } #endif IoIFP(io) = fp; diff --git a/perl.c b/perl.c index 27d0d9e..1efafe7 100644 --- a/perl.c +++ b/perl.c @@ -3798,7 +3798,11 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch, bool *suidscript) } #if defined(HAS_FCNTL) && defined(F_SETFD) /* ensure close-on-exec */ - fcntl(PerlIO_fileno(rsfp), F_SETFD, 1); + if (fcntl(PerlIO_fileno(rsfp), F_SETFD, 1) < 0) { + Perl_croak(aTHX_ "Can't open perl script \"%s\": " + "fcntl close-on-exec failed\n", + CopFILE(PL_curcop)); + } #endif if (PerlLIO_fstat(PerlIO_fileno(rsfp), &tmpstatbuf) >= 0 diff --git a/perlio.c b/perlio.c index 0ae0a43..375911f 100644 --- a/perlio.c +++ b/perlio.c @@ -3350,8 +3350,8 @@ PerlIOStdio_unread(pTHX_ PerlIO *f, const void *vbuf, Size_t count) } if ((STDCHAR*)PerlSIO_get_ptr(s) != --eptr || ((*eptr & 0xFF) != ch)) { /* Did not change pointer as expected */ - fgetc(s); /* get char back again */ - break; + if (fgetc(s) != EOF) /* get char back again */ + break; } /* It worked ! */ count--; diff --git a/pp_sys.c b/pp_sys.c index 9f97177..abfee72 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -715,8 +715,10 @@ PP(pp_pipe_op) goto badexit; } #if defined(HAS_FCNTL) && defined(F_SETFD) - fcntl(fd[0],F_SETFD,fd[0] > PL_maxsysfd); /* ensure close-on-exec */ - fcntl(fd[1],F_SETFD,fd[1] > PL_maxsysfd); /* ensure close-on-exec */ + /* ensure close-on-exec */ + if ((fcntl(fd[0], F_SETFD,fd[0] > PL_maxsysfd) < 0) || + (fcntl(fd[1], F_SETFD,fd[1] > PL_maxsysfd) < 0)) + goto badexit; #endif RETPUSHYES; @@ -2400,7 +2402,8 @@ PP(pp_socket) RETPUSHUNDEF; } #if defined(HAS_FCNTL) && defined(F_SETFD) - fcntl(fd, F_SETFD, fd > PL_maxsysfd); /* ensure close-on-exec */ + if (fcntl(fd, F_SETFD, fd > PL_maxsysfd) < 0) /* ensure close-on-exec */ + RETPUSHUNDEF; #endif RETPUSHYES; @@ -2445,8 +2448,10 @@ PP(pp_sockpair) RETPUSHUNDEF; } #if defined(HAS_FCNTL) && defined(F_SETFD) - fcntl(fd[0],F_SETFD,fd[0] > PL_maxsysfd); /* ensure close-on-exec */ - fcntl(fd[1],F_SETFD,fd[1] > PL_maxsysfd); /* ensure close-on-exec */ + /* ensure close-on-exec */ + if ((fcntl(fd[0],F_SETFD,fd[0] > PL_maxsysfd) < 0) || + (fcntl(fd[1],F_SETFD,fd[1] > PL_maxsysfd) < 0)) + RETPUSHUNDEF; #endif RETPUSHYES; @@ -2554,7 +2559,8 @@ PP(pp_accept) goto badexit; } #if defined(HAS_FCNTL) && defined(F_SETFD) - fcntl(fd, F_SETFD, fd > PL_maxsysfd); /* ensure close-on-exec */ + if (fcntl(fd, F_SETFD, fd > PL_maxsysfd) < 0) /* ensure close-on-exec */ + goto badexit; #endif #ifdef __SCO_VERSION__ @@ -4194,7 +4200,8 @@ PP(pp_system) if (did_pipes) { PerlLIO_close(pp[0]); #if defined(HAS_FCNTL) && defined(F_SETFD) - fcntl(pp[1], F_SETFD, FD_CLOEXEC); + if (fcntl(pp[1], F_SETFD, FD_CLOEXEC) < 0) + RETPUSHUNDEF; #endif } if (PL_op->op_flags & OPf_STACKED) { diff --git a/util.c b/util.c index 0a0ee40..b8524a8 100644 --- a/util.c +++ b/util.c @@ -2308,7 +2308,8 @@ Perl_my_popen_list(pTHX_ const char *mode, int n, SV **args) PerlLIO_close(pp[0]); #if defined(HAS_FCNTL) && defined(F_SETFD) /* Close error pipe automatically if exec works */ - fcntl(pp[1], F_SETFD, FD_CLOEXEC); + if (fcntl(pp[1], F_SETFD, FD_CLOEXEC) < 0) + return NULL; #endif } /* Now dup our end of _the_ pipe to right position */ @@ -2453,7 +2454,8 @@ Perl_my_popen(pTHX_ const char *cmd, const char *mode) if (did_pipes) { PerlLIO_close(pp[0]); #if defined(HAS_FCNTL) && defined(F_SETFD) - fcntl(pp[1], F_SETFD, FD_CLOEXEC); + if (fcntl(pp[1], F_SETFD, FD_CLOEXEC) < 0) + return NULL; #endif } if (p[THIS] != (*mode == 'r')) { -- 1.9.2 ```

[p5pRT]

From @jhi

On Thursday-201405-01\, 21​:06\, Jarkko Hietaniemi wrote​:

On Thursday-201405-01\, 17​:05\, Jarkko Hietaniemi wrote​:

Yet again refreshed patch\, found two more spots with the same potentially negative fd use.

And one more spot added (missed that a new Coverity scan had found more). Also hopefully better "summary line" now.

Argh. Please discard this very latest patch ("one more spot")\, sorry about that. I'm getting mixed up in my patches\, too many in-flight. The one with "two more spots" is the currently correct one for this issue (not checking for negative return values).

[p5pRT]

From @jhi

Updated patch attached.

[p5pRT]

From @jhi

0001-fcntl-and-fgetc-calls-unchecked-for-failure.patch

```diff From 998ff75995abae05d829ac06d7c73a3af848ca9b Mon Sep 17 00:00:00 2001 From: Jarkko Hietaniemi Date: Thu, 24 Apr 2014 12:10:44 -0400 Subject: [PATCH] fcntl and fgetc calls unchecked for failure. Fix for Coverity perl5 CIDs 29813, 29814, 29819,29821..29823, 28930: Unchecked return value from library (CHECKED_RETURN) check_return: Calling fcntl(...) without checking return value. and CID 29820: Unchecked return value from library (CHECKED_RETURN) check_return: Calling fgetc(...) without checking return value. The fcntl() calls are doing FD_SETFD (for fds larger than PL_maxsysfd) and FD_CLOEXEC. It is debatable whether these failing are serious enough offenses to return undef (or otherwise fail), but this patch makes it so, and no tests start failing. --- doio.c | 6 +++++- perl.c | 6 +++++- perlio.c | 4 ++-- pp_sys.c | 21 ++++++++++++++------- util.c | 6 ++++-- 5 files changed, 30 insertions(+), 13 deletions(-) diff --git a/doio.c b/doio.c index e2bfda5..2bcdbb9 100644 --- a/doio.c +++ b/doio.c @@ -755,8 +755,12 @@ S_openn_cleanup(pTHX_ GV *gv, IO *io, PerlIO *fp, char *mode, const char *oname, #if defined(HAS_FCNTL) && defined(F_SETFD) if (fd >= 0) { dSAVE_ERRNO; - fcntl(fd,F_SETFD,fd > PL_maxsysfd); /* can change errno */ + int rc = fcntl(fd,F_SETFD,fd > PL_maxsysfd); /* can change errno */ RESTORE_ERRNO; + if (rc < 0) { + PerlLIO_close(fd); + goto say_false; + } } #endif IoIFP(io) = fp; diff --git a/perl.c b/perl.c index 27d0d9e..1efafe7 100644 --- a/perl.c +++ b/perl.c @@ -3798,7 +3798,11 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch, bool *suidscript) } #if defined(HAS_FCNTL) && defined(F_SETFD) /* ensure close-on-exec */ - fcntl(PerlIO_fileno(rsfp), F_SETFD, 1); + if (fcntl(PerlIO_fileno(rsfp), F_SETFD, 1) < 0) { + Perl_croak(aTHX_ "Can't open perl script \"%s\": " + "fcntl close-on-exec failed\n", + CopFILE(PL_curcop)); + } #endif if (PerlLIO_fstat(PerlIO_fileno(rsfp), &tmpstatbuf) >= 0 diff --git a/perlio.c b/perlio.c index 0ae0a43..375911f 100644 --- a/perlio.c +++ b/perlio.c @@ -3350,8 +3350,8 @@ PerlIOStdio_unread(pTHX_ PerlIO *f, const void *vbuf, Size_t count) } if ((STDCHAR*)PerlSIO_get_ptr(s) != --eptr || ((*eptr & 0xFF) != ch)) { /* Did not change pointer as expected */ - fgetc(s); /* get char back again */ - break; + if (fgetc(s) != EOF) /* get char back again */ + break; } /* It worked ! */ count--; diff --git a/pp_sys.c b/pp_sys.c index 9f97177..abfee72 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -715,8 +715,10 @@ PP(pp_pipe_op) goto badexit; } #if defined(HAS_FCNTL) && defined(F_SETFD) - fcntl(fd[0],F_SETFD,fd[0] > PL_maxsysfd); /* ensure close-on-exec */ - fcntl(fd[1],F_SETFD,fd[1] > PL_maxsysfd); /* ensure close-on-exec */ + /* ensure close-on-exec */ + if ((fcntl(fd[0], F_SETFD,fd[0] > PL_maxsysfd) < 0) || + (fcntl(fd[1], F_SETFD,fd[1] > PL_maxsysfd) < 0)) + goto badexit; #endif RETPUSHYES; @@ -2400,7 +2402,8 @@ PP(pp_socket) RETPUSHUNDEF; } #if defined(HAS_FCNTL) && defined(F_SETFD) - fcntl(fd, F_SETFD, fd > PL_maxsysfd); /* ensure close-on-exec */ + if (fcntl(fd, F_SETFD, fd > PL_maxsysfd) < 0) /* ensure close-on-exec */ + RETPUSHUNDEF; #endif RETPUSHYES; @@ -2445,8 +2448,10 @@ PP(pp_sockpair) RETPUSHUNDEF; } #if defined(HAS_FCNTL) && defined(F_SETFD) - fcntl(fd[0],F_SETFD,fd[0] > PL_maxsysfd); /* ensure close-on-exec */ - fcntl(fd[1],F_SETFD,fd[1] > PL_maxsysfd); /* ensure close-on-exec */ + /* ensure close-on-exec */ + if ((fcntl(fd[0],F_SETFD,fd[0] > PL_maxsysfd) < 0) || + (fcntl(fd[1],F_SETFD,fd[1] > PL_maxsysfd) < 0)) + RETPUSHUNDEF; #endif RETPUSHYES; @@ -2554,7 +2559,8 @@ PP(pp_accept) goto badexit; } #if defined(HAS_FCNTL) && defined(F_SETFD) - fcntl(fd, F_SETFD, fd > PL_maxsysfd); /* ensure close-on-exec */ + if (fcntl(fd, F_SETFD, fd > PL_maxsysfd) < 0) /* ensure close-on-exec */ + goto badexit; #endif #ifdef __SCO_VERSION__ @@ -4194,7 +4200,8 @@ PP(pp_system) if (did_pipes) { PerlLIO_close(pp[0]); #if defined(HAS_FCNTL) && defined(F_SETFD) - fcntl(pp[1], F_SETFD, FD_CLOEXEC); + if (fcntl(pp[1], F_SETFD, FD_CLOEXEC) < 0) + RETPUSHUNDEF; #endif } if (PL_op->op_flags & OPf_STACKED) { diff --git a/util.c b/util.c index 0a0ee40..b8524a8 100644 --- a/util.c +++ b/util.c @@ -2308,7 +2308,8 @@ Perl_my_popen_list(pTHX_ const char *mode, int n, SV **args) PerlLIO_close(pp[0]); #if defined(HAS_FCNTL) && defined(F_SETFD) /* Close error pipe automatically if exec works */ - fcntl(pp[1], F_SETFD, FD_CLOEXEC); + if (fcntl(pp[1], F_SETFD, FD_CLOEXEC) < 0) + return NULL; #endif } /* Now dup our end of _the_ pipe to right position */ @@ -2453,7 +2454,8 @@ Perl_my_popen(pTHX_ const char *cmd, const char *mode) if (did_pipes) { PerlLIO_close(pp[0]); #if defined(HAS_FCNTL) && defined(F_SETFD) - fcntl(pp[1], F_SETFD, FD_CLOEXEC); + if (fcntl(pp[1], F_SETFD, FD_CLOEXEC) < 0) + return NULL; #endif } if (p[THIS] != (*mode == 'r')) { -- 1.9.2 ```

[p5pRT]

From @jhi

On Thursday-201405-01\, 17​:05\, Jarkko Hietaniemi wrote​:

Yet again refreshed patch\, found two more spots with the same potentially negative fd use.

I decided to merge this ticket with perl #121745 which checked for fcntl failure paths\, since there's a lot of functional overlap​: (1) a fd from fileno being checked against \< 0\, and then (2) the fd being fed to fcntl\, the return value of which we want to check for failure (3) in one actual case of a merge conflict (in perl.c) because the changes for these two checks were too close for comfort

So updated combined patch attached\, and please ignore/merge #121745.

[p5pRT]

From @jhi

0001-Check-fileno-numgroups-1-check-fcntl-fgetc-failures.patch

```diff From 199fd738e900d42cde4181d3a4a363532c0d6fea Mon Sep 17 00:00:00 2001 From: Jarkko Hietaniemi Date: Fri, 2 May 2014 22:12:24 -0400 Subject: [PATCH] Check fileno/numgroups -1, check fcntl (+fgetc) failures. (merged fix for perl #121743 and perl #121745) --- dist/IO/IO.xs | 12 +++- dist/threads/threads.xs | 9 +-- doio.c | 105 +++++++++++++++++++++++----------- ext/PerlIO-mmap/mmap.xs | 6 +- mg.c | 15 +++-- perl.c | 35 ++++++++---- perlio.c | 20 +++++-- pod/perldiag.pod | 4 ++ pp_sys.c | 149 ++++++++++++++++++++++++++++++++++-------------- util.c | 21 ++++--- 10 files changed, 264 insertions(+), 112 deletions(-) diff --git a/dist/IO/IO.xs b/dist/IO/IO.xs index 9056cb6..d7fe0a0 100644 --- a/dist/IO/IO.xs +++ b/dist/IO/IO.xs @@ -524,9 +524,15 @@ fsync(arg) handle = IoOFP(sv_2io(arg)); if (!handle) handle = IoIFP(sv_2io(arg)); - if(handle) - RETVAL = fsync(PerlIO_fileno(handle)); - else { + if (handle) { + int fd = PerlIO_fileno(handle); + if (fd >= 0) { + RETVAL = fsync(fd); + } else { + RETVAL = -1; + errno = EINVAL; + } + } else { RETVAL = -1; errno = EINVAL; } diff --git a/dist/threads/threads.xs b/dist/threads/threads.xs index 8537165..cfcf98b 100644 --- a/dist/threads/threads.xs +++ b/dist/threads/threads.xs @@ -713,11 +713,12 @@ S_ithread_create( } PERL_SET_CONTEXT(aTHX); if (!thread) { - int rc; MUTEX_UNLOCK(&MY_POOL.create_destruct_mutex); - rc = PerlLIO_write(PerlIO_fileno(Perl_error_log), - PL_no_mem, strlen(PL_no_mem)); - PERL_UNUSED_VAR(rc); + int fd = PerlIO_fileno(Perl_error_log); + if (fd < 0) { + int rc = PerlLIO_write(fd, PL_no_mem, strlen(PL_no_mem)); + PERL_UNUSED_VAR(rc); + } my_exit(1); } Zero(thread, 1, ithread); diff --git a/doio.c b/doio.c index e2bfda5..26c0032 100644 --- a/doio.c +++ b/doio.c @@ -646,9 +646,9 @@ S_openn_cleanup(pTHX_ GV *gv, IO *io, PerlIO *fp, char *mode, const char *oname, } fd = PerlIO_fileno(fp); - /* If there is no fd (e.g. PerlIO::scalar) assume it isn't a - * socket - this covers PerlIO::scalar - otherwise unless we "know" the - * type probe for socket-ness. + /* Do NOT do: "if (fd < 0) goto say_false;" here. If there is no + * fd assume it isn't a socket - this covers PerlIO::scalar - + * otherwise unless we "know" the type probe for socket-ness. */ if (IoTYPE(io) && IoTYPE(io) != IoTYPE_PIPE && IoTYPE(io) != IoTYPE_STD && fd >= 0) { if (PerlLIO_fstat(fd,&PL_statbuf) < 0) { @@ -696,7 +696,10 @@ S_openn_cleanup(pTHX_ GV *gv, IO *io, PerlIO *fp, char *mode, const char *oname, is assigned to (say) STDOUT - for now let dup2() fail and provide the error */ - if (PerlLIO_dup2(fd, savefd) < 0) { + if (fd < 0) { + SETERRNO(EBADF,RMS_IFI); + goto say_false; + } else if (PerlLIO_dup2(fd, savefd) < 0) { (void)PerlIO_close(fp); goto say_false; } @@ -732,13 +735,23 @@ S_openn_cleanup(pTHX_ GV *gv, IO *io, PerlIO *fp, char *mode, const char *oname, if (was_fdopen) { /* need to close fp without closing underlying fd */ int ofd = PerlIO_fileno(fp); - int dupfd = PerlLIO_dup(ofd); + int dupfd = ofd >= 0 ? PerlLIO_dup(ofd) : -1; #if defined(HAS_FCNTL) && defined(F_SETFD) /* Assume if we have F_SETFD we have F_GETFD */ - int coe = fcntl(ofd,F_GETFD); + int coe = ofd >= 0 ? fcntl(ofd, F_GETFD) : -1; + if (coe < 0) { + if (dupfd >= 0) + PerlLIO_close(dupfd); + goto say_false; + } #endif + if (ofd < 0 || dupfd < 0) { + if (dupfd >= 0) + PerlLIO_close(dupfd); + goto say_false; + } PerlIO_close(fp); - PerlLIO_dup2(dupfd,ofd); + PerlLIO_dup2(dupfd, ofd); #if defined(HAS_FCNTL) && defined(F_SETFD) /* The dup trick has lost close-on-exec on ofd */ fcntl(ofd,F_SETFD, coe); @@ -755,8 +768,12 @@ S_openn_cleanup(pTHX_ GV *gv, IO *io, PerlIO *fp, char *mode, const char *oname, #if defined(HAS_FCNTL) && defined(F_SETFD) if (fd >= 0) { dSAVE_ERRNO; - fcntl(fd,F_SETFD,fd > PL_maxsysfd); /* can change errno */ + int rc = fcntl(fd,F_SETFD,fd > PL_maxsysfd); /* can change errno */ RESTORE_ERRNO; + if (rc < 0) { + PerlLIO_close(fd); + goto say_false; + } } #endif IoIFP(io) = fp; @@ -956,23 +973,25 @@ Perl_nextargv(pTHX_ GV *gv) } setdefout(PL_argvoutgv); PL_lastfd = PerlIO_fileno(IoIFP(GvIOp(PL_argvoutgv))); - (void)PerlLIO_fstat(PL_lastfd,&PL_statbuf); + if (PL_lastfd >= 0) { + (void)PerlLIO_fstat(PL_lastfd,&PL_statbuf); #ifdef HAS_FCHMOD - (void)fchmod(PL_lastfd,PL_filemode); + (void)fchmod(PL_lastfd,PL_filemode); #else - (void)PerlLIO_chmod(PL_oldname,PL_filemode); + (void)PerlLIO_chmod(PL_oldname,PL_filemode); #endif - if (fileuid != PL_statbuf.st_uid || filegid != PL_statbuf.st_gid) { - int rc = 0; + if (fileuid != PL_statbuf.st_uid || filegid != PL_statbuf.st_gid) { + int rc = 0; #ifdef HAS_FCHOWN - rc = fchown(PL_lastfd,fileuid,filegid); + rc = fchown(PL_lastfd,fileuid,filegid); #else #ifdef HAS_CHOWN - rc = PerlLIO_chown(PL_oldname,fileuid,filegid); + rc = PerlLIO_chown(PL_oldname,fileuid,filegid); #endif #endif - /* XXX silently ignore failures */ - PERL_UNUSED_VAR(rc); + /* XXX silently ignore failures */ + PERL_UNUSED_VAR(rc); + } } return IoIFP(GvIOp(gv)); } @@ -1169,8 +1188,12 @@ Perl_do_sysseek(pTHX_ GV *gv, Off_t pos, int whence) PERL_ARGS_ASSERT_DO_SYSSEEK; - if (io && (fp = IoIFP(io))) - return PerlLIO_lseek(PerlIO_fileno(fp), pos, whence); + if (io && (fp = IoIFP(io))) { + int fd = PerlIO_fileno(fp); + if (fd >= 0) { + return PerlLIO_lseek(fd, pos, whence); + } + } report_evil_fh(gv); SETERRNO(EBADF,RMS_IFI); return (Off_t)-1; @@ -1376,7 +1399,10 @@ Perl_my_stat_flags(pTHX_ const U32 flags) sv_setpvs(PL_statname, ""); if(io) { if (IoIFP(io)) { - return (PL_laststatval = PerlLIO_fstat(PerlIO_fileno(IoIFP(io)), &PL_statcache)); + int fd = PerlIO_fileno(IoIFP(io)); + if (fd >= 0) { + return (PL_laststatval = PerlLIO_fstat(fd, &PL_statcache)); + } } else if (IoDIRP(io)) { return (PL_laststatval = PerlLIO_fstat(my_dirfd(IoDIRP(io)), &PL_statcache)); } @@ -1739,9 +1765,13 @@ Perl_apply(pTHX_ I32 type, SV **mark, SV **sp) if ((gv = MAYBE_DEREF_GV(*mark))) { if (GvIO(gv) && IoIFP(GvIOp(gv))) { #ifdef HAS_FCHMOD + int fd = PerlIO_fileno(IoIFP(GvIOn(gv))); APPLY_TAINT_PROPER(); - if (fchmod(PerlIO_fileno(IoIFP(GvIOn(gv))), val)) - tot--; + if (fd < 0) { + SETERRNO(EBADF,RMS_IFI); + tot--; + } else if (fchmod(fd, val)) + tot--; #else Perl_die(aTHX_ PL_no_func, "fchmod"); #endif @@ -1775,8 +1805,12 @@ Perl_apply(pTHX_ I32 type, SV **mark, SV **sp) if ((gv = MAYBE_DEREF_GV(*mark))) { if (GvIO(gv) && IoIFP(GvIOp(gv))) { #ifdef HAS_FCHOWN + int fd = PerlIO_fileno(IoIFP(GvIOn(gv))); APPLY_TAINT_PROPER(); - if (fchown(PerlIO_fileno(IoIFP(GvIOn(gv))), val, val2)) + if (fd < 0) { + SETERRNO(EBADF,RMS_IFI); + tot--; + } else if (fchown(fd, val, val2)) tot--; #else Perl_die(aTHX_ PL_no_func, "fchown"); @@ -1965,9 +1999,12 @@ nothing in the core. if ((gv = MAYBE_DEREF_GV(*mark))) { if (GvIO(gv) && IoIFP(GvIOp(gv))) { #ifdef HAS_FUTIMES + int fd = PerlIO_fileno(IoIFP(GvIOn(gv))); APPLY_TAINT_PROPER(); - if (futimes(PerlIO_fileno(IoIFP(GvIOn(gv))), - (struct timeval *) utbufp)) + if (fd < 0) { + SETERRNO(EBADF,RMS_IFI); + tot--; + } else if (futimes(fd, (struct timeval *) utbufp)) tot--; #else Perl_die(aTHX_ PL_no_func, "futimes"); @@ -2082,15 +2119,17 @@ S_ingroup(pTHX_ Gid_t testgid, bool effective) bool rc = FALSE; anum = getgroups(0, gary); - Newx(gary, anum, Groups_t); - anum = getgroups(anum, gary); - while (--anum >= 0) - if (gary[anum] == testgid) { - rc = TRUE; - break; - } + if (anum > 0) { + Newx(gary, anum, Groups_t); + anum = getgroups(anum, gary); + while (--anum >= 0) + if (gary[anum] == testgid) { + rc = TRUE; + break; + } - Safefree(gary); + Safefree(gary); + } return rc; } #else diff --git a/ext/PerlIO-mmap/mmap.xs b/ext/PerlIO-mmap/mmap.xs index 4c96da8..6632544 100644 --- a/ext/PerlIO-mmap/mmap.xs +++ b/ext/PerlIO-mmap/mmap.xs @@ -40,8 +40,12 @@ PerlIOMmap_map(pTHX_ PerlIO *f) abort(); if (flags & PERLIO_F_CANREAD) { PerlIOBuf * const b = PerlIOSelf(f, PerlIOBuf); - const int fd = PerlIO_fileno(f); Stat_t st; + const int fd = PerlIO_fileno(f); + if (fd < 0) { + SETERRNO(EBADF,RMS_IFI); + return -1; + } code = Fstat(fd, &st); if (code == 0 && S_ISREG(st.st_mode)) { SSize_t len = st.st_size - b->posn; diff --git a/mg.c b/mg.c index 76912bd..6414349 100644 --- a/mg.c +++ b/mg.c @@ -1120,12 +1120,15 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg) #ifdef HAS_GETGROUPS { Groups_t *gary = NULL; - I32 i, num_groups = getgroups(0, gary); - Newx(gary, num_groups, Groups_t); - num_groups = getgroups(num_groups, gary); - for (i = 0; i < num_groups; i++) - Perl_sv_catpvf(aTHX_ sv, " %"IVdf, (IV)gary[i]); - Safefree(gary); + I32 i; + I32 num_groups = getgroups(0, gary); + if (num_groups > 0) { + Newx(gary, num_groups, Groups_t); + num_groups = getgroups(num_groups, gary); + for (i = 0; i < num_groups; i++) + Perl_sv_catpvf(aTHX_ sv, " %"IVdf, (IV)gary[i]); + Safefree(gary); + } } (void)SvIOK_on(sv); /* what a wonderful hack! */ #endif diff --git a/perl.c b/perl.c index 27d0d9e..6d38f8f 100644 --- a/perl.c +++ b/perl.c @@ -3691,6 +3691,7 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch, bool *suidscript) PerlIO *rsfp = NULL; dVAR; Stat_t tmpstatbuf; + int fd; PERL_ARGS_ASSERT_OPEN_SCRIPT; @@ -3796,13 +3797,21 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch, bool *suidscript) Perl_croak(aTHX_ "Can't open perl script \"%s\": %s\n", CopFILE(PL_curcop), Strerror(errno)); } + fd = PerlIO_fileno(rsfp); #if defined(HAS_FCNTL) && defined(F_SETFD) - /* ensure close-on-exec */ - fcntl(PerlIO_fileno(rsfp), F_SETFD, 1); + if (fd >= 0) { + /* ensure close-on-exec */ + if (fcntl(PerlIO_fileno(rsfp), F_SETFD, 1) < 0) { + Perl_croak(aTHX_ "Can't open perl script \"%s\": " + "fcntl close-on-exec failed\n", + CopFILE(PL_curcop)); + } + } #endif - if (PerlLIO_fstat(PerlIO_fileno(rsfp), &tmpstatbuf) >= 0 - && S_ISDIR(tmpstatbuf.st_mode)) + if (fd < 0 || + (PerlLIO_fstat(fd, &tmpstatbuf) >= 0 + && S_ISDIR(tmpstatbuf.st_mode))) Perl_croak(aTHX_ "Can't open perl script \"%s\": %s\n", CopFILE(PL_curcop), Strerror(EISDIR)); @@ -3833,12 +3842,18 @@ S_validate_suid(pTHX_ PerlIO *rsfp) if (my_euid != my_uid || my_egid != my_gid) { /* (suidperl doesn't exist, in fact) */ dVAR; - - PerlLIO_fstat(PerlIO_fileno(rsfp),&PL_statbuf); /* may be either wrapped or real suid */ - if ((my_euid != my_uid && my_euid == PL_statbuf.st_uid && PL_statbuf.st_mode & S_ISUID) - || - (my_egid != my_gid && my_egid == PL_statbuf.st_gid && PL_statbuf.st_mode & S_ISGID) - ) + int fd = PerlIO_fileno(rsfp); + if (fd < 0) { + Perl_croak(aTHX_ "Illegal suidscript"); + } else { + if (PerlLIO_fstat(fd, &PL_statbuf) < 0) { /* may be either wrapped or real suid */ + Perl_croak(aTHX_ "Illegal suidscript"); + } + } + if ((my_euid != my_uid && my_euid == PL_statbuf.st_uid && PL_statbuf.st_mode & S_ISUID) + || + (my_egid != my_gid && my_egid == PL_statbuf.st_gid && PL_statbuf.st_mode & S_ISGID) + ) if (!PL_do_undump) Perl_croak(aTHX_ "YOU HAVEN'T DISABLED SET-ID SCRIPTS IN THE KERNEL YET!\n\ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n"); diff --git a/perlio.c b/perlio.c index d4c43d0..4b98f6b 100644 --- a/perlio.c +++ b/perlio.c @@ -2923,6 +2923,10 @@ PerlIO_importFILE(FILE *stdio, const char *mode) PerlIO *f = NULL; if (stdio) { PerlIOStdio *s; + int fd0 = fileno(stdio); + if (fd0 < 0) { + return NULL; + } if (!mode || !*mode) { /* We need to probe to see how we can open the stream so start with read/write and then try write and read @@ -2931,8 +2935,12 @@ PerlIO_importFILE(FILE *stdio, const char *mode) Note that the errno value set by a failing fdopen varies between stdio implementations. */ - const int fd = PerlLIO_dup(fileno(stdio)); - FILE *f2 = PerlSIO_fdopen(fd, (mode = "r+")); + const int fd = PerlLIO_dup(fd0); + FILE *f2; + if (fd < 0) { + return f; + } + f2 = PerlSIO_fdopen(fd, (mode = "r+")); if (!f2) { f2 = PerlSIO_fdopen(fd, (mode = "w")); } @@ -3351,8 +3359,8 @@ PerlIOStdio_unread(pTHX_ PerlIO *f, const void *vbuf, Size_t count) } if ((STDCHAR*)PerlSIO_get_ptr(s) != --eptr || ((*eptr & 0xFF) != ch)) { /* Did not change pointer as expected */ - fgetc(s); /* get char back again */ - break; + if (fgetc(s) != EOF) /* get char back again */ + break; } /* It worked ! */ count--; @@ -3668,6 +3676,10 @@ PerlIO_exportFILE(PerlIO * f, const char *mode) FILE *stdio = NULL; if (PerlIOValid(f)) { char buf[8]; + int fd = PerlIO_fileno(f); + if (fd < 0) { + return NULL; + } PerlIO_flush(f); if (!mode || !*mode) { mode = PerlIO_modestr(f, buf); diff --git a/pod/perldiag.pod b/pod/perldiag.pod index bca95e2..df23cd3 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -2292,6 +2292,10 @@ The C<"+"> is valid only when followed by digits, indicating a capturing group. See L)>|perlre/(?PARNO) (?-PARNO) (?+PARNO) (?R) (?0)>. +=item Illegal suidscript + +(F) The script run under suidperl was somehow illegal. + =item Illegal switch in PERL5OPT: -%c (X) The PERL5OPT environment variable may only be used to set the diff --git a/pp_sys.c b/pp_sys.c index 9f97177..9ee7850 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -715,8 +715,10 @@ PP(pp_pipe_op) goto badexit; } #if defined(HAS_FCNTL) && defined(F_SETFD) - fcntl(fd[0],F_SETFD,fd[0] > PL_maxsysfd); /* ensure close-on-exec */ - fcntl(fd[1],F_SETFD,fd[1] > PL_maxsysfd); /* ensure close-on-exec */ + /* ensure close-on-exec */ + if ((fcntl(fd[0], F_SETFD,fd[0] > PL_maxsysfd) < 0) || + (fcntl(fd[1], F_SETFD,fd[1] > PL_maxsysfd) < 0)) + goto badexit; #endif RETPUSHYES; @@ -1616,7 +1618,7 @@ PP(pp_sysread) char *buffer; STRLEN orig_size; SSize_t length; - SSize_t count; + SSize_t count = -1; SV *bufsv; STRLEN blen; int fp_utf8; @@ -1682,6 +1684,11 @@ PP(pp_sysread) if (PL_op->op_type == OP_RECV) { Sock_size_t bufsize; char namebuf[MAXPATHLEN]; + int fd = PerlIO_fileno(IoIFP(io)); + if (fd < 0) { + SETERRNO(EBADF,RMS_IFI); + RETPUSHUNDEF; + } #if (defined(VMS_DO_SOCKETS) && defined(DECCRTL_SOCKETS)) || defined(__QNXNTO__) bufsize = sizeof (struct sockaddr_in); #else @@ -1693,7 +1700,7 @@ PP(pp_sysread) #endif buffer = SvGROW(bufsv, (STRLEN)(length+1)); /* 'offset' means 'flags' here */ - count = PerlSock_recvfrom(PerlIO_fileno(IoIFP(io)), buffer, length, offset, + count = PerlSock_recvfrom(fd, buffer, length, offset, (struct sockaddr *)namebuf, &bufsize); if (count < 0) RETPUSHUNDEF; @@ -1771,8 +1778,11 @@ PP(pp_sysread) else #endif { - count = PerlLIO_read(PerlIO_fileno(IoIFP(io)), - buffer, length); + int fd = PerlIO_fileno(IoIFP(io)); + if (fd < 0) + SETERRNO(EBADF,RMS_IFI); + else + count = PerlLIO_read(fd, buffer, length); } } else @@ -1848,7 +1858,7 @@ PP(pp_syswrite) dVAR; dSP; dMARK; dORIGMARK; dTARGET; SV *bufsv; const char *buffer; - SSize_t retval; + SSize_t retval = -1; STRLEN blen; STRLEN orig_blen_bytes; const int op_type = PL_op->op_type; @@ -1856,6 +1866,7 @@ PP(pp_syswrite) U8 *tmpbuf = NULL; GV *const gv = MUTABLE_GV(*++MARK); IO *const io = GvIO(gv); + int fd; if (op_type == OP_SYSWRITE && io) { const MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar); @@ -1915,17 +1926,21 @@ PP(pp_syswrite) } #ifdef HAS_SOCKET + fd = PerlIO_fileno(IoIFP(io)); + if (fd < 0) { + SETERRNO(EBADF,SS_IVCHAN); + goto say_undef; + } if (op_type == OP_SEND) { const int flags = SvIVx(*++MARK); if (SP > MARK) { STRLEN mlen; char * const sockbuf = SvPVx(*++MARK, mlen); - retval = PerlSock_sendto(PerlIO_fileno(IoIFP(io)), buffer, blen, + retval = PerlSock_sendto(fd, buffer, blen, flags, (struct sockaddr *)sockbuf, mlen); } else { - retval - = PerlSock_send(PerlIO_fileno(IoIFP(io)), buffer, blen, flags); + retval = PerlSock_send(fd, buffer, blen, flags); } } else @@ -2008,15 +2023,13 @@ PP(pp_syswrite) } #ifdef PERL_SOCK_SYSWRITE_IS_SEND if (IoTYPE(io) == IoTYPE_SOCKET) { - retval = PerlSock_send(PerlIO_fileno(IoIFP(io)), - buffer, length, 0); + retval = PerlSock_send(fd, buffer, length, 0); } else #endif { /* See the note at doio.c:do_print about filesize limits. --jhi */ - retval = PerlLIO_write(PerlIO_fileno(IoIFP(io)), - buffer, length); + retval = PerlLIO_write(fd, buffer, length); } } @@ -2224,13 +2237,18 @@ PP(pp_truncate) result = 0; } else { - PerlIO_flush(fp); + int fd = PerlIO_fileno(fp); + if (fd < 0) + SETERRNO(EBADF,RMS_IFI); + else { + PerlIO_flush(fp); #ifdef HAS_TRUNCATE - if (ftruncate(PerlIO_fileno(fp), len) < 0) + if (ftruncate(fd, len) < 0) #else - if (my_chsize(PerlIO_fileno(fp), len) < 0) + if (my_chsize(fd, len) < 0) #endif - result = 0; + result = 0; + } } } } @@ -2248,9 +2266,10 @@ PP(pp_truncate) { const int tmpfd = PerlLIO_open(name, O_RDWR); - if (tmpfd < 0) + if (tmpfd < 0) { + SETERRNO(EBADF,RMS_IFI); result = 0; - else { + } else { if (my_chsize(tmpfd, len) < 0) result = 0; PerlLIO_close(tmpfd); @@ -2388,8 +2407,10 @@ PP(pp_socket) TAINT_PROPER("socket"); fd = PerlSock_socket(domain, type, protocol); - if (fd < 0) + if (fd < 0) { + SETERRNO(EBADF,RMS_IFI); RETPUSHUNDEF; + } IoIFP(io) = PerlIO_fdopen(fd, "r"SOCKET_OPEN_MODE); /* stdio gets confused about sockets */ IoOFP(io) = PerlIO_fdopen(fd, "w"SOCKET_OPEN_MODE); IoTYPE(io) = IoTYPE_SOCKET; @@ -2400,7 +2421,8 @@ PP(pp_socket) RETPUSHUNDEF; } #if defined(HAS_FCNTL) && defined(F_SETFD) - fcntl(fd, F_SETFD, fd > PL_maxsysfd); /* ensure close-on-exec */ + if (fcntl(fd, F_SETFD, fd > PL_maxsysfd) < 0) /* ensure close-on-exec */ + RETPUSHUNDEF; #endif RETPUSHYES; @@ -2445,8 +2467,10 @@ PP(pp_sockpair) RETPUSHUNDEF; } #if defined(HAS_FCNTL) && defined(F_SETFD) - fcntl(fd[0],F_SETFD,fd[0] > PL_maxsysfd); /* ensure close-on-exec */ - fcntl(fd[1],F_SETFD,fd[1] > PL_maxsysfd); /* ensure close-on-exec */ + /* ensure close-on-exec */ + if ((fcntl(fd[0],F_SETFD,fd[0] > PL_maxsysfd) < 0) || + (fcntl(fd[1],F_SETFD,fd[1] > PL_maxsysfd) < 0)) + RETPUSHUNDEF; #endif RETPUSHYES; @@ -2467,16 +2491,20 @@ PP(pp_bind) IO * const io = GvIOn(gv); STRLEN len; int op_type; + int fd; if (!IoIFP(io)) goto nuts; + fd = PerlIO_fileno(IoIFP(io)); + if (fd < 0) + goto nuts; addr = SvPV_const(addrsv, len); op_type = PL_op->op_type; TAINT_PROPER(PL_op_desc[op_type]); if ((op_type == OP_BIND - ? PerlSock_bind(PerlIO_fileno(IoIFP(io)), (struct sockaddr *)addr, len) - : PerlSock_connect(PerlIO_fileno(IoIFP(io)), (struct sockaddr *)addr, len)) + ? PerlSock_bind(fd, (struct sockaddr *)addr, len) + : PerlSock_connect(fd, (struct sockaddr *)addr, len)) >= 0) RETPUSHYES; else @@ -2554,7 +2582,8 @@ PP(pp_accept) goto badexit; } #if defined(HAS_FCNTL) && defined(F_SETFD) - fcntl(fd, F_SETFD, fd > PL_maxsysfd); /* ensure close-on-exec */ + if (fcntl(fd, F_SETFD, fd > PL_maxsysfd) < 0) /* ensure close-on-exec */ + goto badexit; #endif #ifdef __SCO_VERSION__ @@ -2608,6 +2637,8 @@ PP(pp_ssockopt) goto nuts; fd = PerlIO_fileno(IoIFP(io)); + if (fd < 0) + goto nuts; switch (optype) { case OP_GSOCKOPT: SvGROW(sv, 257); @@ -2683,6 +2714,8 @@ PP(pp_getpeername) SvCUR_set(sv, len); *SvEND(sv) ='\0'; fd = PerlIO_fileno(IoIFP(io)); + if (fd < 0) + goto nuts; switch (optype) { case OP_GETSOCKNAME: if (PerlSock_getsockname(fd, (struct sockaddr *)SvPVX(sv), &len) < 0) @@ -2764,9 +2797,14 @@ PP(pp_stat) } if (io) { if (IoIFP(io)) { - PL_laststatval = - PerlLIO_fstat(PerlIO_fileno(IoIFP(io)), &PL_statcache); - havefp = TRUE; + int fd = PerlIO_fileno(IoIFP(io)); + if (fd < 0) { + PL_laststatval = -1; + SETERRNO(EBADF,RMS_IFI); + } else { + PL_laststatval = PerlLIO_fstat(fd, &PL_statcache); + havefp = TRUE; + } } else if (IoDIRP(io)) { PL_laststatval = PerlLIO_fstat(my_dirfd(IoDIRP(io)), &PL_statcache); @@ -3256,9 +3294,13 @@ PP(pp_fttty) if (GvIO(gv) && IoIFP(GvIOp(gv))) fd = PerlIO_fileno(IoIFP(GvIOp(gv))); else if (name && isDIGIT(*name)) - fd = atoi(name); + fd = atoi(name); else FT_RETURNUNDEF; + if (fd < 0) { + SETERRNO(EBADF,RMS_IFI); + FT_RETURNUNDEF; + } if (PerlLIO_isatty(fd)) FT_RETURNYES; FT_RETURNNO; @@ -3307,9 +3349,15 @@ PP(pp_fttext) PL_laststatval = -1; PL_laststype = OP_STAT; if (io && IoIFP(io)) { + int fd; if (! PerlIO_has_base(IoIFP(io))) DIE(aTHX_ "-T and -B not implemented on filehandles"); - PL_laststatval = PerlLIO_fstat(PerlIO_fileno(IoIFP(io)), &PL_statcache); + fd = PerlIO_fileno(IoIFP(io)); + if (fd < 0) { + SETERRNO(EBADF,RMS_IFI); + FT_RETURNUNDEF; + } + PL_laststatval = PerlLIO_fstat(fd, &PL_statcache); if (PL_laststatval < 0) FT_RETURNUNDEF; if (S_ISDIR(PL_statcache.st_mode)) { /* handle NFS glitch */ @@ -3339,6 +3387,7 @@ PP(pp_fttext) } } else { + int fd; sv_setpv(PL_statname, SvPV_nomg_const_nolen(sv)); really_filename: PL_statgv = NULL; @@ -3358,9 +3407,16 @@ PP(pp_fttext) FT_RETURNUNDEF; } PL_laststype = OP_STAT; - PL_laststatval = PerlLIO_fstat(PerlIO_fileno(fp), &PL_statcache); + fd = PerlIO_fileno(fp); + if (fd < 0) { + (void)PerlIO_close(fp); + SETERRNO(EBADF,RMS_IFI); + FT_RETURNUNDEF; + } + PL_laststatval = PerlLIO_fstat(fd, &PL_statcache); if (PL_laststatval < 0) { (void)PerlIO_close(fp); + SETERRNO(EBADF,RMS_IFI); FT_RETURNUNDEF; } PerlIO_binmode(aTHX_ fp, '<', O_BINARY, NULL); @@ -3475,19 +3531,19 @@ PP(pp_chdir) if (IoDIRP(io)) { PUSHi(fchdir(my_dirfd(IoDIRP(io))) >= 0); } else if (IoIFP(io)) { - PUSHi(fchdir(PerlIO_fileno(IoIFP(io))) >= 0); + int fd = PerlIO_fileno(IoIFP(io)); + if (fd < 0) { + goto nuts; + } + PUSHi(fchdir(fd) >= 0); } else { - report_evil_fh(gv); - SETERRNO(EBADF, RMS_IFI); - PUSHi(0); + goto nuts; } + } else { + goto nuts; } - else { - report_evil_fh(gv); - SETERRNO(EBADF,RMS_IFI); - PUSHi(0); - } + #else DIE(aTHX_ PL_no_func, "fchdir"); #endif @@ -3500,6 +3556,12 @@ PP(pp_chdir) hv_delete(GvHVn(PL_envgv),"DEFAULT",7,G_DISCARD); #endif RETURN; + + nuts: + report_evil_fh(gv); + SETERRNO(EBADF,RMS_IFI); + PUSHi(0); + RETURN; } PP(pp_chown) @@ -4194,7 +4256,8 @@ PP(pp_system) if (did_pipes) { PerlLIO_close(pp[0]); #if defined(HAS_FCNTL) && defined(F_SETFD) - fcntl(pp[1], F_SETFD, FD_CLOEXEC); + if (fcntl(pp[1], F_SETFD, FD_CLOEXEC) < 0) + RETPUSHUNDEF; #endif } if (PL_op->op_flags & OPf_STACKED) { diff --git a/util.c b/util.c index 0a0ee40..343bf72 100644 --- a/util.c +++ b/util.c @@ -1710,13 +1710,16 @@ void Perl_croak_no_mem(void) { dTHX; - int rc; - /* Can't use PerlIO to write as it allocates memory */ - rc = PerlLIO_write(PerlIO_fileno(Perl_error_log), - PL_no_mem, sizeof(PL_no_mem)-1); - /* silently ignore failures */ - PERL_UNUSED_VAR(rc); + int fd = PerlIO_fileno(Perl_error_log); + if (fd < 0) + SETERRNO(EBADF,RMS_IFI); + else { + /* Can't use PerlIO to write as it allocates memory */ + int rc = PerlLIO_write(fd, PL_no_mem, sizeof(PL_no_mem)-1); + /* silently ignore failures */ + PERL_UNUSED_VAR(rc); + } my_exit(1); } @@ -2308,7 +2311,8 @@ Perl_my_popen_list(pTHX_ const char *mode, int n, SV **args) PerlLIO_close(pp[0]); #if defined(HAS_FCNTL) && defined(F_SETFD) /* Close error pipe automatically if exec works */ - fcntl(pp[1], F_SETFD, FD_CLOEXEC); + if (fcntl(pp[1], F_SETFD, FD_CLOEXEC) < 0) + return NULL; #endif } /* Now dup our end of _the_ pipe to right position */ @@ -2453,7 +2457,8 @@ Perl_my_popen(pTHX_ const char *cmd, const char *mode) if (did_pipes) { PerlLIO_close(pp[0]); #if defined(HAS_FCNTL) && defined(F_SETFD) - fcntl(pp[1], F_SETFD, FD_CLOEXEC); + if (fcntl(pp[1], F_SETFD, FD_CLOEXEC) < 0) + return NULL; #endif } if (p[THIS] != (*mode == 'r')) { -- 1.9.2 ```

[p5pRT]

From @jhi

On Friday-201405-02\, 22​:27\, Jarkko Hietaniemi wrote​:

On Thursday-201405-01\, 17​:05\, Jarkko Hietaniemi wrote​:

Yet again refreshed patch\, found two more spots with the same potentially negative fd use.

I decided to merge this ticket with perl #121745 which checked for fcntl failure paths\, since there's a lot of functional overlap​: (1) a fd from fileno being checked against \< 0\, and then (2) the fd being fed to fcntl\, the return value of which we want to check for failure (3) in one actual case of a merge conflict (in perl.c) because the changes for these two checks were too close for comfort

So updated combined patch attached\, and please ignore/merge #121745.

... and refreshed. With a fresh cup of coffee found an embarrassing typo of fd\<0 when fd>=0 was meant (on a memory-alloc-failed path​: in general we can't easily test those...)

[p5pRT]

From @jhi

0001-Check-fileno-numgroups-1-check-fcntl-fgetc-failures.patch

```diff From 461ec0f1ae80b32b3b046159a69c950cc7261ff2 Mon Sep 17 00:00:00 2001 From: Jarkko Hietaniemi Date: Fri, 2 May 2014 22:12:24 -0400 Subject: [PATCH] Check fileno/numgroups -1, check fcntl (+fgetc) failures. (merged fix for perl #121743 and perl #121745) --- dist/IO/IO.xs | 12 +++- dist/threads/threads.xs | 10 ++-- doio.c | 105 +++++++++++++++++++++++----------- ext/PerlIO-mmap/mmap.xs | 6 +- mg.c | 15 +++-- perl.c | 35 ++++++++---- perlio.c | 20 +++++-- pod/perldiag.pod | 4 ++ pp_sys.c | 149 ++++++++++++++++++++++++++++++++++-------------- util.c | 21 ++++--- 10 files changed, 265 insertions(+), 112 deletions(-) diff --git a/dist/IO/IO.xs b/dist/IO/IO.xs index 9056cb6..d7fe0a0 100644 --- a/dist/IO/IO.xs +++ b/dist/IO/IO.xs @@ -524,9 +524,15 @@ fsync(arg) handle = IoOFP(sv_2io(arg)); if (!handle) handle = IoIFP(sv_2io(arg)); - if(handle) - RETVAL = fsync(PerlIO_fileno(handle)); - else { + if (handle) { + int fd = PerlIO_fileno(handle); + if (fd >= 0) { + RETVAL = fsync(fd); + } else { + RETVAL = -1; + errno = EINVAL; + } + } else { RETVAL = -1; errno = EINVAL; } diff --git a/dist/threads/threads.xs b/dist/threads/threads.xs index 8537165..90c61ff 100644 --- a/dist/threads/threads.xs +++ b/dist/threads/threads.xs @@ -713,11 +713,13 @@ S_ithread_create( } PERL_SET_CONTEXT(aTHX); if (!thread) { - int rc; MUTEX_UNLOCK(&MY_POOL.create_destruct_mutex); - rc = PerlLIO_write(PerlIO_fileno(Perl_error_log), - PL_no_mem, strlen(PL_no_mem)); - PERL_UNUSED_VAR(rc); + int fd = PerlIO_fileno(Perl_error_log); + if (fd >= 0) { + /* If there's no error_log, we cannot scream about it missing. */ + int rc = PerlLIO_write(fd, PL_no_mem, strlen(PL_no_mem)); + PERL_UNUSED_VAR(rc); + } my_exit(1); } Zero(thread, 1, ithread); diff --git a/doio.c b/doio.c index e2bfda5..26c0032 100644 --- a/doio.c +++ b/doio.c @@ -646,9 +646,9 @@ S_openn_cleanup(pTHX_ GV *gv, IO *io, PerlIO *fp, char *mode, const char *oname, } fd = PerlIO_fileno(fp); - /* If there is no fd (e.g. PerlIO::scalar) assume it isn't a - * socket - this covers PerlIO::scalar - otherwise unless we "know" the - * type probe for socket-ness. + /* Do NOT do: "if (fd < 0) goto say_false;" here. If there is no + * fd assume it isn't a socket - this covers PerlIO::scalar - + * otherwise unless we "know" the type probe for socket-ness. */ if (IoTYPE(io) && IoTYPE(io) != IoTYPE_PIPE && IoTYPE(io) != IoTYPE_STD && fd >= 0) { if (PerlLIO_fstat(fd,&PL_statbuf) < 0) { @@ -696,7 +696,10 @@ S_openn_cleanup(pTHX_ GV *gv, IO *io, PerlIO *fp, char *mode, const char *oname, is assigned to (say) STDOUT - for now let dup2() fail and provide the error */ - if (PerlLIO_dup2(fd, savefd) < 0) { + if (fd < 0) { + SETERRNO(EBADF,RMS_IFI); + goto say_false; + } else if (PerlLIO_dup2(fd, savefd) < 0) { (void)PerlIO_close(fp); goto say_false; } @@ -732,13 +735,23 @@ S_openn_cleanup(pTHX_ GV *gv, IO *io, PerlIO *fp, char *mode, const char *oname, if (was_fdopen) { /* need to close fp without closing underlying fd */ int ofd = PerlIO_fileno(fp); - int dupfd = PerlLIO_dup(ofd); + int dupfd = ofd >= 0 ? PerlLIO_dup(ofd) : -1; #if defined(HAS_FCNTL) && defined(F_SETFD) /* Assume if we have F_SETFD we have F_GETFD */ - int coe = fcntl(ofd,F_GETFD); + int coe = ofd >= 0 ? fcntl(ofd, F_GETFD) : -1; + if (coe < 0) { + if (dupfd >= 0) + PerlLIO_close(dupfd); + goto say_false; + } #endif + if (ofd < 0 || dupfd < 0) { + if (dupfd >= 0) + PerlLIO_close(dupfd); + goto say_false; + } PerlIO_close(fp); - PerlLIO_dup2(dupfd,ofd); + PerlLIO_dup2(dupfd, ofd); #if defined(HAS_FCNTL) && defined(F_SETFD) /* The dup trick has lost close-on-exec on ofd */ fcntl(ofd,F_SETFD, coe); @@ -755,8 +768,12 @@ S_openn_cleanup(pTHX_ GV *gv, IO *io, PerlIO *fp, char *mode, const char *oname, #if defined(HAS_FCNTL) && defined(F_SETFD) if (fd >= 0) { dSAVE_ERRNO; - fcntl(fd,F_SETFD,fd > PL_maxsysfd); /* can change errno */ + int rc = fcntl(fd,F_SETFD,fd > PL_maxsysfd); /* can change errno */ RESTORE_ERRNO; + if (rc < 0) { + PerlLIO_close(fd); + goto say_false; + } } #endif IoIFP(io) = fp; @@ -956,23 +973,25 @@ Perl_nextargv(pTHX_ GV *gv) } setdefout(PL_argvoutgv); PL_lastfd = PerlIO_fileno(IoIFP(GvIOp(PL_argvoutgv))); - (void)PerlLIO_fstat(PL_lastfd,&PL_statbuf); + if (PL_lastfd >= 0) { + (void)PerlLIO_fstat(PL_lastfd,&PL_statbuf); #ifdef HAS_FCHMOD - (void)fchmod(PL_lastfd,PL_filemode); + (void)fchmod(PL_lastfd,PL_filemode); #else - (void)PerlLIO_chmod(PL_oldname,PL_filemode); + (void)PerlLIO_chmod(PL_oldname,PL_filemode); #endif - if (fileuid != PL_statbuf.st_uid || filegid != PL_statbuf.st_gid) { - int rc = 0; + if (fileuid != PL_statbuf.st_uid || filegid != PL_statbuf.st_gid) { + int rc = 0; #ifdef HAS_FCHOWN - rc = fchown(PL_lastfd,fileuid,filegid); + rc = fchown(PL_lastfd,fileuid,filegid); #else #ifdef HAS_CHOWN - rc = PerlLIO_chown(PL_oldname,fileuid,filegid); + rc = PerlLIO_chown(PL_oldname,fileuid,filegid); #endif #endif - /* XXX silently ignore failures */ - PERL_UNUSED_VAR(rc); + /* XXX silently ignore failures */ + PERL_UNUSED_VAR(rc); + } } return IoIFP(GvIOp(gv)); } @@ -1169,8 +1188,12 @@ Perl_do_sysseek(pTHX_ GV *gv, Off_t pos, int whence) PERL_ARGS_ASSERT_DO_SYSSEEK; - if (io && (fp = IoIFP(io))) - return PerlLIO_lseek(PerlIO_fileno(fp), pos, whence); + if (io && (fp = IoIFP(io))) { + int fd = PerlIO_fileno(fp); + if (fd >= 0) { + return PerlLIO_lseek(fd, pos, whence); + } + } report_evil_fh(gv); SETERRNO(EBADF,RMS_IFI); return (Off_t)-1; @@ -1376,7 +1399,10 @@ Perl_my_stat_flags(pTHX_ const U32 flags) sv_setpvs(PL_statname, ""); if(io) { if (IoIFP(io)) { - return (PL_laststatval = PerlLIO_fstat(PerlIO_fileno(IoIFP(io)), &PL_statcache)); + int fd = PerlIO_fileno(IoIFP(io)); + if (fd >= 0) { + return (PL_laststatval = PerlLIO_fstat(fd, &PL_statcache)); + } } else if (IoDIRP(io)) { return (PL_laststatval = PerlLIO_fstat(my_dirfd(IoDIRP(io)), &PL_statcache)); } @@ -1739,9 +1765,13 @@ Perl_apply(pTHX_ I32 type, SV **mark, SV **sp) if ((gv = MAYBE_DEREF_GV(*mark))) { if (GvIO(gv) && IoIFP(GvIOp(gv))) { #ifdef HAS_FCHMOD + int fd = PerlIO_fileno(IoIFP(GvIOn(gv))); APPLY_TAINT_PROPER(); - if (fchmod(PerlIO_fileno(IoIFP(GvIOn(gv))), val)) - tot--; + if (fd < 0) { + SETERRNO(EBADF,RMS_IFI); + tot--; + } else if (fchmod(fd, val)) + tot--; #else Perl_die(aTHX_ PL_no_func, "fchmod"); #endif @@ -1775,8 +1805,12 @@ Perl_apply(pTHX_ I32 type, SV **mark, SV **sp) if ((gv = MAYBE_DEREF_GV(*mark))) { if (GvIO(gv) && IoIFP(GvIOp(gv))) { #ifdef HAS_FCHOWN + int fd = PerlIO_fileno(IoIFP(GvIOn(gv))); APPLY_TAINT_PROPER(); - if (fchown(PerlIO_fileno(IoIFP(GvIOn(gv))), val, val2)) + if (fd < 0) { + SETERRNO(EBADF,RMS_IFI); + tot--; + } else if (fchown(fd, val, val2)) tot--; #else Perl_die(aTHX_ PL_no_func, "fchown"); @@ -1965,9 +1999,12 @@ nothing in the core. if ((gv = MAYBE_DEREF_GV(*mark))) { if (GvIO(gv) && IoIFP(GvIOp(gv))) { #ifdef HAS_FUTIMES + int fd = PerlIO_fileno(IoIFP(GvIOn(gv))); APPLY_TAINT_PROPER(); - if (futimes(PerlIO_fileno(IoIFP(GvIOn(gv))), - (struct timeval *) utbufp)) + if (fd < 0) { + SETERRNO(EBADF,RMS_IFI); + tot--; + } else if (futimes(fd, (struct timeval *) utbufp)) tot--; #else Perl_die(aTHX_ PL_no_func, "futimes"); @@ -2082,15 +2119,17 @@ S_ingroup(pTHX_ Gid_t testgid, bool effective) bool rc = FALSE; anum = getgroups(0, gary); - Newx(gary, anum, Groups_t); - anum = getgroups(anum, gary); - while (--anum >= 0) - if (gary[anum] == testgid) { - rc = TRUE; - break; - } + if (anum > 0) { + Newx(gary, anum, Groups_t); + anum = getgroups(anum, gary); + while (--anum >= 0) + if (gary[anum] == testgid) { + rc = TRUE; + break; + } - Safefree(gary); + Safefree(gary); + } return rc; } #else diff --git a/ext/PerlIO-mmap/mmap.xs b/ext/PerlIO-mmap/mmap.xs index 4c96da8..6632544 100644 --- a/ext/PerlIO-mmap/mmap.xs +++ b/ext/PerlIO-mmap/mmap.xs @@ -40,8 +40,12 @@ PerlIOMmap_map(pTHX_ PerlIO *f) abort(); if (flags & PERLIO_F_CANREAD) { PerlIOBuf * const b = PerlIOSelf(f, PerlIOBuf); - const int fd = PerlIO_fileno(f); Stat_t st; + const int fd = PerlIO_fileno(f); + if (fd < 0) { + SETERRNO(EBADF,RMS_IFI); + return -1; + } code = Fstat(fd, &st); if (code == 0 && S_ISREG(st.st_mode)) { SSize_t len = st.st_size - b->posn; diff --git a/mg.c b/mg.c index 76912bd..6414349 100644 --- a/mg.c +++ b/mg.c @@ -1120,12 +1120,15 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg) #ifdef HAS_GETGROUPS { Groups_t *gary = NULL; - I32 i, num_groups = getgroups(0, gary); - Newx(gary, num_groups, Groups_t); - num_groups = getgroups(num_groups, gary); - for (i = 0; i < num_groups; i++) - Perl_sv_catpvf(aTHX_ sv, " %"IVdf, (IV)gary[i]); - Safefree(gary); + I32 i; + I32 num_groups = getgroups(0, gary); + if (num_groups > 0) { + Newx(gary, num_groups, Groups_t); + num_groups = getgroups(num_groups, gary); + for (i = 0; i < num_groups; i++) + Perl_sv_catpvf(aTHX_ sv, " %"IVdf, (IV)gary[i]); + Safefree(gary); + } } (void)SvIOK_on(sv); /* what a wonderful hack! */ #endif diff --git a/perl.c b/perl.c index 27d0d9e..6d38f8f 100644 --- a/perl.c +++ b/perl.c @@ -3691,6 +3691,7 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch, bool *suidscript) PerlIO *rsfp = NULL; dVAR; Stat_t tmpstatbuf; + int fd; PERL_ARGS_ASSERT_OPEN_SCRIPT; @@ -3796,13 +3797,21 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch, bool *suidscript) Perl_croak(aTHX_ "Can't open perl script \"%s\": %s\n", CopFILE(PL_curcop), Strerror(errno)); } + fd = PerlIO_fileno(rsfp); #if defined(HAS_FCNTL) && defined(F_SETFD) - /* ensure close-on-exec */ - fcntl(PerlIO_fileno(rsfp), F_SETFD, 1); + if (fd >= 0) { + /* ensure close-on-exec */ + if (fcntl(PerlIO_fileno(rsfp), F_SETFD, 1) < 0) { + Perl_croak(aTHX_ "Can't open perl script \"%s\": " + "fcntl close-on-exec failed\n", + CopFILE(PL_curcop)); + } + } #endif - if (PerlLIO_fstat(PerlIO_fileno(rsfp), &tmpstatbuf) >= 0 - && S_ISDIR(tmpstatbuf.st_mode)) + if (fd < 0 || + (PerlLIO_fstat(fd, &tmpstatbuf) >= 0 + && S_ISDIR(tmpstatbuf.st_mode))) Perl_croak(aTHX_ "Can't open perl script \"%s\": %s\n", CopFILE(PL_curcop), Strerror(EISDIR)); @@ -3833,12 +3842,18 @@ S_validate_suid(pTHX_ PerlIO *rsfp) if (my_euid != my_uid || my_egid != my_gid) { /* (suidperl doesn't exist, in fact) */ dVAR; - - PerlLIO_fstat(PerlIO_fileno(rsfp),&PL_statbuf); /* may be either wrapped or real suid */ - if ((my_euid != my_uid && my_euid == PL_statbuf.st_uid && PL_statbuf.st_mode & S_ISUID) - || - (my_egid != my_gid && my_egid == PL_statbuf.st_gid && PL_statbuf.st_mode & S_ISGID) - ) + int fd = PerlIO_fileno(rsfp); + if (fd < 0) { + Perl_croak(aTHX_ "Illegal suidscript"); + } else { + if (PerlLIO_fstat(fd, &PL_statbuf) < 0) { /* may be either wrapped or real suid */ + Perl_croak(aTHX_ "Illegal suidscript"); + } + } + if ((my_euid != my_uid && my_euid == PL_statbuf.st_uid && PL_statbuf.st_mode & S_ISUID) + || + (my_egid != my_gid && my_egid == PL_statbuf.st_gid && PL_statbuf.st_mode & S_ISGID) + ) if (!PL_do_undump) Perl_croak(aTHX_ "YOU HAVEN'T DISABLED SET-ID SCRIPTS IN THE KERNEL YET!\n\ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n"); diff --git a/perlio.c b/perlio.c index d4c43d0..4b98f6b 100644 --- a/perlio.c +++ b/perlio.c @@ -2923,6 +2923,10 @@ PerlIO_importFILE(FILE *stdio, const char *mode) PerlIO *f = NULL; if (stdio) { PerlIOStdio *s; + int fd0 = fileno(stdio); + if (fd0 < 0) { + return NULL; + } if (!mode || !*mode) { /* We need to probe to see how we can open the stream so start with read/write and then try write and read @@ -2931,8 +2935,12 @@ PerlIO_importFILE(FILE *stdio, const char *mode) Note that the errno value set by a failing fdopen varies between stdio implementations. */ - const int fd = PerlLIO_dup(fileno(stdio)); - FILE *f2 = PerlSIO_fdopen(fd, (mode = "r+")); + const int fd = PerlLIO_dup(fd0); + FILE *f2; + if (fd < 0) { + return f; + } + f2 = PerlSIO_fdopen(fd, (mode = "r+")); if (!f2) { f2 = PerlSIO_fdopen(fd, (mode = "w")); } @@ -3351,8 +3359,8 @@ PerlIOStdio_unread(pTHX_ PerlIO *f, const void *vbuf, Size_t count) } if ((STDCHAR*)PerlSIO_get_ptr(s) != --eptr || ((*eptr & 0xFF) != ch)) { /* Did not change pointer as expected */ - fgetc(s); /* get char back again */ - break; + if (fgetc(s) != EOF) /* get char back again */ + break; } /* It worked ! */ count--; @@ -3668,6 +3676,10 @@ PerlIO_exportFILE(PerlIO * f, const char *mode) FILE *stdio = NULL; if (PerlIOValid(f)) { char buf[8]; + int fd = PerlIO_fileno(f); + if (fd < 0) { + return NULL; + } PerlIO_flush(f); if (!mode || !*mode) { mode = PerlIO_modestr(f, buf); diff --git a/pod/perldiag.pod b/pod/perldiag.pod index bca95e2..df23cd3 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -2292,6 +2292,10 @@ The C<"+"> is valid only when followed by digits, indicating a capturing group. See L)>|perlre/(?PARNO) (?-PARNO) (?+PARNO) (?R) (?0)>. +=item Illegal suidscript + +(F) The script run under suidperl was somehow illegal. + =item Illegal switch in PERL5OPT: -%c (X) The PERL5OPT environment variable may only be used to set the diff --git a/pp_sys.c b/pp_sys.c index 9f97177..9ee7850 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -715,8 +715,10 @@ PP(pp_pipe_op) goto badexit; } #if defined(HAS_FCNTL) && defined(F_SETFD) - fcntl(fd[0],F_SETFD,fd[0] > PL_maxsysfd); /* ensure close-on-exec */ - fcntl(fd[1],F_SETFD,fd[1] > PL_maxsysfd); /* ensure close-on-exec */ + /* ensure close-on-exec */ + if ((fcntl(fd[0], F_SETFD,fd[0] > PL_maxsysfd) < 0) || + (fcntl(fd[1], F_SETFD,fd[1] > PL_maxsysfd) < 0)) + goto badexit; #endif RETPUSHYES; @@ -1616,7 +1618,7 @@ PP(pp_sysread) char *buffer; STRLEN orig_size; SSize_t length; - SSize_t count; + SSize_t count = -1; SV *bufsv; STRLEN blen; int fp_utf8; @@ -1682,6 +1684,11 @@ PP(pp_sysread) if (PL_op->op_type == OP_RECV) { Sock_size_t bufsize; char namebuf[MAXPATHLEN]; + int fd = PerlIO_fileno(IoIFP(io)); + if (fd < 0) { + SETERRNO(EBADF,RMS_IFI); + RETPUSHUNDEF; + } #if (defined(VMS_DO_SOCKETS) && defined(DECCRTL_SOCKETS)) || defined(__QNXNTO__) bufsize = sizeof (struct sockaddr_in); #else @@ -1693,7 +1700,7 @@ PP(pp_sysread) #endif buffer = SvGROW(bufsv, (STRLEN)(length+1)); /* 'offset' means 'flags' here */ - count = PerlSock_recvfrom(PerlIO_fileno(IoIFP(io)), buffer, length, offset, + count = PerlSock_recvfrom(fd, buffer, length, offset, (struct sockaddr *)namebuf, &bufsize); if (count < 0) RETPUSHUNDEF; @@ -1771,8 +1778,11 @@ PP(pp_sysread) else #endif { - count = PerlLIO_read(PerlIO_fileno(IoIFP(io)), - buffer, length); + int fd = PerlIO_fileno(IoIFP(io)); + if (fd < 0) + SETERRNO(EBADF,RMS_IFI); + else + count = PerlLIO_read(fd, buffer, length); } } else @@ -1848,7 +1858,7 @@ PP(pp_syswrite) dVAR; dSP; dMARK; dORIGMARK; dTARGET; SV *bufsv; const char *buffer; - SSize_t retval; + SSize_t retval = -1; STRLEN blen; STRLEN orig_blen_bytes; const int op_type = PL_op->op_type; @@ -1856,6 +1866,7 @@ PP(pp_syswrite) U8 *tmpbuf = NULL; GV *const gv = MUTABLE_GV(*++MARK); IO *const io = GvIO(gv); + int fd; if (op_type == OP_SYSWRITE && io) { const MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar); @@ -1915,17 +1926,21 @@ PP(pp_syswrite) } #ifdef HAS_SOCKET + fd = PerlIO_fileno(IoIFP(io)); + if (fd < 0) { + SETERRNO(EBADF,SS_IVCHAN); + goto say_undef; + } if (op_type == OP_SEND) { const int flags = SvIVx(*++MARK); if (SP > MARK) { STRLEN mlen; char * const sockbuf = SvPVx(*++MARK, mlen); - retval = PerlSock_sendto(PerlIO_fileno(IoIFP(io)), buffer, blen, + retval = PerlSock_sendto(fd, buffer, blen, flags, (struct sockaddr *)sockbuf, mlen); } else { - retval - = PerlSock_send(PerlIO_fileno(IoIFP(io)), buffer, blen, flags); + retval = PerlSock_send(fd, buffer, blen, flags); } } else @@ -2008,15 +2023,13 @@ PP(pp_syswrite) } #ifdef PERL_SOCK_SYSWRITE_IS_SEND if (IoTYPE(io) == IoTYPE_SOCKET) { - retval = PerlSock_send(PerlIO_fileno(IoIFP(io)), - buffer, length, 0); + retval = PerlSock_send(fd, buffer, length, 0); } else #endif { /* See the note at doio.c:do_print about filesize limits. --jhi */ - retval = PerlLIO_write(PerlIO_fileno(IoIFP(io)), - buffer, length); + retval = PerlLIO_write(fd, buffer, length); } } @@ -2224,13 +2237,18 @@ PP(pp_truncate) result = 0; } else { - PerlIO_flush(fp); + int fd = PerlIO_fileno(fp); + if (fd < 0) + SETERRNO(EBADF,RMS_IFI); + else { + PerlIO_flush(fp); #ifdef HAS_TRUNCATE - if (ftruncate(PerlIO_fileno(fp), len) < 0) + if (ftruncate(fd, len) < 0) #else - if (my_chsize(PerlIO_fileno(fp), len) < 0) + if (my_chsize(fd, len) < 0) #endif - result = 0; + result = 0; + } } } } @@ -2248,9 +2266,10 @@ PP(pp_truncate) { const int tmpfd = PerlLIO_open(name, O_RDWR); - if (tmpfd < 0) + if (tmpfd < 0) { + SETERRNO(EBADF,RMS_IFI); result = 0; - else { + } else { if (my_chsize(tmpfd, len) < 0) result = 0; PerlLIO_close(tmpfd); @@ -2388,8 +2407,10 @@ PP(pp_socket) TAINT_PROPER("socket"); fd = PerlSock_socket(domain, type, protocol); - if (fd < 0) + if (fd < 0) { + SETERRNO(EBADF,RMS_IFI); RETPUSHUNDEF; + } IoIFP(io) = PerlIO_fdopen(fd, "r"SOCKET_OPEN_MODE); /* stdio gets confused about sockets */ IoOFP(io) = PerlIO_fdopen(fd, "w"SOCKET_OPEN_MODE); IoTYPE(io) = IoTYPE_SOCKET; @@ -2400,7 +2421,8 @@ PP(pp_socket) RETPUSHUNDEF; } #if defined(HAS_FCNTL) && defined(F_SETFD) - fcntl(fd, F_SETFD, fd > PL_maxsysfd); /* ensure close-on-exec */ + if (fcntl(fd, F_SETFD, fd > PL_maxsysfd) < 0) /* ensure close-on-exec */ + RETPUSHUNDEF; #endif RETPUSHYES; @@ -2445,8 +2467,10 @@ PP(pp_sockpair) RETPUSHUNDEF; } #if defined(HAS_FCNTL) && defined(F_SETFD) - fcntl(fd[0],F_SETFD,fd[0] > PL_maxsysfd); /* ensure close-on-exec */ - fcntl(fd[1],F_SETFD,fd[1] > PL_maxsysfd); /* ensure close-on-exec */ + /* ensure close-on-exec */ + if ((fcntl(fd[0],F_SETFD,fd[0] > PL_maxsysfd) < 0) || + (fcntl(fd[1],F_SETFD,fd[1] > PL_maxsysfd) < 0)) + RETPUSHUNDEF; #endif RETPUSHYES; @@ -2467,16 +2491,20 @@ PP(pp_bind) IO * const io = GvIOn(gv); STRLEN len; int op_type; + int fd; if (!IoIFP(io)) goto nuts; + fd = PerlIO_fileno(IoIFP(io)); + if (fd < 0) + goto nuts; addr = SvPV_const(addrsv, len); op_type = PL_op->op_type; TAINT_PROPER(PL_op_desc[op_type]); if ((op_type == OP_BIND - ? PerlSock_bind(PerlIO_fileno(IoIFP(io)), (struct sockaddr *)addr, len) - : PerlSock_connect(PerlIO_fileno(IoIFP(io)), (struct sockaddr *)addr, len)) + ? PerlSock_bind(fd, (struct sockaddr *)addr, len) + : PerlSock_connect(fd, (struct sockaddr *)addr, len)) >= 0) RETPUSHYES; else @@ -2554,7 +2582,8 @@ PP(pp_accept) goto badexit; } #if defined(HAS_FCNTL) && defined(F_SETFD) - fcntl(fd, F_SETFD, fd > PL_maxsysfd); /* ensure close-on-exec */ + if (fcntl(fd, F_SETFD, fd > PL_maxsysfd) < 0) /* ensure close-on-exec */ + goto badexit; #endif #ifdef __SCO_VERSION__ @@ -2608,6 +2637,8 @@ PP(pp_ssockopt) goto nuts; fd = PerlIO_fileno(IoIFP(io)); + if (fd < 0) + goto nuts; switch (optype) { case OP_GSOCKOPT: SvGROW(sv, 257); @@ -2683,6 +2714,8 @@ PP(pp_getpeername) SvCUR_set(sv, len); *SvEND(sv) ='\0'; fd = PerlIO_fileno(IoIFP(io)); + if (fd < 0) + goto nuts; switch (optype) { case OP_GETSOCKNAME: if (PerlSock_getsockname(fd, (struct sockaddr *)SvPVX(sv), &len) < 0) @@ -2764,9 +2797,14 @@ PP(pp_stat) } if (io) { if (IoIFP(io)) { - PL_laststatval = - PerlLIO_fstat(PerlIO_fileno(IoIFP(io)), &PL_statcache); - havefp = TRUE; + int fd = PerlIO_fileno(IoIFP(io)); + if (fd < 0) { + PL_laststatval = -1; + SETERRNO(EBADF,RMS_IFI); + } else { + PL_laststatval = PerlLIO_fstat(fd, &PL_statcache); + havefp = TRUE; + } } else if (IoDIRP(io)) { PL_laststatval = PerlLIO_fstat(my_dirfd(IoDIRP(io)), &PL_statcache); @@ -3256,9 +3294,13 @@ PP(pp_fttty) if (GvIO(gv) && IoIFP(GvIOp(gv))) fd = PerlIO_fileno(IoIFP(GvIOp(gv))); else if (name && isDIGIT(*name)) - fd = atoi(name); + fd = atoi(name); else FT_RETURNUNDEF; + if (fd < 0) { + SETERRNO(EBADF,RMS_IFI); + FT_RETURNUNDEF; + } if (PerlLIO_isatty(fd)) FT_RETURNYES; FT_RETURNNO; @@ -3307,9 +3349,15 @@ PP(pp_fttext) PL_laststatval = -1; PL_laststype = OP_STAT; if (io && IoIFP(io)) { + int fd; if (! PerlIO_has_base(IoIFP(io))) DIE(aTHX_ "-T and -B not implemented on filehandles"); - PL_laststatval = PerlLIO_fstat(PerlIO_fileno(IoIFP(io)), &PL_statcache); + fd = PerlIO_fileno(IoIFP(io)); + if (fd < 0) { + SETERRNO(EBADF,RMS_IFI); + FT_RETURNUNDEF; + } + PL_laststatval = PerlLIO_fstat(fd, &PL_statcache); if (PL_laststatval < 0) FT_RETURNUNDEF; if (S_ISDIR(PL_statcache.st_mode)) { /* handle NFS glitch */ @@ -3339,6 +3387,7 @@ PP(pp_fttext) } } else { + int fd; sv_setpv(PL_statname, SvPV_nomg_const_nolen(sv)); really_filename: PL_statgv = NULL; @@ -3358,9 +3407,16 @@ PP(pp_fttext) FT_RETURNUNDEF; } PL_laststype = OP_STAT; - PL_laststatval = PerlLIO_fstat(PerlIO_fileno(fp), &PL_statcache); + fd = PerlIO_fileno(fp); + if (fd < 0) { + (void)PerlIO_close(fp); + SETERRNO(EBADF,RMS_IFI); + FT_RETURNUNDEF; + } + PL_laststatval = PerlLIO_fstat(fd, &PL_statcache); if (PL_laststatval < 0) { (void)PerlIO_close(fp); + SETERRNO(EBADF,RMS_IFI); FT_RETURNUNDEF; } PerlIO_binmode(aTHX_ fp, '<', O_BINARY, NULL); @@ -3475,19 +3531,19 @@ PP(pp_chdir) if (IoDIRP(io)) { PUSHi(fchdir(my_dirfd(IoDIRP(io))) >= 0); } else if (IoIFP(io)) { - PUSHi(fchdir(PerlIO_fileno(IoIFP(io))) >= 0); + int fd = PerlIO_fileno(IoIFP(io)); + if (fd < 0) { + goto nuts; + } + PUSHi(fchdir(fd) >= 0); } else { - report_evil_fh(gv); - SETERRNO(EBADF, RMS_IFI); - PUSHi(0); + goto nuts; } + } else { + goto nuts; } - else { - report_evil_fh(gv); - SETERRNO(EBADF,RMS_IFI); - PUSHi(0); - } + #else DIE(aTHX_ PL_no_func, "fchdir"); #endif @@ -3500,6 +3556,12 @@ PP(pp_chdir) hv_delete(GvHVn(PL_envgv),"DEFAULT",7,G_DISCARD); #endif RETURN; + + nuts: + report_evil_fh(gv); + SETERRNO(EBADF,RMS_IFI); + PUSHi(0); + RETURN; } PP(pp_chown) @@ -4194,7 +4256,8 @@ PP(pp_system) if (did_pipes) { PerlLIO_close(pp[0]); #if defined(HAS_FCNTL) && defined(F_SETFD) - fcntl(pp[1], F_SETFD, FD_CLOEXEC); + if (fcntl(pp[1], F_SETFD, FD_CLOEXEC) < 0) + RETPUSHUNDEF; #endif } if (PL_op->op_flags & OPf_STACKED) { diff --git a/util.c b/util.c index 0a0ee40..343bf72 100644 --- a/util.c +++ b/util.c @@ -1710,13 +1710,16 @@ void Perl_croak_no_mem(void) { dTHX; - int rc; - /* Can't use PerlIO to write as it allocates memory */ - rc = PerlLIO_write(PerlIO_fileno(Perl_error_log), - PL_no_mem, sizeof(PL_no_mem)-1); - /* silently ignore failures */ - PERL_UNUSED_VAR(rc); + int fd = PerlIO_fileno(Perl_error_log); + if (fd < 0) + SETERRNO(EBADF,RMS_IFI); + else { + /* Can't use PerlIO to write as it allocates memory */ + int rc = PerlLIO_write(fd, PL_no_mem, sizeof(PL_no_mem)-1); + /* silently ignore failures */ + PERL_UNUSED_VAR(rc); + } my_exit(1); } @@ -2308,7 +2311,8 @@ Perl_my_popen_list(pTHX_ const char *mode, int n, SV **args) PerlLIO_close(pp[0]); #if defined(HAS_FCNTL) && defined(F_SETFD) /* Close error pipe automatically if exec works */ - fcntl(pp[1], F_SETFD, FD_CLOEXEC); + if (fcntl(pp[1], F_SETFD, FD_CLOEXEC) < 0) + return NULL; #endif } /* Now dup our end of _the_ pipe to right position */ @@ -2453,7 +2457,8 @@ Perl_my_popen(pTHX_ const char *cmd, const char *mode) if (did_pipes) { PerlLIO_close(pp[0]); #if defined(HAS_FCNTL) && defined(F_SETFD) - fcntl(pp[1], F_SETFD, FD_CLOEXEC); + if (fcntl(pp[1], F_SETFD, FD_CLOEXEC) < 0) + return NULL; #endif } if (p[THIS] != (*mode == 'r')) { -- 1.9.2 ```

[p5pRT]

From @jhi

On Saturday-201405-03\, 8​:30\, Jarkko Hietaniemi wrote​:

On Friday-201405-02\, 22​:27\, Jarkko Hietaniemi wrote​:

On Thursday-201405-01\, 17​:05\, Jarkko Hietaniemi wrote​:

Yet again refreshed patch\, found two more spots with the same potentially negative fd use.

I decided to merge this ticket with perl #121745 which checked for fcntl failure paths\, since there's a lot of functional overlap​: (1) a fd from fileno being checked against \< 0\, and then (2) the fd being fed to fcntl\, the return value of which we want to check for failure (3) in one actual case of a merge conflict (in perl.c) because the changes for these two checks were too close for comfort

So updated combined patch attached\, and please ignore/merge #121745.

... and refreshed. With a fresh cup of coffee found an embarrassing typo of fd\<0 when fd>=0 was meant (on a memory-alloc-failed path​: in general we can't easily test those...)

..and yet again\, to fix a failure in t/porting/diag.

[p5pRT]

From @jhi

0001-Check-fileno-numgroups-1-check-fcntl-fgetc-failures.patch

```diff From 66c482f9ddfb43c6e4e36a37d140891cf9e121a6 Mon Sep 17 00:00:00 2001 From: Jarkko Hietaniemi Date: Fri, 2 May 2014 22:12:24 -0400 Subject: [PATCH] Check fileno/numgroups -1, check fcntl (+fgetc) failures. (merged fix for perl #121743 and perl #121745) --- dist/IO/IO.xs | 12 +++- dist/threads/threads.xs | 10 ++-- doio.c | 105 +++++++++++++++++++++++----------- ext/PerlIO-mmap/mmap.xs | 6 +- mg.c | 15 +++-- perl.c | 36 ++++++++---- perlio.c | 20 +++++-- pod/perldiag.pod | 4 ++ pp_sys.c | 149 ++++++++++++++++++++++++++++++++++-------------- util.c | 21 ++++--- 10 files changed, 266 insertions(+), 112 deletions(-) diff --git a/dist/IO/IO.xs b/dist/IO/IO.xs index 9056cb6..d7fe0a0 100644 --- a/dist/IO/IO.xs +++ b/dist/IO/IO.xs @@ -524,9 +524,15 @@ fsync(arg) handle = IoOFP(sv_2io(arg)); if (!handle) handle = IoIFP(sv_2io(arg)); - if(handle) - RETVAL = fsync(PerlIO_fileno(handle)); - else { + if (handle) { + int fd = PerlIO_fileno(handle); + if (fd >= 0) { + RETVAL = fsync(fd); + } else { + RETVAL = -1; + errno = EINVAL; + } + } else { RETVAL = -1; errno = EINVAL; } diff --git a/dist/threads/threads.xs b/dist/threads/threads.xs index 8537165..90c61ff 100644 --- a/dist/threads/threads.xs +++ b/dist/threads/threads.xs @@ -713,11 +713,13 @@ S_ithread_create( } PERL_SET_CONTEXT(aTHX); if (!thread) { - int rc; MUTEX_UNLOCK(&MY_POOL.create_destruct_mutex); - rc = PerlLIO_write(PerlIO_fileno(Perl_error_log), - PL_no_mem, strlen(PL_no_mem)); - PERL_UNUSED_VAR(rc); + int fd = PerlIO_fileno(Perl_error_log); + if (fd >= 0) { + /* If there's no error_log, we cannot scream about it missing. */ + int rc = PerlLIO_write(fd, PL_no_mem, strlen(PL_no_mem)); + PERL_UNUSED_VAR(rc); + } my_exit(1); } Zero(thread, 1, ithread); diff --git a/doio.c b/doio.c index e2bfda5..26c0032 100644 --- a/doio.c +++ b/doio.c @@ -646,9 +646,9 @@ S_openn_cleanup(pTHX_ GV *gv, IO *io, PerlIO *fp, char *mode, const char *oname, } fd = PerlIO_fileno(fp); - /* If there is no fd (e.g. PerlIO::scalar) assume it isn't a - * socket - this covers PerlIO::scalar - otherwise unless we "know" the - * type probe for socket-ness. + /* Do NOT do: "if (fd < 0) goto say_false;" here. If there is no + * fd assume it isn't a socket - this covers PerlIO::scalar - + * otherwise unless we "know" the type probe for socket-ness. */ if (IoTYPE(io) && IoTYPE(io) != IoTYPE_PIPE && IoTYPE(io) != IoTYPE_STD && fd >= 0) { if (PerlLIO_fstat(fd,&PL_statbuf) < 0) { @@ -696,7 +696,10 @@ S_openn_cleanup(pTHX_ GV *gv, IO *io, PerlIO *fp, char *mode, const char *oname, is assigned to (say) STDOUT - for now let dup2() fail and provide the error */ - if (PerlLIO_dup2(fd, savefd) < 0) { + if (fd < 0) { + SETERRNO(EBADF,RMS_IFI); + goto say_false; + } else if (PerlLIO_dup2(fd, savefd) < 0) { (void)PerlIO_close(fp); goto say_false; } @@ -732,13 +735,23 @@ S_openn_cleanup(pTHX_ GV *gv, IO *io, PerlIO *fp, char *mode, const char *oname, if (was_fdopen) { /* need to close fp without closing underlying fd */ int ofd = PerlIO_fileno(fp); - int dupfd = PerlLIO_dup(ofd); + int dupfd = ofd >= 0 ? PerlLIO_dup(ofd) : -1; #if defined(HAS_FCNTL) && defined(F_SETFD) /* Assume if we have F_SETFD we have F_GETFD */ - int coe = fcntl(ofd,F_GETFD); + int coe = ofd >= 0 ? fcntl(ofd, F_GETFD) : -1; + if (coe < 0) { + if (dupfd >= 0) + PerlLIO_close(dupfd); + goto say_false; + } #endif + if (ofd < 0 || dupfd < 0) { + if (dupfd >= 0) + PerlLIO_close(dupfd); + goto say_false; + } PerlIO_close(fp); - PerlLIO_dup2(dupfd,ofd); + PerlLIO_dup2(dupfd, ofd); #if defined(HAS_FCNTL) && defined(F_SETFD) /* The dup trick has lost close-on-exec on ofd */ fcntl(ofd,F_SETFD, coe); @@ -755,8 +768,12 @@ S_openn_cleanup(pTHX_ GV *gv, IO *io, PerlIO *fp, char *mode, const char *oname, #if defined(HAS_FCNTL) && defined(F_SETFD) if (fd >= 0) { dSAVE_ERRNO; - fcntl(fd,F_SETFD,fd > PL_maxsysfd); /* can change errno */ + int rc = fcntl(fd,F_SETFD,fd > PL_maxsysfd); /* can change errno */ RESTORE_ERRNO; + if (rc < 0) { + PerlLIO_close(fd); + goto say_false; + } } #endif IoIFP(io) = fp; @@ -956,23 +973,25 @@ Perl_nextargv(pTHX_ GV *gv) } setdefout(PL_argvoutgv); PL_lastfd = PerlIO_fileno(IoIFP(GvIOp(PL_argvoutgv))); - (void)PerlLIO_fstat(PL_lastfd,&PL_statbuf); + if (PL_lastfd >= 0) { + (void)PerlLIO_fstat(PL_lastfd,&PL_statbuf); #ifdef HAS_FCHMOD - (void)fchmod(PL_lastfd,PL_filemode); + (void)fchmod(PL_lastfd,PL_filemode); #else - (void)PerlLIO_chmod(PL_oldname,PL_filemode); + (void)PerlLIO_chmod(PL_oldname,PL_filemode); #endif - if (fileuid != PL_statbuf.st_uid || filegid != PL_statbuf.st_gid) { - int rc = 0; + if (fileuid != PL_statbuf.st_uid || filegid != PL_statbuf.st_gid) { + int rc = 0; #ifdef HAS_FCHOWN - rc = fchown(PL_lastfd,fileuid,filegid); + rc = fchown(PL_lastfd,fileuid,filegid); #else #ifdef HAS_CHOWN - rc = PerlLIO_chown(PL_oldname,fileuid,filegid); + rc = PerlLIO_chown(PL_oldname,fileuid,filegid); #endif #endif - /* XXX silently ignore failures */ - PERL_UNUSED_VAR(rc); + /* XXX silently ignore failures */ + PERL_UNUSED_VAR(rc); + } } return IoIFP(GvIOp(gv)); } @@ -1169,8 +1188,12 @@ Perl_do_sysseek(pTHX_ GV *gv, Off_t pos, int whence) PERL_ARGS_ASSERT_DO_SYSSEEK; - if (io && (fp = IoIFP(io))) - return PerlLIO_lseek(PerlIO_fileno(fp), pos, whence); + if (io && (fp = IoIFP(io))) { + int fd = PerlIO_fileno(fp); + if (fd >= 0) { + return PerlLIO_lseek(fd, pos, whence); + } + } report_evil_fh(gv); SETERRNO(EBADF,RMS_IFI); return (Off_t)-1; @@ -1376,7 +1399,10 @@ Perl_my_stat_flags(pTHX_ const U32 flags) sv_setpvs(PL_statname, ""); if(io) { if (IoIFP(io)) { - return (PL_laststatval = PerlLIO_fstat(PerlIO_fileno(IoIFP(io)), &PL_statcache)); + int fd = PerlIO_fileno(IoIFP(io)); + if (fd >= 0) { + return (PL_laststatval = PerlLIO_fstat(fd, &PL_statcache)); + } } else if (IoDIRP(io)) { return (PL_laststatval = PerlLIO_fstat(my_dirfd(IoDIRP(io)), &PL_statcache)); } @@ -1739,9 +1765,13 @@ Perl_apply(pTHX_ I32 type, SV **mark, SV **sp) if ((gv = MAYBE_DEREF_GV(*mark))) { if (GvIO(gv) && IoIFP(GvIOp(gv))) { #ifdef HAS_FCHMOD + int fd = PerlIO_fileno(IoIFP(GvIOn(gv))); APPLY_TAINT_PROPER(); - if (fchmod(PerlIO_fileno(IoIFP(GvIOn(gv))), val)) - tot--; + if (fd < 0) { + SETERRNO(EBADF,RMS_IFI); + tot--; + } else if (fchmod(fd, val)) + tot--; #else Perl_die(aTHX_ PL_no_func, "fchmod"); #endif @@ -1775,8 +1805,12 @@ Perl_apply(pTHX_ I32 type, SV **mark, SV **sp) if ((gv = MAYBE_DEREF_GV(*mark))) { if (GvIO(gv) && IoIFP(GvIOp(gv))) { #ifdef HAS_FCHOWN + int fd = PerlIO_fileno(IoIFP(GvIOn(gv))); APPLY_TAINT_PROPER(); - if (fchown(PerlIO_fileno(IoIFP(GvIOn(gv))), val, val2)) + if (fd < 0) { + SETERRNO(EBADF,RMS_IFI); + tot--; + } else if (fchown(fd, val, val2)) tot--; #else Perl_die(aTHX_ PL_no_func, "fchown"); @@ -1965,9 +1999,12 @@ nothing in the core. if ((gv = MAYBE_DEREF_GV(*mark))) { if (GvIO(gv) && IoIFP(GvIOp(gv))) { #ifdef HAS_FUTIMES + int fd = PerlIO_fileno(IoIFP(GvIOn(gv))); APPLY_TAINT_PROPER(); - if (futimes(PerlIO_fileno(IoIFP(GvIOn(gv))), - (struct timeval *) utbufp)) + if (fd < 0) { + SETERRNO(EBADF,RMS_IFI); + tot--; + } else if (futimes(fd, (struct timeval *) utbufp)) tot--; #else Perl_die(aTHX_ PL_no_func, "futimes"); @@ -2082,15 +2119,17 @@ S_ingroup(pTHX_ Gid_t testgid, bool effective) bool rc = FALSE; anum = getgroups(0, gary); - Newx(gary, anum, Groups_t); - anum = getgroups(anum, gary); - while (--anum >= 0) - if (gary[anum] == testgid) { - rc = TRUE; - break; - } + if (anum > 0) { + Newx(gary, anum, Groups_t); + anum = getgroups(anum, gary); + while (--anum >= 0) + if (gary[anum] == testgid) { + rc = TRUE; + break; + } - Safefree(gary); + Safefree(gary); + } return rc; } #else diff --git a/ext/PerlIO-mmap/mmap.xs b/ext/PerlIO-mmap/mmap.xs index 4c96da8..6632544 100644 --- a/ext/PerlIO-mmap/mmap.xs +++ b/ext/PerlIO-mmap/mmap.xs @@ -40,8 +40,12 @@ PerlIOMmap_map(pTHX_ PerlIO *f) abort(); if (flags & PERLIO_F_CANREAD) { PerlIOBuf * const b = PerlIOSelf(f, PerlIOBuf); - const int fd = PerlIO_fileno(f); Stat_t st; + const int fd = PerlIO_fileno(f); + if (fd < 0) { + SETERRNO(EBADF,RMS_IFI); + return -1; + } code = Fstat(fd, &st); if (code == 0 && S_ISREG(st.st_mode)) { SSize_t len = st.st_size - b->posn; diff --git a/mg.c b/mg.c index 76912bd..6414349 100644 --- a/mg.c +++ b/mg.c @@ -1120,12 +1120,15 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg) #ifdef HAS_GETGROUPS { Groups_t *gary = NULL; - I32 i, num_groups = getgroups(0, gary); - Newx(gary, num_groups, Groups_t); - num_groups = getgroups(num_groups, gary); - for (i = 0; i < num_groups; i++) - Perl_sv_catpvf(aTHX_ sv, " %"IVdf, (IV)gary[i]); - Safefree(gary); + I32 i; + I32 num_groups = getgroups(0, gary); + if (num_groups > 0) { + Newx(gary, num_groups, Groups_t); + num_groups = getgroups(num_groups, gary); + for (i = 0; i < num_groups; i++) + Perl_sv_catpvf(aTHX_ sv, " %"IVdf, (IV)gary[i]); + Safefree(gary); + } } (void)SvIOK_on(sv); /* what a wonderful hack! */ #endif diff --git a/perl.c b/perl.c index 27d0d9e..d55a13e 100644 --- a/perl.c +++ b/perl.c @@ -3691,6 +3691,7 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch, bool *suidscript) PerlIO *rsfp = NULL; dVAR; Stat_t tmpstatbuf; + int fd; PERL_ARGS_ASSERT_OPEN_SCRIPT; @@ -3796,13 +3797,22 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch, bool *suidscript) Perl_croak(aTHX_ "Can't open perl script \"%s\": %s\n", CopFILE(PL_curcop), Strerror(errno)); } + fd = PerlIO_fileno(rsfp); #if defined(HAS_FCNTL) && defined(F_SETFD) - /* ensure close-on-exec */ - fcntl(PerlIO_fileno(rsfp), F_SETFD, 1); + if (fd >= 0) { + /* ensure close-on-exec */ + if (fcntl(PerlIO_fileno(rsfp), F_SETFD, 1) < 0) { + /* diag_listed_as: Can't open perl script: "%s": %s */ + Perl_croak(aTHX_ "Can't open perl script \"%s\": " + "fcntl close-on-exec failed\n", + CopFILE(PL_curcop)); + } + } #endif - if (PerlLIO_fstat(PerlIO_fileno(rsfp), &tmpstatbuf) >= 0 - && S_ISDIR(tmpstatbuf.st_mode)) + if (fd < 0 || + (PerlLIO_fstat(fd, &tmpstatbuf) >= 0 + && S_ISDIR(tmpstatbuf.st_mode))) Perl_croak(aTHX_ "Can't open perl script \"%s\": %s\n", CopFILE(PL_curcop), Strerror(EISDIR)); @@ -3833,12 +3843,18 @@ S_validate_suid(pTHX_ PerlIO *rsfp) if (my_euid != my_uid || my_egid != my_gid) { /* (suidperl doesn't exist, in fact) */ dVAR; - - PerlLIO_fstat(PerlIO_fileno(rsfp),&PL_statbuf); /* may be either wrapped or real suid */ - if ((my_euid != my_uid && my_euid == PL_statbuf.st_uid && PL_statbuf.st_mode & S_ISUID) - || - (my_egid != my_gid && my_egid == PL_statbuf.st_gid && PL_statbuf.st_mode & S_ISGID) - ) + int fd = PerlIO_fileno(rsfp); + if (fd < 0) { + Perl_croak(aTHX_ "Illegal suidscript"); + } else { + if (PerlLIO_fstat(fd, &PL_statbuf) < 0) { /* may be either wrapped or real suid */ + Perl_croak(aTHX_ "Illegal suidscript"); + } + } + if ((my_euid != my_uid && my_euid == PL_statbuf.st_uid && PL_statbuf.st_mode & S_ISUID) + || + (my_egid != my_gid && my_egid == PL_statbuf.st_gid && PL_statbuf.st_mode & S_ISGID) + ) if (!PL_do_undump) Perl_croak(aTHX_ "YOU HAVEN'T DISABLED SET-ID SCRIPTS IN THE KERNEL YET!\n\ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n"); diff --git a/perlio.c b/perlio.c index d4c43d0..4b98f6b 100644 --- a/perlio.c +++ b/perlio.c @@ -2923,6 +2923,10 @@ PerlIO_importFILE(FILE *stdio, const char *mode) PerlIO *f = NULL; if (stdio) { PerlIOStdio *s; + int fd0 = fileno(stdio); + if (fd0 < 0) { + return NULL; + } if (!mode || !*mode) { /* We need to probe to see how we can open the stream so start with read/write and then try write and read @@ -2931,8 +2935,12 @@ PerlIO_importFILE(FILE *stdio, const char *mode) Note that the errno value set by a failing fdopen varies between stdio implementations. */ - const int fd = PerlLIO_dup(fileno(stdio)); - FILE *f2 = PerlSIO_fdopen(fd, (mode = "r+")); + const int fd = PerlLIO_dup(fd0); + FILE *f2; + if (fd < 0) { + return f; + } + f2 = PerlSIO_fdopen(fd, (mode = "r+")); if (!f2) { f2 = PerlSIO_fdopen(fd, (mode = "w")); } @@ -3351,8 +3359,8 @@ PerlIOStdio_unread(pTHX_ PerlIO *f, const void *vbuf, Size_t count) } if ((STDCHAR*)PerlSIO_get_ptr(s) != --eptr || ((*eptr & 0xFF) != ch)) { /* Did not change pointer as expected */ - fgetc(s); /* get char back again */ - break; + if (fgetc(s) != EOF) /* get char back again */ + break; } /* It worked ! */ count--; @@ -3668,6 +3676,10 @@ PerlIO_exportFILE(PerlIO * f, const char *mode) FILE *stdio = NULL; if (PerlIOValid(f)) { char buf[8]; + int fd = PerlIO_fileno(f); + if (fd < 0) { + return NULL; + } PerlIO_flush(f); if (!mode || !*mode) { mode = PerlIO_modestr(f, buf); diff --git a/pod/perldiag.pod b/pod/perldiag.pod index bca95e2..df23cd3 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -2292,6 +2292,10 @@ The C<"+"> is valid only when followed by digits, indicating a capturing group. See L)>|perlre/(?PARNO) (?-PARNO) (?+PARNO) (?R) (?0)>. +=item Illegal suidscript + +(F) The script run under suidperl was somehow illegal. + =item Illegal switch in PERL5OPT: -%c (X) The PERL5OPT environment variable may only be used to set the diff --git a/pp_sys.c b/pp_sys.c index 9f97177..9ee7850 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -715,8 +715,10 @@ PP(pp_pipe_op) goto badexit; } #if defined(HAS_FCNTL) && defined(F_SETFD) - fcntl(fd[0],F_SETFD,fd[0] > PL_maxsysfd); /* ensure close-on-exec */ - fcntl(fd[1],F_SETFD,fd[1] > PL_maxsysfd); /* ensure close-on-exec */ + /* ensure close-on-exec */ + if ((fcntl(fd[0], F_SETFD,fd[0] > PL_maxsysfd) < 0) || + (fcntl(fd[1], F_SETFD,fd[1] > PL_maxsysfd) < 0)) + goto badexit; #endif RETPUSHYES; @@ -1616,7 +1618,7 @@ PP(pp_sysread) char *buffer; STRLEN orig_size; SSize_t length; - SSize_t count; + SSize_t count = -1; SV *bufsv; STRLEN blen; int fp_utf8; @@ -1682,6 +1684,11 @@ PP(pp_sysread) if (PL_op->op_type == OP_RECV) { Sock_size_t bufsize; char namebuf[MAXPATHLEN]; + int fd = PerlIO_fileno(IoIFP(io)); + if (fd < 0) { + SETERRNO(EBADF,RMS_IFI); + RETPUSHUNDEF; + } #if (defined(VMS_DO_SOCKETS) && defined(DECCRTL_SOCKETS)) || defined(__QNXNTO__) bufsize = sizeof (struct sockaddr_in); #else @@ -1693,7 +1700,7 @@ PP(pp_sysread) #endif buffer = SvGROW(bufsv, (STRLEN)(length+1)); /* 'offset' means 'flags' here */ - count = PerlSock_recvfrom(PerlIO_fileno(IoIFP(io)), buffer, length, offset, + count = PerlSock_recvfrom(fd, buffer, length, offset, (struct sockaddr *)namebuf, &bufsize); if (count < 0) RETPUSHUNDEF; @@ -1771,8 +1778,11 @@ PP(pp_sysread) else #endif { - count = PerlLIO_read(PerlIO_fileno(IoIFP(io)), - buffer, length); + int fd = PerlIO_fileno(IoIFP(io)); + if (fd < 0) + SETERRNO(EBADF,RMS_IFI); + else + count = PerlLIO_read(fd, buffer, length); } } else @@ -1848,7 +1858,7 @@ PP(pp_syswrite) dVAR; dSP; dMARK; dORIGMARK; dTARGET; SV *bufsv; const char *buffer; - SSize_t retval; + SSize_t retval = -1; STRLEN blen; STRLEN orig_blen_bytes; const int op_type = PL_op->op_type; @@ -1856,6 +1866,7 @@ PP(pp_syswrite) U8 *tmpbuf = NULL; GV *const gv = MUTABLE_GV(*++MARK); IO *const io = GvIO(gv); + int fd; if (op_type == OP_SYSWRITE && io) { const MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar); @@ -1915,17 +1926,21 @@ PP(pp_syswrite) } #ifdef HAS_SOCKET + fd = PerlIO_fileno(IoIFP(io)); + if (fd < 0) { + SETERRNO(EBADF,SS_IVCHAN); + goto say_undef; + } if (op_type == OP_SEND) { const int flags = SvIVx(*++MARK); if (SP > MARK) { STRLEN mlen; char * const sockbuf = SvPVx(*++MARK, mlen); - retval = PerlSock_sendto(PerlIO_fileno(IoIFP(io)), buffer, blen, + retval = PerlSock_sendto(fd, buffer, blen, flags, (struct sockaddr *)sockbuf, mlen); } else { - retval - = PerlSock_send(PerlIO_fileno(IoIFP(io)), buffer, blen, flags); + retval = PerlSock_send(fd, buffer, blen, flags); } } else @@ -2008,15 +2023,13 @@ PP(pp_syswrite) } #ifdef PERL_SOCK_SYSWRITE_IS_SEND if (IoTYPE(io) == IoTYPE_SOCKET) { - retval = PerlSock_send(PerlIO_fileno(IoIFP(io)), - buffer, length, 0); + retval = PerlSock_send(fd, buffer, length, 0); } else #endif { /* See the note at doio.c:do_print about filesize limits. --jhi */ - retval = PerlLIO_write(PerlIO_fileno(IoIFP(io)), - buffer, length); + retval = PerlLIO_write(fd, buffer, length); } } @@ -2224,13 +2237,18 @@ PP(pp_truncate) result = 0; } else { - PerlIO_flush(fp); + int fd = PerlIO_fileno(fp); + if (fd < 0) + SETERRNO(EBADF,RMS_IFI); + else { + PerlIO_flush(fp); #ifdef HAS_TRUNCATE - if (ftruncate(PerlIO_fileno(fp), len) < 0) + if (ftruncate(fd, len) < 0) #else - if (my_chsize(PerlIO_fileno(fp), len) < 0) + if (my_chsize(fd, len) < 0) #endif - result = 0; + result = 0; + } } } } @@ -2248,9 +2266,10 @@ PP(pp_truncate) { const int tmpfd = PerlLIO_open(name, O_RDWR); - if (tmpfd < 0) + if (tmpfd < 0) { + SETERRNO(EBADF,RMS_IFI); result = 0; - else { + } else { if (my_chsize(tmpfd, len) < 0) result = 0; PerlLIO_close(tmpfd); @@ -2388,8 +2407,10 @@ PP(pp_socket) TAINT_PROPER("socket"); fd = PerlSock_socket(domain, type, protocol); - if (fd < 0) + if (fd < 0) { + SETERRNO(EBADF,RMS_IFI); RETPUSHUNDEF; + } IoIFP(io) = PerlIO_fdopen(fd, "r"SOCKET_OPEN_MODE); /* stdio gets confused about sockets */ IoOFP(io) = PerlIO_fdopen(fd, "w"SOCKET_OPEN_MODE); IoTYPE(io) = IoTYPE_SOCKET; @@ -2400,7 +2421,8 @@ PP(pp_socket) RETPUSHUNDEF; } #if defined(HAS_FCNTL) && defined(F_SETFD) - fcntl(fd, F_SETFD, fd > PL_maxsysfd); /* ensure close-on-exec */ + if (fcntl(fd, F_SETFD, fd > PL_maxsysfd) < 0) /* ensure close-on-exec */ + RETPUSHUNDEF; #endif RETPUSHYES; @@ -2445,8 +2467,10 @@ PP(pp_sockpair) RETPUSHUNDEF; } #if defined(HAS_FCNTL) && defined(F_SETFD) - fcntl(fd[0],F_SETFD,fd[0] > PL_maxsysfd); /* ensure close-on-exec */ - fcntl(fd[1],F_SETFD,fd[1] > PL_maxsysfd); /* ensure close-on-exec */ + /* ensure close-on-exec */ + if ((fcntl(fd[0],F_SETFD,fd[0] > PL_maxsysfd) < 0) || + (fcntl(fd[1],F_SETFD,fd[1] > PL_maxsysfd) < 0)) + RETPUSHUNDEF; #endif RETPUSHYES; @@ -2467,16 +2491,20 @@ PP(pp_bind) IO * const io = GvIOn(gv); STRLEN len; int op_type; + int fd; if (!IoIFP(io)) goto nuts; + fd = PerlIO_fileno(IoIFP(io)); + if (fd < 0) + goto nuts; addr = SvPV_const(addrsv, len); op_type = PL_op->op_type; TAINT_PROPER(PL_op_desc[op_type]); if ((op_type == OP_BIND - ? PerlSock_bind(PerlIO_fileno(IoIFP(io)), (struct sockaddr *)addr, len) - : PerlSock_connect(PerlIO_fileno(IoIFP(io)), (struct sockaddr *)addr, len)) + ? PerlSock_bind(fd, (struct sockaddr *)addr, len) + : PerlSock_connect(fd, (struct sockaddr *)addr, len)) >= 0) RETPUSHYES; else @@ -2554,7 +2582,8 @@ PP(pp_accept) goto badexit; } #if defined(HAS_FCNTL) && defined(F_SETFD) - fcntl(fd, F_SETFD, fd > PL_maxsysfd); /* ensure close-on-exec */ + if (fcntl(fd, F_SETFD, fd > PL_maxsysfd) < 0) /* ensure close-on-exec */ + goto badexit; #endif #ifdef __SCO_VERSION__ @@ -2608,6 +2637,8 @@ PP(pp_ssockopt) goto nuts; fd = PerlIO_fileno(IoIFP(io)); + if (fd < 0) + goto nuts; switch (optype) { case OP_GSOCKOPT: SvGROW(sv, 257); @@ -2683,6 +2714,8 @@ PP(pp_getpeername) SvCUR_set(sv, len); *SvEND(sv) ='\0'; fd = PerlIO_fileno(IoIFP(io)); + if (fd < 0) + goto nuts; switch (optype) { case OP_GETSOCKNAME: if (PerlSock_getsockname(fd, (struct sockaddr *)SvPVX(sv), &len) < 0) @@ -2764,9 +2797,14 @@ PP(pp_stat) } if (io) { if (IoIFP(io)) { - PL_laststatval = - PerlLIO_fstat(PerlIO_fileno(IoIFP(io)), &PL_statcache); - havefp = TRUE; + int fd = PerlIO_fileno(IoIFP(io)); + if (fd < 0) { + PL_laststatval = -1; + SETERRNO(EBADF,RMS_IFI); + } else { + PL_laststatval = PerlLIO_fstat(fd, &PL_statcache); + havefp = TRUE; + } } else if (IoDIRP(io)) { PL_laststatval = PerlLIO_fstat(my_dirfd(IoDIRP(io)), &PL_statcache); @@ -3256,9 +3294,13 @@ PP(pp_fttty) if (GvIO(gv) && IoIFP(GvIOp(gv))) fd = PerlIO_fileno(IoIFP(GvIOp(gv))); else if (name && isDIGIT(*name)) - fd = atoi(name); + fd = atoi(name); else FT_RETURNUNDEF; + if (fd < 0) { + SETERRNO(EBADF,RMS_IFI); + FT_RETURNUNDEF; + } if (PerlLIO_isatty(fd)) FT_RETURNYES; FT_RETURNNO; @@ -3307,9 +3349,15 @@ PP(pp_fttext) PL_laststatval = -1; PL_laststype = OP_STAT; if (io && IoIFP(io)) { + int fd; if (! PerlIO_has_base(IoIFP(io))) DIE(aTHX_ "-T and -B not implemented on filehandles"); - PL_laststatval = PerlLIO_fstat(PerlIO_fileno(IoIFP(io)), &PL_statcache); + fd = PerlIO_fileno(IoIFP(io)); + if (fd < 0) { + SETERRNO(EBADF,RMS_IFI); + FT_RETURNUNDEF; + } + PL_laststatval = PerlLIO_fstat(fd, &PL_statcache); if (PL_laststatval < 0) FT_RETURNUNDEF; if (S_ISDIR(PL_statcache.st_mode)) { /* handle NFS glitch */ @@ -3339,6 +3387,7 @@ PP(pp_fttext) } } else { + int fd; sv_setpv(PL_statname, SvPV_nomg_const_nolen(sv)); really_filename: PL_statgv = NULL; @@ -3358,9 +3407,16 @@ PP(pp_fttext) FT_RETURNUNDEF; } PL_laststype = OP_STAT; - PL_laststatval = PerlLIO_fstat(PerlIO_fileno(fp), &PL_statcache); + fd = PerlIO_fileno(fp); + if (fd < 0) { + (void)PerlIO_close(fp); + SETERRNO(EBADF,RMS_IFI); + FT_RETURNUNDEF; + } + PL_laststatval = PerlLIO_fstat(fd, &PL_statcache); if (PL_laststatval < 0) { (void)PerlIO_close(fp); + SETERRNO(EBADF,RMS_IFI); FT_RETURNUNDEF; } PerlIO_binmode(aTHX_ fp, '<', O_BINARY, NULL); @@ -3475,19 +3531,19 @@ PP(pp_chdir) if (IoDIRP(io)) { PUSHi(fchdir(my_dirfd(IoDIRP(io))) >= 0); } else if (IoIFP(io)) { - PUSHi(fchdir(PerlIO_fileno(IoIFP(io))) >= 0); + int fd = PerlIO_fileno(IoIFP(io)); + if (fd < 0) { + goto nuts; + } + PUSHi(fchdir(fd) >= 0); } else { - report_evil_fh(gv); - SETERRNO(EBADF, RMS_IFI); - PUSHi(0); + goto nuts; } + } else { + goto nuts; } - else { - report_evil_fh(gv); - SETERRNO(EBADF,RMS_IFI); - PUSHi(0); - } + #else DIE(aTHX_ PL_no_func, "fchdir"); #endif @@ -3500,6 +3556,12 @@ PP(pp_chdir) hv_delete(GvHVn(PL_envgv),"DEFAULT",7,G_DISCARD); #endif RETURN; + + nuts: + report_evil_fh(gv); + SETERRNO(EBADF,RMS_IFI); + PUSHi(0); + RETURN; } PP(pp_chown) @@ -4194,7 +4256,8 @@ PP(pp_system) if (did_pipes) { PerlLIO_close(pp[0]); #if defined(HAS_FCNTL) && defined(F_SETFD) - fcntl(pp[1], F_SETFD, FD_CLOEXEC); + if (fcntl(pp[1], F_SETFD, FD_CLOEXEC) < 0) + RETPUSHUNDEF; #endif } if (PL_op->op_flags & OPf_STACKED) { diff --git a/util.c b/util.c index 0a0ee40..343bf72 100644 --- a/util.c +++ b/util.c @@ -1710,13 +1710,16 @@ void Perl_croak_no_mem(void) { dTHX; - int rc; - /* Can't use PerlIO to write as it allocates memory */ - rc = PerlLIO_write(PerlIO_fileno(Perl_error_log), - PL_no_mem, sizeof(PL_no_mem)-1); - /* silently ignore failures */ - PERL_UNUSED_VAR(rc); + int fd = PerlIO_fileno(Perl_error_log); + if (fd < 0) + SETERRNO(EBADF,RMS_IFI); + else { + /* Can't use PerlIO to write as it allocates memory */ + int rc = PerlLIO_write(fd, PL_no_mem, sizeof(PL_no_mem)-1); + /* silently ignore failures */ + PERL_UNUSED_VAR(rc); + } my_exit(1); } @@ -2308,7 +2311,8 @@ Perl_my_popen_list(pTHX_ const char *mode, int n, SV **args) PerlLIO_close(pp[0]); #if defined(HAS_FCNTL) && defined(F_SETFD) /* Close error pipe automatically if exec works */ - fcntl(pp[1], F_SETFD, FD_CLOEXEC); + if (fcntl(pp[1], F_SETFD, FD_CLOEXEC) < 0) + return NULL; #endif } /* Now dup our end of _the_ pipe to right position */ @@ -2453,7 +2457,8 @@ Perl_my_popen(pTHX_ const char *cmd, const char *mode) if (did_pipes) { PerlLIO_close(pp[0]); #if defined(HAS_FCNTL) && defined(F_SETFD) - fcntl(pp[1], F_SETFD, FD_CLOEXEC); + if (fcntl(pp[1], F_SETFD, FD_CLOEXEC) < 0) + return NULL; #endif } if (p[THIS] != (*mode == 'r')) { -- 1.9.2 ```

[p5pRT]

From @tonycoz

On Thu May 01 18​:16​:28 2014\, jhi wrote​:

Updated patch attached.

It's a little inconsistent about cleaning up file handles that have failed the fcntl() call​:

--- a/doio.c +++ b/doio.c @​@​ -755\,8 +755\,12 @​@​ S_openn_cleanup(pTHX_ GV *gv\, IO *io\, PerlIO *fp\, char *mode\, const char *oname\, #if defined(HAS_FCNTL) && defined(F_SETFD)   if (fd >= 0) {   dSAVE_ERRNO; - fcntl(fd\,F_SETFD\,fd > PL_maxsysfd); /* can change errno */ + int rc = fcntl(fd\,F_SETFD\,fd > PL_maxsysfd); /* can change errno */   RESTORE_ERRNO; + if (rc \< 0) { + PerlLIO_close(fd); + goto say_false; + }   } #endif   IoIFP(io) = fp;

closes the handle (but the errno from fcntl() failing is lost)

--- a/pp_sys.c +++ b/pp_sys.c @​@​ -715\,8 +715\,10 @​@​ PP(pp_pipe_op)   goto badexit;   } #if defined(HAS_FCNTL) && defined(F_SETFD) - fcntl(fd[0]\,F_SETFD\,fd[0] > PL_maxsysfd); /* ensure close-on-exec */ - fcntl(fd[1]\,F_SETFD\,fd[1] > PL_maxsysfd); /* ensure close-on-exec */ + /* ensure close-on-exec */ + if ((fcntl(fd[0]\, F_SETFD\,fd[0] > PL_maxsysfd) \< 0) || + (fcntl(fd[1]\, F_SETFD\,fd[1] > PL_maxsysfd) \< 0)) + goto badexit; #endif   RETPUSHYES;

@​@​ -2400\,7 +2402\,8 @​@​ PP(pp_socket)   RETPUSHUNDEF;   } #if defined(HAS_FCNTL) && defined(F_SETFD) - fcntl(fd\, F_SETFD\, fd > PL_maxsysfd); /* ensure close-on-exec */ + if (fcntl(fd\, F_SETFD\, fd > PL_maxsysfd) \< 0) /* ensure close-on-exec */ + RETPUSHUNDEF; #endif

  RETPUSHYES; @​@​ -2445\,8 +2448\,10 @​@​ PP(pp_sockpair)   RETPUSHUNDEF;   } #if defined(HAS_FCNTL) && defined(F_SETFD) - fcntl(fd[0]\,F_SETFD\,fd[0] > PL_maxsysfd); /* ensure close-on-exec */ - fcntl(fd[1]\,F_SETFD\,fd[1] > PL_maxsysfd); /* ensure close-on-exec */ + /* ensure close-on-exec */ + if ((fcntl(fd[0]\,F_SETFD\,fd[0] > PL_maxsysfd) \< 0) || + (fcntl(fd[1]\,F_SETFD\,fd[1] > PL_maxsysfd) \< 0)) + RETPUSHUNDEF; #endif

  RETPUSHYES; (and a few more)

leaks the handle(s).

Though I wonder whether a handle that fails fcntl(F_SETFD) will successfully close.

Tony

[p5pRT]

From @tonycoz

On Sun May 04 22​:00​:20 2014\, tonyc wrote​:

On Thu May 01 18​:16​:28 2014\, jhi wrote​:

Updated patch attached.

It's a little inconsistent about cleaning up file handles that have failed the fcntl() call​:

Oops\, 121743 asked me to ignore 121745\, I'll merge as you suggested.

Tony

[p5pRT]

From @tonycoz

On Sun May 04 16​:43​:43 2014\, jhi wrote​:

On Saturday-201405-03\, 8​:30\, Jarkko Hietaniemi wrote​:

On Friday-201405-02\, 22​:27\, Jarkko Hietaniemi wrote​:

On Thursday-201405-01\, 17​:05\, Jarkko Hietaniemi wrote​:

Yet again refreshed patch\, found two more spots with the same potentially negative fd use.

I decided to merge this ticket with perl #121745 which checked for fcntl failure paths\, since there's a lot of functional overlap​: (1) a fd from fileno being checked against \< 0\, and then (2) the fd being fed to fcntl\, the return value of which we want to check for failure (3) in one actual case of a merge conflict (in perl.c) because the changes for these two checks were too close for comfort

So updated combined patch attached\, and please ignore/merge #121745.

... and refreshed. With a fresh cup of coffee found an embarrassing typo of fd\<0 when fd>=0 was meant (on a memory-alloc-failed path​: in general we can't easily test those...)

..and yet again\, to fix a failure in t/porting/diag.

--- a/dist/IO/IO.xs +++ b/dist/IO/IO.xs @​@​ -524\,9 +524\,15 @​@​ fsync(arg)   handle = IoOFP(sv_2io(arg));   if (!handle)   handle = IoIFP(sv_2io(arg)); - if(handle) - RETVAL = fsync(PerlIO_fileno(handle)); - else { + if (handle) { + int fd = PerlIO_fileno(handle); + if (fd >= 0) { + RETVAL = fsync(fd); + } else { + RETVAL = -1; + errno = EINVAL; + } + } else {   RETVAL = -1;   errno = EINVAL;   }

Elsewhere you use EBADF when fd is negative.

@​@​ -1616\,7 +1618\,7 @​@​ PP(pp_sysread)   char *buffer;   STRLEN orig_size;   SSize_t length; - SSize_t count; + SSize_t count = -1;   SV *bufsv;   STRLEN blen;   int fp_utf8; ... @​@​ -1771\,8 +1778\,11 @​@​ PP(pp_sysread)   else #endif   { - count = PerlLIO_read(PerlIO_fileno(IoIFP(io))\, - buffer\, length); + int fd = PerlIO_fileno(IoIFP(io)); + if (fd \< 0) + SETERRNO(EBADF\,RMS_IFI); + else + count = PerlLIO_read(fd\, buffer\, length);   }   }   else

Shouldn't this explicitly set count rather than relying upon the initialization at the top?

eg. if we're reading from a PerlIO_isutf8() STDIN and another thread closes it​:

T1​: successful partial read (partial utf-8 character) T2​: close STDIN T1​: fd is negative (because it's closed) but count is still positive

(Yes\, sysread() handling on UTF-8 streams is crazy.)

@​@​ -2224\,13 +2237\,18 @​@​ PP(pp_truncate)   result = 0;   }   else { - PerlIO_flush(fp); + int fd = PerlIO_fileno(fp); + if (fd \< 0) + SETERRNO(EBADF\,RMS_IFI); + else { + PerlIO_flush(fp); #ifdef HAS_TRUNCATE - if (ftruncate(PerlIO_fileno(fp)\, len) \< 0) + if (ftruncate(fd\, len) \< 0) #else - if (my_chsize(PerlIO_fileno(fp)\, len) \< 0) + if (my_chsize(fd\, len) \< 0) #endif - result = 0; + result = 0; + }   }   }   }

result isn't zeroed if fd is negative.

I haven't finished working my way through this.

Tony

[p5pRT]

From @jhi

On Monday-201405-05\, 2​:56\, Tony Cook via RT wrote​:

+++ b/dist/IO/IO.xs Elsewhere you use EBADF when fd is negative.

Yes\, I remember this spot... I did use EINVAL for consistency with the existing logic *at this spot*​: if there was no file pointer\, it used EINVAL. But of course EBADF would be more consistent with the rest of the change. I dunno. Which "failure contour" to follow?

@​@​ -1616\,7 +1618\,7 @​@​ PP(pp_sysread) + SSize_t count = -1; Shouldn't this explicitly set count rather than relying upon the initialization at the top?

I think I did the count init not so much because of the is-fd-negative logic but because I think I saw a possible code path where count was left uninitialized. But can't see it now\, so recanted that init.

(Though\, in principle\, initializing a variable to an illegal value as opposed to uninitialized should not cause *more* failures\, if they do\, there's something rotten with the logic...)

While I was looking at pp_sysread + pp_syswrite I cleaned up some further logic.

@​@​ -2224\,13 +2237\,18 @​@​ PP(pp_truncate)

result isn't zeroed if fd is negative.

Fixed.

Refreshed patch attached.

[p5pRT]

From @jhi

0001-Check-fileno-numgroups-1-check-fcntl-fgetc-failures.patch

```diff From 05e03d2073fa32766dac895e94892166b37f9e68 Mon Sep 17 00:00:00 2001 From: Jarkko Hietaniemi Date: Fri, 2 May 2014 22:12:24 -0400 Subject: [PATCH] Check fileno/numgroups -1, check fcntl (+fgetc) failures. (merged fix for perl #121743 and perl #121745) --- dist/IO/IO.xs | 12 +++- dist/threads/threads.xs | 10 +-- doio.c | 105 ++++++++++++++++++++++---------- ext/PerlIO-mmap/mmap.xs | 6 +- mg.c | 15 +++-- perl.c | 34 ++++++++--- perlio.c | 20 ++++-- pod/perldiag.pod | 4 ++ pp_sys.c | 158 ++++++++++++++++++++++++++++++++++-------------- util.c | 21 ++++--- 10 files changed, 271 insertions(+), 114 deletions(-) diff --git a/dist/IO/IO.xs b/dist/IO/IO.xs index 9056cb6..d7fe0a0 100644 --- a/dist/IO/IO.xs +++ b/dist/IO/IO.xs @@ -524,9 +524,15 @@ fsync(arg) handle = IoOFP(sv_2io(arg)); if (!handle) handle = IoIFP(sv_2io(arg)); - if(handle) - RETVAL = fsync(PerlIO_fileno(handle)); - else { + if (handle) { + int fd = PerlIO_fileno(handle); + if (fd >= 0) { + RETVAL = fsync(fd); + } else { + RETVAL = -1; + errno = EINVAL; + } + } else { RETVAL = -1; errno = EINVAL; } diff --git a/dist/threads/threads.xs b/dist/threads/threads.xs index 8537165..90c61ff 100644 --- a/dist/threads/threads.xs +++ b/dist/threads/threads.xs @@ -713,11 +713,13 @@ S_ithread_create( } PERL_SET_CONTEXT(aTHX); if (!thread) { - int rc; MUTEX_UNLOCK(&MY_POOL.create_destruct_mutex); - rc = PerlLIO_write(PerlIO_fileno(Perl_error_log), - PL_no_mem, strlen(PL_no_mem)); - PERL_UNUSED_VAR(rc); + int fd = PerlIO_fileno(Perl_error_log); + if (fd >= 0) { + /* If there's no error_log, we cannot scream about it missing. */ + int rc = PerlLIO_write(fd, PL_no_mem, strlen(PL_no_mem)); + PERL_UNUSED_VAR(rc); + } my_exit(1); } Zero(thread, 1, ithread); diff --git a/doio.c b/doio.c index e2bfda5..26c0032 100644 --- a/doio.c +++ b/doio.c @@ -646,9 +646,9 @@ S_openn_cleanup(pTHX_ GV *gv, IO *io, PerlIO *fp, char *mode, const char *oname, } fd = PerlIO_fileno(fp); - /* If there is no fd (e.g. PerlIO::scalar) assume it isn't a - * socket - this covers PerlIO::scalar - otherwise unless we "know" the - * type probe for socket-ness. + /* Do NOT do: "if (fd < 0) goto say_false;" here. If there is no + * fd assume it isn't a socket - this covers PerlIO::scalar - + * otherwise unless we "know" the type probe for socket-ness. */ if (IoTYPE(io) && IoTYPE(io) != IoTYPE_PIPE && IoTYPE(io) != IoTYPE_STD && fd >= 0) { if (PerlLIO_fstat(fd,&PL_statbuf) < 0) { @@ -696,7 +696,10 @@ S_openn_cleanup(pTHX_ GV *gv, IO *io, PerlIO *fp, char *mode, const char *oname, is assigned to (say) STDOUT - for now let dup2() fail and provide the error */ - if (PerlLIO_dup2(fd, savefd) < 0) { + if (fd < 0) { + SETERRNO(EBADF,RMS_IFI); + goto say_false; + } else if (PerlLIO_dup2(fd, savefd) < 0) { (void)PerlIO_close(fp); goto say_false; } @@ -732,13 +735,23 @@ S_openn_cleanup(pTHX_ GV *gv, IO *io, PerlIO *fp, char *mode, const char *oname, if (was_fdopen) { /* need to close fp without closing underlying fd */ int ofd = PerlIO_fileno(fp); - int dupfd = PerlLIO_dup(ofd); + int dupfd = ofd >= 0 ? PerlLIO_dup(ofd) : -1; #if defined(HAS_FCNTL) && defined(F_SETFD) /* Assume if we have F_SETFD we have F_GETFD */ - int coe = fcntl(ofd,F_GETFD); + int coe = ofd >= 0 ? fcntl(ofd, F_GETFD) : -1; + if (coe < 0) { + if (dupfd >= 0) + PerlLIO_close(dupfd); + goto say_false; + } #endif + if (ofd < 0 || dupfd < 0) { + if (dupfd >= 0) + PerlLIO_close(dupfd); + goto say_false; + } PerlIO_close(fp); - PerlLIO_dup2(dupfd,ofd); + PerlLIO_dup2(dupfd, ofd); #if defined(HAS_FCNTL) && defined(F_SETFD) /* The dup trick has lost close-on-exec on ofd */ fcntl(ofd,F_SETFD, coe); @@ -755,8 +768,12 @@ S_openn_cleanup(pTHX_ GV *gv, IO *io, PerlIO *fp, char *mode, const char *oname, #if defined(HAS_FCNTL) && defined(F_SETFD) if (fd >= 0) { dSAVE_ERRNO; - fcntl(fd,F_SETFD,fd > PL_maxsysfd); /* can change errno */ + int rc = fcntl(fd,F_SETFD,fd > PL_maxsysfd); /* can change errno */ RESTORE_ERRNO; + if (rc < 0) { + PerlLIO_close(fd); + goto say_false; + } } #endif IoIFP(io) = fp; @@ -956,23 +973,25 @@ Perl_nextargv(pTHX_ GV *gv) } setdefout(PL_argvoutgv); PL_lastfd = PerlIO_fileno(IoIFP(GvIOp(PL_argvoutgv))); - (void)PerlLIO_fstat(PL_lastfd,&PL_statbuf); + if (PL_lastfd >= 0) { + (void)PerlLIO_fstat(PL_lastfd,&PL_statbuf); #ifdef HAS_FCHMOD - (void)fchmod(PL_lastfd,PL_filemode); + (void)fchmod(PL_lastfd,PL_filemode); #else - (void)PerlLIO_chmod(PL_oldname,PL_filemode); + (void)PerlLIO_chmod(PL_oldname,PL_filemode); #endif - if (fileuid != PL_statbuf.st_uid || filegid != PL_statbuf.st_gid) { - int rc = 0; + if (fileuid != PL_statbuf.st_uid || filegid != PL_statbuf.st_gid) { + int rc = 0; #ifdef HAS_FCHOWN - rc = fchown(PL_lastfd,fileuid,filegid); + rc = fchown(PL_lastfd,fileuid,filegid); #else #ifdef HAS_CHOWN - rc = PerlLIO_chown(PL_oldname,fileuid,filegid); + rc = PerlLIO_chown(PL_oldname,fileuid,filegid); #endif #endif - /* XXX silently ignore failures */ - PERL_UNUSED_VAR(rc); + /* XXX silently ignore failures */ + PERL_UNUSED_VAR(rc); + } } return IoIFP(GvIOp(gv)); } @@ -1169,8 +1188,12 @@ Perl_do_sysseek(pTHX_ GV *gv, Off_t pos, int whence) PERL_ARGS_ASSERT_DO_SYSSEEK; - if (io && (fp = IoIFP(io))) - return PerlLIO_lseek(PerlIO_fileno(fp), pos, whence); + if (io && (fp = IoIFP(io))) { + int fd = PerlIO_fileno(fp); + if (fd >= 0) { + return PerlLIO_lseek(fd, pos, whence); + } + } report_evil_fh(gv); SETERRNO(EBADF,RMS_IFI); return (Off_t)-1; @@ -1376,7 +1399,10 @@ Perl_my_stat_flags(pTHX_ const U32 flags) sv_setpvs(PL_statname, ""); if(io) { if (IoIFP(io)) { - return (PL_laststatval = PerlLIO_fstat(PerlIO_fileno(IoIFP(io)), &PL_statcache)); + int fd = PerlIO_fileno(IoIFP(io)); + if (fd >= 0) { + return (PL_laststatval = PerlLIO_fstat(fd, &PL_statcache)); + } } else if (IoDIRP(io)) { return (PL_laststatval = PerlLIO_fstat(my_dirfd(IoDIRP(io)), &PL_statcache)); } @@ -1739,9 +1765,13 @@ Perl_apply(pTHX_ I32 type, SV **mark, SV **sp) if ((gv = MAYBE_DEREF_GV(*mark))) { if (GvIO(gv) && IoIFP(GvIOp(gv))) { #ifdef HAS_FCHMOD + int fd = PerlIO_fileno(IoIFP(GvIOn(gv))); APPLY_TAINT_PROPER(); - if (fchmod(PerlIO_fileno(IoIFP(GvIOn(gv))), val)) - tot--; + if (fd < 0) { + SETERRNO(EBADF,RMS_IFI); + tot--; + } else if (fchmod(fd, val)) + tot--; #else Perl_die(aTHX_ PL_no_func, "fchmod"); #endif @@ -1775,8 +1805,12 @@ Perl_apply(pTHX_ I32 type, SV **mark, SV **sp) if ((gv = MAYBE_DEREF_GV(*mark))) { if (GvIO(gv) && IoIFP(GvIOp(gv))) { #ifdef HAS_FCHOWN + int fd = PerlIO_fileno(IoIFP(GvIOn(gv))); APPLY_TAINT_PROPER(); - if (fchown(PerlIO_fileno(IoIFP(GvIOn(gv))), val, val2)) + if (fd < 0) { + SETERRNO(EBADF,RMS_IFI); + tot--; + } else if (fchown(fd, val, val2)) tot--; #else Perl_die(aTHX_ PL_no_func, "fchown"); @@ -1965,9 +1999,12 @@ nothing in the core. if ((gv = MAYBE_DEREF_GV(*mark))) { if (GvIO(gv) && IoIFP(GvIOp(gv))) { #ifdef HAS_FUTIMES + int fd = PerlIO_fileno(IoIFP(GvIOn(gv))); APPLY_TAINT_PROPER(); - if (futimes(PerlIO_fileno(IoIFP(GvIOn(gv))), - (struct timeval *) utbufp)) + if (fd < 0) { + SETERRNO(EBADF,RMS_IFI); + tot--; + } else if (futimes(fd, (struct timeval *) utbufp)) tot--; #else Perl_die(aTHX_ PL_no_func, "futimes"); @@ -2082,15 +2119,17 @@ S_ingroup(pTHX_ Gid_t testgid, bool effective) bool rc = FALSE; anum = getgroups(0, gary); - Newx(gary, anum, Groups_t); - anum = getgroups(anum, gary); - while (--anum >= 0) - if (gary[anum] == testgid) { - rc = TRUE; - break; - } + if (anum > 0) { + Newx(gary, anum, Groups_t); + anum = getgroups(anum, gary); + while (--anum >= 0) + if (gary[anum] == testgid) { + rc = TRUE; + break; + } - Safefree(gary); + Safefree(gary); + } return rc; } #else diff --git a/ext/PerlIO-mmap/mmap.xs b/ext/PerlIO-mmap/mmap.xs index 4c96da8..6632544 100644 --- a/ext/PerlIO-mmap/mmap.xs +++ b/ext/PerlIO-mmap/mmap.xs @@ -40,8 +40,12 @@ PerlIOMmap_map(pTHX_ PerlIO *f) abort(); if (flags & PERLIO_F_CANREAD) { PerlIOBuf * const b = PerlIOSelf(f, PerlIOBuf); - const int fd = PerlIO_fileno(f); Stat_t st; + const int fd = PerlIO_fileno(f); + if (fd < 0) { + SETERRNO(EBADF,RMS_IFI); + return -1; + } code = Fstat(fd, &st); if (code == 0 && S_ISREG(st.st_mode)) { SSize_t len = st.st_size - b->posn; diff --git a/mg.c b/mg.c index 76912bd..6414349 100644 --- a/mg.c +++ b/mg.c @@ -1120,12 +1120,15 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg) #ifdef HAS_GETGROUPS { Groups_t *gary = NULL; - I32 i, num_groups = getgroups(0, gary); - Newx(gary, num_groups, Groups_t); - num_groups = getgroups(num_groups, gary); - for (i = 0; i < num_groups; i++) - Perl_sv_catpvf(aTHX_ sv, " %"IVdf, (IV)gary[i]); - Safefree(gary); + I32 i; + I32 num_groups = getgroups(0, gary); + if (num_groups > 0) { + Newx(gary, num_groups, Groups_t); + num_groups = getgroups(num_groups, gary); + for (i = 0; i < num_groups; i++) + Perl_sv_catpvf(aTHX_ sv, " %"IVdf, (IV)gary[i]); + Safefree(gary); + } } (void)SvIOK_on(sv); /* what a wonderful hack! */ #endif diff --git a/perl.c b/perl.c index 27d0d9e..a16e4a1 100644 --- a/perl.c +++ b/perl.c @@ -3691,6 +3691,7 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch, bool *suidscript) PerlIO *rsfp = NULL; dVAR; Stat_t tmpstatbuf; + int fd; PERL_ARGS_ASSERT_OPEN_SCRIPT; @@ -3796,13 +3797,20 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch, bool *suidscript) Perl_croak(aTHX_ "Can't open perl script \"%s\": %s\n", CopFILE(PL_curcop), Strerror(errno)); } + fd = PerlIO_fileno(rsfp); #if defined(HAS_FCNTL) && defined(F_SETFD) - /* ensure close-on-exec */ - fcntl(PerlIO_fileno(rsfp), F_SETFD, 1); + if (fd >= 0) { + /* ensure close-on-exec */ + if (fcntl(PerlIO_fileno(rsfp), F_SETFD, 1) < 0) { + Perl_croak(aTHX_ "Can't open perl script \"%s\": %s\n", + CopFILE(PL_curcop), Strerror(errno)); + } + } #endif - if (PerlLIO_fstat(PerlIO_fileno(rsfp), &tmpstatbuf) >= 0 - && S_ISDIR(tmpstatbuf.st_mode)) + if (fd < 0 || + (PerlLIO_fstat(fd, &tmpstatbuf) >= 0 + && S_ISDIR(tmpstatbuf.st_mode))) Perl_croak(aTHX_ "Can't open perl script \"%s\": %s\n", CopFILE(PL_curcop), Strerror(EISDIR)); @@ -3833,12 +3841,18 @@ S_validate_suid(pTHX_ PerlIO *rsfp) if (my_euid != my_uid || my_egid != my_gid) { /* (suidperl doesn't exist, in fact) */ dVAR; - - PerlLIO_fstat(PerlIO_fileno(rsfp),&PL_statbuf); /* may be either wrapped or real suid */ - if ((my_euid != my_uid && my_euid == PL_statbuf.st_uid && PL_statbuf.st_mode & S_ISUID) - || - (my_egid != my_gid && my_egid == PL_statbuf.st_gid && PL_statbuf.st_mode & S_ISGID) - ) + int fd = PerlIO_fileno(rsfp); + if (fd < 0) { + Perl_croak(aTHX_ "Illegal suidscript"); + } else { + if (PerlLIO_fstat(fd, &PL_statbuf) < 0) { /* may be either wrapped or real suid */ + Perl_croak(aTHX_ "Illegal suidscript"); + } + } + if ((my_euid != my_uid && my_euid == PL_statbuf.st_uid && PL_statbuf.st_mode & S_ISUID) + || + (my_egid != my_gid && my_egid == PL_statbuf.st_gid && PL_statbuf.st_mode & S_ISGID) + ) if (!PL_do_undump) Perl_croak(aTHX_ "YOU HAVEN'T DISABLED SET-ID SCRIPTS IN THE KERNEL YET!\n\ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n"); diff --git a/perlio.c b/perlio.c index d4c43d0..4b98f6b 100644 --- a/perlio.c +++ b/perlio.c @@ -2923,6 +2923,10 @@ PerlIO_importFILE(FILE *stdio, const char *mode) PerlIO *f = NULL; if (stdio) { PerlIOStdio *s; + int fd0 = fileno(stdio); + if (fd0 < 0) { + return NULL; + } if (!mode || !*mode) { /* We need to probe to see how we can open the stream so start with read/write and then try write and read @@ -2931,8 +2935,12 @@ PerlIO_importFILE(FILE *stdio, const char *mode) Note that the errno value set by a failing fdopen varies between stdio implementations. */ - const int fd = PerlLIO_dup(fileno(stdio)); - FILE *f2 = PerlSIO_fdopen(fd, (mode = "r+")); + const int fd = PerlLIO_dup(fd0); + FILE *f2; + if (fd < 0) { + return f; + } + f2 = PerlSIO_fdopen(fd, (mode = "r+")); if (!f2) { f2 = PerlSIO_fdopen(fd, (mode = "w")); } @@ -3351,8 +3359,8 @@ PerlIOStdio_unread(pTHX_ PerlIO *f, const void *vbuf, Size_t count) } if ((STDCHAR*)PerlSIO_get_ptr(s) != --eptr || ((*eptr & 0xFF) != ch)) { /* Did not change pointer as expected */ - fgetc(s); /* get char back again */ - break; + if (fgetc(s) != EOF) /* get char back again */ + break; } /* It worked ! */ count--; @@ -3668,6 +3676,10 @@ PerlIO_exportFILE(PerlIO * f, const char *mode) FILE *stdio = NULL; if (PerlIOValid(f)) { char buf[8]; + int fd = PerlIO_fileno(f); + if (fd < 0) { + return NULL; + } PerlIO_flush(f); if (!mode || !*mode) { mode = PerlIO_modestr(f, buf); diff --git a/pod/perldiag.pod b/pod/perldiag.pod index bca95e2..df23cd3 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -2292,6 +2292,10 @@ The C<"+"> is valid only when followed by digits, indicating a capturing group. See L)>|perlre/(?PARNO) (?-PARNO) (?+PARNO) (?R) (?0)>. +=item Illegal suidscript + +(F) The script run under suidperl was somehow illegal. + =item Illegal switch in PERL5OPT: -%c (X) The PERL5OPT environment variable may only be used to set the diff --git a/pp_sys.c b/pp_sys.c index 9f97177..ef64829 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -715,8 +715,10 @@ PP(pp_pipe_op) goto badexit; } #if defined(HAS_FCNTL) && defined(F_SETFD) - fcntl(fd[0],F_SETFD,fd[0] > PL_maxsysfd); /* ensure close-on-exec */ - fcntl(fd[1],F_SETFD,fd[1] > PL_maxsysfd); /* ensure close-on-exec */ + /* ensure close-on-exec */ + if ((fcntl(fd[0], F_SETFD,fd[0] > PL_maxsysfd) < 0) || + (fcntl(fd[1], F_SETFD,fd[1] > PL_maxsysfd) < 0)) + goto badexit; #endif RETPUSHYES; @@ -1627,8 +1629,9 @@ PP(pp_sysread) bool charstart = FALSE; STRLEN charskip = 0; STRLEN skip = 0; - GV * const gv = MUTABLE_GV(*++MARK); + int fd; + if ((PL_op->op_type == OP_READ || PL_op->op_type == OP_SYSREAD) && gv && (io = GvIO(gv)) ) { @@ -1659,6 +1662,8 @@ PP(pp_sysread) SETERRNO(EBADF,RMS_IFI); goto say_undef; } + /* Note that fd can here validly be -1, don't check it yet. */ + fd = PerlIO_fileno(IoIFP(io)); if ((fp_utf8 = PerlIO_isutf8(IoIFP(io))) && !IN_BYTES) { buffer = SvPVutf8_force(bufsv, blen); /* UTF-8 may not have been set if they are all low bytes */ @@ -1682,6 +1687,10 @@ PP(pp_sysread) if (PL_op->op_type == OP_RECV) { Sock_size_t bufsize; char namebuf[MAXPATHLEN]; + if (fd < 0) { + SETERRNO(EBADF,SS_IVCHAN); + RETPUSHUNDEF; + } #if (defined(VMS_DO_SOCKETS) && defined(DECCRTL_SOCKETS)) || defined(__QNXNTO__) bufsize = sizeof (struct sockaddr_in); #else @@ -1693,7 +1702,7 @@ PP(pp_sysread) #endif buffer = SvGROW(bufsv, (STRLEN)(length+1)); /* 'offset' means 'flags' here */ - count = PerlSock_recvfrom(PerlIO_fileno(IoIFP(io)), buffer, length, offset, + count = PerlSock_recvfrom(fd, buffer, length, offset, (struct sockaddr *)namebuf, &bufsize); if (count < 0) RETPUSHUNDEF; @@ -1735,6 +1744,7 @@ PP(pp_sysread) else offset = utf8_hop((U8 *)buffer,offset) - (U8 *) buffer; } + more_bytes: orig_size = SvCUR(bufsv); /* Allocating length + offset + 1 isn't perfect in the case of reading @@ -1765,14 +1775,18 @@ PP(pp_sysread) if (PL_op->op_type == OP_SYSREAD) { #ifdef PERL_SOCK_SYSREAD_IS_RECV if (IoTYPE(io) == IoTYPE_SOCKET) { - count = PerlSock_recv(PerlIO_fileno(IoIFP(io)), - buffer, length, 0); + if (fd < 0) + SETERRNO(EBADF,SS_IVCHAN); + else + count = PerlSock_recv(fd, length, 0); } else #endif { - count = PerlLIO_read(PerlIO_fileno(IoIFP(io)), - buffer, length); + if (fd < 0) + SETERRNO(EBADF,RMS_IFI); + else + count = PerlLIO_read(fd, buffer, length); } } else @@ -1848,7 +1862,7 @@ PP(pp_syswrite) dVAR; dSP; dMARK; dORIGMARK; dTARGET; SV *bufsv; const char *buffer; - SSize_t retval; + SSize_t retval = -1; STRLEN blen; STRLEN orig_blen_bytes; const int op_type = PL_op->op_type; @@ -1856,6 +1870,7 @@ PP(pp_syswrite) U8 *tmpbuf = NULL; GV *const gv = MUTABLE_GV(*++MARK); IO *const io = GvIO(gv); + int fd; if (op_type == OP_SYSWRITE && io) { const MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar); @@ -1886,6 +1901,11 @@ PP(pp_syswrite) SETERRNO(EBADF,RMS_IFI); goto say_undef; } + fd = PerlIO_fileno(IoIFP(io)); + if (fd < 0) { + SETERRNO(EBADF,SS_IVCHAN); + goto say_undef; + } /* Do this first to trigger any overloading. */ buffer = SvPV_const(bufsv, blen); @@ -1920,12 +1940,11 @@ PP(pp_syswrite) if (SP > MARK) { STRLEN mlen; char * const sockbuf = SvPVx(*++MARK, mlen); - retval = PerlSock_sendto(PerlIO_fileno(IoIFP(io)), buffer, blen, + retval = PerlSock_sendto(fd, buffer, blen, flags, (struct sockaddr *)sockbuf, mlen); } else { - retval - = PerlSock_send(PerlIO_fileno(IoIFP(io)), buffer, blen, flags); + retval = PerlSock_send(fd, buffer, blen, flags); } } else @@ -2008,15 +2027,13 @@ PP(pp_syswrite) } #ifdef PERL_SOCK_SYSWRITE_IS_SEND if (IoTYPE(io) == IoTYPE_SOCKET) { - retval = PerlSock_send(PerlIO_fileno(IoIFP(io)), - buffer, length, 0); + retval = PerlSock_send(fd, buffer, length, 0); } else #endif { /* See the note at doio.c:do_print about filesize limits. --jhi */ - retval = PerlLIO_write(PerlIO_fileno(IoIFP(io)), - buffer, length); + retval = PerlLIO_write(fd, buffer, length); } } @@ -2224,13 +2241,19 @@ PP(pp_truncate) result = 0; } else { - PerlIO_flush(fp); + int fd = PerlIO_fileno(fp); + if (fd < 0) { + SETERRNO(EBADF,RMS_IFI); + result = 0; + } else { + PerlIO_flush(fp); #ifdef HAS_TRUNCATE - if (ftruncate(PerlIO_fileno(fp), len) < 0) + if (ftruncate(fd, len) < 0) #else - if (my_chsize(PerlIO_fileno(fp), len) < 0) + if (my_chsize(fd, len) < 0) #endif - result = 0; + result = 0; + } } } } @@ -2248,9 +2271,10 @@ PP(pp_truncate) { const int tmpfd = PerlLIO_open(name, O_RDWR); - if (tmpfd < 0) + if (tmpfd < 0) { + SETERRNO(EBADF,RMS_IFI); result = 0; - else { + } else { if (my_chsize(tmpfd, len) < 0) result = 0; PerlLIO_close(tmpfd); @@ -2388,8 +2412,10 @@ PP(pp_socket) TAINT_PROPER("socket"); fd = PerlSock_socket(domain, type, protocol); - if (fd < 0) + if (fd < 0) { + SETERRNO(EBADF,RMS_IFI); RETPUSHUNDEF; + } IoIFP(io) = PerlIO_fdopen(fd, "r"SOCKET_OPEN_MODE); /* stdio gets confused about sockets */ IoOFP(io) = PerlIO_fdopen(fd, "w"SOCKET_OPEN_MODE); IoTYPE(io) = IoTYPE_SOCKET; @@ -2400,7 +2426,8 @@ PP(pp_socket) RETPUSHUNDEF; } #if defined(HAS_FCNTL) && defined(F_SETFD) - fcntl(fd, F_SETFD, fd > PL_maxsysfd); /* ensure close-on-exec */ + if (fcntl(fd, F_SETFD, fd > PL_maxsysfd) < 0) /* ensure close-on-exec */ + RETPUSHUNDEF; #endif RETPUSHYES; @@ -2445,8 +2472,10 @@ PP(pp_sockpair) RETPUSHUNDEF; } #if defined(HAS_FCNTL) && defined(F_SETFD) - fcntl(fd[0],F_SETFD,fd[0] > PL_maxsysfd); /* ensure close-on-exec */ - fcntl(fd[1],F_SETFD,fd[1] > PL_maxsysfd); /* ensure close-on-exec */ + /* ensure close-on-exec */ + if ((fcntl(fd[0],F_SETFD,fd[0] > PL_maxsysfd) < 0) || + (fcntl(fd[1],F_SETFD,fd[1] > PL_maxsysfd) < 0)) + RETPUSHUNDEF; #endif RETPUSHYES; @@ -2467,16 +2496,20 @@ PP(pp_bind) IO * const io = GvIOn(gv); STRLEN len; int op_type; + int fd; if (!IoIFP(io)) goto nuts; + fd = PerlIO_fileno(IoIFP(io)); + if (fd < 0) + goto nuts; addr = SvPV_const(addrsv, len); op_type = PL_op->op_type; TAINT_PROPER(PL_op_desc[op_type]); if ((op_type == OP_BIND - ? PerlSock_bind(PerlIO_fileno(IoIFP(io)), (struct sockaddr *)addr, len) - : PerlSock_connect(PerlIO_fileno(IoIFP(io)), (struct sockaddr *)addr, len)) + ? PerlSock_bind(fd, (struct sockaddr *)addr, len) + : PerlSock_connect(fd, (struct sockaddr *)addr, len)) >= 0) RETPUSHYES; else @@ -2554,7 +2587,8 @@ PP(pp_accept) goto badexit; } #if defined(HAS_FCNTL) && defined(F_SETFD) - fcntl(fd, F_SETFD, fd > PL_maxsysfd); /* ensure close-on-exec */ + if (fcntl(fd, F_SETFD, fd > PL_maxsysfd) < 0) /* ensure close-on-exec */ + goto badexit; #endif #ifdef __SCO_VERSION__ @@ -2608,6 +2642,8 @@ PP(pp_ssockopt) goto nuts; fd = PerlIO_fileno(IoIFP(io)); + if (fd < 0) + goto nuts; switch (optype) { case OP_GSOCKOPT: SvGROW(sv, 257); @@ -2683,6 +2719,8 @@ PP(pp_getpeername) SvCUR_set(sv, len); *SvEND(sv) ='\0'; fd = PerlIO_fileno(IoIFP(io)); + if (fd < 0) + goto nuts; switch (optype) { case OP_GETSOCKNAME: if (PerlSock_getsockname(fd, (struct sockaddr *)SvPVX(sv), &len) < 0) @@ -2764,9 +2802,14 @@ PP(pp_stat) } if (io) { if (IoIFP(io)) { - PL_laststatval = - PerlLIO_fstat(PerlIO_fileno(IoIFP(io)), &PL_statcache); - havefp = TRUE; + int fd = PerlIO_fileno(IoIFP(io)); + if (fd < 0) { + PL_laststatval = -1; + SETERRNO(EBADF,RMS_IFI); + } else { + PL_laststatval = PerlLIO_fstat(fd, &PL_statcache); + havefp = TRUE; + } } else if (IoDIRP(io)) { PL_laststatval = PerlLIO_fstat(my_dirfd(IoDIRP(io)), &PL_statcache); @@ -3256,9 +3299,13 @@ PP(pp_fttty) if (GvIO(gv) && IoIFP(GvIOp(gv))) fd = PerlIO_fileno(IoIFP(GvIOp(gv))); else if (name && isDIGIT(*name)) - fd = atoi(name); + fd = atoi(name); else FT_RETURNUNDEF; + if (fd < 0) { + SETERRNO(EBADF,RMS_IFI); + FT_RETURNUNDEF; + } if (PerlLIO_isatty(fd)) FT_RETURNYES; FT_RETURNNO; @@ -3307,9 +3354,15 @@ PP(pp_fttext) PL_laststatval = -1; PL_laststype = OP_STAT; if (io && IoIFP(io)) { + int fd; if (! PerlIO_has_base(IoIFP(io))) DIE(aTHX_ "-T and -B not implemented on filehandles"); - PL_laststatval = PerlLIO_fstat(PerlIO_fileno(IoIFP(io)), &PL_statcache); + fd = PerlIO_fileno(IoIFP(io)); + if (fd < 0) { + SETERRNO(EBADF,RMS_IFI); + FT_RETURNUNDEF; + } + PL_laststatval = PerlLIO_fstat(fd, &PL_statcache); if (PL_laststatval < 0) FT_RETURNUNDEF; if (S_ISDIR(PL_statcache.st_mode)) { /* handle NFS glitch */ @@ -3339,6 +3392,7 @@ PP(pp_fttext) } } else { + int fd; sv_setpv(PL_statname, SvPV_nomg_const_nolen(sv)); really_filename: PL_statgv = NULL; @@ -3358,9 +3412,16 @@ PP(pp_fttext) FT_RETURNUNDEF; } PL_laststype = OP_STAT; - PL_laststatval = PerlLIO_fstat(PerlIO_fileno(fp), &PL_statcache); + fd = PerlIO_fileno(fp); + if (fd < 0) { + (void)PerlIO_close(fp); + SETERRNO(EBADF,RMS_IFI); + FT_RETURNUNDEF; + } + PL_laststatval = PerlLIO_fstat(fd, &PL_statcache); if (PL_laststatval < 0) { (void)PerlIO_close(fp); + SETERRNO(EBADF,RMS_IFI); FT_RETURNUNDEF; } PerlIO_binmode(aTHX_ fp, '<', O_BINARY, NULL); @@ -3475,19 +3536,19 @@ PP(pp_chdir) if (IoDIRP(io)) { PUSHi(fchdir(my_dirfd(IoDIRP(io))) >= 0); } else if (IoIFP(io)) { - PUSHi(fchdir(PerlIO_fileno(IoIFP(io))) >= 0); + int fd = PerlIO_fileno(IoIFP(io)); + if (fd < 0) { + goto nuts; + } + PUSHi(fchdir(fd) >= 0); } else { - report_evil_fh(gv); - SETERRNO(EBADF, RMS_IFI); - PUSHi(0); + goto nuts; } + } else { + goto nuts; } - else { - report_evil_fh(gv); - SETERRNO(EBADF,RMS_IFI); - PUSHi(0); - } + #else DIE(aTHX_ PL_no_func, "fchdir"); #endif @@ -3500,6 +3561,12 @@ PP(pp_chdir) hv_delete(GvHVn(PL_envgv),"DEFAULT",7,G_DISCARD); #endif RETURN; + + nuts: + report_evil_fh(gv); + SETERRNO(EBADF,RMS_IFI); + PUSHi(0); + RETURN; } PP(pp_chown) @@ -4194,7 +4261,8 @@ PP(pp_system) if (did_pipes) { PerlLIO_close(pp[0]); #if defined(HAS_FCNTL) && defined(F_SETFD) - fcntl(pp[1], F_SETFD, FD_CLOEXEC); + if (fcntl(pp[1], F_SETFD, FD_CLOEXEC) < 0) + RETPUSHUNDEF; #endif } if (PL_op->op_flags & OPf_STACKED) { diff --git a/util.c b/util.c index 0a0ee40..343bf72 100644 --- a/util.c +++ b/util.c @@ -1710,13 +1710,16 @@ void Perl_croak_no_mem(void) { dTHX; - int rc; - /* Can't use PerlIO to write as it allocates memory */ - rc = PerlLIO_write(PerlIO_fileno(Perl_error_log), - PL_no_mem, sizeof(PL_no_mem)-1); - /* silently ignore failures */ - PERL_UNUSED_VAR(rc); + int fd = PerlIO_fileno(Perl_error_log); + if (fd < 0) + SETERRNO(EBADF,RMS_IFI); + else { + /* Can't use PerlIO to write as it allocates memory */ + int rc = PerlLIO_write(fd, PL_no_mem, sizeof(PL_no_mem)-1); + /* silently ignore failures */ + PERL_UNUSED_VAR(rc); + } my_exit(1); } @@ -2308,7 +2311,8 @@ Perl_my_popen_list(pTHX_ const char *mode, int n, SV **args) PerlLIO_close(pp[0]); #if defined(HAS_FCNTL) && defined(F_SETFD) /* Close error pipe automatically if exec works */ - fcntl(pp[1], F_SETFD, FD_CLOEXEC); + if (fcntl(pp[1], F_SETFD, FD_CLOEXEC) < 0) + return NULL; #endif } /* Now dup our end of _the_ pipe to right position */ @@ -2453,7 +2457,8 @@ Perl_my_popen(pTHX_ const char *cmd, const char *mode) if (did_pipes) { PerlLIO_close(pp[0]); #if defined(HAS_FCNTL) && defined(F_SETFD) - fcntl(pp[1], F_SETFD, FD_CLOEXEC); + if (fcntl(pp[1], F_SETFD, FD_CLOEXEC) < 0) + return NULL; #endif } if (p[THIS] != (*mode == 'r')) { -- 1.9.2 ```

[p5pRT]

From @jhi

Refreshed patch attached.

Sigh. This is getting annoying. Too many damn code paths. One more spot fixed\, in perl.c (if we already did fd=fileno\, let's use the fd...)   Attached.

(\<old_grumpy_man>And running full "make test" is too damn slow these days.\</old_grumpy_man>)

[p5pRT]

From @jhi

0001-Check-fileno-numgroups-1-check-fcntl-fgetc-failures.patch

```diff From 28be09767a365f0cc924eb0870fce37c812897fd Mon Sep 17 00:00:00 2001 From: Jarkko Hietaniemi Date: Fri, 2 May 2014 22:12:24 -0400 Subject: [PATCH] Check fileno/numgroups -1, check fcntl (+fgetc) failures. (merged fix for perl #121743 and perl #121745) --- dist/IO/IO.xs | 12 +++- dist/threads/threads.xs | 10 +-- doio.c | 105 ++++++++++++++++++++++---------- ext/PerlIO-mmap/mmap.xs | 6 +- mg.c | 15 +++-- perl.c | 34 ++++++++--- perlio.c | 20 ++++-- pod/perldiag.pod | 4 ++ pp_sys.c | 158 ++++++++++++++++++++++++++++++++++-------------- util.c | 21 ++++--- 10 files changed, 271 insertions(+), 114 deletions(-) diff --git a/dist/IO/IO.xs b/dist/IO/IO.xs index 9056cb6..d7fe0a0 100644 --- a/dist/IO/IO.xs +++ b/dist/IO/IO.xs @@ -524,9 +524,15 @@ fsync(arg) handle = IoOFP(sv_2io(arg)); if (!handle) handle = IoIFP(sv_2io(arg)); - if(handle) - RETVAL = fsync(PerlIO_fileno(handle)); - else { + if (handle) { + int fd = PerlIO_fileno(handle); + if (fd >= 0) { + RETVAL = fsync(fd); + } else { + RETVAL = -1; + errno = EINVAL; + } + } else { RETVAL = -1; errno = EINVAL; } diff --git a/dist/threads/threads.xs b/dist/threads/threads.xs index 8537165..90c61ff 100644 --- a/dist/threads/threads.xs +++ b/dist/threads/threads.xs @@ -713,11 +713,13 @@ S_ithread_create( } PERL_SET_CONTEXT(aTHX); if (!thread) { - int rc; MUTEX_UNLOCK(&MY_POOL.create_destruct_mutex); - rc = PerlLIO_write(PerlIO_fileno(Perl_error_log), - PL_no_mem, strlen(PL_no_mem)); - PERL_UNUSED_VAR(rc); + int fd = PerlIO_fileno(Perl_error_log); + if (fd >= 0) { + /* If there's no error_log, we cannot scream about it missing. */ + int rc = PerlLIO_write(fd, PL_no_mem, strlen(PL_no_mem)); + PERL_UNUSED_VAR(rc); + } my_exit(1); } Zero(thread, 1, ithread); diff --git a/doio.c b/doio.c index e2bfda5..26c0032 100644 --- a/doio.c +++ b/doio.c @@ -646,9 +646,9 @@ S_openn_cleanup(pTHX_ GV *gv, IO *io, PerlIO *fp, char *mode, const char *oname, } fd = PerlIO_fileno(fp); - /* If there is no fd (e.g. PerlIO::scalar) assume it isn't a - * socket - this covers PerlIO::scalar - otherwise unless we "know" the - * type probe for socket-ness. + /* Do NOT do: "if (fd < 0) goto say_false;" here. If there is no + * fd assume it isn't a socket - this covers PerlIO::scalar - + * otherwise unless we "know" the type probe for socket-ness. */ if (IoTYPE(io) && IoTYPE(io) != IoTYPE_PIPE && IoTYPE(io) != IoTYPE_STD && fd >= 0) { if (PerlLIO_fstat(fd,&PL_statbuf) < 0) { @@ -696,7 +696,10 @@ S_openn_cleanup(pTHX_ GV *gv, IO *io, PerlIO *fp, char *mode, const char *oname, is assigned to (say) STDOUT - for now let dup2() fail and provide the error */ - if (PerlLIO_dup2(fd, savefd) < 0) { + if (fd < 0) { + SETERRNO(EBADF,RMS_IFI); + goto say_false; + } else if (PerlLIO_dup2(fd, savefd) < 0) { (void)PerlIO_close(fp); goto say_false; } @@ -732,13 +735,23 @@ S_openn_cleanup(pTHX_ GV *gv, IO *io, PerlIO *fp, char *mode, const char *oname, if (was_fdopen) { /* need to close fp without closing underlying fd */ int ofd = PerlIO_fileno(fp); - int dupfd = PerlLIO_dup(ofd); + int dupfd = ofd >= 0 ? PerlLIO_dup(ofd) : -1; #if defined(HAS_FCNTL) && defined(F_SETFD) /* Assume if we have F_SETFD we have F_GETFD */ - int coe = fcntl(ofd,F_GETFD); + int coe = ofd >= 0 ? fcntl(ofd, F_GETFD) : -1; + if (coe < 0) { + if (dupfd >= 0) + PerlLIO_close(dupfd); + goto say_false; + } #endif + if (ofd < 0 || dupfd < 0) { + if (dupfd >= 0) + PerlLIO_close(dupfd); + goto say_false; + } PerlIO_close(fp); - PerlLIO_dup2(dupfd,ofd); + PerlLIO_dup2(dupfd, ofd); #if defined(HAS_FCNTL) && defined(F_SETFD) /* The dup trick has lost close-on-exec on ofd */ fcntl(ofd,F_SETFD, coe); @@ -755,8 +768,12 @@ S_openn_cleanup(pTHX_ GV *gv, IO *io, PerlIO *fp, char *mode, const char *oname, #if defined(HAS_FCNTL) && defined(F_SETFD) if (fd >= 0) { dSAVE_ERRNO; - fcntl(fd,F_SETFD,fd > PL_maxsysfd); /* can change errno */ + int rc = fcntl(fd,F_SETFD,fd > PL_maxsysfd); /* can change errno */ RESTORE_ERRNO; + if (rc < 0) { + PerlLIO_close(fd); + goto say_false; + } } #endif IoIFP(io) = fp; @@ -956,23 +973,25 @@ Perl_nextargv(pTHX_ GV *gv) } setdefout(PL_argvoutgv); PL_lastfd = PerlIO_fileno(IoIFP(GvIOp(PL_argvoutgv))); - (void)PerlLIO_fstat(PL_lastfd,&PL_statbuf); + if (PL_lastfd >= 0) { + (void)PerlLIO_fstat(PL_lastfd,&PL_statbuf); #ifdef HAS_FCHMOD - (void)fchmod(PL_lastfd,PL_filemode); + (void)fchmod(PL_lastfd,PL_filemode); #else - (void)PerlLIO_chmod(PL_oldname,PL_filemode); + (void)PerlLIO_chmod(PL_oldname,PL_filemode); #endif - if (fileuid != PL_statbuf.st_uid || filegid != PL_statbuf.st_gid) { - int rc = 0; + if (fileuid != PL_statbuf.st_uid || filegid != PL_statbuf.st_gid) { + int rc = 0; #ifdef HAS_FCHOWN - rc = fchown(PL_lastfd,fileuid,filegid); + rc = fchown(PL_lastfd,fileuid,filegid); #else #ifdef HAS_CHOWN - rc = PerlLIO_chown(PL_oldname,fileuid,filegid); + rc = PerlLIO_chown(PL_oldname,fileuid,filegid); #endif #endif - /* XXX silently ignore failures */ - PERL_UNUSED_VAR(rc); + /* XXX silently ignore failures */ + PERL_UNUSED_VAR(rc); + } } return IoIFP(GvIOp(gv)); } @@ -1169,8 +1188,12 @@ Perl_do_sysseek(pTHX_ GV *gv, Off_t pos, int whence) PERL_ARGS_ASSERT_DO_SYSSEEK; - if (io && (fp = IoIFP(io))) - return PerlLIO_lseek(PerlIO_fileno(fp), pos, whence); + if (io && (fp = IoIFP(io))) { + int fd = PerlIO_fileno(fp); + if (fd >= 0) { + return PerlLIO_lseek(fd, pos, whence); + } + } report_evil_fh(gv); SETERRNO(EBADF,RMS_IFI); return (Off_t)-1; @@ -1376,7 +1399,10 @@ Perl_my_stat_flags(pTHX_ const U32 flags) sv_setpvs(PL_statname, ""); if(io) { if (IoIFP(io)) { - return (PL_laststatval = PerlLIO_fstat(PerlIO_fileno(IoIFP(io)), &PL_statcache)); + int fd = PerlIO_fileno(IoIFP(io)); + if (fd >= 0) { + return (PL_laststatval = PerlLIO_fstat(fd, &PL_statcache)); + } } else if (IoDIRP(io)) { return (PL_laststatval = PerlLIO_fstat(my_dirfd(IoDIRP(io)), &PL_statcache)); } @@ -1739,9 +1765,13 @@ Perl_apply(pTHX_ I32 type, SV **mark, SV **sp) if ((gv = MAYBE_DEREF_GV(*mark))) { if (GvIO(gv) && IoIFP(GvIOp(gv))) { #ifdef HAS_FCHMOD + int fd = PerlIO_fileno(IoIFP(GvIOn(gv))); APPLY_TAINT_PROPER(); - if (fchmod(PerlIO_fileno(IoIFP(GvIOn(gv))), val)) - tot--; + if (fd < 0) { + SETERRNO(EBADF,RMS_IFI); + tot--; + } else if (fchmod(fd, val)) + tot--; #else Perl_die(aTHX_ PL_no_func, "fchmod"); #endif @@ -1775,8 +1805,12 @@ Perl_apply(pTHX_ I32 type, SV **mark, SV **sp) if ((gv = MAYBE_DEREF_GV(*mark))) { if (GvIO(gv) && IoIFP(GvIOp(gv))) { #ifdef HAS_FCHOWN + int fd = PerlIO_fileno(IoIFP(GvIOn(gv))); APPLY_TAINT_PROPER(); - if (fchown(PerlIO_fileno(IoIFP(GvIOn(gv))), val, val2)) + if (fd < 0) { + SETERRNO(EBADF,RMS_IFI); + tot--; + } else if (fchown(fd, val, val2)) tot--; #else Perl_die(aTHX_ PL_no_func, "fchown"); @@ -1965,9 +1999,12 @@ nothing in the core. if ((gv = MAYBE_DEREF_GV(*mark))) { if (GvIO(gv) && IoIFP(GvIOp(gv))) { #ifdef HAS_FUTIMES + int fd = PerlIO_fileno(IoIFP(GvIOn(gv))); APPLY_TAINT_PROPER(); - if (futimes(PerlIO_fileno(IoIFP(GvIOn(gv))), - (struct timeval *) utbufp)) + if (fd < 0) { + SETERRNO(EBADF,RMS_IFI); + tot--; + } else if (futimes(fd, (struct timeval *) utbufp)) tot--; #else Perl_die(aTHX_ PL_no_func, "futimes"); @@ -2082,15 +2119,17 @@ S_ingroup(pTHX_ Gid_t testgid, bool effective) bool rc = FALSE; anum = getgroups(0, gary); - Newx(gary, anum, Groups_t); - anum = getgroups(anum, gary); - while (--anum >= 0) - if (gary[anum] == testgid) { - rc = TRUE; - break; - } + if (anum > 0) { + Newx(gary, anum, Groups_t); + anum = getgroups(anum, gary); + while (--anum >= 0) + if (gary[anum] == testgid) { + rc = TRUE; + break; + } - Safefree(gary); + Safefree(gary); + } return rc; } #else diff --git a/ext/PerlIO-mmap/mmap.xs b/ext/PerlIO-mmap/mmap.xs index 4c96da8..6632544 100644 --- a/ext/PerlIO-mmap/mmap.xs +++ b/ext/PerlIO-mmap/mmap.xs @@ -40,8 +40,12 @@ PerlIOMmap_map(pTHX_ PerlIO *f) abort(); if (flags & PERLIO_F_CANREAD) { PerlIOBuf * const b = PerlIOSelf(f, PerlIOBuf); - const int fd = PerlIO_fileno(f); Stat_t st; + const int fd = PerlIO_fileno(f); + if (fd < 0) { + SETERRNO(EBADF,RMS_IFI); + return -1; + } code = Fstat(fd, &st); if (code == 0 && S_ISREG(st.st_mode)) { SSize_t len = st.st_size - b->posn; diff --git a/mg.c b/mg.c index 76912bd..6414349 100644 --- a/mg.c +++ b/mg.c @@ -1120,12 +1120,15 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg) #ifdef HAS_GETGROUPS { Groups_t *gary = NULL; - I32 i, num_groups = getgroups(0, gary); - Newx(gary, num_groups, Groups_t); - num_groups = getgroups(num_groups, gary); - for (i = 0; i < num_groups; i++) - Perl_sv_catpvf(aTHX_ sv, " %"IVdf, (IV)gary[i]); - Safefree(gary); + I32 i; + I32 num_groups = getgroups(0, gary); + if (num_groups > 0) { + Newx(gary, num_groups, Groups_t); + num_groups = getgroups(num_groups, gary); + for (i = 0; i < num_groups; i++) + Perl_sv_catpvf(aTHX_ sv, " %"IVdf, (IV)gary[i]); + Safefree(gary); + } } (void)SvIOK_on(sv); /* what a wonderful hack! */ #endif diff --git a/perl.c b/perl.c index 27d0d9e..452bc63 100644 --- a/perl.c +++ b/perl.c @@ -3691,6 +3691,7 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch, bool *suidscript) PerlIO *rsfp = NULL; dVAR; Stat_t tmpstatbuf; + int fd; PERL_ARGS_ASSERT_OPEN_SCRIPT; @@ -3796,13 +3797,20 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch, bool *suidscript) Perl_croak(aTHX_ "Can't open perl script \"%s\": %s\n", CopFILE(PL_curcop), Strerror(errno)); } + fd = PerlIO_fileno(rsfp); #if defined(HAS_FCNTL) && defined(F_SETFD) - /* ensure close-on-exec */ - fcntl(PerlIO_fileno(rsfp), F_SETFD, 1); + if (fd >= 0) { + /* ensure close-on-exec */ + if (fcntl(fd, F_SETFD, 1) < 0) { + Perl_croak(aTHX_ "Can't open perl script \"%s\": %s\n", + CopFILE(PL_curcop), Strerror(errno)); + } + } #endif - if (PerlLIO_fstat(PerlIO_fileno(rsfp), &tmpstatbuf) >= 0 - && S_ISDIR(tmpstatbuf.st_mode)) + if (fd < 0 || + (PerlLIO_fstat(fd, &tmpstatbuf) >= 0 + && S_ISDIR(tmpstatbuf.st_mode))) Perl_croak(aTHX_ "Can't open perl script \"%s\": %s\n", CopFILE(PL_curcop), Strerror(EISDIR)); @@ -3833,12 +3841,18 @@ S_validate_suid(pTHX_ PerlIO *rsfp) if (my_euid != my_uid || my_egid != my_gid) { /* (suidperl doesn't exist, in fact) */ dVAR; - - PerlLIO_fstat(PerlIO_fileno(rsfp),&PL_statbuf); /* may be either wrapped or real suid */ - if ((my_euid != my_uid && my_euid == PL_statbuf.st_uid && PL_statbuf.st_mode & S_ISUID) - || - (my_egid != my_gid && my_egid == PL_statbuf.st_gid && PL_statbuf.st_mode & S_ISGID) - ) + int fd = PerlIO_fileno(rsfp); + if (fd < 0) { + Perl_croak(aTHX_ "Illegal suidscript"); + } else { + if (PerlLIO_fstat(fd, &PL_statbuf) < 0) { /* may be either wrapped or real suid */ + Perl_croak(aTHX_ "Illegal suidscript"); + } + } + if ((my_euid != my_uid && my_euid == PL_statbuf.st_uid && PL_statbuf.st_mode & S_ISUID) + || + (my_egid != my_gid && my_egid == PL_statbuf.st_gid && PL_statbuf.st_mode & S_ISGID) + ) if (!PL_do_undump) Perl_croak(aTHX_ "YOU HAVEN'T DISABLED SET-ID SCRIPTS IN THE KERNEL YET!\n\ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n"); diff --git a/perlio.c b/perlio.c index d4c43d0..4b98f6b 100644 --- a/perlio.c +++ b/perlio.c @@ -2923,6 +2923,10 @@ PerlIO_importFILE(FILE *stdio, const char *mode) PerlIO *f = NULL; if (stdio) { PerlIOStdio *s; + int fd0 = fileno(stdio); + if (fd0 < 0) { + return NULL; + } if (!mode || !*mode) { /* We need to probe to see how we can open the stream so start with read/write and then try write and read @@ -2931,8 +2935,12 @@ PerlIO_importFILE(FILE *stdio, const char *mode) Note that the errno value set by a failing fdopen varies between stdio implementations. */ - const int fd = PerlLIO_dup(fileno(stdio)); - FILE *f2 = PerlSIO_fdopen(fd, (mode = "r+")); + const int fd = PerlLIO_dup(fd0); + FILE *f2; + if (fd < 0) { + return f; + } + f2 = PerlSIO_fdopen(fd, (mode = "r+")); if (!f2) { f2 = PerlSIO_fdopen(fd, (mode = "w")); } @@ -3351,8 +3359,8 @@ PerlIOStdio_unread(pTHX_ PerlIO *f, const void *vbuf, Size_t count) } if ((STDCHAR*)PerlSIO_get_ptr(s) != --eptr || ((*eptr & 0xFF) != ch)) { /* Did not change pointer as expected */ - fgetc(s); /* get char back again */ - break; + if (fgetc(s) != EOF) /* get char back again */ + break; } /* It worked ! */ count--; @@ -3668,6 +3676,10 @@ PerlIO_exportFILE(PerlIO * f, const char *mode) FILE *stdio = NULL; if (PerlIOValid(f)) { char buf[8]; + int fd = PerlIO_fileno(f); + if (fd < 0) { + return NULL; + } PerlIO_flush(f); if (!mode || !*mode) { mode = PerlIO_modestr(f, buf); diff --git a/pod/perldiag.pod b/pod/perldiag.pod index bca95e2..df23cd3 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -2292,6 +2292,10 @@ The C<"+"> is valid only when followed by digits, indicating a capturing group. See L)>|perlre/(?PARNO) (?-PARNO) (?+PARNO) (?R) (?0)>. +=item Illegal suidscript + +(F) The script run under suidperl was somehow illegal. + =item Illegal switch in PERL5OPT: -%c (X) The PERL5OPT environment variable may only be used to set the diff --git a/pp_sys.c b/pp_sys.c index 9f97177..ef64829 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -715,8 +715,10 @@ PP(pp_pipe_op) goto badexit; } #if defined(HAS_FCNTL) && defined(F_SETFD) - fcntl(fd[0],F_SETFD,fd[0] > PL_maxsysfd); /* ensure close-on-exec */ - fcntl(fd[1],F_SETFD,fd[1] > PL_maxsysfd); /* ensure close-on-exec */ + /* ensure close-on-exec */ + if ((fcntl(fd[0], F_SETFD,fd[0] > PL_maxsysfd) < 0) || + (fcntl(fd[1], F_SETFD,fd[1] > PL_maxsysfd) < 0)) + goto badexit; #endif RETPUSHYES; @@ -1627,8 +1629,9 @@ PP(pp_sysread) bool charstart = FALSE; STRLEN charskip = 0; STRLEN skip = 0; - GV * const gv = MUTABLE_GV(*++MARK); + int fd; + if ((PL_op->op_type == OP_READ || PL_op->op_type == OP_SYSREAD) && gv && (io = GvIO(gv)) ) { @@ -1659,6 +1662,8 @@ PP(pp_sysread) SETERRNO(EBADF,RMS_IFI); goto say_undef; } + /* Note that fd can here validly be -1, don't check it yet. */ + fd = PerlIO_fileno(IoIFP(io)); if ((fp_utf8 = PerlIO_isutf8(IoIFP(io))) && !IN_BYTES) { buffer = SvPVutf8_force(bufsv, blen); /* UTF-8 may not have been set if they are all low bytes */ @@ -1682,6 +1687,10 @@ PP(pp_sysread) if (PL_op->op_type == OP_RECV) { Sock_size_t bufsize; char namebuf[MAXPATHLEN]; + if (fd < 0) { + SETERRNO(EBADF,SS_IVCHAN); + RETPUSHUNDEF; + } #if (defined(VMS_DO_SOCKETS) && defined(DECCRTL_SOCKETS)) || defined(__QNXNTO__) bufsize = sizeof (struct sockaddr_in); #else @@ -1693,7 +1702,7 @@ PP(pp_sysread) #endif buffer = SvGROW(bufsv, (STRLEN)(length+1)); /* 'offset' means 'flags' here */ - count = PerlSock_recvfrom(PerlIO_fileno(IoIFP(io)), buffer, length, offset, + count = PerlSock_recvfrom(fd, buffer, length, offset, (struct sockaddr *)namebuf, &bufsize); if (count < 0) RETPUSHUNDEF; @@ -1735,6 +1744,7 @@ PP(pp_sysread) else offset = utf8_hop((U8 *)buffer,offset) - (U8 *) buffer; } + more_bytes: orig_size = SvCUR(bufsv); /* Allocating length + offset + 1 isn't perfect in the case of reading @@ -1765,14 +1775,18 @@ PP(pp_sysread) if (PL_op->op_type == OP_SYSREAD) { #ifdef PERL_SOCK_SYSREAD_IS_RECV if (IoTYPE(io) == IoTYPE_SOCKET) { - count = PerlSock_recv(PerlIO_fileno(IoIFP(io)), - buffer, length, 0); + if (fd < 0) + SETERRNO(EBADF,SS_IVCHAN); + else + count = PerlSock_recv(fd, length, 0); } else #endif { - count = PerlLIO_read(PerlIO_fileno(IoIFP(io)), - buffer, length); + if (fd < 0) + SETERRNO(EBADF,RMS_IFI); + else + count = PerlLIO_read(fd, buffer, length); } } else @@ -1848,7 +1862,7 @@ PP(pp_syswrite) dVAR; dSP; dMARK; dORIGMARK; dTARGET; SV *bufsv; const char *buffer; - SSize_t retval; + SSize_t retval = -1; STRLEN blen; STRLEN orig_blen_bytes; const int op_type = PL_op->op_type; @@ -1856,6 +1870,7 @@ PP(pp_syswrite) U8 *tmpbuf = NULL; GV *const gv = MUTABLE_GV(*++MARK); IO *const io = GvIO(gv); + int fd; if (op_type == OP_SYSWRITE && io) { const MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar); @@ -1886,6 +1901,11 @@ PP(pp_syswrite) SETERRNO(EBADF,RMS_IFI); goto say_undef; } + fd = PerlIO_fileno(IoIFP(io)); + if (fd < 0) { + SETERRNO(EBADF,SS_IVCHAN); + goto say_undef; + } /* Do this first to trigger any overloading. */ buffer = SvPV_const(bufsv, blen); @@ -1920,12 +1940,11 @@ PP(pp_syswrite) if (SP > MARK) { STRLEN mlen; char * const sockbuf = SvPVx(*++MARK, mlen); - retval = PerlSock_sendto(PerlIO_fileno(IoIFP(io)), buffer, blen, + retval = PerlSock_sendto(fd, buffer, blen, flags, (struct sockaddr *)sockbuf, mlen); } else { - retval - = PerlSock_send(PerlIO_fileno(IoIFP(io)), buffer, blen, flags); + retval = PerlSock_send(fd, buffer, blen, flags); } } else @@ -2008,15 +2027,13 @@ PP(pp_syswrite) } #ifdef PERL_SOCK_SYSWRITE_IS_SEND if (IoTYPE(io) == IoTYPE_SOCKET) { - retval = PerlSock_send(PerlIO_fileno(IoIFP(io)), - buffer, length, 0); + retval = PerlSock_send(fd, buffer, length, 0); } else #endif { /* See the note at doio.c:do_print about filesize limits. --jhi */ - retval = PerlLIO_write(PerlIO_fileno(IoIFP(io)), - buffer, length); + retval = PerlLIO_write(fd, buffer, length); } } @@ -2224,13 +2241,19 @@ PP(pp_truncate) result = 0; } else { - PerlIO_flush(fp); + int fd = PerlIO_fileno(fp); + if (fd < 0) { + SETERRNO(EBADF,RMS_IFI); + result = 0; + } else { + PerlIO_flush(fp); #ifdef HAS_TRUNCATE - if (ftruncate(PerlIO_fileno(fp), len) < 0) + if (ftruncate(fd, len) < 0) #else - if (my_chsize(PerlIO_fileno(fp), len) < 0) + if (my_chsize(fd, len) < 0) #endif - result = 0; + result = 0; + } } } } @@ -2248,9 +2271,10 @@ PP(pp_truncate) { const int tmpfd = PerlLIO_open(name, O_RDWR); - if (tmpfd < 0) + if (tmpfd < 0) { + SETERRNO(EBADF,RMS_IFI); result = 0; - else { + } else { if (my_chsize(tmpfd, len) < 0) result = 0; PerlLIO_close(tmpfd); @@ -2388,8 +2412,10 @@ PP(pp_socket) TAINT_PROPER("socket"); fd = PerlSock_socket(domain, type, protocol); - if (fd < 0) + if (fd < 0) { + SETERRNO(EBADF,RMS_IFI); RETPUSHUNDEF; + } IoIFP(io) = PerlIO_fdopen(fd, "r"SOCKET_OPEN_MODE); /* stdio gets confused about sockets */ IoOFP(io) = PerlIO_fdopen(fd, "w"SOCKET_OPEN_MODE); IoTYPE(io) = IoTYPE_SOCKET; @@ -2400,7 +2426,8 @@ PP(pp_socket) RETPUSHUNDEF; } #if defined(HAS_FCNTL) && defined(F_SETFD) - fcntl(fd, F_SETFD, fd > PL_maxsysfd); /* ensure close-on-exec */ + if (fcntl(fd, F_SETFD, fd > PL_maxsysfd) < 0) /* ensure close-on-exec */ + RETPUSHUNDEF; #endif RETPUSHYES; @@ -2445,8 +2472,10 @@ PP(pp_sockpair) RETPUSHUNDEF; } #if defined(HAS_FCNTL) && defined(F_SETFD) - fcntl(fd[0],F_SETFD,fd[0] > PL_maxsysfd); /* ensure close-on-exec */ - fcntl(fd[1],F_SETFD,fd[1] > PL_maxsysfd); /* ensure close-on-exec */ + /* ensure close-on-exec */ + if ((fcntl(fd[0],F_SETFD,fd[0] > PL_maxsysfd) < 0) || + (fcntl(fd[1],F_SETFD,fd[1] > PL_maxsysfd) < 0)) + RETPUSHUNDEF; #endif RETPUSHYES; @@ -2467,16 +2496,20 @@ PP(pp_bind) IO * const io = GvIOn(gv); STRLEN len; int op_type; + int fd; if (!IoIFP(io)) goto nuts; + fd = PerlIO_fileno(IoIFP(io)); + if (fd < 0) + goto nuts; addr = SvPV_const(addrsv, len); op_type = PL_op->op_type; TAINT_PROPER(PL_op_desc[op_type]); if ((op_type == OP_BIND - ? PerlSock_bind(PerlIO_fileno(IoIFP(io)), (struct sockaddr *)addr, len) - : PerlSock_connect(PerlIO_fileno(IoIFP(io)), (struct sockaddr *)addr, len)) + ? PerlSock_bind(fd, (struct sockaddr *)addr, len) + : PerlSock_connect(fd, (struct sockaddr *)addr, len)) >= 0) RETPUSHYES; else @@ -2554,7 +2587,8 @@ PP(pp_accept) goto badexit; } #if defined(HAS_FCNTL) && defined(F_SETFD) - fcntl(fd, F_SETFD, fd > PL_maxsysfd); /* ensure close-on-exec */ + if (fcntl(fd, F_SETFD, fd > PL_maxsysfd) < 0) /* ensure close-on-exec */ + goto badexit; #endif #ifdef __SCO_VERSION__ @@ -2608,6 +2642,8 @@ PP(pp_ssockopt) goto nuts; fd = PerlIO_fileno(IoIFP(io)); + if (fd < 0) + goto nuts; switch (optype) { case OP_GSOCKOPT: SvGROW(sv, 257); @@ -2683,6 +2719,8 @@ PP(pp_getpeername) SvCUR_set(sv, len); *SvEND(sv) ='\0'; fd = PerlIO_fileno(IoIFP(io)); + if (fd < 0) + goto nuts; switch (optype) { case OP_GETSOCKNAME: if (PerlSock_getsockname(fd, (struct sockaddr *)SvPVX(sv), &len) < 0) @@ -2764,9 +2802,14 @@ PP(pp_stat) } if (io) { if (IoIFP(io)) { - PL_laststatval = - PerlLIO_fstat(PerlIO_fileno(IoIFP(io)), &PL_statcache); - havefp = TRUE; + int fd = PerlIO_fileno(IoIFP(io)); + if (fd < 0) { + PL_laststatval = -1; + SETERRNO(EBADF,RMS_IFI); + } else { + PL_laststatval = PerlLIO_fstat(fd, &PL_statcache); + havefp = TRUE; + } } else if (IoDIRP(io)) { PL_laststatval = PerlLIO_fstat(my_dirfd(IoDIRP(io)), &PL_statcache); @@ -3256,9 +3299,13 @@ PP(pp_fttty) if (GvIO(gv) && IoIFP(GvIOp(gv))) fd = PerlIO_fileno(IoIFP(GvIOp(gv))); else if (name && isDIGIT(*name)) - fd = atoi(name); + fd = atoi(name); else FT_RETURNUNDEF; + if (fd < 0) { + SETERRNO(EBADF,RMS_IFI); + FT_RETURNUNDEF; + } if (PerlLIO_isatty(fd)) FT_RETURNYES; FT_RETURNNO; @@ -3307,9 +3354,15 @@ PP(pp_fttext) PL_laststatval = -1; PL_laststype = OP_STAT; if (io && IoIFP(io)) { + int fd; if (! PerlIO_has_base(IoIFP(io))) DIE(aTHX_ "-T and -B not implemented on filehandles"); - PL_laststatval = PerlLIO_fstat(PerlIO_fileno(IoIFP(io)), &PL_statcache); + fd = PerlIO_fileno(IoIFP(io)); + if (fd < 0) { + SETERRNO(EBADF,RMS_IFI); + FT_RETURNUNDEF; + } + PL_laststatval = PerlLIO_fstat(fd, &PL_statcache); if (PL_laststatval < 0) FT_RETURNUNDEF; if (S_ISDIR(PL_statcache.st_mode)) { /* handle NFS glitch */ @@ -3339,6 +3392,7 @@ PP(pp_fttext) } } else { + int fd; sv_setpv(PL_statname, SvPV_nomg_const_nolen(sv)); really_filename: PL_statgv = NULL; @@ -3358,9 +3412,16 @@ PP(pp_fttext) FT_RETURNUNDEF; } PL_laststype = OP_STAT; - PL_laststatval = PerlLIO_fstat(PerlIO_fileno(fp), &PL_statcache); + fd = PerlIO_fileno(fp); + if (fd < 0) { + (void)PerlIO_close(fp); + SETERRNO(EBADF,RMS_IFI); + FT_RETURNUNDEF; + } + PL_laststatval = PerlLIO_fstat(fd, &PL_statcache); if (PL_laststatval < 0) { (void)PerlIO_close(fp); + SETERRNO(EBADF,RMS_IFI); FT_RETURNUNDEF; } PerlIO_binmode(aTHX_ fp, '<', O_BINARY, NULL); @@ -3475,19 +3536,19 @@ PP(pp_chdir) if (IoDIRP(io)) { PUSHi(fchdir(my_dirfd(IoDIRP(io))) >= 0); } else if (IoIFP(io)) { - PUSHi(fchdir(PerlIO_fileno(IoIFP(io))) >= 0); + int fd = PerlIO_fileno(IoIFP(io)); + if (fd < 0) { + goto nuts; + } + PUSHi(fchdir(fd) >= 0); } else { - report_evil_fh(gv); - SETERRNO(EBADF, RMS_IFI); - PUSHi(0); + goto nuts; } + } else { + goto nuts; } - else { - report_evil_fh(gv); - SETERRNO(EBADF,RMS_IFI); - PUSHi(0); - } + #else DIE(aTHX_ PL_no_func, "fchdir"); #endif @@ -3500,6 +3561,12 @@ PP(pp_chdir) hv_delete(GvHVn(PL_envgv),"DEFAULT",7,G_DISCARD); #endif RETURN; + + nuts: + report_evil_fh(gv); + SETERRNO(EBADF,RMS_IFI); + PUSHi(0); + RETURN; } PP(pp_chown) @@ -4194,7 +4261,8 @@ PP(pp_system) if (did_pipes) { PerlLIO_close(pp[0]); #if defined(HAS_FCNTL) && defined(F_SETFD) - fcntl(pp[1], F_SETFD, FD_CLOEXEC); + if (fcntl(pp[1], F_SETFD, FD_CLOEXEC) < 0) + RETPUSHUNDEF; #endif } if (PL_op->op_flags & OPf_STACKED) { diff --git a/util.c b/util.c index 0a0ee40..343bf72 100644 --- a/util.c +++ b/util.c @@ -1710,13 +1710,16 @@ void Perl_croak_no_mem(void) { dTHX; - int rc; - /* Can't use PerlIO to write as it allocates memory */ - rc = PerlLIO_write(PerlIO_fileno(Perl_error_log), - PL_no_mem, sizeof(PL_no_mem)-1); - /* silently ignore failures */ - PERL_UNUSED_VAR(rc); + int fd = PerlIO_fileno(Perl_error_log); + if (fd < 0) + SETERRNO(EBADF,RMS_IFI); + else { + /* Can't use PerlIO to write as it allocates memory */ + int rc = PerlLIO_write(fd, PL_no_mem, sizeof(PL_no_mem)-1); + /* silently ignore failures */ + PERL_UNUSED_VAR(rc); + } my_exit(1); } @@ -2308,7 +2311,8 @@ Perl_my_popen_list(pTHX_ const char *mode, int n, SV **args) PerlLIO_close(pp[0]); #if defined(HAS_FCNTL) && defined(F_SETFD) /* Close error pipe automatically if exec works */ - fcntl(pp[1], F_SETFD, FD_CLOEXEC); + if (fcntl(pp[1], F_SETFD, FD_CLOEXEC) < 0) + return NULL; #endif } /* Now dup our end of _the_ pipe to right position */ @@ -2453,7 +2457,8 @@ Perl_my_popen(pTHX_ const char *cmd, const char *mode) if (did_pipes) { PerlLIO_close(pp[0]); #if defined(HAS_FCNTL) && defined(F_SETFD) - fcntl(pp[1], F_SETFD, FD_CLOEXEC); + if (fcntl(pp[1], F_SETFD, FD_CLOEXEC) < 0) + return NULL; #endif } if (p[THIS] != (*mode == 'r')) { -- 1.9.2 ```

[p5pRT]

From @Hugmeir

On Mon\, May 5\, 2014 at 3​:13 PM\, Jarkko Hietaniemi \jhi@&#8203;iki\.fi wrote​:

Refreshed patch attached.

Sigh. This is getting annoying. Too many damn code paths. One more spot fixed\, in perl.c (if we already did fd=fileno\, let's use the fd...) Attached.

(\<old_grumpy_man>And running full "make test" is too damn slow these days.\</old_grumpy_man>)

TEST_JOBS=30 make test_harness -j30

:D

[p5pRT]

From @jhi

On Monday-201405-05\, 9​:38\, Brian Fraser via RT wrote​:

TEST_JOBS=30 make test_harness -j30

Dude\, can you spare some cores?

[p5pRT]

From @tux

On Mon\, 05 May 2014 09​:39​:58 -0400\, Jarkko Hietaniemi \jhi@&#8203;iki\.fi wrote​:

On Monday-201405-05\, 9​:38\, Brian Fraser via RT wrote​:

TEST_JOBS=30 make test_harness -j30

Dude\, can you spare some cores?

Would access to

Linux 2.6.32-358.el6.x86_64/#1 x86_64 Xeon(R) CPU L5640 @​ 2.27GHz/2267(24) x86_64 96729 Mb

Help you gain more speed in your work?

-- H.Merijn Brand http​://tux.nl Perl Monger http​://amsterdam.pm.org/ using perl5.00307 .. 5.19 porting perl5 on HP-UX\, AIX\, and openSUSE http​://mirrors.develooper.com/hpux/ http​://www.test-smoke.org/ http​://qa.perl.org http​://www.goldmark.org/jeff/stupid-disclaimers/

[p5pRT]

From @jhi

On Monday-201405-05\, 9​:46\, H. Merijn Brand via RT wrote​:

Linux 2.6.32-358.el6.x86_64/#1 x86_64 Xeon(R) CPU L5640 @​ 2.27GHz/2267(24) x86_64 96729 Mb Help you gain more speed in your work?

It would be certainly faster than my five-year old MacBook Pro :-)

[p5pRT]

From @demerphq

On 5 May 2014 15​:53\, Jarkko Hietaniemi \jhi@&#8203;iki\.fi wrote​:

On Monday-201405-05\, 9​:46\, H. Merijn Brand via RT wrote​:

Linux 2.6.32-358.el6.x86_64/#1 x86_64 Xeon(R) CPU L5640 @​ 2.27GHz/2267(24) x86_64 96729 Mb

Help you gain more speed in your work?

It would be certainly faster than my five-year old MacBook Pro :-)

We will fix that then.

Yves

-- perl -Mre=debug -e "/just|another|perl|hacker/"

[p5pRT]

From dennis@kaarsemaker.net

On ma\, 2014-05-05 at 16​:07 +0200\, demerphq wrote​:

On 5 May 2014 15​:53\, Jarkko Hietaniemi \jhi@&#8203;iki\.fi wrote​: On Monday-201405-05\, 9​:46\, H. Merijn Brand via RT wrote​: Linux 2.6.32-358.el6.x86_64/#1 x86_64 Xeon(R) CPU L5640 @​ 2.27GHz/2267(24) x86_64 96729 Mb

Help you gain more speed in your work? It would be certainly faster than my five-year old MacBook Pro :-)

We will fix that then.

The power of delegation​:

[dkaarsemaker@​dromedary-001 ~]$ id jhi uid=1156(jhi) gid=1003(p5p) groups=1003(p5p)

:)

-- Dennis Kaarsemaker http​://www.kaarsemaker.net

[p5pRT]

From @tonycoz

On Mon May 05 05​:33​:07 2014\, jhi wrote​:

On Monday-201405-05\, 2​:56\, Tony Cook via RT wrote​:

+++ b/dist/IO/IO.xs Elsewhere you use EBADF when fd is negative.

Yes\, I remember this spot... I did use EINVAL for consistency with the existing logic *at this spot*​: if there was no file pointer\, it used EINVAL. But of course EBADF would be more consistent with the rest of the change. I dunno. Which "failure contour" to follow?

I'm aiming for the old behaviour - fsync() etc would have been setting errno=EBADF when supplied with a bad file handle.

@​@​ -1616\,7 +1618\,7 @​@​ PP(pp_sysread) + SSize_t count = -1; Shouldn't this explicitly set count rather than relying upon the initialization at the top?

I think I did the count init not so much because of the is-fd-negative logic but because I think I saw a possible code path where count was left uninitialized. But can't see it now\, so recanted that init.

(Though\, in principle\, initializing a variable to an illegal value as opposed to uninitialized should not cause *more* failures\, if they do\, there's something rotten with the logic...)

While I was looking at pp_sysread + pp_syswrite I cleaned up some further logic.

I wasn't clear enough here\, this code​:

@​@​ -1765\,14 +1775\,18 @​@​ PP(pp_sysread)   if (PL_op->op_type == OP_SYSREAD) { #ifdef PERL_SOCK_SYSREAD_IS_RECV   if (IoTYPE(io) == IoTYPE_SOCKET) { - count = PerlSock_recv(PerlIO_fileno(IoIFP(io))\, - buffer\, length\, 0); + if (fd \< 0) + SETERRNO(EBADF\,SS_IVCHAN); + else + count = PerlSock_recv(fd\, length\, 0);   }   else #endif   { - count = PerlLIO_read(PerlIO_fileno(IoIFP(io))\, - buffer\, length); + if (fd \< 0) + SETERRNO(EBADF\,RMS_IFI); + else + count = PerlLIO_read(fd\, buffer\, length);   }   }   else

doesn't set count when fd is negative\, probably breaking the code that follows that checks and uses count.

With the initialization\, the first time around the loop would have been safe\, but on a UTF-8 stream\, sysread() can loop to fill out partial UTF-8 sequences\, which would have left count as the previous value - I think fd could change if we were reading from STDIN and another thread closed it.

@​@​ -696\,7 +696\,10 @​@​ S_openn_cleanup(pTHX_ GV *gv\, IO *io\, PerlIO *fp\, char *mode\, const char *oname\,   is assigned to (say) STDOUT - for now let dup2() fail   and provide the error   */ - if (PerlLIO_dup2(fd\, savefd) \< 0) { + if (fd \< 0) { + SETERRNO(EBADF\,RMS_IFI); + goto say_false; + } else if (PerlLIO_dup2(fd\, savefd) \< 0) {   (void)PerlIO_close(fp);   goto say_false;   }

The comment you can see the tail of here is now incorrect\, I think.

@​@​ -755\,8 +768\,12 @​@​ S_openn_cleanup(pTHX_ GV *gv\, IO *io\, PerlIO *fp\, char *mode\, const char *oname\, #if defined(HAS_FCNTL) && defined(F_SETFD)   if (fd >= 0) {   dSAVE_ERRNO; - fcntl(fd\,F_SETFD\,fd > PL_maxsysfd); /* can change errno */ + int rc = fcntl(fd\,F_SETFD\,fd > PL_maxsysfd); /* can change errno */   RESTORE_ERRNO; + if (rc \< 0) { + PerlLIO_close(fd); + goto say_false; + }   } #endif   IoIFP(io) = fp;

If we're failing the open() based on fcntl() failing\, the errno from that failure should be visible to the caller. I think that means we can remove the dSAVE_ERRNO/RESTORE_ERRNO pair.

Sigh. This is getting annoying. Too many damn code paths. One more spot fixed\, in perl.c (if we already did fd=fileno\, let's use the fd...) Attached.

Comments based on this patch.

Tony

[p5pRT]

From @jhi

EINVAL. But of course EBADF would be more consistent with the rest of the change. I dunno. Which "failure contour" to follow?

I'm aiming for the old behaviour - fsync() etc would have been setting errno=EBADF when supplied with a bad file handle.

Ah\, I see. With that in mind\, IO.xs given a new shake.

I wasn't clear enough here\, this code​:

@​@​ -1765\,14 +1775\,18 @​@​ PP(pp_sysread) if (PL_op->op_type == OP_SYSREAD) { ... + if (fd \< 0) + SETERRNO(EBADF\,RMS_IFI); + else + count = PerlLIO_read(fd\, buffer\, length); } } else

doesn't set count when fd is negative\, probably breaking the code that follows that checks and uses count.

Now see. Now setting the count to -1 on the failure branches.

in a UTF-8 stream\, sysread() can loop to fill out partial UTF-8 sequences\, which would have left count as the previous value

Years of therapy... all wasted.

- I think fd could change if we were reading from STDIN and another thread closed it.

Aaaaaa. Hmmmm... maybe reestablishing fd from fileno at more_bytes label would help for this?

(Not attaching refreshed patch until we hash this one out.)

@​@​ -755\,8 +768\,12 @​@​ S_openn_cleanup(pTHX_ GV *gv\, IO *io\, PerlIO *fp\, char *mode\, const char *oname\, #if defined(HAS_FCNTL) && defined(F_SETFD) if (fd >= 0) { dSAVE_ERRNO; - fcntl(fd\,F_SETFD\,fd > PL_maxsysfd); /* can change errno */ + int rc = fcntl(fd\,F_SETFD\,fd > PL_maxsysfd); /* can change errno */ RESTORE_ERRNO; + if (rc \< 0) { + PerlLIO_close(fd); + goto say_false; + } } #endif IoIFP(io) = fp;

If we're failing the open() based on fcntl() failing\, the errno from that failure should be visible to the caller. I think that means we can remove the dSAVE_ERRNO/RESTORE_ERRNO pair.

Gone.

[p5pRT]

From @jhi

Oh\, well. Went ahead and refreshed patch anyway.