TCLTLS Redux

Check-in [28b250e1fb]
Login

Check-in [28b250e1fb]

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Clean-up gcc compiler warnings
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA3-256: 28b250e1fbd071d99251af66ac47cf2bf66dcf8ca67ba8556c17d34a14ebf76f
User & Date: bohagan 2024-02-24 22:22:56
Context
2024-02-27
05:05
Removed unneeded initialize dstrings. check-in: e1844648e1 user: bohagan tags: trunk
2024-02-24
22:22
Clean-up gcc compiler warnings check-in: 28b250e1fb user: bohagan tags: trunk
03:26
Added back initialize dynamic strings since Tcl_TranslateFileName doesn't initialize them check-in: 341113cd35 user: bohagan tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/tls.c.

︙︙
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968


static int
CiphersObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    Tcl_Obj *objPtr = NULL;
    SSL_CTX *ctx = NULL;
    SSL *ssl = NULL;
    STACK_OF(SSL_CIPHER) *sk;
    char *cp, buf[BUFSIZ];
    int index, verbose = 0, use_supported = 0;
    const SSL_METHOD *method;
    (void) clientData;

    dprintf("Called");

    if ((objc < 2) || (objc > 4)) {








|








954
955
956
957
958
959
960
961
962
963
964
965
966
967
968


static int
CiphersObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    Tcl_Obj *objPtr = NULL;
    SSL_CTX *ctx = NULL;
    SSL *ssl = NULL;
    STACK_OF(SSL_CIPHER) *sk;
    char buf[BUFSIZ];
    int index, verbose = 0, use_supported = 0;
    const SSL_METHOD *method;
    (void) clientData;

    dprintf("Called");

    if ((objc < 2) || (objc > 4)) {
︙︙
1050
1051
1052
1053
1054
1055
1056

1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072

	sk = SSL_get1_supported_ciphers(ssl);
    } else {
	sk = SSL_get_ciphers(ssl);
    }

    if (sk != NULL) {
	if (!verbose) {

	    objPtr = Tcl_NewListObj(0, NULL);
	    for (int i = 0; i < sk_SSL_CIPHER_num(sk); i++) {
		const SSL_CIPHER *c = sk_SSL_CIPHER_value(sk, i);
		if (c == NULL) continue;

		/* cipher name or (NONE) */
		cp = SSL_CIPHER_get_name(c);
		if (cp == NULL) break;
		Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(cp, -1));
	    }

	} else {
	    objPtr = Tcl_NewStringObj("",0);
	    for (int i = 0; i < sk_SSL_CIPHER_num(sk); i++) {
		const SSL_CIPHER *c = sk_SSL_CIPHER_value(sk, i);
		if (c == NULL) continue;








>








|








1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073

	sk = SSL_get1_supported_ciphers(ssl);
    } else {
	sk = SSL_get_ciphers(ssl);
    }

    if (sk != NULL) {
	if (!verbose) {
	    const char *cp;
	    objPtr = Tcl_NewListObj(0, NULL);
	    for (int i = 0; i < sk_SSL_CIPHER_num(sk); i++) {
		const SSL_CIPHER *c = sk_SSL_CIPHER_value(sk, i);
		if (c == NULL) continue;

		/* cipher name or (NONE) */
		cp = SSL_CIPHER_get_name(c);
		if (cp == NULL) break;
		Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj((char *) cp, -1));
	    }

	} else {
	    objPtr = Tcl_NewStringObj("",0);
	    for (int i = 0; i < sk_SSL_CIPHER_num(sk); i++) {
		const SSL_CIPHER *c = sk_SSL_CIPHER_value(sk, i);
		if (c == NULL) continue;
︙︙
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282

    char *ciphers		= NULL;
    char *ciphersuites		= NULL;
    char *CAfile		= NULL;
    char *CApath		= NULL;
    char *DHparams		= NULL;
    char *model			= NULL;
    char *servername		= NULL;	/* hostname for Server Name Indication */
    const unsigned char *session_id = NULL;
    Tcl_Obj *alpn		= NULL;
    int ssl2 = 0, ssl3 = 0;
    int tls1 = 1, tls1_1 = 1, tls1_2 = 1, tls1_3 = 1;
    int proto = 0, level = -1;
    int verify = 0, require = 0, request = 1, post_handshake = 0;
    (void) clientData;









|








1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283

    char *ciphers		= NULL;
    char *ciphersuites		= NULL;
    char *CAfile		= NULL;
    char *CApath		= NULL;
    char *DHparams		= NULL;
    char *model			= NULL;
    char *servername		= NULL;	/* hostname for Server Name Indication */
    char *session_id		= NULL;
    Tcl_Obj *alpn		= NULL;
    int ssl2 = 0, ssl3 = 0;
    int tls1 = 1, tls1_1 = 1, tls1_2 = 1, tls1_3 = 1;
    int proto = 0, level = -1;
    int verify = 0, require = 0, request = 1, post_handshake = 0;
    (void) clientData;
︙︙
1509
1510
1511
1512
1513
1514
1515
1516

1517
1518
1519
1520
1521
1522
1523

	    return TCL_ERROR;
	}
    }

    /* Resume session id */
    if (session_id && strlen(session_id) <= SSL_MAX_SID_CTX_LENGTH) {
	/* SSL_set_session() */
	if (!SSL_SESSION_set1_id_context(SSL_get_session(statePtr->ssl), session_id, (unsigned int) strlen(session_id))) {

	    Tcl_AppendResult(interp, "Resume session failed: ", GET_ERR_REASON(), (char *) NULL);
	    Tcl_SetErrorCode(interp, "TLS", "IMPORT", "SESSION", "FAILED", (char *) NULL);
	    Tls_Free((char *) statePtr);
	    return TCL_ERROR;
	}
    }









|
>








1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525

	    return TCL_ERROR;
	}
    }

    /* Resume session id */
    if (session_id && strlen(session_id) <= SSL_MAX_SID_CTX_LENGTH) {
	/* SSL_set_session() */
	if (!SSL_SESSION_set1_id_context(SSL_get_session(statePtr->ssl),
		(const unsigned char *) session_id, (unsigned int) strlen(session_id))) {
	    Tcl_AppendResult(interp, "Resume session failed: ", GET_ERR_REASON(), (char *) NULL);
	    Tcl_SetErrorCode(interp, "TLS", "IMPORT", "SESSION", "FAILED", (char *) NULL);
	    Tls_Free((char *) statePtr);
	    return TCL_ERROR;
	}
    }
︙︙

Changes to tests/common.tcl.

︙︙
17
18
19
20
21
22
23
24
25
26
27
28

# OpenSSL version
::tcltest::testConstraint OpenSSL [string match "OpenSSL*" [::tls::version]]

# Legacy OpenSSL v1.1.1 vs new v3.x
scan [lindex [split [::tls::version]] 1] %f version
::tcltest::testConstraint new_api [expr {$version >= 3.0}]
::tcltest::testConstraint old_api [expr {$version < 3.0}]

# Load legacy provider
if {$version >= 3.0} {
    tls::provider legacy
}








<
<
<
<
<

17
18
19
20
21
22
23






# OpenSSL version
::tcltest::testConstraint OpenSSL [string match "OpenSSL*" [::tls::version]]

# Legacy OpenSSL v1.1.1 vs new v3.x
scan [lindex [split [::tls::version]] 1] %f version
::tcltest::testConstraint new_api [expr {$version >= 3.0}]
::tcltest::testConstraint old_api [expr {$version < 3.0}]