[00d04c4f12] Repair broken edge cases in [binary encode base64].

3 files changed, 51 insertions, 2 deletions

diff --git a/changes b/changes
index 1bae43b..eb18c72 100644
--- a/changes
+++ b/changes
@@ -8891,4 +8891,6 @@ improvements to regexp engine from Postgres (lane,porter,fellows,seltenreich)
 
 2018-11-09 (bug)[35a8f1] overlong string length of some lists (owens)
 
+2018-11-16 (bug)[00d04c] Repair [binary encode base64] (sebres)
+
 - Released 8.6.9, November 16, 2018 - details at http://core.tcl-lang.org/tcl/ -
diff --git a/generic/tclBinary.c b/generic/tclBinary.c
index bb918f2..571eb07 100644
--- a/generic/tclBinary.c
+++ b/generic/tclBinary.c
@@ -2914,6 +2914,11 @@ BinaryDecode64(
 	    } else if (i > 1) {
 		c = '=';
 	    } else {
+		if (strict && i <= 1) {
+		    /* single resp. unfulfilled char (each 4th next single char)
+		     * is rather bad64 error case in strict mode */
+		    goto bad64;
+		}
 		cut += 3;
 		break;
 	    }
@@ -2944,9 +2949,11 @@ BinaryDecode64(
 		value = (value << 6) | 0x3e;
 	    } else if (c == '/') {
 		value = (value << 6) | 0x3f;
-	    } else if (c == '=') {
+	    } else if (c == '=' && (
+		!strict || i > 1) /* "=" and "a=" is rather bad64 error case in strict mode */
+	    ) {
 		value <<= 6;
-		cut++;
+		if (i) cut++;
 	    } else if (strict || !isspace(c)) {
 		goto bad64;
 	    } else {
diff --git a/tests/binary.test b/tests/binary.test
index 2a306a3..8c1dedb 100644
--- a/tests/binary.test
+++ b/tests/binary.test
@@ -2711,6 +2711,46 @@ test binary-73.30 {binary decode base64} -body {
 test binary-73.31 {binary decode base64} -body {
     list [string length [set r [binary decode base64 WA==WFla]]] $r
 } -returnCodes error -match glob -result {invalid base64 character *}
+test binary-73.32 {binary decode base64, bug [00d04c4f12]} -body {
+    list \
+	[string length [binary decode base64 =]] \
+	[string length [binary decode base64 " ="]] \
+	[string length [binary decode base64 "   ="]] \
+	[string length [binary decode base64 "\r\n\t="]] \
+} -result [lrepeat 4 0]
+test binary-73.33 {binary decode base64, bug [00d04c4f12]} -body {
+    list \
+	[string length [binary decode base64 ==]] \
+	[string length [binary decode base64 " =="]] \
+	[string length [binary decode base64 "  =="]] \
+	[string length [binary decode base64 "   =="]] \
+} -result [lrepeat 4 0]
+test binary-73.34 {binary decode base64, (compatibility) unfulfilled base64 (single char) in non-strict mode} -body {
+    list \
+	[expr {[binary decode base64 a] eq [binary decode base64 ""]}] \
+	[expr {[binary decode base64 abcda] eq [binary decode base64 "abcd"]}]
+} -result [lrepeat 2 1]
+test binary-73.35 {binary decode base64, bad base64 in strict mode} -body {
+    set r {}
+    foreach c {a " a" "  a" "   a" "    a" abcda abcdabcda a= a== abcda= abcda==} {
+	lappend r \
+	    [catch {binary decode base64 $c}] \
+	    [catch {binary decode base64 -strict $c}]
+    }
+    set r
+} -result [lrepeat 11 0 1]
+test binary-73.36 {binary decode base64: check encoded & decoded equals original} -body {
+    set r {}
+    for {set i 0} {$i < 255 && [llength $r] < 20} {incr i} {
+	foreach c {1 2 3 4 5 6 7 8} {
+	    set c [string repeat [format %c $i] $c]
+	    if {[set a [binary decode base64 [set x [binary encode base64 $c]]]] ne $c} {
+		lappend r "encode & decode is wrong on string `$c` (encoded: $x): `$a` != `$c`"
+	    }
+	}
+    }
+    join $r \n
+} -result {}
 
 test binary-74.1 {binary encode uuencode} -body {
     binary encode uuencode