TclTLS
Diff
Login
HomeTimelineDownloadBrowse SourceBranchesTagsTicketsWiki
Annotate Patch Side-by-side Diff

Differences From Artifact [a1d0fac62c]:

To Artifact [ae2cba46b1]:

︙
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97

78
79
80
81
82
83
84






85
86
87
88
89
90
91








-
-
-
-
-
-








 * Static data structures
 */

#ifndef OPENSSL_NO_DH
#include "dh_params.h"
#endif

/*
 * Defined in Tls_Init to determine what kind of channels we are using
 * (old-style 8.2.0-8.3.1 or new-style 8.3.2+).
 */
int channelTypeVersion = TLS_CHANNEL_VERSION_2;

/*
 * We lose the tcl password callback when we use the RSA BSAFE SSL-C 1.1.2
 * libraries instead of the current OpenSSL libraries.
 */

#ifdef BSAFE
#define PRE_OPENSSL_0_9_4 1
︙
626
627
628
629
630
631
632
633
634
635
636
637





638
639
640
641
642
643
644
645

620
621
622
623
624
625
626





627
628
629
630
631

632
633
634
635
636
637
638








-
-
-
-
-
+
+
+
+
+
-








	return TCL_ERROR;
    }

    chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], NULL), NULL);
    if (chan == (Tcl_Channel) NULL) {
	return TCL_ERROR;
    }
    if (channelTypeVersion == TLS_CHANNEL_VERSION_2) {
	/*
	 * Make sure to operate on the topmost channel
	 */
	chan = Tcl_GetTopChannel(chan);

    /*
     * Make sure to operate on the topmost channel
     */
    chan = Tcl_GetTopChannel(chan);
    }
    if (Tcl_GetChannelType(chan) != Tls_ChannelType()) {
	Tcl_AppendResult(interp, "bad channel \"", Tcl_GetChannelName(chan),
		"\": not a TLS channel", NULL);
	return TCL_ERROR;
    }
    statePtr = (State *)Tcl_GetChannelInstanceData(chan);
︙
749
750
751
752
753
754
755
756
757
758
759
760





761
762
763
764
765
766
767
768

742
743
744
745
746
747
748





749
750
751
752
753

754
755
756
757
758
759
760








-
-
-
-
-
+
+
+
+
+
-








	return TCL_ERROR;
    }

    chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], NULL), NULL);
    if (chan == (Tcl_Channel) NULL) {
	return TCL_ERROR;
    }
    if (channelTypeVersion == TLS_CHANNEL_VERSION_2) {
	/*
	 * Make sure to operate on the topmost channel
	 */
	chan = Tcl_GetTopChannel(chan);

    /*
     * Make sure to operate on the topmost channel
     */
    chan = Tcl_GetTopChannel(chan);
    }

    for (idx = 2; idx < objc; idx++) {
	char *opt = Tcl_GetStringFromObj(objv[idx], NULL);

	if (opt[0] != '-')
	    break;
︙
841
842
843
844
845
846
847
848
849
850
851
852





853
854
855
856
857
858
859
860

833
834
835
836
837
838
839





840
841
842
843
844

845
846
847
848
849
850
851








-
-
-
-
-
+
+
+
+
+
-








	int mode;
	/* Get the "model" context */
	chan = Tcl_GetChannel(interp, model, &mode);
	if (chan == (Tcl_Channel) NULL) {
	    Tls_Free((char *) statePtr);
	    return TCL_ERROR;
	}
	if (channelTypeVersion == TLS_CHANNEL_VERSION_2) {
	    /*
	     * Make sure to operate on the topmost channel
	     */
	    chan = Tcl_GetTopChannel(chan);

        /*
         * Make sure to operate on the topmost channel
         */
        chan = Tcl_GetTopChannel(chan);
	}
	if (Tcl_GetChannelType(chan) != Tls_ChannelType()) {
	    Tcl_AppendResult(interp, "bad channel \"",
		    Tcl_GetChannelName(chan), "\": not a TLS channel", NULL);
	    Tls_Free((char *) statePtr);
	    return TCL_ERROR;
	}
	ctx = ((State *)Tcl_GetChannelInstanceData(chan))->ctx;
︙
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

862
863
864
865
866
867
868






869






870
871
872
873
874
875
876








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








    /*
     * We need to make sure that the channel works in binary (for the
     * encryption not to get goofed up).
     * We only want to adjust the buffering in pre-v2 channels, where
     * each channel in the stack maintained its own buffers.
     */
    Tcl_SetChannelOption(interp, chan, "-translation", "binary");
    if (channelTypeVersion == TLS_CHANNEL_VERSION_1) {
	Tcl_SetChannelOption(interp, chan, "-buffering", "none");
    }

    if (channelTypeVersion == TLS_CHANNEL_VERSION_2) {
	statePtr->self = Tcl_StackChannel(interp, Tls_ChannelType(),
    statePtr->self = Tcl_StackChannel(interp, Tls_ChannelType(), (ClientData) statePtr, (TCL_READABLE | TCL_WRITABLE), chan);
		(ClientData) statePtr, (TCL_READABLE | TCL_WRITABLE), chan);
    } else {
	statePtr->self = chan;
	Tcl_StackChannel(interp, Tls_ChannelType(),
		(ClientData) statePtr, (TCL_READABLE | TCL_WRITABLE), chan);
    }
    if (statePtr->self == (Tcl_Channel) NULL) {
	/*
	 * No use of Tcl_EventuallyFree because no possible Tcl_Preserve.
	 */
	Tls_Free((char *) statePtr);
	return TCL_ERROR;
    }
︙
981
982
983
984
985
986
987
988
989
990
991
992




993
994
995
996
997
998
999
1000

961
962
963
964
965
966
967





968
969
970
971

972
973
974
975
976
977
978








-
-
-
-
-
+
+
+
+
-








    }

    chan = Tcl_GetChannel(interp, Tcl_GetString(objv[1]), NULL);
    if (chan == (Tcl_Channel) NULL) {
	return TCL_ERROR;
    }

    if (channelTypeVersion == TLS_CHANNEL_VERSION_2) {
	/*
	 * Make sure to operate on the topmost channel
	 */
	chan = Tcl_GetTopChannel(chan);
    /*
     * Make sure to operate on the topmost channel
     */
    chan = Tcl_GetTopChannel(chan);
    }

    if (Tcl_GetChannelType(chan) != Tls_ChannelType()) {
	Tcl_AppendResult(interp, "bad channel \"", Tcl_GetChannelName(chan),
		"\": not a TLS channel", NULL);
	return TCL_ERROR;
    }
︙
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313




1314
1315
1316
1317
1318
1319
1320
1321

1280
1281
1282
1283
1284
1285
1286





1287
1288
1289
1290

1291
1292
1293
1294
1295
1296
1297








-
-
-
-
-
+
+
+
+
-








	    return TCL_ERROR;
    }

    chan = Tcl_GetChannel(interp, channelName, &mode);
    if (chan == (Tcl_Channel) NULL) {
	return TCL_ERROR;
    }
    if (channelTypeVersion == TLS_CHANNEL_VERSION_2) {
	/*
	 * Make sure to operate on the topmost channel
	 */
	chan = Tcl_GetTopChannel(chan);
    /*
     * Make sure to operate on the topmost channel
     */
    chan = Tcl_GetTopChannel(chan);
    }
    if (Tcl_GetChannelType(chan) != Tls_ChannelType()) {
	Tcl_AppendResult(interp, "bad channel \"", Tcl_GetChannelName(chan),
		"\": not a TLS channel", NULL);
	return TCL_ERROR;
    }
    statePtr = (State *) Tcl_GetChannelInstanceData(chan);
    if (objc == 2) {
︙
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649

1650
1651
1652
1653

1654
1655

1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681

1682
1683
1684

1685
1686
1687

1688
1689
1690

1691
1692
1693

1694
1695
1696

1697
1698
1699

1700
1701
1702
1703
1704
1705
1706
1707

1615
1616
1617
1618
1619
1620
1621




1622
1623
1624
1625

1626
1627

1628
1629
1630
1631
1632
1633















1634
1635
1636
1637
1638

1639



1640



1641



1642



1643



1644



1645

1646
1647
1648
1649
1650
1651
1652








-
-
-
-
+



-
+

-
+





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





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








    const char tlsTclInitScript[] = {
#include "tls.tcl.h"
    };

    int major, minor, patchlevel, release;

    /*
     * The original 8.2.0 stacked channel implementation (and the patch
     * that preceded it) had problems with scalability and robustness.
     * These were address in 8.3.2 / 8.4a2, so we now require that as a
     * minimum for TLS 1.4+.  We only support 8.2+ now (8.3.2+ preferred).
     * We only support Tcl 8.4 or newer
     */
    if (
#ifdef USE_TCL_STUBS
	Tcl_InitStubs(interp, "8.2", 0)
	Tcl_InitStubs(interp, "8.4", 0)
#else
	Tcl_PkgRequire(interp, "Tcl", "8.2", 0)
	Tcl_PkgRequire(interp, "Tcl", "8.4", 0)
#endif
	== NULL) {
	return TCL_ERROR;
    }

    /*
     * Get the version so we can runtime switch on available functionality.
     * TLS should really only be used in 8.3.2+, but the other works for
     * some limited functionality, so an attempt at support is made.
     */
    Tcl_GetVersion(&major, &minor, &patchlevel, &release);
    if ((major > 8) || ((major == 8) && ((minor > 3) || ((minor == 3) &&
	    (release == TCL_FINAL_RELEASE) && (patchlevel >= 2))))) {
	/* 8.3.2+ */
	channelTypeVersion = TLS_CHANNEL_VERSION_2;
    } else {
	/* 8.2.0 - 8.3.1 */
	channelTypeVersion = TLS_CHANNEL_VERSION_1;
    }

    if (TlsLibInit() != TCL_OK) {
	Tcl_AppendResult(interp, "could not initialize SSL library", NULL);
	return TCL_ERROR;
    }

    Tcl_CreateObjCommand(interp, "tls::ciphers", CiphersObjCmd,
    Tcl_CreateObjCommand(interp, "tls::ciphers", CiphersObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);

    Tcl_CreateObjCommand(interp, "tls::handshake", HandshakeObjCmd,
    Tcl_CreateObjCommand(interp, "tls::handshake", HandshakeObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);

    Tcl_CreateObjCommand(interp, "tls::import", ImportObjCmd,
    Tcl_CreateObjCommand(interp, "tls::import", ImportObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);

    Tcl_CreateObjCommand(interp, "tls::unimport", UnimportObjCmd,
    Tcl_CreateObjCommand(interp, "tls::unimport", UnimportObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);

    Tcl_CreateObjCommand(interp, "tls::status", StatusObjCmd,
    Tcl_CreateObjCommand(interp, "tls::status", StatusObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);

    Tcl_CreateObjCommand(interp, "tls::version", VersionObjCmd,
    Tcl_CreateObjCommand(interp, "tls::version", VersionObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);

    Tcl_CreateObjCommand(interp, "tls::misc", MiscObjCmd,
    Tcl_CreateObjCommand(interp, "tls::misc", MiscObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);

    if (interp) {
        Tcl_Eval(interp, tlsTclInitScript);
    }

    return Tcl_PkgProvide(interp, "tls", PACKAGE_VERSION);
}
︙
Powered by Fossil · RSS