Check-in Differences

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Difference From 1505883e4a18b50e To df52134925f88091

2024-10-05
14:39
Fix formatting Leaf check-in: df52134925 user: Bandoti tags: in-mem-cacert
14:35
Clean up error handling check-in: 185b37e621 user: Bandoti tags: in-mem-cacert
11:47
Create new branch named "in-mem-cacert" check-in: 7f432bcb5a user: Bandoti tags: in-mem-cacert
11:36
Remove manifest.uuid Leaf check-in: 58d7711452 user: Bandoti tags: tls-1.8
2024-07-01
01:08
Changed to send SSL_shutdown as part of BIO close channel handler rather than Tls_Clean. check-in: 1505883e4a user: bohagan tags: tls-1.8
2024-06-29
19:21
Backed out changes to provide error status when setting -cadir, -cafile, and -castore options. Breaks IO test cases. check-in: 89536252d5 user: bohagan tags: tls-1.8

Changes to generic/tls.c.

1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
    Tcl_GetChannelOption(interp, chan, "-encoding", &upperChannelEncoding);
    Tcl_GetChannelOption(interp, chan, "-translation", &upperChannelTranslation);
    Tcl_GetChannelOption(interp, chan, "-blocking", &upperChannelBlocking);

    /* Ensure the channel works in binary mode (for the encryption not to get goofed up). */
    Tcl_SetChannelOption(interp, chan, "-translation", "binary");
    Tcl_SetChannelOption(interp, chan, "-blocking", "true");
    
    /* Create stacked channel */
    dprintf("Consuming Tcl channel %s", Tcl_GetChannelName(chan));
    statePtr->self = Tcl_StackChannel(interp, Tls_ChannelType(), (ClientData) statePtr,
	(TCL_READABLE | TCL_WRITABLE), chan);
    dprintf("Created channel named %s", Tcl_GetChannelName(statePtr->self));
    if (statePtr->self == (Tcl_Channel) NULL) {
	/*







|







1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
    Tcl_GetChannelOption(interp, chan, "-encoding", &upperChannelEncoding);
    Tcl_GetChannelOption(interp, chan, "-translation", &upperChannelTranslation);
    Tcl_GetChannelOption(interp, chan, "-blocking", &upperChannelBlocking);

    /* Ensure the channel works in binary mode (for the encryption not to get goofed up). */
    Tcl_SetChannelOption(interp, chan, "-translation", "binary");
    Tcl_SetChannelOption(interp, chan, "-blocking", "true");

    /* Create stacked channel */
    dprintf("Consuming Tcl channel %s", Tcl_GetChannelName(chan));
    statePtr->self = Tcl_StackChannel(interp, Tls_ChannelType(), (ClientData) statePtr,
	(TCL_READABLE | TCL_WRITABLE), chan);
    dprintf("Created channel named %s", Tcl_GetChannelName(statePtr->self));
    if (statePtr->self == (Tcl_Channel) NULL) {
	/*
1741
1742
1743
1744
1745
1746
1747




1748
1749
1750
1751
1752
1753
1754
    /* Clean-up */
    Tcl_DStringFree(&upperChannelTranslation);
    Tcl_DStringFree(&upperChannelEncoding);
    Tcl_DStringFree(&upperChannelEOFChar);
    Tcl_DStringFree(&upperChannelBlocking);
    return res;
}





/*
 *-------------------------------------------------------------------
 *
 * CTX_Init -- construct a SSL_CTX instance
 *
 * Results:







>
>
>
>







1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
    /* Clean-up */
    Tcl_DStringFree(&upperChannelTranslation);
    Tcl_DStringFree(&upperChannelEncoding);
    Tcl_DStringFree(&upperChannelEOFChar);
    Tcl_DStringFree(&upperChannelBlocking);
    return res;
}

static int
TlsLoadClientCAFileFromMemory(Tcl_Interp *interp, SSL_CTX *ctx, const Tcl_Obj *file);


/*
 *-------------------------------------------------------------------
 *
 * CTX_Init -- construct a SSL_CTX instance
 *
 * Results:
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116











2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127













2128
2129
2130
2131
2132
2133




































































































2134
2135
2136
2137
2138
2139
2140
	/* Set directory containing CA certificates in PEM format. */
	if (CApath != NULL) {
	    if (!SSL_CTX_load_verify_dir(ctx, F2N(CApath, &ds))) {
		abort++;
	    }
	    Tcl_DStringFree(&ds);
	}
	
	/* Set URI for to a store, which may be a single container or a catalog of containers. */
	if (CAstore != NULL) {
	    if (!SSL_CTX_load_verify_store(ctx, F2N(CAstore, &ds))) {
		abort++;
	    }
	    Tcl_DStringFree(&ds);
	}
	
	/* Set file of CA certificates in PEM format.  */
	if (CAfile != NULL) {











	    if (!SSL_CTX_load_verify_file(ctx, F2N(CAfile, &ds))) {
		abort++;
	    }
	    Tcl_DStringFree(&ds);

	    /* Set list of CAs to send to client when requesting a client certificate */
	    STACK_OF(X509_NAME) *certNames = SSL_load_client_CA_file(F2N(CAfile, &ds));
	    if (certNames != NULL) {
		SSL_CTX_set_client_CA_list(ctx, certNames);
	    }
	    Tcl_DStringFree(&ds);













	}
#endif
    }

    return ctx;
}





































































































/*
 *-------------------------------------------------------------------
 *
 * StatusObjCmd -- return certificate for connected peer info.
 *
 * Results:







|







|


>
>
>
>
>
>
>
>
>
>
>
|
|
|
|

|
|
|
|
|
|
>
>
>
>
>
>
>
>
>
>
>
>
>






>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
2166
2167
2168
2169
2170
2171
2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200
2201
2202
2203
2204
2205
2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
2235
2236
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
2253
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
2265
2266
2267
2268
	/* Set directory containing CA certificates in PEM format. */
	if (CApath != NULL) {
	    if (!SSL_CTX_load_verify_dir(ctx, F2N(CApath, &ds))) {
		abort++;
	    }
	    Tcl_DStringFree(&ds);
	}

	/* Set URI for to a store, which may be a single container or a catalog of containers. */
	if (CAstore != NULL) {
	    if (!SSL_CTX_load_verify_store(ctx, F2N(CAstore, &ds))) {
		abort++;
	    }
	    Tcl_DStringFree(&ds);
	}

	/* Set file of CA certificates in PEM format.  */
	if (CAfile != NULL) {
	    Tcl_Obj *cafileobj = Tcl_NewStringObj(CAfile, -1);
	    Tcl_IncrRefCount(cafileobj);

	    Tcl_Obj *fsinfo = Tcl_FSFileSystemInfo(cafileobj);
	    if (fsinfo) {
		Tcl_IncrRefCount(fsinfo);

		Tcl_Obj *fstype = NULL;
		Tcl_ListObjIndex(interp, fsinfo, 0, &fstype);

		if (Tcl_StringMatch("native", Tcl_GetString(fstype))) {
		    if (!SSL_CTX_load_verify_file(ctx, F2N(CAfile, &ds))) {
			abort++;
		    }
		    Tcl_DStringFree(&ds);

		    /* Set list of CAs to send to client when requesting a client certificate */
		    STACK_OF(X509_NAME) *certNames = SSL_load_client_CA_file(F2N(CAfile, &ds));
		    if (certNames != NULL) {
			SSL_CTX_set_client_CA_list(ctx, certNames);
		    }
		    Tcl_DStringFree(&ds);

		} else {
		    /* Load certificate into memory */
		    if (!TlsLoadClientCAFileFromMemory(interp, ctx, cafileobj)) {
			abort++;
		    }
		}
		Tcl_DecrRefCount(fsinfo);

	    } else {
		abort++; /* Path is not recognized */
	    }
	    Tcl_DecrRefCount(cafileobj);
	}
#endif
    }

    return ctx;
}

static int
TlsLoadClientCAFileFromMemory(Tcl_Interp *interp, SSL_CTX *ctx, const Tcl_Obj *file) {
    BIO  *bio  = NULL;
    X509 *cert = NULL;
    X509_STORE *store = NULL;
    Tcl_Obj    *buf = NULL;
    const void *data = NULL;
    X509_NAME  *name = NULL;
    X509_NAME  *name_copy = NULL;
    STACK_OF(X509_NAME) *certNames = NULL;
    int ret = 0;
    int len = 0;

    /* Read file into memory */
    Tcl_Channel in = Tcl_FSOpenFileChannel(interp, file, "r", 0);
    if (in == NULL) {
	goto cleanup;
    }
    Tcl_SetChannelOption(interp, in, "-encoding", "binary");
    buf = Tcl_NewObj();
    Tcl_IncrRefCount(buf);

    if (Tcl_ReadChars(in, buf, -1, 0) < 0) {
	Tcl_Close(interp, in);
	goto cleanup;
    }
    Tcl_Close(interp, in);

    data = (const void *) Tcl_GetByteArrayFromObj(buf, &len);
    bio = BIO_new_mem_buf(data, len);
    if (bio == NULL) {
	goto cleanup;
    }

    /* Where the certs go */
    store = SSL_CTX_get_cert_store(ctx);
    if (store == NULL) {
	store = X509_STORE_new();
	if (store == NULL) {
	    goto cleanup;
	}
    }

    /* Where the CA names go */
    certNames = sk_X509_NAME_new_null();
    if (!certNames) {
        goto cleanup;
    }

    /* Attempt to load all certs from the PEM file */
    while ((cert = PEM_read_bio_X509(bio, NULL, 0, NULL)) != NULL) {
        if (X509_STORE_add_cert(store, cert) == 0) {
            X509_free(cert);
            ret = 0;
            goto cleanup;
        }
        /* Copy name to stack before certificate gets freed */
	name = X509_get_subject_name(cert);
        if (name) {
            X509_NAME *name_copy = X509_NAME_dup(name);
            if (!name_copy || !sk_X509_NAME_push(certNames, name_copy)) {
                X509_free(cert);
		ret = 0;
                goto cleanup;
            }
        }
        X509_free(cert);
        ret ++;
    }

    /* At least one cert was added so retain the store and CA list */
    if (ret) {
	if (SSL_CTX_get_cert_store(ctx) == NULL) {
	    SSL_CTX_set_cert_store(ctx, store);
	}
	SSL_CTX_set_client_CA_list(ctx, certNames);
    }

  cleanup:

    if (! ret) {
	/* New store is not required */
	if (store != SSL_CTX_get_cert_store(ctx)) {
	    X509_STORE_free(store);
	}
	/* Cert names will not be used */
	if (certNames) {
	    sk_X509_NAME_pop_free(certNames, X509_NAME_free);
	}
    }

    BIO_free(bio);

    if (buf)
	Tcl_DecrRefCount(buf);

    return ret;
}


/*
 *-------------------------------------------------------------------
 *
 * StatusObjCmd -- return certificate for connected peer info.
 *
 * Results:
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
2326
    ssl = statePtr->ssl;
    if (ssl != NULL) {
	const unsigned char *proto;
	unsigned int ulen;

	/* Initialization finished */
	LAPPEND_BOOL(interp, objPtr, "init_finished", SSL_is_init_finished(ssl));
	
	/* connection state */
	LAPPEND_STR(interp, objPtr, "state", SSL_state_string_long(ssl), -1);

	/* Get SNI requested server name */
	LAPPEND_STR(interp, objPtr, "servername", SSL_get_servername(ssl, TLSEXT_NAMETYPE_host_name), -1);

	/* Report the selected protocol as a result of the negotiation */







|







2440
2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
    ssl = statePtr->ssl;
    if (ssl != NULL) {
	const unsigned char *proto;
	unsigned int ulen;

	/* Initialization finished */
	LAPPEND_BOOL(interp, objPtr, "init_finished", SSL_is_init_finished(ssl));

	/* connection state */
	LAPPEND_STR(interp, objPtr, "state", SSL_state_string_long(ssl), -1);

	/* Get SNI requested server name */
	LAPPEND_STR(interp, objPtr, "servername", SSL_get_servername(ssl, TLSEXT_NAMETYPE_host_name), -1);

	/* Report the selected protocol as a result of the negotiation */
3002
3003
3004
3005
3006
3007
3008
3009
3010
3011
3012
3013
3014
3015
3016
	    | OPENSSL_INIT_ADD_ALL_CIPHERS | OPENSSL_INIT_ADD_ALL_DIGESTS
	    | OPENSSL_INIT_LOAD_CONFIG | OPENSSL_INIT_ASYNC, NULL)) {
	    return TCL_ERROR;
	}

	/* Create BIO handlers */
	BIO_new_tcl(NULL, 0);
	
	/* Create exit handler */
	Tcl_CreateExitHandler(TlsLibShutdown, NULL);
	initialized = 1;
    }
    return TCL_OK;
}








|







3130
3131
3132
3133
3134
3135
3136
3137
3138
3139
3140
3141
3142
3143
3144
	    | OPENSSL_INIT_ADD_ALL_CIPHERS | OPENSSL_INIT_ADD_ALL_DIGESTS
	    | OPENSSL_INIT_LOAD_CONFIG | OPENSSL_INIT_ASYNC, NULL)) {
	    return TCL_ERROR;
	}

	/* Create BIO handlers */
	BIO_new_tcl(NULL, 0);

	/* Create exit handler */
	Tcl_CreateExitHandler(TlsLibShutdown, NULL);
	initialized = 1;
    }
    return TCL_OK;
}


Deleted manifest.uuid.

1
git-
<