| ︙ | | |
151
152
153
154
155
156
157
158
159
160
161
162
163
164
|
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
|
+
+
|
*/
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
|
| ︙ | | |
337
338
339
340
341
342
343
344
345
346
347
348
349
350
|
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
|
+
+
|
*-------------------------------------------------------------------
*/
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;
|
| ︙ | | |
404
405
406
407
408
409
410
411
412
413
414
415
416
417
|
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
|
+
+
|
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);
|
| ︙ | | |
476
477
478
479
480
481
482
483
484
485
486
487
488
489
|
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
|
+
+
|
};
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) {
|
| ︙ | | |
601
602
603
604
605
606
607
608
609
610
611
612
613
614
|
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
|
+
+
|
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) {
|
| ︙ | | |
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
|
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
|
-
-
+
+
|
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;
}
|
| ︙ | | |
722
723
724
725
726
727
728
729
730
731
732
733
734
735
|
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
|
+
+
|
#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);
|
| ︙ | | |
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
|
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
|
+
+
+
|
/*
* 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");
Tcl_SetChannelOption(interp, chan, "-blocking", "true");
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;
}
|
| ︙ | | |
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
|
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
|
-
+
+
|
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;
}
/*
*-------------------------------------------------------------------
|
| ︙ | | |
940
941
942
943
944
945
946
947
948
949
950
951
952
953
|
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
|
+
+
|
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);
|
| ︙ | | |
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
|
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
|
+
+
|
{
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 */
|
| ︙ | | |
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
|
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
|
+
+
|
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")) {
|
| ︙ | | |
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
|
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
|
+
+
|
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;
}
|
| ︙ | | |
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
|
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
|
+
+
|
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) {
|
| ︙ | | |
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
|
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
|
+
+
|
*
*-------------------------------------------------------------------
*/
void
Tls_Free( char *blockPtr )
{
State *statePtr = (State *)blockPtr;
dprintf("Called");
Tls_Clean(statePtr);
ckfree(blockPtr);
}
/*
*-------------------------------------------------------------------
|
| ︙ | | |
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
|
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
|
-
-
-
+
+
+
-
|
* none
*
* Side effects:
* Frees all the state
*
*-------------------------------------------------------------------
*/
void
Tls_Clean(State *statePtr)
{
|
| ︙ | | |
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
|
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
|
+
+
|
Tcl_DecrRefCount(statePtr->callback);
statePtr->callback = NULL;
}
if (statePtr->password) {
Tcl_DecrRefCount(statePtr->password);
statePtr->password = NULL;
}
dprintf("Returning");
}
/*
*-------------------------------------------------------------------
*
* Tls_Init --
*
|
| ︙ | | |
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
|
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
|
+
+
+
|
*
*-------------------------------------------------------------------
*/
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)
|
| ︙ | | |
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
|
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
|
+
|
* Result:
* A standard Tcl error code.
*
*------------------------------------------------------*
*/
int Tls_SafeInit(Tcl_Interp *interp) {
dprintf("Called");
return(Tls_Init(interp));
}
/*
*------------------------------------------------------*
*
* TlsLibInit --
|
| ︙ | | |
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
|
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
|
+
+
+
|
Tcl_MutexUnlock(&init_mx);
#endif
return(TCL_OK);
}
if (initialized) {
dprintf("Called, but using cached value");
return(status);
}
dprintf("Called");
#if defined(OPENSSL_THREADS) && defined(TCL_THREADS)
Tcl_MutexLock(&init_mx);
#endif
initialized = 1;
#if defined(OPENSSL_THREADS) && defined(TCL_THREADS)
|
| ︙ | | |
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
|
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
|
+
+
|
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
*/
|
| ︙ | | |