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
|
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
|
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
static void ChannelHandler _ANSI_ARGS_ ((ClientData clientData, int mask));
static void ChannelHandlerTimer _ANSI_ARGS_ ((ClientData clientData));
/*
* This structure describes the channel type structure for TCP socket
* based IO:
*/
#ifdef TCL_CHANNEL_VERSION_2
static Tcl_ChannelType tlsChannelType = {
"tls", /* Type name. */
TCL_CHANNEL_VERSION_2, /* A NG channel */
CloseProc, /* Close proc. */
InputProc, /* Input proc. */
OutputProc, /* Output proc. */
NULL, /* Seek proc. */
NULL, /* Set option proc. */
GetOptionProc, /* Get option proc. */
WatchProc, /* Initialize notifier. */
GetHandleProc, /* Get file handle out of channel. */
NULL, /* Close2Proc. */
BlockModeProc, /* Set blocking/nonblocking mode.*/
NULL, /* FlushProc. */
NULL, /* handlerProc. */
};
#else
static Tcl_ChannelType tlsChannelType = {
"tls", /* Type name. */
BlockModeProc, /* Set blocking/nonblocking mode.*/
CloseProc, /* Close proc. */
InputProc, /* Input proc. */
OutputProc, /* Output proc. */
NULL, /* Seek proc. */
NULL, /* Set option proc. */
GetOptionProc, /* Get option proc. */
WatchProc, /* Initialize notifier. */
GetHandleProc, /* Get file handle out of channel. */
};
#endif
Tcl_ChannelType *Tls_ChannelType()
{
return &tlsChannelType;
}
/*
|
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
|
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
|
+
+
+
+
|
State *statePtr = (State *) instanceData;
if (mode == TCL_MODE_NONBLOCKING) {
statePtr->flags |= TLS_TCL_ASYNC;
} else {
statePtr->flags &= ~(TLS_TCL_ASYNC);
}
#ifdef TCL_CHANNEL_VERSION_2
return 0;
#else
return Tcl_SetChannelOption(statePtr->interp, Tls_GetParent(statePtr),
"-blocking", (mode == TCL_MODE_NONBLOCKING) ? "0" : "1");
#endif
}
/*
*-------------------------------------------------------------------
*
* CloseProc --
*
|
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
|
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
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
406
407
408
409
|
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
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. */
{
#ifdef TCL_CHANNEL_VERSION_2
State *statePtr = (State *) instanceData;
Tcl_Channel downChan = Tls_GetParent(statePtr);
Tcl_DriverGetOptionProc *getOptionProc;
getOptionProc = Tcl_ChannelGetOptionProc(Tcl_GetChannelType(downChan));
if (getOptionProc != NULL) {
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 for a specific option has to fail, we don't have any.
*/
return TCL_ERROR;
#else
State *statePtr = (State *) instanceData;
size_t len = 0;
if (optionName != (char *) NULL) {
len = strlen(optionName);
}
#if 0
if ((len == 0) ||
((len > 1) && (optionName[1] == 'c') &&
(strncmp(optionName, "-cipher", len) == 0))) {
if (len == 0) {
Tcl_DStringAppendElement(dsPtr, "-cipher");
}
Tcl_DStringAppendElement(dsPtr, SSL_get_cipher(statePtr->ssl));
if (len) {
return TCL_OK;
}
}
#endif
return TCL_OK;
#endif
}
/*
*-------------------------------------------------------------------
*
* WatchProc --
*
|
620
621
622
623
624
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
|
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
|
+
+
+
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
+
|
}
}
Tcl_Channel
Tls_GetParent( statePtr )
State *statePtr;
{
#ifdef TCL_CHANNEL_VERSION_2
return Tcl_GetStackedChannel(statePtr->self);
#else
#if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION < 2
return statePtr->parent;
#else
/* The reason for the existence of this procedure is
* the fact that stacking a transform over another
* transform will leave our internal pointer unchanged,
* and thus pointing to the new transform, and not the
* Channel structure containing the saved state of this
* transform. This is the price to pay for leaving
* Tcl_Channel references intact. The only other solution
* is an extension of Tcl_ChannelType with another driver
* procedure to notify a Channel about the (un)stacking.
*
* It walks the chain of Channel structures until it
* finds the one pointing having 'ctrl' as instanceData
* and then returns the superceding channel to that. (AK)
*/
Tcl_Channel self = statePtr->self;
Tcl_Channel next;
Tcl_Channel self = statePtr->self;
Tcl_Channel next;
while ((ClientData) statePtr != Tcl_GetChannelInstanceData (self)) {
next = Tcl_GetStackedChannel (self);
if (next == (Tcl_Channel) NULL) {
/* 09/24/1999 Unstacking bug, found by Matt Newman <[email protected]>.
*
* We were unable to find the channel structure for this
* transformation in the chain of stacked channel. This
* means that we are currently in the process of unstacking
* it *and* there were some bytes waiting which are now
* flushed. In this situation the pointer to the channel
* itself already refers to the parent channel we have to
* write the bytes into, so we return that.
*/
return statePtr->self;
}
self = next;
}
while ((ClientData) statePtr != Tcl_GetChannelInstanceData (self)) {
next = Tcl_GetStackedChannel (self);
if (next == (Tcl_Channel) NULL) {
/* 09/24/1999 Unstacking bug,
* found by Matt Newman <[email protected]>.
*
* We were unable to find the channel structure for this
* transformation in the chain of stacked channel. This
* means that we are currently in the process of unstacking
* it *and* there were some bytes waiting which are now
* flushed. In this situation the pointer to the channel
* itself already refers to the parent channel we have to
* write the bytes into, so we return that.
*/
return statePtr->self;
}
self = next;
}
return Tcl_GetStackedChannel (self);
return Tcl_GetStackedChannel (self);
#endif
#endif
}
|