tr///c: handle len(replacement charlist) > 32767
authorDavid Mitchell <davem@iabyn.com>
Fri, 12 Jan 2018 16:21:48 +0000 (16:21 +0000)
committerDavid Mitchell <davem@iabyn.com>
Fri, 19 Jan 2018 13:45:20 +0000 (13:45 +0000)
RT #132608

In the non-utf8 case, the /c (complement) flag to tr adds an implied
\x{100}-\x{7fffffff} range to the search charlist. If the replacement list
contains more chars than are paired with the 0-255 part of the search
list, then the excess chars are stored in an extended part of the table.
The excess char count was being stored as a short, which caused problems
if the replacement list contained more than 32767 excess chars: either
substituting the wrong char, or substituting for a char located up to
0xffff bytes in memory before the real translation table.

So change it to SSize_t.

Note that this is only a problem when the search and replacement charlists
are non-utf8, the replacement list contains around 0x8000+ entries, and
where the string being translated is utf8 with at least one codepoint >=
U+8000.

doop.c
ext/B/B.xs
lib/B/Deparse.pm
op.c
op.h
t/op/tr.t

diff --git a/doop.c b/doop.c
index fa908cf..edc4038 100644 (file)
--- a/doop.c
+++ b/doop.c
@@ -227,7 +227,7 @@ S_do_trans_complex(pTHX_ SV * const sv)
        if (complement)
             /* number of replacement chars in excess of any 0x00..0xff
              * search characters */
-           excess = (SSize_t)extbl->excess_len;
+           excess = extbl->excess_len;
 
        if (PL_op->op_private & OPpTRANS_SQUASH) {
            UV pch = 0xfeedface;
index b7d80e4..426cbf3 100644 (file)
@@ -1033,7 +1033,7 @@ next(o)
                                                 (OPtrans_map_ex*)cPVOPo->op_pv;
                     char *end = (char*)(&(extbl->map[256]));
                     if (cPVOPo->op_private & OPpTRANS_COMPLEMENT) {
-                        short excess_len = extbl->excess_len;
+                        SSize_t excess_len = extbl->excess_len;
                         end = (char*)(&(extbl->map_ex[excess_len]));
                     }
                    ret = newSVpvn_flags(cPVOPo->op_pv,
index 5fc3d02..0b4fafc 100644 (file)
@@ -58,6 +58,8 @@ our $AUTOLOAD;
 use warnings ();
 require feature;
 
+use Config;
+
 BEGIN {
     # List version-specific constants here.
     # Easiest way to keep this code portable between version looks to
@@ -5607,7 +5609,8 @@ sub collapse {
 
 sub tr_decode_byte {
     my($table, $flags) = @_;
-    my (@table) = unpack("s256sss*", $table);
+    my $ssize_t = $Config{ptrsize} == 8 ? 'q' : 'l';
+    my (@table) = unpack("s256${ssize_t}ss*", $table);
     my ($excess_len, $repeat_char) = splice(@table, 256, 2);
 
     my($c, $tr, @from, @to, @delfrom, $delhyphen);
diff --git a/op.c b/op.c
index 4fb46e1..2fc4d94 100644 (file)
--- a/op.c
+++ b/op.c
@@ -6702,7 +6702,7 @@ S_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
                         o->op_private |= OPpTRANS_IDENTICAL;
                 }
            }
-            extbl->excess_len  = (short)excess;      /* excess char count */
+            extbl->excess_len  = excess;      /* excess char count */
             extbl->repeat_char = (short)repeat_char; /* repeated replace char */
        }
     }
diff --git a/op.h b/op.h
index aeee339..5ba7167 100644 (file)
--- a/op.h
+++ b/op.h
@@ -638,7 +638,7 @@ typedef struct {
  * are paired with the implicit 0x100..0x7fffffff search chars */
 typedef struct {
     short map[256];
-    short excess_len; /* number of entries in map_ex[] */
+    SSize_t excess_len; /* number of entries in map_ex[] */
     short repeat_char;
     short map_ex[1];  /* Unwarranted chumminess */
 } OPtrans_map_ex;
index db2134b..0f74936 100644 (file)
--- a/t/op/tr.t
+++ b/t/op/tr.t
@@ -13,7 +13,7 @@ BEGIN {
 
 use utf8;
 
-plan tests => 296;
+plan tests => 300;
 
 # Test this first before we extend the stack with other operations.
 # This caused an asan failure due to a bad write past the end of the stack.
@@ -445,6 +445,31 @@ like $@,
     is $c, 0x120, "/csd <U count";
 }
 
+{
+    # RT #132608
+    # the 'extra length' for tr///c was stored as a short, so if the
+    # replacement string had more than 0x7fff chars not paired with
+    # search chars, bad things could happen
+
+    my ($c, $e, $s);
+
+    $s = "\x{9000}\x{9001}\x{9002}";
+    $e =    "\$c = \$s =~ tr/\\x00-\\xff/"
+          . ("ABCDEFGHIJKLMNO" x (0xa000 / 15))
+          . "/c; 1; ";
+    eval $e or die $@;
+    is $s, "IJK", "RT #132608 len=0xa000";
+    is $c, 3, "RT #132608 len=0xa000 count";
+
+    $s = "\x{9003}\x{9004}\x{9005}";
+    $e =    "\$c = \$s =~ tr/\\x00-\\xff/"
+          . ("ABCDEFGHIJKLMNO" x (0x12000 / 15))
+          . "/c; 1; ";
+    eval $e or die $@;
+    is $s, "LMN", "RT #132608 len=0x12000";
+    is $c, 3, "RT #132608 len=0x12000 count";
+}
+
 
 SKIP: {   # Test literal range end point special handling
     unless ($::IS_EBCDIC) {