Overview
Comment: | * tls.c (ImportObjCmd): removed unnecessary use of 'bio' arg. (Tls_Init): check return value of SSL_library_init. Also lots of whitespace cleanup (more like Tcl Eng style guide), but not all code was cleaned up. * tlsBIO.c: minor whitespace cleanup * tlsIO.c: minor whitespace cleanup. (TlsInputProc, TlsOutputProc): Added ERR_clear_error before calls to BIO_read or BIO_write, because we could otherwise end up pulling an error off the stack that didn't belong to us. Also cleanup up excessive use of gotos. |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | tls-1-3-io-rewrite |
Files: | files | file ages | folders |
SHA1: |
e64e21d80e4a03c855cf0ab9cbd330f3 |
User & Date: | hobbs on 2000-07-26 22:15:07 |
Other Links: | branch diff | manifest | tags |
Context
2000-07-26
| ||
23:11 | * tests/tlsIO.test: updated comments, fixed a pcCrash case that was due to debug assertion in Windows SSL. Closed-Leaf check-in: 5ed815df85 user: hobbs tags: merge-1-3-io-rewrite-07-26-00, tls-1-3-io-rewrite | |
22:15 | * tls.c (ImportObjCmd): removed unnecessary use of 'bio' arg. (Tls_Init): check return value of SSL_library_init. Also lots of whitespace cleanup (more like Tcl Eng style guide), but not all code was cleaned up. * tlsBIO.c: minor whitespace cleanup * tlsIO.c: minor whitespace cleanup. (TlsInputProc, TlsOutputProc): Added ERR_clear_error before calls to BIO_read or BIO_write, because we could otherwise end up pulling an error off the stack that didn't belong to us. Also cleanup up excessive use of gotos. check-in: e64e21d80e user: hobbs tags: tls-1-3-io-rewrite | |
2000-07-21
| ||
05:32 | * tests/tlsIO.test: corrected various tests to be correct for TLS stacked channels (as opposed to the standard sockets the test suite was adopted from). Key differences are that TLS cannot operate in one process without all channels being non-blocking, or the handshake will block, and handshaking must be forced in some cases. Also, handshakes don't seem to complete unless the client has placed at least one byte for the server to read in the channel. * tests/remote.tcl: corrected the finding of tests certificates * tlsIO.c (TlsCloseProc): removed deleting of timer handler as that is handled by Tls_Clean. * tls.tcl (tls::_accept): corrected the internal _accept to trickle callback errors to the user. * Makefile.in: made the install-binaries target regenerate the pkgIndex.tcl correctly. The test target probably shouldn't screw it up, but this is to be on the safe side. check-in: 977988aed6 user: hobbs tags: tls-1-3-io-rewrite | |
Changes
Modified ChangeLog from [c9bfe5bf82] to [2accd518be].
1 2 3 4 5 6 7 | 2000-07-20 Jeff Hobbs <[email protected]> * tests/tlsIO.test: corrected various tests to be correct for TLS stacked channels (as opposed to the standard sockets the test suite was adopted from). Key differences are that TLS cannot operate in one process without all channels being non-blocking, or the handshake will block, and handshaking must be forced in some | > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 | 2000-07-26 Jeff Hobbs <[email protected]> * tls.c (ImportObjCmd): removed unnecessary use of 'bio' arg. (Tls_Init): check return value of SSL_library_init. Also lots of whitespace cleanup (more like Tcl Eng style guide), but not all code was cleaned up. * tlsBIO.c: minor whitespace cleanup * tlsIO.c: minor whitespace cleanup. (TlsInputProc, TlsOutputProc): Added ERR_clear_error before calls to BIO_read or BIO_write, because we could otherwise end up pulling an error off the stack that didn't belong to us. Also cleanup up excessive use of gotos. 2000-07-20 Jeff Hobbs <[email protected]> * tests/tlsIO.test: corrected various tests to be correct for TLS stacked channels (as opposed to the standard sockets the test suite was adopted from). Key differences are that TLS cannot operate in one process without all channels being non-blocking, or the handshake will block, and handshaking must be forced in some |
︙ | ︙ |
Modified tls.c from [82fbf20832] to [d793bbc229].
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.6.2.3 2000/07/26 22:15:07 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 * |
︙ | ︙ | |||
217 218 219 220 221 222 223 224 225 226 | * The err field of the currently operative State is set * to a string describing the SSL negotiation failure reason *------------------------------------------------------------------- */ static int VerifyCallback(int ok, X509_STORE_CTX *ctx) { SSL *ssl = (SSL*)X509_STORE_CTX_get_app_data(ctx); X509 *cert = X509_STORE_CTX_get_current_cert(ctx); State *statePtr = (State*)SSL_get_app_data(ssl); | > > < < | | | > | | > | 217 218 219 220 221 222 223 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 | * The err field of the currently operative State is set * to a string describing the SSL negotiation failure reason *------------------------------------------------------------------- */ static int VerifyCallback(int ok, X509_STORE_CTX *ctx) { Tcl_Obj *cmdPtr; char *errStr; SSL *ssl = (SSL*)X509_STORE_CTX_get_app_data(ctx); X509 *cert = X509_STORE_CTX_get_current_cert(ctx); State *statePtr = (State*)SSL_get_app_data(ssl); int depth = X509_STORE_CTX_get_error_depth(ctx); int err = X509_STORE_CTX_get_error(ctx); dprintf(stderr, "Verify: %d\n", ok); if (!ok) { errStr = (char*)X509_verify_cert_error_string(err); } else { errStr = (char *)0; } if (statePtr->callback == (Tcl_Obj*)NULL) { if (statePtr->vflags & SSL_VERIFY_FAIL_IF_NO_PEER_CERT) { return ok; } else { return 1; } } cmdPtr = Tcl_DuplicateObj(statePtr->callback); Tcl_ListObjAppendElement( statePtr->interp, cmdPtr, Tcl_NewStringObj( "verify", -1)); Tcl_ListObjAppendElement( statePtr->interp, cmdPtr, |
︙ | ︙ | |||
455 456 457 458 459 460 461 | Tcl_AppendResult(interp, "protocol not supported", NULL); return TCL_ERROR; #else ctx = SSL_CTX_new(TLSv1_method()); break; #endif } if (ctx == NULL) { | | < | < | 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 | Tcl_AppendResult(interp, "protocol not supported", NULL); return TCL_ERROR; #else ctx = SSL_CTX_new(TLSv1_method()); break; #endif } if (ctx == NULL) { Tcl_AppendResult(interp, REASON(), (char *) NULL); return TCL_ERROR; } ssl = SSL_new(ctx); if (ssl == NULL) { Tcl_AppendResult(interp, REASON(), (char *) NULL); SSL_CTX_free(ctx); return TCL_ERROR; } objPtr = Tcl_NewListObj( 0, NULL); if (!verbose) { for (index = 0; ; index++) { |
︙ | ︙ | |||
568 569 570 571 572 573 574 575 576 577 578 579 580 581 | } Tcl_AppendResult(interp, "handshake failed: ", errStr, (char *) NULL); return TCL_ERROR; } } Tcl_SetObjResult(interp, Tcl_NewIntObj(ret)); return TCL_OK; } /* *------------------------------------------------------------------- * | > | 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 | } Tcl_AppendResult(interp, "handshake failed: ", errStr, (char *) NULL); return TCL_ERROR; } } Tcl_SetObjResult(interp, Tcl_NewIntObj(ret)); return TCL_OK; } /* *------------------------------------------------------------------- * |
︙ | ︙ | |||
598 599 600 601 602 603 604 | ImportObjCmd(clientData, interp, objc, objv) ClientData clientData; /* Not used. */ Tcl_Interp *interp; int objc; Tcl_Obj *CONST objv[]; { Tcl_Channel chan; /* The channel to set a mode on. */ | < | 599 600 601 602 603 604 605 606 607 608 609 610 611 612 | ImportObjCmd(clientData, interp, objc, objv) ClientData clientData; /* Not used. */ 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 */ SSL_CTX *ctx = NULL; Tcl_Obj *script = NULL; int idx; int flags = TLS_TCL_INIT; int server = 0; /* is connection incoming or outgoing? */ char *key = NULL; |
︙ | ︙ | |||
689 690 691 692 693 694 695 | if (CAfile && !*CAfile) CAfile = NULL; if (CAdir && !*CAdir) CAdir = NULL; if (model != NULL) { int mode; /* Get the "model" context */ chan = Tcl_GetChannel( interp, model, &mode); | | | | | 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 | if (CAfile && !*CAfile) CAfile = NULL; if (CAdir && !*CAdir) CAdir = NULL; if (model != NULL) { int mode; /* Get the "model" context */ chan = Tcl_GetChannel( interp, model, &mode); if (chan == (Tcl_Channel) NULL) { return TCL_ERROR; } #ifdef TCL_CHANNEL_VERSION_2 /* * Make sure to operate on the topmost channel */ chan = Tcl_GetTopChannel(chan); #endif 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; } else { if ((ctx = CTX_Init( interp, proto, key, cert, CAdir, CAfile, ciphers)) == (SSL_CTX*)0) { |
︙ | ︙ | |||
732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 | statePtr->ssl = (SSL*)0; statePtr->ctx = ctx; statePtr->bio = (BIO*)0; statePtr->p_bio = (BIO*)0; statePtr->err = ""; Tcl_SetChannelOption(interp, chan, "-translation", "binary"); Tcl_SetChannelOption(interp, chan, "-buffering", "none"); #if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION < 2 statePtr->parent = chan; statePtr->self = Tcl_ReplaceChannel( interp, Tls_ChannelType(), (ClientData) statePtr, (TCL_READABLE | TCL_WRITABLE), statePtr->parent); #else | > > > > > > > > | 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 | statePtr->ssl = (SSL*)0; statePtr->ctx = ctx; statePtr->bio = (BIO*)0; statePtr->p_bio = (BIO*)0; statePtr->err = ""; /* * 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"); #ifndef TCL_CHANNEL_VERSION_2 Tcl_SetChannelOption(interp, chan, "-buffering", "none"); #endif #if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION < 2 statePtr->parent = chan; statePtr->self = Tcl_ReplaceChannel( interp, Tls_ChannelType(), (ClientData) statePtr, (TCL_READABLE | TCL_WRITABLE), statePtr->parent); #else |
︙ | ︙ | |||
779 780 781 782 783 784 785 | /* * SSL Initialization */ statePtr->ssl = SSL_new(statePtr->ctx); if (!statePtr->ssl) { /* SSL library error */ | < | | | | 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 | /* * SSL Initialization */ statePtr->ssl = SSL_new(statePtr->ctx); if (!statePtr->ssl) { /* SSL library error */ Tcl_AppendResult(interp, "couldn't construct ssl session: ", REASON(), (char *) NULL); Tls_Free((char *) statePtr); return TCL_ERROR; } /* * SSL Callbacks */ SSL_set_app_data(statePtr->ssl, (VOID *)statePtr); /* point back to us */ /* * The following is broken - we need is to set the * verify_mode, but the library ignores the verify_callback!!! */ /*SSL_set_verify(statePtr->ssl, verify, VerifyCallback);*/ SSL_CTX_set_info_callback( statePtr->ctx, InfoCallback); /* Create Tcl_Channel BIO Handler */ statePtr->p_bio = BIO_new_tcl(statePtr, BIO_CLOSE); statePtr->bio = BIO_new(BIO_f_ssl()); if (server) { statePtr->flags |= TLS_TCL_SERVER; SSL_set_accept_state(statePtr->ssl); } else { SSL_set_connect_state(statePtr->ssl); } SSL_set_bio(statePtr->ssl, statePtr->p_bio, statePtr->p_bio); BIO_set_ssl(statePtr->bio, statePtr->ssl, BIO_CLOSE); /* * End of SSL Init */ Tcl_SetResult(interp, Tcl_GetChannelName(statePtr->self), TCL_VOLATILE); return TCL_OK; |
︙ | ︙ | |||
1010 1011 1012 1013 1014 1015 1016 | if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "channel"); return TCL_ERROR; } channelName = Tcl_GetStringFromObj(objv[1], NULL); chan = Tcl_GetChannel( interp, channelName, &mode); | | | | > | 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 | if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "channel"); return TCL_ERROR; } channelName = Tcl_GetStringFromObj(objv[1], NULL); chan = Tcl_GetChannel( interp, channelName, &mode); if (chan == (Tcl_Channel) NULL) { return TCL_ERROR; } #ifdef TCL_CHANNEL_VERSION_2 /* * Make sure to operate on the topmost channel */ chan = Tcl_GetTopChannel(chan); #endif 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); if (peer) { objPtr = Tls_NewX509Obj( interp, peer); } else { objPtr = Tcl_NewListObj( 0, 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( SSL_get_cipher(statePtr->ssl), -1) ); |
︙ | ︙ | |||
1133 1134 1135 1136 1137 1138 1139 1140 1141 | * to be made available. */ { #if TCL_MAJOR_VERSION >= 8 && TCL_MINOR_VERSION >= 2 if (!Tcl_InitStubs(interp, TCL_VERSION, 0)) { return TCL_ERROR; } #endif SSL_load_error_strings(); ERR_load_crypto_strings(); | > > > > < | | | | | | | | < | 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 | * to be made available. */ { #if TCL_MAJOR_VERSION >= 8 && TCL_MINOR_VERSION >= 2 if (!Tcl_InitStubs(interp, TCL_VERSION, 0)) { return TCL_ERROR; } #endif 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(); Tcl_CreateObjCommand(interp, "tls::ciphers", CiphersObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateObjCommand(interp, "tls::handshake", HandshakeObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateObjCommand(interp, "tls::import", ImportObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateObjCommand(interp, "tls::status", StatusObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); return Tcl_PkgProvide(interp, PACKAGE, VERSION); } /* *------------------------------------------------------* * * Tls_SafeInit -- * * ------------------------------------------------* |
︙ | ︙ |
Modified tlsBIO.c from [1167365c8d] to [8a7d792ec5].
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.2.2.4 2000/07/26 22:15:07 hobbs Exp $ * * Provides BIO layer to interface openssl to Tcl. */ #include "tlsInt.h" /* |
︙ | ︙ | |||
54 55 56 57 58 59 60 | static int BioWrite (bio, buf, bufLen) BIO *bio; char *buf; int bufLen; { | | | 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 | static int BioWrite (bio, buf, bufLen) BIO *bio; char *buf; int bufLen; { Tcl_Channel chan = Tls_GetParent((State*)(bio->ptr)); int ret; dprintf(stderr,"\nBioWrite(0x%x, <buf>, %d) [0x%x]", bio, bufLen, chan); #ifdef TCL_CHANNEL_VERSION_2 ret = Tcl_WriteRaw( chan, buf, bufLen); #else |
︙ | ︙ | |||
76 77 78 79 80 81 82 | if (ret == 0) { if (!Tcl_Eof( chan)) { BIO_set_retry_write(bio); ret = -1; } } | | > | 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 | if (ret == 0) { if (!Tcl_Eof( chan)) { BIO_set_retry_write(bio); ret = -1; } } if (BIO_should_read(bio)) { BIO_set_retry_read(bio); } return ret; } static int BioRead (bio, buf, bufLen) BIO *bio; char *buf; |
︙ | ︙ | |||
111 112 113 114 115 116 117 | if (ret == 0) { if (!Tcl_Eof( chan)) { BIO_set_retry_read(bio); ret = -1; } } | | > | 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 | if (ret == 0) { if (!Tcl_Eof( chan)) { BIO_set_retry_read(bio); ret = -1; } } if (BIO_should_write(bio)) { BIO_set_retry_write(bio); } return ret; } static int BioPuts (bio, str) BIO *bio; char *str; |
︙ | ︙ |
Modified tlsIO.c from [d750d9a254] to [1cbb80c69b].
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.7.2.4 2000/07/26 22:15:07 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 |
︙ | ︙ | |||
210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 | if (bytesRead <= 0) { goto input; } } if (statePtr->flags & TLS_TCL_INIT) { statePtr->flags &= ~(TLS_TCL_INIT); } bytesRead = BIO_read(statePtr->bio, buf, bufSize); dprintf(stderr,"\nBIO_read -> %d", bytesRead); if (bytesRead < 0) { int err = SSL_get_error(statePtr->ssl, bytesRead); if (err == SSL_ERROR_SSL) { Tls_Error(statePtr, SSL_ERROR(statePtr->ssl, bytesRead)); *errorCodePtr = ECONNABORTED; | > > > > > > > > > > > > < < | > | > < < < < > | 210 211 212 213 214 215 216 217 218 219 220 221 222 223 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 | if (bytesRead <= 0) { goto input; } } if (statePtr->flags & TLS_TCL_INIT) { statePtr->flags &= ~(TLS_TCL_INIT); } /* * We need to clear the SSL error stack now because we sometimes reach * this function with leftover errors in the stack. If BIO_read * returns -1 and intends EAGAIN, there is a leftover error, it will be * misconstrued as an error, not EAGAIN. * * Alternatively, we may want to handle the <0 return codes from * BIO_read specially (as advised in the RSA docs). TLS's lower level BIO * functions play with the retry flags though, and this seems to work * correctly. Similar fix in TlsOutputProc. - hobbs */ ERR_clear_error(); bytesRead = BIO_read(statePtr->bio, buf, bufSize); dprintf(stderr,"\nBIO_read -> %d", bytesRead); if (bytesRead < 0) { int err = SSL_get_error(statePtr->ssl, bytesRead); if (err == SSL_ERROR_SSL) { Tls_Error(statePtr, SSL_ERROR(statePtr->ssl, bytesRead)); *errorCodePtr = ECONNABORTED; } else if (BIO_should_retry(statePtr->bio)) { dprintf(stderr,"RE! "); *errorCodePtr = EAGAIN; } else { *errorCodePtr = Tcl_GetErrno(); if (*errorCodePtr == ECONNRESET) { /* Soft EOF */ *errorCodePtr = 0; bytesRead = 0; } } } input: dprintf(stderr, "\nInput(%d) -> %d [%d]", bufSize, bytesRead, *errorCodePtr); return bytesRead; } |
︙ | ︙ | |||
268 269 270 271 272 273 274 | int *errorCodePtr) /* Where to store error code. */ { State *statePtr = (State *) instanceData; int written, err; *errorCodePtr = 0; | | > > > > > > > > > > > > | > | | < | | | < > | > < > < > > | 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 | int *errorCodePtr) /* Where to store error code. */ { State *statePtr = (State *) instanceData; int written, err; *errorCodePtr = 0; dprintf(stderr,"\nBIO_write(0x%x, %d)", statePtr, toWrite); if (!SSL_is_init_finished(statePtr->ssl)) { written = Tls_WaitForConnect(statePtr, errorCodePtr); if (written <= 0) { goto output; } } if (statePtr->flags & TLS_TCL_INIT) { statePtr->flags &= ~(TLS_TCL_INIT); } if (toWrite == 0) { dprintf(stderr, "zero-write\n"); BIO_flush(statePtr->bio); written = 0; goto output; } else { /* * We need to clear the SSL error stack now because we sometimes reach * this function with leftover errors in the stack. If BIO_write * returns -1 and intends EAGAIN, there is a leftover error, it will be * misconstrued as an error, not EAGAIN. * * Alternatively, we may want to handle the <0 return codes from * BIO_write specially (as advised in the RSA docs). TLS's lower level * BIO functions play with the retry flags though, and this seems to * work correctly. Similar fix in TlsInputProc. - hobbs */ ERR_clear_error(); written = BIO_write(statePtr->bio, buf, toWrite); dprintf(stderr,"\nBIO_write(0x%x, %d) -> [%d]", statePtr, toWrite, written); } if (written <= 0) { switch ((err = SSL_get_error(statePtr->ssl, written))) { case SSL_ERROR_NONE: if (written < 0) { written = 0; } break; case SSL_ERROR_WANT_WRITE: dprintf(stderr," write W BLOCK"); break; case SSL_ERROR_WANT_READ: dprintf(stderr," write R BLOCK"); break; case SSL_ERROR_WANT_X509_LOOKUP: dprintf(stderr," write X BLOCK"); break; case SSL_ERROR_ZERO_RETURN: dprintf(stderr,"closed\n"); written = 0; break; case SSL_ERROR_SYSCALL: *errorCodePtr = Tcl_GetErrno(); dprintf(stderr," [%d] syscall errr: %d", written, *errorCodePtr); written = -1; break; case SSL_ERROR_SSL: Tls_Error(statePtr, SSL_ERROR(statePtr->ssl, written)); *errorCodePtr = ECONNABORTED; written = -1; break; default: dprintf(stderr,"unknown err: %d\n", err); break; } } output: dprintf(stderr, "\nOutput(%d) -> %d", toWrite, written); return written; } |
︙ | ︙ |