TclTLS
Check-in [ea8c67f798]
Login
HomeTimelineDownloadBrowse SourceBranchesTagsTicketsWiki
Overview
Comment:Merge trunk
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | bohagan
Files: files | file ages | folders
SHA3-256: ea8c67f798b9b71674f29ea664c47b87f826c2f6ca0dc309510a05bf4c941b34
User & Date: jan.nijtmans on 2024-02-23 15:08:47
Other Links: branch diff | manifest | tags
Context
2024-02-23
15:28
Merge-mark check-in: 7ef59c838a user: jan.nijtmans tags: bohagan
15:08
Merge trunk check-in: ea8c67f798 user: jan.nijtmans tags: bohagan
14:48
Merge "dh" branch from: [https://chiselapp.com/user/bohagan/repository/TCLTLS/timeline?r=dh]. The "gen_dh_params" script is no longer necessary check-in: 6aeb4fa6ee user: jan.nijtmans tags: nijtmans
13:21
Merge trunk check-in: c7b67bc013 user: jan.nijtmans tags: bohagan
Changes
Side-by-Side Diff Ignore Whitespace Patch
Modified .fossil-settings/ignore-glob from [053031e94a] to [b290d0ded2].
︙
15
16
17
18
19
20
21
22

15
16
17
18
19
20
21









-

tlsBIO.o
tlsIO.o
tlsX509.o
tls.tcl.h
tls.tcl.h.new.1
tls.tcl.h.new.2
build/work
dh_params.h
Deleted gen_dh_params version [c005dd2aeb].
Modified generic/tls.c from [d656aab335] to [c4917ab97f].
︙
443
444
445
446
447
448
449
450

451
452
453
454
455
456
457

443
444
445
446
447
448
449

450
451
452
453
454
455
456
457








-
+








    cmdPtr = Tcl_DuplicateObj(statePtr->callback);
    Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj("error", -1));
    Tcl_ListObjAppendElement(interp, cmdPtr,
	    Tcl_NewStringObj(Tcl_GetChannelName(statePtr->self), -1));
    if (msg != NULL) {
	Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(msg, -1));

    } else if ((msg = Tcl_GetStringFromObj(Tcl_GetObjResult(interp), (Tcl_Size *) NULL)) != NULL) {
    } else if ((msg = Tcl_GetString(Tcl_GetObjResult(interp))) != NULL) {
	Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(msg, -1));

    } else {
	listPtr = Tcl_NewListObj(0, NULL);
	while ((err = ERR_get_error()) != 0) {
	    Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj(ERR_reason_error_string(err), -1));
	}
︙
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935

918
919
920
921
922
923
924




925
926
927
928
929
930
931








-
-
-
-








	res = SSL_CLIENT_HELLO_ERROR;
	*alert = SSL_R_TLSV1_ALERT_INTERNAL_ERROR;
    }
    Tcl_DecrRefCount(cmdPtr);
    return res;
}

/********************/
/* Commands         */
/********************/

/*
 *-------------------------------------------------------------------
 *
 * CiphersObjCmd -- list available ciphers
 *
 *	This procedure is invoked to process the "tls::ciphers" command
 *	to list available ciphers, based upon protocol selected.
︙
985
986
987
988
989
990
991
992

993
994
995
996
997
998
999

981
982
983
984
985
986
987

988
989
990
991
992
993
994
995








-
+









    switch ((enum protocol)index) {
    case TLS_SSL2:
	Tcl_AppendResult(interp, protocols[index], ": protocol not supported", (char *)NULL);
	return TCL_ERROR;
    case TLS_SSL3:
#if defined(NO_SSL3) || defined(OPENSSL_NO_SSL3) || defined(OPENSSL_NO_SSL3_METHOD)
	Tcl_AppendResult(interp, protocols[index], ": protocol not supported", NULL);
	Tcl_AppendResult(interp, protocols[index], ": protocol not supported", (char *)NULL);
	return TCL_ERROR;
#else
	method = SSLv3_method(); break;
#endif
    case TLS_TLS1:
#if defined(NO_TLS1) || defined(OPENSSL_NO_TLS1) || defined(OPENSSL_NO_TLS1_METHOD)
	Tcl_AppendResult(interp, protocols[index], ": protocol not supported", (char *)NULL);
︙
1012
1013
1014
1015
1016
1017
1018
1019

1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045

1008
1009
1010
1011
1012
1013
1014

1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027

1028
1029
1030
1031
1032

1033
1034
1035
1036
1037
1038
1039








-
+












-





-








#if defined(NO_TLS1_2) || defined(OPENSSL_NO_TLS1_2) || defined(OPENSSL_NO_TLS1_2_METHOD)
	Tcl_AppendResult(interp, protocols[index], ": protocol not supported", (char *)NULL);
	return TCL_ERROR;
#else
	method = TLSv1_2_method(); break;
#endif
    case TLS_TLS1_3:
#if defined(NO_TLS1_3) || defined(OPENSSL_NO_TLS1_3)
#if defined(NO_TLS1_3) || defined(OPENSSL_NO_TLS1_3) || defined(OPENSSL_NO_TLS1_3_METHOD)
	Tcl_AppendResult(interp, protocols[index], ": protocol not supported", (char *)NULL);
	return TCL_ERROR;
#else
	method = TLS_method();
	SSL_CTX_set_min_proto_version(ctx, TLS1_3_VERSION);
	SSL_CTX_set_max_proto_version(ctx, TLS1_3_VERSION);
	break;
#endif
    default:
	method = TLS_method();
	break;
    }

    ctx = SSL_CTX_new(method);
    if (ctx == NULL) {
	Tcl_AppendResult(interp, GET_ERR_REASON(), (char *)NULL);
	return TCL_ERROR;
    }

    ssl = SSL_new(ctx);
    if (ssl == NULL) {
	Tcl_AppendResult(interp, GET_ERR_REASON(), (char *)NULL);
	SSL_CTX_free(ctx);
	return TCL_ERROR;
    }
︙
1824
1825
1826
1827
1828
1829
1830
1831

1832
1833
1834
1835
1836
1837
1838

1818
1819
1820
1821
1822
1823
1824

1825
1826
1827
1828
1829
1830
1831
1832








-
+








	break;
#endif
#if !defined(NO_TLS1_2) && !defined(OPENSSL_NO_TLS1_2) && !defined(OPENSSL_NO_TLS1_2_METHOD)
    case TLS_PROTO_TLS1_2:
	method = isServer ? TLSv1_2_server_method() : TLSv1_2_client_method();
	break;
#endif
#if !defined(NO_TLS1_3) && !defined(OPENSSL_NO_TLS1_3)
#if !defined(NO_TLS1_3) && !defined(OPENSSL_NO_TLS1_3) && !defined(OPENSSL_NO_TLS1_3_METHOD)
    case TLS_PROTO_TLS1_3:
	/* Use the generic method and constraint range after context is created */
	method = isServer ? TLS_server_method() : TLS_client_method();
	break;
#endif
    default:
	/* Negotiate highest available SSL/TLS version */
︙
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946

1926
1927
1928
1929
1930
1931
1932

1933
1934
1935
1936
1937
1938
1939








-








	    if (!dh) {
		Tcl_AppendResult(interp, "Could not read DH parameters from file", (char *)NULL);
		SSL_CTX_free(ctx);
		return NULL;
	    }
	    SSL_CTX_set_tmp_dh(ctx, dh);
	    DH_free(dh);

	} else {
	    /* Use well known DH parameters that have built-in support in OpenSSL */
	    if (!SSL_CTX_set_dh_auto(ctx, 1)) {
		Tcl_AppendResult(interp, "Could not enable set DH auto: ", GET_ERR_REASON(), (char *)NULL);
		SSL_CTX_free(ctx);
		return NULL;
	    }
︙
2014
2015
2016
2017
2018
2019
2020
2021
2022


2023
2024
2025
2026
2027
2028
2029

2007
2008
2009
2010
2011
2012
2013


2014
2015
2016
2017
2018
2019
2020
2021
2022








-
-
+
+








		return NULL;
	    }
	}
	/* Now we know that a key and cert have been set against
	 * the SSL context */
	if (!SSL_CTX_check_private_key(ctx)) {
	    Tcl_AppendResult(interp,
			    "private key does not match the certificate public key",
			    (char *)NULL);
		    "private key does not match the certificate public key",
		    (char *)NULL);
	    SSL_CTX_free(ctx);
	    return NULL;
	}
    }

    /* Set to use default location and file for Certificate Authority (CA) certificates. The
     * verify path and store can be overridden by the SSL_CERT_DIR env var. The verify file can
︙
2112
2113
2114
2115
2116
2117
2118
2119
2120

2121
2122
2123
2124
2125
2126



2127
2128
2129
2130

2131
2132
2133
2134
2135
2136
2137

2105
2106
2107
2108
2109
2110
2111


2112
2113
2114
2115
2116


2117
2118
2119
2120
2121
2122

2123
2124
2125
2126
2127
2128
2129
2130








-
-
+




-
-
+
+
+



-
+








    dprintf("Called");

    if (objc < 2 || objc > 3 || (objc == 3 && !strcmp(Tcl_GetString(objv[1]), "-local"))) {
	Tcl_WrongNumArgs(interp, 1, objv, "?-local? channel");
	return TCL_ERROR;
    }

    /* Get channel Id */
    channelName = Tcl_GetStringFromObj(objv[(objc == 2 ? 1 : 2)], (Tcl_Size *) NULL);
    channelName = Tcl_GetString(objv[(objc == 2 ? 1 : 2)]);
    chan = Tcl_GetChannel(interp, channelName, &mode);
    if (chan == (Tcl_Channel) NULL) {
	return TCL_ERROR;
    }

    /* Make sure to operate on the topmost channel */
    /*
     * 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);
		"\": not a TLS channel", (char *)NULL);
	Tcl_SetErrorCode(interp, "TLS", "STATUS", "CHANNEL", "INVALID", (char *)NULL);
	return TCL_ERROR;
    }
    statePtr = (State *) Tcl_GetChannelInstanceData(chan);

    /* Get certificate for peer or self */
    if (objc == 2) {
︙
2237
2238
2239
2240
2241
2242
2243
2244

2245
2246
2247
2248
2249
2250
2251

2230
2231
2232
2233
2234
2235
2236

2237
2238
2239
2240
2241
2242
2243
2244








-
+








    const EVP_MD *md;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "channel");
	return(TCL_ERROR);
    }

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

    /* Make sure to operate on the topmost channel */
    chan = Tcl_GetTopChannel(chan);
    if (Tcl_GetChannelType(chan) != Tls_ChannelType()) {
︙
2823
2824
2825
2826
2827
2828
2829



2830
2831
2832
2833
2834
2835
2836

2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832








+
+
+








DLLEXPORT int Tls_Init(
    Tcl_Interp *interp)
{
    Tcl_CmdInfo info;

    dprintf("Called");

	/*
	 * We only support Tcl 8.6 or newer
	 */
    if (Tcl_InitStubs(interp, "8.6-", 0) == NULL) {
	return TCL_ERROR;
    }

    if (TlsLibInit(0) != TCL_OK) {
	Tcl_AppendResult(interp, "could not initialize SSL library", (char *)NULL);
	return TCL_ERROR;
︙
Modified win/makefile.vc from [50d01db583] to [9aa1648d15].
︙
71
72
73
74
75
76
77
78

79
80
81

71
72
73
74
75
76
77

78
79
80
81








-
+




# The default install target only installs binaries and scripts so add
# an additional target for our documentation. Note this *adds* a target
# since no commands are listed after it. The original targets for
# install (from targets.vc) will remain.
install: default-pkgindex-tea default-install default-install-docs-html

# Explicit dependency rules
$(GENERICDIR)\tls.c : $(GENERICDIR)\dh_params.h $(TMP_DIR)\tlsUuid.h
$(GENERICDIR)\tls.c: $(TMP_DIR)\tlsUuid.h

# Test package
test: default-test
Powered by Fossil · RSS