fcntl receiving -1 from fileno, fcntl failing.

(Also very few spots of negative numgroups for getgroups(),
and fgetc() return, but almost all checking is for fcntl.)

(merged fix for perl #121743 and perl #121745: hopefully
picked up all the fixes-to-fixes from the ticket...)

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.

10 files changed, 295 insertions, 121 deletions

diff --git a/dist/IO/IO.xs b/dist/IO/IO.xs
index 9056cb648d..eed7139fde 100644
--- a/dist/IO/IO.xs
+++ b/dist/IO/IO.xs
@@ -102,13 +102,19 @@ not_here(const char *s)
 static int
 io_blocking(pTHX_ InputStream f, int block)
 {
+    int fd = -1;
 #if defined(HAS_FCNTL)
     int RETVAL;
-    if(!f) {
+    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 85371655b2..182cd373e4 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) {
+          /* If there's no error_log, we cannot scream about it missing. */
+          PERL_UNUSED_RESULT(PerlLIO_write(fd, PL_no_mem, strlen(PL_no_mem)));
+        }
         my_exit(1);
     }
     Zero(thread, 1, ithread);
diff --git a/doio.c b/doio.c
index 0eec22c3e9..7ef02064bd 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 4c96da84f7..6632544c76 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 7f3339a93e..699c970fda 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 51deabde79..8480a5d017 100644
--- a/perl.c
+++ b/perl.c
@@ -3690,6 +3690,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;
 
@@ -3797,13 +3798,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));
@@ -3834,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 2ce8ac162c..29c4bf771e 100644
--- a/perlio.c
+++ b/perlio.c
@@ -2928,6 +2928,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
@@ -2936,8 +2940,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"));
 	    }
@@ -3357,8 +3365,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--;
@@ -3674,6 +3682,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 530bc471a1..635acb6e8e 100644
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -2290,6 +2290,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 d954f8b04b..1ee3ba2070 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,22 @@ 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, buffer, 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 +1879,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 +1910,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 +1950,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 +2037,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 +2251,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 +2281,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 +2422,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 +2436,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 +2482,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 +2506,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 +2597,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 +2652,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 +2729,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 +2812,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 +3309,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 +3364,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 */
@@ -3341,6 +3404,7 @@ PP(pp_fttext)
     }
     else {
         const char *file;
+        int fd; 
 
 	sv_setpv(PL_statname, SvPV_nomg_const_nolen(sv));
       really_filename:
@@ -3360,9 +3424,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);
@@ -3477,19 +3548,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
@@ -3502,6 +3573,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)
@@ -4196,7 +4273,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 42926b37f7..70c32e4fdd 100644
--- a/util.c
+++ b/util.c
@@ -1712,13 +1712,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);
 }
 
@@ -2310,7 +2313,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 */
@@ -2455,7 +2459,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')) {