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
|
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;
}
/*******************************************************************/
/*
*-------------------------------------------------------------------
*
* Hash Calc --
* DigestHashFunction --
*
* Calculate message digest of data using type hash algorithm.
* Calculate message digest using hash function.
*
* Results:
* A standard Tcl result.
* Returns:
* TCL_OK or TCL_ERROR
*
* Side effects:
* None.
* Sets result to message digest or error message
*
*-------------------------------------------------------------------
*/
int
HashCalc(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], const EVP_MD *type) {
DigestHashFunction(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], const EVP_MD *md, int format) {
char *data;
int len;
unsigned int mdlen;
unsigned char mdbuf[EVP_MAX_MD_SIZE];
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 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);
/* 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 < mdlen; i++) {
*ptr++ = hex[(mdbuf[i] >> 4) & 0x0F];
*ptr++ = hex[mdbuf[i] & 0x0F];
}
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_SetResult(interp, "Hash calculation error", NULL);
Tcl_AppendResult(interp, "Hash calculation error:", REASON(), (char *) NULL);
return TCL_ERROR;
}
return TCL_OK;
}
/*
*-------------------------------------------------------------------
*
* Hash Commands --
* DigestObjCmd --
*
* Return the digest as a hex string for data using type message digest.
* Return message digest using user specified hash function.
*
* Results:
* A standard Tcl result.
* Returns:
* TCL_OK or TCL_ERROR
*
* Side effects:
* None.
* Sets result to message digest or error message
*
*-------------------------------------------------------------------
*/
static int
DigestObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
int len;
const char *name;
const EVP_MD *type;
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 */
if (objc != 3) {
Tcl_WrongNumArgs(interp, 1, objv, "type data");
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 */
name = Tcl_GetStringFromObj(objv[1],&len);
if (objc == 3) {
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
*
* 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
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());
|