New issue
Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.
By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.
Already on GitHub? Sign in to your account
[PATCH] Coverity: check for negative return values from/to library calls #13774
Comments
From @jhiDozens of too trusting fileno calls (and then using the returned fds for Attached. |
From @jhi0001-Fix-for-Coverity-perl5-CIDs-28990.29003-29005.29011-.patchFrom c0b207e73c8a503a10759b56243fc02cb43fdbfb Mon Sep 17 00:00:00 2001
From: Jarkko Hietaniemi <jhi@iki.fi>
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<C<(?I<PARNO>)>|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
|
From @jhiAttached. |
From @jhi0001-Fix-for-Coverity-perl5-CIDs-29813-29814-29819-29821..patchFrom 9b4739a6f95d91657d94e249f08d03cff6cb1a1d Mon Sep 17 00:00:00 2001
From: Jarkko Hietaniemi <jhi@iki.fi>
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
|
From @tonycozOn Sat Apr 26 12:58:05 2014, jhi wrote:
Fails to build with -Duseithreads due to missing aTHX_ in: if (fd < 0) { Some other issues, the original code here for example (doio.c): @@ -1775,8 +1797,9 @@ Perl_apply(pTHX_ I32 type, SV **mark, SV **sp) 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 |
The RT System itself - Status changed from 'new' to 'open' |
From @tonycozOn Sat Apr 26 13:01:39 2014, jhi wrote:
--- a/doio.c 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 |
The RT System itself - Status changed from 'new' to 'open' |
From @jhiOn Sunday-201404-27, 23:48, Tony Cook via RT wrote:
Refreshed patch attached. (Also now doing the RESTORE_ERRNO before that 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 (2) we should be doing the dance in much more regimented way so that the And then there's of course my more blue-sky mind thinking that the { bool => undef, I32 => ENOENT, ... } That is, the reason for failure would be embedded in the return value.
Yeah. The FD_CLOEXEC seems to be common thing to do whenever acquiring
|
From @jhi0001-Fix-for-Coverity-perl5-CIDs-29813-29814-29819-29821..patchFrom fa18b49cc3cc3cbc5006b12f43011227d99b8c74 Mon Sep 17 00:00:00 2001
From: Jarkko Hietaniemi <jhi@iki.fi>
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
|
From @jhi
Yeah. Amended the patch to set EBADF when applicable. Also now getting failures from tests, will see what's up with them.
|
From @jhi
I now explictly set errno to EBADF if fd is zero (if necessary, some
One stray "goto failure;" too many broke PerlIO::scalar. Now passing
|
From @jhi0001-Fix-for-Coverity-perl5-CIDs-28990.29003-29005.29011-.patchFrom 5c22c14b9f4e61ae885182da2e0a12420849d3a6 Mon Sep 17 00:00:00 2001
From: Jarkko Hietaniemi <jhi@iki.fi>
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<C<(?I<PARNO>)>|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
|
From @bulk88On Sat Apr 26 12:58:05 2014, jhi wrote:
Why this isn't a horrible perf degradation? -- |
From @bulk88It seems this patch changes user visible behavior, when previously true was returned, is now undef. What are the pros and cons of this? -- |
From @jhiOn Wednesday-201404-30, 1:23, bulk88 via RT wrote:
Huh? Before: fileno was called After: (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 |
From @jhiOn Wednesday-201404-30, 1:31, bulk88 via RT wrote:
Could you be more detailed? Where is the user visible behavior changed? |
From @bulk88On Wed Apr 30 03:43:33 2014, jhi wrote:
pp_socket currently if (!IoIFP(io) || !IoOFP(io)) { RETPUSHYES; Your patch is @@ -2400,7 +2402,8 @@ PP(pp_socket) 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? -- |
From @jhiOn Wednesday-201404-30, 16:06, bulk88 via RT wrote:
Ahh, I see what you mean. Well, this is kind of fuzzy area... if you So I extended that "if the file handle is dubious" logic to include also
The PL_maxsysfd is initialized from #define MAXSYSFD which is by default FWIW, we should probably use the O_CLOEXEC flag where available, when |
From @LeontOn Wed, Apr 30, 2014 at 10:47 PM, Jarkko Hietaniemi <jhi@iki.fi> wrote:
Technically yes, though I share the impression it's universally 1.
AFAIK that's a Linuxism (though BSDs seem to be implementing it too now), Leon |
From @jhiOn Wednesday-201404-30, 17:57, Leon Timmermans wrote:
It's Official, don't know exactly since when: http://pubs.opengroup.org/onlinepubs/9699919799/functions/open.html |
From @jhiYet again refreshed patch, found two more spots with the same |
From @jhi0001-Fix-for-Coverity-perl5-CIDs-28990.29003-29005.29011-.patchFrom f883ae96667b0521489a69a57381a6d22f554bb0 Mon Sep 17 00:00:00 2001
From: Jarkko Hietaniemi <jhi@iki.fi>
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<C<(?I<PARNO>)>|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
|
From @jhiOn Thursday-201405-01, 17:05, Jarkko Hietaniemi wrote:
And one more spot added (missed that a new Coverity scan had found |
From @jhi0001-fcntl-and-fgetc-calls-unchecked-for-failure.patchFrom 998ff75995abae05d829ac06d7c73a3af848ca9b Mon Sep 17 00:00:00 2001
From: Jarkko Hietaniemi <jhi@iki.fi>
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
|
From @jhiOn Thursday-201405-01, 21:06, Jarkko Hietaniemi wrote:
Argh. Please discard this very latest patch ("one more spot"), sorry |
From @jhiUpdated patch attached. |
From @jhi0001-fcntl-and-fgetc-calls-unchecked-for-failure.patchFrom 998ff75995abae05d829ac06d7c73a3af848ca9b Mon Sep 17 00:00:00 2001
From: Jarkko Hietaniemi <jhi@iki.fi>
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
|
From @jhiOn Thursday-201405-01, 17:05, Jarkko Hietaniemi wrote:
I decided to merge this ticket with perl #121745 which checked for fcntl So updated combined patch attached, and please ignore/merge #121745. |
From @jhi0001-Check-fileno-numgroups-1-check-fcntl-fgetc-failures.patchFrom 199fd738e900d42cde4181d3a4a363532c0d6fea Mon Sep 17 00:00:00 2001
From: Jarkko Hietaniemi <jhi@iki.fi>
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<C<(?I<PARNO>)>|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
|
From @jhi0001-Check-fileno-numgroups-1-check-fcntl-fgetc-failures.patchFrom 28be09767a365f0cc924eb0870fce37c812897fd Mon Sep 17 00:00:00 2001
From: Jarkko Hietaniemi <jhi@iki.fi>
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<C<(?I<PARNO>)>|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
|
From @HugmeirOn Mon, May 5, 2014 at 3:13 PM, Jarkko Hietaniemi <jhi@iki.fi> wrote:
TEST_JOBS=30 make test_harness -j30 :D |
From @jhiOn Monday-201405-05, 9:38, Brian Fraser via RT wrote:
Dude, can you spare some cores? |
From @TuxOn Mon, 05 May 2014 09:39:58 -0400, Jarkko Hietaniemi <jhi@iki.fi>
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? -- |
From @demerphqOn 5 May 2014 15:53, Jarkko Hietaniemi <jhi@iki.fi> wrote:
We will fix that then. Yves -- |
From dennis@kaarsemaker.netOn ma, 2014-05-05 at 16:07 +0200, demerphq wrote:
The power of delegation: [dkaarsemaker@dromedary-001 ~]$ id jhi :) -- |
From @tonycozOn Mon May 05 05:33:07 2014, jhi wrote:
I'm aiming for the old behaviour - fsync() etc would have been setting errno=EBADF when supplied with a bad file handle.
I wasn't clear enough here, this code: @@ -1765,14 +1775,18 @@ PP(pp_sysread) 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, 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 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.
Comments based on this patch. Tony |
From @jhi
Ah, I see. With that in mind, IO.xs given a new shake.
Now see. Now setting the count to -1 on the failure branches.
Years of therapy... all wasted.
Aaaaaa. Hmmmm... maybe reestablishing fd from fileno at more_bytes (Not attaching refreshed patch until we hash this one out.)
Gone. |
From @jhiOh, well. Went ahead and refreshed patch anyway. |
From @jhi0001-Check-fileno-numgroups-1-check-fcntl-fgetc-failures.patchFrom 026cc3058c2fec9beb42215b49dadc487f17b725 Mon Sep 17 00:00:00 2001
From: Jarkko Hietaniemi <jhi@iki.fi>
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 | 35 ++++++++---
dist/threads/threads.xs | 10 +--
doio.c | 106 ++++++++++++++++++++-----------
ext/PerlIO-mmap/mmap.xs | 6 +-
mg.c | 15 +++--
perl.c | 34 +++++++---
perlio.c | 20 ++++--
pod/perldiag.pod | 4 ++
pp_sys.c | 162 +++++++++++++++++++++++++++++++++++-------------
util.c | 21 ++++---
10 files changed, 292 insertions(+), 121 deletions(-)
diff --git a/dist/IO/IO.xs b/dist/IO/IO.xs
index 9056cb6..829d898 100644
--- a/dist/IO/IO.xs
+++ b/dist/IO/IO.xs
@@ -104,11 +104,17 @@ io_blocking(pTHX_ InputStream f, int block)
{
#if defined(HAS_FCNTL)
int RETVAL;
- if(!f) {
+ int fd;
+ if (!f) {
errno = EBADF;
return -1;
}
- RETVAL = fcntl(PerlIO_fileno(f), F_GETFL, 0);
+ fd = PerlIO_fileno(f);
+ if (fd < 0) {
+ errno = EBADF;
+ return -1;
+ }
+ RETVAL = fcntl(fd, F_GETFL, 0);
if (RETVAL >= 0) {
int mode = RETVAL;
int newmode = mode;
@@ -143,7 +149,7 @@ io_blocking(pTHX_ InputStream f, int block)
}
#endif
if (newmode != mode) {
- const int ret = fcntl(PerlIO_fileno(f),F_SETFL,newmode);
+ const int ret = fcntl(fd, F_SETFL, newmode);
if (ret < 0)
RETVAL = ret;
}
@@ -154,7 +160,7 @@ io_blocking(pTHX_ InputStream f, int block)
if (block >= 0) {
unsigned long flags = !block;
/* ioctl claims to take char* but really needs a u_long sized buffer */
- const int ret = ioctl(PerlIO_fileno(f), FIONBIO, (char*)&flags);
+ const int ret = ioctl(fd, FIONBIO, (char*)&flags);
if (ret != 0)
return -1;
/* Win32 has no way to get the current blocking status of a socket.
@@ -524,9 +530,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 = EBADF;
+ }
+ } else {
RETVAL = -1;
errno = EINVAL;
}
@@ -557,9 +569,14 @@ sockatmark (sock)
int fd;
CODE:
{
- fd = PerlIO_fileno(sock);
#ifdef HAS_SOCKATMARK
- RETVAL = sockatmark(fd);
+ int fd = PerlIO_fileno(sock);
+ if (fd < 0) {
+ errno = EBADF;
+ RETVAL = -1;
+ } else {
+ RETVAL = sockatmark(fd);
+ }
#else
{
int flag = 0;
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..0f2ac68 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);
@@ -754,9 +767,10 @@ 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 */
- RESTORE_ERRNO;
+ if (fcntl(fd, F_SETFD, fd > PL_maxsysfd) < 0) {
+ PerlLIO_close(fd);
+ goto say_false;
+ }
}
#endif
IoIFP(io) = fp;
@@ -956,23 +970,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 +1185,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 +1396,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 +1762,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 +1802,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 +1996,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 +2116,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<C<(?I<PARNO>)>|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..9aa652f 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,10 @@ 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 +1689,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 +1704,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 +1746,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 +1777,21 @@ 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);
+ count = -1;
+ } 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);
+ count = -1;
+ }
+ else
+ count = PerlLIO_read(fd, buffer, length);
}
}
else
@@ -1856,6 +1875,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 +1906,12 @@ PP(pp_syswrite)
SETERRNO(EBADF,RMS_IFI);
goto say_undef;
}
+ fd = PerlIO_fileno(IoIFP(io));
+ if (fd < 0) {
+ SETERRNO(EBADF,SS_IVCHAN);
+ retval = -1;
+ goto say_undef;
+ }
/* Do this first to trigger any overloading. */
buffer = SvPV_const(bufsv, blen);
@@ -1920,12 +1946,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 +2033,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 +2247,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 +2277,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 +2418,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 +2432,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 +2478,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 +2502,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 +2593,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 +2648,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 +2725,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 +2808,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 +3305,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 +3360,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 +3398,7 @@ PP(pp_fttext)
}
}
else {
+ int fd;
sv_setpv(PL_statname, SvPV_nomg_const_nolen(sv));
really_filename:
PL_statgv = NULL;
@@ -3358,9 +3418,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 +3542,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 +3567,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 +4267,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
|
From @tonycozOn Mon May 05 18:18:16 2014, jhi wrote:
Sorry, yes, I think it should. The current code has a race condition if the file is closed between fetching the fd and using it, but the patch makes that larger. Tony |
From @jhiOn Tuesday-201405-06, 20:26, Tony Cook via RT wrote:
So done.
And here we go again, attaching... |
From @jhi0001-Check-fileno-numgroups-1-check-fcntl-fgetc-failures.patchFrom a08c8c52935454cf7fbac7bb4397dcab7bae658a Mon Sep 17 00:00:00 2001
From: Jarkko Hietaniemi <jhi@iki.fi>
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 | 35 +++++++---
dist/threads/threads.xs | 10 +--
doio.c | 106 +++++++++++++++++++++----------
ext/PerlIO-mmap/mmap.xs | 6 +-
mg.c | 15 +++--
perl.c | 34 +++++++---
perlio.c | 20 ++++--
pod/perldiag.pod | 4 ++
pp_sys.c | 165 +++++++++++++++++++++++++++++++++++-------------
util.c | 21 +++---
10 files changed, 295 insertions(+), 121 deletions(-)
diff --git a/dist/IO/IO.xs b/dist/IO/IO.xs
index 9056cb6..829d898 100644
--- a/dist/IO/IO.xs
+++ b/dist/IO/IO.xs
@@ -104,11 +104,17 @@ io_blocking(pTHX_ InputStream f, int block)
{
#if defined(HAS_FCNTL)
int RETVAL;
- if(!f) {
+ int fd;
+ if (!f) {
errno = EBADF;
return -1;
}
- RETVAL = fcntl(PerlIO_fileno(f), F_GETFL, 0);
+ fd = PerlIO_fileno(f);
+ if (fd < 0) {
+ errno = EBADF;
+ return -1;
+ }
+ RETVAL = fcntl(fd, F_GETFL, 0);
if (RETVAL >= 0) {
int mode = RETVAL;
int newmode = mode;
@@ -143,7 +149,7 @@ io_blocking(pTHX_ InputStream f, int block)
}
#endif
if (newmode != mode) {
- const int ret = fcntl(PerlIO_fileno(f),F_SETFL,newmode);
+ const int ret = fcntl(fd, F_SETFL, newmode);
if (ret < 0)
RETVAL = ret;
}
@@ -154,7 +160,7 @@ io_blocking(pTHX_ InputStream f, int block)
if (block >= 0) {
unsigned long flags = !block;
/* ioctl claims to take char* but really needs a u_long sized buffer */
- const int ret = ioctl(PerlIO_fileno(f), FIONBIO, (char*)&flags);
+ const int ret = ioctl(fd, FIONBIO, (char*)&flags);
if (ret != 0)
return -1;
/* Win32 has no way to get the current blocking status of a socket.
@@ -524,9 +530,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 = EBADF;
+ }
+ } else {
RETVAL = -1;
errno = EINVAL;
}
@@ -557,9 +569,14 @@ sockatmark (sock)
int fd;
CODE:
{
- fd = PerlIO_fileno(sock);
#ifdef HAS_SOCKATMARK
- RETVAL = sockatmark(fd);
+ int fd = PerlIO_fileno(sock);
+ if (fd < 0) {
+ errno = EBADF;
+ RETVAL = -1;
+ } else {
+ RETVAL = sockatmark(fd);
+ }
#else
{
int flag = 0;
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..0f2ac68 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);
@@ -754,9 +767,10 @@ 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 */
- RESTORE_ERRNO;
+ if (fcntl(fd, F_SETFD, fd > PL_maxsysfd) < 0) {
+ PerlLIO_close(fd);
+ goto say_false;
+ }
}
#endif
IoIFP(io) = fp;
@@ -956,23 +970,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 +1185,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 +1396,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 +1762,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 +1802,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 +1996,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 +2116,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<C<(?I<PARNO>)>|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..672b77d 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,10 @@ 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 +1689,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 +1704,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,7 +1746,11 @@ PP(pp_sysread)
else
offset = utf8_hop((U8 *)buffer,offset) - (U8 *) buffer;
}
+
more_bytes:
+ /* Reestablish the fd in case it shifted from underneath us. */
+ fd = PerlIO_fileno(IoIFP(io));
+
orig_size = SvCUR(bufsv);
/* Allocating length + offset + 1 isn't perfect in the case of reading
bytes from a byte file handle into a UTF8 buffer, but it won't harm us
@@ -1765,14 +1780,21 @@ 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);
+ count = -1;
+ } 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);
+ count = -1;
+ }
+ else
+ count = PerlLIO_read(fd, buffer, length);
}
}
else
@@ -1856,6 +1878,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 +1909,12 @@ PP(pp_syswrite)
SETERRNO(EBADF,RMS_IFI);
goto say_undef;
}
+ fd = PerlIO_fileno(IoIFP(io));
+ if (fd < 0) {
+ SETERRNO(EBADF,SS_IVCHAN);
+ retval = -1;
+ goto say_undef;
+ }
/* Do this first to trigger any overloading. */
buffer = SvPV_const(bufsv, blen);
@@ -1920,12 +1949,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 +2036,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 +2250,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 +2280,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 +2421,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 +2435,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 +2481,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 +2505,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 +2596,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 +2651,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 +2728,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 +2811,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 +3308,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 +3363,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 +3401,7 @@ PP(pp_fttext)
}
}
else {
+ int fd;
sv_setpv(PL_statname, SvPV_nomg_const_nolen(sv));
really_filename:
PL_statgv = NULL;
@@ -3358,9 +3421,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 +3545,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 +3570,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 +4270,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
|
From @bulk88On Tue May 06 17:37:22 2014, jhi wrote:
Doesnt this need version number bumps? -- |
From @tonycozOn Sat May 10 15:26:31 2014, bulk88 wrote:
I'll do version bumps, patches with the bumps run the risk of conflicts (see 121618 for example) Tony |
From @tonycozOn Tue May 06 17:37:22 2014, jhi wrote:
Looks good to me. It conflicts with another patch (from 121112), which I've fixed for my work branch. Tony |
From @jhiOn Tuesday-201405-20, 20:36, Tony Cook via RT wrote:
Hmm, okay. Which way you'd prefer me to fix my fix? Do you want to (About 121112: how about \r? I've been bitten too many times by |
From @jhiOn Tuesday-201405-20, 20:47, Jarkko Hietaniemi wrote:
That is, with \r\n (*) looking for the \n is of course enough... I was (*) There's also Mac OS Classic with just \r, but files with that are |
From @tonycozOn Tue May 20 17:47:50 2014, jhi wrote:
The warning is intended to protect against a missing chomp(), which won't remove the \r anyway. My fix won't go into blead until after 5.20 is released. I have your work in my work branch (smoke-me/tonyc/5.21.1-blockers on perl5.git.perl.org) adjusted for the conflict. Tony |
From @tonycozOn Tue May 06 17:37:22 2014, jhi wrote:
Picked up by building on Win32: @@ -1765,14 +1780,21 @@ PP(pp_sysread) lost the buffer parameter to PerlSock_recv(). Tony |
From @tonycozOn Wed May 21 17:42:52 2014, tonyc wrote:
Some other issuess: This chunk: @@ -154,7 +160,7 @@ io_blocking(pTHX_ InputStream f, int block) fd is only defined withing #if defined(HAS_FCNTL) (and the checks are only done there) and so isn't visible to this code. This one: Inline Patchdiff --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);
Tony |
From @jhiOn Wednesday-201405-21, 22:03, Tony Cook via RT wrote:
Well, (as long as f, being the source of fd, is not fiddled with) the fd
I'm confused, the declaration of rc was moved like this: + if (fd >= 0) { so the rc declaration is at the top of the block? Though, looking at that closer, why not just do: |
From @tonycozOn Wed, May 21, 2014 at 10:11:59PM -0400, Jarkko Hietaniemi wrote:
See Dave's explanation: http://perl5.git.perl.org/perl.git/commit/04783dc7025287c5d75ab531602c7ec786a1e787 Tony |
From @jhiOn Thursday-201405-22, 0:16, Tony Cook via RT wrote:
Ah, this is the same issue as with Gconvert()... once the |
From @tonycozOn Wed May 21 19:12:39 2014, jhi wrote:
The changes in this ticket have been applied as part of 375ed12. Tony |
@tonycoz - Status changed from 'open' to 'resolved' |
Migrated from rt.perl.org#121743 (status was 'resolved')
Searchable as RT121743$
The text was updated successfully, but these errors were encountered: