Diff

Differences From Artifact [18e864999a]:

To Artifact [ede520a139]:


33
34
35
36
37
38
39

40
41
42
43
44
45
46
47
48
/*
 *-------------------------------------------------------------------
 *
 * TlsBlockModeProc --
 *
 *    This procedure is invoked by the generic IO level
 *       to set blocking and nonblocking modes

 * Results:
 *    0 if successful, errno when failed.
 *
 * Side effects:
 *    Sets the device into blocking or nonblocking mode.
 *
 *-------------------------------------------------------------------
 */
static int TlsBlockModeProc(ClientData instanceData, int mode) {







>

|







33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
/*
 *-------------------------------------------------------------------
 *
 * TlsBlockModeProc --
 *
 *    This procedure is invoked by the generic IO level
 *       to set blocking and nonblocking modes
 *
 * Results:
 *    0 if successful or POSIX error code if failed.
 *
 * Side effects:
 *    Sets the device into blocking or nonblocking mode.
 *
 *-------------------------------------------------------------------
 */
static int TlsBlockModeProc(ClientData instanceData, int mode) {
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
 *    This procedure is invoked by the generic IO level to perform
 *    channel-type-specific cleanup when a SSL socket based channel
 *    is closed.
 *
 *    Note: we leave the underlying socket alone, is this right?
 *
 * Results:
 *    0 if successful, the value of Tcl_GetErrno() if failed.
 *
 * Side effects:
 *    Closes the socket of the channel.
 *
 *-------------------------------------------------------------------
 */
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);
    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 --
 *



 *    Side effects:
 *        Issues SSL_accept or SSL_connect
 *
 *    Result:
 *        None.
 *
 *------------------------------------------------------*
 */
int Tls_WaitForConnect(State *statePtr, int *errorCodePtr, int handshakeFailureIsPermanent) {
    unsigned long backingError;
    int err, rc;
    int bioShouldRetry;







|



















|
>
>
>
>
>
>
>









|

>
>
>
|
|
<
<
<







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
 *    This procedure is invoked by the generic IO level to perform
 *    channel-type-specific cleanup when a SSL socket based channel
 *    is closed.
 *
 *    Note: we leave the underlying socket alone, is this right?
 *
 * Results:
 *    0 if successful or POSIX error code if failed.
 *
 * Side effects:
 *    Closes the socket of the channel.
 *
 *-------------------------------------------------------------------
 */
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);
    return(0);

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

static int TlsCloseProc2(ClientData instanceData,    /* The socket state. */
    Tcl_Interp *interp,		/* For errors - can be NULL. */
    int flags)			/* Flags to close read and/or write side of channel */
{
    State *statePtr = (State *) instanceData;

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

    if ((flags & (TCL_CLOSE_READ|TCL_CLOSE_WRITE)) == 0) {
	return TlsCloseProc(instanceData, interp);
    }
    return EINVAL;
}

/*
 *------------------------------------------------------*
 *
 * Tls_WaitForConnect --
 *
 * Result:
 *    0 if successful, -1 if failed.
 *
 * Side effects:
 *    Issues SSL_accept or SSL_connect



 *
 *------------------------------------------------------*
 */
int Tls_WaitForConnect(State *statePtr, int *errorCodePtr, int handshakeFailureIsPermanent) {
    unsigned long backingError;
    int err, rc;
    int bioShouldRetry;
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
 *
 * TlsInputProc --
 *
 *    This procedure is invoked by the generic IO level
 *       to read input from a SSL socket based channel.
 *
 * Results:
 *    The number of bytes read is returned or -1 on error. An output
 *    argument contains the POSIX error code on error, or zero if no
 *    error occurred.
 *
 * Side effects:
 *    Reads input from the input device of the channel.
 *
 *-------------------------------------------------------------------
 */
static int TlsInputProc(ClientData instanceData, char *buf, int bufSize, int *errorCodePtr) {







|
|
<







283
284
285
286
287
288
289
290
291

292
293
294
295
296
297
298
 *
 * TlsInputProc --
 *
 *    This procedure is invoked by the generic IO level
 *       to read input from a SSL socket based channel.
 *
 * Results:
 *    Returns the number of bytes read or -1 on error. Sets errorCodePtr
 *    to a POSIX error code if an error occurred, or 0 if none.

 *
 * Side effects:
 *    Reads input from the input device of the channel.
 *
 *-------------------------------------------------------------------
 */
static int TlsInputProc(ClientData instanceData, char *buf, int bufSize, int *errorCodePtr) {
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
 *
 * TlsOutputProc --
 *
 *    This procedure is invoked by the generic IO level
 *       to write output to a SSL socket based channel.
 *
 * Results:
 *    The number of bytes written is returned. An output argument is
 *    set to a POSIX error code if an error occurred, or zero.
 *
 * Side effects:
 *    Writes output on the output device of the channel.
 *
 *-------------------------------------------------------------------
 */
static int TlsOutputProc(ClientData instanceData, const char *buf, int toWrite, int *errorCodePtr) {







|
|







416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
 *
 * TlsOutputProc --
 *
 *    This procedure is invoked by the generic IO level
 *       to write output to a SSL socket based channel.
 *
 * Results:
 *    Returns the number of bytes written or -1 on error. Sets errorCodePtr
 *    to a POSIX error code if an error occurred, or 0 if none.
 *
 * Side effects:
 *    Writes output on the output device of the channel.
 *
 *-------------------------------------------------------------------
 */
static int TlsOutputProc(ClientData instanceData, const char *buf, int toWrite, int *errorCodePtr) {
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
}

/*
 *-------------------------------------------------------------------
 *
 * TlsSetOptionProc --
 *
 *    Computes an option value for a SSL socket based channel, or a
 *    list of all options and their values.
 *
 * Results:
 *    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. */
    const char *optionName,	/* Name of the option to set the value for, or







|



<
<
|


|







559
560
561
562
563
564
565
566
567
568
569


570
571
572
573
574
575
576
577
578
579
580
}

/*
 *-------------------------------------------------------------------
 *
 * TlsSetOptionProc --
 *
 *    Sets an option value for a SSL socket based channel, or a
 *    list of all options and their values.
 *
 * Results:


 *    TCL_OK if successful or TCL_ERROR if failed.
 *
 * Side effects:
 *    Updates channel option to new value.
 *
 *-------------------------------------------------------------------
 */
static int
TlsSetOptionProc(ClientData instanceData,    /* Socket state. */
    Tcl_Interp *interp,		/* For errors - can be NULL. */
    const char *optionName,	/* Name of the option to set the value for, or
589
590
591
592
593
594
595
596
597
598
599
600
601
602
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
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
	 * 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;
}

/*
 *-------------------------------------------------------------------
 *
 * TlsGetOptionProc --
 *
 *    Computes an option value for a SSL socket based channel, or a
 *    list of all options and their values.
 *
 * Results:
 *    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
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;

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

/*
 *-------------------------------------------------------------------
 *
 * TlsWatchProc --
 *
 *    Initialize the notifier to watch Tcl_Files from this channel.
 *
 * Results:
 *    None.
 *
 * Side effects:
 *    Sets up the notifier so that a future event on the channel
 *    will be seen by Tcl.
 *
 *-------------------------------------------------------------------
 */
static void
TlsWatchProc(ClientData instanceData,    /* The socket state. */
    int mask)		/* Events of interest; an OR-ed combination of
			* 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.







|







|




|












|








|









|




















|
|







594
595
596
597
598
599
600
601
602
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
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
	 * 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_BadChannelOption(interp, optionName, "");
}

/*
 *-------------------------------------------------------------------
 *
 * TlsGetOptionProc --
 *
 *    Gets an option value for a SSL socket based channel, or a
 *    list of all options and their values.
 *
 * Results:
 *    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
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 *optionValue)	/* 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;

    getOptionProc = Tcl_ChannelGetOptionProc(Tcl_GetChannelType(downChan));
    if (getOptionProc != NULL) {
	return (*getOptionProc)(Tcl_GetChannelInstanceData(downChan), interp, optionName, optionValue);
    } 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_BadChannelOption(interp, optionName, "");
}

/*
 *-------------------------------------------------------------------
 *
 * TlsWatchProc --
 *
 *    Initialize the notifier to watch Tcl_Files from this channel.
 *
 * Results:
 *    None.
 *
 * Side effects:
 *    Sets up the notifier so that a future event on the channel
 *    will be seen by Tcl.
 *
 *-------------------------------------------------------------------
 */
static void
TlsWatchProc(ClientData instanceData,    /* The socket state. */
    int mask)			/* Events of interest; an OR-ed combination of
				 * 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.
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
752
753
754
755
756
757
758
759
760



761
762
763
764
765
766
767
	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);
    }
}

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



    State *statePtr = (State *) instanceData;

    return(Tcl_GetChannelHandle(Tls_GetParent(statePtr, TLS_TCL_FASTPATH), direction, handlePtr));
}

/*
 *-------------------------------------------------------------------
 *
 * TlsNotifyProc --
 *
 *    Handler called by Tcl to inform us of activity
 *    on the underlying channel.
 *
 * Results:
 *    None.
 *
 * Side effects:
 *    May process the incoming event by itself.
 *
 *-------------------------------------------------------------------
 */
static int TlsNotifyProc(ClientData instanceData, int mask) {



    State *statePtr = (State *) instanceData;
    int errorCode;

    /*
     * An event occurred in the underlying channel.  This
     * transformation doesn't process such events thus returns the
     * incoming mask unchanged.







|
|
|
|
|
|












|






|
>
>
>














|






|
>
>
>







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

/*
 *-------------------------------------------------------------------
 *
 * TlsGetHandleProc --
 *
 *    Called from Tcl_GetChannelFile to retrieve o/s file handler
 *    from the SSL socket based channel.
 *
 * Results:
 *    The appropriate Tcl_File handle or NULL if none.
 *
 * Side effects:
 *    None.
 *
 *-------------------------------------------------------------------
 */
static int TlsGetHandleProc(ClientData instanceData,    /* Socket state. */
    int direction,		/* TCL_READABLE or TCL_WRITABLE */
    ClientData *handlePtr)	/* Handle associated with the channel */
{
    State *statePtr = (State *) instanceData;

    return(Tcl_GetChannelHandle(Tls_GetParent(statePtr, TLS_TCL_FASTPATH), direction, handlePtr));
}

/*
 *-------------------------------------------------------------------
 *
 * TlsNotifyProc --
 *
 *    Handler called by Tcl to inform us of activity
 *    on the underlying channel.
 *
 * Results:
 *    Type of event or 0 if failed
 *
 * Side effects:
 *    May process the incoming event by itself.
 *
 *-------------------------------------------------------------------
 */
static int TlsNotifyProc(ClientData instanceData,    /* Socket state. */
    int mask)			/* type of event that occurred:
				 * OR-ed combination of TCL_READABLE or TCL_WRITABLE */
{
    State *statePtr = (State *) instanceData;
    int errorCode;

    /*
     * An event occurred in the underlying channel.  This
     * transformation doesn't process such events thus returns the
     * incoming mask unchanged.
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
 *
 *      Result:
 *              None.
 *
 *------------------------------------------------------*
 */
static void
TlsChannelHandler (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);







|







830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
 *
 *      Result:
 *              None.
 *
 *------------------------------------------------------*
 */
static void
TlsChannelHandler(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);