Overview
Comment: | * tlsInt.h: * tlsIO.c: * tlsBIO.c: * tls.c: changed around to only working with 8.2.0+ (8.3.2+ preferred), with runtime checks for pre- and post-io-rewrite. |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | trunk |
Files: | files | file ages | folders |
SHA1: |
33ea0b5a9d057eb73c8c3716b8b1cbad |
User & Date: | hobbs on 2000-08-15 00:02:08 |
Other Links: | manifest | tags |
Context
2000-08-15
| ||
17:05 | * tests/simpleClient.tcl: * tests/simpleServer.tcl: added simple client/server test scripts that use test certs and can do simple stress tests. check-in: 2f852e2ef6 user: hobbs tags: trunk | |
00:02 | * tlsInt.h: * tlsIO.c: * tlsBIO.c: * tls.c: changed around to only working with 8.2.0+ (8.3.2+ preferred), with runtime checks for pre- and post-io-rewrite. check-in: 33ea0b5a9d user: hobbs tags: trunk | |
2000-08-14
| ||
21:55 | * tls.c (Tls_Init): changed it to require 8.3.2 when Tcl_InitStubs was called because we don't want people using TLS with the original stacked channel implementation. check-in: 2b0ce3e01b user: hobbs tags: trunk | |
Changes
Modified ChangeLog from [d63d0daba3] to [90bb6e0e94].
1 2 3 4 5 6 7 8 9 | 2000-08-14 Jeff Hobbs <[email protected]> * tls.c (Tls_Init): changed it to require 8.3.2 when Tcl_InitStubs was called because we don't want people using TLS with the original stacked channel implementation. 2000-07-26 Jeff Hobbs <[email protected]> * merged all changes from tls-1-3-io-rewrite back into main branch | > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 | 2000-08-14 Jeff Hobbs <[email protected]> * tlsInt.h: * tlsIO.c: * tlsBIO.c: * tls.c: changed around to only working with 8.2.0+ (8.3.2+ preferred), with runtime checks for pre- and post-io-rewrite. * tls.c (Tls_Init): changed it to require 8.3.2 when Tcl_InitStubs was called because we don't want people using TLS with the original stacked channel implementation. 2000-07-26 Jeff Hobbs <[email protected]> * merged all changes from tls-1-3-io-rewrite back into main branch |
︙ | ︙ |
Modified tls.c from [5bbd225a1e] to [468d0efc89].
1 2 3 | /* * Copyright (C) 1997-1999 Matt Newman <[email protected]> * | | | 1 2 3 4 5 6 7 8 9 10 11 | /* * Copyright (C) 1997-1999 Matt Newman <[email protected]> * * $Header: /home/rkeene/tmp/cvs2fossil/../tcltls/tls/tls/tls.c,v 1.9 2000/08/15 00:02:08 hobbs Exp $ * * TLS (aka SSL) Channel - can be layered on any bi-directional * Tcl_Channel (Note: Requires Trf Core Patch) * * This was built (almost) from scratch based upon observation of * OpenSSL 0.9.2B * |
︙ | ︙ | |||
84 85 86 87 88 89 90 91 92 93 94 95 96 97 | if ((dh->p == NULL) || (dh->g == NULL)) return(NULL); return(dh); } #endif /* * We lose the tcl password callback when we use the RSA BSAFE SSL-C 1.1.2 * libraries instead of the current OpenSSL libraries. */ #ifdef BSAFE | > > > > > | 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 | if ((dh->p == NULL) || (dh->g == NULL)) return(NULL); return(dh); } #endif /* * Defined in Tls_Init to determine what kind of channels we are using * (old-style 8.2.0-8.3.1 or new-style 8.3.2+). */ int channelTypeVersion; /* * We lose the tcl password callback when we use the RSA BSAFE SSL-C 1.1.2 * libraries instead of the current OpenSSL libraries. */ #ifdef BSAFE |
︙ | ︙ | |||
538 539 540 541 542 543 544 | return TCL_ERROR; } chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], NULL), NULL); if (chan == (Tcl_Channel) NULL) { return TCL_ERROR; } | | | | | | < > | 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 | return TCL_ERROR; } chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], NULL), NULL); if (chan == (Tcl_Channel) NULL) { return TCL_ERROR; } if (channelTypeVersion == TLS_CHANNEL_VERSION_2) { /* * 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); |
︙ | ︙ | |||
638 639 640 641 642 643 644 | return TCL_ERROR; } chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], NULL), NULL); if (chan == (Tcl_Channel) NULL) { return TCL_ERROR; } | | | | | | < > | 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 | return TCL_ERROR; } chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], NULL), NULL); if (chan == (Tcl_Channel) NULL) { return TCL_ERROR; } if (channelTypeVersion == TLS_CHANNEL_VERSION_2) { /* * 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; |
︙ | ︙ | |||
692 693 694 695 696 697 698 | if (model != NULL) { int mode; /* Get the "model" context */ chan = Tcl_GetChannel(interp, model, &mode); if (chan == (Tcl_Channel) NULL) { return TCL_ERROR; } | | | | | | < > | 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 | if (model != NULL) { int mode; /* Get the "model" context */ chan = Tcl_GetChannel(interp, model, &mode); if (chan == (Tcl_Channel) NULL) { return TCL_ERROR; } if (channelTypeVersion == TLS_CHANNEL_VERSION_2) { /* * 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); ctx = statePtr->ctx; |
︙ | ︙ | |||
739 740 741 742 743 744 745 | /* * We need to make sure that the channel works in binary (for the * encryption not to get goofed up). * We only want to adjust the buffering in pre-v2 channels, where * each channel in the stack maintained its own buffers. */ Tcl_SetChannelOption(interp, chan, "-translation", "binary"); | | | < | | < < < < < | | | | | | | < < > | 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 | /* * We need to make sure that the channel works in binary (for the * encryption not to get goofed up). * We only want to adjust the buffering in pre-v2 channels, where * each channel in the stack maintained its own buffers. */ Tcl_SetChannelOption(interp, chan, "-translation", "binary"); if (channelTypeVersion == TLS_CHANNEL_VERSION_1) { Tcl_SetChannelOption(interp, chan, "-buffering", "none"); } if (channelTypeVersion == TLS_CHANNEL_VERSION_2) { statePtr->self = Tcl_StackChannel(interp, Tls_ChannelType(), (ClientData) statePtr, (TCL_READABLE | TCL_WRITABLE), chan); } else { statePtr->self = chan; Tcl_StackChannel(interp, Tls_ChannelType(), (ClientData) statePtr, (TCL_READABLE | TCL_WRITABLE), chan); } if (statePtr->self == (Tcl_Channel) NULL) { /* * No use of Tcl_EventuallyFree because no possible Tcl_Preserve. */ Tls_Free((char *) statePtr); return TCL_ERROR; } |
︙ | ︙ | |||
1020 1021 1022 1023 1024 1025 1026 | } channelName = Tcl_GetStringFromObj(objv[1], NULL); chan = Tcl_GetChannel(interp, channelName, &mode); if (chan == (Tcl_Channel) NULL) { return TCL_ERROR; } | | | | | | < > | 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 | } channelName = Tcl_GetStringFromObj(objv[1], NULL); chan = Tcl_GetChannel(interp, channelName, &mode); if (chan == (Tcl_Channel) NULL) { return TCL_ERROR; } if (channelTypeVersion == TLS_CHANNEL_VERSION_2) { /* * 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); peer = SSL_get_peer_certificate(statePtr->ssl); |
︙ | ︙ | |||
1136 1137 1138 1139 1140 1141 1142 | *------------------------------------------------------------------- */ int Tls_Init(Tcl_Interp *interp) /* Interpreter in which the package is * to be made available. */ { | > | | > > | > > > > | > > > > > > > > > > > > > > | 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 | *------------------------------------------------------------------- */ int Tls_Init(Tcl_Interp *interp) /* Interpreter in which the package is * to be made available. */ { int major, minor, release, serial; /* * The original 8.2.0 stacked channel implementation (and the patch * that preceded it) had problems with scalability and robustness. * These were address in 8.3.2 / 8.4a2, so we now require that as a * minimum for TLS 1.4+. We only support 8.2+ now (8.3.2+ preferred). */ if ( #ifdef USE_TCL_STUBS Tcl_InitStubs(interp, "8.2", 0) #else Tcl_PkgRequire(interp, "Tcl", "8.2", 0) #endif == NULL) { return TCL_ERROR; } /* * Get the version so we can runtime switch on available functionality. * TLS should really only be used in 8.3.2+, but the other works for * some limited functionality, so an attempt at support is made. */ Tcl_GetVersion(&major, &minor, &release, &serial); if ((major > 8) || ((major == 8) && ((minor > 3) || ((minor == 3) && (release == TCL_FINAL_RELEASE) && (serial >= 2))))) { /* 8.3.2+ */ channelTypeVersion = TLS_CHANNEL_VERSION_2; } else { /* 8.2.0 - 8.3.1 */ channelTypeVersion = TLS_CHANNEL_VERSION_1; } if (SSL_library_init() != 1) { Tcl_AppendResult(interp, "could not initialize SSL library", NULL); return TCL_ERROR; } SSL_load_error_strings(); ERR_load_crypto_strings(); |
︙ | ︙ |
Modified tlsBIO.c from [03080294a4] to [c6f920b02f].
1 2 3 | /* * Copyright (C) 1997-2000 Matt Newman <[email protected]> * | | | 1 2 3 4 5 6 7 8 9 10 11 | /* * Copyright (C) 1997-2000 Matt Newman <[email protected]> * * $Header: /home/rkeene/tmp/cvs2fossil/../tcltls/tls/tls/tlsBIO.c,v 1.4 2000/08/15 00:02:08 hobbs Exp $ * * Provides BIO layer to interface openssl to Tcl. */ #include "tlsInt.h" /* |
︙ | ︙ | |||
59 60 61 62 63 64 65 | int bufLen; { Tcl_Channel chan = Tls_GetParent((State*)(bio->ptr)); int ret; dprintf(stderr,"\nBioWrite(0x%x, <buf>, %d) [0x%x]", bio, bufLen, chan); | | | | | < > | 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 | int bufLen; { Tcl_Channel chan = Tls_GetParent((State*)(bio->ptr)); int ret; dprintf(stderr,"\nBioWrite(0x%x, <buf>, %d) [0x%x]", bio, bufLen, chan); if (channelTypeVersion == TLS_CHANNEL_VERSION_2) { ret = Tcl_WriteRaw(chan, buf, bufLen); } else { ret = Tcl_Write(chan, buf, bufLen); } dprintf(stderr,"\n[0x%x] BioWrite(%d) -> %d [%d.%d]", chan, bufLen, ret, Tcl_Eof(chan), Tcl_GetErrno()); BIO_clear_flags(bio, BIO_FLAGS_WRITE|BIO_FLAGS_SHOULD_RETRY); if (ret == 0) { |
︙ | ︙ | |||
95 96 97 98 99 100 101 | Tcl_Channel chan = Tls_GetParent((State*)bio->ptr); int ret = 0; dprintf(stderr,"\nBioRead(0x%x, <buf>, %d) [0x%x]", bio, bufLen, chan); if (buf == NULL) return 0; | | | | | < > | 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 | Tcl_Channel chan = Tls_GetParent((State*)bio->ptr); int ret = 0; dprintf(stderr,"\nBioRead(0x%x, <buf>, %d) [0x%x]", bio, bufLen, chan); if (buf == NULL) return 0; if (channelTypeVersion == TLS_CHANNEL_VERSION_2) { ret = Tcl_ReadRaw(chan, buf, bufLen); } else { ret = Tcl_Read(chan, buf, bufLen); } dprintf(stderr,"\n[0x%x] BioRead(%d) -> %d [%d.%d]", chan, bufLen, ret, Tcl_Eof(chan), Tcl_GetErrno()); BIO_clear_flags(bio, BIO_FLAGS_READ|BIO_FLAGS_SHOULD_RETRY); if (ret == 0) { |
︙ | ︙ | |||
188 189 190 191 192 193 194 | case BIO_CTRL_WPENDING: ret = 0; break; case BIO_CTRL_DUP: break; case BIO_CTRL_FLUSH: dprintf(stderr, "BIO_CTRL_FLUSH\n"); | < | | | | < < < < < | 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 | case BIO_CTRL_WPENDING: ret = 0; break; case BIO_CTRL_DUP: break; case BIO_CTRL_FLUSH: dprintf(stderr, "BIO_CTRL_FLUSH\n"); if (channelTypeVersion == TLS_CHANNEL_VERSION_2) { ret = ((Tcl_WriteRaw(chan, "", 0) >= 0) ? 1 : -1); } else { ret = ((Tcl_Flush(chan) == TCL_OK) ? 1 : -1); } break; default: ret = 0; break; } return(ret); |
︙ | ︙ |
Modified tlsIO.c from [8569dadd68] to [7f2f9df19f].
1 2 3 | /* * Copyright (C) 1997-2000 Matt Newman <[email protected]> * | | | 1 2 3 4 5 6 7 8 9 10 11 | /* * Copyright (C) 1997-2000 Matt Newman <[email protected]> * * $Header: /home/rkeene/tmp/cvs2fossil/../tcltls/tls/tls/tlsIO.c,v 1.9 2000/08/15 00:02:08 hobbs Exp $ * * TLS (aka SSL) Channel - can be layered on any bi-directional * Tcl_Channel (Note: Requires Trf Core Patch) * * This was built from scratch based upon observation of OpenSSL 0.9.2B * * Addition credit is due for Andreas Kupries ([email protected]), for |
︙ | ︙ | |||
52 53 54 55 56 57 58 | int mask)); static void TlsChannelHandlerTimer _ANSI_ARGS_ ((ClientData clientData)); /* * This structure describes the channel type structure for TCP socket * based IO: */ | < | > > > > > > | | | > > > > > > < > | > > > | 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 | int mask)); static void TlsChannelHandlerTimer _ANSI_ARGS_ ((ClientData clientData)); /* * This structure describes the channel type structure for TCP socket * based IO: */ static Tcl_ChannelType tlsChannelType2 = { "tls", /* Type name. */ #ifndef TCL_CHANNEL_VERSION_2 /* * Avoids warning in Windows compiler when compiling with 8.3.1-. */ (Tcl_DriverBlockModeProc *) #endif TCL_CHANNEL_VERSION_2, /* A v2 channel (8.3.2+) */ TlsCloseProc, /* Close proc. */ TlsInputProc, /* Input proc. */ TlsOutputProc, /* Output proc. */ NULL, /* Seek proc. */ NULL, /* Set option proc. */ TlsGetOptionProc, /* Get option proc. */ TlsWatchProc, /* Initialize notifier. */ TlsGetHandleProc, /* Get file handle out of channel. */ NULL, /* Close2Proc. */ TlsBlockModeProc, /* Set blocking/nonblocking mode.*/ NULL, /* FlushProc. */ TlsNotifyProc, /* handlerProc. */ }; static Tcl_ChannelType tlsChannelType1 = { "tls", /* Type name. */ #ifdef TCL_CHANNEL_VERSION_2 /* * Avoids warning in Windows compiler when compiling with 8.3.2+. */ (Tcl_ChannelTypeVersion) #endif TlsBlockModeProc, /* Set blocking/nonblocking mode.*/ TlsCloseProc, /* Close proc. */ TlsInputProc, /* Input proc. */ TlsOutputProc, /* Output proc. */ NULL, /* Seek proc. */ NULL, /* Set option proc. */ TlsGetOptionProc, /* Get option proc. */ TlsWatchProc, /* Initialize notifier. */ TlsGetHandleProc, /* Get file handle out of channel. */ }; Tcl_ChannelType *Tls_ChannelType() { if (channelTypeVersion == TLS_CHANNEL_VERSION_2) { return &tlsChannelType2; } else { return &tlsChannelType1; } } /* *------------------------------------------------------------------- * * TlsBlockModeProc -- * |
︙ | ︙ | |||
118 119 120 121 122 123 124 | State *statePtr = (State *) instanceData; if (mode == TCL_MODE_NONBLOCKING) { statePtr->flags |= TLS_TCL_ASYNC; } else { statePtr->flags &= ~(TLS_TCL_ASYNC); } | | | | | < > | 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 | State *statePtr = (State *) instanceData; if (mode == TCL_MODE_NONBLOCKING) { statePtr->flags |= TLS_TCL_ASYNC; } else { statePtr->flags &= ~(TLS_TCL_ASYNC); } if (channelTypeVersion == TLS_CHANNEL_VERSION_2) { return 0; } else { return Tcl_SetChannelOption(statePtr->interp, Tls_GetParent(statePtr), "-blocking", (mode == TCL_MODE_NONBLOCKING) ? "0" : "1"); } } /* *------------------------------------------------------------------- * * TlsCloseProc -- * |
︙ | ︙ | |||
153 154 155 156 157 158 159 | TlsCloseProc(ClientData instanceData, /* The socket to close. */ Tcl_Interp *interp) /* For error reporting - unused. */ { State *statePtr = (State *) instanceData; dprintf(stderr,"\nTlsCloseProc(0x%x)", statePtr); | | | | | | | | < > | 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 | TlsCloseProc(ClientData instanceData, /* The socket to close. */ Tcl_Interp *interp) /* For error reporting - unused. */ { State *statePtr = (State *) instanceData; dprintf(stderr,"\nTlsCloseProc(0x%x)", statePtr); if (channelTypeVersion == TLS_CHANNEL_VERSION_1) { /* * Remove event handler to underlying channel, this could * be because we are closing for real, or being "unstacked". */ Tcl_DeleteChannelHandler(Tls_GetParent(statePtr), TlsChannelHandler, (ClientData) statePtr); } Tls_Clean(statePtr); Tcl_EventuallyFree((ClientData)statePtr, Tls_Free); return TCL_OK; } /* |
︙ | ︙ | |||
359 360 361 362 363 364 365 | *------------------------------------------------------------------- * * TlsGetOptionProc -- * * Computes an option value for a SSL socket based channel, or a * list of all options and their values. * | < < | | | | | | | < > > | | | | | | | | | | | | | | | | | < | | | | < | | | | | | | | | | | < > | 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 | *------------------------------------------------------------------- * * TlsGetOptionProc -- * * Computes an option value for a SSL socket based channel, or a * list of all options and their values. * * Results: * A standard Tcl result. The value of the specified option or a * list of all options and their values is returned in the * supplied DString. * * Side effects: * None. * *------------------------------------------------------------------- */ static int TlsGetOptionProc(ClientData instanceData, /* Socket state. */ Tcl_Interp *interp, /* For errors - can be NULL. */ char *optionName, /* Name of the option to * retrieve the value for, or * NULL to get all options and * their values. */ Tcl_DString *dsPtr) /* Where to store the computed value * initialized by caller. */ { State *statePtr = (State *) instanceData; if (channelTypeVersion == TLS_CHANNEL_VERSION_2) { Tcl_Channel downChan = Tls_GetParent(statePtr); Tcl_DriverGetOptionProc *getOptionProc; getOptionProc = Tcl_ChannelGetOptionProc(Tcl_GetChannelType(downChan)); if (getOptionProc != NULL) { return (*getOptionProc)(Tcl_GetChannelInstanceData(downChan), interp, optionName, dsPtr); } else if (optionName == (char*) NULL) { /* * Request is query for all options, this is ok. */ return TCL_OK; } /* * Request for a specific option has to fail, we don't have any. */ return TCL_ERROR; } else { size_t len = 0; if (optionName != (char *) NULL) { len = strlen(optionName); } #if 0 if ((len == 0) || ((len > 1) && (optionName[1] == 'c') && (strncmp(optionName, "-cipher", len) == 0))) { if (len == 0) { Tcl_DStringAppendElement(dsPtr, "-cipher"); } Tcl_DStringAppendElement(dsPtr, SSL_get_cipher(statePtr->ssl)); if (len) { return TCL_OK; } } #endif return TCL_OK; } } /* *------------------------------------------------------------------- * * TlsWatchProc -- * |
︙ | ︙ | |||
449 450 451 452 453 454 455 | TlsWatchProc(ClientData instanceData, /* The socket state. */ int mask) /* Events of interest; an OR-ed * combination of TCL_READABLE, * TCL_WRITABLE and TCL_EXCEPTION. */ { State *statePtr = (State *) instanceData; | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | > | < > | 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 | TlsWatchProc(ClientData instanceData, /* The socket state. */ int mask) /* Events of interest; an OR-ed * combination of TCL_READABLE, * TCL_WRITABLE and TCL_EXCEPTION. */ { State *statePtr = (State *) instanceData; if (channelTypeVersion == TLS_CHANNEL_VERSION_2) { Tcl_Channel downChan; statePtr->watchMask = mask; /* No channel handlers any more. We will be notified automatically * about events on the channel below via a call to our * 'TransformNotifyProc'. But we have to pass the interest down now. * We are allowed to add additional 'interest' to the mask if we want * to. But this transformation has no such interest. It just passes * the request down, unchanged. */ downChan = Tls_GetParent(statePtr); (Tcl_GetChannelType(downChan)) ->watchProc(Tcl_GetChannelInstanceData(downChan), mask); /* * Management of the internal timer. */ if (statePtr->timer != (Tcl_TimerToken) NULL) { Tcl_DeleteTimerHandler(statePtr->timer); statePtr->timer = (Tcl_TimerToken) NULL; } if ((mask & TCL_READABLE) && Tcl_InputBuffered(statePtr->self) > 0) { /* * There is interest in readable events and we actually have * data waiting, so generate a timer to flush that. */ statePtr->timer = Tcl_CreateTimerHandler(TLS_TCL_DELAY, TlsChannelHandlerTimer, (ClientData) statePtr); } } else { if (mask == statePtr->watchMask) return; if (statePtr->watchMask) { /* * Remove event handler to underlying channel, this could * be because we are closing for real, or being "unstacked". */ Tcl_DeleteChannelHandler(Tls_GetParent(statePtr), TlsChannelHandler, (ClientData) statePtr); } statePtr->watchMask = mask; if (statePtr->watchMask) { /* * Setup active monitor for events on underlying Channel. */ Tcl_CreateChannelHandler(Tls_GetParent(statePtr), statePtr->watchMask, TlsChannelHandler, (ClientData) statePtr); } } } /* *------------------------------------------------------------------- * * TlsGetHandleProc -- * |
︙ | ︙ | |||
580 581 582 583 584 585 586 | Tcl_DeleteTimerHandler(statePtr->timer); statePtr->timer = (Tcl_TimerToken) NULL; } return mask; } | < | 592 593 594 595 596 597 598 599 600 601 602 603 604 605 | Tcl_DeleteTimerHandler(statePtr->timer); statePtr->timer = (Tcl_TimerToken) NULL; } return mask; } /* *------------------------------------------------------* * * TlsChannelHandler -- * * ------------------------------------------------* * Handler called by Tcl as a result of |
︙ | ︙ | |||
660 661 662 663 664 665 666 | * Data is waiting, flush it out in short time */ statePtr->timer = Tcl_CreateTimerHandler(TLS_TCL_DELAY, TlsChannelHandlerTimer, (ClientData) statePtr); } Tcl_Release( (ClientData)statePtr); } | < | 671 672 673 674 675 676 677 678 679 680 681 682 683 684 | * Data is waiting, flush it out in short time */ statePtr->timer = Tcl_CreateTimerHandler(TLS_TCL_DELAY, TlsChannelHandlerTimer, (ClientData) statePtr); } Tcl_Release( (ClientData)statePtr); } /* *------------------------------------------------------* * * TlsChannelHandlerTimer -- * * ------------------------------------------------* |
︙ | ︙ | |||
776 777 778 779 780 781 782 | } } Tcl_Channel Tls_GetParent( statePtr ) State *statePtr; { | | | | < < < | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | < < > | 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 | } } Tcl_Channel Tls_GetParent( statePtr ) State *statePtr; { if (channelTypeVersion == TLS_CHANNEL_VERSION_2) { return Tcl_GetStackedChannel(statePtr->self); } else { /* The reason for the existence of this procedure is * the fact that stacking a transform over another * transform will leave our internal pointer unchanged, * and thus pointing to the new transform, and not the * Channel structure containing the saved state of this * transform. This is the price to pay for leaving * Tcl_Channel references intact. The only other solution * is an extension of Tcl_ChannelType with another driver * procedure to notify a Channel about the (un)stacking. * * It walks the chain of Channel structures until it * finds the one pointing having 'ctrl' as instanceData * and then returns the superceding channel to that. (AK) */ Tcl_Channel self = statePtr->self; Tcl_Channel next; while ((ClientData) statePtr != Tcl_GetChannelInstanceData (self)) { next = Tcl_GetStackedChannel (self); if (next == (Tcl_Channel) NULL) { /* 09/24/1999 Unstacking bug, * found by Matt Newman <[email protected]>. * * We were unable to find the channel structure for this * transformation in the chain of stacked channel. This * means that we are currently in the process of unstacking * it *and* there were some bytes waiting which are now * flushed. In this situation the pointer to the channel * itself already refers to the parent channel we have to * write the bytes into, so we return that. */ return statePtr->self; } self = next; } return Tcl_GetStackedChannel (self); } } |
Modified tlsInt.h from [b5b99844b7] to [b040f94bfd].
1 2 3 | /* * Copyright (C) 1997-2000 Matt Newman <[email protected]> * | | | 1 2 3 4 5 6 7 8 9 10 11 | /* * Copyright (C) 1997-2000 Matt Newman <[email protected]> * * $Header: /home/rkeene/tmp/cvs2fossil/../tcltls/tls/tls/tlsInt.h,v 1.6 2000/08/15 00:02:08 hobbs Exp $ * * TLS (aka SSL) Channel - can be layered on any bi-directional * Tcl_Channel (Note: Requires Trf Core Patch) * * This was built from scratch based upon observation of OpenSSL 0.9.2B * * Addition credit is due for Andreas Kupries ([email protected]), for |
︙ | ︙ | |||
81 82 83 84 85 86 87 | * This structure describes the per-instance state * of an ssl channel. * * The SSL processing context is maintained here, in the ClientData */ typedef struct State { Tcl_Channel self; /* this socket channel */ | < < < > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 81 82 83 84 85 86 87 88 89 90 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 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 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 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 | * This structure describes the per-instance state * of an ssl channel. * * The SSL processing context is maintained here, in the ClientData */ typedef struct State { Tcl_Channel self; /* this socket channel */ Tcl_TimerToken timer; int flags; /* currently only CHANNEL_ASYNC */ int watchMask; /* current WatchProc mask */ int mode; /* current mode of parent channel */ Tcl_Interp *interp; /* interpreter in which this resides */ Tcl_Obj *callback; /* script called for tracing, verifying and errors */ int vflags; /* verify flags */ SSL *ssl; /* Struct for SSL processing */ SSL_CTX *ctx; /* SSL Context */ BIO *bio; /* Struct for SSL processing */ BIO *p_bio; /* Parent BIO (that is layered on Tcl_Channel) */ char *err; } State; /* * The following definitions have to be usable for 8.0.x, 8.1.x, 8.2.x, * 8.3.[01], 8.3.2 and beyond. The differences between these versions: * * 8.0-8.1: There is no support for these in TLS 1.4 (get 1.3). This * was the version with the original patch. * * 8.2.0- Changed semantics for Tcl_StackChannel (Tcl_ReplaceChannel). * 8.3.1: Check at runtime to switch the behaviour. The patch is part * of the core from now on. * * 8.3.2+: Stacked channels rewritten for better behaviour in some * situations (closing). Some new API's, semantic changes. * * The following magic was taken from Trf 2.1 (Kupries). */ #define TLS_CHANNEL_VERSION_1 0x1 #define TLS_CHANNEL_VERSION_2 0x2 extern int channelTypeVersion; #ifdef USE_TCL_STUBS #ifndef Tcl_StackChannel /* * The core we are compiling against is not patched, so supply the * necesssary definitions here by ourselves. The form chosen for * the procedure macros (reservedXXX) will notify us if the core * does not have these reserved locations anymore. * * !! Synchronize the procedure indices in their definitions with * the patch to tcl.decls, as they have to be the same. */ /* 281 */ typedef Tcl_Channel (tls_StackChannel) _ANSI_ARGS_((Tcl_Interp* interp, Tcl_ChannelType* typePtr, ClientData instanceData, int mask, Tcl_Channel prevChan)); /* 282 */ typedef void (tls_UnstackChannel) _ANSI_ARGS_((Tcl_Interp* interp, Tcl_Channel chan)); #define Tcl_StackChannel ((tls_StackChannel*) tclStubsPtr->reserved281) #define Tcl_UnstackChannel ((tls_UnstackChannel*) tclStubsPtr->reserved282) #endif /* Tcl_StackChannel */ #ifndef Tcl_GetStackedChannel /* * Separate definition, available in 8.2, but not 8.1 and before ! */ /* 283 */ typedef Tcl_Channel (tls_GetStackedChannel) _ANSI_ARGS_((Tcl_Channel chan)); #define Tcl_GetStackedChannel ((tls_GetStackedChannel*) tclStubsPtr->reserved283) #endif /* Tcl_GetStackedChannel */ #ifndef Tcl_WriteRaw /* * Core is older than 8.3.2. Supply the missing definitions for * the new API's in 8.3.2. */ /* 394 */ typedef int (tls_ReadRaw) _ANSI_ARGS_((Tcl_Channel chan, char *dst, int bytesToRead)); /* 395 */ typedef int (tls_WriteRaw) _ANSI_ARGS_((Tcl_Channel chan, char *src, int srcLen)); /* 397 */ typedef int (tls_GetTopChannel) _ANSI_ARGS_((Tcl_Channel chan)); /* * Generating code for accessing these parts of the stub table when * compiling against a core older than 8.3.2 is a hassle because even * the 'reservedXXX' fields of the structure are not defined yet. So * we have to write up some macros hiding some very hackish pointer * arithmetics to get at these fields. We assume that pointer to * functions are always of the same size. */ #define STUB_BASE ((char*)(&(tclStubsPtr->tcl_UtfNcasecmp))) /* field 370 */ #define procPtrSize (sizeof (Tcl_DriverBlockModeProc *)) #define IDX(n) (((n)-370) * procPtrSize) #define SLOT(n) (STUB_BASE + IDX(n)) #define Tcl_ReadRaw (*((tls_ReadRaw**) (SLOT(394)))) #define Tcl_WriteRaw (*((tls_WriteRaw**) (SLOT(395)))) #define Tcl_GetTopChannel (*((tls_GetTopChannel**)(SLOT(396)))) typedef struct TlsChannelTypeVersion_* TlsChannelTypeVersion; #define TCL_CHANNEL_VERSION_2 ((TlsChannelTypeVersion) 0x2) /* * Required, easy emulation. */ #define Tcl_ChannelGetOptionProc(chanDriver) ((chanDriver)->getOptionProc) #endif /* Tcl_WriteRaw */ #endif /* USE_TCL_STUBS */ /* * Forward declarations */ EXTERN Tcl_ChannelType *Tls_ChannelType _ANSI_ARGS_((void)); EXTERN Tcl_Channel Tls_GetParent _ANSI_ARGS_((State *statePtr)); |
︙ | ︙ |