From dcd49ec1ee202c50fa9921cabd1b716ae0c159fe Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Tue, 6 Dec 2016 18:55:28 +0000
Subject: Several commands should be picky about expecting byte-valued
 arguments. Make them so.

---
 generic/tclBinary.c | 31 ++++++++++++++++++++++++++++---
 generic/tclCmdAH.c  |  6 ++++++
 generic/tclTest.c   |  4 ++++
 tests/utf.test      |  4 ++--
 4 files changed, 40 insertions(+), 5 deletions(-)

diff --git a/generic/tclBinary.c b/generic/tclBinary.c
index 4074596..350105a 100644
--- a/generic/tclBinary.c
+++ b/generic/tclBinary.c
@@ -453,6 +453,9 @@ Tcl_GetByteArrayFromObj(
     if ((objPtr->typePtr != &properByteArrayType)
 	    && (objPtr->typePtr != &tclByteArrayType)) {
 	if (TCL_ERROR == SetByteArrayFromAny(NULL, objPtr)) {
+	    if (lengthPtr != NULL) {
+		*lengthPtr = 0;
+	    }
 	    return NULL;
 	}
     }
@@ -1370,9 +1373,13 @@ BinaryScanCmd(
 		"value formatString ?varName ...?");
 	return TCL_ERROR;
     }
+    buffer = Tcl_GetByteArrayFromObj(objv[1], &length);
+    if (buffer == NULL) {
+	Tcl_AppendResult(interp, "binary scan expects bytes", NULL);
+	return TCL_ERROR;
+    }
     numberCachePtr = &numberCacheHash;
     Tcl_InitHashTable(numberCachePtr, TCL_ONE_WORD_KEYS);
-    buffer = Tcl_GetByteArrayFromObj(objv[1], &length);
     format = TclGetString(objv[2]);
     arg = 3;
     offset = 0;
@@ -2411,8 +2418,13 @@ BinaryEncodeHex(
 	return TCL_ERROR;
     }
 
-    TclNewObj(resultObj);
     data = Tcl_GetByteArrayFromObj(objv[1], &count);
+    if (data == NULL) {
+	Tcl_AppendResult(interp, "binary encode expects bytes", NULL);
+	return TCL_ERROR;
+    }
+
+    TclNewObj(resultObj);
     cursor = Tcl_SetByteArrayLength(resultObj, count * 2);
     for (offset = 0; offset < count; ++offset) {
 	*cursor++ = HexDigits[((data[offset] >> 4) & 0x0f)];
@@ -2605,8 +2617,12 @@ BinaryEncode64(
 	}
     }
 
-    resultObj = Tcl_NewObj();
     data = Tcl_GetByteArrayFromObj(objv[objc-1], &count);
+    if (data == NULL) {
+	Tcl_AppendResult(interp, "binary encode expects bytes", NULL);
+	return TCL_ERROR;
+    }
+    resultObj = Tcl_NewObj();
     if (count > 0) {
 	size = (((count * 4) / 3) + 3) & ~3; /* ensure 4 byte chunks */
 	if (maxlen > 0 && size > maxlen) {
@@ -2705,6 +2721,11 @@ BinaryEncodeUu(
 	    break;
 	case OPT_WRAPCHAR:
 	    wrapchar = Tcl_GetByteArrayFromObj(objv[i+1], &wrapcharlen);
+	    if (wrapchar == NULL) {
+		Tcl_AppendResult(interp,
+			"binary encode -wrapchar expects bytes", NULL);
+		return TCL_ERROR;
+	    }
 	    break;
 	}
     }
@@ -2717,6 +2738,10 @@ BinaryEncodeUu(
     resultObj = Tcl_NewObj();
     offset = 0;
     data = Tcl_GetByteArrayFromObj(objv[objc-1], &count);
+    if (data == NULL) {
+	Tcl_AppendResult(interp, "binary encode expects bytes", NULL);
+	return TCL_ERROR;
+    }
     rawLength = (lineLength - 1) * 3 / 4;
     start = cursor = Tcl_SetByteArrayLength(resultObj,
 	    (lineLength + wrapcharlen) *
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index 0883a1d..9afc4f6 100644
--- a/generic/tclCmdAH.c
+++ b/generic/tclCmdAH.c
@@ -431,6 +431,12 @@ Tcl_EncodingObjCmd(
 	     */
 
 	    stringPtr = (char *) Tcl_GetByteArrayFromObj(data, &length);
+	    if (stringPtr == NULL) {
+		Tcl_AppendResult(interp, "encoding conversion expects bytes",
+			NULL);
+		Tcl_FreeEncoding(encoding);
+		return TCL_ERROR;
+	    }
 	    Tcl_ExternalToUtfDString(encoding, stringPtr, length, &ds);
 
 	    /*
diff --git a/generic/tclTest.c b/generic/tclTest.c
index bc64594..d554c54 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -4847,6 +4847,10 @@ TestbytestringObjCmd(
 	return TCL_ERROR;
     }
     p = (const char *)Tcl_GetByteArrayFromObj(objv[1], &n);
+    if (p == NULL) {
+	Tcl_AppendResult(interp, "testbytestring expects bytes", NULL);
+	return TCL_ERROR;
+    }
     Tcl_SetObjResult(interp, Tcl_NewStringObj(p, n));
     return TCL_OK;
 }
diff --git a/tests/utf.test b/tests/utf.test
index a03dd6c..4a4c1d0 100644
--- a/tests/utf.test
+++ b/tests/utf.test
@@ -75,7 +75,7 @@ test utf-4.2 {Tcl_NumUtfChars: length 1} {testnumutfchars testbytestring} {
     testnumutfchars [testbytestring "\xC2\xA2"]
 } {1}
 test utf-4.3 {Tcl_NumUtfChars: long string} {testnumutfchars testbytestring} {
-    testnumutfchars [testbytestring "abc\xC2\xA2\xe4\xb9\x8e\uA2\u4e4e"]
+    testnumutfchars [testbytestring "abc\xC2\xA2\xe4\xb9\x8e\uA2\u4e"]
 } {7}
 test utf-4.4 {Tcl_NumUtfChars: #u0000} {testnumutfchars testbytestring} {
     testnumutfchars [testbytestring "\xC0\x80"]
@@ -87,7 +87,7 @@ test utf-4.6 {Tcl_NumUtfChars: length 1, calc len} {testnumutfchars testbytestri
     testnumutfchars [testbytestring "\xC2\xA2"] 1
 } {1}
 test utf-4.7 {Tcl_NumUtfChars: long string, calc len} {testnumutfchars testbytestring} {
-    testnumutfchars [testbytestring "abc\xC2\xA2\xe4\xb9\x8e\uA2\u4e4e"] 1
+    testnumutfchars [testbytestring "abc\xC2\xA2\xe4\xb9\x8e\uA2\u4e"] 1
 } {7}
 test utf-4.8 {Tcl_NumUtfChars: #u0000, calc len} {testnumutfchars testbytestring} {
     testnumutfchars [testbytestring "\xC0\x80"] 1
-- 
cgit v0.12