Diff
Bounty program for improvements to Tcl and certain Tcl packages.

Differences From Artifact [b7a88587d1]:

To Artifact [48a25c8f03]:


746
747
748
749
750
751
752

753
754
755
756
757
758
759
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760






+







    char *ciphers	        = NULL;
    char *CAfile	        = NULL;
    char *CAdir		        = NULL;
    char *DHparams	        = NULL;
    char *model		        = NULL;
#ifndef OPENSSL_NO_TLSEXT
    char *servername	        = NULL;	/* hostname for Server Name Indication */
    Tcl_Obj *alpn		= NULL;
#endif
    int ssl2 = 0, ssl3 = 0;
    int tls1 = 1, tls1_1 = 1, tls1_2 = 1, tls1_3 = 1;
    int proto = 0;
    int verify = 0, require = 0, request = 1;

    dprintf("Called");
808
809
810
811
812
813
814

815
816
817
818
819
820
821
822
823
824
825
826

827
828
829
830
831
832
833
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827

828
829
830
831
832
833
834
835






+











-
+







	OPTSTR( "-model", model);
	OPTOBJ( "-password", password);
	OPTBOOL( "-require", require);
	OPTBOOL( "-request", request);
	OPTBOOL( "-server", server);
#ifndef OPENSSL_NO_TLSEXT
        OPTSTR( "-servername", servername);
	OPTOBJ( "-alpn", alpn);
#endif

	OPTBOOL( "-ssl2", ssl2);
	OPTBOOL( "-ssl3", ssl3);
	OPTBOOL( "-tls1", tls1);
	OPTBOOL( "-tls1.1", tls1_1);
	OPTBOOL( "-tls1.2", tls1_2);
	OPTBOOL( "-tls1.3", tls1_3);
  OPTBYTE("-cert", cert, cert_len);
  OPTBYTE("-key", key, key_len);

	OPTBAD( "option", "-cadir, -cafile, -cert, -certfile, -cipher, -command, -dhparams, -key, -keyfile, -model, -password, -require, -request, -server, -servername, -ssl2, -ssl3, -tls1, -tls1.1, -tls1.2, or tls1.3");
	OPTBAD( "option", "-alpn, -cadir, -cafile, -cert, -certfile, -cipher, -command, -dhparams, -key, -keyfile, -model, -password, -require, -request, -server, -servername, -ssl2, -ssl3, -tls1, -tls1.1, -tls1.2, or tls1.3");

	return TCL_ERROR;
    }
    if (request)	    verify |= SSL_VERIFY_CLIENT_ONCE | SSL_VERIFY_PEER;
    if (request && require) verify |= SSL_VERIFY_FAIL_IF_NO_PEER_CERT;
    if (verify == 0)	verify = SSL_VERIFY_NONE;

956
957
958
959
960
961
962









































963
964
965
966
967
968
969
958
959
960
961
962
963
964
965
966
967
968
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






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







        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;
        }
    }
    if (alpn) {
	/* Convert a Tcl list into a protocol-list in wire-format */
	unsigned char *protos, *p;
	unsigned int protoslen = 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;
	    }
	    protoslen += 1 + len;
	}
	/* Build the complete protocol-list */
	protos = ckalloc(protoslen);
	/* 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;
	}
	/* Note: This functions reverses the return value convention */
	if (SSL_set_alpn_protos(statePtr->ssl, protos, protoslen)) {
	    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);
    }
#endif

    /*
     * SSL Callbacks
     */

    SSL_set_app_data(statePtr->ssl, (VOID *)statePtr);	/* point back to us */
1407
1408
1409
1410
1411
1412
1413




1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427

1428
1429
1430
1431
1432
1433
1434
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482






+
+
+
+














+







{
    State *statePtr;
    X509 *peer;
    Tcl_Obj *objPtr;
    Tcl_Channel chan;
    char *channelName, *ciphers;
    int mode;
#ifndef OPENSSL_NO_TLSEXT
    const unsigned char *proto;
    unsigned int len;
#endif

    dprintf("Called");

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

	case 3:
	    if (!strcmp (Tcl_GetString (objv[1]), "-local")) {
		channelName = Tcl_GetStringFromObj(objv[2], NULL);
		break;
	    }
	    /* else fall... */
	    __attribute__((fallthrough));
	default:
	    Tcl_WrongNumArgs(interp, 1, objv, "?-local? channel");
	    return TCL_ERROR;
    }

    chan = Tcl_GetChannel(interp, channelName, &mode);
    if (chan == (Tcl_Channel) NULL) {
1464
1465
1466
1467
1468
1469
1470








1471
1472
1473
1474
1475
1476
1477
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533






+
+
+
+
+
+
+
+







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

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

    Tcl_ListObjAppendElement(interp, objPtr,
	Tcl_NewStringObj("version", -1));
    Tcl_ListObjAppendElement(interp, objPtr,
	Tcl_NewStringObj(SSL_get_version(statePtr->ssl), -1));

    Tcl_SetObjResult( interp, objPtr);