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
|
*/
#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 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));
/*
* 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->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 --
*
|
|
|
|
|
|
|
|
|
<
<
<
|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
|
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
|
*/
#include "tlsInt.h"
/*
* Forward declarations
*/
static int TlsBlockModeProc (ClientData instanceData, int mode);
static int TlsCloseProc (ClientData instanceData, Tcl_Interp *interp);
static int TlsInputProc (ClientData instanceData, char *buf, int bufSize, int *errorCodePtr);
static int TlsOutputProc (ClientData instanceData, const char *buf, int toWrite, int *errorCodePtr);
static int TlsGetOptionProc (ClientData instanceData, Tcl_Interp *interp, const char *optionName, Tcl_DString *dsPtr);
static void TlsWatchProc (ClientData instanceData, int mask);
static int TlsGetHandleProc (ClientData instanceData, int direction, ClientData *handlePtr);
static int TlsNotifyProc (ClientData instanceData, int mask);
static void TlsChannelHandlerTimer (ClientData clientData);
/*
* TLS Channel Type
*/
static const Tcl_ChannelType tlsChannelType = {
"tls", /* typeName */
TCL_CHANNEL_VERSION_5, /* version */
TlsCloseProc, /* closeProc */
TlsInputProc, /* inputProc */
TlsOutputProc, /* outputProc */
0, /* seekProc */
0, /* setOptionProc */
TlsGetOptionProc, /* getOptionProc */
TlsWatchProc, /* watchProc */
TlsGetHandleProc, /* getHandleProc */
NULL, /* close2Proc */
TlsBlockModeProc, /* blockModeProc */
0, /* flushProc */
TlsNotifyProc /* handlerProc */
};
/*
*-------------------------------------------------------------------
*
* Tls_ChannelType --
*
* Return the correct TLS channel driver info
*
* Results:
* The correct channel driver for the current version of Tcl.
*
* Side effects:
* None.
*
*-------------------------------------------------------------------
*/
const Tcl_ChannelType *Tls_ChannelType(void) {
return &tlsChannelType;
}
/*
*-------------------------------------------------------------------
*
* TlsBlockModeProc --
*
|
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
|
*
* Side effects:
* Writes output on the output device of the channel.
*
*-------------------------------------------------------------------
*/
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;
|
|
|
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
|
*
* Side effects:
* Writes output on the output device of the channel.
*
*-------------------------------------------------------------------
*/
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;
|
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
|
* None.
*
*-------------------------------------------------------------------
*/
static int
TlsGetOptionProc(ClientData instanceData, /* Socket state. */
Tcl_Interp *interp, /* For errors - can be NULL. */
CONST84 char *optionName, /* Name of the option to
* retrieve the value for, or
* NULL to get all options and
* their values. */
Tcl_DString *dsPtr) /* Where to store the computed value
* initialized by caller. */
{
State *statePtr = (State *) instanceData;
|
|
|
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
|
* None.
*
*-------------------------------------------------------------------
*/
static int
TlsGetOptionProc(ClientData instanceData, /* Socket state. */
Tcl_Interp *interp, /* For errors - can be NULL. */
const char *optionName, /* Name of the option to
* retrieve the value for, or
* NULL to get all options and
* their values. */
Tcl_DString *dsPtr) /* Where to store the computed value
* initialized by caller. */
{
State *statePtr = (State *) instanceData;
|
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
|
* 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;
}
dprintFlags(statePtr);
|
|
|
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
|
* 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;
}
dprintFlags(statePtr);
|
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
|
*
* TlsGetHandleProc --
*
* Called from Tcl_GetChannelFile to retrieve o/s file handler
* from the SSL socket based channel.
*
* Results:
* The appropriate Tcl_File or NULL if not present.
*
* Side effects:
* None.
*
*-------------------------------------------------------------------
*/
static int TlsGetHandleProc(ClientData instanceData, int direction, ClientData *handlePtr) {
|
|
|
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
|
*
* TlsGetHandleProc --
*
* Called from Tcl_GetChannelFile to retrieve o/s file handler
* from the SSL socket based channel.
*
* Results:
* The appropriate Tcl_File or NULL if not present.
*
* Side effects:
* None.
*
*-------------------------------------------------------------------
*/
static int TlsGetHandleProc(ClientData instanceData, int direction, ClientData *handlePtr) {
|
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
|
* Notify the upper channel of the current BIO state so the event
* continues to propagate up the chain.
*
* stanton: It looks like this could result in an infinite loop if
* the upper channel doesn't cause ChannelHandler to be removed
* before Tcl_NotifyChannel calls channel handlers on the lower channel.
*/
Tcl_NotifyChannel(statePtr->self, mask);
if (statePtr->timer != (Tcl_TimerToken)NULL) {
Tcl_DeleteTimerHandler(statePtr->timer);
statePtr->timer = (Tcl_TimerToken)NULL;
}
if ((mask & TCL_READABLE) && Tcl_InputBuffered(statePtr->self) > 0) {
/*
* Data is waiting, flush it out in short time
|
|
|
|
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
|
* Notify the upper channel of the current BIO state so the event
* continues to propagate up the chain.
*
* stanton: It looks like this could result in an infinite loop if
* the upper channel doesn't cause ChannelHandler to be removed
* before Tcl_NotifyChannel calls channel handlers on the lower channel.
*/
Tcl_NotifyChannel(statePtr->self, mask);
if (statePtr->timer != (Tcl_TimerToken)NULL) {
Tcl_DeleteTimerHandler(statePtr->timer);
statePtr->timer = (Tcl_TimerToken)NULL;
}
if ((mask & TCL_READABLE) && Tcl_InputBuffered(statePtr->self) > 0) {
/*
* Data is waiting, flush it out in short time
|