TclTLS
Check-in [c740ba0cb8]
Login
HomeTimelineDownloadBrowse SourceBranchesTagsTicketsWiki
Overview
Comment:Updates for TCL 9.0 and Tcl_Size change
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA3-256: c740ba0cb88234ec5a733d28641b0206de63c9ad769c7d4d96fd7e7ef6588153
User & Date: bohagan on 2023-09-23 22:37:42
Other Links: manifest | tags
Context
2023-09-24
20:12
Moved definition of Append to List macros to tlsInt.h. Updated tls.c to use Append to List macros. check-in: 28d6418fa7 user: bohagan tags: trunk
2023-09-23
22:37
Updates for TCL 9.0 and Tcl_Size change check-in: c740ba0cb8 user: bohagan tags: trunk
2023-09-10
22:43
Added test cases to check for badssl.com certificate error conditions check-in: 6729942f38 user: bohagan tags: trunk
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified generic/tclOpts.h from [26b0fd21c2] to [fee5089a30].

︙
23
24
25
26
27
28
29
30

31
32
33
34
35
36
37

23
24
25
26
27
28
29

30
31
32
33
34
35
36
37








-
+








#define OPTOBJ(option, var)			\
    OPT_PROLOG(option)				\
    var = objv[idx];				\
    OPT_POSTLOG()

#define OPTSTR(option, var)			\
    OPT_PROLOG(option)				\
    var = Tcl_GetStringFromObj(objv[idx], NULL);\
    var = Tcl_GetStringFromObj(objv[idx], (Tcl_Size *)NULL);\
    OPT_POSTLOG()

#define OPTINT(option, var)			\
    OPT_PROLOG(option)				\
    if (Tcl_GetIntFromObj(interp, objv[idx],	\
	    &(var)) != TCL_OK) {		\
	    return TCL_ERROR;			\
︙

Modified generic/tls.c from [b2882089e7] to [6525346f21].

︙
442
443
444
445
446
447
448
449

450
451
452
453
454
455
456

442
443
444
445
446
447
448

449
450
451
452
453
454
455
456








-
+








    cmdPtr = Tcl_DuplicateObj(statePtr->callback);
    Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj("error", -1));
    Tcl_ListObjAppendElement(interp, cmdPtr,
	    Tcl_NewStringObj(Tcl_GetChannelName(statePtr->self), -1));
    if (msg != NULL) {
	Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(msg, -1));

    } else if ((msg = Tcl_GetStringFromObj(Tcl_GetObjResult(interp), NULL)) != NULL) {
    } else if ((msg = Tcl_GetStringFromObj(Tcl_GetObjResult(interp), (Tcl_Size *)NULL)) != NULL) {
	Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(msg, -1));

    } else {
	listPtr = Tcl_NewListObj(0, NULL);
	while ((err = ERR_get_error()) != 0) {
	    Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj(ERR_reason_error_string(err), -1));
	}
︙
549
550
551
552
553
554
555
556

557
558
559


560
561
562
563
564

565
566
567
568
569
570
571

549
550
551
552
553
554
555

556
557


558
559
560
561
562
563

564
565
566
567
568
569
570
571








-
+

-
-
+
+




-
+








    }
    Tcl_DecrRefCount(cmdPtr);

    Tcl_Release((ClientData) statePtr);

    /* If successful, pass back password string and truncate if too long */
    if (code == TCL_OK) {
	int len;
	Tcl_Size len;
	char *ret = (char *) Tcl_GetStringFromObj(Tcl_GetObjResult(interp), &len);
	if (len > size-1) {
	    len = size-1;
	if (len > (Tcl_Size) size-1) {
	    len = (Tcl_Size) size-1;
	}
	strncpy(buf, ret, (size_t) len);
	buf[len] = '\0';
	Tcl_Release((ClientData) interp);
	return(len);
	return((int) len);
    }
    Tcl_Release((ClientData) interp);
    return -1;
}

/*
 *-------------------------------------------------------------------
︙
611
612
613
614
615
616
617
618

619
620
621
622

623
624
625
626
627
628
629

611
612
613
614
615
616
617

618
619
620
621

622
623
624
625
626
627
628
629








-
+



-
+








    cmdPtr = Tcl_DuplicateObj(statePtr->callback);
    Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj("session", -1));
    Tcl_ListObjAppendElement(interp, cmdPtr,
	    Tcl_NewStringObj(Tcl_GetChannelName(statePtr->self), -1));

    /* Session id */
    session_id = SSL_SESSION_get_id(session, &ulen);
    Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewByteArrayObj(session_id, (int) ulen));
    Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewByteArrayObj(session_id, (Tcl_Size) ulen));

    /* Session ticket */
    SSL_SESSION_get0_ticket(session, &ticket, &len2);
    Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewByteArrayObj(ticket, (int) len2));
    Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewByteArrayObj(ticket, (Tcl_Size) len2));

    /* Lifetime - number of seconds */
    Tcl_ListObjAppendElement(interp, cmdPtr,
	Tcl_NewLongObj((long) SSL_SESSION_get_ticket_lifetime_hint(session)));

    /* Eval callback command */
    Tcl_IncrRefCount(cmdPtr);
︙
900
901
902
903
904
905
906
907

908
909
910
911
912
913
914

900
901
902
903
904
905
906

907
908
909
910
911
912
913
914








-
+








    servername = (const char *)p;

    /* Create command to eval */
    cmdPtr = Tcl_DuplicateObj(statePtr->vcmd);
    Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj("hello", -1));
    Tcl_ListObjAppendElement(interp, cmdPtr,
	    Tcl_NewStringObj(Tcl_GetChannelName(statePtr->self), -1));
    Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(servername, (int) len));
    Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(servername, (Tcl_Size) len));

    /* Eval callback command */
    Tcl_IncrRefCount(cmdPtr);
    if ((code = EvalCallback(interp, statePtr, cmdPtr)) > 1) {
	res = SSL_CLIENT_HELLO_RETRY;
	*alert = SSL_R_TLSV1_ALERT_USER_CANCELLED;
    } else if (code == 1) {
︙
1064
1065
1066
1067
1068
1069
1070
1071

1072
1073
1074
1075
1076
1077
1078

1064
1065
1066
1067
1068
1069
1070

1071
1072
1073
1074
1075
1076
1077
1078








-
+








	    objPtr = Tcl_NewStringObj("",0);
	    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) {
		    Tcl_AppendToObj(objPtr, buf, (int) strlen(buf));
		    Tcl_AppendToObj(objPtr, buf, (Tcl_Size) strlen(buf));
		} else {
		    Tcl_AppendToObj(objPtr, "UNKNOWN\n", 8);
		}
	    }
	}
	if (use_supported) {
	    sk_SSL_CIPHER_free(sk);
︙
1169
1170
1171
1172
1173
1174
1175
1176

1177
1178
1179
1180
1181
1182
1183

1169
1170
1171
1172
1173
1174
1175

1176
1177
1178
1179
1180
1181
1182
1183








-
+








    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "channel");
	return(TCL_ERROR);
    }

    ERR_clear_error();

    chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], NULL), NULL);
    chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], (Tcl_Size *)NULL), NULL);
    if (chan == (Tcl_Channel) NULL) {
	return(TCL_ERROR);
    }

    /* Make sure to operate on the topmost channel */
    chan = Tcl_GetTopChannel(chan);
    if (Tcl_GetChannelType(chan) != Tls_ChannelType()) {
︙
1247
1248
1249
1250
1251
1252
1253
1254


1255
1256
1257
1258
1259
1260

1261
1262

1263
1264
1265
1266
1267
1268
1269

1247
1248
1249
1250
1251
1252
1253

1254
1255
1256
1257
1258
1259
1260

1261
1262

1263
1264
1265
1266
1267
1268
1269
1270








-
+
+





-
+

-
+








    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;
    Tcl_Obj *password	        = NULL;
    Tcl_Obj *vcmd	        = NULL;
    Tcl_DString upperChannelTranslation, upperChannelBlocking, upperChannelEncoding, upperChannelEOFChar;
    int idx, len;
    int idx;
    Tcl_Size len;
    int flags		        = TLS_TCL_INIT;
    int server		        = 0;	/* is connection incoming or outgoing? */
    char *keyfile	        = NULL;
    char *certfile	        = NULL;
    unsigned char *key  	= NULL;
    int key_len                 = 0;
    Tcl_Size key_len                 = 0;
    unsigned char *cert         = NULL;
    int cert_len                = 0;
    Tcl_Size cert_len                = 0;
    char *ciphers	        = NULL;
    char *ciphersuites	        = NULL;
    char *CAfile	        = NULL;
    char *CAdir		        = NULL;
    char *DHparams	        = NULL;
    char *model		        = NULL;
    char *servername	        = NULL;	/* hostname for Server Name Indication */
︙
1292
1293
1294
1295
1296
1297
1298
1299

1300
1301
1302
1303
1304
1305
1306
1307
1308

1309
1310
1311
1312
1313
1314
1315

1293
1294
1295
1296
1297
1298
1299

1300
1301
1302
1303
1304
1305
1306
1307
1308

1309
1310
1311
1312
1313
1314
1315
1316








-
+








-
+








    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "channel ?options?");
	return TCL_ERROR;
    }

    ERR_clear_error();

    chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], NULL), NULL);
    chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], (Tcl_Size *)NULL), NULL);
    if (chan == (Tcl_Channel) NULL) {
	return TCL_ERROR;
    }

    /* Make sure to operate on the topmost channel */
    chan = Tcl_GetTopChannel(chan);

    for (idx = 2; idx < objc; idx++) {
	char *opt = Tcl_GetStringFromObj(objv[idx], NULL);
	char *opt = Tcl_GetStringFromObj(objv[idx], (Tcl_Size *)NULL);

	if (opt[0] != '-')
	    break;

	OPTOBJ("-alpn", alpn);
	OPTSTR("-cadir", CAdir);
	OPTSTR("-cafile", CAfile);
︙
1421
1422
1423
1424
1425
1426
1427
1428
1429


1430
1431
1432
1433
1434
1435
1436

1422
1423
1424
1425
1426
1427
1428


1429
1430
1431
1432
1433
1434
1435
1436
1437








-
-
+
+








		"\": not a TLS channel", NULL);
	    Tcl_SetErrorCode(interp, "TLS", "IMPORT", "CHANNEL", "INVALID", (char *) NULL);
	    Tls_Free((char *) 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, ciphersuites, level, DHparams)) == NULL) {
	if ((ctx = CTX_Init(statePtr, server, proto, keyfile, certfile, key, cert, (int) key_len,
	    (int) cert_len, CAdir, CAfile, ciphers, ciphersuites, level, DHparams)) == NULL) {
	    Tls_Free((char *) statePtr);
	    return TCL_ERROR;
	}
    }

    statePtr->ctx = ctx;
︙
1512
1513
1514
1515
1516
1517
1518

1519

1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536

1537
1538
1539
1540
1541
1542
1543
1544
1545




1546
1547
1548
1549
1550
1551
1552

1513
1514
1515
1516
1517
1518
1519
1520

1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537

1538
1539
1540
1541
1542
1543




1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554








+
-
+
















-
+





-
-
-
-
+
+
+
+









    /* Enable Application-Layer Protocol Negotiation. Examples are: http/1.0,
	http/1.1, h2, h3, ftp, imap, pop3, xmpp-client, xmpp-server, mqtt, irc, etc. */
    if (alpn) {
	/* Convert a TCL list into a protocol-list in wire-format */
	unsigned char *protos, *p;
	unsigned int protos_len = 0;
	Tcl_Size cnt, i;
	int i, len, cnt;
	int j;
	Tcl_Obj **list;

	if (Tcl_ListObjGetElements(interp, alpn, &cnt, &list) != TCL_OK) {
	    Tls_Free((char *) statePtr);
	    return TCL_ERROR;
	}

	/* Determine the memory required for the protocol-list */
	for (i = 0; i < cnt; i++) {
	    Tcl_GetStringFromObj(list[i], &len);
	    if (len > 255) {
		Tcl_AppendResult(interp, "ALPN protocol name too long", (char *) NULL);
		Tcl_SetErrorCode(interp, "TLS", "IMPORT", "ALPN", "FAILED", (char *) NULL);
		Tls_Free((char *) statePtr);
		return TCL_ERROR;
	    }
	    protos_len += 1 + len;
	    protos_len += 1 + (int) len;
	}

	/* Build the complete protocol-list */
	protos = ckalloc(protos_len);
	/* protocol-lists consist of 8-bit length-prefixed, byte strings */
	for (i = 0, p = protos; i < cnt; i++) {
	    char *str = Tcl_GetStringFromObj(list[i], &len);
	    *p++ = len;
	    memcpy(p, str, len);
	for (j = 0, p = protos; j < cnt; j++) {
	    char *str = Tcl_GetStringFromObj(list[j], &len);
	    *p++ = (unsigned char) len;
	    memcpy(p, str, (size_t) len);
	    p += len;
	}

	/* SSL_set_alpn_protos makes a copy of the protocol-list */
	/* Note: This functions reverses the return value convention */
	if (SSL_set_alpn_protos(statePtr->ssl, protos, protos_len)) {
	    Tcl_AppendResult(interp, "failed to set ALPN protocols", (char *) NULL);
︙
1716
1717
1718
1719
1720
1721
1722
1723

1724
1725
1726
1727
1728
1729
1730

1731
1732
1733
1734
1735
1736

1737
1738
1739
1740
1741
1742

1743
1744
1745
1746
1747
1748

1749
1750
1751
1752
1753
1754

1755
1756
1757
1758
1759
1760

1761
1762
1763
1764
1765
1766
1767

1718
1719
1720
1721
1722
1723
1724

1725
1726
1727
1728
1729
1730
1731

1732
1733
1734
1735
1736
1737

1738
1739
1740
1741
1742
1743

1744
1745
1746
1747
1748
1749

1750
1751
1752
1753
1754
1755

1756
1757
1758
1759
1760
1761

1762
1763
1764
1765
1766
1767
1768
1769








-
+






-
+





-
+





-
+





-
+





-
+





-
+








    int off = 0;
    int load_private_key;
    const SSL_METHOD *method;

    dprintf("Called");

    if (!proto) {
	Tcl_AppendResult(interp, "no valid protocol selected", NULL);
	Tcl_AppendResult(interp, "no valid protocol selected", (char *) NULL);
	return NULL;
    }

    /* create SSL context */
#if OPENSSL_VERSION_NUMBER >= 0x10100000L || defined(NO_SSL2) || defined(OPENSSL_NO_SSL2)
    if (ENABLED(proto, TLS_PROTO_SSL2)) {
	Tcl_AppendResult(interp, "SSL2 protocol not supported", NULL);
	Tcl_AppendResult(interp, "SSL2 protocol not supported", (char *) NULL);
	return NULL;
    }
#endif
#if defined(NO_SSL3) || defined(OPENSSL_NO_SSL3)
    if (ENABLED(proto, TLS_PROTO_SSL3)) {
	Tcl_AppendResult(interp, "SSL3 protocol not supported", NULL);
	Tcl_AppendResult(interp, "SSL3 protocol not supported", (char *) NULL);
	return NULL;
    }
#endif
#if defined(NO_TLS1) || defined(OPENSSL_NO_TLS1)
    if (ENABLED(proto, TLS_PROTO_TLS1)) {
	Tcl_AppendResult(interp, "TLS 1.0 protocol not supported", NULL);
	Tcl_AppendResult(interp, "TLS 1.0 protocol not supported", (char *) NULL);
	return NULL;
    }
#endif
#if defined(NO_TLS1_1) || defined(OPENSSL_NO_TLS1_1)
    if (ENABLED(proto, TLS_PROTO_TLS1_1)) {
	Tcl_AppendResult(interp, "TLS 1.1 protocol not supported", NULL);
	Tcl_AppendResult(interp, "TLS 1.1 protocol not supported", (char *) NULL);
	return NULL;
    }
#endif
#if defined(NO_TLS1_2) || defined(OPENSSL_NO_TLS1_2)
    if (ENABLED(proto, TLS_PROTO_TLS1_2)) {
	Tcl_AppendResult(interp, "TLS 1.2 protocol not supported", NULL);
	Tcl_AppendResult(interp, "TLS 1.2 protocol not supported", (char *) NULL);
	return NULL;
    }
#endif
#if defined(NO_TLS1_3) || defined(OPENSSL_NO_TLS1_3)
    if (ENABLED(proto, TLS_PROTO_TLS1_3)) {
	Tcl_AppendResult(interp, "TLS 1.3 protocol not supported", NULL);
	Tcl_AppendResult(interp, "TLS 1.3 protocol not supported", (char *) NULL);
	return NULL;
    }
#endif
    if (proto == 0) {
	/* Use full range */
	SSL_CTX_set_min_proto_version(ctx, 0);
	SSL_CTX_set_max_proto_version(ctx, 0);
︙
2054
2055
2056
2057
2058
2059
2060
2061

2062
2063
2064
2065
2066

2067
2068
2069
2070
2071
2072
2073

2056
2057
2058
2059
2060
2061
2062

2063
2064
2065
2066
2067

2068
2069
2070
2071
2072
2073
2074
2075








-
+




-
+








    unsigned int len;
    int nid;

    dprintf("Called");

    switch (objc) {
	case 2:
	    channelName = Tcl_GetStringFromObj(objv[1], NULL);
	    channelName = Tcl_GetStringFromObj(objv[1], (Tcl_Size *)NULL);
	    break;

	case 3:
	    if (!strcmp (Tcl_GetString (objv[1]), "-local")) {
		channelName = Tcl_GetStringFromObj(objv[2], NULL);
		channelName = Tcl_GetStringFromObj(objv[2], (Tcl_Size *)NULL);
		break;
	    }
	    /* else fall-through ... */
#if defined(__GNUC__)
	    __attribute__((fallthrough));
#endif
	default:
︙
2208
2209
2210
2211
2212
2213
2214
2215

2216
2217
2218
2219
2220
2221
2222

2210
2211
2212
2213
2214
2215
2216

2217
2218
2219
2220
2221
2222
2223
2224








-
+








    long mode;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "channel");
	return(TCL_ERROR);
    }

    chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], NULL), NULL);
    chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], (Tcl_Size *)NULL), NULL);
    if (chan == (Tcl_Channel) NULL) {
	return(TCL_ERROR);
    }

    /* Make sure to operate on the topmost channel */
    chan = Tcl_GetTopChannel(chan);
    if (Tcl_GetChannelType(chan) != Tls_ChannelType()) {
︙
2412
2413
2414
2415
2416
2417
2418

2419
2420
2421
2422
2423
2424
2425

2414
2415
2416
2417
2418
2419
2420
2421
2422
2423
2424
2425
2426
2427
2428








+








    Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("caList", -1));
    Tcl_ListObjAppendElement(interp, objPtr, listPtr);

    Tcl_SetObjResult(interp, objPtr);
    return TCL_OK;
	clientData = clientData;
}


/*
 *-------------------------------------------------------------------
 *
 * VersionObjCmd -- return version string from OpenSSL.
 *
 * Results:
︙
2458
2459
2460
2461
2462
2463
2464

2465

2466
2467
2468
2469
2470
2471
2472

2461
2462
2463
2464
2465
2466
2467
2468

2469
2470
2471
2472
2473
2474
2475
2476








+
-
+








 *
 *-------------------------------------------------------------------
 */
static int
MiscObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    static const char *commands [] = { "req", "strreq", NULL };
    enum command { C_REQ, C_STRREQ, C_DUMMY };
    Tcl_Size cmd;
    int cmd, isStr;
    int isStr;
    char buffer[16384];

    dprintf("Called");

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?args?");
	return TCL_ERROR;
︙
2481
2482
2483
2484
2485
2486
2487
2488


2489
2490
2491
2492
2493
2494
2495

2485
2486
2487
2488
2489
2490
2491

2492
2493
2494
2495
2496
2497
2498
2499
2500








-
+
+








    switch ((enum command) cmd) {
	case C_REQ:
	case C_STRREQ: {
	    EVP_PKEY *pkey=NULL;
	    X509 *cert=NULL;
	    X509_NAME *name=NULL;
	    Tcl_Obj **listv;
	    int listc,i;
	    Tcl_Size listc;
	    int i;

	    BIO *out=NULL;

	    char *k_C="",*k_ST="",*k_L="",*k_O="",*k_OU="",*k_CN="",*k_Email="";
	    char *keyout,*pemout,*str;
	    int keysize,serial=0,days=365;
︙
2512
2513
2514
2515
2516
2517
2518
2519

2520
2521
2522
2523
2524
2525
2526
2527

2517
2518
2519
2520
2521
2522
2523

2524

2525
2526
2527
2528
2529
2530
2531








-
+
-








	    pemout=Tcl_GetString(objv[4]);
	    if (isStr) {
		Tcl_SetVar(interp,keyout,"",0);
		Tcl_SetVar(interp,pemout,"",0);
	    }

	    if (objc>=6) {
		if (Tcl_ListObjGetElements(interp, objv[5],
		if (Tcl_ListObjGetElements(interp, objv[5], &listc, &listv) != TCL_OK) {
			&listc, &listv) != TCL_OK) {
		    return TCL_ERROR;
		}

		if ((listc%2) != 0) {
		    Tcl_SetResult(interp,"Information list must have even number of arguments",NULL);
		    return TCL_ERROR;
		}
︙
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
2782

2783
2784







2785

2786



2787
2788

2789
2790

2791
2792
2793

2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811

2812
2813
2814
2815
2816
2817
2818

2776
2777
2778
2779
2780
2781
2782




2783
2784

2785
2786
2787
2788
2789
2790
2791
2792
2793

2794
2795
2796
2797

2798
2799
2800
2801
2802
2803

2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821

2822
2823
2824
2825
2826
2827
2828
2829








-
-
-
-
+

-
+
+
+
+
+
+
+

+
-
+
+
+

-
+


+


-
+

















-
+








    const char tlsTclInitScript[] = {
#include "tls.tcl.h"
	0x00
    };

    dprintf("Called");

    /*
     * We only support Tcl 8.4 or newer
     */
    if (
#if TCL_MAJOR_VERSION > 8
#ifdef USE_TCL_STUBS
	Tcl_InitStubs(interp, "8.4", 0)
    if (Tcl_InitStubs(interp, "9.0", 0) == NULL) {
	return TCL_ERROR;
    }
#endif
    if (Tcl_PkgRequire(interp, "Tcl", "9.0-", 0) == NULL) {
	return TCL_ERROR;
    }
#else
#ifdef USE_TCL_STUBS
	Tcl_PkgRequire(interp, "Tcl", "8.4-", 0)
    if (Tcl_InitStubs(interp, "8.5", 0) == NULL) {
	return TCL_ERROR;
    }
#endif
	 == NULL) {
    if (Tcl_PkgRequire(interp, "Tcl", "8.5-", 0) == NULL) {
	return TCL_ERROR;
    }
#endif

    if (TlsLibInit(0) != TCL_OK) {
	Tcl_AppendResult(interp, "could not initialize SSL library", NULL);
	Tcl_AppendResult(interp, "could not initialize SSL library", (char *) NULL);
	return TCL_ERROR;
    }

    Tcl_CreateObjCommand(interp, "tls::ciphers", CiphersObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "tls::connection", ConnectionInfoObjCmd, (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::unimport", UnimportObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "tls::status", StatusObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "tls::version", VersionObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "tls::misc", MiscObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "tls::protocols", ProtocolsObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);

    if (interp) {
	Tcl_Eval(interp, tlsTclInitScript);
    }

    return(Tcl_PkgProvide(interp, "tls", PACKAGE_VERSION));
    return Tcl_PkgProvide(interp, PACKAGE_NAME, PACKAGE_VERSION);
}

/*
 *------------------------------------------------------*
 *
 *	Tls_SafeInit --
 *
︙

Modified generic/tlsBIO.c from [88d81d7f98] to [904acc3cbd]. 

1
2
3
4
5
6
7
8
9
10
11

12
13
14
15
16
17
18

19
20
21
22

23

24
25
26
27
28
29
30

1
2
3
4
5
6
7
8
9
10

11
12
13
14
15
16
17

18
19
20
21
22
23

24
25
26
27
28
29
30
31











-
+






-
+




+
-
+








/*
 * Copyright (C) 1997-2000 Matt Newman <[email protected]>
 *
 * Provides BIO layer to interface openssl to Tcl.
 */

#include "tlsInt.h"

static int BioWrite(BIO *bio, const char *buf, int bufLen) {
    Tcl_Channel chan;
    int ret;
    Tcl_Size ret;
    int tclEofChan, tclErrno;

    chan = Tls_GetParent((State *) BIO_get_data(bio), 0);

    dprintf("[chan=%p] BioWrite(%p, <buf>, %d)", (void *)chan, (void *) bio, bufLen);

    ret = Tcl_WriteRaw(chan, buf, bufLen);
    ret = Tcl_WriteRaw(chan, buf, (Tcl_Size) bufLen);

    tclEofChan = Tcl_Eof(chan);
    tclErrno = Tcl_GetErrno();

    dprintf("[chan=%p] BioWrite(%d) -> %" TCL_SIZE_MODIFIER "d [tclEof=%d; tclErrno=%d]",
    dprintf("[chan=%p] BioWrite(%d) -> %d [tclEof=%d; tclErrno=%d]", (void *) chan, bufLen, ret, tclEofChan, Tcl_GetErrno());
	(void *) chan, bufLen, ret, tclEofChan, Tcl_GetErrno());

    BIO_clear_flags(bio, BIO_FLAGS_WRITE | BIO_FLAGS_SHOULD_RETRY);

    if (tclEofChan && ret <= 0) {
	dprintf("Got EOF while reading, returning a Connection Reset error which maps to Soft EOF");
	Tcl_SetErrno(ECONNRESET);
	ret = 0;
︙
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
84
85

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
84
85
86
87








-
+




-
+










-
+




+
-
+








    if (ret != -1 || (ret == -1 && tclErrno == EAGAIN)) {
	if (BIO_should_read(bio)) {
	    dprintf("Setting should retry read flag");

	    BIO_set_retry_read(bio);
	}
    }
    return(ret);
    return((int) ret);
}

static int BioRead(BIO *bio, char *buf, int bufLen) {
    Tcl_Channel chan;
    int ret = 0;
    Tcl_Size ret = 0;
    int tclEofChan, tclErrno;

    chan = Tls_GetParent((State *) BIO_get_data(bio), 0);

    dprintf("[chan=%p] BioRead(%p, <buf>, %d)", (void *) chan, (void *) bio, bufLen);

    if (buf == NULL) {
	return 0;
    }

    ret = Tcl_ReadRaw(chan, buf, bufLen);
    ret = Tcl_ReadRaw(chan, buf, (Tcl_Size) bufLen);

    tclEofChan = Tcl_Eof(chan);
    tclErrno = Tcl_GetErrno();

    dprintf("[chan=%p] BioRead(%d) -> %" TCL_SIZE_MODIFIER "d [tclEof=%d; tclErrno=%d]",
    dprintf("[chan=%p] BioRead(%d) -> %d [tclEof=%d; tclErrno=%d]", (void *) chan, bufLen, ret, tclEofChan, tclErrno);
	(void *) chan, bufLen, ret, tclEofChan, tclErrno);

    BIO_clear_flags(bio, BIO_FLAGS_READ | BIO_FLAGS_SHOULD_RETRY);

    if (tclEofChan && ret <= 0) {
	dprintf("Got EOF while reading, returning a Connection Reset error which maps to Soft EOF");
	Tcl_SetErrno(ECONNRESET);
	ret = 0;
︙
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
220
221
222
223
224
225

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








-
+
+

-
+














-
+



-
-
-
-
+
+
+
+

-
-
-
+
+
+

-
-
-
+
+
+

-
-
-
+
+
+

-
-
-
+
+
+

-
-
-
+
+
+

-
-
-
+
+
+

-
-
-
+
+
+

-
-
-
+
+
+

-
-
-
-
+
+
+
+

-
-
-
+
+
+

-
-
+
+

-
-
-
-
+
+
+
+

-
-
-
+
+
+

-
-
-
+
+
+

-
-
-
+
+
+

-
-
-
+
+
+


-
-
-
+
+
+



-
-
-
+
+
+


-
-
-
+
+
+








	if (BIO_should_write(bio)) {
	    dprintf("Setting should retry write flag");

	    BIO_set_retry_write(bio);
	}
    }

    dprintf("BioRead(%p, <buf>, %d) [%p] returning %i", (void *) bio, bufLen, (void *) chan, ret);
    dprintf("BioRead(%p, <buf>, %d) [%p] returning %" TCL_SIZE_MODIFIER "d", (void *) bio,
	bufLen, (void *) chan, ret);

    return(ret);
    return((int) ret);
}

static int BioPuts(BIO *bio, const char *str) {
    dprintf("BioPuts(%p, <string:%p>) called", bio, str);

    return BioWrite(bio, str, (int) strlen(str));
}

static long BioCtrl(BIO *bio, int cmd, long num, void *ptr) {
    Tcl_Channel chan;
    long ret = 1;

    chan = Tls_GetParent((State *) BIO_get_data(bio), 0);

	dprintf("BioCtrl(%p, 0x%x, 0x%lx, %p)", (void *) bio, cmd, num, ptr);
    dprintf("BioCtrl(%p, 0x%x, 0x%lx, %p)", (void *) bio, cmd, num, ptr);

    switch (cmd) {
	case BIO_CTRL_RESET:
	    dprintf("Got BIO_CTRL_RESET");
	    num = 0;
			ret = 0;
			break;
		dprintf("Got BIO_CTRL_RESET");
		num = 0;
		ret = 0;
		break;
	case BIO_C_FILE_SEEK:
	    dprintf("Got BIO_C_FILE_SEEK");
			ret = 0;
			break;
		dprintf("Got BIO_C_FILE_SEEK");
		ret = 0;
		break;
	case BIO_C_FILE_TELL:
	    dprintf("Got BIO_C_FILE_TELL");
	    ret = 0;
	    break;
		dprintf("Got BIO_C_FILE_TELL");
		ret = 0;
		break;
	case BIO_CTRL_INFO:
	    dprintf("Got BIO_CTRL_INFO");
	    ret = 1;
	    break;
		dprintf("Got BIO_CTRL_INFO");
		ret = 1;
		break;
	case BIO_C_SET_FD:
	    dprintf("Unsupported call: BIO_C_SET_FD");
	    ret = -1;
	    break;
		dprintf("Unsupported call: BIO_C_SET_FD");
		ret = -1;
		break;
	case BIO_C_GET_FD:
	    dprintf("Unsupported call: BIO_C_GET_FD");
	    ret = -1;
	    break;
		dprintf("Unsupported call: BIO_C_GET_FD");
		ret = -1;
		break;
	case BIO_CTRL_GET_CLOSE:
	    dprintf("Got BIO_CTRL_CLOSE");
	    ret = BIO_get_shutdown(bio);
	    break;
		dprintf("Got BIO_CTRL_CLOSE");
		ret = BIO_get_shutdown(bio);
		break;
	case BIO_CTRL_SET_CLOSE:
	    dprintf("Got BIO_SET_CLOSE");
	    BIO_set_shutdown(bio, num);
	    break;
		dprintf("Got BIO_SET_CLOSE");
		BIO_set_shutdown(bio, num);
		break;
	case BIO_CTRL_EOF:
	    dprintf("Got BIO_CTRL_EOF");
			ret = ((chan) ? Tcl_Eof(chan) : 1);
	    break;
		dprintf("Got BIO_CTRL_EOF");
		ret = ((chan) ? Tcl_Eof(chan) : 1);
		break;
	case BIO_CTRL_PENDING:
	    dprintf("Got BIO_CTRL_PENDING");
			ret = ((chan) ? ((Tcl_InputBuffered(chan) ? 1 : 0)) : 0);
	    dprintf("BIO_CTRL_PENDING(%d)", (int) ret);
	    break;
		dprintf("Got BIO_CTRL_PENDING");
		ret = ((chan) ? ((Tcl_InputBuffered(chan) ? 1 : 0)) : 0);
		dprintf("BIO_CTRL_PENDING(%d)", (int) ret);
		break;
	case BIO_CTRL_WPENDING:
	    dprintf("Got BIO_CTRL_WPENDING");
	    ret = 0;
	    break;
		dprintf("Got BIO_CTRL_WPENDING");
		ret = 0;
		break;
	case BIO_CTRL_DUP:
	    dprintf("Got BIO_CTRL_DUP");
	    break;
		dprintf("Got BIO_CTRL_DUP");
		break;
	case BIO_CTRL_FLUSH:
	    dprintf("Got BIO_CTRL_FLUSH");
			ret = ((chan) && (Tcl_WriteRaw(chan, "", 0) >= 0) ? 1 : -1);
	    dprintf("BIO_CTRL_FLUSH returning value %li", ret);
	    break;
		dprintf("Got BIO_CTRL_FLUSH");
		ret = ((chan) && (Tcl_WriteRaw(chan, "", 0) >= 0) ? 1 : -1);
		dprintf("BIO_CTRL_FLUSH returning value %li", ret);
		break;
	case BIO_CTRL_PUSH:
	    dprintf("Got BIO_CTRL_PUSH");
	    ret = 0;
	    break;
		dprintf("Got BIO_CTRL_PUSH");
		ret = 0;
		break;
	case BIO_CTRL_POP:
	    dprintf("Got BIO_CTRL_POP");
	    ret = 0;
	    break;
		dprintf("Got BIO_CTRL_POP");
		ret = 0;
		break;
	case BIO_CTRL_SET:
	    dprintf("Got BIO_CTRL_SET");
	    ret = 0;
	    break;
		dprintf("Got BIO_CTRL_SET");
		ret = 0;
		break;
	case BIO_CTRL_GET :
	    dprintf("Got BIO_CTRL_GET ");
	    ret = 0;
	    break;
		dprintf("Got BIO_CTRL_GET ");
		ret = 0;
		break;
#ifdef BIO_CTRL_GET_KTLS_SEND
	case BIO_CTRL_GET_KTLS_SEND:
	    dprintf("Got BIO_CTRL_GET_KTLS_SEND");
	    ret = 0;
	    break;
		dprintf("Got BIO_CTRL_GET_KTLS_SEND");
		ret = 0;
		break;
#endif
#ifdef BIO_CTRL_GET_KTLS_RECV
	case BIO_CTRL_GET_KTLS_RECV:
	    dprintf("Got BIO_CTRL_GET_KTLS_RECV");
	    ret = 0;
	    break;
		dprintf("Got BIO_CTRL_GET_KTLS_RECV");
		ret = 0;
		break;
#endif
	default:
	    dprintf("Got unknown control command (%i)", cmd);
	    ret = 0;
	    break;
		dprintf("Got unknown control command (%i)", cmd);
		ret = 0;
		break;
    }
    return(ret);
}

static int BioNew(BIO *bio) {
    dprintf("BioNew(%p) called", bio);
︙

Modified generic/tlsIO.c from [78ad51e25b] to [1ca7509902].

︙
85
86
87
88
89
90
91
92

93
94
95
96
97
98

99
100
101
102
103
104
105

85
86
87
88
89
90
91

92
93
94
95
96
97

98
99
100
101
102
103
104
105








-
+





-
+








    Tcl_EventuallyFree((ClientData)statePtr, Tls_Free);
    return(0);

	/* Interp is unused. */
	interp = interp;
}

static int TlsCloseProc2(ClientData instanceData,    /* The socket state. */
static int TlsClose2Proc(ClientData instanceData,    /* The socket state. */
    Tcl_Interp *interp,		/* For errors - can be NULL. */
    int flags)			/* Flags to close read and/or write side of channel */
{
    State *statePtr = (State *) instanceData;

    dprintf("TlsCloseProc2(%p)", (void *) statePtr);
    dprintf("TlsClose2Proc(%p)", (void *) statePtr);

    if ((flags & (TCL_CLOSE_READ|TCL_CLOSE_WRITE)) == 0) {
	return TlsCloseProc(instanceData, interp);
    }
    return EINVAL;
}
︙
969
970
971
972
973
974
975

976

977
978
979
980
981
982
983
984
985
986

987
988
989
990
991
992
993
994

995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006


1007
1008
1009
1010

969
970
971
972
973
974
975
976

977
978
979
980
981
982
983
984
985
986

987
988
989
990
991
992
993
994

995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013








+
-
+









-
+







-
+












+
+





	/* Allocate new channel type structure */
	size = sizeof(Tcl_ChannelType) * 2; /* Base size plus pad for future changes */
	tlsChannelType = (Tcl_ChannelType *) ckalloc(size);
	memset((void *) tlsChannelType, 0, size);

	/* Init structure */
	tlsChannelType->typeName	= "tls";
	/* TCL 8.5 and later */
#ifdef TCL_CHANNEL_VERSION_5
#if TCL_MAJOR_VERSION > 8 || defined(TCL_CHANNEL_VERSION_5)
	tlsChannelType->version		= TCL_CHANNEL_VERSION_5;
	tlsChannelType->closeProc	= TlsCloseProc;
	tlsChannelType->inputProc	= TlsInputProc;
	tlsChannelType->outputProc	= TlsOutputProc;
	tlsChannelType->seekProc	= NULL;
	tlsChannelType->setOptionProc	= TlsSetOptionProc;
	tlsChannelType->getOptionProc	= TlsGetOptionProc;
	tlsChannelType->watchProc	= TlsWatchProc;
	tlsChannelType->getHandleProc	= TlsGetHandleProc;
	tlsChannelType->close2Proc	= TlsCloseProc2;
	tlsChannelType->close2Proc	= TlsClose2Proc;
	tlsChannelType->blockModeProc	= TlsBlockModeProc;
	tlsChannelType->flushProc	= NULL;
	tlsChannelType->handlerProc	= TlsNotifyProc;
	tlsChannelType->wideSeekProc	= NULL;
	tlsChannelType->threadActionProc = NULL;
	tlsChannelType->truncateProc	= NULL;
#else
	tlsChannelType->version		= TCL_CHANNEL_VERSION_2;
	tlsChannelType->version		= TCL_CHANNEL_VERSION_4;
	tlsChannelType->closeProc	= TlsCloseProc;
	tlsChannelType->inputProc	= TlsInputProc;
	tlsChannelType->outputProc	= TlsOutputProc;
	tlsChannelType->seekProc	= NULL;
	tlsChannelType->setOptionProc	= TlsSetOptionProc;
	tlsChannelType->getOptionProc	= TlsGetOptionProc;
	tlsChannelType->watchProc	= TlsWatchProc;
	tlsChannelType->getHandleProc	= TlsGetHandleProc;
	tlsChannelType->close2Proc	= NULL;
	tlsChannelType->blockModeProc	= TlsBlockModeProc;
	tlsChannelType->flushProc	= NULL;
	tlsChannelType->handlerProc	= TlsNotifyProc;
	tlsChannelType->wideSeekProc	= NULL;
	tlsChannelType->threadActionProc = NULL;
#endif
    }
    return(tlsChannelType);
}

Modified generic/tlsInt.h from [bb784703e5] to [3f4fb6ad69].

︙
27
28
29
30
31
32
33



34













35
36
37
38
39
40
41

27
28
29
30
31
32
33
34
35
36

37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56








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








#define WIN32_LEAN_AND_MEAN
#include <windows.h>
#include <wincrypt.h> /* OpenSSL needs this on Windows */
#endif

/* Handle TCL 8.6 CONST changes */
#ifndef CONST86
#   if TCL_MAJOR_VERSION > 8
#	define CONST86 const
#   else
#define CONST86
#	define CONST86
#   endif
#endif

/*
 * Backwards compatibility for size type change
 */
#if TCL_MAJOR_VERSION < 9 && TCL_MINOR_VERSION < 7
    #ifndef Tcl_Size
        typedef int Tcl_Size;
    #endif

    #define TCL_SIZE_MODIFIER ""
#endif

#include <openssl/ssl.h>
#include <openssl/err.h>
#include <openssl/rand.h>
#include <openssl/opensslv.h>
︙

Modified generic/tlsX509.c from [0d1e21b228] to [c5b889a2d5].

︙
99
100
101
102
103
104
105
106

107
108
109
110
111
112
113

99
100
101
102
103
104
105

106
107
108
109
110
111
112
113








-
+








    int len = 0;
    char buffer[1024];

    if (astring != NULL) {
	len = String_to_Hex((char *)ASN1_STRING_get0_data(astring),
	    ASN1_STRING_length(astring), buffer, 1024);
    }
    resultPtr = Tcl_NewStringObj(buffer, len);
    resultPtr = Tcl_NewStringObj(buffer, (Tcl_Size) len);
    return resultPtr;
}

/*
 * Get Key Usage
 */
Tcl_Obj *Tls_x509KeyUsage(Tcl_Interp *interp, X509 *cert, uint32_t xflags) {
︙
221
222
223
224
225
226
227
228

229
230
231
232
233
234
235

221
222
223
224
225
226
227

228
229
230
231
232
233
234
235








-
+








    }

    if (names = X509_get_ext_d2i(cert, nid, NULL, NULL)) {
	for (int i=0; i < sk_GENERAL_NAME_num(names); i++) {
	    const GENERAL_NAME *name = sk_GENERAL_NAME_value(names, i);

	    len = BIO_to_Buffer(name && GENERAL_NAME_print(bio, name), bio, buffer, 1024);
	    LAPPEND_STR(interp, listPtr, NULL, buffer, len);
	    LAPPEND_STR(interp, listPtr, NULL, buffer, (Tcl_Size) len);
	}
	sk_GENERAL_NAME_pop_free(names, GENERAL_NAME_free);
    }
    return listPtr;
}

/*
︙
298
299
300
301
302
303
304
305

306
307
308
309
310
311
312
313
314

315
316
317
318
319
320
321

298
299
300
301
302
303
304

305
306
307
308
309
310
311
312
313

314
315
316
317
318
319
320
321








-
+








-
+








	    if (distpoint->type == 0) {
		/* full-name GENERALIZEDNAME */
		for (int j = 0; j < sk_GENERAL_NAME_num(distpoint->name.fullname); j++) {
		    GENERAL_NAME *gen = sk_GENERAL_NAME_value(distpoint->name.fullname, j);
		    int type;
		    ASN1_STRING *uri = GENERAL_NAME_get0_value(gen, &type);
		    if (type == GEN_URI) {
			LAPPEND_STR(interp, listPtr, NULL, ASN1_STRING_get0_data(uri), ASN1_STRING_length(uri));
			LAPPEND_STR(interp, listPtr, NULL, ASN1_STRING_get0_data(uri), (Tcl_Size) ASN1_STRING_length(uri));
		    }
		}
	    } else if (distpoint->type == 1) {
		/* relative-name X509NAME */
		STACK_OF(X509_NAME_ENTRY) *sk_relname = distpoint->name.relativename;
		for (int j = 0; j < sk_X509_NAME_ENTRY_num(sk_relname); j++) {
		    X509_NAME_ENTRY *e = sk_X509_NAME_ENTRY_value(sk_relname, j);
		    ASN1_STRING *d = X509_NAME_ENTRY_get_data(e);
		    LAPPEND_STR(interp, listPtr, NULL, ASN1_STRING_data(d), ASN1_STRING_length(d));
		    LAPPEND_STR(interp, listPtr, NULL, ASN1_STRING_data(d), (Tcl_Size) ASN1_STRING_length(d));
		}
	    }
	}
	CRL_DIST_POINTS_free(crl);
    }
    return listPtr;
}
︙
352
353
354
355
356
357
358
359

360
361
362
363
364
365
366

352
353
354
355
356
357
358

359
360
361
362
363
364
365
366








-
+









    if (ads = X509_get_ext_d2i(cert, NID_info_access, NULL, NULL)) {
	for (int i = 0; i < sk_ACCESS_DESCRIPTION_num(ads); i++) {
	    ad = sk_ACCESS_DESCRIPTION_value(ads, i);
	    if (OBJ_obj2nid(ad->method) == NID_ad_ca_issuers && ad->location) {
		if (ad->location->type == GEN_URI) {
		    len = ASN1_STRING_to_UTF8(&buf, ad->location->d.uniformResourceIdentifier);
		    Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj(buf, len));
		    Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj(buf, (Tcl_Size) len));
		    OPENSSL_free(buf);
		    break;
		}
	    }
	}
	/* sk_ACCESS_DESCRIPTION_pop_free(ads, ACCESS_DESCRIPTION_free); */
	AUTHORITY_INFO_ACCESS_free(ads);
︙
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
486
487
488
489

490
491
492
493
494
495
496

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
486
487
488

489
490
491
492
493
494
495
496








-
+







-
+







-
+





-
+



-
+




-
+




-
+





-
+














-
+





-
+






-
+








	int sig_nid;

	X509_get0_signature(&sig, &sig_alg, cert);
	/* sig_nid = X509_get_signature_nid(cert) */
	sig_nid = OBJ_obj2nid(sig_alg->algorithm);
	LAPPEND_STR(interp, certPtr, "signatureAlgorithm", OBJ_nid2ln(sig_nid), -1);
	len = (sig_nid != NID_undef) ? String_to_Hex(sig->data, sig->length, buffer, BUFSIZ) : 0;
	LAPPEND_STR(interp, certPtr, "signatureValue", buffer, len);
	LAPPEND_STR(interp, certPtr, "signatureValue", buffer, (Tcl_Size) len);
    }

    /* Version of the encoded certificate - RFC 5280 section 4.1.2.1 */
    LAPPEND_LONG(interp, certPtr, "version", X509_get_version(cert)+1);

    /* Unique number assigned by CA to certificate - RFC 5280 section 4.1.2.2 */
    len = BIO_to_Buffer(i2a_ASN1_INTEGER(bio, X509_get0_serialNumber(cert)), bio, buffer, BUFSIZ);
    LAPPEND_STR(interp, certPtr, "serialNumber", buffer, len);
    LAPPEND_STR(interp, certPtr, "serialNumber", buffer, (Tcl_Size) len);

    /* Signature algorithm used by the CA to sign the certificate. Must match
	signatureAlgorithm. RFC 5280 section 4.1.2.3 */
    LAPPEND_STR(interp, certPtr, "signature", OBJ_nid2ln(X509_get_signature_nid(cert)), -1);

    /* Issuer identifies the entity that signed and issued the cert. RFC 5280 section 4.1.2.4 */
    len = BIO_to_Buffer(X509_NAME_print_ex(bio, X509_get_issuer_name(cert), 0, flags), bio, buffer, BUFSIZ);
    LAPPEND_STR(interp, certPtr, "issuer", buffer, len);
    LAPPEND_STR(interp, certPtr, "issuer", buffer, (Tcl_Size) len);

    /* Certificate validity period is the interval the CA warrants that it will
	maintain info on the status of the certificate. RFC 5280 section 4.1.2.5 */
    /* Get Validity - Not Before */
    len = BIO_to_Buffer(ASN1_TIME_print(bio, X509_get0_notBefore(cert)), bio, buffer, BUFSIZ);
    LAPPEND_STR(interp, certPtr, "notBefore", buffer, len);
    LAPPEND_STR(interp, certPtr, "notBefore", buffer, (Tcl_Size) len);

    /* Get Validity - Not After */
    len = BIO_to_Buffer(ASN1_TIME_print(bio, X509_get0_notAfter(cert)), bio, buffer, BUFSIZ);
    LAPPEND_STR(interp, certPtr, "notAfter", buffer, len);
    LAPPEND_STR(interp, certPtr, "notAfter", buffer, (Tcl_Size) len);

    /* Subject identifies the entity associated with the public key stored in
	the subject public key field. RFC 5280 section 4.1.2.6 */
    len = BIO_to_Buffer(X509_NAME_print_ex(bio, X509_get_subject_name(cert), 0, flags), bio, buffer, BUFSIZ);
    LAPPEND_STR(interp, certPtr, "subject", buffer, len);
    LAPPEND_STR(interp, certPtr, "subject", buffer, (Tcl_Size) len);

    /* SHA1 Digest (Fingerprint) of cert - DER representation */
    if (X509_digest(cert, EVP_sha1(), md, &len)) {
    len = String_to_Hex(md, len, buffer, BUFSIZ);
	LAPPEND_STR(interp, certPtr, "sha1_hash", buffer, len);
	LAPPEND_STR(interp, certPtr, "sha1_hash", buffer, (Tcl_Size) len);
    }

    /* SHA256 Digest (Fingerprint) of cert - DER representation */
    if (X509_digest(cert, EVP_sha256(), md, &len)) {
    len = String_to_Hex(md, len, buffer, BUFSIZ);
	LAPPEND_STR(interp, certPtr, "sha256_hash", buffer, len);
	LAPPEND_STR(interp, certPtr, "sha256_hash", buffer, (Tcl_Size) len);
    }

    /* Subject Public Key Info specifies the public key and identifies the
	algorithm with which the key is used. RFC 5280 section 4.1.2.7 */
    if (X509_get_signature_info(cert, &mdnid, &pknid, &bits, &xflags)) {
	ASN1_BIT_STRING *key;
	unsigned int n;

	LAPPEND_STR(interp, certPtr, "signingDigest", OBJ_nid2ln(mdnid), -1);
	LAPPEND_STR(interp, certPtr, "publicKeyAlgorithm", OBJ_nid2ln(pknid), -1);
	LAPPEND_INT(interp, certPtr, "bits", bits); /* Effective security bits */

	key = X509_get0_pubkey_bitstr(cert);
	len = String_to_Hex(key->data, key->length, buffer, BUFSIZ);
	LAPPEND_STR(interp, certPtr, "publicKey", buffer, len);
	LAPPEND_STR(interp, certPtr, "publicKey", buffer, (Tcl_Size) len);

	len = 0;
	if (X509_pubkey_digest(cert, EVP_get_digestbynid(pknid), md, &n)) {
	    len = String_to_Hex(md, (int)n, buffer, BUFSIZ);
	}
	LAPPEND_STR(interp, certPtr, "publicKeyHash", buffer, len);
	LAPPEND_STR(interp, certPtr, "publicKeyHash", buffer, (Tcl_Size) len);

	/* digest of the DER representation of the certificate */
	len = 0;
	if (X509_digest(cert, EVP_get_digestbynid(mdnid), md, &n)) {
	    len = String_to_Hex(md, (int)n, buffer, BUFSIZ);
	}
	LAPPEND_STR(interp, certPtr, "signatureHash", buffer, len);
	LAPPEND_STR(interp, certPtr, "signatureHash", buffer, (Tcl_Size) len);
    }

    /* Certificate Purpose. Call before checking for extensions. */
    LAPPEND_STR(interp, certPtr, "purpose", Tls_x509Purpose(cert), -1);
    LAPPEND_OBJ(interp, certPtr, "certificatePurpose", Tls_x509Purposes(interp, cert));

    /* Get extensions flags */
︙
508
509
510
511
512
513
514
515

516
517
518
519
520
521
522

523
524
525
526
527
528
529

508
509
510
511
512
513
514

515
516
517
518
519
520
521

522
523
524
525
526
527
528
529








-
+






-
+








	and/or issuer names over time. RFC 5280 section 4.1.2.8 */
    {
	const ASN1_BIT_STRING *iuid, *suid;
        X509_get0_uids(cert, &iuid, &suid);

	Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewStringObj("issuerUniqueId", -1));
	if (iuid != NULL) {
	    Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewByteArrayObj((char *)iuid->data, iuid->length));
	    Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewByteArrayObj((char *)iuid->data, (Tcl_Size) iuid->length));
	} else {
	    Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewStringObj("", -1));
	}

	Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewStringObj("subjectUniqueId", -1));
	if (suid != NULL) {
	    Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewByteArrayObj((char *)suid->data, suid->length));
	    Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewByteArrayObj((char *)suid->data, (Tcl_Size) suid->length));
	} else {
	    Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewStringObj("", -1));
	}
    }

    /* X509 v3 Extensions - RFC 5280 section 4.1.2.9 */
    LAPPEND_INT(interp, certPtr, "extCount", X509_get_ext_count(cert));
︙
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

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








-
+








-
+



-
+






    /* Subject Information Access - RFC 5280 section 4.2.2.2, NID_sinfo_access */

    /* Certificate Alias. If uses a PKCS#12 structure, alias will reflect the
	friendlyName attribute (RFC 2985). */
    {
	len = 0;
        char *string = X509_alias_get0(cert, &len);
	LAPPEND_STR(interp, certPtr, "alias", string, len);
	LAPPEND_STR(interp, certPtr, "alias", string, (Tcl_Size) len);
    }

    /* Certificate and dump all data */
    {
	char certStr[CERT_STR_SIZE];

	/* Get certificate */
	len = BIO_to_Buffer(PEM_write_bio_X509(bio, cert), bio, certStr, CERT_STR_SIZE);
	LAPPEND_STR(interp, certPtr, "certificate", certStr, len);
	LAPPEND_STR(interp, certPtr, "certificate", certStr, (Tcl_Size) len);

	/* Get all cert info */
	len = BIO_to_Buffer(X509_print_ex(bio, cert, flags, 0), bio, certStr, CERT_STR_SIZE);
	LAPPEND_STR(interp, certPtr, "all", certStr, len);
	LAPPEND_STR(interp, certPtr, "all", certStr, (Tcl_Size) len);
    }

    BIO_free(bio);
    return certPtr;
}

Powered by Fossil · RSS