Check-in [d966a301eb]
EuroTcl/OpenACS 11 - 12 JULY 2024, VIENNA
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: d966a301eb018f7f8a51c1906b083f5be764a2a32977bc3d7b0ad86843cf07d4
User & Date: bohagan on 2024-02-24 22:22:56
Other Links: manifest | tags
Context
2024-02-27
05:05
Removed unneeded initialize dstrings. check-in: 6ffc298e51 user: bohagan tags: trunk
2024-02-24
22:22
Clean-up gcc compiler warnings check-in: d966a301eb user: bohagan tags: trunk
03:26
Added back initialize dynamic strings since Tcl_TranslateFileName doesn't initialize them check-in: ccb3824e44 user: bohagan tags: trunk
Changes

Modified generic/tls.c from [69b432401c] to [5e701cf08b].

954
955
956
957
958
959
960
961

962
963
964
965
966
967
968
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];
    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
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(cp, -1));
		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
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 */
    const unsigned char *session_id = NULL;
    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
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), session_id, (unsigned int) strlen(session_id))) {
	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;
	}
    }

Modified tests/common.tcl from [3f4b3346c0] to [95c47b8587].

17
18
19
20
21
22
23
24
25
26
27
28
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}]

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