[perl #125760] deprecate sys(read|write)(), send(), recv() on :utf8

5 files changed, 53 insertions, 0 deletions

diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index 4f21dbe556..f47fd3efcb 100644
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -2619,6 +2619,27 @@ provides a list context to its subscript, which can do weird things
 if you're expecting only one subscript.  When called in list context,
 it also returns the key in addition to the value.
 
+=item %s() is deprecated on :utf8 handles
+
+(W deprecated) The sysread(), recv(), syswrite() and send() operators
+are deprecated on handles that have the C<:utf8> layer, either
+explicitly, or implicitly, eg., with the C<:encoding(UTF-16LE)> layer.
+
+Both sysread() and recv() currently use only the C<:utf8> flag for the
+stream, ignoring the actual layers.  Since sysread() and recv() do no
+UTF-8 validation they can end up creating invalidly encoded scalars.
+
+Similarly, syswrite() and send() use only the C<:utf8> flag, otherwise
+ignoring any layers.  If the flag is set, both write the value UTF-8
+encoded, even if the layer is some different encoding, such as the
+example above.
+
+Ideally, all of these operators would completely ignore the C<:utf8>
+state, working only with bytes, but this would result in silently
+breaking existing code.  To avoid this a future version of perl will
+throw an exception when any of sysread(), recv(), syswrite() or send()
+are called on handle with the C<:utf8> layer.
+
 =item Insecure dependency in %s
 
 (F) You tried to do something that the tainting mechanism didn't like.
diff --git a/pp_sys.c b/pp_sys.c
index ebd675b9be..dc1b3cec1a 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -1691,6 +1691,11 @@ PP(pp_sysread)
     fd = PerlIO_fileno(IoIFP(io));
 
     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(aTHX_ packWARN(WARN_DEPRECATED),
+                           "%s() is deprecated 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 */
 	SvUTF8_on(bufsv);
@@ -1950,6 +1955,9 @@ PP(pp_syswrite)
     doing_utf8 = DO_UTF8(bufsv);
 
     if (PerlIO_isutf8(IoIFP(io))) {
+        Perl_ck_warner(aTHX_ packWARN(WARN_DEPRECATED),
+                       "%s() is deprecated on :utf8 handles",
+                       OP_DESC(PL_op));
 	if (!SvUTF8(bufsv)) {
 	    /* We don't modify the original scalar.  */
 	    tmpbuf = bytes_to_utf8((const U8*) buffer, &blen);
diff --git a/t/lib/warnings/pp_sys b/t/lib/warnings/pp_sys
index a1e07f8966..ea18bac2be 100644
--- a/t/lib/warnings/pp_sys
+++ b/t/lib/warnings/pp_sys
@@ -939,3 +939,25 @@ sleep(-1);
 
 EXPECT
 sleep() with negative argument at - line 2.
+########
+# NAME sysread() deprecated on :utf8
+use warnings 'deprecated';
+open my $fh, "<", "../harness" or die "# $!";
+my $buf;
+sysread $fh, $buf, 10;
+binmode $fh, ':utf8';
+sysread $fh, $buf, 10;
+EXPECT
+sysread() is deprecated on :utf8 handles at - line 6.
+########
+# NAME syswrite() deprecated on :utf8
+my $file = "syswwarn.tmp";
+use warnings 'deprecated';
+open my $fh, ">", $file or die "# $!";
+syswrite $fh, 'ABC';
+binmode $fh, ':utf8';
+syswrite $fh, 'ABC';
+close $fh;
+unlink $file;
+EXPECT
+syswrite() is deprecated on :utf8 handles at - line 6.
diff --git a/t/op/gmagic.t b/t/op/gmagic.t
index bcf1322578..94e164e313 100644
--- a/t/op/gmagic.t
+++ b/t/op/gmagic.t
@@ -77,6 +77,7 @@ expected_tie_calls(tied $c, 1, 2, 'chomping a ref');
  # Do this again, with a utf8 handle
     $c = *foo;                                         # 1 write
     open $h, "<:utf8", $outfile;
+    no warnings 'deprecated';
     sysread $h, $c, 3, 7;                              # 1 read; 1 write
     is $c, "*main::bar", 'what sysread wrote';         # 1 read
     expected_tie_calls(tied $c, 2, 2, 'calling sysread with tied buf');
diff --git a/t/uni/overload.t b/t/uni/overload.t
index 66cd5b852d..ff89b0835c 100644
--- a/t/uni/overload.t
+++ b/t/uni/overload.t
@@ -169,6 +169,7 @@ foreach my $operator ('print', 'syswrite', 'syswrite len', 'syswrite off',
 	my $trail = $operator =~ /\blen\b/ ? "!" : "";
 	my $u = UTF8Toggle->new("$pad$E_acute\n$trail");
 	my $l = UTF8Toggle->new("$pad$e_acute\n$trail", 1);
+        no warnings 'deprecated';
 	if ($operator eq 'print') {
 	    no warnings 'utf8';
 	    print $fh $u;