TclTLS: Diff

Differences From Artifact [b314eff29c]:

File generic/tls.c — part of check-in [cdb51c799e] at 2023-07-30 02:53:19 on branch errors_and_callbacks — Updated default callbacks in tls.tcl file (user: bohagan, size: 89573) [annotate] [blame] [check-ins using] [more...]

To Artifact [4969f5a74b]:

File generic/tls.c — part of check-in [070af72ccb] at 2023-08-19 20:30:51 on branch status_x509 — Updated ConnectionInfoObjCmd to localize variables (user: bohagan, size: 91951) [annotate] [blame] [check-ins using]

︙
114 115 116 117 118 119 120 ~~121~~ 122 123 124 125 126 127 128 129 130 131 132 133 134 135 ~~136~~ 137 138 139 140 141 142 143	114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143	- + + -	* Side effects: * Evaluates callback command * ------------------------------------------------------------------- / static int EvalCallback(Tcl_Interp interp, State statePtr, Tcl_Obj cmdPtr) { ~~int code, ok;~~ int code, ok = 0; Tcl_Preserve((ClientData) interp); Tcl_Preserve((ClientData) statePtr); / Eval callback with success for ok or return value 1, fail for error or return value 0 / Tcl_ResetResult(interp); code = Tcl_EvalObjEx(interp, cmdPtr, TCL_EVAL_GLOBAL); if (code == TCL_OK) { / Check result for return value / Tcl_Obj result = Tcl_GetObjResult(interp); if (result == NULL \|\| Tcl_GetIntFromObj(interp, result, &ok) != TCL_OK) { ok = 1; } } else { /* Error - reject the certificate */ ~~ok = 0;~~ #if (TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION < 6) Tcl_BackgroundError(interp); #else Tcl_BackgroundException(interp, code); #endif }
︙
382 383 384 385 386 387 388 389 390 391 392 393 394 395	382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397	+ +	if (statePtr->vcmd == (Tcl_Obj)NULL) { if (statePtr->vflags & SSL_VERIFY_FAIL_IF_NO_PEER_CERT) { return ok; } else { return 1; } } else if (cert == NULL \|\| ssl == NULL) { return 0; } / Create command to eval */ cmdPtr = Tcl_DuplicateObj(statePtr->vcmd); Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj("verify", -1)); Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(Tcl_GetChannelName(statePtr->self), -1));
︙
853 854 855 856 857 858 859 ~~860~~ 861 862 863 864 865 866 867	855 856 857 858 859 860 861 862 863 864 865 866 867 868 869	- +	const unsigned char p; size_t len, remaining; dprintf("Called"); if (statePtr->vcmd == (Tcl_Obj)NULL) { return SSL_CLIENT_HELLO_SUCCESS; ~~} else if (ssl == NULL \|\| arg == NULL) {~~ } else if (ssl == (const SSL )NULL \|\| arg == (void )NULL) { return SSL_CLIENT_HELLO_ERROR; } /* Get names / if (!SSL_client_hello_get0_ext(ssl, TLSEXT_TYPE_server_name, &p, &remaining) \|\| remaining <= 2) { alert = SSL_R_SSLV3_ALERT_ILLEGAL_PARAMETER; return SSL_CLIENT_HELLO_ERROR;
︙
950 951 952 953 954 955 956 957 958 959 960 961 962 963	952 953 954 955 956 957 958 959 960 961 962 963 964 965 966	+	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; dprintf("Called"); if ((objc < 2) \|\| (objc > 4)) { Tcl_WrongNumArgs(interp, 1, objv, "protocol ?verbose? ?supported?"); return TCL_ERROR; }
︙
975 976 977 978 979 980 981 ~~982~~ 983 984 985 986 987 988 ~~989~~ 990 991 992 993 994 995 ~~996~~ 997 998 999 1000 1001 1002 ~~1003~~ 1004 1005 1006 1007 1008 1009 ~~1010~~ 1011 1012 1013 1014 1015 1016 ~~1017~~ 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031	978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 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	- + - + - + - + - + - + + + +	switch ((enum protocol)index) { case TLS_SSL2: #if OPENSSL_VERSION_NUMBER >= 0x10100000L \|\| defined(NO_SSL2) \|\| defined(OPENSSL_NO_SSL2) Tcl_AppendResult(interp, protocols[index], ": protocol not supported", NULL); return TCL_ERROR; #else ~~~~ctx~~ = ~~SSL_CTX_new(~~SSLv2_method()); break;~~ method = SSLv2_method(); break; #endif 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); return TCL_ERROR; #else ~~~~ctx~~ = ~~SSL_CTX_new(~~SSLv3_method()); break;~~ 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", NULL); return TCL_ERROR; #else ~~~~ctx~~ = ~~SSL_CTX_new(~~TLSv1_method()); break;~~ method = TLSv1_method(); break; #endif case TLS_TLS1_1: #if defined(NO_TLS1_1) \|\| defined(OPENSSL_NO_TLS1_1) \|\| defined(OPENSSL_NO_TLS1_1_METHOD) Tcl_AppendResult(interp, protocols[index], ": protocol not supported", NULL); return TCL_ERROR; #else ~~~~ctx~~ = ~~SSL_CTX_new(~~TLSv1_1_method()); break;~~ method = TLSv1_1_method(); break; #endif case TLS_TLS1_2: #if defined(NO_TLS1_2) \|\| defined(OPENSSL_NO_TLS1_2) \|\| defined(OPENSSL_NO_TLS1_2_METHOD) Tcl_AppendResult(interp, protocols[index], ": protocol not supported", NULL); return TCL_ERROR; #else ~~~~ctx~~ = ~~SSL_CTX_new(~~TLSv1_2_method()); break;~~ method = TLSv1_2_method(); break; #endif case TLS_TLS1_3: #if defined(NO_TLS1_3) \|\| defined(OPENSSL_NO_TLS1_3) Tcl_AppendResult(interp, protocols[index], ": protocol not supported", NULL); return TCL_ERROR; #else ~~~~ctx~~ = ~~SSL_CTX_new(~~TLS_method());~~ 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, REASON(), NULL); return TCL_ERROR; } ssl = SSL_new(ctx); if (ssl == NULL) {
︙
2070 2071 2072 2073 2074 2075 2076 2077 2078 ~~2079~~ 2080 2081 2082 2083 2084 2085 ~~2086~~ 2087 2088 2089 2090 ~~2091~~ 2092 2093 2094 2095 2096 2097 2098 2099 2100 2101 2102 2103 2104 ~~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	2076 2077 2078 2079 2080 2081 2082 2083 2084 2085 2086 2087 2088 2089 2090 2091 2092 2093 2094 2095 2096 2097 2098 2099 2100 2101 2102 2103 2104 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 2131 2132 2133 2134 2135 2136 2137 2138 2139 2140 2141 2142 2143 2144 2145 2146 2147 2148 2149 2150 2151 2152 2153 2154 2155 2156 2157 2158 2159 2160 2161 2162 2163 2164 2165 2166 2167 2168 2169 2170	+ - + + + + - + + + - + - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - +	/* Get certificate for peer or self / if (objc == 2) { peer = SSL_get_peer_certificate(statePtr->ssl); } else { peer = SSL_get_certificate(statePtr->ssl); } / Get X509 certificate info / if (peer) { objPtr = Tls_NewX509Obj(interp, peer); ~~if (objc == 2) { ~~X509_free(peer); }~~~~ if (objc == 2) { X509_free(peer); peer = NULL; } } else { objPtr = Tcl_NewListObj(0, NULL); } / Peer cert chain (client only) / STACK_OF(X509) ssl_certs = SSL_get_peer_cert_chain(statePtr->ssl); ~~if (~~!peer && (~~ssl_certs == NULL \|\| sk_X509_num(ssl_certs) == 0)) {~~ if (ssl_certs == NULL \|\| sk_X509_num(ssl_certs) == 0) { Tcl_SetErrorCode(interp, "TLS", "STATUS", "CERTIFICATE", (char ) NULL); Tcl_IncrRefCount(objPtr); Tcl_DecrRefCount(objPtr); return TCL_ERROR; } ~~/ Peer name ~~from cert~~ /~~ / Peer name / Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("peername", -1)); Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(SSL_get0_peername(statePtr->ssl), -1)); Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("sbits", -1)); Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewIntObj(SSL_get_cipher_bits(statePtr->ssl, NULL))); ciphers = (char)SSL_get_cipher(statePtr->ssl); if ((ciphers != NULL) && (strcmp(ciphers, "(NONE)") != 0)) { Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("cipher", -1)); Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(ciphers, -1)); } /* Verify the X509 certificate presented by the peer / ~~Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("verif~~ica~~t~~ion~~", -1));~~ Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("verifyResult", -1)); Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(X509_verify_cert_error_string(SSL_get_verify_result(statePtr->ssl)), -1)); / Verify mode / Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("verifyMode", -1)); / SSL_CTX_get_verify_mode(ctx) / mode = SSL_get_verify_mode(statePtr->ssl); if (mode && SSL_VERIFY_NONE) { Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("none", -1)); } else { Tcl_Obj listObjPtr = Tcl_NewListObj(0, NULL); if (mode && SSL_VERIFY_PEER) { Tcl_ListObjAppendElement(interp, listObjPtr, Tcl_NewStringObj("peer", -1)); } if (mode && SSL_VERIFY_FAIL_IF_NO_PEER_CERT) { Tcl_ListObjAppendElement(interp, listObjPtr, Tcl_NewStringObj("fail if no peer cert", -1)); } if (mode && SSL_VERIFY_CLIENT_ONCE) { Tcl_ListObjAppendElement(interp, listObjPtr, Tcl_NewStringObj("client once", -1)); } if (mode && SSL_VERIFY_POST_HANDSHAKE) { Tcl_ListObjAppendElement(interp, listObjPtr, Tcl_NewStringObj("post handshake", -1)); } Tcl_ListObjAppendElement(interp, objPtr, listObjPtr); } /* Verify mode depth / Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("verifyDepth", -1)); / SSL_CTX_get_verify_depth(ctx) / Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewIntObj(SSL_get_verify_depth(statePtr->ssl))); / Report the selected protocol as a result of the negotiation / SSL_get0_alpn_selected(statePtr->ssl, &proto, &len); Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("alpn", -1)); Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj((char )proto, (int) len)); Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("protocol", -1)); Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(SSL_get_version(statePtr->ssl), -1)); /* Valid for non-RSA signature and TLS 1.3 */ Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("signatureHashAlgorithm", -1)); if (objc == 2 ? SSL_get_peer_signature_nid(statePtr->ssl, &nid) : SSL_get_signature_nid(statePtr->ssl, &nid)) { Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(OBJ_nid2ln(nid), -1)); } else { Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("", -1)); } ~~Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("signature_type", -1));~~ Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("signatureType", -1)); if (objc == 2 ? SSL_get_peer_signature_type_nid(statePtr->ssl, &nid) : SSL_get_signature_type_nid(statePtr->ssl, &nid)) { Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(OBJ_nid2ln(nid), -1)); } else { Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("", -1)); } Tcl_SetObjResult(interp, objPtr);
︙
2142 2143 2144 2145 2146 2147 2148 ~~2149~~ 2150 2151 2152 ~~2153~~ 2154 2155 2156 2157 2158 2159 2160	2182 2183 2184 2185 2186 2187 2188 2189 2190 2191 2192 2193 2194 2195 2196 2197 2198 2199	- + -	* ------------------------------------------------------------------- / static int ConnectionInfoObjCmd(ClientData clientData, Tcl_Interp interp, int objc, Tcl_Obj const objv[]) { Tcl_Channel chan; /* The channel to set a mode on. / State statePtr; /* client state for ssl socket / ~~Tcl_Obj objPtr;~~ Tcl_Obj objPtr, listPtr; const SSL ssl; const SSL_CIPHER cipher; const SSL_SESSION session; ~~const unsigned char proto;~~ long mode; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "channel"); return(TCL_ERROR); }
︙
2216 2217 2218 2219 2220 2221 2222 ~~2223~~ 2224 ~~2225~~ 2226 2227 2228 2229 2230 2231 2232	2255 2256 2257 2258 2259 2260 2261 2262 2263 2264 2265 2266 2267 2268 2269 2270 2271	- + - +	Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("cipher", -1)); Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(SSL_CIPHER_get_name(cipher), -1)); Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("standard_name", -1)); Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(SSL_CIPHER_standard_name(cipher), -1)); bits = SSL_CIPHER_get_bits(cipher, &alg_bits); ~~Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("bits", -1));~~ Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("secret_bits", -1)); Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewIntObj(bits)); ~~Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("~~sec~~ret_bits", -1));~~ Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("algorithm_bits", -1)); Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewIntObj(alg_bits)); /* alg_bits is actual key secret bits. If use bits and secret (algorithm) bits differ, the rest of the bits are fixed, i.e. for limited export ciphers (bits < 56) / Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("min_version", -1)); Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(SSL_CIPHER_get_version(cipher), -1)); / Get OpenSSL-specific ID, not IANA ID */
︙
2241 2242 2243 2244 2245 2246 2247 ~~2248~~ 2249 2250 2251 2252 2253 2254 2255	2280 2281 2282 2283 2284 2285 2286 2287 2288 2289 2290 2291 2292 2293 2294	- +	/* Session info / session = SSL_get_session(ssl); if (session != NULL) { const unsigned char ticket; size_t len2; unsigned int ulen; ~~const unsigned char session_id;~~ const unsigned char session_id, proto; char buffer[SSL_MAX_MASTER_KEY_LENGTH]; / Report the selected protocol as a result of the ALPN negotiation / SSL_SESSION_get0_alpn_selected(session, &proto, &len2); Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("alpn", -1)); Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj((char )proto, (int) len2));
︙
2272 2273 2274 2275 2276 2277 2278 ~~2279~~ 2280 2281 2282 2283 2284 2285 2286 2287 2288 2289 2290	2311 2312 2313 2314 2315 2316 2317 2318 2319 2320 2321 2322 2323 2324 2325 2326 2327 2328 2329 2330 2331 2332 2333 2334	- + + + + + +	Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("timeout", -1)); Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewLongObj(SSL_SESSION_get_timeout(session))); /* Session ticket lifetime hint (in seconds) / Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("lifetime", -1)); Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewLongObj(SSL_SESSION_get_ticket_lifetime_hint(session))); ~~/ Session id /~~ / Session id - TLSv1.2 and below only / session_id = SSL_SESSION_get_id(session, &ulen); Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("session_id", -1)); Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewByteArrayObj(session_id, (int) ulen)); / Session context / session_id = SSL_SESSION_get0_id_context(session, &ulen); Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("session_context", -1)); Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewByteArrayObj(session_id, (int) ulen)); / Session ticket - client only / SSL_SESSION_get0_ticket(session, &ticket, &len2); Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("session_ticket", -1)); Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewByteArrayObj(ticket, (int) len2)); / Ticket app data */ SSL_SESSION_get0_ticket_appdata(session, &ticket, &len2);
︙
2313 2314 2315 2316 2317 2318 2319 ~~2320 2321 2322 2323 2324 2325 2326 2327 2328 2329 2330 2331 2332 2333~~ 2334 2335 2336 2337 2338 2339 2340	2357 2358 2359 2360 2361 2362 2363 2364 2365 2366 2367 2368 2369 2370 2371 2372 2373 2374 2375 2376 2377 2378 2379 2380 2381 2382 2383 2384 2385 2386 2387 2388 2389 2390 2391 2392 2393 2394 2395 2396 2397 2398 2399 2400 2401 2402 2403 2404 2405	+ - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("NONE", -1)); Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("expansion", -1)); Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("NONE", -1)); #endif } /* Server info / { mode = SSL_CTX_get_session_cache_mode(statePtr->ctx); if (mode & SSL_SESS_CACHE_OFF) { ~~proto~~ = "off"; } else if (mode & SSL_SESS_CACHE_CLIENT) { ~~proto~~ = "client"; } else if (mode & SSL_SESS_CACHE_SERVER) { ~~proto~~ = "server"; } else if (mode & SSL_SESS_CACHE_BOTH) { ~~proto~~ = "both"; } else { ~~proto~~ = "unknown"; } Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("session_cache_mode", -1)); Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(~~proto~~, -1)); mode = SSL_CTX_get_session_cache_mode(statePtr->ctx); char msg; if (mode & SSL_SESS_CACHE_OFF) { msg = "off"; } else if (mode & SSL_SESS_CACHE_CLIENT) { msg = "client"; } else if (mode & SSL_SESS_CACHE_SERVER) { msg = "server"; } else if (mode & SSL_SESS_CACHE_BOTH) { msg = "both"; } else { msg = "unknown"; } Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("session_cache_mode", -1)); Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(msg, -1)); } /* CA List / / IF not a server, same as SSL_get0_peer_CA_list. If server same as SSL_CTX_get_client_CA_list / listPtr = Tcl_NewListObj(0, NULL); STACK_OF(X509_NAME) ca_list; if ((ca_list = SSL_get_client_CA_list(ssl)) != NULL) { char buffer[BUFSIZ]; for (int i = 0; i < sk_X509_NAME_num(ca_list); i++) { X509_NAME name = sk_X509_NAME_value(ca_list, i); if (name) { X509_NAME_oneline(name, buffer, BUFSIZ); Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj(buffer, -1)); } } } Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("caList", -1)); Tcl_ListObjAppendElement(interp, objPtr, listPtr); Tcl_SetObjResult(interp, objPtr); return TCL_OK; clientData = clientData; } /
︙