Skip to content

Commit

Permalink
Ticket [ecf13be4c9] Multi interpreter solution
Browse files Browse the repository at this point in the history
  • Loading branch information
@oehhar
oehhar committed Dec 11, 2024
1 parent 7d6679b commit 54cf9e5
Showing 1 changed file with 112 additions and 34 deletions.
146 changes: 112 additions & 34 deletions generic/tclsample.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -28,14 +28,23 @@
static const unsigned char itoa64f[] =
"0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ_,";

static int numcontexts = 0;
static SHA1_CTX *sha1Contexts = NULL;
static Tcl_Size *ctxtotalRead = NULL;
#define DIGESTSIZE 20

/*
* The procedure needs interpreter local state. This is called
* "Command client data" in TCL. Typically, a struct is allocated and
* the pointer to it is made available on each operation by TCL.
* Here is the struct for the sha1 procedure.
*/

struct Sha1ClientData {
int numcontexts;
SHA1_CTX *sha1Contexts;
Tcl_Size *ctxtotalRead;
};

static int Sha1_Cmd(void *clientData, Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);

#define DIGESTSIZE 20

/*
*----------------------------------------------------------------------
Expand All @@ -55,12 +64,18 @@ static int Sha1_Cmd(void *clientData, Tcl_Interp *interp,

static int
Sha1_Cmd(
void *dummy, /* Not used. */
ClientData clientData, /* Client data with thread local state */
Tcl_Interp *interp, /* Current interpreter */
int objc, /* Number of arguments */
Tcl_Obj *const objv[] /* Argument strings */
)
{
/*
* Get my thread local memory
*/

struct Sha1ClientData *sha1ClientDataPtr = clientData;

/*
* The default base is hex
*/
Expand All @@ -72,15 +87,13 @@ Sha1_Cmd(
Tcl_Channel copychan = NULL;
int mode;
int contextnum = 0;
#define sha1Context (sha1Contexts[contextnum])
char *bufPtr;
Tcl_WideInt maxbytes = 0;
int doinit = 1;
int dofinal = 1;
Tcl_Obj *descriptorObj = NULL;
Tcl_Size totalRead = 0, n;
int i, j, mask, bits, offset;
(void)dummy;

/*
* For binary representation + null char
Expand Down Expand Up @@ -113,24 +126,26 @@ Sha1_Cmd(
}
switch ((enum ShaOpts) index) {
case SHAOPT_INIT:
for (contextnum = 1; contextnum < numcontexts; contextnum++) {
if (ctxtotalRead[contextnum] == -1) {
for (contextnum = 1; contextnum < sha1ClientDataPtr->numcontexts; contextnum++) {
if (sha1ClientDataPtr->ctxtotalRead[contextnum] == -1) {
break;
}
}
if (contextnum == numcontexts) {
if (contextnum == sha1ClientDataPtr->numcontexts) {
/*
* Allocate a new context.
*/

numcontexts++;
sha1Contexts = (SHA1_CTX *) ckrealloc((void *) sha1Contexts,
numcontexts * sizeof(SHA1_CTX));
ctxtotalRead = (Tcl_Size *)ckrealloc(ctxtotalRead,
numcontexts * sizeof(Tcl_Size));
sha1ClientDataPtr->numcontexts++;
sha1ClientDataPtr->sha1Contexts = (SHA1_CTX *) ckrealloc(
(void *) sha1ClientDataPtr->sha1Contexts,
sha1ClientDataPtr->numcontexts * sizeof(SHA1_CTX));
sha1ClientDataPtr->ctxtotalRead = (Tcl_Size *)ckrealloc(
sha1ClientDataPtr->ctxtotalRead,
sha1ClientDataPtr->numcontexts * sizeof(Tcl_Size));
}
ctxtotalRead[contextnum] = 0;
SHA1Init(&sha1Context);
sha1ClientDataPtr->ctxtotalRead[contextnum] = 0;
SHA1Init(&sha1ClientDataPtr->sha1Contexts[contextnum]);
snprintf(buf, sizeof(buf), "sha1%d", contextnum);
Tcl_AppendResult(interp, buf, NULL);
return TCL_OK;
Expand Down Expand Up @@ -188,16 +203,16 @@ Sha1_Cmd(

if (descriptorObj != NULL) {
if ((sscanf(Tcl_GetString(descriptorObj), "sha1%d",
&contextnum) != 1) || (contextnum >= numcontexts) ||
(ctxtotalRead[contextnum] == -1)) {
&contextnum) != 1) || (contextnum >= sha1ClientDataPtr->numcontexts) ||
(sha1ClientDataPtr->ctxtotalRead[contextnum] == -1)) {
Tcl_AppendResult(interp, "invalid sha1 descriptor \"",
Tcl_GetString(descriptorObj), "\"", NULL);
return TCL_ERROR;
}
}

if (doinit) {
SHA1Init(&sha1Context);
SHA1Init(&sha1ClientDataPtr->sha1Contexts[contextnum]);
}

if (stringObj != NULL) {
Expand All @@ -206,10 +221,17 @@ Sha1_Cmd(
goto wrongArgs;
}
string = Tcl_GetStringFromObj(stringObj, &totalRead);
SHA1Update(&sha1Context, (unsigned char *) string, totalRead);
SHA1Update(&sha1ClientDataPtr->sha1Contexts[contextnum],
(unsigned char *) string, totalRead);
} else if (chan != NULL) {
bufPtr = (char *)ckalloc(TCL_READ_CHUNK_SIZE);
totalRead = 0;
/*
* FIXME: MS-VC 2015 gives the following warning in the next line I
* was not able to fix (translated from German):
* warning C4244: "Function": Conversion of "Tcl_WideInt" to "int",
* possible data loss
*/
while ((n = Tcl_Read(chan, bufPtr,
maxbytes == 0
? TCL_READ_CHUNK_SIZE
Expand All @@ -226,7 +248,8 @@ Sha1_Cmd(

totalRead += n;

SHA1Update(&sha1Context, (unsigned char *) bufPtr, n);
SHA1Update(&sha1ClientDataPtr->sha1Contexts[contextnum],
(unsigned char *) bufPtr, n);

if (copychan != NULL) {
n = Tcl_Write(copychan, bufPtr, n);
Expand All @@ -250,17 +273,17 @@ Sha1_Cmd(
}

if (!dofinal) {
ctxtotalRead[contextnum] += totalRead;
sha1ClientDataPtr->ctxtotalRead[contextnum] += totalRead;
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(totalRead));
return TCL_OK;
}

if (stringObj == NULL) {
totalRead += ctxtotalRead[contextnum];
totalRead += sha1ClientDataPtr->ctxtotalRead[contextnum];
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(totalRead));
}

SHA1Final(&sha1Context, digest);
SHA1Final(&sha1ClientDataPtr->sha1Contexts[contextnum], digest);

/*
* Take the 20 byte array and print it in the requested base
Expand Down Expand Up @@ -297,7 +320,7 @@ Sha1_Cmd(
buf[j++] = '\0';
Tcl_AppendResult(interp, buf, NULL);
if (contextnum > 0) {
ctxtotalRead[contextnum] = -1;
sha1ClientDataPtr->ctxtotalRead[contextnum] = -1;
}
return TCL_OK;

Expand Down Expand Up @@ -325,6 +348,42 @@ Sha1_Cmd(
NULL);
return TCL_ERROR;
}


/*
*----------------------------------------------------------------------
*
* Sha1_CmdDeleteProc --
*
* Clear all thread data of the Sha1 command.
*
* Results:
* No result
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/

static void
Sha1_CmdDeleteProc(ClientData clientData)
{
struct Sha1ClientData *sha1ClientDataPtr = clientData;

/*
* Release the sha1 contextes
*/

ckfree(sha1ClientDataPtr->sha1Contexts);
ckfree(sha1ClientDataPtr->ctxtotalRead);

/*
* Release the procedure client data
*/

ckfree(sha1ClientDataPtr);
}

/*
*----------------------------------------------------------------------
Expand Down Expand Up @@ -358,6 +417,7 @@ Sample_Init(
Tcl_Interp* interp) /* Tcl interpreter */
{
Tcl_CmdInfo info;
struct Sha1ClientData *sha1ClientDataPtr;

/*
* Require compatible TCL version.
Expand All @@ -368,10 +428,35 @@ Sample_Init(
* Note that Tcl_InitStubs is a macro, which is replaced by a Tcl version
* check only, if TCL_STUBS is not defined (e.g. direct link, static build)
*/

if (Tcl_InitStubs(interp, "8.1-", 0) == NULL) {
return TCL_ERROR;
}

/*
* Init the sha1 context queues
*/

sha1ClientDataPtr = ckalloc(sizeof(struct Sha1ClientData));
sha1ClientDataPtr->numcontexts = 1;
sha1ClientDataPtr->sha1Contexts = (SHA1_CTX *) ckalloc(sizeof(SHA1_CTX));
sha1ClientDataPtr->ctxtotalRead = (Tcl_Size *) ckalloc(sizeof(Tcl_Size));

/*
* Create the sha1 command.
* Pass the client data pointer to the procedure, so the queue data is
* available.
* Also, register a delete proc to clear the sha1 queue on deletion.
*/

Tcl_CreateObjCommand(
interp, "sha1", (Tcl_ObjCmdProc *)Sha1_Cmd,
sha1ClientDataPtr, Sha1_CmdDeleteProc);

/*
* Create the buildinfo command if tcl supports it
*/

if (Tcl_GetCommandInfo(interp, "::tcl::build-info", &info)) {
Tcl_CreateObjCommand(interp, "::sample::build-info",
info.objProc, (void *)(
Expand Down Expand Up @@ -434,13 +519,6 @@ Sample_Init(
if (Tcl_PkgProvideEx(interp, PACKAGE_NAME, PACKAGE_VERSION, NULL) != TCL_OK) {
return TCL_ERROR;
}
Tcl_CreateObjCommand(interp, "sha1", (Tcl_ObjCmdProc *)Sha1_Cmd,
NULL, NULL);

numcontexts = 1;
sha1Contexts = (SHA1_CTX *) ckalloc(sizeof(SHA1_CTX));
ctxtotalRead = (Tcl_Size *) ckalloc(sizeof(Tcl_Size));
ctxtotalRead[0] = 0;

return TCL_OK;
}
Expand Down

0 comments on commit 54cf9e5

Please sign in to comment.