TclTLS
Check-in [f50ee33fd6]
Login
HomeTimelineDownloadBrowse SourceBranchesTagsTicketsWiki
Overview
Comment:Added ALPN callback protocol selection. In ALPNCallback, server select from client provided protocol list uses -alpn protocols list to find first common protocol.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | status_x509
Files: files | file ages | folders
SHA3-256: f50ee33fd61b583dbf63807972c1864090e13a5a435fea34ab68712ab29b87f9
User & Date: bohagan on 2023-06-03 22:33:16
Other Links: branch diff | manifest | tags
Context
2023-06-04
03:20
Set host name for certificate checks. Pass peer specified host name to Hello callback. Set host name for certificate checks. This is separate from SNI. Added peername to status command results. Source: https://core.tcl-lang.org/tcltls/tktview/b023257dcf and https://core.tcl-lang.org/tcltls/tktview/3c42b2ba11 check-in: 65f84287e7 user: bohagan tags: status_x509
2023-06-03
22:33
Added ALPN callback protocol selection. In ALPNCallback, server select from client provided protocol list uses -alpn protocols list to find first common protocol. check-in: f50ee33fd6 user: bohagan tags: status_x509
20:55
Added version and signature to X509 status check-in: 7d59536ee7 user: bohagan tags: status_x509
Changes
Side-by-Side Diff Ignore Whitespace Patch
Modified doc/tls.html from [0abe3d26ae] to [b59518295e].
︙
365
366
367
368
369
370
371
372

373
374
375
376
377
378
379

365
366
367
368
369
370
371

372
373
374
375
376
377
378
379








-
+









	<br>
	<br>

	<dl>

	<dt>
	  <strong>alpn</strong> <em></em>
	  <strong>alpn</strong> <em>protocol</em>
	</dt>
	<dd>
	  This form of callback is invoked when server selects the first
	  -alpn specified protocol common to the client and server. If none,
	  first client one is used.
	</dd>
︙
Modified generic/tls.c from [edf428a0fb] to [36d88366bc].
︙
526
527
528
529
530
531
532



533
534
535


536
537
538
539
540
541
542

526
527
528
529
530
531
532
533
534
535
536


537
538
539
540
541
542
543
544
545








+
+
+

-
-
+
+








    int code;

    dprintf("Called");

    if (statePtr->callback == (Tcl_Obj*)NULL)
	return SSL_TLSEXT_ERR_OK;

    /* Select protocol */
    SSL_select_next_proto(out, outlen, statePtr->protos, statePtr->protos_len, in, inlen);

    cmdPtr = Tcl_DuplicateObj(statePtr->callback);

    Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj( "alpn", -1));
    Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj("alpn", -1));
    Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(*out, -1));

    Tcl_Preserve((ClientData) interp);
    Tcl_Preserve((ClientData) statePtr);

    Tcl_IncrRefCount(cmdPtr);
    code = Tcl_EvalObjEx(interp, cmdPtr, TCL_EVAL_GLOBAL);
    if (code != TCL_OK) {
︙
1236
1237
1238
1239
1240
1241
1242

1243
1244
1245
1246

1247
1248
1249
1250
1251
1252
1253
1254
1255
1256

1257
1258
1259
1260
1261
1262
1263
1264
1265


1266
1267
1268
1269
1270
1271
1272
1273
1274







1275
1276
1277
1278
1279
1280
1281

1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280


1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294








+




+










+









+
+







-
-
+
+
+
+
+
+
+









    if (alpn) {
	/* Convert a Tcl list into a protocol-list in wire-format */
	unsigned char *protos, *p;
	unsigned int protos_len = 0;
	int i, len, cnt;
	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);
		Tls_Free((char *) statePtr);
		return TCL_ERROR;
	    }
	    protos_len += 1 + 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);
	    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);
	    Tls_Free((char *) statePtr);
	    ckfree(protos);
	    return TCL_ERROR;
	}
	/* SSL_set_alpn_protos makes a copy of the protocol-list */
	ckfree(protos);

	/* Store protocols list */
	statePtr->protos = protos;
	statePtr->protos_len = protos_len;
    } else {
	statePtr->protos = NULL;
	statePtr->protos_len = 0;
    }

    /*
     * SSL Callbacks
     */
    SSL_set_app_data(statePtr->ssl, (void *)statePtr);	/* point back to us */
    SSL_set_verify(statePtr->ssl, verify, VerifyCallback);
︙
2259
2260
2261
2262
2263
2264
2265




2266
2267
2268
2269
2270
2271
2272

2272
2273
2274
2275
2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289








+
+
+
+








     * we're assuming here that we're single-threaded
     */
    if (statePtr->timer != (Tcl_TimerToken) NULL) {
	Tcl_DeleteTimerHandler(statePtr->timer);
	statePtr->timer = NULL;
    }

    if (statePtr->protos) {
	ckfree(statePtr->protos);
	statePtr->protos = NULL;
    }
    if (statePtr->bio) {
	/* This will call SSL_shutdown. Bug 1414045 */
	dprintf("BIO_free_all(%p)", statePtr->bio);
	BIO_free_all(statePtr->bio);
	statePtr->bio = NULL;
    }
    if (statePtr->ssl) {
︙
Modified generic/tlsInt.h from [2fc41e655c] to [a2b6326281].
︙
126
127
128
129
130
131
132



133
134
135
136
137
138
139

126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142








+
+
+








	Tcl_Obj *password;      /* script called for certificate password */

	int vflags;             /* verify flags */
	SSL *ssl;               /* Struct for SSL processing */
	SSL_CTX *ctx;           /* SSL Context */
	BIO *bio;               /* Struct for SSL processing */
	BIO *p_bio;             /* Parent BIO (that is layered on Tcl_Channel) */

	char *protos;		/* List of supported protocols in protocol format */
	unsigned int protos_len; /* Length of protos */

	char *err;
} State;

#ifdef USE_TCL_STUBS
#ifndef Tcl_StackChannel
#error "Unable to compile on this version of Tcl"
︙
Powered by Fossil · RSS