TclTLS
Check-in [e8f554a732]
Login
HomeTimelineDownloadBrowse SourceBranchesTagsTicketsWiki
Overview
Comment:Improve error-handling, e.g. using Tcl_SetErrorCode()
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | nijtmans
Files: files | file ages | folders
SHA3-256: e8f554a7328363411e9baa825b85bd9a4a100005568f42531a8e04db518fa5ab
User & Date: jan.nijtmans on 2024-02-24 21:07:16
Other Links: branch diff | manifest | tags
Context
2024-02-24
22:07
Eliminate some deprecated function usages. Disable ssl3 by default too (just as ssl2) check-in: 3090c676df user: jan.nijtmans tags: nijtmans
21:07
Improve error-handling, e.g. using Tcl_SetErrorCode() check-in: e8f554a732 user: jan.nijtmans tags: nijtmans
16:59
No need for LAPPEND_LONG, use LAPPEND_INT check-in: 4f6f9b9874 user: jan.nijtmans tags: nijtmans
Changes
Side-by-Side Diff Ignore Whitespace Patch
Modified generic/tls.c from [6f7de4fd54] to [22deb29539].
︙
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64

41
42
43
44
45
46
47










48
49
50
51
52
53
54








-
-
-
-
-
-
-
-
-
-








 * Forward declarations
 */

#define F2N(key, dsp) \
	(((key) == NULL) ? (char *)NULL : \
		Tcl_TranslateFileName(interp, (key), (dsp)))

static void	InfoCallback(const SSL *ssl, int where, int ret);

static Tcl_ObjCmdProc CiphersObjCmd;
static Tcl_ObjCmdProc HandshakeObjCmd;
static Tcl_ObjCmdProc ImportObjCmd;
static Tcl_ObjCmdProc StatusObjCmd;
static Tcl_ObjCmdProc VersionObjCmd;
static Tcl_ObjCmdProc MiscObjCmd;
static Tcl_ObjCmdProc UnimportObjCmd;

static SSL_CTX *CTX_Init(State *statePtr, int isServer, int proto, char *key,
		char *certfile, unsigned char *key_asn1, unsigned char *cert_asn1,
		int key_asn1_len, int cert_asn1_len, char *CAdir, char *CAfile,
		char *ciphers, char *DHparams);

static int	TlsLibInit(int uninitialize);
︙
159
160
161
162
163
164
165

166
167
168
169
170
171
172

149
150
151
152
153
154
155
156
157
158
159
160
161
162
163








+








 *
 *-------------------------------------------------------------------
 */
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;
    const char *major, *minor;

    dprintf("Called");

    if (statePtr->callback == (Tcl_Obj*)NULL)
	return;
︙
197
198
199
200
201
202
203
204

205
206
207

208
209
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

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


219
220
221
222

223
224
225


226
227
228
229
230
231
232
233
234








-
+


-
+


-
+


-
+



-
+


-
+

-
+


-
+


-
-
+
+


-
+


-
-
+
+








	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_ListObjAppendElement( interp, cmdPtr,
	    Tcl_NewStringObj( "info", -1));

    Tcl_ListObjAppendElement( statePtr->interp, cmdPtr,
    Tcl_ListObjAppendElement( interp, cmdPtr,
	    Tcl_NewStringObj( Tcl_GetChannelName(statePtr->self), -1) );

    Tcl_ListObjAppendElement( statePtr->interp, cmdPtr,
    Tcl_ListObjAppendElement( interp, cmdPtr,
	    Tcl_NewStringObj( major, -1) );

    Tcl_ListObjAppendElement( statePtr->interp, cmdPtr,
    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);
	const char *cp = (char *)SSL_alert_desc_string_long(ret);

	Tcl_ListObjAppendElement( statePtr->interp, cmdPtr,
	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) statePtr);
    Tcl_Preserve((void *) interp);
    Tcl_Preserve((void *) 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((void *) statePtr);
    Tcl_Release((void *) interp);

}

/*
 *-------------------------------------------------------------------
 *
 * VerifyCallback --
︙
301
302
303
304
305
306
307
308
309


310
311
312
313
314
315
316

292
293
294
295
296
297
298


299
300
301
302
303
304
305
306
307








-
-
+
+









    Tcl_ListObjAppendElement( statePtr->interp, cmdPtr,
	    Tcl_NewIntObj( ok) );

    Tcl_ListObjAppendElement( statePtr->interp, cmdPtr,
	    Tcl_NewStringObj( errStr ? errStr : "", -1) );

    Tcl_Preserve( (ClientData) statePtr->interp);
    Tcl_Preserve( (ClientData) statePtr);
    Tcl_Preserve((void *) statePtr->interp);
    Tcl_Preserve((void *) statePtr);

    statePtr->flags |= TLS_TCL_CALLBACK;

    Tcl_IncrRefCount( cmdPtr);
    if (Tcl_EvalObjEx(statePtr->interp, cmdPtr, TCL_EVAL_GLOBAL) != TCL_OK) {
	/* It got an error - reject the certificate.		*/
	Tcl_BackgroundError( statePtr->interp);
︙
326
327
328
329
330
331
332
333
334


335
336
337
338
339
340
341

317
318
319
320
321
322
323


324
325
326
327
328
329
330
331
332








-
-
+
+








	    }
	}
    }
    Tcl_DecrRefCount( cmdPtr);

    statePtr->flags &= ~(TLS_TCL_CALLBACK);

    Tcl_Release( (ClientData) statePtr);
    Tcl_Release( (ClientData) statePtr->interp);
    Tcl_Release((void *) statePtr);
    Tcl_Release((void *) statePtr->interp);

    return(ok);	/* By default, leave verification unchanged.	*/
}

/*
 *-------------------------------------------------------------------
 *
︙
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

369
370
371
372
373
374
375


376
377
378
379
380
381
382
383
384


385
386
387
388
389
390
391
392
393








-
-
+
+







-
-
+
+









    Tcl_ListObjAppendElement(statePtr->interp, cmdPtr,
	    Tcl_NewStringObj(Tcl_GetChannelName(statePtr->self), -1));

    Tcl_ListObjAppendElement(statePtr->interp, cmdPtr,
	    Tcl_NewStringObj(msg, -1));

    Tcl_Preserve((ClientData) statePtr->interp);
    Tcl_Preserve((ClientData) statePtr);
    Tcl_Preserve((void *) statePtr->interp);
    Tcl_Preserve((void *) statePtr);

    Tcl_IncrRefCount(cmdPtr);
    if (Tcl_EvalObjEx(statePtr->interp, cmdPtr, TCL_EVAL_GLOBAL) != TCL_OK) {
	Tcl_BackgroundError(statePtr->interp);
    }
    Tcl_DecrRefCount(cmdPtr);

    Tcl_Release((ClientData) statePtr);
    Tcl_Release((ClientData) statePtr->interp);
    Tcl_Release((void *) statePtr);
    Tcl_Release((void *) statePtr->interp);
}

/*
 *-------------------------------------------------------------------
 *
 * PasswordCallback --
 *
︙
442
443
444
445
446
447
448
449
450


451
452
453
454
455
456
457
458
459
460


461
462
463
464
465
466
467

433
434
435
436
437
438
439


440
441
442
443
444
445
446
447
448
449


450
451
452
453
454
455
456
457
458








-
-
+
+








-
-
+
+








	} else {
	    return -1;
	}
    }

    cmdPtr = Tcl_DuplicateObj(statePtr->password);

    Tcl_Preserve((ClientData) statePtr->interp);
    Tcl_Preserve((ClientData) statePtr);
    Tcl_Preserve((void *) statePtr->interp);
    Tcl_Preserve((void *) statePtr);

    Tcl_IncrRefCount(cmdPtr);
    result = Tcl_EvalObjEx(interp, cmdPtr, TCL_EVAL_GLOBAL);
    if (result != TCL_OK) {
	Tcl_BackgroundError(statePtr->interp);
    }
    Tcl_DecrRefCount(cmdPtr);

    Tcl_Release((ClientData) statePtr);
    Tcl_Release((ClientData) statePtr->interp);
    Tcl_Release((void *) statePtr);
    Tcl_Release((void *) statePtr->interp);

    if (result == TCL_OK) {
	const char *ret = Tcl_GetStringResult(interp);
	strncpy(buf, ret, (size_t) size);
	return (int)strlen(ret);
    } else {
	return -1;
︙
648
649
650
651
652
653
654

655
656
657
658
659
660
661
662
663
664
665
666

667
668
669
670
671
672
673
674
675




676
677
678
679
680
681
682

639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679








+












+









+
+
+
+








    }

    /* 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", (char *)NULL);
	Tcl_SetErrorCode(interp, "TLS", "HANDSHAKE", "CHANNEL", "INVALID", (char *)NULL);
	return(TCL_ERROR);
    }
    statePtr = (State *)Tcl_GetChannelInstanceData(chan);

    dprintf("Calling Tls_WaitForConnect");
    ret = Tls_WaitForConnect(statePtr, &err, 1);
    dprintf("Tls_WaitForConnect returned: %i", ret);

    if (ret < 0 && ((statePtr->flags & TLS_TCL_ASYNC) && (err == EAGAIN))) {
	dprintf("Async set and err = EAGAIN");
	ret = 0;
    } else if (ret < 0) {
	long result;
	errStr = statePtr->err;
	Tcl_ResetResult(interp);
	Tcl_SetErrno(err);

	if (!errStr || (*errStr == 0)) {
	    errStr = Tcl_PosixError(interp);
	}

	Tcl_AppendResult(interp, "handshake failed: ", errStr, (char *)NULL);
	if ((result = SSL_get_verify_result(statePtr->ssl)) != X509_V_OK) {
	    Tcl_AppendResult(interp, " due to \"", X509_verify_cert_error_string(result), "\"", (char *)NULL);
	}
	Tcl_SetErrorCode(interp, "TLS", "HANDSHAKE", "FAILED", (char *)NULL);
	dprintf("Returning TCL_ERROR with handshake failed: %s", errStr);
	return(TCL_ERROR);
    } else {
	if (err != 0) {
	    dprintf("Got an error with a completed handshake: err = %i", err);
	}
	ret = 1;
︙
869
870
871
872
873
874
875

876
877
878
879
880
881
882

866
867
868
869
870
871
872
873
874
875
876
877
878
879
880








+








	/*
	 * 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", (char *)NULL);
	    Tcl_SetErrorCode(interp, "TLS", "IMPORT", "CHANNEL", "INVALID", (char *)NULL);
	    Tls_Free((void *)statePtr);
	    return TCL_ERROR;
	}
	ctx = ((State *)Tcl_GetChannelInstanceData(chan))->ctx;
    } else {
	if ((ctx = CTX_Init(statePtr, server, proto, keyfile, certfile, key,
		cert, key_len, cert_len, CAdir, CAfile, ciphers,
︙
924
925
926
927
928
929
930

931
932
933
934
935
936
937
938

939
940
941
942
943
944
945

922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945








+








+








     * SSL Initialization
     */

    statePtr->ssl = SSL_new(statePtr->ctx);
    if (!statePtr->ssl) {
	/* SSL library error */
	Tcl_AppendResult(interp, "couldn't construct ssl session: ", GET_ERR_REASON(), (char *)NULL);
	Tcl_SetErrorCode(interp, "TLS", "IMPORT", "INIT", "FAILED", (char *)NULL);
	Tls_Free((void *)statePtr);
	return TCL_ERROR;
    }

#ifndef OPENSSL_NO_TLSEXT
    if (servername) {
	if (!SSL_set_tlsext_host_name(statePtr->ssl, servername) && require) {
	    Tcl_AppendResult(interp, "setting TLS host name extension failed", (char *)NULL);
	    Tcl_SetErrorCode(interp, "TLS", "IMPORT", "HOSTNAME", "FAILED", (char *)NULL);
	    Tls_Free((void *)statePtr);
	    return TCL_ERROR;
	}
    }
#endif

    /*
︙
962
963
964
965
966
967
968
969

970
971
972
973
974
975
976

962
963
964
965
966
967
968

969
970
971
972
973
974
975
976








-
+








    SSL_set_bio(statePtr->ssl, statePtr->p_bio, statePtr->p_bio);
    BIO_set_ssl(statePtr->bio, statePtr->ssl, BIO_NOCLOSE);

    /*
     * End of SSL Init
     */
    dprintf("Returning %s", Tcl_GetChannelName(statePtr->self));
    Tcl_SetResult(interp, (char *) Tcl_GetChannelName(statePtr->self), TCL_VOLATILE);
    Tcl_SetResult(interp, (char *)Tcl_GetChannelName(statePtr->self), TCL_VOLATILE);
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------
 *
 * UnimportObjCmd --
︙
1011
1012
1013
1014
1015
1016
1017

1018
1019
1020
1021
1022
1023
1024

1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025








+








     * 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", (char *)NULL);
	Tcl_SetErrorCode(interp, "TLS", "UNIMPORT", "CHANNEL", "INVALID", (char *)NULL);
	return TCL_ERROR;
    }

    if (Tcl_UnstackChannel(interp, chan) == TCL_ERROR) {
	return TCL_ERROR;
    }
︙
1389
1390
1391
1392
1393
1394
1395

1396
1397
1398
1399
1400
1401
1402

1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404








+








    /*
     * 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", (char *)NULL);
	Tcl_SetErrorCode(interp, "TLS", "STATUS", "CHANNEL", "INVALID", (char *)NULL);
	return TCL_ERROR;
    }
    statePtr = (State *) Tcl_GetChannelInstanceData(chan);

    /* Get certificate for peer or self */
    if (objc == 2) {
	peer = SSL_get_peer_certificate(statePtr->ssl);
︙
Powered by Fossil · RSS