| ︙ | | |
161
162
163
164
165
166
167
168
169
170
171
172
173
174
|
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
|
+
+
|
*/
static void
InfoCallback(CONST SSL *ssl, int where, int ret)
{
State *statePtr = (State*)SSL_get_app_data((SSL *)ssl);
Tcl_Obj *cmdPtr;
char *major; char *minor;
dprintf("Called");
if (statePtr->callback == (Tcl_Obj*)NULL)
return;
cmdPtr = Tcl_DuplicateObj(statePtr->callback);
#if 0
|
| ︙ | | |
347
348
349
350
351
352
353
354
355
356
357
358
359
360
|
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
|
+
+
|
*-------------------------------------------------------------------
*/
void
Tls_Error(State *statePtr, char *msg)
{
Tcl_Obj *cmdPtr;
dprintf("Called");
if (msg && *msg) {
Tcl_SetErrorCode(statePtr->interp, "SSL", msg, (char *)NULL);
} else {
msg = Tcl_GetStringFromObj(Tcl_GetObjResult(statePtr->interp), NULL);
}
statePtr->err = msg;
|
| ︙ | | |
414
415
416
417
418
419
420
421
422
423
424
425
426
427
|
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
|
+
+
|
static int
PasswordCallback(char *buf, int size, int verify, void *udata)
{
State *statePtr = (State *) udata;
Tcl_Interp *interp = statePtr->interp;
Tcl_Obj *cmdPtr;
int result;
dprintf("Called");
if (statePtr->password == NULL) {
if (Tcl_EvalEx(interp, "tls::password", -1, TCL_EVAL_GLOBAL)
== TCL_OK) {
char *ret = (char *) Tcl_GetStringResult(interp);
strncpy(buf, ret, (size_t) size);
return (int)strlen(ret);
|
| ︙ | | |
486
487
488
489
490
491
492
493
494
495
496
497
498
499
|
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
|
+
+
|
};
Tcl_Obj *objPtr;
SSL_CTX *ctx = NULL;
SSL *ssl = NULL;
STACK_OF(SSL_CIPHER) *sk;
char *cp, buf[BUFSIZ];
int index, verbose = 0;
dprintf("Called");
if (objc < 2 || objc > 3) {
Tcl_WrongNumArgs(interp, 1, objv, "protocol ?verbose?");
return TCL_ERROR;
}
if (Tcl_GetIndexFromObj( interp, objv[1], protocols, "protocol", 0,
&index) != TCL_OK) {
|
| ︙ | | |
611
612
613
614
615
616
617
618
619
620
621
622
623
624
|
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
|
+
+
|
int objc;
Tcl_Obj *CONST objv[];
{
Tcl_Channel chan; /* The channel to set a mode on. */
State *statePtr; /* client state for ssl socket */
int ret = 1;
dprintf("Called");
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "channel");
return TCL_ERROR;
}
chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], NULL), NULL);
if (chan == (Tcl_Channel) NULL) {
|
| ︙ | | |
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
|
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
|
-
-
+
+
|
Tcl_ResetResult(interp);
Tcl_SetErrno(err);
if (!errStr || *errStr == 0) {
errStr = Tcl_PosixError(interp);
}
Tcl_AppendResult(interp, "handshake failed: ", errStr,
(char *) NULL);
Tcl_AppendResult(interp, "handshake failed: ", errStr, (char *) NULL);
dprintf("Returning TCL_ERROR with handshake failed: %s", errStr);
return TCL_ERROR;
}
}
Tcl_SetObjResult(interp, Tcl_NewIntObj(ret));
return TCL_OK;
}
|
| ︙ | | |
732
733
734
735
736
737
738
739
740
741
742
743
744
745
|
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
|
+
+
|
#if defined(NO_TLS1_2)
int tls1_2 = 0;
#else
int tls1_2 = 1;
#endif
int proto = 0;
int verify = 0, require = 0, request = 1;
dprintf("Called");
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "channel ?options?");
return TCL_ERROR;
}
chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], NULL), NULL);
|
| ︙ | | |
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
|
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
|
+
+
|
/*
* We need to make sure that the channel works in binary (for the
* encryption not to get goofed up).
* We only want to adjust the buffering in pre-v2 channels, where
* each channel in the stack maintained its own buffers.
*/
Tcl_SetChannelOption(interp, chan, "-translation", "binary");
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) {
/*
* No use of Tcl_EventuallyFree because no possible Tcl_Preserve.
*/
Tls_Free((char *) statePtr);
return TCL_ERROR;
}
|
| ︙ | | |
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
|
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
|
-
+
+
|
SSL_set_app_data(statePtr->ssl, (VOID *)statePtr); /* point back to us */
SSL_set_verify(statePtr->ssl, verify, VerifyCallback);
SSL_CTX_set_info_callback(statePtr->ctx, InfoCallback);
/* Create Tcl_Channel BIO Handler */
statePtr->p_bio = BIO_new_tcl(statePtr, BIO_CLOSE);
statePtr->p_bio = BIO_new_tcl(statePtr, BIO_NOCLOSE);
statePtr->bio = BIO_new(BIO_f_ssl());
if (server) {
statePtr->flags |= TLS_TCL_SERVER;
SSL_set_accept_state(statePtr->ssl);
} else {
SSL_set_connect_state(statePtr->ssl);
}
SSL_set_bio(statePtr->ssl, statePtr->p_bio, statePtr->p_bio);
BIO_set_ssl(statePtr->bio, statePtr->ssl, BIO_NOCLOSE);
/*
* End of SSL Init
*/
dprintf("Returning %s", Tcl_GetChannelName(statePtr->self));
Tcl_SetResult(interp, (char *) Tcl_GetChannelName(statePtr->self),
TCL_VOLATILE);
return TCL_OK;
}
/*
*-------------------------------------------------------------------
|
| ︙ | | |
950
951
952
953
954
955
956
957
958
959
960
961
962
963
|
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
|
+
+
|
UnimportObjCmd(clientData, interp, objc, objv)
ClientData clientData; /* Not used. */
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];
{
Tcl_Channel chan; /* The channel to set a mode on. */
dprintf("Called");
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "channel");
return TCL_ERROR;
}
chan = Tcl_GetChannel(interp, Tcl_GetString(objv[1]), NULL);
|
| ︙ | | |
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
|
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
|
+
+
|
{
Tcl_Interp *interp = statePtr->interp;
SSL_CTX *ctx = NULL;
Tcl_DString ds;
Tcl_DString ds1;
int off = 0;
const SSL_METHOD *method;
dprintf("Called");
if (!proto) {
Tcl_AppendResult(interp, "no valid protocol selected", NULL);
return (SSL_CTX *)0;
}
/* create SSL context */
|
| ︙ | | |
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
|
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
|
+
+
|
State *statePtr;
X509 *peer;
Tcl_Obj *objPtr;
Tcl_Channel chan;
char *channelName, *ciphers;
int mode;
dprintf("Called");
switch (objc) {
case 2:
channelName = Tcl_GetStringFromObj(objv[1], NULL);
break;
case 3:
if (!strcmp (Tcl_GetString (objv[1]), "-local")) {
|
| ︙ | | |
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
|
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
|
+
+
|
VersionObjCmd(clientData, interp, objc, objv)
ClientData clientData; /* Not used. */
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];
{
Tcl_Obj *objPtr;
dprintf("Called");
objPtr = Tcl_NewStringObj(OPENSSL_VERSION_TEXT, -1);
Tcl_SetObjResult(interp, objPtr);
return TCL_OK;
}
|
| ︙ | | |
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
|
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
|
+
+
|
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];
{
static CONST84 char *commands [] = { "req", NULL };
enum command { C_REQ, C_DUMMY };
int cmd;
dprintf("Called");
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?args?");
return TCL_ERROR;
}
if (Tcl_GetIndexFromObj(interp, objv[1], commands,
"command", 0,&cmd) != TCL_OK) {
|
| ︙ | | |
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
|
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
|
+
+
|
*
*-------------------------------------------------------------------
*/
void
Tls_Free( char *blockPtr )
{
State *statePtr = (State *)blockPtr;
dprintf("Called");
Tls_Clean(statePtr);
ckfree(blockPtr);
}
/*
*-------------------------------------------------------------------
|
| ︙ | | |
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
|
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
|
-
-
-
+
+
+
-
|
* none
*
* Side effects:
* Frees all the state
*
*-------------------------------------------------------------------
*/
void
Tls_Clean(State *statePtr)
{
|
| ︙ | | |
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
|
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
|
+
+
|
Tcl_DecrRefCount(statePtr->callback);
statePtr->callback = NULL;
}
if (statePtr->password) {
Tcl_DecrRefCount(statePtr->password);
statePtr->password = NULL;
}
dprintf("Returning");
}
/*
*-------------------------------------------------------------------
*
* Tls_Init --
*
|
| ︙ | | |
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
|
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
|
+
+
+
|
*
*-------------------------------------------------------------------
*/
int Tls_Init(Tcl_Interp *interp) {
const char tlsTclInitScript[] = {
#include "tls.tcl.h"
, 0x00
};
dprintf("Called");
/*
* We only support Tcl 8.4 or newer
*/
if (
#ifdef USE_TCL_STUBS
Tcl_InitStubs(interp, "8.4", 0)
|
| ︙ | | |
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
|
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
|
+
|
* Result:
* A standard Tcl error code.
*
*------------------------------------------------------*
*/
int Tls_SafeInit(Tcl_Interp *interp) {
dprintf("Called");
return(Tls_Init(interp));
}
/*
*------------------------------------------------------*
*
* TlsLibInit --
|
| ︙ | | |
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
|
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
|
+
+
+
|
*------------------------------------------------------*
*/
static int TlsLibInit(void) {
static int initialized = 0;
int status = TCL_OK;
if (initialized) {
dprintf("Called, but using cached value");
return(status);
}
dprintf("Called");
initialized = 1;
#if defined(OPENSSL_THREADS) && defined(TCL_THREADS)
size_t num_locks;
Tcl_MutexLock(&init_mx);
|
| ︙ | | |
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
|
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
|
+
+
|
if (SSL_library_init() != 1) {
status = TCL_ERROR;
goto done;
}
SSL_load_error_strings();
ERR_load_crypto_strings();
BIO_new_tcl(NULL, 0);
#if 0
/*
* XXX:TODO: Remove this code and replace it with a check
* for enough entropy and do not try to create our own
* terrible entropy
*/
|
| ︙ | | |