/*
 * tclsample.c --
 *
 *	This file implements a Tcl interface to the secure hashing
 *	algorithm functions in sha1.c
 *
 * Copyright (c) 1999 Scriptics Corporation.
 * Copyright (c) 2003 ActiveState Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 */

/*
 * Modified from tclmd5.c by Dave Dykstra, dwd@bell-labs.com, 4/22/97
 */

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

#define TCL_READ_CHUNK_SIZE 4096

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

static int numcontexts = 0;
typedef struct {
	SHA1_CTX ctx;
	Tcl_Size totalRead;
} sha1CmdContext;
static sha1CmdContext *sha1CmdContexts = NULL;


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

#define DIGESTSIZE 20

/*
 *----------------------------------------------------------------------
 *
 * Sha1 --
 *
 *	 Implements the new Tcl "sha1" command.
 *
 * Results:
 *	A standard Tcl result
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

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

    int log2base = 4;
    int a;
    Tcl_Obj *stringObj = NULL;
    Tcl_Channel chan = NULL;
    Tcl_Channel copychan = NULL;
    int mode;
    int contextnum = 0;
#define sha1Context (sha1CmdContexts[contextnum].ctx)
    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
     */

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

    static const char *const options[] = {
	"-chan", "-copychan", "-final", "-init", "-log2base", "-maxbytes",
	"-string", "-update", NULL
    };
    enum ShaOpts {
	SHAOPT_CHAN, SHAOPT_COPY, SHAOPT_FINAL, SHAOPT_INIT, SHAOPT_LOG,
	SHAOPT_MAXB, SHAOPT_STRING, SHAOPT_UPDATE
    };

    for (a = 1; a < objc; a++) {
	int index;

	if (Tcl_GetIndexFromObjStruct(interp, objv[a], options, sizeof(char *),
		"option", 0, &index) != TCL_OK) {
	    return TCL_ERROR;
	}
	/*
	 * Everything except -init takes an argument...
	 */
	if ((index != SHAOPT_INIT) && (++a >= objc)) {
	    goto wrongArgs;
	}
	switch ((enum ShaOpts) index) {
	case SHAOPT_INIT:
	    for (contextnum = 1; contextnum < numcontexts; contextnum++) {
		if (sha1CmdContexts[contextnum].totalRead == -1) {
		    break;
		}
	    }
	    if (contextnum == numcontexts) {
		/*
		 * Allocate a new context.
		 */

		numcontexts++;
		sha1CmdContexts = (sha1CmdContext *)ckrealloc((void *)sha1CmdContexts,
			numcontexts * sizeof(sha1CmdContext));
	    }
	    sha1CmdContexts[contextnum].totalRead = 0;
	    SHA1Init(&sha1Context);
	    snprintf(buf, sizeof(buf), "sha1%d", contextnum);
	    Tcl_AppendResult(interp, buf, (char *)NULL);
	    return TCL_OK;
	case SHAOPT_CHAN:
	    chan = Tcl_GetChannel(interp, Tcl_GetString(objv[a]), &mode);
	    if (chan == NULL) {
		return TCL_ERROR;
	    }
	    if ((mode & TCL_READABLE) == 0) {
		Tcl_AppendResult(interp, "chan \"", Tcl_GetString(objv[a]),
			"\" wasn't opened for reading", (char *)NULL);
		return TCL_ERROR;
	    }
	    continue;
	case SHAOPT_COPY:
	    copychan = Tcl_GetChannel(interp, Tcl_GetString(objv[a]), &mode);
	    if (copychan == NULL) {
		return TCL_ERROR;
	    }
	    if ((mode & TCL_WRITABLE) == 0) {
		Tcl_AppendResult(interp, "copychan \"", Tcl_GetString(objv[a]),
			"\" wasn't opened for writing", (char *)NULL);
		return TCL_ERROR;
	    }
	    continue;
	case SHAOPT_FINAL:
	    descriptorObj = objv[a];
	    doinit = 0;
	    continue;
	case SHAOPT_LOG:
	    if (Tcl_GetIntFromObj(interp, objv[a], &log2base) != TCL_OK) {
		return TCL_ERROR;
	    } else if ((log2base < 1) || (log2base > 6)) {
		Tcl_AppendResult(interp, "parameter to -log2base \"",
			Tcl_GetString(objv[a]),
			"\" must be integer in range 1...6", (char *)NULL);
		return TCL_ERROR;
	    }
	    continue;
	case SHAOPT_MAXB:
	    if (Tcl_GetWideIntFromObj(interp, objv[a], &maxbytes) != TCL_OK) {
		return TCL_ERROR;
	    }
	    continue;
	case SHAOPT_STRING:
	    stringObj = objv[a];
	    continue;
	case SHAOPT_UPDATE:
	    descriptorObj = objv[a];
	    doinit = 0;
	    dofinal = 0;
	    continue;
	}
    }

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

    if (doinit) {
	SHA1Init(&sha1Context);
    }

    if (stringObj != NULL) {
	char *string;
	if (chan != NULL) {
	    goto wrongArgs;
	}
	string = Tcl_GetStringFromObj(stringObj, &totalRead);
	SHA1Update(&sha1Context, (unsigned char *) string, totalRead);
    } else if (chan != 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) {
	    if (n == -1) {
		ckfree(bufPtr);
		Tcl_AppendResult(interp, Tcl_GetString(objv[0]), ": ",
			Tcl_GetChannelName(chan), Tcl_PosixError(interp),
			(char *)NULL);
		return TCL_ERROR;
	    }

	    totalRead += n;

	    SHA1Update(&sha1Context, (unsigned char *)bufPtr, n);

	    if (copychan != NULL) {
		n = Tcl_Write(copychan, bufPtr, n);
		if (n == -1) {
		    ckfree(bufPtr);
		    Tcl_AppendResult(interp, Tcl_GetString(objv[0]), ": ",
			    Tcl_GetChannelName(copychan),
			     Tcl_PosixError(interp), (char *)NULL);
		    return TCL_ERROR;
		}
	    }

	    if ((maxbytes > 0) && (maxbytes <= n)) {
		break;
	    }
	    maxbytes -= n;
	}
	ckfree(bufPtr);
    } else if (descriptorObj == NULL) {
	goto wrongArgs;
    }

    if (!dofinal) {
	sha1CmdContexts[contextnum].totalRead += totalRead;
	Tcl_SetObjResult(interp, Tcl_NewWideIntObj(totalRead));
	return TCL_OK;
    }

    if (stringObj == NULL) {
	totalRead += sha1CmdContexts[contextnum].totalRead;
	Tcl_SetObjResult(interp, Tcl_NewWideIntObj(totalRead));
    }

    SHA1Final(&sha1Context, digest);

    /*
     * Take the 20 byte array and print it in the requested base
     * e.g. log2base=1 => binary,  log2base=4 => hex
     */

    n = log2base;
    i = j = bits = 0;

    /*
     * if 160 bits doesn't divide exactly by n then the first character of
     *  the output represents the residual bits.  e.g for n=6 (base 64) the
     *  first character can only take the values 0..f
     */

    offset = (DIGESTSIZE * 8) % n;
    if (offset > 0) {
	offset = n - offset;
    }
    mask = (2 << (n-1)) - 1;
    while (1) {
	bits <<= n;
	if (offset <= n) {
	    if (i == DIGESTSIZE) {
		break;
	    }
	    bits += (digest[i++] << (n - offset));
	    offset += 8;
	}
	offset -= n;
	buf[j++] = itoa64f[(bits>>8)&mask];
    }
    buf[j++] = itoa64f[(bits>>8)&mask];
    buf[j++] = '\0';
    Tcl_AppendResult(interp, buf, (char *)NULL);
    if (contextnum > 0) {
	sha1CmdContexts[contextnum].totalRead = -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",
	    " or\n",
	    "  ",
	    Tcl_GetString(objv[0]),
	    " -init (returns descriptor)\n",
	    "  ",
	    Tcl_GetString(objv[0]),
	    " -update descriptor ?-maxbytes n? ?-copychan chanID? -chan chanID\n",
	    "    (any number of -update calls, returns number of bytes read)\n",
	    "  ",
	    Tcl_GetString(objv[0]),
	    " ?-log2base log2base? -final descriptor\n",
	    " The default log2base is 4 (hex)",
	    (char *)NULL);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * Sample_Init --
 *
 *	Initialize the new package.  The string "Sample" in the
 *	function name must match the PACKAGE declaration at the top of
 *	configure.ac.
 *
 * Results:
 *	A standard Tcl result
 *
 * Side effects:
 *	The Sample package is created.
 *	One new command "sha1" is added to the Tcl interpreter.
 *
 *----------------------------------------------------------------------
 */

#ifndef STRINGIFY
#  define STRINGIFY(x) STRINGIFY1(x)
#  define STRINGIFY1(x) #x
#endif

#ifdef __cplusplus
extern "C" {
#endif  /* __cplusplus */
DLLEXPORT int
Sample_Init(
    Tcl_Interp* interp)		/* Tcl interpreter */
{
    Tcl_CmdInfo info;

    /*
     * Support any TCL version from 8.5.0 to 9.x.x.
     * The upper bound "10" is exclusive
     */
    if (Tcl_InitStubs(interp, "8.5-10", 0) == NULL) {
	return TCL_ERROR;
    }

    if (Tcl_GetCommandInfo(interp, "::tcl::build-info", &info)) {
	Tcl_CreateObjCommand(interp, "::sample::build-info",
		info.objProc, (void *)(
		    PACKAGE_VERSION "+" STRINGIFY(SAMPLE_VERSION_UUID)
#if defined(__clang__) && defined(__clang_major__)
			    ".clang-" STRINGIFY(__clang_major__)
#if __clang_minor__ < 10
			    "0"
#endif
			    STRINGIFY(__clang_minor__)
#endif
#if defined(__cplusplus) && !defined(__OBJC__)
			    ".cplusplus"
#endif
#ifndef NDEBUG
			    ".debug"
#endif
#if !defined(__clang__) && !defined(__INTEL_COMPILER) && defined(__GNUC__)
			    ".gcc-" STRINGIFY(__GNUC__)
#if __GNUC_MINOR__ < 10
			    "0"
#endif
			    STRINGIFY(__GNUC_MINOR__)
#endif
#ifdef __INTEL_COMPILER
			    ".icc-" STRINGIFY(__INTEL_COMPILER)
#endif
#ifdef TCL_MEM_DEBUG
			    ".memdebug"
#endif
#if defined(_MSC_VER)
			    ".msvc-" STRINGIFY(_MSC_VER)
#endif
#ifdef USE_NMAKE
			    ".nmake"
#endif
#ifndef TCL_CFG_OPTIMIZED
			    ".no-optimize"
#endif
#ifdef __OBJC__
			    ".objective-c"
#if defined(__cplusplus)
			    "plusplus"
#endif
#endif
#ifdef TCL_CFG_PROFILED
			    ".profile"
#endif
#ifdef PURIFY
			    ".purify"
#endif
#ifdef STATIC_BUILD
			    ".static"
#endif
		), NULL);
    }

    /* Provide the current package */

    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;
    sha1CmdContexts = (sha1CmdContext *)ckalloc(sizeof(sha1CmdContext));
    sha1CmdContexts[0].totalRead = 0;

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