Diff

Differences From Artifact [fb9115a376]:

To Artifact [106287680c]:


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
18
19
20
21
22
23
24













25
26
27
28
29
30
31











































































32
33
34
35
36
37
38







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






-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







 */

#include "tlsInt.h"

/*
 * Forward declarations
 */
static int  TlsBlockModeProc _ANSI_ARGS_((ClientData instanceData, int mode));
static int  TlsCloseProc _ANSI_ARGS_((ClientData instanceData, Tcl_Interp *interp));
static int  TlsInputProc _ANSI_ARGS_((ClientData instanceData, char *buf, int bufSize, int *errorCodePtr));
static int  TlsOutputProc _ANSI_ARGS_((ClientData instanceData, CONST char *buf, int toWrite, int *errorCodePtr));
static int  TlsGetOptionProc _ANSI_ARGS_((ClientData instanceData, Tcl_Interp *interp, CONST84 char *optionName, Tcl_DString *dsPtr));
static int  TlsSetOptionProc _ANSI_ARGS_((ClientData instanceData, Tcl_Interp *interp, CONST84 char *optionName, CONST84 char *optionValue));
static void TlsWatchProc _ANSI_ARGS_((ClientData instanceData, int mask));
static int  TlsGetHandleProc _ANSI_ARGS_((ClientData instanceData, int direction, ClientData *handlePtr));
static int  TlsNotifyProc _ANSI_ARGS_((ClientData instanceData, int mask));
#if 0
static void TlsChannelHandler _ANSI_ARGS_((ClientData clientData, int mask));
#endif
static void TlsChannelHandlerTimer _ANSI_ARGS_((ClientData clientData));
static void TlsChannelHandlerTimer(ClientData clientData);

/*
 * TLS Channel Type
 */
static Tcl_ChannelType *tlsChannelType = NULL;

/*
 *-------------------------------------------------------------------
 *
 * Tls_ChannelType --
 *
 *	Return the correct TLS channel driver info
 *
 * Results:
 *	The correct channel driver for the current version of Tcl.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------
 */
Tcl_ChannelType *Tls_ChannelType(void) {
	unsigned int size;

	/*
	 * Initialize the channel type if necessary
	 */
	if (tlsChannelType == NULL) {
		/*
		 * Allocation of a new channeltype structure is not easy, because of
		 * the various verson of the core and subsequent changes to the
		 * structure. The main challenge is to allocate enough memory for
		 * modern versions even if this extsension is compiled against one
		 * of the older variant!
		 *
		 * (1) Versions before stubs (8.0.x) are simple, because they are
		 *     supported only if the extension is compiled against exactly
		 *     that version of the core.
		 *
		 * (2) With stubs we just determine the difference between the older
		 *     and modern variant and overallocate accordingly if compiled
		 *     against an older variant.
		 */
		size = sizeof(Tcl_ChannelType); /* Base size */

		tlsChannelType = (Tcl_ChannelType *) ckalloc(size);
		memset((VOID *) tlsChannelType, 0, size);

		/*
		 * Common elements of the structure (no changes in location or name)
		 * close2Proc, seekProc, setOptionProc stay NULL.
		 */

		tlsChannelType->typeName	= "tls";
		tlsChannelType->closeProc	= TlsCloseProc;
		tlsChannelType->inputProc	= TlsInputProc;
		tlsChannelType->outputProc	= TlsOutputProc;
		tlsChannelType->getOptionProc	= TlsGetOptionProc;
		tlsChannelType->setOptionProc	= TlsSetOptionProc;
		tlsChannelType->watchProc	= TlsWatchProc;
		tlsChannelType->getHandleProc	= TlsGetHandleProc;

		/*
		 * Compiled against 8.3.2+. Direct access to all elements possible. Use
		 * channelTypeVersion information to select the values to use.
		 */

		/*
		 * For the 8.3.2 core we present ourselves as a version 2
		 * driver. This means a special value in version (ex
		 * blockModeProc), blockModeProc in a different place and of
		 * course usage of the handlerProc.
		 */
		tlsChannelType->version       = TCL_CHANNEL_VERSION_2;
		tlsChannelType->blockModeProc = TlsBlockModeProc;
		tlsChannelType->handlerProc   = TlsNotifyProc;
	}

	return(tlsChannelType);
}

/*
 *-------------------------------------------------------------------
 *
 * TlsBlockModeProc --
 *
 *	This procedure is invoked by the generic IO level
 *       to set blocking and nonblocking modes
165
166
167
168
169
170
171
172
173
174
175

176
177
178
179







180
181
182
183
184
185
186
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







-
-
-
-
+




+
+
+
+
+
+
+







static int TlsCloseProc(ClientData instanceData, Tcl_Interp *interp) {
	State *statePtr = (State *) instanceData;

	dprintf("TlsCloseProc(%p)", (void *) statePtr);

	Tls_Clean(statePtr);
	Tcl_EventuallyFree((ClientData)statePtr, Tls_Free);

	dprintf("Returning TCL_OK");

	return(TCL_OK);
	return(0);

	/* Interp is unused. */
	interp = interp;
}

static int TlsCloseProc2(ClientData instanceData, Tcl_Interp *interp, int flags) {
    if ((flags & (TCL_CLOSE_READ|TCL_CLOSE_WRITE)) == 0) {
	return TlsCloseProc(instanceData, interp);
    }
    return EINVAL;
}

/*
 *------------------------------------------------------*
 *
 *	Tls_WaitForConnect --
 *
 *	Sideeffects:
499
500
501
502
503
504
505
506

507
508
509
510
511
512
513
416
417
418
419
420
421
422

423
424
425
426
427
428
429
430







-
+







 *
 * Side effects:
 *	Writes output on the output device of the channel.
 *
 *-------------------------------------------------------------------
 */

static int TlsOutputProc(ClientData instanceData, CONST char *buf, int toWrite, int *errorCodePtr) {
static int TlsOutputProc(ClientData instanceData, const char *buf, int toWrite, int *errorCodePtr) {
	unsigned long backingError;
	State *statePtr = (State *) instanceData;
	int written, err;
	int tlsConnect;

	*errorCodePtr = 0;

625
626
627
628
629
630
631
632


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
542
543
544
545
546
547
548

549
550
551
552

553
554
555
556
557
558
559
560
561
562
563
564

565



566
567
568
569
570


571
572
573
574
575
576
577
578
579
580

581
582
583
584
585
586
587
588







-
+
+


-
+
+
+









-
+
-
-
-
+
+



-
-
+
+








-
+







}

/*
 *-------------------------------------------------------------------
 *
 * TlsSetOptionProc --
 *
 *	Sets an option value for a SSL socket based channel.
 *	Computes an option value for a SSL socket based channel, or a
 *	list of all options and their values.
 *
 * Results:
 *	A standard Tcl result.
 *	A standard Tcl result. The value of the specified option or a
 *	list of all options and	their values is returned in the
 *	supplied DString.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------
 */
static int
TlsSetOptionProc(ClientData instanceData,	/* Socket state. */
	Tcl_Interp *interp,		/* For errors - can be NULL. */
	CONST84 char *optionName,	/* Name of the option to
	const char *optionName,		/* Name of the option to set the value for, or
					 * set the value for, or
					 * NULL to get all options. */
	CONST84 char *optionValue)	/* Value for option. */
					 * NULL to get all options and their values. */
	const char *optionValue)	/* Value for option. */
{
    State *statePtr = (State *) instanceData;

    Tcl_Channel downChan = Tls_GetParent(statePtr, TLS_TCL_FASTPATH);
    Tcl_DriverSetOptionProc *setOptionProc;
   Tcl_Channel downChan = Tls_GetParent(statePtr, TLS_TCL_FASTPATH);
   Tcl_DriverSetOptionProc *setOptionProc;

    setOptionProc = Tcl_ChannelSetOptionProc(Tcl_GetChannelType(downChan));
    if (setOptionProc != NULL) {
	return (*setOptionProc)(Tcl_GetChannelInstanceData(downChan), interp, optionName, optionValue);
    } else if (optionName == (char*) NULL) {
	/*
	 * Request is query for all options, this is ok.
	 */
	return TCL_OK;
	 return TCL_OK;
    }
    /*
     * Request for a specific option has to fail, we don't have any.
     */
    return TCL_ERROR;
}

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
603
604
605
606
607
608
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







-
+
-
-
+
-





-
-
+
+



-
+

-
-
-
-
+
+
+
+







 *	None.
 *
 *-------------------------------------------------------------------
 */
static int
TlsGetOptionProc(ClientData instanceData,	/* Socket state. */
	Tcl_Interp *interp,		/* For errors - can be NULL. */
	CONST84 char *optionName,	/* Name of the option to
	const char *optionName,		/* Name of the option to retrieve the value for, or
					 * retrieve the value for, or
					 * NULL to get all options and
					 * NULL to get all options and their values. */
					 * their values. */
	Tcl_DString *dsPtr)		/* Where to store the computed value
					 * initialized by caller. */
{
    State *statePtr = (State *) instanceData;

    Tcl_Channel downChan = Tls_GetParent(statePtr, TLS_TCL_FASTPATH);
    Tcl_DriverGetOptionProc *getOptionProc;
   Tcl_Channel downChan = Tls_GetParent(statePtr, TLS_TCL_FASTPATH);
   Tcl_DriverGetOptionProc *getOptionProc;

    getOptionProc = Tcl_ChannelGetOptionProc(Tcl_GetChannelType(downChan));
    if (getOptionProc != NULL) {
        return (*getOptionProc)(Tcl_GetChannelInstanceData(downChan), interp, optionName, dsPtr);
	return (*getOptionProc)(Tcl_GetChannelInstanceData(downChan), interp, optionName, dsPtr);
    } else if (optionName == (char*) NULL) {
        /*
         * Request is query for all options, this is ok.
         */
         return TCL_OK;
	/*
	 * Request is query for all options, this is ok.
	 */
	 return TCL_OK;
    }
    /*
     * Request for a specific option has to fail, we don't have any.
     */
    return TCL_ERROR;
}

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







-
+
-
-
+









-
-
+
+







-
+






-
+













-
+








-
+






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







 *	will be seen by Tcl.
 *
 *-------------------------------------------------------------------
 */

static void
TlsWatchProc(ClientData instanceData,	/* The socket state. */
             int mask)			/* Events of interest; an OR-ed
	     int mask)			/* Events of interest; an OR-ed combination of */
                                         * combination of TCL_READABLE,
                                         * TCL_WRITABLE and TCL_EXCEPTION. */
					/* TCL_READABLE, TCL_WRITABLE and TCL_EXCEPTION. */
{
    Tcl_Channel     downChan;
    State *statePtr = (State *) instanceData;

    dprintf("TlsWatchProc(0x%x)", mask);

    /* Pretend to be dead as long as the verify callback is running. 
     * Otherwise that callback could be invoked recursively. */
    if (statePtr->flags & TLS_TCL_CALLBACK) {
        dprintf("Callback is on-going, doing nothing");
        return;
	dprintf("Callback is on-going, doing nothing");
	return;
    }

    dprintFlags(statePtr);

    downChan = Tls_GetParent(statePtr, TLS_TCL_FASTPATH);

    if (statePtr->flags & TLS_TCL_HANDSHAKE_FAILED) {
        dprintf("Asked to watch a socket with a failed handshake -- nothing can happen here");
	dprintf("Asked to watch a socket with a failed handshake -- nothing can happen here");

	dprintf("Unregistering interest in the lower channel");
	(Tcl_GetChannelType(downChan))->watchProc(Tcl_GetChannelInstanceData(downChan), 0);

	statePtr->watchMask = 0;

        return;
	return;
    }

    statePtr->watchMask = mask;

    /* No channel handlers any more. We will be notified automatically
     * about events on the channel below via a call to our
     * 'TransformNotifyProc'. But we have to pass the interest down now.
     * We are allowed to add additional 'interest' to the mask if we want
     * to. But this transformation has no such interest. It just passes
     * the request down, unchanged.
     */


	dprintf("Registering our interest in the lower channel (chan=%p)", (void *) downChan);
    dprintf("Registering our interest in the lower channel (chan=%p)", (void *) downChan);
    (Tcl_GetChannelType(downChan))
	->watchProc(Tcl_GetChannelInstanceData(downChan), mask);

    /*
     * Management of the internal timer.
     */

    if (statePtr->timer != (Tcl_TimerToken) NULL) {
	    dprintf("A timer was found, deleting it");
	dprintf("A timer was found, deleting it");
	Tcl_DeleteTimerHandler(statePtr->timer);
	statePtr->timer = (Tcl_TimerToken) NULL;
    }

    if ((mask & TCL_READABLE) &&
	((Tcl_InputBuffered(statePtr->self) > 0) || (BIO_ctrl_pending(statePtr->bio) > 0))) {
	/*
	 * There is interest in readable events and we actually have
	 * data waiting, so generate a timer to flush that.
	 */
	dprintf("Creating a new timer since data appears to be waiting");
	statePtr->timer = Tcl_CreateTimerHandler(TLS_TCL_DELAY, TlsChannelHandlerTimer, (ClientData) statePtr);
	    /*
	     * There is interest in readable events and we actually have
	     * data waiting, so generate a timer to flush that.
	     */
	    dprintf("Creating a new timer since data appears to be waiting");
	    statePtr->timer = Tcl_CreateTimerHandler(TLS_TCL_DELAY, TlsChannelHandlerTimer, (ClientData) statePtr);
    }
}

/*
 *-------------------------------------------------------------------
 *
 * TlsGetHandleProc --
902
903
904
905
906
907
908
909

910
911
912
913
914
915
916
917
918
919
818
819
820
821
822
823
824

825



826
827
828
829
830
831
832







-
+
-
-
-







 *      Result:
 *              None.
 *
 *------------------------------------------------------*
 */

static void
TlsChannelHandler (clientData, mask)
TlsChannelHandler (ClientData clientData, int mask) {
    ClientData     clientData;
    int            mask;
{
    State *statePtr = (State *) clientData;

    dprintf("HANDLER(0x%x)", mask);
    Tcl_Preserve( (ClientData)statePtr);

    if (mask & TCL_READABLE) {
	BIO_set_flags(statePtr->p_bio, BIO_FLAGS_READ);
1018
1019
1020
1021
1022
1023
1024



































































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
999
1000
1001
1002
1003
1004







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
	if ((statePtr->flags & ~maskFlags) & TLS_TCL_FASTPATH) {
		dprintf("Asked to get the parent channel while we are using FastPath -- returning NULL");
		return(NULL);
	}

	return(Tcl_GetStackedChannel(statePtr->self));
}

/*
 *-------------------------------------------------------------------
 *
 * Tls_ChannelType --
 *
 *	Return the correct TLS channel driver info
 *
 * Results:
 *	The correct channel driver for the current version of Tcl.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------
 */
Tcl_ChannelType *Tls_ChannelType(void) {
	unsigned int size;

	/*
	 * Initialize the channel type if necessary
	 */
	if (tlsChannelType == NULL) {
		/*
		 * Allocate new channeltype structure
		 */
		size = sizeof(Tcl_ChannelType); /* Base size */

		tlsChannelType = (Tcl_ChannelType *) ckalloc(size);
		memset((void *) tlsChannelType, 0, size);

		tlsChannelType->typeName	= "tls";
#ifdef TCL_CHANNEL_VERSION_5
		tlsChannelType->version		= TCL_CHANNEL_VERSION_5;
		tlsChannelType->closeProc	= TlsCloseProc;
		tlsChannelType->inputProc	= TlsInputProc;
		tlsChannelType->outputProc	= TlsOutputProc;
		tlsChannelType->seekProc	= NULL;
		tlsChannelType->setOptionProc	= TlsSetOptionProc;
		tlsChannelType->getOptionProc	= TlsGetOptionProc;
		tlsChannelType->watchProc	= TlsWatchProc;
		tlsChannelType->getHandleProc	= TlsGetHandleProc;
		tlsChannelType->close2Proc	= TlsCloseProc2;
		tlsChannelType->blockModeProc	= TlsBlockModeProc;
		tlsChannelType->flushProc	= NULL;
		tlsChannelType->handlerProc	= TlsNotifyProc;
		tlsChannelType->wideSeekProc	= NULL;
		tlsChannelType->threadActionProc= NULL;
		tlsChannelType->truncateProc	= NULL;
#else
		tlsChannelType->version		= TCL_CHANNEL_VERSION_2;
		tlsChannelType->closeProc	= TlsCloseProc;
		tlsChannelType->inputProc	= TlsInputProc;
		tlsChannelType->outputProc	= TlsOutputProc;
		tlsChannelType->seekProc	= NULL;
		tlsChannelType->setOptionProc	= TlsSetOptionProc;
		tlsChannelType->getOptionProc	= TlsGetOptionProc;
		tlsChannelType->watchProc	= TlsWatchProc;
		tlsChannelType->getHandleProc	= TlsGetHandleProc;
		tlsChannelType->close2Proc	= NULL;
		tlsChannelType->blockModeProc	= TlsBlockModeProc;
		tlsChannelType->flushProc	= NULL;
		tlsChannelType->handlerProc	= TlsNotifyProc;
#endif
	}
	return(tlsChannelType);
}