From 1ed4b7762a858fb9c71bc209fe868060f3774cb5 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Tue, 25 Sep 2018 11:18:40 +1000
Subject: (perl #125760) fatalize sysread/syswrite/recv/send on :utf8 handles

This includes removing the :utf8 logic from pp_syswrite.  pp_sysread
retains it, since it's also used for read().

Tests that are specifically testing the behaviour against :utf8
handles have been removed (eg in lib/open.t), several other tests
that incidentally used those functions on :utf8 handles have been
adapted to use :raw handles instead (eg. op/readline.t).

Test lib/sigtrap.t fails if STDERR is :utf8, in code from the
original 5.000 commit, which is intended to run in a signal handler
---
 pp_sys.c | 80 ++++++++++++----------------------------------------------------
 1 file changed, 14 insertions(+), 66 deletions(-)

(limited to 'pp_sys.c')

diff --git a/pp_sys.c b/pp_sys.c
index 4ae475d460..00faa7711f 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -1725,10 +1725,9 @@ PP(pp_sysread)
 
     if ((fp_utf8 = PerlIO_isutf8(IoIFP(io))) && !IN_BYTES) {
         if (PL_op->op_type == OP_SYSREAD || PL_op->op_type == OP_RECV) {
-            Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED),
-                             "%s() is deprecated on :utf8 handles. "
-                             "This will be a fatal error in Perl 5.30",
-                             OP_DESC(PL_op));
+            Perl_croak(aTHX_
+                       "%s() isn't allowed on :utf8 handles",
+                       OP_DESC(PL_op));
         }
 	buffer = SvPVutf8_force(bufsv, blen);
 	/* UTF-8 may not have been set if they are all low bytes */
@@ -1939,7 +1938,6 @@ PP(pp_syswrite)
     const char *buffer;
     SSize_t retval;
     STRLEN blen;
-    STRLEN orig_blen_bytes;
     const int op_type = PL_op->op_type;
     bool doing_utf8;
     U8 *tmpbuf = NULL;
@@ -1985,20 +1983,12 @@ PP(pp_syswrite)
 
     /* Do this first to trigger any overloading.  */
     buffer = SvPV_const(bufsv, blen);
-    orig_blen_bytes = blen;
     doing_utf8 = DO_UTF8(bufsv);
 
     if (PerlIO_isutf8(IoIFP(io))) {
-        Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED),
-                         "%s() is deprecated on :utf8 handles. "
-                         "This will be a fatal error in Perl 5.30",
-                         OP_DESC(PL_op));
-	if (!SvUTF8(bufsv)) {
-	    /* We don't modify the original scalar.  */
-	    tmpbuf = bytes_to_utf8((const U8*) buffer, &blen);
-	    buffer = (char *) tmpbuf;
-	    doing_utf8 = TRUE;
-	}
+        Perl_croak(aTHX_
+                   "%s() isn't allowed on :utf8 handles",
+                   OP_DESC(PL_op));
     }
     else if (doing_utf8) {
 	STRLEN tmplen = blen;
@@ -2031,25 +2021,10 @@ PP(pp_syswrite)
 #endif
     {
 	Size_t length = 0; /* This length is in characters.  */
-	STRLEN blen_chars;
 	IV offset;
 
-	if (doing_utf8) {
-	    if (tmpbuf) {
-		/* The SV is bytes, and we've had to upgrade it.  */
-		blen_chars = orig_blen_bytes;
-	    } else {
-		/* The SV really is UTF-8.  */
-		/* Don't call sv_len_utf8 on a magical or overloaded
-		   scalar, as we might get back a different result.  */
-		blen_chars = sv_or_pv_len_utf8(bufsv, buffer, blen);
-	    }
-	} else {
-	    blen_chars = blen;
-	}
-
 	if (MARK >= SP) {
-	    length = blen_chars;
+	    length = blen;
 	} else {
 #if Size_t_size > IVSIZE
 	    length = (Size_t)SvNVx(*++MARK);
@@ -2065,46 +2040,21 @@ PP(pp_syswrite)
 	if (MARK < SP) {
 	    offset = SvIVx(*++MARK);
 	    if (offset < 0) {
-		if (-offset > (IV)blen_chars) {
+		if (-offset > (IV)blen) {
 		    Safefree(tmpbuf);
 		    DIE(aTHX_ "Offset outside string");
 		}
-		offset += blen_chars;
-	    } else if (offset > (IV)blen_chars) {
+		offset += blen;
+	    } else if (offset > (IV)blen) {
 		Safefree(tmpbuf);
 		DIE(aTHX_ "Offset outside string");
 	    }
 	} else
 	    offset = 0;
-	if (length > blen_chars - offset)
-	    length = blen_chars - offset;
-	if (doing_utf8) {
-	    /* Here we convert length from characters to bytes.  */
-	    if (tmpbuf || SvGMAGICAL(bufsv) || SvAMAGIC(bufsv)) {
-		/* Either we had to convert the SV, or the SV is magical, or
-		   the SV has overloading, in which case we can't or mustn't
-		   or mustn't call it again.  */
-
-		buffer = (const char*)utf8_hop((const U8 *)buffer, offset);
-		length = utf8_hop((U8 *)buffer, length) - (U8 *)buffer;
-	    } else {
-		/* It's a real UTF-8 SV, and it's not going to change under
-		   us.  Take advantage of any cache.  */
-		I32 start = offset;
-		I32 len_I32 = length;
-
-		/* Convert the start and end character positions to bytes.
-		   Remember that the second argument to sv_pos_u2b is relative
-		   to the first.  */
-		sv_pos_u2b(bufsv, &start, &len_I32);
-
-		buffer += start;
-		length = len_I32;
-	    }
-	}
-	else {
-	    buffer = buffer+offset;
-	}
+	if (length > blen - offset)
+	    length = blen - offset;
+        buffer = buffer+offset;
+
 #ifdef PERL_SOCK_SYSWRITE_IS_SEND
 	if (IoTYPE(io) == IoTYPE_SOCKET) {
 	    retval = PerlSock_send(fd, buffer, length, 0);
@@ -2120,8 +2070,6 @@ PP(pp_syswrite)
     if (retval < 0)
 	goto say_undef;
     SP = ORIGMARK;
-    if (doing_utf8)
-        retval = utf8_length((U8*)buffer, (U8*)buffer + retval);
 
     Safefree(tmpbuf);
 #if Size_t_size > IVSIZE
-- 
cgit v1.2.1