Tcl Extension Architecture (TEA) Sample Extension

 * Side effects:
 *	Contents of state pointer are changed.
 *
 *----------------------------------------------------------------------
 */

void
SHA1Transform(
    sha_uint32_t state[5],	/* State variable */
    unsigned char buffer[64])	/* Modified buffer */
{
#if (!defined(BIG_ENDIAN) && !defined(LITTLE_ENDIAN))
    unsigned char *p;
#endif
    sha_uint32_t a, b, c, d, e;
    typedef union {
	unsigned char c[64];

 *
 * Side effects:
 *	Contents of context pointer are changed.
 *
 *----------------------------------------------------------------------
 */

void SHA1Init(
    SHA1_CTX* context)		/* Context to initialize */
{
    /*
     * SHA1 initialization constants
     */

    context->state[0] = 0x67452301;
    context->state[1] = 0xEFCDAB89;

 * Side effects:
 *	Contents of context pointer are changed.
 *
 *----------------------------------------------------------------------
 */

void
SHA1Update(
    SHA1_CTX* context,		/* Context to update */
    unsigned char* data,	/* Data used for update */
    unsigned int len)		/* Length of data */
{
    unsigned int i, j;

    j = (context->count[0] >> 3) & 63;
    if ((context->count[0] += len << 3) < (len << 3)) {
	context->count[1]++;
    }

 *
 * Side effects:
 *	Contents of context pointer are changed.
 *
 *----------------------------------------------------------------------
 */

void SHA1Final(
    SHA1_CTX* context,		/* Context to pad */
    unsigned char digest[20])	/* Returned message digest */
{
    sha_uint32_t i, j;
    unsigned char finalcount[8];

    for (i = 0; i < 8; i++) {
	/*
	 * This statement is independent of the endianness

#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include "sample.h"

#define TCL_READ_CHUNK_SIZE 4096

static const unsigned char itoa64f[] =
        "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ_,";

static int numcontexts = 0;
static SHA1_CTX *sha1Contexts = NULL;
static int *ctxtotalRead = NULL;

static int Sha1_Cmd(ClientData clientData, Tcl_Interp *interp,

 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
Sha1_Cmd(
    ClientData dummy,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter */
    int objc,			/* Number of arguments */
    Tcl_Obj *const objv[]	/* Argument strings */
    )
{
    /*
     * The default base is hex

    char *bufPtr;
    int maxbytes = 0;
    int doinit = 1;
    int dofinal = 1;
    Tcl_Obj *descriptorObj = NULL;
    int totalRead = 0;
    int i, j, n, mask, bits, offset;
    (void)dummy;

    /*
     * For binary representation + null char
     */

    char buf[129];
    unsigned char digest[DIGESTSIZE];

		/*
		 * Allocate a new context.
		 */

		numcontexts++;
		sha1Contexts = (SHA1_CTX *) realloc((void *) sha1Contexts,
			numcontexts * sizeof(SHA1_CTX));
		ctxtotalRead = (int *)realloc(ctxtotalRead,
			numcontexts * sizeof(int));
	    }
	    ctxtotalRead[contextnum] = 0;
	    SHA1Init(&sha1Context);
	    sprintf(buf, "sha1%d", contextnum);
	    Tcl_AppendResult(interp, buf, NULL);
	    return TCL_OK;
	case SHAOPT_CHAN:
	    chan = Tcl_GetChannel(interp, Tcl_GetString(objv[a]), &mode);
	    if (chan == (Tcl_Channel) NULL) {
		return TCL_ERROR;
	    }
	    if ((mode & TCL_READABLE) == 0) {

	char *string;
	if (chan != (Tcl_Channel) NULL) {
	    goto wrongArgs;
	}
	string = Tcl_GetStringFromObj(stringObj, &totalRead);
	SHA1Update(&sha1Context, (unsigned char *) string, totalRead);
    } else if (chan != (Tcl_Channel) NULL) {
	bufPtr = (char *)ckalloc(TCL_READ_CHUNK_SIZE);
	totalRead = 0;
	while ((n = Tcl_Read(chan, bufPtr,
		maxbytes == 0
		? TCL_READ_CHUNK_SIZE
		: (TCL_READ_CHUNK_SIZE < maxbytes
		? TCL_READ_CHUNK_SIZE
		: maxbytes))) != 0) {

    	    offset += 8;
        }
        offset -= n;
        buf[j++] = itoa64f[(bits>>8)&mask];
    }
    buf[j++] = itoa64f[(bits>>8)&mask];
    buf[j++] = '\0';
    Tcl_AppendResult(interp, buf, NULL);
    if (contextnum > 0) {
	ctxtotalRead[contextnum] = -1;
    }
    return TCL_OK;

wrongArgs:
    Tcl_AppendResult(interp, "wrong # args: should be either:\n",
	    "  ",
	    Tcl_GetString(objv[0]),
	    " ?-log2base log2base? -string string\n",
	    " or\n",
	    "  ",
	    Tcl_GetString(objv[0]),
	    " ?-log2base log2base? ?-copychan chanID? -chan chanID\n",

 * Side effects:
 *	The Sample package is created.
 *	One new command "sha1" is added to the Tcl interpreter.
 *
 *----------------------------------------------------------------------
 */

#ifdef __cplusplus
extern "C" {
#endif  /* __cplusplus */
DLLEXPORT int
Sample_Init(Tcl_Interp *interp)
{
    /*
     * This may work with 8.0, but we are using strictly stubs here,
     * which requires 8.1.
     */
    if (Tcl_InitStubs(interp, "8.1", 0) == NULL) {

    numcontexts = 1;
    sha1Contexts = (SHA1_CTX *) malloc(sizeof(SHA1_CTX));
    ctxtotalRead = (int *) malloc(sizeof(int));
    ctxtotalRead[0] = 0;

    return TCL_OK;
}
#ifdef __cplusplus
}
#endif  /* __cplusplus */