Diff
EuroTcl/OpenACS 11 - 12 JULY 2024, VIENNA

Differences From Artifact [7c8820a0b3]:

To Artifact [ff147d0f8d]:


1
2
3
4
5
6
7
8
9
10
11
/*
 * Message Digests Module
 *
 * Provides commands to calculate a message digest using a specified hash algorithm.
 *
 * Copyright (C) 2023 Brian O'Hagan
 *
 */

#include "tlsInt.h"
#include "tclOpts.h"



|







1
2
3
4
5
6
7
8
9
10
11
/*
 * Message Digests Module
 *
 * Provides commands to calculate a message digest using a specified hash function.
 *
 * Copyright (C) 2023 Brian O'Hagan
 *
 */

#include "tlsInt.h"
#include "tclOpts.h"
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
/* Macros */
#define BUFFER_SIZE 65536
#define BIN_FORMAT 0
#define HEX_FORMAT 1
#define CHAN_EOF 0x10

/*
 * This structure describes the per-instance state of an SSL channel.
 *
 * The SSL processing context is maintained here, in the ClientData
 */
typedef struct DigestState {
	Tcl_Channel self;	/* This socket channel */
	Tcl_TimerToken timer;	/* Timer for read events */

	int flags;		/* Chan config flags */
	int watchMask;		/* Current WatchProc mask */







|
<
<







20
21
22
23
24
25
26
27


28
29
30
31
32
33
34
/* Macros */
#define BUFFER_SIZE 65536
#define BIN_FORMAT 0
#define HEX_FORMAT 1
#define CHAN_EOF 0x10

/*
 * This structure defines the per-instance state of a digest operation.


 */
typedef struct DigestState {
	Tcl_Channel self;	/* This socket channel */
	Tcl_TimerToken timer;	/* Timer for read events */

	int flags;		/* Chan config flags */
	int watchMask;		/* Current WatchProc mask */
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
 *
 * 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 */







|







53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
 *
 * Side effects:
 *	Creates structure
 *
 *-------------------------------------------------------------------
 */
DigestState *Tls_DigestNew(Tcl_Interp *interp, int format) {
    DigestState *statePtr;

    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 */
89
90
91
92
93
94
95
96


97
98
99
100
101
102
103
 *
 * Side effects:
 *	Removes structure
 *
 *-------------------------------------------------------------------
 */
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);
    }







|
>
>







87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
 *
 * Side effects:
 *	Removes structure
 *
 *-------------------------------------------------------------------
 */
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);
    }
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
    /* 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);

    /* 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) {







|
<




|







258
259
260
261
262
263
264
265

266
267
268
269
270
271
272
273
274
275
276
277
    /* Open file channel */
    chan = Tcl_FSOpenFileChannel(interp, filename, "rb", 0444);
    if (chan == (Tcl_Channel) NULL) {
	return TCL_ERROR;
    }

    /* Configure channel */
    if ((res = Tcl_SetChannelOption(interp, chan, "-translation", "binary")) == TCL_ERROR) {

	goto done;
    }
    Tcl_SetChannelBufferSize(chan, BUFFER_SIZE);

    /* Create state data 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) {
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309

    /* 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;
}








<

<







292
293
294
295
296
297
298

299

300
301
302
303
304
305
306

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

done:
    /* Close channel */
    if (Tcl_Close(interp, chan) == TCL_ERROR) {

	res = TCL_ERROR;

    }

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

347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
 *	queued output is flushed prior to calling this function.
 *
 * Returns:
 *	0 if successful or POSIX error code if failed.
 *
 * Side effects:
 *	Writes digest to output and closes the channel. Stores error
 *	messages in interp result.
 *
 *-------------------------------------------------------------------
 */
int DigestCloseProc(ClientData clientData, Tcl_Interp *interp) {
    DigestState *statePtr = (DigestState *) clientData;

    /* Cancel active timer, if any */







|







344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
 *	queued output is flushed prior to calling this function.
 *
 * Returns:
 *	0 if successful or POSIX error code if failed.
 *
 * Side effects:
 *	Writes digest to output and closes the channel. Stores error
 *	messages in interp result using Tcl_GetChannelErrorInterp.
 *
 *-------------------------------------------------------------------
 */
int DigestCloseProc(ClientData clientData, Tcl_Interp *interp) {
    DigestState *statePtr = (DigestState *) clientData;

    /* Cancel active timer, if any */
399
400
401
402
403
404
405

406
407
408
409
410
411
412
 */
int DigestInputProc(ClientData clientData, char *buf, int toRead, int *errorCodePtr) {
    DigestState *statePtr = (DigestState *) clientData;
    Tcl_Channel parent;
    int read, res;
    *errorCodePtr = 0;


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

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







>







396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
 */
int DigestInputProc(ClientData clientData, char *buf, int toRead, int *errorCodePtr) {
    DigestState *statePtr = (DigestState *) clientData;
    Tcl_Channel parent;
    int read, res;
    *errorCodePtr = 0;

    /* Abort if nothing to process */
    if (toRead <= 0 || statePtr->self == (Tcl_Channel) NULL) {
	return 0;
    }

    /* Get bytes from underlying channel */
    parent = Tcl_GetStackedChannel(statePtr->self);
    read = Tcl_ReadRaw(parent, buf, toRead);
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441

442
443
444
445
446
447
448
	    
    } else if (read < 0) {
	/* Error */
	*errorCodePtr = Tcl_GetErrno();

    } else if (!(statePtr->flags & CHAN_EOF)) {
	/* EOF */
	*errorCodePtr = 0;
	unsigned char md_buf[EVP_MAX_MD_SIZE];
	unsigned int md_len = 0;

	/* Finalize hash function and calculate message digest */
	if (statePtr->ctx != NULL) {
	    res = EVP_DigestFinal_ex(statePtr->ctx, md_buf, &md_len);
	} else {
	    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 && toRead >= (int) md_len) {
		read = md_len;
		memcpy(buf, md_buf, read);







<










>







422
423
424
425
426
427
428

429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
	    
    } else if (read < 0) {
	/* Error */
	*errorCodePtr = Tcl_GetErrno();

    } else if (!(statePtr->flags & CHAN_EOF)) {
	/* EOF */

	unsigned char md_buf[EVP_MAX_MD_SIZE];
	unsigned int md_len = 0;

	/* Finalize hash function and calculate message digest */
	if (statePtr->ctx != NULL) {
	    res = EVP_DigestFinal_ex(statePtr->ctx, md_buf, &md_len);
	} else {
	    res = HMAC_Final(statePtr->hctx, md_buf, &md_len);
	}
	if (!res) {
	    Tcl_SetChannelError(statePtr->self, Tcl_ObjPrintf("Digest finalize failed: %s", REASON()));
	    *errorCodePtr = EINVAL;

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

487
488
489
490
491
492
493
 *
 *----------------------------------------------------------------------
 */
 int DigestOutputProc(ClientData clientData, const char *buf, int toWrite, int *errorCodePtr) {
    DigestState *statePtr = (DigestState *) clientData;
    *errorCodePtr = 0;


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

    /* Update hash function */
    if (toWrite > 0 && !Tls_DigestUpdate(statePtr, buf, (size_t) toWrite)) {
	Tcl_SetChannelError(statePtr->self, Tcl_ObjPrintf("Digest update failed: %s", REASON()));







>







478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
 *
 *----------------------------------------------------------------------
 */
 int DigestOutputProc(ClientData clientData, const char *buf, int toWrite, int *errorCodePtr) {
    DigestState *statePtr = (DigestState *) clientData;
    *errorCodePtr = 0;

    /* Abort if nothing to process */
    if (toWrite <= 0 || statePtr->self == (Tcl_Channel) NULL) {
	return 0;
    }

    /* Update hash function */
    if (toWrite > 0 && !Tls_DigestUpdate(statePtr, buf, (size_t) toWrite)) {
	Tcl_SetChannelError(statePtr->self, Tcl_ObjPrintf("Digest update failed: %s", REASON()));
515
516
517
518
519
520
521

522
523
524
525
526
527
528
 */
static int DigestSetOptionProc(ClientData clientData, Tcl_Interp *interp, const char *optionName,
	const char *optionValue) {
    DigestState *statePtr = (DigestState *) clientData;
    Tcl_Channel parent;
    Tcl_DriverSetOptionProc *setOptionProc;


    if (statePtr->self == (Tcl_Channel) NULL) {
	return TCL_ERROR;
    }

    /* Delegate options downstream */
    parent = Tcl_GetStackedChannel(statePtr->self);
    setOptionProc = Tcl_ChannelSetOptionProc(Tcl_GetChannelType(parent));







>







514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
 */
static int DigestSetOptionProc(ClientData clientData, Tcl_Interp *interp, const char *optionName,
	const char *optionValue) {
    DigestState *statePtr = (DigestState *) clientData;
    Tcl_Channel parent;
    Tcl_DriverSetOptionProc *setOptionProc;

    /* Abort if no channel */
    if (statePtr->self == (Tcl_Channel) NULL) {
	return TCL_ERROR;
    }

    /* Delegate options downstream */
    parent = Tcl_GetStackedChannel(statePtr->self);
    setOptionProc = Tcl_ChannelSetOptionProc(Tcl_GetChannelType(parent));
552
553
554
555
556
557
558

559
560
561
562
563
564
565
 */
static int DigestGetOptionProc(ClientData clientData, Tcl_Interp *interp, const char *optionName,
	Tcl_DString *optionValue) {
    DigestState *statePtr = (DigestState *) clientData;
    Tcl_Channel parent;
    Tcl_DriverGetOptionProc *getOptionProc;


    if (statePtr->self == (Tcl_Channel) NULL) {
	return TCL_ERROR;
    }

    /* Delegate options downstream */
    parent = Tcl_GetStackedChannel(statePtr->self);
    getOptionProc = Tcl_ChannelGetOptionProc(Tcl_GetChannelType(parent));







>







552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
 */
static int DigestGetOptionProc(ClientData clientData, Tcl_Interp *interp, const char *optionName,
	Tcl_DString *optionValue) {
    DigestState *statePtr = (DigestState *) clientData;
    Tcl_Channel parent;
    Tcl_DriverGetOptionProc *getOptionProc;

    /* Abort if no channel */
    if (statePtr->self == (Tcl_Channel) NULL) {
	return TCL_ERROR;
    }

    /* Delegate options downstream */
    parent = Tcl_GetStackedChannel(statePtr->self);
    getOptionProc = Tcl_ChannelGetOptionProc(Tcl_GetChannelType(parent));
588
589
590
591
592
593
594

595
596
597
598
599
600
601
 *	May call Tcl_NotifyChannel
 *
 *----------------------------------------------------------------------
 */
static void DigestTimerHandler(ClientData clientData) {
    DigestState *statePtr = (DigestState *) clientData;


    if (statePtr->self == (Tcl_Channel) NULL) {
	return;
    }

    /* Clear timer token */
    statePtr->timer = (Tcl_TimerToken) NULL;








>







589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
 *	May call Tcl_NotifyChannel
 *
 *----------------------------------------------------------------------
 */
static void DigestTimerHandler(ClientData clientData) {
    DigestState *statePtr = (DigestState *) clientData;

    /* Abort if no channel */
    if (statePtr->self == (Tcl_Channel) NULL) {
	return;
    }

    /* Clear timer token */
    statePtr->timer = (Tcl_TimerToken) NULL;

609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628

629
630
631
632
633
634
635
 *----------------------------------------------------------------------
 *
 * DigestWatchProc --
 *
 *	Initialize the notifier to watch for events from this channel.
 *
 * Returns:
 *	Nothing
 *
 * Side effects:
 *	Configure notifier so future events on the channel will be seen by Tcl.
 *
 *----------------------------------------------------------------------
 */
#define READ_DELAY	5
void DigestWatchProc(ClientData clientData, int mask) {
    DigestState *statePtr = (DigestState *) clientData;
    Tcl_Channel parent;
    Tcl_DriverWatchProc *watchProc;


    if (statePtr->self == (Tcl_Channel) NULL) {
	return;
    }

    /* Store OR-ed combination of TCL_READABLE, TCL_WRITABLE and TCL_EXCEPTION */
    statePtr->watchMask = mask;








|












>







611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
 *----------------------------------------------------------------------
 *
 * DigestWatchProc --
 *
 *	Initialize the notifier to watch for events from this channel.
 *
 * Returns:
 *	Nothing (can't return error messages)
 *
 * Side effects:
 *	Configure notifier so future events on the channel will be seen by Tcl.
 *
 *----------------------------------------------------------------------
 */
#define READ_DELAY	5
void DigestWatchProc(ClientData clientData, int mask) {
    DigestState *statePtr = (DigestState *) clientData;
    Tcl_Channel parent;
    Tcl_DriverWatchProc *watchProc;

    /* Abort if no channel */
    if (statePtr->self == (Tcl_Channel) NULL) {
	return;
    }

    /* Store OR-ed combination of TCL_READABLE, TCL_WRITABLE and TCL_EXCEPTION */
    statePtr->watchMask = mask;

666
667
668
669
670
671
672

673

674
675
676

677

678
679
680
681
682
683
684
 * Side effects:
 *	None
 *
 *----------------------------------------------------------------------
 */
int DigestGetHandleProc(ClientData clientData, int direction, ClientData *handlePtr) {
    DigestState *statePtr = (DigestState *) clientData;



    if (statePtr->self == (Tcl_Channel) NULL) {
	return TCL_ERROR;
    }

    return Tcl_GetChannelHandle(Tcl_GetStackedChannel(statePtr->self), direction, handlePtr);

}

/*
 *----------------------------------------------------------------------
 *
 * DigestNotifyProc --
 *







>

>



>
|
>







669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
 * Side effects:
 *	None
 *
 *----------------------------------------------------------------------
 */
int DigestGetHandleProc(ClientData clientData, int direction, ClientData *handlePtr) {
    DigestState *statePtr = (DigestState *) clientData;
    Tcl_Channel parent;

    /* Abort if no channel */
    if (statePtr->self == (Tcl_Channel) NULL) {
	return TCL_ERROR;
    }

    parent = Tcl_GetStackedChannel(statePtr->self);
    return Tcl_GetChannelHandle(parent, direction, handlePtr);
}

/*
 *----------------------------------------------------------------------
 *
 * DigestNotifyProc --
 *
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
 *
 *	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
Tls_DigestChannel(Tcl_Interp *interp, const char *channel, const EVP_MD *md, int format,
	Tcl_Obj *keyObj) {
    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 struct */
    if ((statePtr = Tls_DigestNew(interp, format)) == NULL) {
	Tcl_AppendResult(interp, "Initialize digest error: memory allocation failure", (char *) NULL);
	return TCL_ERROR;
    }
    statePtr->self = chan;
    statePtr->mode = mode;








|









<
<






>








|







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
 *
 *	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 id or error message.
 *
 *----------------------------------------------------------------------
 */
static int
Tls_DigestChannel(Tcl_Interp *interp, const char *channel, const EVP_MD *md, int format,
	Tcl_Obj *keyObj) {
    int mode; /* OR-ed combination of TCL_READABLE and TCL_WRITABLE */
    Tcl_Channel chan;
    DigestState *statePtr;



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

    /* Get channel Id */
    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 state data struct */
    if ((statePtr = Tls_DigestNew(interp, format)) == NULL) {
	Tcl_AppendResult(interp, "Initialize digest error: memory allocation failure", (char *) NULL);
	return TCL_ERROR;
    }
    statePtr->self = chan;
    statePtr->mode = mode;

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
816
817
818

819
820
821
822
823
824
825
    /* Stack channel */
    statePtr->self = Tcl_StackChannel(interp, &digestChannelType, (ClientData) statePtr, mode, chan);
    if (statePtr->self == (Tcl_Channel) NULL) {
	Tls_DigestFree(statePtr);
	return TCL_ERROR;
    }


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

/*
 *----------------------------------------------------------------------
 *
 * Unstack Channel --
 *
 *	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.
 *
 *----------------------------------------------------------------------
 */
static int
UnstackObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    Tcl_Channel chan;
    int mode; /* OR-ed combination of TCL_READABLE and TCL_WRITABLE  */


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

    /* Get channel */
    chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], NULL), &mode);







>









|
|














>







793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
    /* Stack channel */
    statePtr->self = Tcl_StackChannel(interp, &digestChannelType, (ClientData) statePtr, mode, chan);
    if (statePtr->self == (Tcl_Channel) NULL) {
	Tls_DigestFree(statePtr);
	return TCL_ERROR;
    }

    /* Set result to channel Id */
    Tcl_SetResult(interp, (char *) Tcl_GetChannelName(chan), TCL_VOLATILE);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Unstack Channel --
 *
 *	This function removes the stacked channel from the top of the
 *	channel stack if it is a digest channel.
 *
 * Returns:
 *	TCL_OK or TCL_ERROR
 *
 * Side effects:
 *	Removes transform from channel or sets result to error message.
 *
 *----------------------------------------------------------------------
 */
static int
UnstackObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    Tcl_Channel chan;
    int mode; /* OR-ed combination of TCL_READABLE and TCL_WRITABLE  */

    /* Validate arg count */
    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "channel");
	return TCL_ERROR;
    }

    /* Get channel */
    chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], NULL), &mode);
834
835
836
837
838
839
840
841
842
843
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
    if (Tcl_GetChannelType(chan) != &digestChannelType) {
	Tcl_AppendResult(interp, "bad channel \"", Tcl_GetChannelName(chan),
	    "\": not a digest channel", NULL);
	Tcl_SetErrorCode(interp, "TLS", "UNSTACK", "CHANNEL", "INVALID", (char *) NULL);
	return TCL_ERROR;
    }

    /* Pop transform from channel, leaves error info in interp result */
    if (Tcl_UnstackChannel(interp, chan) == TCL_ERROR) {
	return TCL_ERROR;
    }
    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;
    }

    /* 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 */







|
|
<
<
<












|
>














>





|






|







>







842
843
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
    if (Tcl_GetChannelType(chan) != &digestChannelType) {
	Tcl_AppendResult(interp, "bad channel \"", Tcl_GetChannelName(chan),
	    "\": not a digest channel", NULL);
	Tcl_SetErrorCode(interp, "TLS", "UNSTACK", "CHANNEL", "INVALID", (char *) NULL);
	return TCL_ERROR;
    }

    /* Pop transform from channel */
    return Tcl_UnstackChannel(interp, chan);



    	clientData = clientData;
}

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

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

/*
 *-------------------------------------------------------------------
 *
 * InstanceObjCmd --
 *
 *	Handler for digest command instances. Used to add data to hash
 *	function or retrieve message digest.
 *
 * 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;

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

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

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

	/* Update hash function */
	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 */
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
 *-------------------------------------------------------------------
 */
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) {







|







953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
 *-------------------------------------------------------------------
 */
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 state data 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) {
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
999
1000
1001
1002
1003
1004
/*******************************************************************/

/*
 *-------------------------------------------------------------------
 *
 * 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
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) {
	Tcl_WrongNumArgs(interp, 1, objv, "data");
	return TCL_ERROR;
    }

    /* Get data */
    data = Tcl_GetByteArrayFromObj(objv[1], &len);







|

















>







981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
/*******************************************************************/

/*
 *-------------------------------------------------------------------
 *
 * Tls_DigestData --
 *
 *	Return message digest for data using user specified hash function.
 *
 * Returns:
 *	TCL_OK or TCL_ERROR
 *
 * Side effects:
 *	Sets result to message digest or error message
 *
 *-------------------------------------------------------------------
 */
int
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];

    /* Validate arg count */
    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "data");
	return TCL_ERROR;
    }

    /* Get data */
    data = Tcl_GetByteArrayFromObj(objv[1], &len);
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071

1072
1073

1074
1075
1076
1077
1078
1079
1080
 * 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_ERROR;
    const char *digestname, *channel = 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 | -command cmdName | -file filename | ?-data? data]");
	return TCL_ERROR;
    }

    /* Get digest */
    digestname = Tcl_GetStringFromObj(objv[1], &len);







|


<


>


>







1068
1069
1070
1071
1072
1073
1074
1075
1076
1077

1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
 * 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, res = TCL_OK;
    const char *digestname, *channel = NULL;
    Tcl_Obj *cmdObj = NULL, *dataObj = NULL, *fileObj = NULL, *keyObj = NULL;

    const EVP_MD *md;

    /* Clear interp result */
    Tcl_ResetResult(interp);

    /* Validate arg count */
    if (objc < 3 || objc > 7) {
	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);
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
	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, -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 = Tls_DigestFile(interp, fileObj, md, format, keyObj);
    } else if (channel != NULL) {
	res = Tls_DigestChannel(interp, channel, md, format, keyObj);
    } else if (cmdObj != NULL) {
	res = Tls_DigestInstance(interp, cmdObj, md, format, keyObj);
    } else if (dataObj != NULL) {







|

>





<



>













|







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
	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);

	OPTSTR("-chan", channel);
	OPTSTR("-channel", channel);
	OPTOBJ("-command", cmdObj);
	OPTOBJ("-data", dataObj);
	OPTOBJ("-file", fileObj);
	OPTOBJ("-filename", fileObj);
	OPTOBJ("-key", keyObj);

	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, using instance command, or data blob */
    if (fileObj != NULL) {
	res = Tls_DigestFile(interp, fileObj, md, format, keyObj);
    } else if (channel != NULL) {
	res = Tls_DigestChannel(interp, channel, md, format, keyObj);
    } else if (cmdObj != NULL) {
	res = Tls_DigestInstance(interp, cmdObj, md, format, keyObj);
    } else if (dataObj != NULL) {