Diff

Differences From Artifact [f6606c060c]:

To Artifact [7c8820a0b3]:


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
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
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316

317
318
319
320
321
322
323
324







+





+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+

-
+









-
+
















-
+

-
+


-
+
+


-
+



-
+

-
-
-
-
-
-
-

-
+
-
-
-
-
-
-
-
-
-
-
-



-
-
+
+

-
-
+
+



-
+




-
+


-
+



-
+

+
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
+
+
-
-
-
-
+
+
+
+
+
+
+
+
+
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+


-
-
+
+

-
+



-
+


-
-
-
-

-
+













-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
-
-
+
+
+
+
+
+
+
+
+
+

-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+









-
+







	int watchMask;		/* Current WatchProc mask */
	int mode;		/* Current mode of parent channel */
	int format;		/* Output format */

	Tcl_Interp *interp;	/* Current interpreter */
	EVP_MD_CTX *ctx;	/* MD Context */
	HMAC_CTX *hctx;		/* HMAC Context */
	Tcl_Command token;	/* Command token */
} DigestState;

/*
 *-------------------------------------------------------------------
 *
 * Tls_DigestNew --
 *
 *	This function creates a digest state structure
 *
 * Returns:
 *	Digest structure pointer
 *
 * Side effects:
 *	Creates structure
 *
 *-------------------------------------------------------------------
 */
DigestState *Tls_DigestNew(Tcl_Interp *interp, int format) {
    DigestState *statePtr = NULL;

    statePtr = (DigestState *) ckalloc((unsigned) sizeof(DigestState));
    if (statePtr != NULL) {
	memset(statePtr, 0, sizeof(DigestState));
	statePtr->self	= NULL;		/* This socket channel */
	statePtr->timer = NULL;		/* Timer to flush data */
	statePtr->flags = 0;		/* Chan config flags */
	statePtr->watchMask = 0;	/* Current WatchProc mask */
	statePtr->mode	= 0;		/* Current mode of parent channel */
	statePtr->format = format;	/* Output format */
	statePtr->interp = interp;	/* Current interpreter */
	statePtr->ctx = NULL;		/* MD Context */
	statePtr->hctx = NULL;		/* HMAC Context */
    }
    return statePtr;
}

/*
 *-------------------------------------------------------------------
 *
 * DigestFree --
 * Tls_DigestFree --
 *
 *	This procedure removes a digest state structure
 *	This function removes a digest state structure
 *
 * Returns:
 *	Nothing
 *
 * Side effects:
 *	Removes structure
 *
 *-------------------------------------------------------------------
 */
void DigestFree (DigestState *statePtr) {
void Tls_DigestFree(DigestState *statePtr) {
    if (statePtr == (DigestState *) NULL) return;

    if (statePtr->ctx != (EVP_MD_CTX *) NULL) {
	EVP_MD_CTX_free(statePtr->ctx);
    }
    if (statePtr->hctx != (HMAC_CTX *) NULL) {
	HMAC_CTX_free(statePtr->hctx);
    }
    ckfree(statePtr);
}

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

/*
 *-------------------------------------------------------------------
 *
 * DigestFile --
 * Tls_DigestInit --
 *
 *	Return message digest for file using user specified hash function.
 *	Initialize a hash function
 *
 * Returns:
 *	TCL_OK or TCL_ERROR
 *	TCL_OK if successful or TCL_ERROR for failure with result set
 *	to error message.
 *
 * Side effects:
 *	Result is message digest or error message
 *	No result or error message
 *
 *-------------------------------------------------------------------
 */
int DigestFile(Tcl_Interp *interp, Tcl_Obj *filename, const EVP_MD *md, int format,
int Tls_DigestInit(Tcl_Interp *interp, DigestState *statePtr, const EVP_MD *md,
	Tcl_Obj *keyObj) {
    EVP_MD_CTX *ctx = (EVP_MD_CTX *) NULL;
    HMAC_CTX *hctx = (HMAC_CTX *) NULL;
    Tcl_Channel chan;
    unsigned char buf[BUFFER_SIZE];
    unsigned char md_buf[EVP_MAX_MD_SIZE];
    unsigned int md_len;
    unsigned char *key;
    int key_len, res;

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

    /* Configure channel */
    if (Tcl_SetChannelOption(interp, chan, "-translation", "binary") == TCL_ERROR) {
	goto error;
    }
    Tcl_SetChannelBufferSize(chan, BUFFER_SIZE);

    /* Create message digest context */
    if (keyObj == NULL) {
	ctx = EVP_MD_CTX_new();
	res = (ctx != NULL);
	statePtr->ctx = EVP_MD_CTX_new();
	res = (statePtr->ctx != NULL);
    } else {
	hctx = HMAC_CTX_new();
	res = (hctx != NULL);
	statePtr->hctx = HMAC_CTX_new();
	res = (statePtr->hctx != NULL);
    }
    if (!res) {
	Tcl_AppendResult(interp, "Create digest context failed: ", REASON(), NULL);
	goto error;
	return TCL_ERROR;
    }

    /* Initialize hash function */
    if (keyObj == NULL) {
	res = EVP_DigestInit_ex(ctx, md, NULL);
	res = EVP_DigestInit_ex(statePtr->ctx, md, NULL);
    } else {
	key = Tcl_GetByteArrayFromObj(keyObj, &key_len);
	res = HMAC_Init_ex(hctx, (const void *) key, key_len, md, NULL);
	res = HMAC_Init_ex(statePtr->hctx, (const void *) key, key_len, md, NULL);
    }
    if (!res) {
	Tcl_AppendResult(interp, "Initialize digest failed: ", REASON(), NULL);
	goto error;
	return TCL_ERROR;
    }
    return TCL_OK;

    /* Read file data and update hash function */
    while (!Tcl_Eof(chan)) {
	int len = Tcl_ReadRaw(chan, (char *) buf, BUFFER_SIZE);
	if (len > 0) {
	    if (keyObj == NULL) {
		res = EVP_DigestUpdate(ctx, &buf, (size_t) len);
	    } else {
		res = HMAC_Update(hctx, &buf[0], (size_t) len);
	    }
	    if (!res) {
}

/*
 *-------------------------------------------------------------------
 *
 * Tls_DigestUpdate --
 *
 *	Update a hash function
 *
 * Returns:
 *	1 if successful or 0 for failure
 *
 * Side effects:
 *	Adds buf to hash function
 *
 *-------------------------------------------------------------------
 */
int Tls_DigestUpdate(DigestState *statePtr, char *buf, size_t read) {
    int res;

    if (statePtr->ctx != NULL) {
	res = EVP_DigestUpdate(statePtr->ctx, buf, read);
    } else {
	res = HMAC_Update(statePtr->hctx, buf, read);
    }
    return res;
		Tcl_AppendResult(interp, "Update digest failed: ", REASON(), NULL);
		res = TCL_ERROR;
		goto error;
	    }
	}
}

    }

    /* Close channel */
    if (Tcl_Close(interp, chan) == TCL_ERROR) {
/*
 *-------------------------------------------------------------------
 *
 * Tls_DigestFinialize --
 *
 *	Finalize a hash function and generate a message digest
 *
 * Returns:
 *	TCL_OK if successful or TCL_ERROR for failure with result set
	chan = (Tcl_Channel) NULL;
	goto error;
    }
    chan = (Tcl_Channel) NULL;
 *	to error message.
 *
 * Side effects:
 *	Sets result to message digest for hash function or an error message.
 *
 *-------------------------------------------------------------------
 */

int Tls_DigestFinialize(Tcl_Interp *interp, DigestState *statePtr) {
    unsigned char md_buf[EVP_MAX_MD_SIZE];
    unsigned int md_len;
    int res;

    /* Finalize hash function and calculate message digest */
    if (keyObj == NULL) {
	res = EVP_DigestFinal_ex(ctx, md_buf, &md_len);
    if (statePtr->ctx != NULL) {
	res = EVP_DigestFinal_ex(statePtr->ctx, md_buf, &md_len);
    } else {
	res = HMAC_Final(hctx, md_buf, &md_len);
	res = HMAC_Final(statePtr->hctx, md_buf, &md_len);
    }
    if (!res) {
	Tcl_AppendResult(interp, "Finalize digest failed: ", REASON(), NULL);
	goto error;
	return TCL_ERROR;
    }

    /* Done with struct */
    EVP_MD_CTX_free(ctx);
    ctx = NULL;

    /* Return message digest as either a binary or hex string */
    if (format == BIN_FORMAT) {
    if (statePtr->format == BIN_FORMAT) {
	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;

error:
    if (chan != (Tcl_Channel) NULL) {
	Tcl_Close(interp, chan);
}

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


/*
 *-------------------------------------------------------------------
 *
 * Tls_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 Tls_DigestFile(Tcl_Interp *interp, Tcl_Obj *filename, const EVP_MD *md, int format,
	Tcl_Obj *keyObj) {
    DigestState *statePtr;
    Tcl_Channel chan = NULL;
    unsigned char buf[BUFFER_SIZE];
    int res = TCL_OK, len;

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

    /* Configure channel */
    if (Tcl_SetChannelOption(interp, chan, "-translation", "binary") == TCL_ERROR) {
	res = TCL_ERROR;
	goto done;
    }
    Tcl_SetChannelBufferSize(chan, BUFFER_SIZE);
    if (ctx != (EVP_MD_CTX *) NULL) {
	EVP_MD_CTX_free(ctx);

    /* Create struct */
    if ((statePtr = Tls_DigestNew(interp, format)) == NULL) {
	res = TCL_ERROR;
	goto done;
    }

    /* Initialize hash function */
    if ((res = Tls_DigestInit(interp, statePtr, md, keyObj)) != TCL_OK) {
	goto done;
    }
    if (hctx != (HMAC_CTX *) NULL) {
	HMAC_CTX_free(hctx);
    }
    return TCL_ERROR;

    /* Read file data and update hash function */
    while (!Tcl_Eof(chan)) {
	len = Tcl_ReadRaw(chan, (char *) buf, BUFFER_SIZE);
	if (len > 0) {
	    if (!Tls_DigestUpdate(statePtr, &buf[0], (size_t) len)) {
		Tcl_AppendResult(interp, "Update digest failed: ", REASON(), NULL);
		res = TCL_ERROR;
		goto done;
	    }
	}
    }

    /* Finalize hash function and calculate message digest */
    res = Tls_DigestFinialize(interp, statePtr);

done:
    /* Close channel */
    if (Tcl_Close(interp, chan) == TCL_ERROR) {
	chan = (Tcl_Channel) NULL;
	res = TCL_ERROR;
	goto done;
    }

    /* Clean-up */
    Tls_DigestFree(statePtr);
    return res;
}

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

/*
 *-------------------------------------------------------------------
 *
 * DigestBlockModeProc --
 *
 *	This procedure is invoked by the generic IO level
 *	This function is invoked by the generic IO level
 *       to set blocking and nonblocking modes.
 *
 * Returns:
 *	0 if successful or POSIX error code if failed.
 *
 * Side effects:
 *	Sets the device into blocking or nonblocking mode.
233
234
235
236
237
238
239
240

241
242
243
244
245
246
247
338
339
340
341
342
343
344

345
346
347
348
349
350
351
352







-
+







}

/*
 *-------------------------------------------------------------------
 *
 * DigestCloseProc --
 *
 *	This procedure is invoked by the generic IO level to perform
 *	This function is invoked by the generic IO level to perform
 *	channel-type-specific cleanup when channel is closed. All
 *	queued output is flushed prior to calling this function.
 *
 * Returns:
 *	0 if successful or POSIX error code if failed.
 *
 * Side effects:
256
257
258
259
260
261
262
263

264
265
266
267
268
269
270
361
362
363
364
365
366
367

368
369
370
371
372
373
374
375







-
+







    /* Cancel active timer, if any */
    if (statePtr->timer != (Tcl_TimerToken) NULL) {
	Tcl_DeleteTimerHandler(statePtr->timer);
	statePtr->timer = (Tcl_TimerToken) NULL;
    }

    /* Clean-up */
    DigestFree(statePtr);
    Tls_DigestFree(statePtr);
    return 0;
}

/*
 * Same as DigestCloseProc but with individual read and write close control
 */
static int DigestClose2Proc(ClientData instanceData, Tcl_Interp *interp, int flags) {
302
303
304
305
306
307
308
309

310
311
312

313
314
315
316
317
318
319
320
321
322
323
407
408
409
410
411
412
413

414
415


416




417
418
419
420
421
422
423







-
+

-
-
+
-
-
-
-







	return 0;
    }

    /* Get bytes from underlying channel */
    parent = Tcl_GetStackedChannel(statePtr->self);
    read = Tcl_ReadRaw(parent, buf, toRead);

    /* Add to message digest */
    /* Update hash function */
    if (read > 0) {
	if (statePtr->ctx != NULL) {
	    res = EVP_DigestUpdate(statePtr->ctx, buf, (size_t) read);
	if (!Tls_DigestUpdate(statePtr, buf, (size_t) read)) {
	} else {
	    res = HMAC_Update(statePtr->hctx, buf, (size_t) read);
	}
	if (!res) {
	    Tcl_SetChannelError(statePtr->self, Tcl_ObjPrintf("Digest update failed: %s", REASON()));
	    *errorCodePtr = EINVAL;
	    return -1;
	}
	/* This is correct */
	read = -1;
	*errorCodePtr = EAGAIN;
339
340
341
342
343
344
345
346

347
348
349
350

351
352
353
354
355
356
357
439
440
441
442
443
444
445

446
447
448
449

450
451
452
453
454
455
456
457







-
+



-
+







	    res = HMAC_Final(statePtr->hctx, md_buf, &md_len);
	}
	if (!res) {
	    *errorCodePtr = EINVAL;

	/* Write message digest to output channel as byte array or hex string */
	} else if (md_len > 0) {
	    if (statePtr->format == BIN_FORMAT) {
	    if (statePtr->format == BIN_FORMAT && toRead >= (int) md_len) {
		read = md_len;
		memcpy(buf, md_buf, read);

	    } else {
	    } else if(statePtr->format == HEX_FORMAT && toRead >= (int) (md_len*2)) {
		unsigned char hex_buf[EVP_MAX_MD_SIZE*2];
		unsigned char *ptr = hex_buf;

		for (unsigned int i = 0; i < md_len; i++) {
		    *ptr++ = hex[(md_buf[i] >> 4) & 0x0F];
		    *ptr++ = hex[md_buf[i] & 0x0F];
		}
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394

395
396

397
398
399
400
401
402
403
404
405
479
480
481
482
483
484
485

486
487
488
489
490



491


492


493
494
495
496
497
498
499







-





-
-
-
+
-
-
+
-
-







 *	Get data from buf and update digest
 *
 *----------------------------------------------------------------------
 */
 int DigestOutputProc(ClientData clientData, const char *buf, int toWrite, int *errorCodePtr) {
    DigestState *statePtr = (DigestState *) clientData;
    *errorCodePtr = 0;
    int res;

    if (toWrite <= 0 || statePtr->self == (Tcl_Channel) NULL) {
	return 0;
    }

    /* Add to message digest */
    if (statePtr->ctx != NULL) {
	res = EVP_DigestUpdate(statePtr->ctx, buf, (size_t) toWrite);
    /* Update hash function */
    } else {
	res = HMAC_Update(statePtr->hctx, buf, (size_t) toWrite);
    if (toWrite > 0 && !Tls_DigestUpdate(statePtr, buf, (size_t) toWrite)) {
    }
    if (!res) {
	Tcl_SetChannelError(statePtr->self, Tcl_ObjPrintf("Digest update failed: %s", REASON()));
	*errorCodePtr = EINVAL;
	return -1;
    }
    return toWrite;
}

633
634
635
636
637
638
639
640

641
642
643
644
645
646
647
648
649
650
651
652
653

654
655

656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674

675
676

677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701


702
703
704
705
706

707
708
709
710

711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731

732
733
734
735
736
737
738
739
740
741
742
743
744

745
746
747
748
749
750
751
727
728
729
730
731
732
733

734
735
736
737
738
739
740
741
742
743
744
745
746

747
748

749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767

768


769












770
771
772










773
774





775

776


777








778
779
780
781
782
783
784
785
786
787
788
789

790
791
792
793
794
795
796
797
798
799
800
801
802

803
804
805
806
807
808
809
810







-
+












-
+

-
+


















-
+
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-



-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
+
-

-
-
+
-
-
-
-
-
-
-
-












-
+












-
+







    NULL,			/* Thread action */
    NULL			/* Truncate */
};

/*
 *----------------------------------------------------------------------
 *
 * DigestChannel --
 * Tls_DigestChannel --
 *
 *	Create a stacked channel for a message digest transformation.
 *
 * Returns:
 *	TCL_OK or TCL_ERROR
 *
 * Side effects:
 *	Adds transform to channel and sets result to channel name or error message.
 *
 *----------------------------------------------------------------------
 */
static int
DigestChannel(Tcl_Interp *interp, const char *channel, const EVP_MD *md, int format,
Tls_DigestChannel(Tcl_Interp *interp, const char *channel, const EVP_MD *md, int format,
	Tcl_Obj *keyObj) {
    int res, mode; /* OR-ed combination of TCL_READABLE and TCL_WRITABLE */
    int mode; /* OR-ed combination of TCL_READABLE and TCL_WRITABLE */
    Tcl_Channel chan;
    DigestState *statePtr;
    EVP_MD_CTX *ctx = (EVP_MD_CTX *) NULL;
    HMAC_CTX *hctx = (HMAC_CTX *) NULL;

    /* Validate args */
    if (channel == (const char *) NULL || md == (const EVP_MD *) NULL) {
	return TCL_ERROR;
    }

    chan = Tcl_GetChannel(interp, channel, &mode);
    if (chan == (Tcl_Channel) NULL) {
	return TCL_ERROR;
    }

    /* Make sure to operate on the topmost channel */
    chan = Tcl_GetTopChannel(chan);

    /* Create internal storage structure */
    /* Create struct */
    statePtr = (DigestState *) ckalloc((unsigned) sizeof(DigestState));
    if (statePtr != NULL) {
    if ((statePtr = Tls_DigestNew(interp, format)) == NULL) {
	memset(statePtr, 0, sizeof(DigestState));
	statePtr->self	= chan;		/* This socket channel */
	statePtr->timer = (Tcl_TimerToken) NULL;	/* Timer to flush data */
	statePtr->flags = 0;		/* Chan config flags */
	statePtr->watchMask = 0;	/* Current WatchProc mask */
	statePtr->mode	= mode;		/* Current mode of parent channel */
	statePtr->format = format;	/* Output format */
	statePtr->interp = interp;	/* Current interpreter */
	statePtr->ctx = ctx;		/* MD Context */
	statePtr->hctx = hctx;		/* HMAC Context */
	statePtr->mac = NULL;		/* MAC Context */
    } else {
	Tcl_AppendResult(interp, "Initialize digest error: memory allocation failure", (char *) NULL);
	return TCL_ERROR;
    }

    /* Create message digest context */
    if (keyObj == NULL) {
	ctx = EVP_MD_CTX_new();
    } else {
	hctx = HMAC_CTX_new();
    }
    if (ctx != NULL || hctx != NULL) {
	statePtr->ctx = ctx;
	statePtr->hctx = hctx;
    statePtr->self = chan;
    statePtr->mode = mode;
    } else {
	Tcl_AppendResult(interp, "Create digest context failed: ", REASON(), NULL);
	DigestFree(statePtr);
	return TCL_ERROR;
    }


    /* Initialize hash function */
    if (keyObj == NULL) {
	res = EVP_DigestInit_ex(ctx, md, NULL);
    if (Tls_DigestInit(interp, statePtr, md, keyObj) != TCL_OK) {
    } else {
	int key_len;
	unsigned char *key = Tcl_GetByteArrayFromObj(keyObj, &key_len);
	res = HMAC_Init_ex(hctx, (const void *) key, key_len, md, NULL);
    }
    if (!res) {
	Tcl_AppendResult(interp, "Initialize digest failed: ", REASON(), (char *) NULL);
	DigestFree(statePtr);
	return TCL_ERROR;
    }

    /* Configure channel */
    Tcl_SetChannelOption(interp, chan, "-translation", "binary");
    if (Tcl_GetChannelBufferSize(chan) < EVP_MAX_MD_SIZE * 2) {
	Tcl_SetChannelBufferSize(chan, EVP_MAX_MD_SIZE * 2);
    }

    /* Stack channel */
    statePtr->self = Tcl_StackChannel(interp, &digestChannelType, (ClientData) statePtr, mode, chan);
    if (statePtr->self == (Tcl_Channel) NULL) {
	DigestFree(statePtr);
	Tls_DigestFree(statePtr);
	return TCL_ERROR;
    }

    Tcl_SetResult(interp, (char *) Tcl_GetChannelName(chan), TCL_VOLATILE);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Unstack Channel --
 *
 *	This procedure is invoked to process the "unstack" TCL command.
 *	This function is invoked to process the "unstack" TCL command.
 *	See the user documentation for details on what it does.
 *
 * Returns:
 *	TCL_OK or TCL_ERROR
 *
 * Side effects:
 *	Removes transform from channel or sets result to error message.
785
786
787
788
789
790
791


792
793
794






















795





































































































796
797
798
799
800
801
802
803
804
805
806
807
808

809
810
811
812
813
814
815
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877

878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990

991
992
993
994
995
996
997
998







+
+



+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+












-
+







    }
    return TCL_OK;
    	clientData = clientData;
}

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

static const char *instance_fns [] = { "finalize", "update", NULL };

/*
 *-------------------------------------------------------------------
 *
 * InstanceObjCmd --
 *
 *	 Handler for digest accumulator command instances.
 *
 * Returns:
 *	TCL_OK or TCL_ERROR
 *
 * Side effects:
 *	Adds data to hash or returns message digest
 *
 *-------------------------------------------------------------------
 */
int InstanceObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    DigestState *statePtr = (DigestState *) clientData;
    int fn, len = 0;
    char *buf = NULL;

    if (objc < 2 || objc > 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "function ?data?");
	return TCL_ERROR;
    }

 * DigestHashFunction --
    /* Function */
    if (Tcl_GetIndexFromObj(interp, objv[1], instance_fns, "function", 0, &fn) != TCL_OK) {
	return TCL_ERROR;
    }

    /* Do function */
    if (fn) {
	/* Update hash function */
	if (objc == 3) {
	    buf = Tcl_GetByteArrayFromObj(objv[2], &len);
	} else {
	    Tcl_WrongNumArgs(interp, 1, objv, "update data");
	    return TCL_ERROR;
	}

	if (!Tls_DigestUpdate(statePtr, buf, (size_t) len)) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf("Digest update failed: %s", REASON()));
	    return TCL_ERROR;
	}

    } else {
	/* Finalize hash function and calculate message digest */
	if (Tls_DigestFinialize(interp, statePtr) != TCL_OK) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf("Digest finalize failed: %s", REASON()));
	    return TCL_ERROR;
	}

	Tcl_DeleteCommandFromToken(interp, statePtr->token);
    }
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------
 *
 * InstanceDelCallback --
 *
 *	 Callback to clean-up when digest instance command is deleted.
 *
 * Returns:
 *	Nothing
 *
 * Side effects:
 *	Destroys struct
 *
 *-------------------------------------------------------------------
 */
void InstanceDelCallback(ClientData clientData) {
    DigestState *statePtr = (DigestState *) clientData;

    /* Clean-up */
    Tls_DigestFree(statePtr);
}

/*
 *-------------------------------------------------------------------
 *
 * Tls_DigestInstance --
 *
 *	 Create command to allow user to add data to hash function.
 *
 * Returns:
 *	TCL_OK or TCL_ERROR
 *
 * Side effects:
 *	Creates command or error message
 *
 *-------------------------------------------------------------------
 */
int Tls_DigestInstance(Tcl_Interp *interp, Tcl_Obj *cmdObj, const EVP_MD *md, int format,
	Tcl_Obj *keyObj) {
    DigestState *statePtr;
    char *cmdName = Tcl_GetStringFromObj(cmdObj, NULL);

    /* Create struct */
    if ((statePtr = Tls_DigestNew(interp, format)) == NULL) {
	Tcl_AppendResult(interp, "Initialize digest error: memory allocation failure", (char *) NULL);
	return TCL_ERROR;
    }

    /* Initialize hash function */
    if (Tls_DigestInit(interp, statePtr, md, keyObj) != TCL_OK) {
	return TCL_ERROR;
    }

    /* Create instance command */
    statePtr->token = Tcl_CreateObjCommand(interp, cmdName, InstanceObjCmd,
	(ClientData) statePtr, InstanceDelCallback);

    /* Return command name */
    Tcl_SetObjResult(interp, cmdObj);
    return TCL_OK;
}


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

/*
 *-------------------------------------------------------------------
 *
 * Tls_DigestData --
 *
 *	 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[],
Tls_DigestData(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[],
	const EVP_MD *md, int format, Tcl_Obj *keyObj) {
    char *data;
    int len, res;
    unsigned int md_len;
    unsigned char md_buf[EVP_MAX_MD_SIZE];

    if (objc != 2) {
856
857
858
859
860
861
862



863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880

881
882

883
884
885
886
887
888
889

890
891
892
893
894
895
896
897
898
899
900
901
902

903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918

919
920
921
922
923

924
925
926
927
928
929
930
931
932
933
934

935
936



937
938
939
940
941

942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962

963
964
965
966

967
968
969
970

971
972
973
974

975
976
977
978

979
980
981
982
983
984
985
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065

1066
1067

1068
1069
1070
1071
1072
1073
1074

1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087

1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109

1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120

1121
1122

1123
1124
1125
1126
1127
1128
1129

1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150

1151
1152
1153
1154

1155
1156
1157
1158

1159
1160
1161
1162

1163
1164
1165
1166

1167
1168
1169
1170
1171
1172
1173
1174







+
+
+

















-
+

-
+






-
+












-
+
















+




-
+










-
+

-
+
+
+




-
+




















-
+



-
+



-
+



-
+



-
+







    } 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 = HEX_FORMAT, key_len = 0, data_len = 0, res = TCL_OK;
    int idx, len, format = HEX_FORMAT, key_len = 0, data_len = 0, res = TCL_ERROR;
    const char *digestname, *channel = NULL;
    Tcl_Obj *dataObj = NULL, *fileObj = NULL, *keyObj = NULL;
    Tcl_Obj *cmdObj = NULL, *dataObj = NULL, *fileObj = NULL, *keyObj = NULL;
    unsigned char *key = NULL;
    const EVP_MD *md;

    Tcl_ResetResult(interp);

    if (objc < 3 || objc > 7) {
	Tcl_WrongNumArgs(interp, 1, objv, "type ?-bin|-hex? ?-key hmac_key? [-channel chan | -file filename | ?-data? data]");
	Tcl_WrongNumArgs(interp, 1, objv, "type ?-bin|-hex? ?-key hmac_key? [-channel chan | -command cmdName | -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, NULL);
	return Tls_DigestData(interp, --objc, ++objv, md, format, NULL);
    }

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

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

	OPTFLAG("-bin", format, BIN_FORMAT);
	OPTFLAG("-binary", format, BIN_FORMAT);
	OPTFLAG("-hex", format, HEX_FORMAT);
	OPTFLAG("-hexadecimal", format, HEX_FORMAT);
	OPTOBJ("-data", dataObj);
	OPTSTR("-chan", channel);
	OPTSTR("-channel", channel);
	OPTOBJ("-command", cmdObj);
	OPTOBJ("-file", fileObj);
	OPTOBJ("-filename", fileObj);
	OPTOBJ("-key", keyObj);

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

    /* If no option for last arg, then its the data */
    if (idx < objc) {
	dataObj = objv[idx];
    }

    /* Calc digest on file, stacked channel, or data blob */
    if (fileObj != NULL) {
	res = DigestFile(interp, fileObj, md, format, keyObj);
	res = Tls_DigestFile(interp, fileObj, md, format, keyObj);
    } else if (channel != NULL) {
	res = DigestChannel(interp, channel, md, format, keyObj);
	res = Tls_DigestChannel(interp, channel, md, format, keyObj);
    } else if (cmdObj != NULL) {
	res = Tls_DigestInstance(interp, cmdObj, md, format, keyObj);
    } else if (dataObj != NULL) {
	Tcl_Obj *objs[2];
	objs[0] = NULL;
	objs[1] = dataObj;
	res = DigestHashFunction(interp, 2, objs, md, format, keyObj);
	res = Tls_DigestData(interp, 2, objs, md, format, keyObj);
    }
    return res;
}

/*
 *-------------------------------------------------------------------
 *
 * 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(), HEX_FORMAT, NULL);
    return Tls_DigestData(interp, objc, objv, EVP_md4(), HEX_FORMAT, NULL);
}

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

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

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

int DigestSHA512Cmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    return DigestHashFunction(interp, objc, objv, EVP_sha512(), HEX_FORMAT, NULL);
    return Tls_DigestData(interp, objc, objv, EVP_sha512(), HEX_FORMAT, NULL);
}

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