From dca8be01de6f8cc44135c0528bba0fc4d25c3a44 Mon Sep 17 00:00:00 2001 From: sebres Date: Thu, 15 Nov 2018 22:18:29 +0000 Subject: test cases for decode base64, bug [00d04c4f12], unfulfilled base64 (strict and non-strict mode, etc). --- tests/binary.test | 40 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 40 insertions(+) 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 -- cgit v0.12 From d1e5b0f72f8fd4f57590893488e6fd2df7fba2d2 Mon Sep 17 00:00:00 2001 From: sebres Date: Thu, 15 Nov 2018 22:31:39 +0000 Subject: fixes segfault [00d04c4f12], unfulfilled base64 (strict and non-strict mode, etc). --- generic/tclBinary.c | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) 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 { -- cgit v0.12 From fa3d7ed1784d69d0aa90486a9f53ac71a0aa1c41 Mon Sep 17 00:00:00 2001 From: dkf Date: Fri, 16 Nov 2018 13:45:26 +0000 Subject: Clear up a bunch of small issues found by Coverity analysis. --- generic/tclCmdMZ.c | 82 +++++++++++++++++++++++++-------------------------- generic/tclOOInfo.c | 14 +++++---- generic/tclOOMethod.c | 6 ++-- generic/tclPathObj.c | 1 + generic/tclZlib.c | 2 +- 5 files changed, 52 insertions(+), 53 deletions(-) diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index 8530719..01c0a2d 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -1080,7 +1080,7 @@ Tcl_SplitObjCmd( Tcl_InitHashTable(&charReuseTable, TCL_ONE_WORD_KEYS); for ( ; stringPtr < end; stringPtr += len) { - int fullchar; + int fullchar; len = TclUtfToUniChar(stringPtr, &ch); fullchar = ch; @@ -2638,9 +2638,7 @@ StringEqualCmd( */ objv += objc-2; - - match = TclStringCmp (objv[0], objv[1], 0, nocase, reqlength); - + match = TclStringCmp(objv[0], objv[1], 0, nocase, reqlength); Tcl_SetObjResult(interp, Tcl_NewBooleanObj(match ? 0 : 1)); return TCL_OK; } @@ -2678,25 +2676,25 @@ StringCmpCmd( int match, nocase, reqlength, status; - if ((status = TclStringCmpOpts(interp, objc, objv, &nocase, &reqlength)) - != TCL_OK) { - + status = TclStringCmpOpts(interp, objc, objv, &nocase, &reqlength); + if (status != TCL_OK) { return status; } objv += objc-2; - match = TclStringCmp (objv[0], objv[1], 0, nocase, reqlength); + match = TclStringCmp(objv[0], objv[1], 0, nocase, reqlength); Tcl_SetObjResult(interp, Tcl_NewIntObj(match)); return TCL_OK; } -int TclStringCmp ( - Tcl_Obj *value1Ptr, - Tcl_Obj *value2Ptr, - int checkEq, /* comparison is only for equality */ - int nocase, /* comparison is not case sensitive */ - int reqlength /* requested length */ -) { +int +TclStringCmp( + Tcl_Obj *value1Ptr, + Tcl_Obj *value2Ptr, + int checkEq, /* comparison is only for equality */ + int nocase, /* comparison is not case sensitive */ + int reqlength) /* requested length */ +{ char *s1, *s2; int empty, length, match, s1len, s2len; memCmpFn_t memCmpFn; @@ -2707,7 +2705,6 @@ int TclStringCmp ( */ match = 0; } else { - if (!nocase && TclIsPureByteArray(value1Ptr) && TclIsPureByteArray(value2Ptr)) { /* @@ -2716,6 +2713,7 @@ int TclStringCmp ( * case-sensitive (which is all that really makes sense with byte * arrays anyway, and we have no memcasecmp() for some reason... :^) */ + s1 = (char *) Tcl_GetByteArrayFromObj(value1Ptr, &s1len); s2 = (char *) Tcl_GetByteArrayFromObj(value2Ptr, &s2len); memCmpFn = memcmp; @@ -2747,11 +2745,11 @@ int TclStringCmp ( s2 = (char *) Tcl_GetUnicode(value2Ptr); if ( #ifdef WORDS_BIGENDIAN - 1 + 1 #else - checkEq -#endif - ) { + checkEq +#endif /* WORDS_BIGENDIAN */ + ) { memCmpFn = memcmp; s1len *= sizeof(Tcl_UniChar); s2len *= sizeof(Tcl_UniChar); @@ -2761,33 +2759,34 @@ int TclStringCmp ( } } } else { - if ((empty = TclCheckEmptyString(value1Ptr)) > 0) { + empty = TclCheckEmptyString(value1Ptr); + if (empty > 0) { switch (TclCheckEmptyString(value2Ptr)) { - case -1: + case -1: s1 = ""; s1len = 0; s2 = TclGetStringFromObj(value2Ptr, &s2len); break; - case 0: + case 0: match = -1; goto matchdone; - case 1: - default: /* avoid warn: `s2` may be used uninitialized */ + case 1: + default: /* avoid warn: `s2` may be used uninitialized */ match = 0; goto matchdone; } } else if (TclCheckEmptyString(value2Ptr) > 0) { switch (empty) { - case -1: + case -1: s2 = ""; s2len = 0; s1 = TclGetStringFromObj(value1Ptr, &s1len); break; - case 0: + case 0: match = 1; goto matchdone; - case 1: - default: /* avoid warn: `s1` may be used uninitialized */ + case 1: + default: /* avoid warn: `s1` may be used uninitialized */ match = 0; goto matchdone; } @@ -2797,18 +2796,18 @@ int TclStringCmp ( } if (!nocase && checkEq) { /* - * When we have equal-length we can check only for (in)equality. - * We can use memcmp in all (n)eq cases because we - * don't need to worry about lexical LE/BE variance. + * When we have equal-length we can check only for + * (in)equality. We can use memcmp in all (n)eq cases because + * we don't need to worry about lexical LE/BE variance. */ memCmpFn = memcmp; } else { - /* - * As a catch-all we will work with UTF-8. We cannot use memcmp() as - * that is unsafe with any string containing NUL (\xC0\x80 in Tcl's - * utf rep). We can use the more efficient TclpUtfNcmp2 if we are - * case-sensitive and no specific length was requested. + * As a catch-all we will work with UTF-8. We cannot use + * memcmp() as that is unsafe with any string containing NUL + * (\xC0\x80 in Tcl's utf rep). We can use the more efficient + * TclpUtfNcmp2 if we are case-sensitive and no specific + * length was requested. */ if ((reqlength < 0) && !nocase) { @@ -2826,8 +2825,8 @@ int TclStringCmp ( length = reqlength; } else if (reqlength < 0) { /* - * The requested length is negative, so we ignore it by setting it to - * length + 1 so we correct the match var. + * The requested length is negative, so we ignore it by setting it + * to length + 1 so we correct the match var. */ reqlength = length + 1; @@ -2851,13 +2850,12 @@ int TclStringCmp ( return match; } -int TclStringCmpOpts ( +int TclStringCmpOpts( Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[], /* Argument objects. */ int *nocase, - int *reqlength -) + int *reqlength) { int i, length; const char *string; diff --git a/generic/tclOOInfo.c b/generic/tclOOInfo.c index 76eaef5..c9263b5 100644 --- a/generic/tclOOInfo.c +++ b/generic/tclOOInfo.c @@ -114,12 +114,14 @@ TclOOInitInfo( */ infoCmd = Tcl_FindCommand(interp, "info", NULL, TCL_GLOBAL_ONLY); - Tcl_GetEnsembleMappingDict(NULL, infoCmd, &mapDict); - Tcl_DictObjPut(NULL, mapDict, Tcl_NewStringObj("object", -1), - Tcl_NewStringObj("::oo::InfoObject", -1)); - Tcl_DictObjPut(NULL, mapDict, Tcl_NewStringObj("class", -1), - Tcl_NewStringObj("::oo::InfoClass", -1)); - Tcl_SetEnsembleMappingDict(interp, infoCmd, mapDict); + if (infoCmd) { + Tcl_GetEnsembleMappingDict(NULL, infoCmd, &mapDict); + Tcl_DictObjPut(NULL, mapDict, Tcl_NewStringObj("object", -1), + Tcl_NewStringObj("::oo::InfoObject", -1)); + Tcl_DictObjPut(NULL, mapDict, Tcl_NewStringObj("class", -1), + Tcl_NewStringObj("::oo::InfoClass", -1)); + Tcl_SetEnsembleMappingDict(interp, infoCmd, mapDict); + } } /* diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c index 8da0fb3..3e64ba2 100644 --- a/generic/tclOOMethod.c +++ b/generic/tclOOMethod.c @@ -970,10 +970,8 @@ ProcedureMethodVarResolver( * Must not retain reference to resolved information. [Bug 3105999] */ - if (rPtr != NULL) { - rPtr->deleteProc(rPtr); - } - return (*varPtr? TCL_OK : TCL_CONTINUE); + rPtr->deleteProc(rPtr); + return (*varPtr ? TCL_OK : TCL_CONTINUE); } static Tcl_Var diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c index 29d6f96..e214d1f 100644 --- a/generic/tclPathObj.c +++ b/generic/tclPathObj.c @@ -1359,6 +1359,7 @@ TclNewFSPathObj( count = 0; state = 1; } + break; case 1: /* Scanning for next dirsep */ switch (*p) { case '/': diff --git a/generic/tclZlib.c b/generic/tclZlib.c index fc20d7e..aed38c3 100644 --- a/generic/tclZlib.c +++ b/generic/tclZlib.c @@ -1488,7 +1488,7 @@ Tcl_ZlibStreamGet( count = 0; for (i=0; ioutData, i, &itemObj); - itemPtr = Tcl_GetByteArrayFromObj(itemObj, &itemLen); + (void) Tcl_GetByteArrayFromObj(itemObj, &itemLen); if (i == 0) { count += itemLen - zshPtr->outPos; } else { -- cgit v0.12 From 38f743a2c7279a2cc77c9da36499a9d43a7427e0 Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 16 Nov 2018 18:45:59 +0000 Subject: [00d04c4f12] Repair broken edge cases in [binary encode base64]. --- changes | 2 ++ generic/tclBinary.c | 11 +++++++++-- tests/binary.test | 40 ++++++++++++++++++++++++++++++++++++++++ 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 -- cgit v0.12