# stub library C source files to compile in TEA_ADD_STUB_SOURCES,
# and runtime Tcl library files in TEA_ADD_TCL_SOURCES.
# This defines PKG(_STUB)_SOURCES, PKG(_STUB)_OBJECTS, PKG_HEADERS
# and PKG_TCL_SOURCES.
#-----------------------------------------------------------------------


    vars="tls.c tlsBIO.c tlsDigest.c tlsEncrypt.c tlsInfo.c tlsIO.c tlsKDF.c tlsUtil.c tlsX509.c"
    for i in $vars; do
	case $i in
	    \$*)
		# allow $-var names
		PKG_SOURCES="$PKG_SOURCES $i"
		PKG_OBJECTS="$PKG_OBJECTS $i"
		;;

# public headers that need to be installed in TEA_ADD_HEADERS,
# stub library C source files to compile in TEA_ADD_STUB_SOURCES,
# and runtime Tcl library files in TEA_ADD_TCL_SOURCES.
# This defines PKG(_STUB)_SOURCES, PKG(_STUB)_OBJECTS, PKG_HEADERS
# and PKG_TCL_SOURCES.
#-----------------------------------------------------------------------

TEA_ADD_SOURCES([tls.c tlsBIO.c tlsDigest.c tlsEncrypt.c tlsInfo.c tlsIO.c tlsKDF.c tlsUtil.c tlsX509.c])
TEA_ADD_HEADERS([generic/tls.h])
TEA_ADD_INCLUDES([])
TEA_ADD_LIBS([])
TEA_ADD_CFLAGS([])
TEA_ADD_STUB_SOURCES([])
TEA_ADD_TCL_SOURCES([library/tls.tcl])

 * Side effects:
 *	No result or error message
 *
 *-------------------------------------------------------------------
 */
int DigestInitialize(Tcl_Interp *interp, DigestState *statePtr, Tcl_Obj *digestObj,
	Tcl_Obj *cipherObj, Tcl_Obj *keyObj, Tcl_Obj *macObj) {
    int res = 0, type = statePtr->format & 0xFF0;

    const EVP_MD *md = NULL;
    const EVP_CIPHER *cipher = NULL;
    const void *key = NULL, *iv = NULL, *salt = NULL;
    int key_len = 0;

    dprintf("Called");

    /* Get digest */
    md = Util_GetDigest(interp, digestObj, type != TYPE_CMAC);
    if (md == NULL && type != TYPE_CMAC) {
	return TCL_ERROR;
    }

    /* Get cipher */
    cipher = Util_GetCipher(interp, cipherObj, type == TYPE_CMAC);
    if (cipher == NULL && type == TYPE_CMAC) {
	return TCL_ERROR;
    }

    /* Get key */
    key = (const void *) Util_GetKey(interp, keyObj, &key_len, "key", 0, type != TYPE_MD);
    if (key == NULL && type != TYPE_MD) {
	return TCL_ERROR;
    }

    /* Create contexts */
    switch(type) {
    case TYPE_MD:
	statePtr->ctx = EVP_MD_CTX_new();
	res = (statePtr->ctx != NULL);
	break;

    }

    if (!res) {
	Tcl_AppendResult(interp, "Create context failed", NULL);
	return TCL_ERROR;
    }





















































    /* Initialize cryptography function */
    switch(type) {
    case TYPE_MD:
	res = EVP_DigestInit_ex(statePtr->ctx, md, NULL);
	break;
    case TYPE_HMAC:
	res = HMAC_Init_ex(statePtr->hctx, key, key_len, md, NULL);
	break;
    case TYPE_CMAC:
	res = CMAC_Init(statePtr->cctx, key, key_len, cipher, NULL);
	break;
    }

    if (!res) {
	Tcl_AppendResult(interp, "Initialize failed: ", REASON(), NULL);
	return TCL_ERROR;
    }

	if (macObj != NULL) {
	    char *macName = Tcl_GetStringFromObj(macObj, NULL);
	    if (strcmp(macName,"cmac") == 0) {
		type = TYPE_CMAC;
	    } else if (strcmp(macName,"hmac") == 0) {
		type = TYPE_HMAC;
	    } else {
		Tcl_AppendResult(interp, "invalid MAC \"", macName, "\"", NULL);
		return TCL_ERROR;
	    }
	} else {
	    Tcl_AppendResult(interp, "no MAC", NULL);
	    return TCL_ERROR;
	}
    }

    /* Calc digest on file, stacked channel, using instance command, or data blob */
    if (fileObj != NULL) {
	res = DigestFileHandler(interp, fileObj, digestObj, cipherObj, format | type, keyObj, macObj);
    } else if (channel != NULL) {
	res = DigestChannelHandler(interp, channel, digestObj, cipherObj, format | type, keyObj, macObj);
    } else if (cmdObj != NULL) {
	res = DigestCommandHandler(interp, cmdObj, digestObj, cipherObj, format | type, keyObj, macObj);
    } else if (dataObj != NULL) {
	res = DigestDataHandler(interp, dataObj, digestObj, cipherObj, format | type, keyObj, macObj);
    } else {
	Tcl_AppendResult(interp, "No operation: Use -channel, -command, -data, or -file option", NULL);
	res = TCL_ERROR;
    }
    return res;
}

/*
 *-------------------------------------------------------------------

 *	No result or error message
 *
 *-------------------------------------------------------------------
 */
int EncryptInitialize(Tcl_Interp *interp, int type, EVP_CIPHER_CTX **ctx,
	Tcl_Obj *cipherObj, Tcl_Obj *keyObj, Tcl_Obj *ivObj) {
    const EVP_CIPHER *cipher;
    char *keyString = NULL, *ivString = NULL;
    int cipher_len = 0, key_len = 0, iv_len = 0, res, max;
    unsigned char key[EVP_MAX_KEY_LENGTH], iv[EVP_MAX_IV_LENGTH];

    dprintf("Called");

    /* Init buffers */
    memset(key, 0, EVP_MAX_KEY_LENGTH);
    memset(iv, 0, EVP_MAX_IV_LENGTH);












    /* Get cipher */

    cipher = Util_GetCipher(interp, cipherObj, 1);



    if (cipher == NULL) {

	return TCL_ERROR;
    }

    /*  Get key - Only support internally defined cipher lengths.
	Custom ciphers can be up to size_t bytes. */

    max = EVP_CIPHER_key_length(cipher);

    keyString = (const void *) Util_GetKey(interp, keyObj, &key_len, "key", max, FALSE);


    if (keyString != NULL) {
	memcpy((void *) key, (const void *) keyString, (size_t) key_len);
    } else if (keyObj != NULL)  {

	return TCL_ERROR;
    }

    /*  Get IV */


    max = EVP_CIPHER_iv_length(cipher);




    ivString = (const void *) Util_GetIV(interp, ivObj, &iv_len, max, FALSE);
    if (ivString != NULL) {
	memcpy((void *) iv, (const void *) ivString, (size_t) iv_len);
    } else if (ivObj != NULL) {

	return TCL_ERROR;
    }


    /* Create context */
    if((*ctx = EVP_CIPHER_CTX_new()) == NULL) {
	Tcl_AppendResult(interp, "Memory allocation error", (char *) NULL);
	return TCL_ERROR;
    }

    /* Initialize the operation. Need appropriate key and iv size. */

    if (type == TYPE_ENCRYPT) {
	res = EVP_EncryptInit_ex(*ctx, cipher, NULL, key, iv);
    } else {
	res = EVP_DecryptInit_ex(*ctx, cipher, NULL, key, iv);
    }
















    if(!res) {
	Tcl_AppendResult(interp, "Initialize failed: ", REASON(), NULL);
	return TCL_ERROR;
    }

    /* Erase buffers */
    memset(key, 0, EVP_MAX_KEY_LENGTH);
    memset(iv, 0, EVP_MAX_IV_LENGTH);
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------
 *
 * EncryptUpdate --

int             Tls_WaitForConnect(State *statePtr, int *errorCodePtr, int handshakeFailureIsPermanent);
int             Tls_DigestCommands(Tcl_Interp *interp);
int             Tls_EncryptCommands(Tcl_Interp *interp);
int             Tls_InfoCommands(Tcl_Interp *interp);
int             Tls_KeyCommands(Tcl_Interp *interp);

BIO             *BIO_new_tcl(State* statePtr, int flags);

EVP_CIPHER	*Util_GetCipher(Tcl_Interp *interp, Tcl_Obj *cipherObj, int no_null);
EVP_MD		*Util_GetDigest(Tcl_Interp *interp, Tcl_Obj *digestObj, int no_null);
unsigned char	*Util_GetIV(Tcl_Interp *interp, Tcl_Obj *ivObj, int *len, int max, int no_null);
unsigned char	*Util_GetKey(Tcl_Interp *interp, Tcl_Obj *keyObj, int *len, char *name, int max, int no_null);
unsigned char	*Util_GetSalt(Tcl_Interp *interp, Tcl_Obj *saltObj, int *len, int max, int no_null);
int		Util_GetInt(Tcl_Interp *interp, Tcl_Obj *dataObj, int *value, char *name, int min, int max);
#if OPENSSL_VERSION_NUMBER >= 0x30000000L
EVP_MAC		*Util_GetMAC(Tcl_Interp *interp, Tcl_Obj *MacObj, int no_null);
#endif

#define PTR2INT(x) ((int) ((intptr_t) (x)))

#endif /* _TLSINT_H */

/*
 * Key Derivation Function (KDF) Module
 *
 * Provides commands to derive keys.
 *
 * Copyright (C) 2023 Brian O'Hagan
 *
 */

#include "tlsInt.h"
#include "tclOpts.h"
#include <openssl/evp.h>
#include <openssl/kdf.h>

/*******************************************************************/

/* Options for KDF commands */

static const char *command_opts [] = {
    "-cipher", "-digest", "-hash", "-info", "-iterations", "-key", "-length", "-password",
    "-salt", "-size", "-N", "-n", "-r", "-p", NULL};

enum _command_opts {
    _opt_cipher, _opt_digest, _opt_hash, _opt_info, _opt_iter, _opt_key, _opt_length,
    _opt_password, _opt_salt, _opt_size, _opt_N, _opt_n, _opt_r, _opt_p
};

/*
 *-------------------------------------------------------------------
 *
 * KDF_PBKDF2 --
 *
 *	PKCS5_PBKDF2_HMAC key derivation function (KDF) specified by PKCS #5.
 *	KDFs include PBKDF2 from RFC 2898/8018 and Scrypt from RFC 7914.
 *
 * Returns:
 *	TCL_OK or TCL_ERROR
 *
 * Side effects:
 *	Sets result to a list of key and iv values, or an error message
 *
 *-------------------------------------------------------------------
 */
static int KDF_PBKDF2(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    int pass_len = 0, salt_len = 0, fn;
    int iklen, ivlen, iter = 1;
    unsigned char *pass = NULL, *salt = NULL;
    const EVP_MD *md = NULL;
    const EVP_CIPHER *cipher = NULL;
    int buf_len = (EVP_MAX_KEY_LENGTH + EVP_MAX_IV_LENGTH)*4, dk_len = buf_len;
    unsigned char tmpkeyiv[(EVP_MAX_KEY_LENGTH + EVP_MAX_IV_LENGTH)*4];

    dprintf("Called");

    /* Clear errors */
    Tcl_ResetResult(interp);
    ERR_clear_error();

    /* Validate arg count */
    if (objc < 3 || objc > 11) {
	Tcl_WrongNumArgs(interp, 1, objv, "[-cipher cipher | -size length] -digest digest ?-iterations count? ?-password string? ?-salt string?");
	return TCL_ERROR;
    }

    /* Init buffers */
    memset(tmpkeyiv, 0, buf_len);

    /* Get options */
    for (int idx = 1; idx < objc; idx++) {
	/* Get option */
	if (Tcl_GetIndexFromObj(interp, objv[idx], command_opts, "option", 0, &fn) != TCL_OK) {
	    return TCL_ERROR;
	}

	/* Validate arg has a value */
	if (++idx >= objc) {
	    Tcl_AppendResult(interp, "No value for option \"", command_opts[fn], "\"", NULL);
	    return TCL_ERROR;
	}

	switch(fn) {
	case _opt_cipher:
	    if ((cipher = Util_GetCipher(interp, objv[idx], TRUE)) == NULL) {
		return TCL_ERROR;
	    }
	    break;
	case _opt_digest:
	case _opt_hash:
	    if ((md = Util_GetDigest(interp, objv[idx], TRUE)) == NULL) {
		return TCL_ERROR;
	    }
	    break;
	case _opt_iter:
	    if (Util_GetInt(interp, objv[idx], &iter, "iterations", 1, -1) != TCL_OK) {
		return TCL_ERROR;
	    }
	    break;
	case _opt_key:
	case _opt_password:
	    pass = Util_GetKey(interp, objv[idx], &pass_len, command_opts[fn], 0, FALSE);
	    break;
	case _opt_salt:
	    GET_OPT_BYTE_ARRAY(objv[idx], salt, &salt_len);
	    break;
	case _opt_length:
	case _opt_size:
	    if (Util_GetInt(interp, objv[idx], &dk_len, command_opts[fn], 1, buf_len) != TCL_OK) {
		return TCL_ERROR;
	    }
	    break;
	}
    }

    /* Validate options */
    if (md == NULL) {
	Tcl_AppendResult(interp, "no digest", NULL);
	return TCL_ERROR;
    }

    /* Set output type sizes */
    if (cipher == NULL) {
	if (dk_len > buf_len) dk_len = buf_len;
	iklen = dk_len;
	ivlen = 0;
    } else {
	iklen = EVP_CIPHER_key_length(cipher);
	ivlen = EVP_CIPHER_iv_length(cipher);
	dk_len = iklen+ivlen;
    }

    /* Derive key */
    if (!PKCS5_PBKDF2_HMAC(pass, pass_len, salt, salt_len, iter, md, dk_len, tmpkeyiv)) {
	Tcl_AppendResult(interp, "Key derivation failed: ", REASON(), NULL);
	return TCL_ERROR;
    }

   /* Set result to key and iv */
    if (cipher == NULL) {
	Tcl_SetObjResult(interp, Tcl_NewByteArrayObj(tmpkeyiv, dk_len));
    } else {
	Tcl_Obj *resultObj = Tcl_NewListObj(0, NULL);
	LAPPEND_BARRAY(interp, resultObj, "key", tmpkeyiv, iklen);
	LAPPEND_BARRAY(interp, resultObj, "iv", tmpkeyiv+iklen, ivlen);
	Tcl_SetObjResult(interp, resultObj);
    }

    /* Clear data */
    memset(tmpkeyiv, 0, buf_len);
    return TCL_OK;
	clientData = clientData;
}

/*
 *-------------------------------------------------------------------
 *
 * KDF_HKDF --
 *
 *	HMAC-based Extract-and-Expand Key Derivation Function (HKDF).
 *	See RFC 5869.
 *
 * Returns:
 *	TCL_OK or TCL_ERROR
 *
 * Side effects:
 *	Sets result to a key of specified length, or an error message
 *
 *-------------------------------------------------------------------
 */
static int KDF_HKDF(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    EVP_PKEY_CTX *pctx = NULL;
    const EVP_MD *md = NULL;
    unsigned char *salt = NULL, *key = NULL, *info = NULL, *out = NULL;
    int salt_len = 0, key_len = 0, info_len = 0, res = TCL_OK, fn;
    int dk_len = EVP_MAX_KEY_LENGTH + EVP_MAX_IV_LENGTH;
    size_t out_len;
    Tcl_Obj *resultObj;

    dprintf("Called");

    /* Clear errors */
    Tcl_ResetResult(interp);
    ERR_clear_error();

    /* Validate arg count */
    if (objc < 5 || objc > 11) {
	Tcl_WrongNumArgs(interp, 1, objv, "-digest digest -key string ?-info string? ?-salt string? ?-size derived_length?");
	return TCL_ERROR;
    }

    /* Get options */
    for (int idx = 1; idx < objc; idx++) {
	/* Get option */
	if (Tcl_GetIndexFromObj(interp, objv[idx], command_opts, "option", 0, &fn) != TCL_OK) {
	    return TCL_ERROR;
	}

	/* Validate arg has a value */
	if (++idx >= objc) {
	    Tcl_AppendResult(interp, "No value for option \"", command_opts[fn], "\"", NULL);
	    return TCL_ERROR;
	}

	switch(fn) {
	case _opt_digest:
	case _opt_hash:
	    if ((md = Util_GetDigest(interp, objv[idx], TRUE)) == NULL) {
		goto error;
	    }
	    break;
	case _opt_info:
	    /* Max 1024/2048 */
	    GET_OPT_BYTE_ARRAY(objv[idx], info, &info_len);
	    break;
	case _opt_key:
	case _opt_password:
	    if ((key = Util_GetKey(interp, objv[idx], &key_len, command_opts[fn], 0, 1)) == NULL) {
		goto error;
	    }
	    break;
	case _opt_salt:
	    GET_OPT_BYTE_ARRAY(objv[idx], salt, &salt_len);
	    break;
	case _opt_length:
	case _opt_size:
	    if (Util_GetInt(interp, objv[idx], &dk_len, command_opts[fn], 1, 0) != TCL_OK) {
		goto error;
	    }
	    break;
	}
    }

    if (md == NULL) {
	Tcl_AppendResult(interp, "no digest", NULL);
	goto error;
    }

    if (key == NULL) {
	Tcl_AppendResult(interp, "no key", NULL);
	goto error;
    }

    /* Create context */
    pctx = EVP_PKEY_CTX_new_id(EVP_PKEY_HKDF, NULL);
    if (pctx == NULL) {
	Tcl_AppendResult(interp, "Memory allocation error", NULL);
	goto error;
    }

    if (EVP_PKEY_derive_init(pctx) < 1) {
	Tcl_AppendResult(interp, "Initialize failed: ", REASON(), NULL);
	goto error;
    }

    /* Set config parameters */
    if (EVP_PKEY_CTX_set_hkdf_md(pctx, md) < 1) {
	Tcl_AppendResult(interp, "Set digest failed: ", REASON(), NULL);
	goto error;
    }
    if (EVP_PKEY_CTX_set1_hkdf_key(pctx, key, key_len) < 1) {
	Tcl_AppendResult(interp, "Set key failed: ", REASON(), NULL);
	goto error;
    }
    if (salt != NULL && EVP_PKEY_CTX_set1_hkdf_salt(pctx, salt, salt_len) < 1) {
	Tcl_AppendResult(interp, "Set salt failed: ", REASON(), NULL);
	goto error;
    }
    if (info != NULL && EVP_PKEY_CTX_add1_hkdf_info(pctx, info, info_len) < 1) {
	Tcl_AppendResult(interp, "Set info failed: ", REASON(), NULL);
	goto error;
    }

    /* Get buffer */
    resultObj = Tcl_NewObj();
    if ((out = Tcl_SetByteArrayLength(resultObj, dk_len)) == NULL) {
	Tcl_AppendResult(interp, "Memory allocation error", (char *) NULL);
	goto error;
    }
    out_len = (size_t) dk_len;

    /* Derive key */
    if (EVP_PKEY_derive(pctx, out, &out_len) > 0) {
	/* Shrink buffer to actual size */
	Tcl_SetByteArrayLength(resultObj, (int) out_len);
	Tcl_SetObjResult(interp, resultObj);
	res = TCL_OK;
	goto done;
    } else {
	Tcl_AppendResult(interp, "Key derivation failed: ", REASON(), NULL);
	Tcl_DecrRefCount(resultObj);
    }

error:
    res = TCL_ERROR;
done:
    if (pctx != NULL) {
	EVP_PKEY_CTX_free(pctx);
    }
    return res;
}

/*
 *-------------------------------------------------------------------
 *
 * KDF_Scrypt --
 *
 *	HMAC-based Extract-and-Expand Key Derivation Function (HKDF).
 *	See RFC 5869 and RFC 7914.
 *
 * Returns:
 *	TCL_OK or TCL_ERROR
 *
 * Side effects:
 *	Sets result to a list of key and iv values, or an error message
 *
 *-------------------------------------------------------------------
 */
static int KDF_Scrypt(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    EVP_PKEY_CTX *pctx = NULL;
    unsigned char *salt = NULL, *pass = NULL, *out = NULL;
    int salt_len = 0, pass_len = 0, dk_len = 64, res = TCL_OK, fn;
    uint64_t N = 0, p = 0, r = 0, maxmem = 0;
    size_t out_len;
    Tcl_Obj *resultObj;

    dprintf("Called");

    /* Clear errors */
    Tcl_ResetResult(interp);
    ERR_clear_error();

    /* Validate arg count */
    if (objc < 5 || objc > 13) {
	Tcl_WrongNumArgs(interp, 1, objv, "-password string -salt string ?-N costParameter? ?-r blockSize? ?-p parallelization? ?-size derived_length?");
	return TCL_ERROR;
    }

    /* Get options */
    for (int idx = 1; idx < objc; idx++) {
	/* Get option */
	if (Tcl_GetIndexFromObj(interp, objv[idx], command_opts, "option", 0, &fn) != TCL_OK) {
	    return TCL_ERROR;
	}

	/* Validate arg has a value */
	if (++idx >= objc) {
	    Tcl_AppendResult(interp, "No value for option \"", command_opts[fn], "\"", (char *) NULL);
	    return TCL_ERROR;
	}

	switch(fn) {
	case _opt_key:
	case _opt_password:
	    GET_OPT_BYTE_ARRAY(objv[idx], pass, &pass_len);
	    break;
	case _opt_salt:
	    GET_OPT_BYTE_ARRAY(objv[idx], salt, &salt_len);
	    break;
	case _opt_length:
	case _opt_size:
	    if (Util_GetInt(interp, objv[idx], &dk_len, command_opts[fn], 1, 0) != TCL_OK) {
		goto error;
	    }
	    break;
	case _opt_N:
	case _opt_n:
	    GET_OPT_WIDE(objv[idx], &N);
	    break;
	case _opt_r:
	    GET_OPT_WIDE(objv[idx], &r);
	    break;
	case _opt_p:
	    GET_OPT_WIDE(objv[idx], &p);
	    break;
	}
    }

    if (pass == NULL) {
	Tcl_AppendResult(interp, "no password", (char *) NULL);
	return TCL_ERROR;
    }

    if (salt == NULL) {
	Tcl_AppendResult(interp, "no salt", (char *) NULL);
	return TCL_ERROR;
    }

    /* Create context */
    pctx = EVP_PKEY_CTX_new_id(EVP_PKEY_SCRYPT, NULL);
    if (pctx == NULL) {
	Tcl_AppendResult(interp, "Memory allocation error", (char *) NULL);
	goto error;
    }

    if (EVP_PKEY_derive_init(pctx) < 1) {
	Tcl_AppendResult(interp, "Initialize failed: ", REASON(), NULL);
	goto error;
    }

    /* Set config parameters */
    if (EVP_PKEY_CTX_set1_pbe_pass(pctx, pass, pass_len) < 1) {
	Tcl_AppendResult(interp, "Set key failed: ", REASON(), NULL);
	goto error;
    }
    if (EVP_PKEY_CTX_set1_scrypt_salt(pctx, salt, salt_len) < 1) {
	Tcl_AppendResult(interp, "Set salt failed: ", REASON(), NULL);
	goto error;
    }
    if (N != 0 && EVP_PKEY_CTX_set_scrypt_N(pctx, N) < 1) {
	Tcl_AppendResult(interp, "Set cost parameter (N) failed: ", REASON(), NULL);
	goto error;
    }
    if (r != 0 && EVP_PKEY_CTX_set_scrypt_r(pctx, r) < 1) {
	Tcl_AppendResult(interp, "Set lock size parameter (r) failed: ", REASON(), NULL);
	goto error;
   }
    if (p != 0 && EVP_PKEY_CTX_set_scrypt_p(pctx, p) < 1) {
	Tcl_AppendResult(interp, "Set Parallelization parameter (p) failed: ", REASON(), NULL);
	goto error;
    }
    if (maxmem != 0 && EVP_PKEY_CTX_set_scrypt_maxmem_bytes(pctx, maxmem) < 1) {
	Tcl_AppendResult(interp, "Set max memory failed: ", REASON(), NULL);
	goto error;
    }

    /* Get buffer */
    resultObj = Tcl_NewObj();
    if ((out = Tcl_SetByteArrayLength(resultObj, dk_len)) == NULL) {
	Tcl_AppendResult(interp, "Memory allocation error", (char *) NULL);
	goto error;
    }
    out_len = (size_t) dk_len;

    /* Derive key */
    if (EVP_PKEY_derive(pctx, out, &out_len) > 0) {
	/* Shrink buffer to actual size */
	Tcl_SetByteArrayLength(resultObj, (int) out_len);
	Tcl_SetObjResult(interp, resultObj);
	goto done;

    } else {
	Tcl_AppendResult(interp, "Key derivation failed: ", REASON(), NULL);
	Tcl_DecrRefCount(resultObj);
    }

error:
    res = TCL_ERROR;

done:
    if (pctx != NULL) {
	EVP_PKEY_CTX_free(pctx);
    }
    return res;
}

/*
 *-------------------------------------------------------------------
 *
 * Tls_KeyCommands --
 *
 *	Create key commands
 *
 * Returns:
 *	TCL_OK or TCL_ERROR
 *
 * Side effects:
 *	Creates commands
 *
 *-------------------------------------------------------------------
 */
int Tls_KeyCommands(Tcl_Interp *interp) {
    Tcl_CreateObjCommand(interp, "tls::hkdf", KDF_HKDF, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "tls::pbkdf2", KDF_PBKDF2, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "tls::scrypt", KDF_Scrypt, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
    return TCL_OK;
}

/*
 * Cryptographic Utility Functions
 *
 * Provides commands to derive keys.
 *
 * Copyright (C) 2023 Brian O'Hagan
 *
 */

#include "tlsInt.h"
#include "tclOpts.h"
#include <openssl/evp.h>


/*
 *-------------------------------------------------------------------
 *
 * Util_GetCipher --
 *
 *	Get symmetric cipher from TclObj
 *
 * Returns:
 *	Pointer to type or NULL
 *
 * Side effects:
 *	None
 *
 *-------------------------------------------------------------------
 */
EVP_CIPHER *Util_GetCipher(Tcl_Interp *interp, Tcl_Obj *cipherObj, int no_null) {
    EVP_CIPHER *cipher = NULL;
    char *name = NULL;

    if (cipherObj != NULL) {
	name = Tcl_GetStringFromObj(cipherObj, NULL);
#if OPENSSL_VERSION_NUMBER < 0x30000000L
	cipher = EVP_get_cipherbyname(name);
#else
	cipher = EVP_CIPHER_fetch(NULL, name, NULL);
#endif
	if (cipher == NULL) {
	    Tcl_AppendResult(interp, "invalid cipher \"", name, "\"", (char *) NULL);
	}
    } else if (no_null) {
	Tcl_AppendResult(interp, "no cipher", (char *) NULL);
    }
    return cipher;
}

/*
 *-------------------------------------------------------------------
 *
 * Util_GetDigest --
 *
 *	Get message digest (MD) or hash from TclObj
 *
 * Returns:
 *	Pointer to type or NULL
 *
 * Side effects:
 *	None
 *
 *-------------------------------------------------------------------
 */
EVP_MD *Util_GetDigest(Tcl_Interp *interp, Tcl_Obj *digestObj, int no_null) {
    EVP_MD *md = NULL;
    char *name = NULL;

    if (digestObj != NULL) {
	name = Tcl_GetStringFromObj(digestObj, NULL);
#if OPENSSL_VERSION_NUMBER < 0x30000000L
	md = EVP_get_digestbyname(name);
#else
	md = EVP_MD_fetch(NULL, name, NULL);
#endif
	if (md == NULL) {
	    Tcl_AppendResult(interp, "invalid digest \"", name, "\"", (char *) NULL);
	}
    } else if (no_null) {
	Tcl_AppendResult(interp, "no digest", (char *) NULL);
    }
    return md;
}

/*
 *-------------------------------------------------------------------
 *
 * Util_GetIV --
 *
 *	Get encryption initialization vector or seed from TclObj
 *
 * Returns:
 *	Pointer to type or NULL, and size
 *
 * Side effects:
 *	None
 *
 *-------------------------------------------------------------------
 */
unsigned char *Util_GetIV(Tcl_Interp *interp, Tcl_Obj *ivObj, int *len, int max, int no_null) {
    unsigned char *iv = NULL;
    *len = 0;

    if (ivObj != NULL) {
	iv = Tcl_GetByteArrayFromObj(ivObj, len);
    } else if (no_null) {
	Tcl_AppendResult(interp, "no initialization vector (IV)", (char *) NULL);
	return NULL;
    }

    if (max > 0 && *len > max) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf("IV too long. Must be <= %d bytes", max));
	return NULL;
    }
    return iv;
}

/*
 *-------------------------------------------------------------------
 *
 * Util_GetKey --
 *
 *	Get encryption key or password from TclObj
 *
 * Returns:
 *	Pointer to type or NULL, and size
 *
 * Side effects:
 *	None
 *
 *-------------------------------------------------------------------
 */
unsigned char *Util_GetKey(Tcl_Interp *interp, Tcl_Obj *keyObj, int *len, char *name, int max, int no_null) {
    unsigned char *key = NULL;
    *len = 0;

    if (keyObj != NULL) {
	key = Tcl_GetByteArrayFromObj(keyObj, len);
    } else if (no_null) {
	Tcl_AppendResult(interp, "no ", name, (char *) NULL);
	return NULL;
    }

    if (max > 0 && *len > max) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf("Invalid %s length. Must be <= %d bytes", name, max));
	return NULL;
    }
    return key;
}

/*
 *-------------------------------------------------------------------
 *
 * Util_GetMAC --
 *
 *	Get Message Authentication Code (MAC) from TclObj
 *
 * Returns:
 *	Pointer to type or NULL
 *
 * Side effects:
 *	None
 *
 *-------------------------------------------------------------------
 */
#if OPENSSL_VERSION_NUMBER >= 0x30000000L
EVP_MAC *Util_GetMAC(Tcl_Interp *interp, Tcl_Obj *MacObj, int no_null) {
    EVP_MAC *mac = NULL;
    char *name = NULL;

    if (MacObj != NULL) {
	name = Tcl_GetStringFromObj(MacObj, NULL);
	mac = EVP_MAC_fetch(NULL, name, NULL);
	if (mac == NULL) {
	    Tcl_AppendResult(interp, "invalid MAC \"", name, "\"", (char *) NULL);
	    return NULL;
	}
    } else if (no_null) {
	Tcl_AppendResult(interp, "no MAC", (char *) NULL);
    }
    return mac;
}
#endif

/*
 *-------------------------------------------------------------------
 *
 * Util_GetSalt --
 *
 *	Get encryption salt from TclObj
 *
 * Returns:
 *	Pointer to type or NULL, and size
 *
 * Side effects:
 *	None
 *
 *-------------------------------------------------------------------
 */
unsigned char *Util_GetSalt(Tcl_Interp *interp, Tcl_Obj *saltObj, int *len, int max, int no_null) {
    unsigned char *salt = NULL;
    *len = 0;

    if (saltObj != NULL) {
	salt = Tcl_GetByteArrayFromObj(saltObj, len);
    } else if (no_null) {
	Tcl_AppendResult(interp, "no salt", (char *) NULL);
	return NULL;
    }

    if (max > 0 && *len > max) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf("Salt too long. Must be <= %d bytes", max));
	return NULL;
    }
    return salt;
}

/*******************************************************************/

/*
 *-------------------------------------------------------------------
 *
 * Util_GetInt --
 *
 *	Get integer value from TclObj
 *
 * Returns:
 *	TCL_OK or TCL_ERROR
 *
 * Side effects:
 *	None
 *
 *-------------------------------------------------------------------
 */

int Util_GetInt(Tcl_Interp *interp, Tcl_Obj *dataObj, int *value, char *name, int min, int max) {

    if (dataObj != NULL) {
	if (Tcl_GetIntFromObj(interp, dataObj, value) != TCL_OK) {
	    return TCL_ERROR;
	}
    }

    /* Validate range */
    if (*value < min) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf("invalid value \"%d\" for option \"%s\": must be >= %d", *value, name, min));
	return TCL_ERROR;
    } else if (max > 0 && *value > max) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf("invalid value \"%d\" for option \"%s\": must be <= %d", *value, name, max));
	return TCL_ERROR;
    }
    return TCL_OK;
}

# defined by rules for object files.
PRJ_OBJS = $(TMP_DIR)\tls.obj \
	$(TMP_DIR)\tlsBIO.obj \
	$(TMP_DIR)\tlsDigest.obj \
	$(TMP_DIR)\tlsEncrypt.obj \
	$(TMP_DIR)\tlsInfo.obj \
	$(TMP_DIR)\tlsIO.obj \
	$(TMP_DIR)\tlsKDF.obj \
	$(TMP_DIR)\tlsUtil.obj \
	$(TMP_DIR)\tlsX509.obj

# Define any additional project include flags
# SSL_INSTALL_FOLDER = with the OpenSSL installation folder following.
PRJ_INCLUDES = -I"$(SSL_INSTALL_FOLDER)\include" -I"$(OPENSSL_INSTALL_DIR)\include"

# Define any additional compiler flags that might be required for the project