Diff

Differences From Artifact [36d88366bc]:

To Artifact [62ec7882d5]:


232
233
234
235
236
237
238
239

240
241
242
243
244
245
246
232
233
234
235
236
237
238

239
240
241
242
243
244
245
246







-
+







	    return 1;
	}
    }
    cmdPtr = Tcl_DuplicateObj(statePtr->callback);

    Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj("verify", -1));
    Tcl_ListObjAppendElement(interp, cmdPtr,
	    Tcl_NewStringObj(Tcl_GetChannelName(statePtr->self), -1));
	Tcl_NewStringObj(Tcl_GetChannelName(statePtr->self), -1));
    Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewIntObj(depth));
    Tcl_ListObjAppendElement(interp, cmdPtr, Tls_NewX509Obj(interp, cert));
    Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewIntObj(ok));
    Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(errStr ? errStr : "", -1));

    Tcl_Preserve((ClientData) interp);
    Tcl_Preserve((ClientData) statePtr);
366
367
368
369
370
371
372
373

374
375
376
377
378
379
380
366
367
368
369
370
371
372

373
374
375
376
377
378
379
380







-
+







	fclose(fd);
    }
}

/*
 *-------------------------------------------------------------------
 *
 * PasswordCallback --
 * Password Callback --
 *
 *	Called when a password is needed to unpack RSA and PEM keys.
 *	Evals any bound password script and returns the result as
 *	the password string.
 *-------------------------------------------------------------------
 */
static int
426
427
428
429
430
431
432
433

434
435
436
437
438
439
440
426
427
428
429
430
431
432

433
434
435
436
437
438
439
440







-
+







    return -1;
	verify = verify;
}

/*
 *-------------------------------------------------------------------
 *
 * SessionCallback for Clients --
 * Session Callback for Clients --
 *
 *	Called when a new session ticket has been received. In TLS 1.3
 *	this may be received multiple times after the handshake. For
 *	earlier versions, this will be received during the handshake.
 *
 * Results:
 *	None
456
457
458
459
460
461
462
463
464

465
466
467
468
469
470
471
456
457
458
459
460
461
462


463
464
465
466
467
468
469
470







-
-
+








    dprintf("Called");

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

    cmdPtr = Tcl_DuplicateObj(statePtr->callback);

    Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj( "session", -1));
    Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj("session", -1));

    /* Session id */
    session_id = SSL_SESSION_get0_id_context(session, &len);
    Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(session_id, len));

    /* Session ticket */
    SSL_SESSION_get0_ticket(session, &ticket, &len2);
598
599
600
601
602
603
604
605
606

607
608
609
610
611
612
613
597
598
599
600
601
602
603


604
605
606
607
608
609
610
611







-
-
+








    servername = SSL_get_servername(ssl, TLSEXT_NAMETYPE_host_name);
    if (!servername || servername[0] == '\0') {
        return SSL_TLSEXT_ERR_NOACK;
    }

    cmdPtr = Tcl_DuplicateObj(statePtr->callback);

    Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj( "sni", -1));
    Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj("sni", -1));
    Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(servername , -1));

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

    Tcl_IncrRefCount(cmdPtr);
    code = Tcl_EvalObjEx(interp, cmdPtr, TCL_EVAL_GLOBAL);
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
675
676
677
678
679
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
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706







-
+




















+
+
+






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







 * Hello Callback for Servers --
 *
 *	Used by server to examine the server name indication (SNI) extension
 *	provided by the client in order to select an appropriate certificate to
 *	present, and make other configuration adjustments relevant to that server
 *	name and its configuration. This includes swapping out the associated
 *	SSL_CTX pointer, modifying the server's list of permitted TLS versions,
 *	changing the server's cipher list in response to the client's cipher list, etc.
*	changing the server's cipher list in response to the client's cipher list, etc.
 *
 * Results:
 *	None
 *
 * Side effects:
 *	Calls callback (if defined)
 *
 * Return codes:
 *	SSL_CLIENT_HELLO_RETRY = suspend the handshake, and the handshake function will return immediately
 *	SSL_CLIENT_HELLO_ERROR = failure, terminate connection. Set alert to error code.
 *	SSL_CLIENT_HELLO_SUCCESS = success
 *
 *-------------------------------------------------------------------
 */
static int
HelloCallback(const SSL *ssl, int *alert, void *arg) {
    State *statePtr = (State*)arg;
    Tcl_Interp *interp	= statePtr->interp;
    Tcl_Obj *cmdPtr;
    int code;
    const char *servername;
    const unsigned char *p;
    size_t len, remaining;

    dprintf("Called");

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

    cmdPtr = Tcl_DuplicateObj(statePtr->callback);

    Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj( "hello", -1));

    /* SSL_client_hello_get0_random(), SSL_client_hello_get0_session_id(), SSL_client_hello_get0_ciphers(), and SSL_client_hello_get0_compression_methods() provide access to the corresponding ClientHello fields, returning the field length and optionally setting an out pointer to the octets of that field. */

    /* Similarly, SSL_client_hello_get0_ext() provides access to individual extensions from the ClientHello on a per-extension basis. For the provided wire protocol extension type value, the extension value and length are returned in the output parameters (if present). */

    /* Get names */
    if (!SSL_client_hello_get0_ext(ssl, TLSEXT_TYPE_server_name, &p, &remaining) || remaining <= 2) {
        return SSL_CLIENT_HELLO_ERROR;
    }

    /* Extract the length of the supplied list of names. */
    len = (*(p++) << 8);
    len += *(p++);
    if (len + 2 != remaining) {
        return SSL_CLIENT_HELLO_ERROR;
    }
    remaining = len;

    /* The list in practice only has a single element, so we only consider the first one. */
    if (remaining == 0 || *p++ != TLSEXT_NAMETYPE_host_name) {
        return SSL_CLIENT_HELLO_ERROR;
    }
    remaining--;

    /* Now we can finally pull out the byte array with the actual hostname. */
    if (remaining <= 2) {
        return SSL_CLIENT_HELLO_ERROR;
    }
    len = (*(p++) << 8);
    len += *(p++);
    if (len + 2 > remaining) {
        return SSL_CLIENT_HELLO_ERROR;
    }
    remaining = len;
    servername = (const char *)p;

    cmdPtr = Tcl_DuplicateObj(statePtr->callback);
    Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj("hello", -1));
    Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(servername, (int)len));

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

    Tcl_IncrRefCount(cmdPtr);
    code = Tcl_EvalObjEx(interp, cmdPtr, TCL_EVAL_GLOBAL);
    if (code != TCL_OK) {
1216
1217
1218
1219
1220
1221
1222

1223
1224
1225
1226
1227








1228
1229
1230
1231
1232
1233
1234
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







+





+
+
+
+
+
+
+
+







	Tcl_AppendResult(interp, "couldn't construct ssl session: ", REASON(), (char *) NULL);
	Tls_Free((char *) statePtr);
	return TCL_ERROR;
    }

    /* Set host server name */
    if (servername) {
	/* Sets the server name indication (SNI) ClientHello extension */
	if (!SSL_set_tlsext_host_name(statePtr->ssl, servername) && require) {
	    Tcl_AppendResult(interp, "setting TLS host name extension failed", (char *) NULL);
            Tls_Free((char *) statePtr);
            return TCL_ERROR;
        }

	/* Configure server host name checks in the SSL client. Set DNS hostname to
	   name for peer certificate checks. SSL_set1_host has limitations. */
	if (!SSL_add1_host(statePtr->ssl, servername)) {
	    Tcl_AppendResult(interp, "setting DNS host name failed", (char *) NULL);
            Tls_Free((char *) statePtr);
            return TCL_ERROR;
	}
    }

    /* Resume session id */
    if (session_id && strlen(session_id) <= SSL_MAX_SID_CTX_LENGTH) {
	/* SSL_set_session() */
	if (!SSL_SESSION_set1_id_context(SSL_get_session(statePtr->ssl), session_id, (unsigned int) strlen(session_id))) {
	    Tcl_AppendResult(interp, "Resume session id ", session_id, " failed", (char *) NULL);
1515
1516
1517
1518
1519
1520
1521

1522
1523
1524
1525
1526
1527
1528
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565







+







#if !defined(NO_TLS1_3) && !defined(OPENSSL_NO_TLS1_3)
    if (proto == TLS_PROTO_TLS1_3) {
	SSL_CTX_set_min_proto_version(ctx, TLS1_3_VERSION);
	SSL_CTX_set_max_proto_version(ctx, TLS1_3_VERSION);
    }
#endif

    /* Force cipher selection order by server */
    if (!isServer) {
	SSL_CTX_set_options(ctx, SSL_OP_CIPHER_SERVER_PREFERENCE);
    }

    SSL_CTX_set_app_data(ctx, (void*)interp);	/* remember the interpreter */
    SSL_CTX_set_options(ctx, SSL_OP_ALL);	/* all SSL bug workarounds */
    SSL_CTX_set_options(ctx, off);		/* disable protocol versions */
1714
1715
1716
1717
1718
1719
1720

1721
1722
1723
1724
1725
1726
1727
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765







+







    X509 *peer;
    Tcl_Obj *objPtr;
    Tcl_Channel chan;
    char *channelName, *ciphers;
    int mode;
    const unsigned char *proto;
    unsigned int len;
    char *peername = NULL;

    dprintf("Called");

    switch (objc) {
	case 2:
	    channelName = Tcl_GetStringFromObj(objv[1], NULL);
	    break;
1760
1761
1762
1763
1764
1765
1766













1767
1768
1769
1770
1771
1772
1773
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824







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







    if (peer) {
	objPtr = Tls_NewX509Obj(interp, peer);
	if (objc == 2) { X509_free(peer); }
    } else {
	objPtr = Tcl_NewListObj(0, NULL);
    }

    /* Peer cert chain (client only) */
    STACK_OF(X509)* ssl_certs = SSL_get_peer_cert_chain(statePtr->ssl);
    if (!peer && (ssl_certs == NULL || sk_X509_num(ssl_certs) == 0)) {
	return TCL_ERROR;
    }

    /* Peer name from cert */
    if (SSL_get_verify_result(statePtr->ssl) == X509_V_OK) {
	peername = SSL_get0_peername(statePtr->ssl);
    }
    Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("peername", -1));
    Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(peername, -1));

    Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("sbits", -1));
    Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewIntObj(SSL_get_cipher_bits(statePtr->ssl, NULL)));

    ciphers = (char*)SSL_get_cipher(statePtr->ssl);
    if ((ciphers != NULL) && (strcmp(ciphers, "(NONE)") != 0)) {
	Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("cipher", -1));
	Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(SSL_get_cipher(statePtr->ssl), -1));
1860
1861
1862
1863
1864
1865
1866
1867

1868
1869
1870
1871
1872
1873
1874
1911
1912
1913
1914
1915
1916
1917

1918
1919
1920
1921
1922
1923
1924
1925







-
+







	/* Get protocol */
	Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("protocol", -1));
	Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(SSL_get_version(ssl), -1));

	/* Renegotiation allowed */
	Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("renegotiation", -1));
	Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(
	    SSL_get_secure_renegotiation_support(ssl) ? "allowed" : "not supported", -1));
	    SSL_get_secure_renegotiation_support(ssl) ? "supported" : "not supported", -1));

	/* Report the selected protocol as a result of the ALPN negotiation */
	SSL_get0_alpn_selected(ssl, &proto, &len);
	Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("alpn", -1));
	Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj((char *)proto, (int)len));

	/* Get security level */
1912
1913
1914
1915
1916
1917
1918
1919

1920
1921
1922

1923
1924
1925
1926
1927
1928
1929
1963
1964
1965
1966
1967
1968
1969

1970
1971
1972

1973
1974
1975
1976
1977
1978
1979
1980







-
+


-
+








	/* Session info */
	Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("session_reused", -1));
	Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewIntObj(SSL_session_reused(ssl)));

	/* Session id */
	Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("session_id", -1));
	session_id = SSL_SESSION_get0_id_context(session, &len);
	session_id = SSL_SESSION_get_id(session, &len);
	Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(session_id, (int)len));

	/* Session ticket */
	/* Session ticket - client only */
	SSL_SESSION_get0_ticket(session, &ticket, &len2);
	Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("session_ticket", -1));
	Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(ticket, (int) len2));

	/* Resumable session */
	Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("resumable", -1));
	Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewIntObj(SSL_SESSION_is_resumable(session)));