From 0403a1ad8ff01aaac2d09a986ea6bb5210472459 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Thu, 22 Oct 2015 12:03:05 +1100
Subject: [PATCH] [perl #126325] don't read past the end of the source for pack
 [Hh]

With a utf8 target but a non-utf8 source, pack Hh would read past the
end of the source when given a length, due to an incorrect condition.
---
 pp_pack.c   |  2 +-
 t/op/pack.t | 22 +++++++++++++++++++++-
 2 files changed, 22 insertions(+), 2 deletions(-)

diff --git a/pp_pack.c b/pp_pack.c
index 96dfd20..044ea7f 100644
--- a/pp_pack.c
+++ b/pp_pack.c
@@ -2488,7 +2488,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
 	    if (howlen == e_star) len = fromlen;
 	    field_len = (len+1)/2;
 	    GROWING(utf8, cat, start, cur, field_len);
-	    if (!utf8 && len > (I32)fromlen) len = fromlen;
+	    if (!utf8_source && len > (I32)fromlen) len = fromlen;
 	    bits = 0;
 	    l = 0;
 	    if (datumtype == 'H')
diff --git a/t/op/pack.t b/t/op/pack.t
index e348693..a2da636 100644
--- a/t/op/pack.t
+++ b/t/op/pack.t
@@ -12,7 +12,7 @@ my $no_endianness = $] > 5.009 ? '' :
 my $no_signedness = $] > 5.009 ? '' :
   "Signed/unsigned pack modifiers not available on this perl";
 
-plan tests => 14708;
+plan tests => 14712;
 
 use strict;
 use warnings qw(FATAL all);
@@ -2024,3 +2024,23 @@ is $o::num, 1,     'pack "c" does call num overloading';
 #[perl #123874]: argument underflow leads to corrupt length
 eval q{ pack "pi/x" };
 ok(1, "argument underflow did not crash");
+
+{
+    # [perl #126325] pack [hH] with a unicode string
+    # the hex encoders would read past the end of the string, using
+    # invalid source bytes
+    my $twenty_nuls = "\0" x 20;
+    # This is the case that failed
+    is(pack("WH40", 0x100, ""), "\x{100}$twenty_nuls",
+       "check pack H zero fills (utf8 target)");
+    my $up_nul = "\0";
+
+    utf8::upgrade($up_nul);
+    # check the other combinations too
+    is(pack("WH40", 0x100, $up_nul), "\x{100}$twenty_nuls",
+       "check pack H zero fills (utf8 target/source)");
+    is(pack("H40", ""), $twenty_nuls,
+       "check pack H zero fills (utf8 none)");
+    is(pack("H40", $up_nul), $twenty_nuls,
+       "check pack H zero fills (utf8 source)");
+}
-- 
1.8.3.1