TclTLS
Check-in [42f5f29486]
Login
HomeTimelineDownloadBrowse SourceBranchesTagsTicketsWiki
Overview
Comment:REASON() -> GET_ERR_REASON(). Add some more utilities to tlsInt.h (not used yet)
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk | main
Files: files | file ages | folders
SHA3-256: 42f5f294867a7027bb55fc4b0ad56e84a4aaef003f0acc60ee0e4fec735576d5
User & Date: jan.nijtmans on 2024-02-23 21:27:23
Other Links: branch diff | manifest | tags
Context
2024-02-23
22:57
Use LAPPEND_STR() and friends check-in: 6e95e7672d user: jan.nijtmans tags: trunk, main
21:29
Merge-mark check-in: f26940283f user: jan.nijtmans tags: bohagan
21:27
REASON() -> GET_ERR_REASON(). Add some more utilities to tlsInt.h (not used yet) check-in: 42f5f29486 user: jan.nijtmans tags: trunk, main
15:25
Fix [bb7085cfdc]: Test tlsIO-8.1 breaks on FreeBSD check-in: 5128841292 user: jan.nijtmans tags: trunk, main
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified generic/tls.c from [f15837cdac] to [cf8594fd4b].

︙
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54

40
41
42
43
44
45
46

47
48
49
50
51
52
53








-








/*
 * Forward declarations
 */

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

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;
︙
559
560
561
562
563
564
565
566

567
568
569
570
571

572
573
574
575
576
577
578

558
559
560
561
562
563
564

565
566
567
568
569

570
571
572
573
574
575
576
577








-
+




-
+








	SSL_CTX_set_min_proto_version (ctx, TLS1_3_VERSION);
	SSL_CTX_set_max_proto_version (ctx, TLS1_3_VERSION);
#endif
    default:
		break;
    }
    if (ctx == NULL) {
	Tcl_AppendResult(interp, REASON(), (char *)NULL);
	Tcl_AppendResult(interp, GET_ERR_REASON(), (char *)NULL);
	return TCL_ERROR;
    }
    ssl = SSL_new(ctx);
    if (ssl == NULL) {
	Tcl_AppendResult(interp, REASON(), (char *)NULL);
	Tcl_AppendResult(interp, GET_ERR_REASON(), (char *)NULL);
	SSL_CTX_free(ctx);
	return TCL_ERROR;
    }
    objPtr = Tcl_NewListObj( 0, NULL);

    if (!verbose) {
	for (index = 0; ; index++) {
︙
924
925
926
927
928
929
930
931

932
933
934
935
936
937
938

923
924
925
926
927
928
929

930
931
932
933
934
935
936
937








-
+








    /*
     * 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);
	Tcl_AppendResult(interp, "couldn't construct ssl session: ", GET_ERR_REASON(), (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) {
︙
1216
1217
1218
1219
1220
1221
1222
1223

1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241

1242
1243
1244
1245
1246
1247
1248
1249
1250

1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261

1262
1263
1264
1265
1266
1267
1268

1215
1216
1217
1218
1219
1220
1221

1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239

1240
1241
1242
1243
1244
1245
1246
1247
1248

1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259

1260
1261
1262
1263
1264
1265
1266
1267








-
+

















-
+








-
+










-
+








		return NULL;
	    }
	    SSL_CTX_set_tmp_dh(ctx, dh);
	    DH_free(dh);
	} else {
	    /* Use well known DH parameters that have built-in support in OpenSSL */
	    if (!SSL_CTX_set_dh_auto(ctx, 1)) {
		Tcl_AppendResult(interp, "Could not enable set DH auto: ", REASON(), (char *)NULL);
		Tcl_AppendResult(interp, "Could not enable set DH auto: ", GET_ERR_REASON(), (char *)NULL);
		SSL_CTX_free(ctx);
		return NULL;
	    }
	}
    }
#endif

    /* set our certificate */
    load_private_key = 0;
    if (certfile != NULL) {
	load_private_key = 1;

	Tcl_DStringInit(&ds);

	if (SSL_CTX_use_certificate_file(ctx, F2N(certfile, &ds), SSL_FILETYPE_PEM) <= 0) {
	    Tcl_DStringFree(&ds);
	    Tcl_AppendResult(interp, "unable to set certificate file ", certfile, ": ",
		    REASON(), (char *)NULL);
		    GET_ERR_REASON(), (char *)NULL);
	    SSL_CTX_free(ctx);
	    return NULL;
	}
    } else if (cert != NULL) {
	load_private_key = 1;
	if (SSL_CTX_use_certificate_ASN1(ctx, cert_len, cert) <= 0) {
	    Tcl_DStringFree(&ds);
	    Tcl_AppendResult(interp, "unable to set certificate: ",
		    REASON(), (char *)NULL);
		    GET_ERR_REASON(), (char *)NULL);
	    SSL_CTX_free(ctx);
	    return NULL;
	}
    } else {
	certfile = (char*)X509_get_default_cert_file();

	if (SSL_CTX_use_certificate_file(ctx, certfile, SSL_FILETYPE_PEM) <= 0) {
#if 0
	    Tcl_DStringFree(&ds);
	    Tcl_AppendResult(interp, "unable to use default certificate file ", certfile, ": ",
		    REASON(), (char *)NULL);
		    GET_ERR_REASON(), (char *)NULL);
	    SSL_CTX_free(ctx);
	    return NULL;
#endif
	}
    }

    /* set our private key */
︙
1278
1279
1280
1281
1282
1283
1284
1285

1286
1287
1288
1289
1290
1291
1292
1293
1294
1295

1296
1297
1298
1299
1300
1301
1302

1277
1278
1279
1280
1281
1282
1283

1284
1285
1286
1287
1288
1289
1290
1291
1292
1293

1294
1295
1296
1297
1298
1299
1300
1301








-
+









-
+








	    }

	    if (SSL_CTX_use_PrivateKey_file(ctx, F2N(keyfile, &ds), SSL_FILETYPE_PEM) <= 0) {
		Tcl_DStringFree(&ds);
		/* flush the passphrase which might be left in the result */
		Tcl_SetResult(interp, NULL, TCL_STATIC);
		Tcl_AppendResult(interp, "unable to set public key file ", keyfile, " ",
			REASON(), (char *)NULL);
			GET_ERR_REASON(), (char *)NULL);
		SSL_CTX_free(ctx);
		return NULL;
	    }
	    Tcl_DStringFree(&ds);
	} else if (key != NULL) {
	    if (SSL_CTX_use_PrivateKey_ASN1(EVP_PKEY_RSA, ctx, key,key_len) <= 0) {
		Tcl_DStringFree(&ds);
		/* flush the passphrase which might be left in the result */
		Tcl_SetResult(interp, NULL, TCL_STATIC);
		Tcl_AppendResult(interp, "unable to set public key: ", REASON(), (char *)NULL);
		Tcl_AppendResult(interp, "unable to set public key: ", GET_ERR_REASON(), (char *)NULL);
		SSL_CTX_free(ctx);
		return NULL;
	    }
	}
	/* Now we know that a key and cert have been set against
	 * the SSL context */
	if (!SSL_CTX_check_private_key(ctx)) {
︙
1314
1315
1316
1317
1318
1319
1320
1321

1322
1323
1324
1325
1326
1327
1328

1313
1314
1315
1316
1317
1318
1319

1320
1321
1322
1323
1324
1325
1326
1327








-
+








    if (!SSL_CTX_load_verify_locations(ctx, F2N(CAfile, &ds), F2N(CAdir, &ds1)) ||
	!SSL_CTX_set_default_verify_paths(ctx)) {
#if 0
	Tcl_DStringFree(&ds);
	Tcl_DStringFree(&ds1);
	/* Don't currently care if this fails */
	Tcl_AppendResult(interp, "SSL default verify paths: ",
		REASON(), (char *)NULL);
		GET_ERR_REASON(), (char *)NULL);
	SSL_CTX_free(ctx);
	return NULL;
#endif
    }

    /* https://sourceforge.net/p/tls/bugs/57/ */
    /* XXX:TODO: Let the user supply values here instead of something that exists on the filesystem */
︙

Modified generic/tlsInt.h from [b7d22055d6] to [5289d6a3a5].

︙
96
97
98
99
100
101
102




























103
104
105
106
107
108
109

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








+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+








#else
#define dprintf(...) if (0) { fprintf(stderr, __VA_ARGS__); }
#define dprintBuffer(bufferName, bufferLength) /**/
#define dprintFlags(statePtr) /**/
#endif

#define TCLTLS_SSL_ERROR(ssl,err) ((char*)ERR_reason_error_string((unsigned long)SSL_get_error((ssl),(err))))
#define GET_ERR_REASON()	ERR_reason_error_string(ERR_get_error())

/* Common list append macros */
#define LAPPEND_BARRAY(interp, obj, text, value, size) {\
    if (text != NULL) Tcl_ListObjAppendElement(interp, obj, Tcl_NewStringObj(text, -1)); \
    Tcl_ListObjAppendElement(interp, obj, Tcl_NewByteArrayObj(value, size)); \
}
#define LAPPEND_STR(interp, obj, text, value, size) {\
    if (text != NULL) Tcl_ListObjAppendElement(interp, obj, Tcl_NewStringObj(text, -1)); \
    Tcl_ListObjAppendElement(interp, obj, Tcl_NewStringObj(value, size)); \
}
#define LAPPEND_INT(interp, obj, text, value) {\
    if (text != NULL) Tcl_ListObjAppendElement(interp, obj, Tcl_NewStringObj(text, -1)); \
    Tcl_ListObjAppendElement(interp, obj, Tcl_NewIntObj(value)); \
}
#define LAPPEND_LONG(interp, obj, text, value) {\
    if (text != NULL) Tcl_ListObjAppendElement(interp, obj, Tcl_NewStringObj(text, -1)); \
    Tcl_ListObjAppendElement(interp, obj, Tcl_NewLongObj(value)); \
}
#define LAPPEND_BOOL(interp, obj, text, value) {\
    if (text != NULL) Tcl_ListObjAppendElement(interp, obj, Tcl_NewStringObj(text, -1)); \
    Tcl_ListObjAppendElement(interp, obj, Tcl_NewBooleanObj(value)); \
}
#define LAPPEND_OBJ(interp, obj, text, listObj) {\
    if (text != NULL) Tcl_ListObjAppendElement(interp, obj, Tcl_NewStringObj(text, -1)); \
    Tcl_ListObjAppendElement(interp, obj, listObj); \
}

/*
 * OpenSSL BIO Routines
 */
#define BIO_TYPE_TCL	(19|0x0400)

/*
 * Defines for State.flags
︙

Powered by Fossil · RSS