1
2
3
4
5
6
7
8
9
10
11
12
13
|
/*
* Copyright (C) 1997-1999 Matt Newman <matt@novadigm.com>
* some modifications:
* Copyright (C) 2000 Ajuba Solutions
* Copyright (C) 2002 ActiveState Corporation
* Copyright (C) 2004 Starfish Systems
*
* TLS (aka SSL) Channel - can be layered on any bi-directional
* Tcl_Channel (Note: Requires Trf Core Patch)
*
* This was built (almost) from scratch based upon observation of
* OpenSSL 0.9.2B
*
|
|
|
1
2
3
4
5
6
7
8
9
10
11
12
13
|
/*
* Copyright (C) 1997-1999 Matt Newman <matt@novadigm.com>
* some modifications:
* Copyright (C) 2000 Ajuba Solutions
* Copyright (C) 2002 ActiveState Corporation
* Copyright (C) 2004 Starfish Systems
*
* TLS (aka SSL) Channel - can be layered on any bi-directional
* Tcl_Channel (Note: Requires Trf Core Patch)
*
* This was built (almost) from scratch based upon observation of
* OpenSSL 0.9.2B
*
|
︙ | | | ︙ | |
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
|
if (where & SSL_CB_READ) minor = "read";
else if (where & SSL_CB_WRITE) minor = "write";
else if (where & SSL_CB_LOOP) minor = "loop";
else if (where & SSL_CB_EXIT) minor = "exit";
else minor = "unknown";
}
Tcl_ListObjAppendElement( statePtr->interp, cmdPtr,
Tcl_NewStringObj( "info", -1));
Tcl_ListObjAppendElement( statePtr->interp, cmdPtr,
Tcl_NewStringObj( Tcl_GetChannelName(statePtr->self), -1) );
Tcl_ListObjAppendElement( statePtr->interp, cmdPtr,
Tcl_NewStringObj( major, -1) );
Tcl_ListObjAppendElement( statePtr->interp, cmdPtr,
Tcl_NewStringObj( minor, -1) );
|
|
|
|
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
|
if (where & SSL_CB_READ) minor = "read";
else if (where & SSL_CB_WRITE) minor = "write";
else if (where & SSL_CB_LOOP) minor = "loop";
else if (where & SSL_CB_EXIT) minor = "exit";
else minor = "unknown";
}
Tcl_ListObjAppendElement( statePtr->interp, cmdPtr,
Tcl_NewStringObj( "info", -1));
Tcl_ListObjAppendElement( statePtr->interp, cmdPtr,
Tcl_NewStringObj( Tcl_GetChannelName(statePtr->self), -1) );
Tcl_ListObjAppendElement( statePtr->interp, cmdPtr,
Tcl_NewStringObj( major, -1) );
Tcl_ListObjAppendElement( statePtr->interp, cmdPtr,
Tcl_NewStringObj( minor, -1) );
|
︙ | | | ︙ | |
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
|
return ok;
} else {
return 1;
}
}
cmdPtr = Tcl_DuplicateObj(statePtr->callback);
Tcl_ListObjAppendElement( statePtr->interp, cmdPtr,
Tcl_NewStringObj( "verify", -1));
Tcl_ListObjAppendElement( statePtr->interp, cmdPtr,
Tcl_NewStringObj( Tcl_GetChannelName(statePtr->self), -1) );
Tcl_ListObjAppendElement( statePtr->interp, cmdPtr,
Tcl_NewIntObj( depth) );
Tcl_ListObjAppendElement( statePtr->interp, cmdPtr,
Tls_NewX509Obj( statePtr->interp, cert) );
|
|
|
|
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
|
return ok;
} else {
return 1;
}
}
cmdPtr = Tcl_DuplicateObj(statePtr->callback);
Tcl_ListObjAppendElement( statePtr->interp, cmdPtr,
Tcl_NewStringObj( "verify", -1));
Tcl_ListObjAppendElement( statePtr->interp, cmdPtr,
Tcl_NewStringObj( Tcl_GetChannelName(statePtr->self), -1) );
Tcl_ListObjAppendElement( statePtr->interp, cmdPtr,
Tcl_NewIntObj( depth) );
Tcl_ListObjAppendElement( statePtr->interp, cmdPtr,
Tls_NewX509Obj( statePtr->interp, cert) );
|
︙ | | | ︙ | |
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
|
Tcl_GetChannelName(statePtr->self), msg);
Tcl_SetResult( statePtr->interp, buf, TCL_VOLATILE);
Tcl_BackgroundError( statePtr->interp);
return;
}
cmdPtr = Tcl_DuplicateObj(statePtr->callback);
Tcl_ListObjAppendElement(statePtr->interp, cmdPtr,
Tcl_NewStringObj("error", -1));
Tcl_ListObjAppendElement(statePtr->interp, cmdPtr,
Tcl_NewStringObj(Tcl_GetChannelName(statePtr->self), -1));
Tcl_ListObjAppendElement(statePtr->interp, cmdPtr,
Tcl_NewStringObj(msg, -1));
Tcl_Preserve((ClientData) statePtr->interp);
Tcl_Preserve((ClientData) statePtr);
|
|
|
|
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
|
Tcl_GetChannelName(statePtr->self), msg);
Tcl_SetResult( statePtr->interp, buf, TCL_VOLATILE);
Tcl_BackgroundError( statePtr->interp);
return;
}
cmdPtr = Tcl_DuplicateObj(statePtr->callback);
Tcl_ListObjAppendElement(statePtr->interp, cmdPtr,
Tcl_NewStringObj("error", -1));
Tcl_ListObjAppendElement(statePtr->interp, cmdPtr,
Tcl_NewStringObj(Tcl_GetChannelName(statePtr->self), -1));
Tcl_ListObjAppendElement(statePtr->interp, cmdPtr,
Tcl_NewStringObj(msg, -1));
Tcl_Preserve((ClientData) statePtr->interp);
Tcl_Preserve((ClientData) statePtr);
|
︙ | | | ︙ | |
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
|
Tcl_Release((ClientData) statePtr);
Tcl_Release((ClientData) statePtr->interp);
}
/*
*-------------------------------------------------------------------
*
* PasswordCallback --
*
* 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.
*-------------------------------------------------------------------
*/
#ifdef PRE_OPENSSL_0_9_4
|
|
|
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
|
Tcl_Release((ClientData) statePtr);
Tcl_Release((ClientData) statePtr->interp);
}
/*
*-------------------------------------------------------------------
*
* PasswordCallback --
*
* 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.
*-------------------------------------------------------------------
*/
#ifdef PRE_OPENSSL_0_9_4
|
︙ | | | ︙ | |
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
|
off |= (ENABLED(proto, TLS_PROTO_TLS1_2) ? 0 : SSL_OP_NO_TLSv1_2);
#endif
#if !defined(NO_TLS1_3)
off |= (ENABLED(proto, TLS_PROTO_TLS1_3) ? 0 : SSL_OP_NO_TLSv1_3);
#endif
break;
}
ctx = SSL_CTX_new (method);
if (!ctx) {
return(NULL);
}
#if !defined(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
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); /* all SSL bug workarounds */
SSL_CTX_sess_set_cache_size( ctx, 128);
if (ciphers != NULL)
SSL_CTX_set_cipher_list(ctx, ciphers);
|
|
|
|
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
|
off |= (ENABLED(proto, TLS_PROTO_TLS1_2) ? 0 : SSL_OP_NO_TLSv1_2);
#endif
#if !defined(NO_TLS1_3)
off |= (ENABLED(proto, TLS_PROTO_TLS1_3) ? 0 : SSL_OP_NO_TLSv1_3);
#endif
break;
}
ctx = SSL_CTX_new (method);
if (!ctx) {
return(NULL);
}
#if !defined(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
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); /* all SSL bug workarounds */
SSL_CTX_sess_set_cache_size( ctx, 128);
if (ciphers != NULL)
SSL_CTX_set_cipher_list(ctx, ciphers);
|
︙ | | | ︙ | |
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
|
if (!bio) {
Tcl_DStringFree(&ds);
Tcl_AppendResult(interp,
"Could not find DH parameters file", (char *) NULL);
SSL_CTX_free(ctx);
return (SSL_CTX *)0;
}
dh = PEM_read_bio_DHparams(bio, NULL, NULL, NULL);
BIO_free(bio);
Tcl_DStringFree(&ds);
if (!dh) {
Tcl_AppendResult(interp,
"Could not read DH parameters from file", (char *) NULL);
SSL_CTX_free(ctx);
|
|
|
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
|
if (!bio) {
Tcl_DStringFree(&ds);
Tcl_AppendResult(interp,
"Could not find DH parameters file", (char *) NULL);
SSL_CTX_free(ctx);
return (SSL_CTX *)0;
}
dh = PEM_read_bio_DHparams(bio, NULL, NULL, NULL);
BIO_free(bio);
Tcl_DStringFree(&ds);
if (!dh) {
Tcl_AppendResult(interp,
"Could not read DH parameters from file", (char *) NULL);
SSL_CTX_free(ctx);
|
︙ | | | ︙ | |
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
|
#endif
}
/* https://sourceforge.net/p/tls/bugs/57/ */
/* XXX:TODO: Let the user supply values here instead of something that exists on the filesystem */
if ( CAfile != NULL ) {
STACK_OF(X509_NAME) *certNames = SSL_load_client_CA_file( F2N(CAfile, &ds) );
if ( certNames != NULL ) {
SSL_CTX_set_client_CA_list(ctx, certNames );
}
}
Tcl_DStringFree(&ds);
Tcl_DStringFree(&ds1);
return ctx;
|
|
|
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
|
#endif
}
/* https://sourceforge.net/p/tls/bugs/57/ */
/* XXX:TODO: Let the user supply values here instead of something that exists on the filesystem */
if ( CAfile != NULL ) {
STACK_OF(X509_NAME) *certNames = SSL_load_client_CA_file( F2N(CAfile, &ds) );
if ( certNames != NULL ) {
SSL_CTX_set_client_CA_list(ctx, certNames );
}
}
Tcl_DStringFree(&ds);
Tcl_DStringFree(&ds1);
return ctx;
|
︙ | | | ︙ | |
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
|
int listc,i;
BIO *out=NULL;
char *k_C="",*k_ST="",*k_L="",*k_O="",*k_OU="",*k_CN="",*k_Email="";
char *keyout,*pemout,*str;
int keysize,serial=0,days=365;
if ((objc<5) || (objc>6)) {
Tcl_WrongNumArgs(interp, 2, objv, "keysize keyfile certfile ?info?");
return TCL_ERROR;
}
if (Tcl_GetIntFromObj(interp, objv[2], &keysize) != TCL_OK) {
return TCL_ERROR;
|
|
|
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
|
int listc,i;
BIO *out=NULL;
char *k_C="",*k_ST="",*k_L="",*k_O="",*k_OU="",*k_CN="",*k_Email="";
char *keyout,*pemout,*str;
int keysize,serial=0,days=365;
if ((objc<5) || (objc>6)) {
Tcl_WrongNumArgs(interp, 2, objv, "keysize keyfile certfile ?info?");
return TCL_ERROR;
}
if (Tcl_GetIntFromObj(interp, objv[2], &keysize) != TCL_OK) {
return TCL_ERROR;
|
︙ | | | ︙ | |
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
|
}
X509_set_version(cert,2);
ASN1_INTEGER_set(X509_get_serialNumber(cert),serial);
X509_gmtime_adj(X509_get_notBefore(cert),0);
X509_gmtime_adj(X509_get_notAfter(cert),(long)60*60*24*days);
X509_set_pubkey(cert,pkey);
name=X509_get_subject_name(cert);
X509_NAME_add_entry_by_txt(name,"C", MBSTRING_ASC, (unsigned char *) k_C, -1, -1, 0);
X509_NAME_add_entry_by_txt(name,"ST", MBSTRING_ASC, (unsigned char *) k_ST, -1, -1, 0);
X509_NAME_add_entry_by_txt(name,"L", MBSTRING_ASC, (unsigned char *) k_L, -1, -1, 0);
X509_NAME_add_entry_by_txt(name,"O", MBSTRING_ASC, (unsigned char *) k_O, -1, -1, 0);
X509_NAME_add_entry_by_txt(name,"OU", MBSTRING_ASC, (unsigned char *) k_OU, -1, -1, 0);
|
|
|
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
|
}
X509_set_version(cert,2);
ASN1_INTEGER_set(X509_get_serialNumber(cert),serial);
X509_gmtime_adj(X509_get_notBefore(cert),0);
X509_gmtime_adj(X509_get_notAfter(cert),(long)60*60*24*days);
X509_set_pubkey(cert,pkey);
name=X509_get_subject_name(cert);
X509_NAME_add_entry_by_txt(name,"C", MBSTRING_ASC, (unsigned char *) k_C, -1, -1, 0);
X509_NAME_add_entry_by_txt(name,"ST", MBSTRING_ASC, (unsigned char *) k_ST, -1, -1, 0);
X509_NAME_add_entry_by_txt(name,"L", MBSTRING_ASC, (unsigned char *) k_L, -1, -1, 0);
X509_NAME_add_entry_by_txt(name,"O", MBSTRING_ASC, (unsigned char *) k_O, -1, -1, 0);
X509_NAME_add_entry_by_txt(name,"OU", MBSTRING_ASC, (unsigned char *) k_OU, -1, -1, 0);
|
︙ | | | ︙ | |
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
|
/*
*------------------------------------------------------*
*
* Tls_SafeInit --
*
* ------------------------------------------------*
* Standard procedure required by 'load'.
* Initializes this extension for a safe interpreter.
* ------------------------------------------------*
*
* Sideeffects:
* As of 'Tls_Init'
*
* Result:
|
|
|
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
|
/*
*------------------------------------------------------*
*
* Tls_SafeInit --
*
* ------------------------------------------------*
* Standard procedure required by 'load'.
* Initializes this extension for a safe interpreter.
* ------------------------------------------------*
*
* Sideeffects:
* As of 'Tls_Init'
*
* Result:
|
︙ | | | ︙ | |
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
|
* terrible entropy
*/
/*
* Seed the random number generator in the SSL library,
* using the do/while construct because of the bug note in the
* OpenSSL FAQ at http://www.openssl.org/support/faq.html#USER1
*
* The crux of the problem is that Solaris 7 does not have a
* /dev/random or /dev/urandom device so it cannot gather enough
* entropy from the RAND_seed() when TLS initializes and refuses
* to go further. Earlier versions of OpenSSL carried on regardless.
*/
srand((unsigned int) time((time_t *) NULL));
do {
for (i = 0; i < 16; i++) {
|
|
|
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
|
* terrible entropy
*/
/*
* Seed the random number generator in the SSL library,
* using the do/while construct because of the bug note in the
* OpenSSL FAQ at http://www.openssl.org/support/faq.html#USER1
*
* The crux of the problem is that Solaris 7 does not have a
* /dev/random or /dev/urandom device so it cannot gather enough
* entropy from the RAND_seed() when TLS initializes and refuses
* to go further. Earlier versions of OpenSSL carried on regardless.
*/
srand((unsigned int) time((time_t *) NULL));
do {
for (i = 0; i < 16; i++) {
|
︙ | | | ︙ | |