TclTLS: Diff

Differences From Artifact [6e32fbd0db]:

File generic/tls.c — part of check-in [489f45bd81] at 2023-05-27 19:20:14 on branch status_x509 — Added session id and ticket to connection status. Added callback to handle session id and ticket updates after the handshake. (user: bohagan, size: 68304) [annotate] [blame] [check-ins using]

To Artifact [78a5edc11d]:

File generic/tls.c — part of check-in [500c6b97d6] at 2023-05-27 21:14:50 on branch status_x509 — Optimized use of pointers and comment format updates. (user: bohagan, size: 68331) [annotate] [blame] [check-ins using]

︙
91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122	91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127	+ + + + +	static Tcl_Mutex locks = NULL; static int locksCount = 0; static Tcl_Mutex init_mx; #endif / OPENSSL_THREADS / #endif / TCL_THREADS / /******************/ / Callbacks / /******************/ / ------------------------------------------------------------------- * InfoCallback -- * * monitors SSL connection process * * Results: * None * * Side effects: * Calls callback (if defined) ------------------------------------------------------------------- / static void InfoCallback(const SSL ssl, int where, int ret) { State statePtr = (State)SSL_get_app_data((SSL )ssl); Tcl_Interp interp = statePtr->interp; Tcl_Obj cmdPtr; char major; char minor; dprintf("Called"); if (statePtr->callback == (Tcl_Obj*)NULL) return;
︙
147 148 149 150 151 152 153 ~~154 155~~ 156 ~~157 158~~ 159 160 ~~161~~ 162 163 164 165 ~~166~~ 167 ~~168~~ 169 170 ~~171~~ 172 173 174 ~~175~~ 176 177 178 ~~179~~ 180 181 182 183 184 185 186	152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191	- - + + - - + + - + - + - + - + - + - +	if (where & SSL_CB_READ) minor = "read"; else if (where & SSL_CB_WRITE) minor = "write"; else if (where & SSL_CB_LOOP) minor = "loop"; else if (where & SSL_CB_EXIT) minor = "exit"; else minor = "unknown"; } ~~Tcl_ListObjAppendElement(~~statePtr->~~interp, cmdPtr, Tcl_NewStringObj("info", -1)); Tcl_ListObjAppendElement(~~statePtr->~~interp, cmdPtr,~~ Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj("info", -1)); Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(Tcl_GetChannelName(statePtr->self), -1)); ~~Tcl_ListObjAppendElement(~~statePtr->~~interp, cmdPtr, Tcl_NewStringObj(major, -1)); Tcl_ListObjAppendElement(~~statePtr->~~interp, cmdPtr, Tcl_NewStringObj(minor, -1));~~ Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(major, -1)); Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(minor, -1)); if (where & (SSL_CB_LOOP\|SSL_CB_EXIT)) { ~~Tcl_ListObjAppendElement(~~statePtr->~~interp, cmdPtr,~~ Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(SSL_state_string_long(ssl), -1)); } else if (where & SSL_CB_ALERT) { const char cp = (char ) SSL_alert_desc_string_long(ret); ~~Tcl_ListObjAppendElement(~~statePtr->~~interp, cmdPtr, Tcl_NewStringObj(cp, -1));~~ Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(cp, -1)); } else { ~~Tcl_ListObjAppendElement(~~statePtr->~~interp, cmdPtr,~~ Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(SSL_state_string_long(ssl), -1)); } ~~Tcl_Preserve((ClientData) ~~statePtr->~~interp);~~ Tcl_Preserve((ClientData) interp); Tcl_Preserve((ClientData) statePtr); Tcl_IncrRefCount(cmdPtr); ~~(void) Tcl_EvalObjEx(~~statePtr->~~interp, cmdPtr, TCL_EVAL_GLOBAL);~~ (void) Tcl_EvalObjEx(interp, cmdPtr, TCL_EVAL_GLOBAL); Tcl_DecrRefCount(cmdPtr); Tcl_Release((ClientData) statePtr); ~~Tcl_Release((ClientData) ~~statePtr->~~interp);~~ Tcl_Release((ClientData) interp); } /* ------------------------------------------------------------------- * VerifyCallback -- *
︙
203 204 205 206 207 208 209 210 211 212 213 214 215 216	208 209 210 211 212 213 214 215 216 217 218 219 220 221 222	+	VerifyCallback(int ok, X509_STORE_CTX ctx) { Tcl_Obj cmdPtr, result; char errStr, string; int length; SSL ssl = (SSL)X509_STORE_CTX_get_ex_data(ctx, SSL_get_ex_data_X509_STORE_CTX_idx()); X509 cert = X509_STORE_CTX_get_current_cert(ctx); State statePtr = (State)SSL_get_app_data(ssl); Tcl_Interp *interp = statePtr->interp; int depth = X509_STORE_CTX_get_error_depth(ctx); int err = X509_STORE_CTX_get_error(ctx); int code; dprintf("Verify: %d", ok); if (!ok) {
︙
224 225 226 227 228 229 230 ~~231 232~~ 233 ~~234 235 236 237~~ 238 ~~239~~ 240 241 242 243 244 ~~245~~ 246 247 248 ~~249~~ 250 ~~251~~ 252 253 254 ~~255~~ 256 257 258 ~~259~~ 260 261 ~~262~~ 263 ~~264~~ 265 266 267 268 269 270 271 272 273 274 ~~275~~ 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 ~~300~~ 301 ~~302~~ 303 304 305 306 307 308 309 ~~310~~ 311 ~~312~~ 313 ~~314~~ 315 316 317 318 319 ~~320 321~~ ~~322 323~~ 324 ~~325 326 327~~ 328 ~~329~~ 330 331 332 ~~333~~ 334 335 ~~336~~ 337 ~~338~~ 339 340 341 342 ~~343~~ 344 345 346 347 348 349 350 351 352	230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366	- - + + - - - - + + + + - + - + - + - + - + - + - + - + - + + - + - + - + - + - + - - + - - + - - - + - + - + - + - + - + + + + + + + + + + + +	return ok; } else { return 1; } } cmdPtr = Tcl_DuplicateObj(statePtr->callback); ~~Tcl_ListObjAppendElement(~~statePtr->~~interp, cmdPtr, Tcl_NewStringObj("verify", -1)); Tcl_ListObjAppendElement(~~statePtr->~~interp, cmdPtr,~~ Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj("verify", -1)); Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(Tcl_GetChannelName(statePtr->self), -1)); Tcl_ListObjAppendElement(~~statePtr->~~interp, cmdPtr, Tcl_NewIntObj(depth)); Tcl_ListObjAppendElement(~~statePtr->~~interp, cmdPtr, Tls_NewX509Obj(~~statePtr->~~interp, cert)); Tcl_ListObjAppendElement(~~statePtr->~~interp, cmdPtr, Tcl_NewIntObj(ok)); Tcl_ListObjAppendElement(~~statePtr->~~interp, cmdPtr, Tcl_NewStringObj(errStr ? errStr : "", -1)); Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewIntObj(depth)); Tcl_ListObjAppendElement(interp, cmdPtr, Tls_NewX509Obj(interp, cert)); Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewIntObj(ok)); Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(errStr ? errStr : "", -1)); ~~Tcl_Preserve((ClientData) ~~statePtr->~~interp);~~ Tcl_Preserve((ClientData) interp); Tcl_Preserve((ClientData) statePtr); statePtr->flags \|= TLS_TCL_CALLBACK; Tcl_IncrRefCount(cmdPtr); ~~code = Tcl_EvalObjEx(~~statePtr->~~interp, cmdPtr, TCL_EVAL_GLOBAL);~~ code = Tcl_EvalObjEx(interp, cmdPtr, TCL_EVAL_GLOBAL); if (code != TCL_OK) { /* It got an error - reject the certificate. / #if (TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION < 6) ~~Tcl_BackgroundError(~~statePtr->~~interp);~~ Tcl_BackgroundError(interp); #else ~~Tcl_BackgroundException(~~statePtr->~~interp, code);~~ Tcl_BackgroundException(interp, code); #endif ok = 0; } else { ~~result = Tcl_GetObjResult(~~statePtr->~~interp);~~ result = Tcl_GetObjResult(interp); string = Tcl_GetStringFromObj(result, &length); / An empty result leaves verification unchanged. / if (string != NULL && length > 0) { ~~code = Tcl_GetIntFromObj(~~statePtr->~~interp, result, &ok);~~ code = Tcl_GetIntFromObj(interp, result, &ok); if (code != TCL_OK) { #if (TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION < 6) ~~Tcl_BackgroundError(~~statePtr->~~interp);~~ Tcl_BackgroundError(interp); #else ~~Tcl_BackgroundException(~~statePtr->~~interp, code);~~ Tcl_BackgroundException(interp, code); #endif ok = 0; } } } Tcl_DecrRefCount(cmdPtr); statePtr->flags &= ~(TLS_TCL_CALLBACK); Tcl_Release((ClientData) statePtr); ~~Tcl_Release((ClientData) ~~statePtr->~~interp);~~ Tcl_Release((ClientData) interp); return(ok); / By default, leave verification unchanged. / } / ------------------------------------------------------------------- * Tls_Error -- * * Calls callback with $fd and $msg - so the callback can decide * what to do with errors. * * Side effects: * The err field of the currently operative State is set * to a string describing the SSL negotiation failure reason ------------------------------------------------------------------- / void Tls_Error(State statePtr, char msg) { Tcl_Interp interp = statePtr->interp; Tcl_Obj cmdPtr; int code; dprintf("Called"); if (msg && msg) { ~~Tcl_SetErrorCode(~~statePtr->~~interp, "SSL", msg, (char )NULL);~~ Tcl_SetErrorCode(interp, "SSL", msg, (char )NULL); } else { ~~msg = Tcl_GetStringFromObj(Tcl_GetObjResult(~~statePtr->~~interp), NULL);~~ msg = Tcl_GetStringFromObj(Tcl_GetObjResult(interp), NULL); } statePtr->err = msg; if (statePtr->callback == (Tcl_Obj)NULL) { char buf[BUFSIZ]; sprintf(buf, "SSL channel \"%s\": error: %s", Tcl_GetChannelName(statePtr->self), msg); ~~Tcl_SetResult(~~statePtr->~~interp, buf, TCL_VOLATILE);~~ Tcl_SetResult(interp, buf, TCL_VOLATILE); #if (TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION < 6) ~~Tcl_BackgroundError(~~statePtr->~~interp);~~ Tcl_BackgroundError(interp); #else ~~Tcl_BackgroundException(~~statePtr->~~interp, TCL_ERROR);~~ Tcl_BackgroundException(interp, TCL_ERROR); #endif return; } cmdPtr = Tcl_DuplicateObj(statePtr->callback); ~~~~Tcl_ListObjAppendElement(statePtr->interp, cmdPtr,~~ Tcl_NewStringObj("error", -1));~~ Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj("error", -1)); ~~Tcl_ListObjAppendElement(~~statePtr->~~interp, cmdPtr,~~ Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(Tcl_GetChannelName(statePtr->self), -1)); ~~~~Tcl_ListObjAppendElement(statePtr->interp, cmdPtr,~~ Tcl_NewStringObj(msg, -1));~~ Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(msg, -1)); ~~Tcl_Preserve((ClientData) ~~statePtr->~~interp);~~ Tcl_Preserve((ClientData) interp); Tcl_Preserve((ClientData) statePtr); Tcl_IncrRefCount(cmdPtr); ~~code = Tcl_EvalObjEx(~~statePtr->~~interp, cmdPtr, TCL_EVAL_GLOBAL);~~ code = Tcl_EvalObjEx(interp, cmdPtr, TCL_EVAL_GLOBAL); if (code != TCL_OK) { #if (TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION < 6) ~~Tcl_BackgroundError(~~statePtr->~~interp);~~ Tcl_BackgroundError(interp); #else ~~Tcl_BackgroundException(~~statePtr->~~interp, code);~~ Tcl_BackgroundException(interp, code); #endif } Tcl_DecrRefCount(cmdPtr); Tcl_Release((ClientData) statePtr); ~~Tcl_Release((ClientData) ~~statePtr->~~interp);~~ Tcl_Release((ClientData) interp); } /* ------------------------------------------------------------------- * KeyLogCallback -- * * Write received key data to log file. * * Side effects: * none ------------------------------------------------------------------- / void KeyLogCallback(const SSL ssl, const char line) { char str = getenv(SSLKEYLOGFILE); FILE fd; if (str) { fd = fopen(str, "a"); fprintf(fd, "%s\n",line); fclose(fd);
︙
446 447 448 449 450 451 452 ~~453~~ 454 455 456 457 458 459 460	460 461 462 463 464 465 466 467 468 469 470 471 472 473	-	return 0; cmdPtr = Tcl_DuplicateObj(statePtr->callback); Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj( "session", -1)); /* Session id / ~~session = SSL_get_session(statePtr->ssl);~~ session_id = SSL_SESSION_get0_id_context(session, &len); Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(session_id, len)); / Session ticket */ SSL_SESSION_get0_ticket(session, &ticket, &len2); Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(ticket, (int)len2));
︙
477 478 479 480 481 482 483 484 485 486 487 488 489 490	490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507	+ + + +	Tcl_DecrRefCount(cmdPtr); Tcl_Release((ClientData) statePtr); Tcl_Release((ClientData) interp); return 1; } /*******************/ / Commands / /******************/ / ------------------------------------------------------------------- * CiphersObjCmd -- list available ciphers * * This procedure is invoked to process the "tls::ciphers" command * to list available ciphers, based upon protocol selected.
︙
720 721 722 723 724 725 726 ~~727 728~~ ~~729~~ 730 731 732 733 734 735 736	737 738 739 740 741 742 743 744 745 746 747 748 749 750 751	- - + -	} chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], NULL), NULL); 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); return(TCL_ERROR); } statePtr = (State *)Tcl_GetChannelInstanceData(chan);
︙
841 842 843 844 845 846 847 ~~848 849~~ ~~850~~ 851 852 853 854 855 856 857	856 857 858 859 860 861 862 863 864 865 866 867 868 869 870	- - + -	} chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], NULL), NULL); 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); for (idx = 2; idx < objc; idx++) { char *opt = Tcl_GetStringFromObj(objv[idx], NULL); if (opt[0] != '-') break;
︙
1126 1127 1128 1129 1130 1131 1132 ~~1133 1134~~ ~~1135~~ 1136 1137 1138 1139 1140 1141 1142	1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 1151 1152 1153	- - + -	} 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~~ /* 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; }
︙
1517 1518 1519 1520 1521 1522 1523 ~~1524 1525~~ ~~1526~~ 1527 1528 1529 1530 1531 1532 1533	1528 1529 1530 1531 1532 1533 1534 1535 1536 1537 1538 1539 1540 1541 1542	- - + -	return TCL_ERROR; } 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); return TCL_ERROR; } statePtr = (State *) Tcl_GetChannelInstanceData(chan);
︙
1604 1605 1606 1607 1608 1609 1610 ~~1611 1612~~ ~~1613~~ 1614 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 1653	1613 1614 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 1653 1654 1655 1656 1657 1658 1659 1660 1661 1662 1663 1664 1665 1666 1667 1668 1669 1670 1671 1672 1673 1674 1675 1676	- - + - - + + + - - - - - - - - + + + + + + + + + + + - - - + + + - - - + + + + + + + + + + + + + - - - - - + + + + + +	} chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], NULL), NULL); 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); return(TCL_ERROR); } objPtr = Tcl_NewListObj(0, NULL); ~~/* ~~Get c~~onnection ~~state~~ /~~ / Connection info / statePtr = (State )Tcl_GetChannelInstanceData(chan); ssl = statePtr->ssl; if (ssl != NULL) { const char state; ~~Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("state", -1));~~ if (SSL_is_init_finished(ssl)) { ~~Tcl_Li~~st~~ObjAppendElement(in~~te~~rp, objPtr, Tcl_NewStringObj(~~"established"~~, -1))~~; } else if (SSL_in_init(ssl)) { ~~Tcl_Li~~st~~ObjAppendElement(in~~te~~rp, objPtr, Tcl_NewStringObj(~~"handshake"~~, -1))~~; } else { ~~Tcl_Li~~st~~ObjAppendElement(in~~te~~rp, objPtr, Tcl_NewStringObj(~~"initializing"~~, -1))~~; } / connection state / if (SSL_is_init_finished(ssl)) { state = "established"; } else if (SSL_in_init(ssl)) { state = "handshake"; } else { state = "initializing"; } Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("state", -1)); Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(state, -1)); / Get server name / Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("servername", -1)); Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(SSL_get_servername(ssl, TLSEXT_NAMETYPE_host_name), -1)); / Get server name / Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("servername", -1)); Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(SSL_get_servername(ssl, TLSEXT_NAMETYPE_host_name), -1)); ~~/ Get protocol / Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("protocol", -1)); Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(SSL_get_version(ssl), -1));~~ / Get protocol / Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("protocol", -1)); Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(SSL_get_version(ssl), -1)); / Renegotiation allowed / Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("renegotiation", -1)); Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj( SSL_get_secure_renegotiation_support(ssl) ? "allowed" : "not supported", -1)); / Report the selected protocol as a result of the ALPN negotiation / SSL_get0_alpn_selected(ssl, &proto, &len); Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("alpn", -1)); Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj((char )proto, (int)len)); /* Get security level / Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("securitylevel", -1)); Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewIntObj(SSL_get_security_level(ssl))); / ~~Get c~~ipher / / Get security level / Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("securitylevel", -1)); Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewIntObj(SSL_get_security_level(ssl))); } / Cipher info */ cipher = SSL_get_current_cipher(ssl); if (cipher != NULL) { char buf[BUFSIZ] = {0}; int bits, alg_bits; Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("cipher", -1)); Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(SSL_CIPHER_get_name(cipher), -1));
︙
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	- - - - - - - - -	if (SSL_CIPHER_description(cipher, buf, sizeof(buf)) != NULL) { Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("description", -1)); Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(buf, -1)); } } ~~Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("renegotiation", -1));~~ ~~Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(~~ ~~SSL_get_secure_renegotiation_support(ssl) ? "allowed" : "not supported", -1));~~ ~~/* Report the selected protocol as a result of the negotiation /~~ ~~SSL_get0_alpn_selected(ssl, &proto, &len);~~ ~~Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("alpn", -1));~~ ~~Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj((char )proto, (int)len));~~ /* Session info / session = SSL_get_session(ssl); if (session != NULL) { const unsigned char ticket; size_t len2; const unsigned char *session_id;
︙
1713 1714 1715 1716 1717 1718 1719 ~~1720~~ 1721 1722 1723 ~~1724~~ 1725 1726 1727 1728 1729 1730 1731	1727 1728 1729 1730 1731 1732 1733 1734 1735 1736 1737 1738 1739 1740 1741 1742 1743 1744 1745	- + - +	Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewLongObj(SSL_SESSION_get_timeout(session))); } #if defined(HAVE_SSL_COMPRESSION) /* Compression info */ comp = SSL_get_current_compression(ssl); if (comp != NULL) { ~~expansion = SSL_get_current_expansion(ssl);~~ Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("compression", -1)); Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(SSL_COMP_get_name(comp), -1)); comp = SSL_get_current_expansion(ssl); Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("expansion", -1)); ~~Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(SSL_COMP_get_name(~~expansion~~), -1));~~ Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(SSL_COMP_get_name(comp), -1)); } #endif Tcl_SetObjResult(interp, objPtr); return TCL_OK; clientData = clientData; }
︙
1966 1967 1968 1969 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979	1980 1981 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991 1992 1993 1994 1995 1996 1997	+ + + +	default: break; } return TCL_OK; clientData = clientData; } /*******************/ / Init / /******************/ / ------------------------------------------------------------------- * Tls_Free -- * * This procedure cleans up when a SSL socket based channel * is closed and its reference count falls below 1
︙