From 501b0809b4cee90c2f4fd68c9ca709c14613c895 Mon Sep 17 00:00:00 2001
From: Jessica Clarke <jrtc27@jrtc27.com>
Date: Fri, 12 Aug 2022 22:24:39 +0100
Subject: [PATCH 5/8] testcmdtoken: Don't rely on round-tripping pointers
 through strings

This is needed to support CHERI, and thus Arm's experimental Morello
prototype, where pointers are implemented using unforgeable capabilities
that include bounds and permissions metadata to provide fine-grained
spatial and referential memory safety, as well as revocation by sweeping
memory to provide heap temporal memory safety.

Whilst a capability can be printed and scanf can read that back in, the
unforgeable nature of capabilities means its tag bit (which marks the
capability as valid/not forged) will be clear and thus it will trap on
dereference (in fact, printf will only print the address and thus all
the metadata will be stripped, but that's not important here as the
unforgeability is the important part).

Since this test doesn't really need the pointer to be in the string,
just some identifier that can be used to get back to the Tcl_Command,
rewrite this to build up a list of these pointers, each with a unique
integer that we use as the handle passed to and from the Tcl world
instead. This is inspired by the list that testasync builds up in
adjacent code. It also happens to remove an assumption that a
Tcl_Command can be cast to and from a pointer.
---
 generic/tclTest.c | 47 ++++++++++++++++++++++++++++++++++++++++-------
 1 file changed, 40 insertions(+), 7 deletions(-)

diff --git a/generic/tclTest.c b/generic/tclTest.c
index ac0c2102d..2142519ea 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -54,6 +54,21 @@ DLLEXPORT int		Tcltest_SafeInit(Tcl_Interp *interp);
 static Tcl_DString delString;
 static Tcl_Interp *delInterp;
 
+/*
+ * One of the following structures exists for each command created by the
+ * "testcmdtoken" command.
+ */
+
+typedef struct TestCommandTokenRef {
+    int id;			/* Identifier for this reference. */
+    Tcl_Command token;		/* Tcl's token for the command. */
+    struct TestCommandTokenRef *nextPtr;
+				/* Next in list of references. */
+} TestCommandTokenRef;
+
+static TestCommandTokenRef *firstCommandTokenRef = NULL;
+static int nextCommandTokenRefId = 1;
+
 /*
  * One of the following structures exists for each asynchronous handler
  * created by the "testasync" command".
@@ -1191,9 +1206,9 @@ TestcmdtokenCmd(
     int argc,			/* Number of arguments. */
     const char **argv)		/* Argument strings. */
 {
-    Tcl_Command token;
-    int *l;
+    TestCommandTokenRef *refPtr;
     char buf[30];
+    int id;
 
     if (argc != 3) {
 	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
@@ -1201,24 +1216,42 @@ TestcmdtokenCmd(
 	return TCL_ERROR;
     }
     if (strcmp(argv[1], "create") == 0) {
-	token = Tcl_CreateCommand(interp, argv[2], CmdProc1,
+	refPtr = (TestCommandTokenRef *)Tcl_Alloc(sizeof(TestCommandTokenRef));
+	refPtr->token = Tcl_CreateCommand(interp, argv[2], CmdProc1,
 		(void *) "original", NULL);
-	sprintf(buf, "%p", (void *)token);
+	refPtr->id = nextCommandTokenRefId;
+	nextCommandTokenRefId++;
+	refPtr->nextPtr = firstCommandTokenRef;
+	firstCommandTokenRef = refPtr;
+	sprintf(buf, "%d", refPtr->id);
 	Tcl_AppendResult(interp, buf, NULL);
     } else if (strcmp(argv[1], "name") == 0) {
 	Tcl_Obj *objPtr;
 
-	if (sscanf(argv[2], "%p", &l) != 1) {
+	if (sscanf(argv[2], "%d", &id) != 1) {
+	    Tcl_AppendResult(interp, "bad command token \"", argv[2],
+		    "\"", NULL);
+	    return TCL_ERROR;
+	}
+
+	for (refPtr = firstCommandTokenRef; refPtr != NULL;
+		refPtr = refPtr->nextPtr) {
+	    if (refPtr->id == id) {
+		break;
+	    }
+	}
+
+	if (refPtr == NULL) {
 	    Tcl_AppendResult(interp, "bad command token \"", argv[2],
 		    "\"", NULL);
 	    return TCL_ERROR;
 	}
 
 	objPtr = Tcl_NewObj();
-	Tcl_GetCommandFullName(interp, (Tcl_Command) l, objPtr);
+	Tcl_GetCommandFullName(interp, refPtr->token, objPtr);
 
 	Tcl_AppendElement(interp,
-		Tcl_GetCommandName(interp, (Tcl_Command) l));
+		Tcl_GetCommandName(interp, refPtr->token));
 	Tcl_AppendElement(interp, Tcl_GetString(objPtr));
 	Tcl_DecrRefCount(objPtr);
     } else {
-- 
2.34.GIT

