TclTLS
Check-in [fa2710a06c]
Login
HomeTimelineDownloadBrowse SourceBranchesTagsTicketsWiki
Overview
Comment:Added digest file, hex, and binary options. Added option to calculate message digest for a file. Added options to set output format to bin or hex.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | crypto
Files: files | file ages | folders
SHA3-256: fa2710a06cfc3e3d14e4d7d0104964593d263cd2f719add98e7d6b1c01d3b3d6
User & Date: bohagan on 2023-10-28 03:10:13
Other Links: branch diff | manifest | tags
Context
2023-10-28
03:34
Updated documentation to add digest file, hex, and binary options check-in: c8671aa698 user: bohagan tags: crypto
03:10
Added digest file, hex, and binary options. Added option to calculate message digest for a file. Added options to set output format to bin or hex. check-in: fa2710a06c user: bohagan tags: crypto
2023-10-27
23:01
Moved digest command to new tlsDigest.c file check-in: b120c6d336 user: bohagan tags: crypto
Changes
Unified Diff Ignore Whitespace Patch
Modified generic/tclOpts.h from [886b892588] to [c197957f96]. 
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20

/*
 *  Copyright (C) 1997-2000 Matt Newman <matt@novadigm.com>
 *
 * Stylized option processing - requires consistent
 * external vars: opt, idx, objc, objv
 */

#ifndef _TCL_OPTS_H
#define _TCL_OPTS_H

#define OPTFLAG(option, var)			\
    if (strcmp(opt, (option)) == 0) {		\
	var = 1;				\
	continue;				\
    }

#define OPT_PROLOG(option)			\
    if (strcmp(opt, (option)) == 0) {		\
	if (++idx >= objc) {			\
	    Tcl_AppendResult(interp,		\











|

|








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20

/*
 *  Copyright (C) 1997-2000 Matt Newman <matt@novadigm.com>
 *
 * Stylized option processing - requires consistent
 * external vars: opt, idx, objc, objv
 */

#ifndef _TCL_OPTS_H
#define _TCL_OPTS_H

#define OPTFLAG(option, var, val)		\
    if (strcmp(opt, (option)) == 0) {		\
	var = val;				\
	continue;				\
    }

#define OPT_PROLOG(option)			\
    if (strcmp(opt, (option)) == 0) {		\
	if (++idx >= objc) {			\
	    Tcl_AppendResult(interp,		\
︙︙
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67

    OPT_PROLOG(option)				\
    if (Tcl_GetBooleanFromObj(interp, objv[idx],\
	    &(var)) != TCL_OK) {		\
	    return TCL_ERROR;			\
    }						\
    OPT_POSTLOG()

#define OPTBYTE(option, var, lvar)			\
    OPT_PROLOG(option)				\
    var = Tcl_GetByteArrayFromObj(objv[idx], &(lvar));\
    OPT_POSTLOG()

#define OPTBAD(type, list)			\
    Tcl_AppendResult(interp, "bad ", (type),	\
		" \"", opt, "\": must be ",	\
		(list), (char *) NULL)

#endif /* _TCL_OPTS_H */








|











50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67

    OPT_PROLOG(option)				\
    if (Tcl_GetBooleanFromObj(interp, objv[idx],\
	    &(var)) != TCL_OK) {		\
	    return TCL_ERROR;			\
    }						\
    OPT_POSTLOG()

#define OPTBYTE(option, var, lvar)		\
    OPT_PROLOG(option)				\
    var = Tcl_GetByteArrayFromObj(objv[idx], &(lvar));\
    OPT_POSTLOG()

#define OPTBAD(type, list)			\
    Tcl_AppendResult(interp, "bad ", (type),	\
		" \"", opt, "\": must be ",	\
		(list), (char *) NULL)

#endif /* _TCL_OPTS_H */
Modified generic/tlsDigest.c from [e53726131a] to [77db2d7c66]. 
1
2
3
4
5
6
7
8

9
10
11
12
13
14
15

16





































































































17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55

56
57

58
59
60
61
62
63
64
65


66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87

88
89
90


91







92

93

94
95
96
97

98
99
100
101
102
103

104

105


106







107
108

109

110

111
112
113
114
115
116

117

118




119
120
121
122



123




124



125


126



127
128
129
130
131



132
133
134
135
136
137
138
139
140
141
142
143
144

/*
 * Digest Commands
 *
 * Copyright (C) 2023 Brian O'Hagan
 *
 */

#include "tlsInt.h"

#include <tcl.h>
#include <stdio.h>
#include <string.h>
#include <openssl/evp.h>

/* Constants */
const char *hex = "0123456789ABCDEF";








































































































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

/*
 *-------------------------------------------------------------------
 *
 * Hash Calc --
 *
 *	Calculate message digest of data using type hash algorithm.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------
 */
int
HashCalc(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], const EVP_MD *type) {
    char *data;
    int len;
    unsigned int mdlen;
    unsigned char mdbuf[EVP_MAX_MD_SIZE];

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "data");
	return TCL_ERROR;
    }

    /* Get data */
    data = Tcl_GetByteArrayFromObj(objv[1], &len);
    if (data == NULL || len == 0) {
	Tcl_SetResult(interp, "No data", NULL);
	return TCL_ERROR;
    }

    /* Calculate hash value, create hex representation, and write to result */
    if (EVP_Digest(data, (size_t) len, mdbuf, &mdlen, type, NULL)) {

	Tcl_Obj *resultObj;
	unsigned char *ptr;

	resultObj = Tcl_NewObj();
	ptr = Tcl_SetByteArrayLength(resultObj, mdlen*2);

	for (unsigned int i = 0; i < mdlen; i++) {
	    *ptr++ = hex[(mdbuf[i] >> 4) & 0x0F];
	    *ptr++ = hex[mdbuf[i] & 0x0F];
	}
	Tcl_SetObjResult(interp, resultObj);


    } else {
	Tcl_SetResult(interp, "Hash calculation error", NULL);
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------
 *
 * Hash Commands --
 *
 *	Return the digest as a hex string for data using type message digest.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------
 */

DigestObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    int len;
    const char *name;


    const EVP_MD *type;









    if (objc != 3) {

	Tcl_WrongNumArgs(interp, 1, objv, "type data");
	return TCL_ERROR;
    }


    name = Tcl_GetStringFromObj(objv[1],&len);
    if (name == NULL || (type = EVP_get_digestbyname(name)) == NULL) {
	Tcl_AppendResult(interp, "Invalid digest type \"", name, "\"", NULL);
	return TCL_ERROR;
    }
    objc--;

    objv++;

    return HashCalc(interp, objc, objv, type);


}








/*

 * Command to Calculate MD4 Message Digest

 */

int
DigestMD4Cmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    return HashCalc(interp, objc, objv, EVP_md4());
}

/*

 * Command to Calculate MD5 Message Digest

 */




int
DigestMD5Cmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    return HashCalc(interp, objc, objv, EVP_md5());
}








/*



 * Command to Calculate SHA-1 Hash


 */



int
DigestSHA1Cmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    return HashCalc(interp, objc, objv, EVP_sha1());
}




/*
 * Command to Calculate SHA2 SHA-256 Hash
 */
int
DigestSHA256Cmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    return HashCalc(interp, objc, objv, EVP_sha256());
}

/*
 *-------------------------------------------------------------------
 *
 * Tls_DigestCommands --
 *









>







>

>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>






|

|

|
|


|




|


|
|













|
|
>
|
|
>
|
|

|
|
|
|

>
>

|








|

|

|
|


|



>

|
|
>
>
|
>
>
>
>
>
>
>

>
|
>
|



>
|
<
<
|

|
>
|
>
|
>
>
|
>
>
>
>
>
>
>

<
>
|
>
|
>
|
<
|
|

|
>
|
>
|
>
>
>
>
|
|
|

>
>
>
|
>
>
>
>
|
>
>
>
|
>
>

>
>
>
|
|
|


>
>
>
|
<
<
<
|
|








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218


219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236

237
238
239
240
241
242

243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286



287
288
289
290
291
292
293
294
295

/*
 * Digest Commands
 *
 * Copyright (C) 2023 Brian O'Hagan
 *
 */

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

/* Constants */
const char *hex = "0123456789ABCDEF";
#define REASON()	ERR_reason_error_string(ERR_get_error())


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

/*
 *-------------------------------------------------------------------
 *
 * DigestFile --
 *
 *	Return message digest for file using user specified hash function.
 *
 * Returns:
 *	TCL_OK or TCL_ERROR
 *
 * Side effects:
 *	Result is message digest or error message
 *
 *-------------------------------------------------------------------
 */
int
DigestFile(Tcl_Interp *interp, Tcl_Obj *filename, const EVP_MD *md, int format) {
    EVP_MD_CTX *ctx;
    Tcl_Channel chan;
    char buf[32768];
    unsigned char md_buf[EVP_MAX_MD_SIZE];
    unsigned int md_len;

    /* Open file channel */
    chan = Tcl_FSOpenFileChannel(interp, filename, "rb", 0444);
    if (chan == NULL) {
	return TCL_ERROR;
    }

    /* Configure channel */
    if (Tcl_SetChannelOption(interp, chan, "-translation", "binary") == TCL_ERROR ||
	Tcl_SetChannelOption(interp, chan, "-buffersize", "32768") == TCL_ERROR) {
	Tcl_Close(interp, chan);
	return TCL_ERROR;
    }

    /* Create message digest context */
    ctx = EVP_MD_CTX_new();
    if (ctx == NULL) {
	Tcl_AppendResult(interp, "Create digest context failed: ", REASON(), NULL);
	Tcl_Close(interp, chan);
	return TCL_ERROR;
    }

    /* Initialize hash function */
#if OPENSSL_VERSION_NUMBER < 0x30000000L
    if (!EVP_DigestInit_ex(ctx, md, NULL))
#else
    if (!EVP_DigestInit_ex2(ctx, md, NULL))
#endif
    {
	Tcl_AppendResult(interp, "Initialize digest failed: ", REASON(), NULL);
	Tcl_Close(interp, chan);
	EVP_MD_CTX_free(ctx);
	return TCL_ERROR;
    }

    /* Read file data and update hash function */
    while (!Tcl_Eof(chan)) {
	int len = Tcl_ReadRaw(chan, buf, 32768);
	if (!EVP_DigestUpdate(ctx, &buf, (size_t) len)) {
	    Tcl_AppendResult(interp, "Update digest failed: ", REASON(), NULL);
	    Tcl_Close(interp, chan);
	    EVP_MD_CTX_free(ctx);
	    return TCL_ERROR;
	}
    }

    /* Close channel */
    if (Tcl_Close(interp, chan) == TCL_ERROR) {
	EVP_MD_CTX_free(ctx);
	return TCL_ERROR;
    }

    /* Finalize hash function and calculate message digest */
    if (!EVP_DigestFinal_ex(ctx, md_buf, &md_len)) {
	Tcl_AppendResult(interp, "Finalize digest failed: ", REASON(), NULL);
	EVP_MD_CTX_free(ctx);
	return TCL_ERROR;
    }
    EVP_MD_CTX_free(ctx);

    /* Return message digest as either a binary or hex string */
    if (format == 0) {
	Tcl_SetObjResult(interp, Tcl_NewByteArrayObj(md_buf, md_len));

    } else {
	Tcl_Obj *resultObj = Tcl_NewObj();
	unsigned char *ptr = Tcl_SetByteArrayLength(resultObj, md_len*2);

	for (unsigned int i = 0; i < md_len; i++) {
	    *ptr++ = hex[(md_buf[i] >> 4) & 0x0F];
	    *ptr++ = hex[md_buf[i] & 0x0F];
	}
	Tcl_SetObjResult(interp, resultObj);
    }
    return TCL_OK;
}

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

/*
 *-------------------------------------------------------------------
 *
 * DigestHashFunction --
 *
 *	 Calculate message digest using hash function.
 *
 * Returns:
 *	TCL_OK or TCL_ERROR
 *
 * Side effects:
 *	Sets result to message digest or error message
 *
 *-------------------------------------------------------------------
 */
int
DigestHashFunction(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], const EVP_MD *md, int format) {
    char *data;
    int len;
    unsigned int md_len;
    unsigned char md_buf[EVP_MAX_MD_SIZE];

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "data");
	return TCL_ERROR;
    }

    /* Get data */
    data = Tcl_GetByteArrayFromObj(objv[1], &len);
    if (data == NULL || len == 0) {
	Tcl_SetResult(interp, "No data", NULL);
	return TCL_ERROR;
    }

    /* Calculate hash value, create bin/hex representation, and write to result */
    if (EVP_Digest(data, (size_t) len, md_buf, &md_len, md, NULL)) {
	if (format == 0) {
	    Tcl_SetObjResult(interp, Tcl_NewByteArrayObj(md_buf, md_len));

	} else {
	    Tcl_Obj *resultObj = Tcl_NewObj();
	    unsigned char *ptr = Tcl_SetByteArrayLength(resultObj, md_len*2);

	    for (unsigned int i = 0; i < md_len; i++) {
		*ptr++ = hex[(md_buf[i] >> 4) & 0x0F];
		*ptr++ = hex[md_buf[i] & 0x0F];
	    }
	Tcl_SetObjResult(interp, resultObj);
	}

    } else {
	Tcl_AppendResult(interp, "Hash calculation error:", REASON(), (char *) NULL);
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------
 *
 * DigestObjCmd --
 *
 *	Return message digest using user specified hash function.
 *
 * Returns:
 *	TCL_OK or TCL_ERROR
 *
 * Side effects:
 *	Sets result to message digest or error message
 *
 *-------------------------------------------------------------------
 */
static int
DigestObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    int idx, len, format = 1, key_len = 0, data_len = 0;
    const char *digestname;
    Tcl_Obj *dataObj = NULL, *fileObj = NULL;
    unsigned char *key = NULL;
    const EVP_MD *md;

    Tcl_ResetResult(interp);

    if (objc < 3 || objc > 5) {
	Tcl_WrongNumArgs(interp, 1, objv, "type ?-bin|-hex? [-channel chan | -file filename | ?-data? data]");
	return TCL_ERROR;
    }

    /* Get digest */
    digestname = Tcl_GetStringFromObj(objv[1], &len);
    if (digestname == NULL || (md = EVP_get_digestbyname(digestname)) == NULL) {
	Tcl_AppendResult(interp, "Invalid digest type \"", digestname, "\"", NULL);
	return TCL_ERROR;
    }

    /* Optimal case for blob of data */
    if (objc == 3) {


	return DigestHashFunction(interp, --objc, ++objv, md, format);
    }

    /* Get options */
    for (idx = 2; idx < objc-1; idx++) {
	char *opt = Tcl_GetStringFromObj(objv[idx], NULL);

	if (opt[0] != '-')
	    break;

	OPTFLAG("-bin", format, 0);
	OPTFLAG("-binary", format, 0);
	OPTFLAG("-hex", format, 1);
	OPTFLAG("-hexadecimal", format, 1);
	OPTOBJ("-data", dataObj);
	OPTOBJ("-file", fileObj);
	OPTOBJ("-filename", fileObj);


	OPTBAD("option", "-bin, -data, -file, -filename, -key, or -hex");
	return TCL_ERROR;
    }

    /* If no option for last arg, then its the data */
    if (idx < objc) {

	dataObj = objv[idx];
    }

    /* Calc digest on file or data blob */
    if (fileObj != NULL) {
	return DigestFile(interp, fileObj, md, format);
    } else if (dataObj != NULL) {
	Tcl_Obj *objs[2];
	objs[0] = NULL;
	objs[1] = dataObj;
	return DigestHashFunction(interp, 2, objs, md, format);
    }

    Tcl_AppendResult(interp, "No data specified.", NULL);
    return TCL_ERROR;
}

/*
 *-------------------------------------------------------------------
 *
 * Message Digest Convenience Commands --
 *
 *	Convenience commands for message digests.
 *
 * Returns:
 *	TCL_OK or TCL_ERROR
 *
 * Side effects:
 *	Sets result to message digest or error message
 *
 *-------------------------------------------------------------------
 */
int DigestMD4Cmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    return DigestHashFunction(interp, objc, objv, EVP_md4(), 1);
}

int DigestMD5Cmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    return DigestHashFunction(interp, objc, objv, EVP_md5(), 1);
}

int DigestSHA1Cmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    return DigestHashFunction(interp, objc, objv, EVP_sha1(), 1);
}




int DigestSHA256Cmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    return DigestHashFunction(interp, objc, objv, EVP_sha256(), 1);
}

/*
 *-------------------------------------------------------------------
 *
 * Tls_DigestCommands --
 *
︙︙
Powered by Fossil · RSS