TclTLS
Check-in [e88816cf57]
Login
HomeTimelineDownloadBrowse SourceBranchesTagsTicketsWiki
Overview
Comment:Optimized info commands and added more error checking. Use modern set protocol versions API for ciphers list.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | crypto
Files: files | file ages | folders
SHA3-256: e88816cf57661f64ecf0823d8f3b5dc42fcbf078e35943fd618850ee16829b87
User & Date: bohagan on 2023-11-07 23:40:52
Other Links: branch diff | manifest | tags
Context
2023-11-08
03:09
Updated test cases check-in: 9b69dccaca user: bohagan tags: crypto
2023-11-07
23:40
Optimized info commands and added more error checking. Use modern set protocol versions API for ciphers list. check-in: e88816cf57 user: bohagan tags: crypto
2023-11-06
23:46
Added more comments and removed obsolete code check-in: 5a0296430f user: bohagan tags: crypto
Changes
Side-by-Side Diff Ignore Whitespace Patch
Modified generic/tlsInfo.c from [1f24eba4d4] to [9aada2ce3d].
︙
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
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

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
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
219








-


-
+
-

-



+
+
+
+
+
+
+
+
+
-
+



-
-
+
+
+


-
-
-
-

-



-
-

-
-
-
-
+
+
+
+
+


-
-



-


-
-
-





+
+
-
+






+
+
-
+






+
+
-
+






+
+
-
+






-
-
-
+
+



+
-
+



+
-
+
-




+
+
+
-
-
+
+
+
+
+
+










+



+
+

+

+











+

+








 *
 * Side effects:
 *	constructs and destroys SSL context (CTX)
 *
 *-------------------------------------------------------------------
 */
static int CiphersObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    Tcl_Obj *objPtr = NULL;
    SSL_CTX *ctx = NULL;
    SSL *ssl = NULL;
    STACK_OF(SSL_CIPHER) *sk;
    STACK_OF(SSL_CIPHER) *sk = NULL;
    char *cp, buf[BUFSIZ];
    int index, verbose = 0, use_supported = 0;
    const SSL_METHOD *method;

    dprintf("Called");

#if OPENSSL_VERSION_NUMBER < 0x10100000L
    OpenSSL_add_all_ciphers(); /* Make sure they're loaded */
#endif

    /* Clear errors */
    Tcl_ResetResult(interp);
    ERR_clear_error();

    /* Validate arg count */
    if ((objc < 1) || (objc > 4)) {
    if (objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "?protocol? ?verbose? ?supported?");
	return TCL_ERROR;
    }
    if (objc == 1) {
	/* List all ciphers */

    /* List all ciphers */
    if (objc == 1) {
	Tcl_Obj *objPtr = Tcl_NewListObj(0, NULL);

#if OPENSSL_VERSION_NUMBER < 0x10100000L
	OpenSSL_add_all_ciphers(); /* Make sure they're loaded */
#endif

	OBJ_NAME_do_all(OBJ_NAME_TYPE_CIPHER_METH, NamesCallback, (void *) objPtr);
	Tcl_ResetResult(interp);
	Tcl_SetObjResult(interp, objPtr);
	return TCL_OK;

    } else if (Tcl_GetIndexFromObj(interp, objv[1], protocols, "protocol", 0, &index) != TCL_OK) {
	return TCL_ERROR;
    }
    if ((objc > 2) && Tcl_GetBooleanFromObj(interp, objv[2], &verbose) != TCL_OK) {
	return TCL_ERROR;
    }
    if ((objc > 3) && Tcl_GetBooleanFromObj(interp, objv[3], &use_supported) != TCL_OK) {

    /* Get options */
    if (Tcl_GetIndexFromObj(interp, objv[1], protocols, "protocol", 0, &index) != TCL_OK ||
	(objc > 2 && Tcl_GetBooleanFromObj(interp, objv[2], &verbose) != TCL_OK) ||
	(objc > 3 && Tcl_GetBooleanFromObj(interp, objv[3], &use_supported) != TCL_OK)) {
	return TCL_ERROR;
    }

    ERR_clear_error();

    switch ((enum protocol)index) {
	case TLS_SSL2:
#if OPENSSL_VERSION_NUMBER >= 0x10100000L || defined(NO_SSL2) || defined(OPENSSL_NO_SSL2)
	    Tcl_AppendResult(interp, protocols[index], ": protocol not supported", NULL);
	    return TCL_ERROR;
#else
	    method = SSLv2_method(); break;
#endif
	case TLS_SSL3:
#if defined(NO_SSL3) || defined(OPENSSL_NO_SSL3) || defined(OPENSSL_NO_SSL3_METHOD)
	    Tcl_AppendResult(interp, protocols[index], ": protocol not supported", NULL);
	    return TCL_ERROR;
#else
            min_version = SSL3_VERSION;
            max_version = SSL3_VERSION;
	    method = SSLv3_method(); break;
	    break;
#endif
	case TLS_TLS1:
#if defined(NO_TLS1) || defined(OPENSSL_NO_TLS1) || defined(OPENSSL_NO_TLS1_METHOD)
	    Tcl_AppendResult(interp, protocols[index], ": protocol not supported", NULL);
	    return TCL_ERROR;
#else
            min_version = TLS1_VERSION;
            max_version = TLS1_VERSION;
	    method = TLSv1_method(); break;
	    break;
#endif
	case TLS_TLS1_1:
#if defined(NO_TLS1_1) || defined(OPENSSL_NO_TLS1_1) || defined(OPENSSL_NO_TLS1_1_METHOD)
	    Tcl_AppendResult(interp, protocols[index], ": protocol not supported", NULL);
	    return TCL_ERROR;
#else
            min_version = TLS1_1_VERSION;
            max_version = TLS1_1_VERSION;
	    method = TLSv1_1_method(); break;
	    break;
#endif
	case TLS_TLS1_2:
#if defined(NO_TLS1_2) || defined(OPENSSL_NO_TLS1_2) || defined(OPENSSL_NO_TLS1_2_METHOD)
	    Tcl_AppendResult(interp, protocols[index], ": protocol not supported", NULL);
	    return TCL_ERROR;
#else
            min_version = TLS1_2_VERSION;
            max_version = TLS1_2_VERSION;
	    method = TLSv1_2_method(); break;
	    break;
#endif
	case TLS_TLS1_3:
#if defined(NO_TLS1_3) || defined(OPENSSL_NO_TLS1_3)
	    Tcl_AppendResult(interp, protocols[index], ": protocol not supported", NULL);
	    return TCL_ERROR;
#else
	    method = TLS_method();
	    SSL_CTX_set_min_proto_version(ctx, TLS1_3_VERSION);
	    SSL_CTX_set_max_proto_version(ctx, TLS1_3_VERSION);
            min_version = TLS1_3_VERSION;
            max_version = TLS1_3_VERSION;
	    break;
#endif
	default:
            min_version = SSL3_VERSION;
	    method = TLS_method();
            max_version = TLS1_3_VERSION;
	    break;
    }

    /* Create context */
    ctx = SSL_CTX_new(method);
    if ((ctx = SSL_CTX_new(TLS_server_method())) == NULL) {
    if (ctx == NULL) {
	Tcl_AppendResult(interp, REASON(), NULL);
	return TCL_ERROR;
    }

    /* Set protocol versions */
    if (SSL_CTX_set_min_proto_version(ctx, min_version) == 0 ||
	SSL_CTX_set_max_proto_version(ctx, max_version) == 0) {
    ssl = SSL_new(ctx);
    if (ssl == NULL) {
	SSL_CTX_free(ctx);
	return TCL_ERROR;
    }

    /* Create SSL context */
    if ((ssl = SSL_new(ctx)) == NULL) {
	Tcl_AppendResult(interp, REASON(), NULL);
	SSL_CTX_free(ctx);
	return TCL_ERROR;
    }

    /* Use list and order as would be sent in a ClientHello or all available ciphers */
    if (use_supported) {
	sk = SSL_get1_supported_ciphers(ssl);
    } else {
	sk = SSL_get_ciphers(ssl);
	/*sk = SSL_CTX_get_ciphers(ctx);*/
    }

    if (sk != NULL) {
	Tcl_Obj *objPtr = NULL;

	if (!verbose) {
	    char *cp;
	    objPtr = Tcl_NewListObj(0, NULL);

	    for (int i = 0; i < sk_SSL_CIPHER_num(sk); i++) {
		const SSL_CIPHER *c = sk_SSL_CIPHER_value(sk, i);
		if (c == NULL) continue;

		/* cipher name or (NONE) */
		cp = SSL_CIPHER_get_name(c);
		if (cp == NULL) break;
		Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(cp, -1));
	    }

	} else {
	    char buf[BUFSIZ];
	    objPtr = Tcl_NewStringObj("",0);

	    for (int i = 0; i < sk_SSL_CIPHER_num(sk); i++) {
		/* uint32_t id;*/
		const SSL_CIPHER *c = sk_SSL_CIPHER_value(sk, i);
		if (c == NULL) continue;

		/* Get OpenSSL-specific ID, not IANA ID */
		/*id = SSL_CIPHER_get_id(c);*/
︙
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
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

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








+
+



+

+


-
-







-
+












-
-
+
+
+
+




+
+
+
+
+
+
+
+




-
-





-
+












+
+
+
+
+
+
+
+
+
+
+
-
+





-
-








		if (SSL_CIPHER_description(c, buf, sizeof(buf)) != NULL) {
		    Tcl_AppendToObj(objPtr, buf, (Tcl_Size) strlen(buf));
		} else {
		    Tcl_AppendToObj(objPtr, "UNKNOWN\n", 8);
		}
	    }
	}

	/* Clean up */
	if (use_supported) {
	    sk_SSL_CIPHER_free(sk);
	}
	Tcl_SetObjResult(interp, objPtr);
    }

    SSL_free(ssl);
    SSL_CTX_free(ctx);

    Tcl_SetObjResult(interp, objPtr);
    return TCL_OK;
	clientData = clientData;
}

/*
 *-------------------------------------------------------------------
 *
 * DigestsObjCmd -- 
 * DigestsObjCmd --
 *
 *	Return a list of all valid hash algorithms or message digests.
 *
 * Results:
 *	A standard Tcl list.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------
 */
int DigestsObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    Tcl_Obj *objPtr = Tcl_NewListObj(0, NULL);
    
    Tcl_Obj *objPtr;

    dprintf("Called");

#if OPENSSL_VERSION_NUMBER < 0x10100000L
    OpenSSL_add_all_digests(); /* Make sure they're loaded */
#endif

    /* Validate arg count */
    if (objc != 1) {
	Tcl_WrongNumArgs(interp, 1, objv, NULL);
	return TCL_ERROR;
    }

    /* List all digests */
    objPtr = Tcl_NewListObj(0, NULL);
    OBJ_NAME_do_all(OBJ_NAME_TYPE_MD_METH, NamesCallback, (void *) objPtr);
    Tcl_SetObjResult(interp, objPtr);
    return TCL_OK;
	clientData = clientData;
	objc = objc;
	objv = objv;
}

/*
 *-------------------------------------------------------------------
 *
 * MacsObjCmd -- 
 * MacsObjCmd --
 *
 *	Return a list of all valid message authentication codes (MAC).
 *
 * Results:
 *	A standard Tcl list.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------
 */
int MacsObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    Tcl_Obj *objPtr;

    dprintf("Called");

    /* Validate arg count */
    if (objc != 1) {
	Tcl_WrongNumArgs(interp, 1, objv, NULL);
	return TCL_ERROR;
    }

    /* List all MACs */
    Tcl_Obj *objPtr = Tcl_NewListObj(0, NULL);
    objPtr = Tcl_NewListObj(0, NULL);
    Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("cmac", -1));
    Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("hmac", -1));
    Tcl_SetObjResult(interp, objPtr);
    return TCL_OK;
	clientData = clientData;
	objc = objc;
	objv = objv;
}

/*
 *-------------------------------------------------------------------
 *
 * ProtocolsObjCmd --
 *
︙
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

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
367
368
369

370
371
372
373
374
375
376








+





-
-
+

-


















-








 */
static int
ProtocolsObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    Tcl_Obj *objPtr;

    dprintf("Called");

    /* Validate arg count */
    if (objc != 1) {
	Tcl_WrongNumArgs(interp, 1, objv, NULL);
	return TCL_ERROR;
    }

    ERR_clear_error();

    /* List all MACs */
    objPtr = Tcl_NewListObj(0, NULL);

#if OPENSSL_VERSION_NUMBER < 0x10100000L && !defined(NO_SSL2) && !defined(OPENSSL_NO_SSL2)
    Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(protocols[TLS_SSL2], -1));
#endif
#if !defined(NO_SSL3) && !defined(OPENSSL_NO_SSL3) && !defined(OPENSSL_NO_SSL3_METHOD)
    Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(protocols[TLS_SSL3], -1));
#endif
#if !defined(NO_TLS1) && !defined(OPENSSL_NO_TLS1) && !defined(OPENSSL_NO_TLS1_METHOD)
    Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(protocols[TLS_TLS1], -1));
#endif
#if !defined(NO_TLS1_1) && !defined(OPENSSL_NO_TLS1_1) && !defined(OPENSSL_NO_TLS1_1_METHOD)
    Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(protocols[TLS_TLS1_1], -1));
#endif
#if !defined(NO_TLS1_2) && !defined(OPENSSL_NO_TLS1_2) && !defined(OPENSSL_NO_TLS1_2_METHOD)
    Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(protocols[TLS_TLS1_2], -1));
#endif
#if !defined(NO_TLS1_3) && !defined(OPENSSL_NO_TLS1_3)
    Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(protocols[TLS_TLS1_3], -1));
#endif

    Tcl_SetObjResult(interp, objPtr);
    return TCL_OK;
	clientData = clientData;
}

/*
 *-------------------------------------------------------------------
︙
354
355
356
357
358
359
360






361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389

390
391
392

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








+
+
+
+
+
+





-
-




















-

+




 *-------------------------------------------------------------------
 */
static int
VersionObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    Tcl_Obj *objPtr;

    dprintf("Called");

    /* Validate arg count */
    if (objc != 1) {
	Tcl_WrongNumArgs(interp, 1, objv, NULL);
	return TCL_ERROR;
    }

    objPtr = Tcl_NewStringObj(OPENSSL_VERSION_TEXT, -1);
    Tcl_SetObjResult(interp, objPtr);
    return TCL_OK;
	clientData = clientData;
	objc = objc;
	objv = objv;
}

/*
 *-------------------------------------------------------------------
 *
 * Tls_InfoCommands --
 *
 *	Create info commands
 *
 * Returns:
 *	TCL_OK or TCL_ERROR
 *
 * Side effects:
 *	Creates commands
 *
 *-------------------------------------------------------------------
 */
int Tls_InfoCommands(Tcl_Interp *interp) {
    Tcl_CreateObjCommand(interp, "tls::ciphers", CiphersObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "tls::digests", DigestsObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "tls::protocols", ProtocolsObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "tls::macs", MacsObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "tls::protocols", ProtocolsObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "tls::version", VersionObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
    return TCL_OK;
}
Powered by Fossil · RSS