TclTLS
Check-in [9e6e94200c]
Login
HomeTimelineDownloadBrowse SourceBranchesTagsTicketsWiki
Overview
Comment:Split list operations into separate functions to make it easier for OpenSSL 3.0 changes. Added pkey list function. Added mac info and pkey info placeholder functions. More checks for NULL pointers. Moved legacy load ciphers and digest to init routine.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | crypto
Files: files | file ages | folders
SHA3-256: 9e6e94200c8f1bd0b5cd286644362d686f2636232333641e5ede0aceef97b8d1
User & Date: bohagan on 2023-12-04 03:56:29
Other Links: branch diff | manifest | tags
Context
2023-12-08
03:03
Digest optimizations to delay conversion to OpenSSL types to initialization procedure. Add MAC info and incomplete Pkey info functions. check-in: d93493f320 user: bohagan tags: crypto
2023-12-04
03:56
Split list operations into separate functions to make it easier for OpenSSL 3.0 changes. Added pkey list function. Added mac info and pkey info placeholder functions. More checks for NULL pointers. Moved legacy load ciphers and digest to init routine. check-in: 9e6e94200c user: bohagan tags: crypto
00:30
Improved key and iv storage to use zero padded buffer to ensure no buffer overrun in OpenSSL API if string pointer is used. Added cipher default option for encrypt and decrypt. Pass data as last arg without -data option. check-in: 191f8b29bc user: bohagan tags: crypto
Changes
Side-by-Side Diff Ignore Whitespace Patch
Modified doc/cryptography.html from [b0e27f9e6f] to [c88e8b2743].
︙
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

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








-
-
+
+






-
-
-
+
+
+









<dl>
    <dt><a name="-iv"><strong>-iv</strong> <em>string</em></a></dt>
    <dd>Initialization vector (IV) to use. Required for some ciphers and GMAC.
    Cipher modes CBC, CFB, OFB and CTR all need an IV while ECB mode does not.
    A new, random IV should be created for each use. Think of the IV as a nonce
    (number used once), it's public but random and unpredictable. See the
   <a href="#tls::cipher"><b>tls::cipher</b></a> command for iv size and
    when required.</dd>
   <a href="#tls::cipher"><b>tls::cipher</b></a> for iv_length and
    when required (length > 0). If not set, it will default to \x00 fill data.</dd>
</dl>

<dl>
    <dt><a name="-key"><strong>-key</strong> <em>string</em></a></dt>
    <dd>Encryption key to use for cryptography function. Can be a binary or
    text string. Longer keys provide better protection. Used by ciphers, HMAC,
    some CMAC, and some KDF implementations. Key lengths less than <b>key_length</b>
    size may be padded or rejected. See the
    <a href="#tls::cipher"><b>tls::cipher</b></a> command for key size.</dd>
    some CMAC, and some KDF implementations. If the length of the key is &lt;
    <b>key_length</b> it will be padded. If &gt; key_length, it will be rejected.
    See the <a href="#tls::cipher"><b>tls::cipher</b></a> for key_length.</dd>
</dl>

<dl>
    <dt><a name="-mac"><strong>-mac</strong> <em>name</em></a></dt>
    <dd>Name of Message Authentication Code (MAC) to use.
    See <a href="#tls::mac"><b>tls::macs</b></a> for the valid values.</dd>
</dl>
︙
285
286
287
288
289
290
291
292


293
294
295
296
297
298
299

285
286
287
288
289
290
291

292
293
294
295
296
297
298
299
300








-
+
+








<dl>

<h4>Info Commands</h4>

    <dt><a name="tls::cipher"><strong>tls::cipher</strong> <em>name</em></a></dt>
    <dd>Return a list of property names and values describing cipher
	<i>name</i>. Properties include name, description, block_size,
	key_length, iv_length, type, and mode list.</dd>
	key_length, iv_length, type, and mode list. If block-size is 1,
	then it's a stream cipher, otherwise it's a block cipher.</dd>

    <dt><a name="tls::ciphers"><strong>tls::ciphers</strong>
    <em>?protocol? ?verbose? ?supported?</em></a></dt>
    <dd>Without any args, returns a list of all symmetric ciphers for use with
	the <a href="#-cipher"><b>-cipher</b></a> option. With <em>protocol</em>,
	only the ciphers supported for that protocol are returned. See
	<b>tls::protocols</b> command for the supported protocols. If
︙
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

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








-
+











-
+








    <dd>Removes the top level cryptographic transform from channel <em>channelId</em>.</dd>

<br>

<h4>Encryption and Decryption Commands</h4>

    <dt><a name="tls::encrypt"><strong>tls::encrypt</strong>
	<b>-cipher</b> <em>name</em> <b>-key</b> <em>key ?</em><b>-iv</b> <em>string?
	<em>?</em><b>-cipher</b><em>? name</em> <b>-key</b> <em>key ?</em><b>-iv</b> <em>string?
	[</em><b>-chan</b> <em>channelId |</em> <b>-command</b> <em>cmdName |</em>
	<b>-infile</b> <em>filename</em> <b>-outfile</b> <em>filename |</em>
	<b>-data</b><em> data]</em></a></dt>
    <dd>Encrypt the data using cipher <em>cipher</em> and output the result per
	the I/O options. Ciphers are used to create the cipher text from the
	input data. See <a href="#OPTIONS"><b>options</b></a> for usage
	info. Option <b>-iv</b> is only used for some ciphers. See the
	&quot;<b>tls::cipher</b> <em>cipher</em>&quot; command for key and iv
	sizes and when the iv is used (iv_length &gt; 0).</dd>

    <dt><a name="tls::decrypt"><strong>tls::decrypt</strong>
	<b>-cipher</b> <em>name</em> <b>-key</b> <em>key ?</em><b>-iv</b> <em>string?
	<em>?</em><b>-cipher</b><em>? name</em> <b>-key</b> <em>key ?</em><b>-iv</b> <em>string?
	[</em><b>-chan</b> <em>channelId |</em> <b>-command</b> <em>cmdName |</em>
	<b>-infile</b> <em>filename</em> <b>-outfile</b> <em>filename |</em>
	<b>-data</b><em> data]</em></a></dt>
    <dd>Decrypt the data using cipher <em>cipher</em> and output the result per
	the I/O options. This command is the opposite of the <b>tls::encrypt</b>
	command. See <a href="#OPTIONS"><b>options</b></a> for usage
	info. Option <b>-iv</b> is only used for some ciphers. See the
︙
Modified generic/tls.c from [3ece83c57b] to [63ca861d17].
︙
2041
2042
2043
2044
2045
2046
2047
2048

2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064


2065
2066
2067
2068
2069
2070
2071

2041
2042
2043
2044
2045
2046
2047

2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063

2064
2065
2066
2067
2068
2069
2070
2071
2072








-
+















-
+
+








	LAPPEND_INT(interp, objPtr, "algorithm_bits", alg_bits);
	/* alg_bits is actual key secret bits. If use bits and secret (algorithm) bits differ,
	   the rest of the bits are fixed, i.e. for limited export ciphers (bits < 56) */

	/* Indicates which SSL/TLS protocol version first defined the cipher */
	LAPPEND_STR(interp, objPtr, "min_version", SSL_CIPHER_get_version(cipher), -1);

	/* Cipher NID */
	/* Cipher NID, digest NID (none for AEAD cipher suites), Key Exchange NID, and authentication NID */
	LAPPEND_STR(interp, objPtr, "cipherNID", (char *)OBJ_nid2ln(SSL_CIPHER_get_cipher_nid(cipher)), -1);
	LAPPEND_STR(interp, objPtr, "digestNID", (char *)OBJ_nid2ln(SSL_CIPHER_get_digest_nid(cipher)), -1);
	LAPPEND_STR(interp, objPtr, "keyExchangeNID", (char *)OBJ_nid2ln(SSL_CIPHER_get_kx_nid(cipher)), -1);
	LAPPEND_STR(interp, objPtr, "authenticationNID", (char *)OBJ_nid2ln(SSL_CIPHER_get_auth_nid(cipher)), -1);

	/* message authentication code - Cipher is AEAD (e.g. GCM or ChaCha20/Poly1305) or not */
	/* Authenticated Encryption with associated data (AEAD) check */
	LAPPEND_BOOL(interp, objPtr, "cipher_is_aead", SSL_CIPHER_is_aead(cipher));

	/* Get OpenSSL-specific ID, not IANA ID */
	LAPPEND_INT(interp, objPtr, "cipher_id", (int) SSL_CIPHER_get_id(cipher));

	/* Two-byte ID used in the TLS protocol of the given cipher */
	LAPPEND_INT(interp, objPtr, "protocol_id", (int) SSL_CIPHER_get_protocol_id(cipher));

	/* Textual description of the cipher */
	/* Textual description of the cipher. Includes: cipher name, protocol version, key
	   exchange, authentication, symmetric encryption method, message authentication code */
	if (SSL_CIPHER_description(cipher, buf, sizeof(buf)) != NULL) {
	    LAPPEND_STR(interp, objPtr, "description", buf, -1);
	}

	/* Digest used during the SSL/TLS handshake when using the cipher. */
	md = SSL_CIPHER_get_handshake_digest(cipher);
	LAPPEND_STR(interp, objPtr, "handshake_digest", (char *)EVP_MD_name(md), -1);
︙
Modified generic/tlsInfo.c from [8baec4a647] to [e2ea39ef40].
︙
49
50
51
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

49
50
51
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








-
+

















-
+
-
-








}

/*******************************************************************/

/*
 *-------------------------------------------------------------------
 *
 * CipherInfo --
 * CipherObjCmd --
 *
 *	Return a list of properties and values for cipherName.
 *
 * Results:
 *	A standard Tcl list.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------
 */
static int CipherObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    Tcl_Obj *objPtr, *listPtr;
    unsigned char *cipherName = NULL, *modeName = NULL;
    const EVP_CIPHER *cipher;
    unsigned long flags, mode;

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

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

    /* Validate arg count */
    if (objc != 2) {
︙
92
93
94
95
96
97
98



99
100
101
102
103
104
105

90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106








+
+
+








    if (cipher == NULL) {
	Tcl_AppendResult(interp, "Invalid cipher \"", cipherName, "\"", NULL);
	return TCL_ERROR;
    }

    /* Get properties */
    objPtr = Tcl_NewListObj(0, NULL);
    if (objPtr == NULL) {
	return TCL_ERROR;
    }
    LAPPEND_STR(interp, objPtr, "nid", OBJ_nid2ln(EVP_CIPHER_nid(cipher)), -1);
    LAPPEND_STR(interp, objPtr, "name", EVP_CIPHER_name(cipher), -1);
    LAPPEND_STR(interp, objPtr, "description", "", -1);
    LAPPEND_INT(interp, objPtr, "block_size", EVP_CIPHER_block_size(cipher));
    LAPPEND_INT(interp, objPtr, "key_length", EVP_CIPHER_key_length(cipher));
    LAPPEND_INT(interp, objPtr, "iv_length", EVP_CIPHER_iv_length(cipher));
    LAPPEND_STR(interp, objPtr, "type", OBJ_nid2ln(EVP_CIPHER_type(cipher)), -1);
︙
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
220

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
220
221
222
223
224
225
226
227
228
229
230





231

232
233
234
235
236
237
238








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

















-
+




-
-
-
-












-
-
-
-
-
+
-








    Tcl_SetObjResult(interp, objPtr);
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------
 *
 * CipherList --
 *
 *	Return a list of all cipher algorithms
 *
 * Results:
 *	A standard Tcl list.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------
 */
int CipherList(Tcl_Interp *interp) {
    Tcl_Obj *objPtr = Tcl_NewListObj(0, NULL);
    if (objPtr == NULL) {
	return TCL_ERROR;
    }

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

/*
 *-------------------------------------------------------------------
 *
 * CiphersObjCmd --
 *
 *	This procedure is invoked to process the "tls::ciphers" command
 *	to list available ciphers, based upon protocol selected.
 *
 * Results:
 *	A standard Tcl result list.
 *
 * Side effects:
 *	constructs and destroys SSL context (CTX)
 *
 *-------------------------------------------------------------------
 */
static int CiphersObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    SSL_CTX *ctx = NULL;
    SSL *ssl = NULL;
    STACK_OF(SSL_CIPHER) *sk = NULL;
    int index, verbose = 0, use_supported = 0;
    int index, verbose = 0, use_supported = 0, res = TCL_OK;
    int min_version, max_version;

    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 > 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "?protocol? ?verbose? ?supported?");
	return TCL_ERROR;
    }

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

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

    }

    /* 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;
︙
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

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
358








+
+
+
+














+
+
+
+









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

	if (!verbose) {
	    char *cp;
	    objPtr = Tcl_NewListObj(0, NULL);
	    if (objPtr == NULL) {
		res = TCL_ERROR;
		goto done;
	    }

	    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);
	    if (objPtr == NULL) {
		res = TCL_ERROR;
		goto done;
	    }

	    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;

		/* textual description of the cipher */
		if (SSL_CIPHER_description(c, buf, sizeof(buf)) != NULL) {
︙
340
341
342
343
344
345
346

347
348
349

350
351
352
353
354
355
356

366
367
368
369
370
371
372
373
374
375

376
377
378
379
380
381
382
383








+


-
+








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

done:
    SSL_free(ssl);
    SSL_CTX_free(ctx);
    return TCL_OK;
    return res;
	clientData = clientData;
}

/*******************************************************************/

/*
 *-------------------------------------------------------------------
︙
375
376
377
378
379
380
381



382
383
384
385
386
387
388

402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418








+
+
+








    if (md == NULL) {
	Tcl_AppendResult(interp, "Invalid digest \"", digestName, "\"", NULL);
	return TCL_ERROR;
    }

    /* Get properties */
    objPtr = Tcl_NewListObj(0, NULL);
    if (objPtr == NULL) {
	return TCL_ERROR;
    }
    LAPPEND_STR(interp, objPtr, "name", EVP_MD_name(md), -1);
    LAPPEND_STR(interp, objPtr, "description", "", -1);
    LAPPEND_INT(interp, objPtr, "size", EVP_MD_size(md));
    LAPPEND_INT(interp, objPtr, "block_size", EVP_MD_block_size(md));
    LAPPEND_STR(interp, objPtr, "provider", "", -1);
    LAPPEND_STR(interp, objPtr, "type", OBJ_nid2ln(EVP_MD_type(md)), -1);
    LAPPEND_STR(interp, objPtr, "pkey_type", OBJ_nid2ln(EVP_MD_pkey_type(md)), -1);
︙
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
447
448
449
450
451
452
453
454
455
456
457
458
459
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

431
432
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
459
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
532
533
534
535
536
537
538
539

540


541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615


616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
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








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













-
-


-
-
-
-

-
-
-
-
+
+
+
+
+
+
+



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


-

-
-

















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


+
+
+
+

-
-
+
+
+
+
+
+
+
+


-
-
-
-
-
-








    Tcl_SetObjResult(interp, objPtr);
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------
 *
 * DigestList --
 *
 *	Return a list of all digest algorithms
 *
 * Results:
 *	A standard Tcl list.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------
 */
int DigestList(Tcl_Interp *interp) {
    Tcl_Obj *objPtr = Tcl_NewListObj(0, NULL);
    if (objPtr == NULL) {
	return TCL_ERROR;
    }

    OBJ_NAME_do_all(OBJ_NAME_TYPE_MD_METH, NamesCallback, (void *) objPtr);
    Tcl_SetObjResult(interp, objPtr);
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------
 *
 * 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;

    dprintf("Called");

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

    /* Validate arg count */
    if (objc == 2) {
	char *digestName = Tcl_GetStringFromObj(objv[1],NULL);
	return DigestInfo(interp, digestName);
    } else if (objc > 2) {
    if (objc == 1) {
	return DigestList(interp);

    } else if (objc == 2) {
	return DigestInfo(interp, Tcl_GetStringFromObj(objv[1],NULL));

    } else {
	Tcl_WrongNumArgs(interp, 1, objv, "?name?");
	return TCL_ERROR;
    }
    return TCL_OK;
	clientData = clientData;

    /* List all digests */
    objPtr = Tcl_NewListObj(0, NULL);
    OBJ_NAME_do_all(OBJ_NAME_TYPE_MD_METH, NamesCallback, (void *) objPtr);
}

/*******************************************************************/

/*
 *-------------------------------------------------------------------
 *
 * MacInfo --
 *
 *	Return a list of properties and values for macName.
 *
 * Results:
 *	A standard Tcl list.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------
 */
int MacInfo(Tcl_Interp *interp, char *macName) {
     return TCL_OK;
}

/*
 *-------------------------------------------------------------------
 *
 * MacList --
 *
 *	Return a list of all MAC algorithms
 *
 * Results:
 *	A standard Tcl list.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------
 */
int MacList(Tcl_Interp *interp) {
    Tcl_Obj *objPtr = Tcl_NewListObj(0, NULL);
    if (objPtr == NULL) {
	return TCL_ERROR;
    }

    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;
}

/*******************************************************************/

/*
 *-------------------------------------------------------------------
 *
 * 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[]) {
    dprintf("Called");

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

    /* Validate arg count */
    if (objc == 1) {
	return MacList(interp);

    } else if (objc == 2) {
	return MacInfo(interp, Tcl_GetStringFromObj(objv[1],NULL));

    } else {
	Tcl_WrongNumArgs(interp, 1, objv, "?name?");
	return TCL_ERROR;
    }
    return TCL_OK;
	clientData = clientData;
}

/*******************************************************************/

/*
 *-------------------------------------------------------------------
 *
 * PkeyInfo --
 *
 *	Return a list of properties and values for pkeyName.
 *
 * Results:
 *	A standard Tcl list.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------
 */
int PkeyInfo(Tcl_Interp *interp, char *pkeyName) {
     return TCL_OK;
}

/*
 *-------------------------------------------------------------------
 *
 * PkeyList --
 *
 *	Return a list of all public key methods
 *
 * Results:
 *	A standard Tcl list.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------
 */
int PkeyList(Tcl_Interp *interp) {
    Tcl_Obj *objPtr;

    Tcl_Obj *objPtr = Tcl_NewListObj(0, NULL);
    if (objPtr == NULL) {
	return TCL_ERROR;
    }

    for (size_t i = 0; i < EVP_PKEY_meth_get_count(); i++) {
        const EVP_PKEY_METHOD *pmeth = EVP_PKEY_meth_get0(i);
        int pkey_id, pkey_flags;

        EVP_PKEY_meth_get0_info(&pkey_id, &pkey_flags, pmeth);
	/*LAPPEND_STR(interp, objPtr, "name", OBJ_nid2ln(pkey_id), -1);
	LAPPEND_STR(interp, objPtr, "type", pkey_flags & ASN1_PKEY_DYNAMIC ? "External" : "Built-in", -1);*/

	Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(OBJ_nid2ln(pkey_id), -1));
    }
    Tcl_SetObjResult(interp, objPtr);
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------
 *
 * PkeysObjCmd --
 *
 *	Return a list of all valid hash algorithms or message digests.
 *
 * Results:
 *	A standard Tcl list.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------
 */
int PkeysObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    dprintf("Called");

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

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

    } else if (objc == 2) {
	return PkeyInfo(interp, Tcl_GetStringFromObj(objv[1],NULL));

    } else {
	Tcl_WrongNumArgs(interp, 1, objv, "?name?");
	return TCL_ERROR;
    }

    /* List all MACs */
    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;
}

/*******************************************************************/

/*
︙
498
499
500
501
502
503
504




505
506
507
508
509
510
511
512

513



514
515
516
517
518
519
520

687
688
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
715
716








+
+
+
+







-
+

+
+
+








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

    dprintf("Called");

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

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

    /* List all MACs */
    /* List all protocols */
    objPtr = Tcl_NewListObj(0, NULL);
    if (objPtr == NULL) {
	return TCL_ERROR;
    }
#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)
︙
583
584
585
586
587
588
589







590
591
592
593

594
595
596
597

779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801








+
+
+
+
+
+
+




+





 *
 * Side effects:
 *	Creates commands
 *
 *-------------------------------------------------------------------
 */
int Tls_InfoCommands(Tcl_Interp *interp) {

#if OPENSSL_VERSION_NUMBER < 0x10100000L
    OpenSSL_add_all_ciphers();
    OpenSSL_add_all_digests();
    OpenSSL_add_all_algorithms();
#endif

    Tcl_CreateObjCommand(interp, "tls::cipher", CipherObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
    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::macs", MacsObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "tls::pkeys", PkeysObjCmd, (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;
}
Modified tests/info.csv from [e9434748d4] to [25591cb194].
︙
8
9
10
11
12
13
14

15
16
17
18
19
20
21

8
9
10
11
12
13
14
15
16
17
18
19
20
21
22








+








command,source common.tcl,,,,,,,,,
,,,,,,,,,,
command,# Helper functions,,,,,,,,,
command,"proc lcompare {list1 list2} {set m """";set u """";foreach i $list1 {if {$i ni $list2} {lappend m $i}};foreach i $list2 {if {$i ni $list1} {lappend u $i}};return [list ""missing"" $m ""unexpected"" $u]}",,,,,,,,,
command,proc exec_get {delim args} {return [split [exec openssl {*}$args] $delim]},,,,,,,,,
command,"proc exec_get_ciphers {} {set list [list];set data [exec openssl list -cipher-algorithms];foreach line [split $data ""\n""] {foreach {cipher null alias} [split [string trim $line]] {lappend list [string tolower $cipher]}};return [lsort -unique $list]}",,,,,,,,,
command,"proc exec_get_digests {} {set list [list];set data [exec openssl dgst -list];foreach line [split $data ""\n""] {foreach digest $line {if {[string match ""-*"" $digest]} {lappend list [string trimleft $digest ""-""]}}};return [lsort $list]}",,,,,,,,,
command,"proc exec_get_pkeys {} {set list [list];set data [exec openssl list -public-key-methods];foreach line [split $data ""\n""] {if {![string match ""*Type:*"" $line]} {lappend list [string trim $line]}};return $list}",,,,,,,,,
command,proc exec_get_macs {} {return [list cmac hmac]},,,,,,,,,
command,proc list_tolower {list} {set result [list];foreach element $list {lappend result [string tolower $element]};return $result},,,,,,,,,
,,,,,,,,,,
command,# Test list ciphers,,,,,,,,,
Ciphers List,All,,,lcompare [lsort [exec_get_ciphers]] [list_tolower [lsort [::tls::ciphers]]],,,missing {rc5 rc5-cbc rc5-cfb rc5-ecb rc5-ofb} unexpected {aes-128-ccm aes-128-gcm aes-192-ccm aes-192-gcm aes-256-ccm aes-256-gcm},,,
,,,,,,,,,,
command,# Test list ciphers for protocols,,,,,,,,,
︙
62
63
64
65
66
67
68



69
70
71
72
73
74
75
76
77
78
79
80


81
82

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








+
+
+











-
+
+



,,,,,,,,,,
command,# Test Digest Info,,,,,,,,,
Digest Info,md5,,,tls::digests md5,,,name MD5 description {} size 16 block_size 64 provider {} type md5 pkey_type md5WithRSAEncryption flags {One-shot 0 XOF 0 DigestAlgorithmId_NULL 0 DigestAlgorithmId_Abscent 0 DigestAlgorithmId_Custom 0 FIPS 0},,,
,,,,,,,,,,
command,# Test list MACs,,,,,,,,,
MAC List,All,,,lcompare [exec_get_macs] [tls::macs],,,missing {} unexpected {},,,
,,,,,,,,,,
command,# Test list Pkeys,,,,,,,,,
Pkey List,All,,,lcompare [exec_get_pkeys] [tls::pkeys],,,missing {} unexpected {},,,
,,,,,,,,,,
command,# Test list protocols,,,,,,,,,
Protocols,All,,,lcompare $::protocols [::tls::protocols],,,missing {ssl2 ssl3} unexpected {},,,
,,,,,,,,,,
command,# Test show version,,,,,,,,,
Version,All,,,::tls::version,,glob,*,,,
Version,OpenSSL,OpenSSL,,::tls::version,,glob,OpenSSL*,,,
,,,,,,,,,,
command,# Error Cases,,,,,,,,,
Error Cases,Cipher Too few args,,,::tls::cipher,,,"wrong # args: should be ""::tls::cipher name""",,,1
Error Cases,Cipher Too many args,,,::tls::cipher too many args,,,"wrong # args: should be ""::tls::cipher name""",,,1
Error Cases,Digests Too many args,,,::tls::digests too many args,,,"wrong # args: should be ""::tls::digests ?name?""",,,1
Error Cases,MACs Too many args,,,::tls::macs too many args,,,"wrong # args: should be ""::tls::macs""",,,1
Error Cases,MACs Too many args,,,::tls::macs too many args,,,"wrong # args: should be ""::tls::macs ?name?""",,,1
Error Cases,Pkeys Too many args,,,::tls::pkeys too many args,,,"wrong # args: should be ""::tls::pkeys ?name?""",,,1
Error Cases,Protocols Too many args,,,::tls::protocols too many args,,,"wrong # args: should be ""::tls::protocols""",,,1
Error Cases,Version Too many args,,,::tls::version too many args,,,"wrong # args: should be ""::tls::version""",,,1
Modified tests/info.test from [52471437c8] to [3004379e81].
︙
17
18
19
20
21
22
23
24

25
26
27
28
29
30
31

17
18
19
20
21
22
23

24
25
26
27
28
29
30
31








-
+








source common.tcl

# Helper functions
proc lcompare {list1 list2} {set m "";set u "";foreach i $list1 {if {$i ni $list2} {lappend m $i}};foreach i $list2 {if {$i ni $list1} {lappend u $i}};return [list "missing" $m "unexpected" $u]}
proc exec_get {delim args} {return [split [exec openssl {*}$args] $delim]}
proc exec_get_ciphers {} {set list [list];set data [exec openssl list -cipher-algorithms];foreach line [split $data "\n"] {foreach {cipher null alias} [split [string trim $line]] {lappend list [string tolower $cipher]}};return [lsort -unique $list]}
proc exec_get_digests {} {set list [list];set data [exec openssl dgst -list];foreach line [split $data "\n"] {foreach digest $line {if {[string match "-*" $digest]} {lappend list [string trimleft $digest "-"]}}};return [lsort $list]}
proc exec_get_pks {} {set list [list];set data [exec openssl list -public-key-methods];foreach line [split $data "\n"] {if {![string match "*Type:*" $line]} {lappend list [string trim $line]}};return $list}
proc exec_get_pkeys {} {set list [list];set data [exec openssl list -public-key-methods];foreach line [split $data "\n"] {if {![string match "*Type:*" $line]} {lappend list [string trim $line]}};return $list}
proc exec_get_macs {} {return [list cmac hmac]}
proc list_tolower {list} {set result [list];foreach element $list {lappend result [string tolower $element]};return $result}

# Test list ciphers


test Ciphers_List-1.1 {All} -body {
︙
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
220

221
222

223




224

225
226
227
228

229
230
231
232
233
234

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








+
+
+
+
+
+
+



-
+






-
+



-
+






-
+



-
+



-
+



-
+

-
+

+
+
+
+
-
+



-
+







# Test list MACs


test MAC_List-9.1 {All} -body {
	lcompare [exec_get_macs] [tls::macs]
    } -result {missing {} unexpected {}}

# Test list Pkeys


test Pkey_List-10.1 {All} -body {
	lcompare [exec_get_pkeys] [tls::pkeys]
    } -result {missing {} unexpected {}}

# Test list protocols


test Protocols-10.1 {All} -body {
test Protocols-11.1 {All} -body {
	lcompare $::protocols [::tls::protocols]
    } -result {missing {ssl2 ssl3} unexpected {}}

# Test show version


test Version-11.1 {All} -body {
test Version-12.1 {All} -body {
	::tls::version
    } -match {glob} -result {*}

test Version-11.2 {OpenSSL} -constraints {OpenSSL} -body {
test Version-12.2 {OpenSSL} -constraints {OpenSSL} -body {
	::tls::version
    } -match {glob} -result {OpenSSL*}

# Error Cases


test Error_Cases-12.1 {Cipher Too few args} -body {
test Error_Cases-13.1 {Cipher Too few args} -body {
	::tls::cipher
    } -result {wrong # args: should be "::tls::cipher name"} -returnCodes {1}

test Error_Cases-12.2 {Cipher Too many args} -body {
test Error_Cases-13.2 {Cipher Too many args} -body {
	::tls::cipher too many args
    } -result {wrong # args: should be "::tls::cipher name"} -returnCodes {1}

test Error_Cases-12.3 {Digests Too many args} -body {
test Error_Cases-13.3 {Digests Too many args} -body {
	::tls::digests too many args
    } -result {wrong # args: should be "::tls::digests ?name?"} -returnCodes {1}

test Error_Cases-12.4 {MACs Too many args} -body {
test Error_Cases-13.4 {MACs Too many args} -body {
	::tls::macs too many args
    } -result {wrong # args: should be "::tls::macs"} -returnCodes {1}
    } -result {wrong # args: should be "::tls::macs ?name?"} -returnCodes {1}

test Error_Cases-13.5 {Pkeys Too many args} -body {
	::tls::pkeys too many args
    } -result {wrong # args: should be "::tls::pkeys ?name?"} -returnCodes {1}

test Error_Cases-12.5 {Protocols Too many args} -body {
test Error_Cases-13.6 {Protocols Too many args} -body {
	::tls::protocols too many args
    } -result {wrong # args: should be "::tls::protocols"} -returnCodes {1}

test Error_Cases-12.6 {Version Too many args} -body {
test Error_Cases-13.7 {Version Too many args} -body {
	::tls::version too many args
    } -result {wrong # args: should be "::tls::version"} -returnCodes {1}

# Cleanup
::tcltest::cleanupTests
return
Powered by Fossil · RSS