X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/7b7309aff53f13fbc885bbe035da3e4ef8b481f4..e8432c63fd530dd325a1bd86b17c892b4cfb754a:/doio.c

diff --git a/doio.c b/doio.c
index 7f3160d..d8ea076 100644
--- a/doio.c
+++ b/doio.c
@@ -60,81 +60,104 @@
 
 #include <signal.h>
 
-bool
-Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
-	      int rawmode, int rawperm, PerlIO *supplied_fp, SV **svp,
-	      I32 num_svs)
+static IO *
+S_openn_setup(pTHX_ GV *gv, char *mode, PerlIO **saveifp, PerlIO **saveofp,
+              int *savefd,  char *savetype)
 {
-    dVAR;
-    register IO * const io = GvIOn(gv);
-    PerlIO *saveifp = NULL;
-    PerlIO *saveofp = NULL;
-    int savefd = -1;
-    char savetype = IoTYPE_CLOSED;
-    int writing = 0;
-    PerlIO *fp;
-    int fd;
-    int result;
-    bool was_fdopen = FALSE;
-    bool in_raw = 0, in_crlf = 0, out_raw = 0, out_crlf = 0;
-    char *type  = NULL;
-    char mode[PERL_MODE_MAX];	/* file mode ("r\0", "rb\0", "ab\0" etc.) */
-    SV *namesv;
+    IO * const io = GvIOn(gv);
 
-    PERL_ARGS_ASSERT_DO_OPENN;
+    PERL_ARGS_ASSERT_OPENN_SETUP;
+
+    *saveifp = NULL;
+    *saveofp = NULL;
+    *savefd = -1;
+    *savetype = IoTYPE_CLOSED;
 
     Zero(mode,sizeof(mode),char);
     PL_forkprocess = 1;		/* assume true if no fork */
 
-    /* Collect default raw/crlf info from the op */
-    if (PL_op && PL_op->op_type == OP_OPEN) {
-	/* set up IO layers */
-	const U8 flags = PL_op->op_private;
-	in_raw = (flags & OPpOPEN_IN_RAW);
-	in_crlf = (flags & OPpOPEN_IN_CRLF);
-	out_raw = (flags & OPpOPEN_OUT_RAW);
-	out_crlf = (flags & OPpOPEN_OUT_CRLF);
-    }
-
     /* If currently open - close before we re-open */
     if (IoIFP(io)) {
-	fd = PerlIO_fileno(IoIFP(io));
 	if (IoTYPE(io) == IoTYPE_STD) {
 	    /* This is a clone of one of STD* handles */
-	    result = 0;
-	}
-	else if (fd >= 0 && fd <= PL_maxsysfd) {
-	    /* This is one of the original STD* handles */
-	    saveifp  = IoIFP(io);
-	    saveofp  = IoOFP(io);
-	    savetype = IoTYPE(io);
-	    savefd   = fd;
-	    result   = 0;
-	}
-	else if (IoTYPE(io) == IoTYPE_PIPE)
-	    result = PerlProc_pclose(IoIFP(io));
-	else if (IoIFP(io) != IoOFP(io)) {
-	    if (IoOFP(io)) {
-		result = PerlIO_close(IoOFP(io));
-		PerlIO_close(IoIFP(io)); /* clear stdio, fd already closed */
-	    }
-	    else
-		result = PerlIO_close(IoIFP(io));
-	}
-	else
-	    result = PerlIO_close(IoIFP(io));
-	if (result == EOF && fd > PL_maxsysfd) {
-	    /* Why is this not Perl_warn*() call ? */
-	    PerlIO_printf(Perl_error_log,
-		"Warning: unable to close filehandle %"HEKf" properly.\n",
-		 HEKfARG(GvENAME_HEK(gv))
-	    );
 	}
+	else {
+            const int old_fd = PerlIO_fileno(IoIFP(io));
+
+            if (old_fd >= 0 && old_fd <= PL_maxsysfd) {
+                /* This is one of the original STD* handles */
+                *saveifp  = IoIFP(io);
+                *saveofp  = IoOFP(io);
+                *savetype = IoTYPE(io);
+                *savefd   = old_fd;
+            }
+            else {
+                int result;
+
+                if (IoTYPE(io) == IoTYPE_PIPE)
+                    result = PerlProc_pclose(IoIFP(io));
+                else if (IoIFP(io) != IoOFP(io)) {
+                    if (IoOFP(io)) {
+                        result = PerlIO_close(IoOFP(io));
+                        PerlIO_close(IoIFP(io)); /* clear stdio, fd already closed */
+                    }
+                    else
+                        result = PerlIO_close(IoIFP(io));
+                }
+                else
+                    result = PerlIO_close(IoIFP(io));
+
+                if (result == EOF && old_fd > PL_maxsysfd) {
+                    /* Why is this not Perl_warn*() call ? */
+                    PerlIO_printf(Perl_error_log,
+                                  "Warning: unable to close filehandle %"HEKf" properly.\n",
+                                  HEKfARG(GvENAME_HEK(gv))
+                        );
+                }
+            }
+        }
 	IoOFP(io) = IoIFP(io) = NULL;
     }
+    return io;
+}
+
+bool
+Perl_do_openn(pTHX_ GV *gv, const char *oname, I32 len, int as_raw,
+	      int rawmode, int rawperm, PerlIO *supplied_fp, SV **svp,
+	      I32 num_svs)
+{
+    PERL_ARGS_ASSERT_DO_OPENN;
 
     if (as_raw) {
         /* sysopen style args, i.e. integer mode and permissions */
+
+	if (num_svs != 0) {
+	    Perl_croak(aTHX_ "panic: sysopen with multiple args, num_svs=%ld",
+		       (long) num_svs);
+	}
+        return do_open_raw(gv, oname, len, rawmode, rawperm);
+    }
+    return do_open6(gv, oname, len, supplied_fp, svp, num_svs);
+}
+
+bool
+Perl_do_open_raw(pTHX_ GV *gv, const char *oname, STRLEN len,
+                 int rawmode, int rawperm)
+{
+    PerlIO *saveifp;
+    PerlIO *saveofp;
+    int savefd;
+    char savetype;
+    char mode[PERL_MODE_MAX];	/* file mode ("r\0", "rb\0", "ab\0" etc.) */
+    IO * const io = openn_setup(gv, mode, &saveifp, &saveofp, &savefd, &savetype);
+    int writing = 0;
+    PerlIO *fp;
+
+    PERL_ARGS_ASSERT_DO_OPEN_RAW;
+
+    /* For ease of blame back to 5.000, keep the existing indenting. */
+    {
+        /* sysopen style args, i.e. integer mode and permissions */
 	STRLEN ix = 0;
 	const int appendtrunc =
 	     0
@@ -147,10 +170,8 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
 	     ;
 	const int modifyingmode = O_WRONLY|O_RDWR|O_CREAT|appendtrunc;
 	int ismodifying;
+        SV *namesv;
 
-	if (num_svs != 0) {
-	     Perl_croak(aTHX_ "panic: sysopen with multiple args");
-	}
 	/* It's not always
 
 	   O_RDONLY 0
@@ -182,17 +203,47 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
         IoTYPE(io) = PerlIO_intmode2str(rawmode, &mode[ix], &writing);
 
 	namesv = newSVpvn_flags(oname, len, SVs_TEMP);
-	num_svs = 1;
-	svp = &namesv;
-	type = NULL;
-	fp = PerlIO_openn(aTHX_ type, mode, -1, rawmode, rawperm, NULL, num_svs, svp);
+	fp = PerlIO_openn(aTHX_ NULL, mode, -1, rawmode, rawperm, NULL, 1, &namesv);
     }
-    else {
+    return openn_cleanup(gv, io, fp, mode, oname, saveifp, saveofp, savefd,
+                         savetype, writing, 0, NULL);
+}
+
+bool
+Perl_do_open6(pTHX_ GV *gv, const char *oname, STRLEN len,
+              PerlIO *supplied_fp, SV **svp, U32 num_svs)
+{
+    PerlIO *saveifp;
+    PerlIO *saveofp;
+    int savefd;
+    char savetype;
+    char mode[PERL_MODE_MAX];	/* file mode ("r\0", "rb\0", "ab\0" etc.) */
+    IO * const io = openn_setup(gv, mode, &saveifp, &saveofp, &savefd, &savetype);
+    int writing = 0;
+    PerlIO *fp;
+    bool was_fdopen = FALSE;
+    char *type  = NULL;
+
+    PERL_ARGS_ASSERT_DO_OPEN6;
+
+    /* For ease of blame back to 5.000, keep the existing indenting. */
+    {
 	/* Regular (non-sys) open */
 	char *name;
 	STRLEN olen = len;
 	char *tend;
 	int dodup = 0;
+        bool in_raw = 0, in_crlf = 0, out_raw = 0, out_crlf = 0;
+
+        /* Collect default raw/crlf info from the op */
+        if (PL_op && PL_op->op_type == OP_OPEN) {
+            /* set up IO layers */
+            const U8 flags = PL_op->op_private;
+            in_raw = (flags & OPpOPEN_IN_RAW);
+            in_crlf = (flags & OPpOPEN_IN_CRLF);
+            out_raw = (flags & OPpOPEN_OUT_RAW);
+            out_crlf = (flags & OPpOPEN_OUT_CRLF);
+        }
 
 	type = savepvn(oname, len);
 	tend = type+len;
@@ -205,6 +256,8 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
 	    *--tend = '\0';
 
 	if (num_svs) {
+            const char *p;
+            STRLEN nlen = 0;
 	    /* New style explicit name, type is just mode and layer info */
 #ifdef USE_STDIO
 	    if (SvROK(*svp) && !strchr(oname,'&')) {
@@ -212,11 +265,19 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
 		    Perl_warner(aTHX_ packWARN(WARN_IO),
 			    "Can't open a reference");
 		SETERRNO(EINVAL, LIB_INVARG);
+                fp = NULL;
 		goto say_false;
 	    }
 #endif /* USE_STDIO */
-	    name = (SvOK(*svp) || SvGMAGICAL(*svp)) ?
-			savesvpv (*svp) : savepvs ("");
+            p = (SvOK(*svp) || SvGMAGICAL(*svp)) ? SvPV(*svp, nlen) : NULL;
+
+            if (p && !IS_SAFE_PATHNAME(p, nlen, "open")) {
+                fp = NULL;
+                goto say_false;
+            }
+
+	    name = p ? savepvn(p, nlen) : savepvs("");
+
 	    SAVEFREEPV(name);
 	}
 	else {
@@ -252,6 +313,7 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
 		if (ckWARN(WARN_PIPE))
 		    Perl_warner(aTHX_ packWARN(WARN_PIPE), "Missing command in piped open");
 		errno = EPIPE;
+                fp = NULL;
 		goto say_false;
 	    }
 	    if (!(*name == '-' && name[1] == '\0') || num_svs)
@@ -277,6 +339,7 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
 	    if (num_svs) {
 		if (*type) {
 		    if (PerlIO_apply_layers(aTHX_ fp, mode, type) != 0) {
+                        fp = NULL;
 			goto say_false;
 		    }
 		}
@@ -313,18 +376,26 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
 		}
 		else {
 		    PerlIO *that_fp = NULL;
+                    int wanted_fd;
+                    UV uv;
 		    if (num_svs > 1) {
 			/* diag_listed_as: More than one argument to '%s' open */
 			Perl_croak(aTHX_ "More than one argument to '%c&' open",IoTYPE(io));
 		    }
 		    while (isSPACE(*type))
 			type++;
-		    if (num_svs && (SvIOK(*svp) || (SvPOK(*svp) && looks_like_number(*svp)))) {
-			fd = SvUV(*svp);
+		    if (num_svs && (
+			     SvIOK(*svp)
+			  || (SvPOKp(*svp) && looks_like_number(*svp))
+		       )) {
+                        wanted_fd = SvUV(*svp);
 			num_svs = 0;
 		    }
-		    else if (isDIGIT(*type)) {
-			fd = atoi(type);
+		    else if (isDIGIT(*type)
+                        && grok_atoUV(type, &uv, NULL)
+                        && uv <= INT_MAX
+                    ) {
+                        wanted_fd = (int)uv;
 		    }
 		    else {
 			const IO* thatio;
@@ -340,6 +411,7 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
 #ifdef EINVAL
 			    SETERRNO(EINVAL,SS_IVCHAN);
 #endif
+                            fp = NULL;
 			    goto say_false;
 			}
 			if ((that_fp = IoIFP(thatio))) {
@@ -348,19 +420,12 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
 			     * be optimized away on most platforms;
 			     * only Solaris and Linux seem to flush
 			     * on that. --jhi */
-#ifdef USE_SFIO
-			    /* sfio fails to clear error on next
-			       sfwrite, contrary to documentation.
-			       -- Nicholas Clark */
-			    if (PerlIO_seek(that_fp, 0, SEEK_CUR) == -1)
-				PerlIO_clearerr(that_fp);
-#endif
 			    /* On the other hand, do all platforms
 			     * take gracefully to flushing a read-only
 			     * filehandle?  Perhaps we should do
 			     * fsetpos(src)+fgetpos(dst)?  --nik */
 			    PerlIO_flush(that_fp);
-			    fd = PerlIO_fileno(that_fp);
+			    wanted_fd = PerlIO_fileno(that_fp);
 			    /* When dup()ing STDIN, STDOUT or STDERR
 			     * explicitly set appropriate access mode */
 			    if (that_fp == PerlIO_stdout()
@@ -373,8 +438,11 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
 			    else if (IoTYPE(thatio) == IoTYPE_SOCKET)
 				IoTYPE(io) = IoTYPE_SOCKET;
 			}
-			else
-			    fd = -1;
+                        else {
+                            SETERRNO(EBADF, RMS_IFI);
+                            fp = NULL;
+                            goto say_false;
+                        }
 		    }
 		    if (!num_svs)
 			type = NULL;
@@ -383,12 +451,12 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
 		    }
 		    else {
 			if (dodup)
-			    fd = PerlLIO_dup(fd);
+                            wanted_fd = PerlLIO_dup(wanted_fd);
 			else
 			    was_fdopen = TRUE;
-			if (!(fp = PerlIO_openn(aTHX_ type,mode,fd,0,0,NULL,num_svs,svp))) {
-			    if (dodup && fd >= 0)
-				PerlLIO_close(fd);
+                        if (!(fp = PerlIO_openn(aTHX_ type,mode,wanted_fd,0,0,NULL,num_svs,svp))) {
+                            if (dodup && wanted_fd >= 0)
+                                PerlLIO_close(wanted_fd);
 			}
 		    }
 		}
@@ -406,13 +474,14 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
 		    }
 		}
 		else  {
-		    if (!num_svs) {
-			namesv = newSVpvn_flags(type, tend - type, SVs_TEMP);
-			num_svs = 1;
-			svp = &namesv;
+		    if (num_svs) {
+                        fp = PerlIO_openn(aTHX_ type,mode,-1,0,0,NULL,num_svs,svp);
+                    }
+                    else {
+                        SV *namesv = newSVpvn_flags(type, tend - type, SVs_TEMP);
 		        type = NULL;
+                        fp = PerlIO_openn(aTHX_ type,mode,-1,0,0,NULL,1,&namesv);
 		    }
-		    fp = PerlIO_openn(aTHX_ type,mode,-1,0,0,NULL,num_svs,svp);
 		}
 	    } /* !& */
 	    if (!fp && type && *type && *type != ':' && !isIDFIRST(*type))
@@ -440,13 +509,14 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
 		}
 	    }
 	    else {
-		if (!num_svs) {
-		    namesv = newSVpvn_flags(type, tend - type, SVs_TEMP);
-		    num_svs = 1;
-		    svp = &namesv;
+		if (num_svs) {
+                    fp = PerlIO_openn(aTHX_ type,mode,-1,0,0,NULL,num_svs,svp);
+                }
+                else {
+                    SV *namesv  = newSVpvn_flags(type, tend - type, SVs_TEMP);
 		    type = NULL;
+                    fp = PerlIO_openn(aTHX_ type,mode,-1,0,0,NULL,1,&namesv);
 		}
-		fp = PerlIO_openn(aTHX_ type,mode,-1,0,0,NULL,num_svs,svp);
 	    }
 	    if (!fp && type && *type && *type != ':' && !isIDFIRST(*type))
 	       goto unknown_open_mode;
@@ -471,6 +541,7 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
 		if (ckWARN(WARN_PIPE))
 		    Perl_warner(aTHX_ packWARN(WARN_PIPE), "Missing command in piped open");
 		errno = EPIPE;
+                fp = NULL;
 		goto say_false;
 	    }
 	    if (!(*name == '-' && name[1] == '\0') || num_svs)
@@ -495,6 +566,7 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
 		    type++;
 		if (*type) {
 		    if (PerlIO_apply_layers(aTHX_ fp, mode, type) != 0) {
+                        fp = NULL;
 			goto say_false;
 		    }
 		}
@@ -519,22 +591,44 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
 		IoTYPE(io) = IoTYPE_STD;
 	    }
 	    else {
-		if (!num_svs) {
-		    namesv = newSVpvn_flags(type, tend - type, SVs_TEMP);
-		    num_svs = 1;
-		    svp = &namesv;
+		if (num_svs) {
+                    fp = PerlIO_openn(aTHX_ type,mode,-1,0,0,NULL,num_svs,svp);
+                }
+                else {
+		    SV *namesv = newSVpvn_flags(type, tend - type, SVs_TEMP);
 		    type = NULL;
+                    fp = PerlIO_openn(aTHX_ type,mode,-1,0,0,NULL,1,&namesv);
 		}
-		fp = PerlIO_openn(aTHX_ type,mode,-1,0,0,NULL,num_svs,svp);
 	    }
 	}
     }
+
+  say_false:
+    return openn_cleanup(gv, io, fp, mode, oname, saveifp, saveofp, savefd,
+                         savetype, writing, was_fdopen, type);
+}
+
+/* Yes, this is ugly, but it's private, and I don't see a cleaner way to
+   simplify the two-headed public interface of do_openn. */
+static bool
+S_openn_cleanup(pTHX_ GV *gv, IO *io, PerlIO *fp, char *mode, const char *oname,
+                PerlIO *saveifp, PerlIO *saveofp, int savefd, char savetype,
+                int writing, bool was_fdopen, const char *type)
+{
+    int fd;
+
+    PERL_ARGS_ASSERT_OPENN_CLEANUP;
+
     if (!fp) {
 	if (IoTYPE(io) == IoTYPE_RDONLY && ckWARN(WARN_NEWLINE)
-	    && strchr(oname, '\n')
+	    && should_warn_nl(oname)
 	    
 	)
+        {
+            GCC_DIAG_IGNORE(-Wformat-nonliteral); /* PL_warn_nl is constant */
 	    Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "open");
+            GCC_DIAG_RESTORE;
+        }
 	goto say_false;
     }
 
@@ -556,9 +650,9 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
     }
 
     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) {
@@ -571,11 +665,7 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
 	    IoTYPE(io) = IoTYPE_SOCKET;	/* in case a socket was passed in to us */
 #ifdef HAS_SOCKET
 	else if (
-#ifdef S_IFMT
 	    !(PL_statbuf.st_mode & S_IFMT)
-#else
-	    !PL_statbuf.st_mode
-#endif
 	    && IoTYPE(io) != IoTYPE_WRONLY  /* Dups of STD* filehandles already have */
 	    && IoTYPE(io) != IoTYPE_RDONLY  /* type so they aren't marked as sockets */
 	) {				    /* on OS's that return 0 on fstat()ed pipe */
@@ -610,7 +700,10 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
 	       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;
 	    }
@@ -619,9 +712,9 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
                 char newname[FILENAME_MAX+1];
                 if (PerlIO_getname(fp, newname)) {
                     if (fd == PerlIO_fileno(PerlIO_stdout()))
-                        Perl_vmssetuserlnm(aTHX_ "SYS$OUTPUT", newname);
+                        vmssetuserlnm("SYS$OUTPUT", newname);
                     if (fd == PerlIO_fileno(PerlIO_stderr()))
-                        Perl_vmssetuserlnm(aTHX_ "SYS$ERROR",  newname);
+                        vmssetuserlnm("SYS$ERROR", newname);
                 }
 	    }
 #endif
@@ -646,16 +739,28 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
 	    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);
+		/* Assume if we have F_SETFD we have F_GETFD. */
+                /* Get a copy of all the fd flags. */
+                int fd_flags = ofd >= 0 ? fcntl(ofd, F_GETFD) : -1;
+                if (fd_flags < 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);
+		/* The dup trick has lost close-on-exec on ofd,
+                 * and possibly any other flags, so restore them. */
+		fcntl(ofd,F_SETFD, fd_flags);
 #endif
                 PerlLIO_close(dupfd);
 	    }
@@ -666,11 +771,10 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
 	PerlIO_clearerr(fp);
 	fd = PerlIO_fileno(fp);
     }
-#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 defined(HAS_FCNTL) && defined(F_SETFD) && defined(FD_CLOEXEC)
+    if (fd > PL_maxsysfd && fcntl(fd, F_SETFD, FD_CLOEXEC) < 0) {
+        PerlLIO_close(fd);
+        goto say_false;
     }
 #endif
     IoIFP(io) = fp;
@@ -683,9 +787,8 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
 	    if (*s == IoTYPE_IMPLICIT || *s == IoTYPE_NUMERIC)
 	      s++;
 	    *s = 'w';
-	    if (!(IoOFP(io) = PerlIO_openn(aTHX_ type,s,fd,0,0,NULL,0,svp))) {
+	    if (!(IoOFP(io) = PerlIO_openn(aTHX_ type,s,fd,0,0,NULL,0,NULL))) {
 		PerlIO_close(fp);
-		IoIFP(io) = NULL;
 		goto say_false;
 	    }
 	}
@@ -694,7 +797,7 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
     }
     return TRUE;
 
-say_false:
+  say_false:
     IoIFP(io) = saveifp;
     IoOFP(io) = saveofp;
     IoTYPE(io) = savetype;
@@ -702,23 +805,15 @@ say_false:
 }
 
 PerlIO *
-Perl_nextargv(pTHX_ register GV *gv)
+Perl_nextargv(pTHX_ GV *gv, bool nomagicopen)
 {
-    dVAR;
-    register SV *sv;
-#ifndef FLEXFILENAMES
-    int filedev;
-    int fileino;
-#endif
-    Uid_t fileuid;
-    Gid_t filegid;
     IO * const io = GvIOp(gv);
 
     PERL_ARGS_ASSERT_NEXTARGV;
 
     if (!PL_argvoutgv)
 	PL_argvoutgv = gv_fetchpvs("ARGVOUT", GV_ADD|GV_NOTQUAL, SVt_PVIO);
-    if (io && (IoFLAGS(io) & IOf_ARGV) && (IoFLAGS(io) & IOf_START)) {
+    if (io && (IoFLAGS(io) & (IOf_ARGV|IOf_START)) == (IOf_ARGV|IOf_START)) {
 	IoFLAGS(io) &= ~IOf_START;
 	if (PL_inplace) {
 	    assert(PL_defoutgv);
@@ -739,15 +834,35 @@ Perl_nextargv(pTHX_ register GV *gv)
     PL_filemode = 0;
     if (!GvAV(gv))
 	return NULL;
-    while (av_len(GvAV(gv)) >= 0) {
+    while (av_tindex(GvAV(gv)) >= 0) {
 	STRLEN oldlen;
-	sv = av_shift(GvAV(gv));
+        SV *const sv = av_shift(GvAV(gv));
 	SAVEFREESV(sv);
+	SvTAINTED_off(GvSVn(gv)); /* previous tainting irrelevant */
 	sv_setsv(GvSVn(gv),sv);
 	SvSETMAGIC(GvSV(gv));
 	PL_oldname = SvPVx(GvSV(gv), oldlen);
-	if (do_open(gv,PL_oldname,oldlen,PL_inplace!=0,O_RDONLY,0,NULL)) {
-	    if (PL_inplace) {
+        if (LIKELY(!PL_inplace)) {
+            if (nomagicopen
+                    ? do_open6(gv, "<", 1, NULL, &GvSV(gv), 1)
+                    : do_open6(gv, PL_oldname, oldlen, NULL, NULL, 0)
+               ) {
+                return IoIFP(GvIOp(gv));
+            }
+        }
+        else {
+            /* This very long block ends with return IoIFP(GvIOp(gv));
+               Both this block and the block above fall through on open
+               failure to the warning code, and then the while loop above tries
+               the next entry. */
+            if (do_open_raw(gv, PL_oldname, oldlen, O_RDONLY, 0)) {
+#ifndef FLEXFILENAMES
+                int filedev;
+                int fileino;
+#endif
+                Uid_t fileuid;
+                Gid_t filegid;
+
 		TAINT_PROPER("inplace open");
 		if (oldlen == 1 && *PL_oldname == '-') {
 		    setdefout(gv_fetchpvs("STDOUT", GV_ADD|GV_NOTQUAL,
@@ -801,7 +916,7 @@ Perl_nextargv(pTHX_ register GV *gv)
 		    }
 #endif
 #ifdef HAS_RENAME
-#if !defined(DOSISH) && !defined(__CYGWIN__) && !defined(EPOC)
+#if !defined(DOSISH) && !defined(__CYGWIN__)
 		    if (PerlLIO_rename(PL_oldname,SvPVX_const(sv)) < 0) {
 			Perl_ck_warner_d(aTHX_ packWARN(WARN_INPLACE),
 					 "Can't rename %s to %"SVf": %s, skipping file",
@@ -813,7 +928,7 @@ Perl_nextargv(pTHX_ register GV *gv)
 		    do_close(gv,FALSE);
 		    (void)PerlLIO_unlink(SvPVX_const(sv));
 		    (void)PerlLIO_rename(PL_oldname,SvPVX_const(sv));
-		    do_open(gv,(char*)SvPVX_const(sv),SvCUR(sv),TRUE,O_RDONLY,0,NULL);
+		    do_open_raw(gv, SvPVX_const(sv), SvCUR(sv), O_RDONLY, 0);
 #endif /* DOSISH */
 #else
 		    (void)UNLINK(SvPVX_const(sv));
@@ -845,14 +960,14 @@ Perl_nextargv(pTHX_ register GV *gv)
 
 		sv_setpvn(sv,PL_oldname,oldlen);
 		SETERRNO(0,0);		/* in case sprintf set errno */
-		if (!Perl_do_openn(aTHX_ PL_argvoutgv, (char*)SvPVX_const(sv),
-				   SvCUR(sv), TRUE,
+		if (!Perl_do_open_raw(aTHX_ PL_argvoutgv, SvPVX_const(sv),
+                                      SvCUR(sv),
 #ifdef VMS
-				   O_WRONLY|O_CREAT|O_TRUNC,0,
+                                      O_WRONLY|O_CREAT|O_TRUNC, 0
 #else
-				   O_WRONLY|O_CREAT|OPEN_EXCL,0600,
+                                      O_WRONLY|O_CREAT|OPEN_EXCL, 0600
 #endif
-				   NULL, NULL, 0)) {
+                        )) {
 		    Perl_ck_warner_d(aTHX_ packWARN(WARN_INPLACE), "Can't do inplace edit on %s: %s",
 				     PL_oldname, Strerror(errno) );
 		    do_close(gv,FALSE);
@@ -860,38 +975,40 @@ Perl_nextargv(pTHX_ register 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) {
+                    if (fileuid != PL_statbuf.st_uid || filegid != PL_statbuf.st_gid) {
+                        /* XXX silently ignore failures */
 #ifdef HAS_FCHOWN
-		    (void)fchown(PL_lastfd,fileuid,filegid);
+                        PERL_UNUSED_RESULT(fchown(PL_lastfd,fileuid,filegid));
 #else
 #ifdef HAS_CHOWN
-		    (void)PerlLIO_chown(PL_oldname,fileuid,filegid);
+                        PERL_UNUSED_RESULT(PerlLIO_chown(PL_oldname,fileuid,filegid));
 #endif
 #endif
+                    }
 		}
+                return IoIFP(GvIOp(gv));
 	    }
-	    return IoIFP(GvIOp(gv));
-	}
-	else {
-	    if (ckWARN_d(WARN_INPLACE)) {
-		const int eno = errno;
-		if (PerlLIO_stat(PL_oldname, &PL_statbuf) >= 0
-		    && !S_ISREG(PL_statbuf.st_mode))	
-		{
-		    Perl_warner(aTHX_ packWARN(WARN_INPLACE),
-				"Can't do inplace edit: %s is not a regular file",
-				PL_oldname);
-		}
-		else
-		    Perl_warner(aTHX_ packWARN(WARN_INPLACE), "Can't open %s: %s",
-				PL_oldname, Strerror(eno));
-	    }
+	} /* successful do_open_raw(), PL_inplace non-NULL */
+
+        if (ckWARN_d(WARN_INPLACE)) {
+            const int eno = errno;
+            if (PerlLIO_stat(PL_oldname, &PL_statbuf) >= 0
+                && !S_ISREG(PL_statbuf.st_mode)) {
+                Perl_warner(aTHX_ packWARN(WARN_INPLACE),
+                            "Can't do inplace edit: %s is not a regular file",
+                            PL_oldname);
+            }
+            else {
+                Perl_warner(aTHX_ packWARN(WARN_INPLACE), "Can't open %s: %s",
+                            PL_oldname, Strerror(eno));
+            }
 	}
     }
     if (io && (IoFLAGS(io) & IOf_ARGV))
@@ -903,7 +1020,7 @@ Perl_nextargv(pTHX_ register GV *gv)
 	{
 	    GV * const oldout = MUTABLE_GV(av_pop(PL_argvout_stack));
 	    setdefout(oldout);
-	    SvREFCNT_dec(oldout);
+	    SvREFCNT_dec_NN(oldout);
 	    return NULL;
 	}
 	setdefout(gv_fetchpvs("STDOUT", GV_ADD|GV_NOTQUAL, SVt_PVIO));
@@ -915,7 +1032,6 @@ Perl_nextargv(pTHX_ register GV *gv)
 bool
 Perl_do_close(pTHX_ GV *gv, bool not_implicit)
 {
-    dVAR;
     bool retval;
     IO *io;
 
@@ -934,7 +1050,7 @@ Perl_do_close(pTHX_ GV *gv, bool not_implicit)
 	}
 	return FALSE;
     }
-    retval = io_close(io, not_implicit);
+    retval = io_close(io, NULL, not_implicit, FALSE);
     if (not_implicit) {
 	IoLINES(io) = 0;
 	IoPAGE(io) = 0;
@@ -945,9 +1061,8 @@ Perl_do_close(pTHX_ GV *gv, bool not_implicit)
 }
 
 bool
-Perl_io_close(pTHX_ IO *io, bool not_implicit)
+Perl_io_close(pTHX_ IO *io, GV *gv, bool not_implicit, bool warn_on_fail)
 {
-    dVAR;
     bool retval = FALSE;
 
     PERL_ARGS_ASSERT_IO_CLOSE;
@@ -968,15 +1083,37 @@ Perl_io_close(pTHX_ IO *io, bool not_implicit)
 	else {
 	    if (IoOFP(io) && IoOFP(io) != IoIFP(io)) {		/* a socket */
 		const bool prev_err = PerlIO_error(IoOFP(io));
+#ifdef USE_PERLIO
+		if (prev_err)
+		    PerlIO_restore_errno(IoOFP(io));
+#endif
 		retval = (PerlIO_close(IoOFP(io)) != EOF && !prev_err);
 		PerlIO_close(IoIFP(io));	/* clear stdio, fd already closed */
 	    }
 	    else {
 		const bool prev_err = PerlIO_error(IoIFP(io));
+#ifdef USE_PERLIO
+		if (prev_err)
+		    PerlIO_restore_errno(IoIFP(io));
+#endif
 		retval = (PerlIO_close(IoIFP(io)) != EOF && !prev_err);
 	    }
 	}
 	IoOFP(io) = IoIFP(io) = NULL;
+
+	if (warn_on_fail && !retval) {
+	    if (gv)
+		Perl_ck_warner_d(aTHX_ packWARN(WARN_IO),
+				"Warning: unable to close filehandle %"
+				 HEKf" properly: %"SVf,
+				 HEKfARG(GvNAME_HEK(gv)),
+                                 SVfARG(get_sv("!",GV_ADD)));
+	    else
+		Perl_ck_warner_d(aTHX_ packWARN(WARN_IO),
+				"Warning: unable to close filehandle "
+				"properly: %"SVf,
+				 SVfARG(get_sv("!",GV_ADD)));
+	}
     }
     else if (not_implicit) {
 	SETERRNO(EBADF,SS_IVCHAN);
@@ -988,8 +1125,7 @@ Perl_io_close(pTHX_ IO *io, bool not_implicit)
 bool
 Perl_do_eof(pTHX_ GV *gv)
 {
-    dVAR;
-    register IO * const io = GvIO(gv);
+    IO * const io = GvIO(gv);
 
     PERL_ARGS_ASSERT_DO_EOF;
 
@@ -1021,7 +1157,7 @@ Perl_do_eof(pTHX_ GV *gv)
 		PerlIO_set_cnt(IoIFP(io),-1);
 	}
 	if (PL_op->op_flags & OPf_SPECIAL) { /* not necessarily a real EOF yet? */
-	    if (gv != PL_argvgv || !nextargv(gv))	/* get another fp handy */
+	    if (gv != PL_argvgv || !nextargv(gv, FALSE))	/* get another fp handy */
 		return TRUE;
 	}
 	else
@@ -1033,17 +1169,12 @@ Perl_do_eof(pTHX_ GV *gv)
 Off_t
 Perl_do_tell(pTHX_ GV *gv)
 {
-    dVAR;
     IO *const io = GvIO(gv);
-    register PerlIO *fp;
+    PerlIO *fp;
 
     PERL_ARGS_ASSERT_DO_TELL;
 
     if (io && (fp = IoIFP(io))) {
-#ifdef ULTRIX_STDIO_BOTCH
-	if (PerlIO_eof(fp))
-	    (void)PerlIO_seek(fp, 0L, 2);	/* ultrix 1.2 workaround */
-#endif
 	return PerlIO_tell(fp);
     }
     report_evil_fh(gv);
@@ -1054,15 +1185,10 @@ Perl_do_tell(pTHX_ GV *gv)
 bool
 Perl_do_seek(pTHX_ GV *gv, Off_t pos, int whence)
 {
-    dVAR;
     IO *const io = GvIO(gv);
-    register PerlIO *fp;
+    PerlIO *fp;
 
     if (io && (fp = IoIFP(io))) {
-#ifdef ULTRIX_STDIO_BOTCH
-	if (PerlIO_eof(fp))
-	    (void)PerlIO_seek(fp, 0L, 2);	/* ultrix 1.2 workaround */
-#endif
 	return PerlIO_seek(fp, pos, whence) >= 0;
     }
     report_evil_fh(gv);
@@ -1073,14 +1199,20 @@ Perl_do_seek(pTHX_ GV *gv, Off_t pos, int whence)
 Off_t
 Perl_do_sysseek(pTHX_ GV *gv, Off_t pos, int whence)
 {
-    dVAR;
     IO *const io = GvIO(gv);
-    register PerlIO *fp;
+    PerlIO *fp;
 
     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 || (whence == SEEK_SET && pos < 0)) {
+            SETERRNO(EINVAL,LIB_INVARG);
+            return -1;
+        } else {
+            return PerlLIO_lseek(fd, pos, whence);
+        }
+    }
     report_evil_fh(gv);
     SETERRNO(EBADF,RMS_IFI);
     return (Off_t)-1;
@@ -1090,6 +1222,7 @@ int
 Perl_mode_from_discipline(pTHX_ const char *s, STRLEN len)
 {
     int mode = O_BINARY;
+    PERL_UNUSED_CONTEXT;
     if (s) {
 	while (*s) {
 	    if (*s == ':') {
@@ -1103,7 +1236,7 @@ Perl_mode_from_discipline(pTHX_ const char *s, STRLEN len)
 			len -= 4;
 			break;
 		    }
-		    /* FALL THROUGH */
+		    /* FALLTHROUGH */
 		case 'c':
 		    if (s[2] == 'r' && s[3] == 'l' && s[4] == 'f'
 			&& (!s[5] || s[5] == ':' || isSPACE(s[5])))
@@ -1113,7 +1246,7 @@ Perl_mode_from_discipline(pTHX_ const char *s, STRLEN len)
 			len -= 5;
 			break;
 		    }
-		    /* FALL THROUGH */
+		    /* FALLTHROUGH */
 		default:
 		    goto fail_discipline;
 		}
@@ -1124,7 +1257,7 @@ Perl_mode_from_discipline(pTHX_ const char *s, STRLEN len)
 	    }
 	    else {
 		const char *end;
-fail_discipline:
+  fail_discipline:
 		end = strchr(s+1, ':');
 		if (!end)
 		    end = s+len;
@@ -1194,10 +1327,8 @@ my_chsize(int fd, Off_t length)
 #endif /* !HAS_TRUNCATE && !HAS_CHSIZE */
 
 bool
-Perl_do_print(pTHX_ register SV *sv, PerlIO *fp)
+Perl_do_print(pTHX_ SV *sv, PerlIO *fp)
 {
-    dVAR;
-
     PERL_ARGS_ASSERT_DO_PRINT;
 
     /* assuming fp is checked earlier */
@@ -1218,26 +1349,31 @@ Perl_do_print(pTHX_ register SV *sv, PerlIO *fp)
 	U8 *tmpbuf = NULL;
 	bool happy = TRUE;
 
-	if (PerlIO_isutf8(fp)) {
-	    if (!SvUTF8(sv)) {
+	if (PerlIO_isutf8(fp)) { /* If the stream is utf8 ... */
+	    if (!SvUTF8(sv)) {	/* Convert to utf8 if necessary */
 		/* We don't modify the original scalar.  */
 		tmpbuf = bytes_to_utf8((const U8*) tmps, &len);
 		tmps = (char *) tmpbuf;
 	    }
-	    else if (ckWARN_d(WARN_UTF8)) {
+	    else if (ckWARN4_d(WARN_UTF8, WARN_SURROGATE, WARN_NON_UNICODE, WARN_NONCHAR)) {
 		(void) check_utf8_print((const U8*) tmps, len);
 	    }
-	}
-	else if (DO_UTF8(sv)) {
+	} /* else stream isn't utf8 */
+	else if (DO_UTF8(sv)) { /* But if is utf8 internally, attempt to
+				   convert to bytes */
 	    STRLEN tmplen = len;
 	    bool utf8 = TRUE;
 	    U8 * const result = bytes_from_utf8((const U8*) tmps, &tmplen, &utf8);
 	    if (!utf8) {
+
+		/* Here, succeeded in downgrading from utf8.  Set up to below
+		 * output the converted value */
 		tmpbuf = result;
 		tmps = (char *) tmpbuf;
 		len = tmplen;
 	    }
-	    else {
+	    else {  /* Non-utf8 output stream, but string only representable in
+		       utf8 */
 		assert((char *)result == tmps);
 		Perl_ck_warner_d(aTHX_ packWARN(WARN_UTF8),
 				 "Wide character in %s",
@@ -1264,13 +1400,11 @@ Perl_do_print(pTHX_ register SV *sv, PerlIO *fp)
 I32
 Perl_my_stat_flags(pTHX_ const U32 flags)
 {
-    dVAR;
     dSP;
     IO *io;
     GV* gv;
 
     if (PL_op->op_flags & OPf_REF) {
-	EXTEND(SP,1);
 	gv = cGVOP_gv;
       do_fstat:
         if (gv == PL_defgv)
@@ -1280,30 +1414,30 @@ Perl_my_stat_flags(pTHX_ const U32 flags)
         PL_laststype = OP_STAT;
         PL_statgv = gv ? gv : (GV *)io;
         sv_setpvs(PL_statname, "");
-        if(io) {
+        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) {
+                    /* E.g. PerlIO::scalar has no real fd. */
+                    return (PL_laststatval = -1);
+                } else {
+                    return (PL_laststatval = PerlLIO_fstat(fd, &PL_statcache));
+                }
             } else if (IoDIRP(io)) {
                 return (PL_laststatval = PerlLIO_fstat(my_dirfd(IoDIRP(io)), &PL_statcache));
-            } else {
-		PL_laststatval = -1;
-		report_evil_fh(gv);
-                return -1;
             }
-	} else {
-	    PL_laststatval = -1;
-	    report_evil_fh(gv);
-            return -1;
         }
+	PL_laststatval = -1;
+	report_evil_fh(gv);
+	return -1;
     }
-    else if (PL_op->op_private & OPpFT_STACKED) {
+    else if ((PL_op->op_private & (OPpFT_STACKED|OPpFT_AFTER_t))
+	     == OPpFT_STACKED)
 	return PL_laststatval;
-    }
     else {
-	SV* const sv = POPs;
+	SV* const sv = TOPs;
 	const char *s;
 	STRLEN len;
-	PUTBACK;
 	if ((gv = MAYBE_DEREF_GV_flags(sv,flags))) {
 	    goto do_fstat;
 	}
@@ -1319,8 +1453,11 @@ Perl_my_stat_flags(pTHX_ const U32 flags)
 	s = SvPVX_const(PL_statname);		/* s now NUL-terminated */
 	PL_laststype = OP_STAT;
 	PL_laststatval = PerlLIO_stat(s, &PL_statcache);
-	if (PL_laststatval < 0 && ckWARN(WARN_NEWLINE) && strchr(s, '\n'))
+	if (PL_laststatval < 0 && ckWARN(WARN_NEWLINE) && should_warn_nl(s)) {
+            GCC_DIAG_IGNORE(-Wformat-nonliteral); /* PL_warn_nl is constant */
 	    Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "stat");
+            GCC_DIAG_RESTORE;
+        }
 	return PL_laststatval;
     }
 }
@@ -1329,40 +1466,60 @@ Perl_my_stat_flags(pTHX_ const U32 flags)
 I32
 Perl_my_lstat_flags(pTHX_ const U32 flags)
 {
-    dVAR;
-    static const char no_prev_lstat[] = "The stat preceding -l _ wasn't an lstat";
+    static const char* const no_prev_lstat = "The stat preceding -l _ wasn't an lstat";
     dSP;
-    SV *sv;
     const char *file;
+    SV* const sv = TOPs;
+    bool isio = FALSE;
     if (PL_op->op_flags & OPf_REF) {
-	EXTEND(SP,1);
 	if (cGVOP_gv == PL_defgv) {
 	    if (PL_laststype != OP_LSTAT)
-		Perl_croak(aTHX_ no_prev_lstat);
+		Perl_croak(aTHX_ "%s", no_prev_lstat);
 	    return PL_laststatval;
 	}
+	PL_laststatval = -1;
 	if (ckWARN(WARN_IO)) {
+	    /* diag_listed_as: Use of -l on filehandle%s */
 	    Perl_warner(aTHX_ packWARN(WARN_IO),
 		 	     "Use of -l on filehandle %"HEKf,
 			      HEKfARG(GvENAME_HEK(cGVOP_gv)));
 	}
-	return (PL_laststatval = -1);
+	return -1;
     }
-    else if (PL_op->op_private & OPpFT_STACKED) {
+    if ((PL_op->op_private & (OPpFT_STACKED|OPpFT_AFTER_t))
+	     == OPpFT_STACKED) {
       if (PL_laststype != OP_LSTAT)
-	Perl_croak(aTHX_ no_prev_lstat);
+	Perl_croak(aTHX_ "%s", no_prev_lstat);
       return PL_laststatval;
-    } 
+    }
 
     PL_laststype = OP_LSTAT;
     PL_statgv = NULL;
-    sv = POPs;
-    PUTBACK;
+    if ( (  (SvROK(sv) && (  isGV_with_GP(SvRV(sv))
+                          || (isio = SvTYPE(SvRV(sv)) == SVt_PVIO)  )
+            )
+         || isGV_with_GP(sv)
+         )
+      && ckWARN(WARN_IO)) {
+        if (isio)
+	    /* diag_listed_as: Use of -l on filehandle%s */
+            Perl_warner(aTHX_ packWARN(WARN_IO),
+                             "Use of -l on filehandle");
+        else
+	    /* diag_listed_as: Use of -l on filehandle%s */
+            Perl_warner(aTHX_ packWARN(WARN_IO),
+                             "Use of -l on filehandle %"HEKf,
+                              HEKfARG(GvENAME_HEK((const GV *)
+                                          (SvROK(sv) ? SvRV(sv) : sv))));
+    }
     file = SvPV_flags_const_nolen(sv, flags);
     sv_setpv(PL_statname,file);
     PL_laststatval = PerlLIO_lstat(file,&PL_statcache);
-    if (PL_laststatval < 0 && ckWARN(WARN_NEWLINE) && strchr(file, '\n'))
-	Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "lstat");
+    if (PL_laststatval < 0 && ckWARN(WARN_NEWLINE) && should_warn_nl(file)) {
+        GCC_DIAG_IGNORE(-Wformat-nonliteral); /* PL_warn_nl is constant */
+        Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "lstat");
+        GCC_DIAG_RESTORE;
+    }
     return PL_laststatval;
 }
 
@@ -1371,21 +1528,29 @@ S_exec_failed(pTHX_ const char *cmd, int fd, int do_report)
 {
     const int e = errno;
     PERL_ARGS_ASSERT_EXEC_FAILED;
-    if (ckWARN(WARN_EXEC))
-	Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't exec \"%s\": %s",
-		    cmd, Strerror(e));
+#ifdef __amigaos4__
+    if (e)
+#endif
+    {
+	if (ckWARN(WARN_EXEC))
+	    Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't exec \"%s\": %s",
+			cmd, Strerror(e));
+    }
     if (do_report) {
-	PerlLIO_write(fd, (void*)&e, sizeof(int));
+        /* XXX silently ignore failures */
+        PERL_UNUSED_RESULT(PerlLIO_write(fd, (void*)&e, sizeof(int)));
 	PerlLIO_close(fd);
     }
 }
 
-bool
-Perl_do_aexec5(pTHX_ SV *really, register SV **mark, register SV **sp,
+DO_EXEC_TYPE
+Perl_do_aexec5(pTHX_ SV *really, SV **mark, SV **sp,
 	       int fd, int do_report)
 {
     dVAR;
+    DO_EXEC_TYPE result = DO_EXEC_FAILURE;
     PERL_ARGS_ASSERT_DO_AEXEC5;
+    PERL_UNUSED_VAR(result); /* if DO_EXEC_TYPE is bool */
 #if defined(__SYMBIAN32__) || defined(__LIBCATAMOUNT__)
     Perl_croak(aTHX_ "exec? I'm not *that* kind of operating system");
 #else
@@ -1408,22 +1573,26 @@ Perl_do_aexec5(pTHX_ SV *really, register SV **mark, register SV **sp,
 	    (really && *tmps != '/'))		/* will execvp use PATH? */
 	    TAINT_ENV();		/* testing IFS here is overkill, probably */
 	PERL_FPU_PRE_EXEC
-	if (really && *tmps)
-	    PerlProc_execvp(tmps,EXEC_ARGV_CAST(PL_Argv));
-	else
-	    PerlProc_execvp(PL_Argv[0],EXEC_ARGV_CAST(PL_Argv));
+	if (really && *tmps) {
+            result =
+              (DO_EXEC_TYPE)
+              PerlProc_execvp(tmps,EXEC_ARGV_CAST(PL_Argv));
+	} else {
+	    result =
+              (DO_EXEC_TYPE)
+              PerlProc_execvp(PL_Argv[0],EXEC_ARGV_CAST(PL_Argv));
+	}
 	PERL_FPU_POST_EXEC
  	S_exec_failed(aTHX_ (really ? tmps : PL_Argv[0]), fd, do_report);
     }
     do_execfree();
 #endif
-    return FALSE;
+    return DO_EXEC_RETVAL(result);
 }
 
 void
 Perl_do_execfree(pTHX)
 {
-    dVAR;
     Safefree(PL_Argv);
     PL_Argv = NULL;
     Safefree(PL_Cmd);
@@ -1432,16 +1601,18 @@ Perl_do_execfree(pTHX)
 
 #ifdef PERL_DEFAULT_DO_EXEC3_IMPLEMENTATION
 
-bool
+DO_EXEC_TYPE
 Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report)
 {
     dVAR;
-    register const char **a;
-    register char *s;
+    const char **a;
+    char *s;
     char *buf;
     char *cmd;
     /* Make a copy so we can change it */
     const Size_t cmdlen = strlen(incmd) + 1;
+    DO_EXEC_TYPE result = DO_EXEC_FAILURE;
+    PERL_UNUSED_VAR(result); /* if DO_EXEC_TYPE is bool */
 
     PERL_ARGS_ASSERT_DO_EXEC3;
 
@@ -1477,12 +1648,14 @@ Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report)
 	      if (s[-1] == '\'') {
 		  *--s = '\0';
 		  PERL_FPU_PRE_EXEC
-		  PerlProc_execl(PL_cshname, "csh", flags, ncmd, (char*)NULL);
+		  result =
+                    (DO_EXEC_TYPE)
+                    PerlProc_execl(PL_cshname, "csh", flags, ncmd, (char*)NULL);
 		  PERL_FPU_POST_EXEC
 		  *s = '\'';
  		  S_exec_failed(aTHX_ PL_cshname, fd, do_report);
 		  Safefree(buf);
-		  return FALSE;
+		  return DO_EXEC_RETVAL(result);
 	      }
 	  }
 	}
@@ -1498,7 +1671,7 @@ Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report)
 	goto doshell;
 
     s = cmd;
-    while (isALNUM(*s))
+    while (isWORDCHAR(*s))
 	s++;	/* catch VAR=val gizmo */
     if (*s == '=')
 	goto doshell;
@@ -1526,11 +1699,16 @@ Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report)
 	    }
 	  doshell:
 	    PERL_FPU_PRE_EXEC
-	    PerlProc_execl(PL_sh_path, "sh", "-c", cmd, (char *)NULL);
+	    result =
+              (DO_EXEC_TYPE)
+              PerlProc_execl(PL_sh_path, "sh", "-c", cmd, (char *)NULL);
 	    PERL_FPU_POST_EXEC
  	    S_exec_failed(aTHX_ PL_sh_path, fd, do_report);
+#if defined (__amigaos4__)
+            amigaos_post_exec(fd, do_report);
+#endif
 	    Safefree(buf);
-	    return FALSE;
+	    return DO_EXEC_RETVAL(result);
 	}
     }
 
@@ -1550,7 +1728,9 @@ Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report)
     *a = NULL;
     if (PL_Argv[0]) {
 	PERL_FPU_PRE_EXEC
-	PerlProc_execvp(PL_Argv[0],EXEC_ARGV_CAST(PL_Argv));
+	result =
+          (DO_EXEC_TYPE)
+          PerlProc_execvp(PL_Argv[0],EXEC_ARGV_CAST(PL_Argv));
 	PERL_FPU_POST_EXEC
 	if (errno == ENOEXEC) {		/* for system V NIH syndrome */
 	    do_execfree();
@@ -1560,24 +1740,30 @@ Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report)
     }
     do_execfree();
     Safefree(buf);
-    return FALSE;
+    return DO_EXEC_RETVAL(result);
 }
 
 #endif /* OS2 || WIN32 */
 
+#ifdef VMS
+#include <starlet.h> /* for sys$delprc */
+#endif
+
 I32
-Perl_apply(pTHX_ I32 type, register SV **mark, register SV **sp)
+Perl_apply(pTHX_ I32 type, SV **mark, SV **sp)
 {
-    dVAR;
-    register I32 val;
-    register I32 tot = 0;
+    I32 val;
+    I32 tot = 0;
     const char *const what = PL_op_name[type];
     const char *s;
     STRLEN len;
     SV ** const oldmark = mark;
+    bool killgp = FALSE;
 
     PERL_ARGS_ASSERT_APPLY;
 
+    PERL_UNUSED_VAR(what); /* may not be used depending on compile options */
+
     /* Doing this ahead of the switch statement preserves the old behaviour,
        where attempting to use kill as a taint test test would fail on
        platforms where kill was not defined.  */
@@ -1593,11 +1779,11 @@ Perl_apply(pTHX_ I32 type, register SV **mark, register SV **sp)
 
 #define APPLY_TAINT_PROPER() \
     STMT_START {							\
-	if (PL_tainted) { TAINT_PROPER(what); }				\
+	if (TAINT_get) { TAINT_PROPER(what); }				\
     } STMT_END
 
     /* This is a first heuristic; it doesn't catch tainting magic. */
-    if (PL_tainting) {
+    if (TAINTING_get) {
 	while (++mark <= sp) {
 	    if (SvTAINTED(*mark)) {
 		TAINT;
@@ -1618,22 +1804,29 @@ Perl_apply(pTHX_ I32 type, register SV **mark, register 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
 		    }
 		    else {
+                        SETERRNO(EBADF,RMS_IFI);
 			tot--;
 		    }
 		}
 		else {
-		    const char *name = SvPV_nomg_const_nolen(*mark);
+		    const char *name = SvPV_nomg_const(*mark, len);
 		    APPLY_TAINT_PROPER();
-		    if (PerlLIO_chmod(name, val))
-			tot--;
+                    if (!IS_SAFE_PATHNAME(name, len, "chmod") ||
+                        PerlLIO_chmod(name, val)) {
+                        tot--;
+                    }
 		}
 	    }
 	}
@@ -1642,7 +1835,7 @@ Perl_apply(pTHX_ I32 type, register SV **mark, register SV **sp)
     case OP_CHOWN:
 	APPLY_TAINT_PROPER();
 	if (sp - mark > 2) {
-            register I32 val2;
+            I32 val2;
 	    val = SvIVx(*++mark);
 	    val2 = SvIVx(*++mark);
 	    APPLY_TAINT_PROPER();
@@ -1652,22 +1845,29 @@ Perl_apply(pTHX_ I32 type, register SV **mark, register 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");
 #endif
 		    }
 		    else {
+                        SETERRNO(EBADF,RMS_IFI);
 			tot--;
 		    }
 		}
 		else {
-		    const char *name = SvPV_nomg_const_nolen(*mark);
+		    const char *name = SvPV_nomg_const(*mark, len);
 		    APPLY_TAINT_PROPER();
-		    if (PerlLIO_chown(name, val, val2))
+                    if (!IS_SAFE_PATHNAME(name, len, "chown") ||
+                        PerlLIO_chown(name, val, val2)) {
 			tot--;
+                    }
 		}
 	    }
 	}
@@ -1685,6 +1885,12 @@ nothing in the core.
 	if (mark == sp)
 	    break;
 	s = SvPVx_const(*++mark, len);
+	if (*s == '-' && isALPHA(s[1]))
+	{
+	    s++;
+	    len--;
+            killgp = TRUE;
+	}
 	if (isALPHA(*s)) {
 	    if (*s == 'S' && s[1] == 'I' && s[2] == 'G') {
 		s += 3;
@@ -1694,21 +1900,26 @@ nothing in the core.
                Perl_croak(aTHX_ "Unrecognized signal name \"%"SVf"\"", SVfARG(*mark));
 	}
 	else
+	{
 	    val = SvIV(*mark);
+	    if (val < 0)
+	    {
+		killgp = TRUE;
+                val = -val;
+	    }
+	}
 	APPLY_TAINT_PROPER();
 	tot = sp - mark;
 #ifdef VMS
 	/* kill() doesn't do process groups (job trees?) under VMS */
-	if (val < 0) val = -val;
 	if (val == SIGKILL) {
-#	    include <starlet.h>
 	    /* Use native sys$delprc() to insure that target process is
 	     * deleted; supervisor-mode images don't pay attention to
 	     * CRTL's emulation of Unix-style signals and kill()
 	     */
 	    while (++mark <= sp) {
 		I32 proc;
-		register unsigned long int __vmssts;
+		unsigned long int __vmssts;
 		SvGETMAGIC(*mark);
 		if (!(SvIOK(*mark) || SvNOK(*mark) || looks_like_number(*mark)))
 		    Perl_croak(aTHX_ "Can't kill a non-numeric process ID");
@@ -1733,34 +1944,22 @@ nothing in the core.
 	    break;
 	}
 #endif
-	if (val < 0) {
-	    val = -val;
-	    while (++mark <= sp) {
-		I32 proc;
-		SvGETMAGIC(*mark);
-		if (!(SvIOK(*mark) || SvNOK(*mark) || looks_like_number(*mark)))
-		    Perl_croak(aTHX_ "Can't kill a non-numeric process ID");
-		proc = SvIV_nomg(*mark);
-		APPLY_TAINT_PROPER();
+	while (++mark <= sp) {
+	    Pid_t proc;
+	    SvGETMAGIC(*mark);
+	    if (!(SvNIOK(*mark) || looks_like_number(*mark)))
+		Perl_croak(aTHX_ "Can't kill a non-numeric process ID");
+	    proc = SvIV_nomg(*mark);
+	    APPLY_TAINT_PROPER();
 #ifdef HAS_KILLPG
-		if (PerlProc_killpg(proc,val))	/* BSD */
+            /* use killpg in preference, as the killpg() wrapper for Win32
+             * understands process groups, but the kill() wrapper doesn't */
+            if (killgp ? PerlProc_killpg(proc, val)
+                       : PerlProc_kill(proc, val))
 #else
-		if (PerlProc_kill(-proc,val))	/* SYSV */
+            if (PerlProc_kill(killgp ? -proc: proc, val))
 #endif
-		    tot--;
-	    }
-	}
-	else {
-	    while (++mark <= sp) {
-		I32 proc;
-		SvGETMAGIC(*mark);
-		if (!(SvIOK(*mark) || SvNOK(*mark) || looks_like_number(*mark)))
-		    Perl_croak(aTHX_ "Can't kill a non-numeric process ID");
-		proc = SvIV_nomg(*mark);
-		APPLY_TAINT_PROPER();
-		if (PerlProc_kill(proc, val))
-		    tot--;
-	    }
+		tot--;
 	}
 	PERL_ASYNC_CHECK();
 	break;
@@ -1769,15 +1968,22 @@ nothing in the core.
 	APPLY_TAINT_PROPER();
 	tot = sp - mark;
 	while (++mark <= sp) {
-	    s = SvPV_nolen_const(*mark);
+	    s = SvPV_const(*mark, len);
 	    APPLY_TAINT_PROPER();
-	    if (PL_euid || PL_unsafe) {
+	    if (!IS_SAFE_PATHNAME(s, len, "unlink")) {
+                tot--;
+            }
+	    else if (PL_unsafe) {
 		if (UNLINK(s))
 		    tot--;
 	    }
 	    else {	/* don't let root wipe out directories without -U */
-		if (PerlLIO_lstat(s,&PL_statbuf) < 0 || S_ISDIR(PL_statbuf.st_mode))
+		if (PerlLIO_lstat(s,&PL_statbuf) < 0)
 		    tot--;
+		else if (S_ISDIR(PL_statbuf.st_mode)) {
+		    tot--;
+		    SETERRNO(EISDIR, SS_NOPRIV);
+		}
 		else {
 		    if (UNLINK(s))
 			tot--;
@@ -1834,9 +2040,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");
@@ -1847,8 +2056,12 @@ nothing in the core.
 		    }
 		}
 		else {
-		    const char * const name = SvPV_nomg_const_nolen(*mark);
+		    const char * const name = SvPV_nomg_const(*mark, len);
 		    APPLY_TAINT_PROPER();
+		    if (!IS_SAFE_PATHNAME(name, len, "utime")) {
+                        tot--;
+                    }
+                    else
 #ifdef HAS_FUTIMES
 		    if (utimes(name, (struct timeval *)utbufp))
 #else
@@ -1872,14 +2085,13 @@ nothing in the core.
 /* Do the permissions allow some operation?  Assumes statcache already set. */
 #ifndef VMS /* VMS' cando is in vms.c */
 bool
-Perl_cando(pTHX_ Mode_t mode, bool effective, register const Stat_t *statbufp)
+Perl_cando(pTHX_ Mode_t mode, bool effective, const Stat_t *statbufp)
 /* effective is a flag, true for EUID, or for checking if the effective gid
  *  is in the list of groups returned from getgroups().
  */
 {
-    dVAR;
-
     PERL_ARGS_ASSERT_CANDO;
+    PERL_UNUSED_CONTEXT;
 
 #ifdef DOSISH
     /* [Comments and code from Len Reed]
@@ -1909,7 +2121,7 @@ Perl_cando(pTHX_ Mode_t mode, bool effective, register const Stat_t *statbufp)
 # ifdef __CYGWIN__
     if (ingroup(544,effective)) {     /* member of Administrators */
 # else
-    if ((effective ? PL_euid : PL_uid) == 0) {	/* root is special */
+    if ((effective ? PerlProc_geteuid() : PerlProc_getuid()) == 0) {	/* root is special */
 # endif
 	if (mode == S_IXUSR) {
 	    if (statbufp->st_mode & 0111 || S_ISDIR(statbufp->st_mode))
@@ -1919,7 +2131,7 @@ Perl_cando(pTHX_ Mode_t mode, bool effective, register const Stat_t *statbufp)
 	    return TRUE;		/* root reads and writes anything */
 	return FALSE;
     }
-    if (statbufp->st_uid == (effective ? PL_euid : PL_uid) ) {
+    if (statbufp->st_uid == (effective ? PerlProc_geteuid() : PerlProc_getuid()) ) {
 	if (statbufp->st_mode & mode)
 	    return TRUE;	/* ok as "user" */
     }
@@ -1937,8 +2149,11 @@ Perl_cando(pTHX_ Mode_t mode, bool effective, register const Stat_t *statbufp)
 static bool
 S_ingroup(pTHX_ Gid_t testgid, bool effective)
 {
-    dVAR;
-    if (testgid == (effective ? PL_egid : PL_gid))
+#ifndef PERL_IMPLICIT_SYS
+    /* PERL_IMPLICIT_SYS like Win32: getegid() etc. require the context. */
+    PERL_UNUSED_CONTEXT;
+#endif
+    if (testgid == (effective ? PerlProc_getegid() : PerlProc_getgid()))
 	return TRUE;
 #ifdef HAS_GETGROUPS
     {
@@ -1947,15 +2162,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
@@ -1968,7 +2185,6 @@ S_ingroup(pTHX_ Gid_t testgid, bool effective)
 I32
 Perl_do_ipcget(pTHX_ I32 optype, SV **mark, SV **sp)
 {
-    dVAR;
     const key_t key = (key_t)SvNVx(*++mark);
     SV *nsv = optype == OP_MSGGET ? NULL : *++mark;
     const I32 flags = SvIVx(*++mark);
@@ -2003,7 +2219,6 @@ Perl_do_ipcget(pTHX_ I32 optype, SV **mark, SV **sp)
 I32
 Perl_do_ipcctl(pTHX_ I32 optype, SV **mark, SV **sp)
 {
-    dVAR;
     char *a;
     I32 ret = -1;
     const I32 id  = SvIVx(*++mark);
@@ -2102,11 +2317,16 @@ Perl_do_ipcctl(pTHX_ I32 optype, SV **mark, SV **sp)
 #ifdef Semctl
             union semun unsemds;
 
+            if(cmd == SETVAL) {
+                unsemds.val = PTR2nat(a);
+            }
+            else {
 #ifdef EXTRA_F_IN_SEMUN_BUF
-            unsemds.buff = (struct semid_ds *)a;
+                unsemds.buff = (struct semid_ds *)a;
 #else
-            unsemds.buf = (struct semid_ds *)a;
+                unsemds.buf = (struct semid_ds *)a;
 #endif
+            }
 	    ret = Semctl(id, n, cmd, unsemds);
 #else
 	    /* diag_listed_as: sem%s not implemented */
@@ -2132,7 +2352,6 @@ Perl_do_ipcctl(pTHX_ I32 optype, SV **mark, SV **sp)
 I32
 Perl_do_msgsnd(pTHX_ SV **mark, SV **sp)
 {
-    dVAR;
 #ifdef HAS_MSG
     STRLEN len;
     const I32 id = SvIVx(*++mark);
@@ -2147,12 +2366,18 @@ Perl_do_msgsnd(pTHX_ SV **mark, SV **sp)
     if (msize < 0)
 	Perl_croak(aTHX_ "Arg too short for msgsnd");
     SETERRNO(0,0);
-    return msgsnd(id, (struct msgbuf *)mbuf, msize, flags);
+    if (id >= 0 && flags >= 0) {
+      return msgsnd(id, (struct msgbuf *)mbuf, msize, flags);
+    } else {
+      SETERRNO(EINVAL,LIB_INVARG);
+      return -1;
+    }
 #else
     PERL_UNUSED_ARG(sp);
     PERL_UNUSED_ARG(mark);
     /* diag_listed_as: msg%s not implemented */
     Perl_croak(aTHX_ "msgsnd not implemented");
+    return -1;
 #endif
 }
 
@@ -2160,7 +2385,6 @@ I32
 Perl_do_msgrcv(pTHX_ SV **mark, SV **sp)
 {
 #ifdef HAS_MSG
-    dVAR;
     char *mbuf;
     long mtype;
     I32 msize, flags, ret;
@@ -2180,14 +2404,17 @@ Perl_do_msgrcv(pTHX_ SV **mark, SV **sp)
     mbuf = SvGROW(mstr, sizeof(long)+msize+1);
 
     SETERRNO(0,0);
-    ret = msgrcv(id, (struct msgbuf *)mbuf, msize, mtype, flags);
+    if (id >= 0 && msize >= 0 && flags >= 0) {
+        ret = msgrcv(id, (struct msgbuf *)mbuf, msize, mtype, flags);
+    } else {
+        SETERRNO(EINVAL,LIB_INVARG);
+        ret = -1;
+    }
     if (ret >= 0) {
 	SvCUR_set(mstr, sizeof(long)+ret);
 	*SvEND(mstr) = '\0';
-#ifndef INCOMPLETE_TAINTS
 	/* who knows who has been playing with this message? */
 	SvTAINTED_on(mstr);
-#endif
     }
     return ret;
 #else
@@ -2195,6 +2422,7 @@ Perl_do_msgrcv(pTHX_ SV **mark, SV **sp)
     PERL_UNUSED_ARG(mark);
     /* diag_listed_as: msg%s not implemented */
     Perl_croak(aTHX_ "msgrcv not implemented");
+    return -1;
 #endif
 }
 
@@ -2202,7 +2430,6 @@ I32
 Perl_do_semop(pTHX_ SV **mark, SV **sp)
 {
 #ifdef HAS_SEM
-    dVAR;
     STRLEN opsize;
     const I32 id = SvIVx(*++mark);
     SV * const opstr = *++mark;
@@ -2235,15 +2462,6 @@ Perl_do_semop(pTHX_ SV **mark, SV **sp)
             t++;
         }
         result = semop(id, temps, nsops);
-        t = temps;
-        o = ops;
-        i = nsops;
-        while (i--) {
-            *o++ = t->sem_num;
-            *o++ = t->sem_op;
-            *o++ = t->sem_flg;
-            t++;
-        }
         Safefree(temps);
         return result;
     }
@@ -2257,7 +2475,6 @@ I32
 Perl_do_shmio(pTHX_ I32 optype, SV **mark, SV **sp)
 {
 #ifdef HAS_SHM
-    dVAR;
     char *shm;
     struct shmid_ds shmds;
     const I32 id = SvIVx(*++mark);
@@ -2276,15 +2493,21 @@ Perl_do_shmio(pTHX_ I32 optype, SV **mark, SV **sp)
 	SETERRNO(EFAULT,SS_ACCVIO);		/* can't do as caller requested */
 	return -1;
     }
-    shm = (char *)shmat(id, NULL, (optype == OP_SHMREAD) ? SHM_RDONLY : 0);
+    if (id >= 0) {
+        shm = (char *)shmat(id, NULL, (optype == OP_SHMREAD) ? SHM_RDONLY : 0);
+    } else {
+        SETERRNO(EINVAL,LIB_INVARG);
+        return -1;
+    }
     if (shm == (char *)-1)	/* I hate System V IPC, I really do */
 	return -1;
     if (optype == OP_SHMREAD) {
 	char *mbuf;
 	/* suppress warning when reading into undef var (tchrist 3/Mar/00) */
+	SvGETMAGIC(mstr);
+	SvUPGRADE(mstr, SVt_PV);
 	if (! SvOK(mstr))
 	    sv_setpvs(mstr, "");
-	SvUPGRADE(mstr, SVt_PV);
 	SvPOK_only(mstr);
 	mbuf = SvGROW(mstr, (STRLEN)msize+1);
 
@@ -2292,10 +2515,8 @@ Perl_do_shmio(pTHX_ I32 optype, SV **mark, SV **sp)
 	SvCUR_set(mstr, msize);
 	*SvEND(mstr) = '\0';
 	SvSETMAGIC(mstr);
-#ifndef INCOMPLETE_TAINTS
 	/* who knows who has been playing with this shared memory? */
 	SvTAINTED_on(mstr);
-#endif
     }
     else {
 	STRLEN len;
@@ -2310,6 +2531,7 @@ Perl_do_shmio(pTHX_ I32 optype, SV **mark, SV **sp)
 #else
     /* diag_listed_as: shm%s not implemented */
     Perl_croak(aTHX_ "shm I/O not implemented");
+    return -1;
 #endif
 }
 
@@ -2321,9 +2543,9 @@ Perl_do_shmio(pTHX_ I32 optype, SV **mark, SV **sp)
 =for apidoc start_glob
 
 Function called by C<do_readline> to spawn a glob (or do the glob inside
-perl on VMS). This code used to be inline, but now perl uses C<File::Glob>
+perl on VMS).  This code used to be inline, but now perl uses C<File::Glob>
 this glob starter is only used by miniperl during the build process.
-Moving it away shrinks pp_hot.c; shrinking pp_hot.c helps speed perl up.
+Moving it away shrinks F<pp_hot.c>; shrinking F<pp_hot.c> helps speed perl up.
 
 =cut
 */
@@ -2331,12 +2553,16 @@ Moving it away shrinks pp_hot.c; shrinking pp_hot.c helps speed perl up.
 PerlIO *
 Perl_start_glob (pTHX_ SV *tmpglob, IO *io)
 {
-    dVAR;
     SV * const tmpcmd = newSV(0);
     PerlIO *fp;
+    STRLEN len;
+    const char *s = SvPV(tmpglob, len);
 
     PERL_ARGS_ASSERT_START_GLOB;
 
+    if (!IS_SAFE_SYSCALL(s, len, "pattern", "glob"))
+        return NULL;
+
     ENTER;
     SAVEFREESV(tmpcmd);
 #ifdef VMS /* expand the wildcards right here, rather than opening a pipe, */
@@ -2374,34 +2600,33 @@ Perl_vms_start_glob
 #else
     sv_setpv(tmpcmd, "echo ");
     sv_catsv(tmpcmd, tmpglob);
-#if 'z' - 'a' == 25
-    sv_catpv(tmpcmd, "|tr -s ' \t\f\r' '\\012\\012\\012\\012'|");
-#else
     sv_catpv(tmpcmd, "|tr -s ' \t\f\r' '\\n\\n\\n\\n'|");
-#endif
 #endif /* !CSH */
 #endif /* !DOSISH */
     {
 	GV * const envgv = gv_fetchpvs("ENV", 0, SVt_PVHV);
 	SV ** const home = hv_fetchs(GvHV(envgv), "HOME", 0);
+	SV ** const path = hv_fetchs(GvHV(envgv), "PATH", 0);
 	if (home && *home) SvGETMAGIC(*home);
+	if (path && *path) SvGETMAGIC(*path);
 	save_hash(gv_fetchpvs("ENV", 0, SVt_PVHV));
 	if (home && *home) SvSETMAGIC(*home);
+	if (path && *path) SvSETMAGIC(*path);
     }
-    (void)do_open(PL_last_in_gv, (char*)SvPVX_const(tmpcmd), SvCUR(tmpcmd),
-		  FALSE, O_RDONLY, 0, NULL);
+    (void)do_open6(PL_last_in_gv, SvPVX_const(tmpcmd), SvCUR(tmpcmd),
+                   NULL, NULL, 0);
     fp = IoIFP(io);
 #endif /* !VMS */
     LEAVE;
+
+    if (!fp && ckWARN(WARN_GLOB)) {
+        Perl_warner(aTHX_ packWARN(WARN_GLOB), "glob failed (can't start child: %s)",
+                    Strerror(errno));
+    }
+
     return fp;
 }
 
 /*
- * Local variables:
- * c-indentation-style: bsd
- * c-basic-offset: 4
- * indent-tabs-mode: t
- * End:
- *
- * ex: set ts=8 sts=4 sw=4 noet:
+ * ex: set ts=8 sts=4 sw=4 et:
  */