Diff

Differences From Artifact [1c80245128]:

To Artifact [9f3b154f0e]:


80
81
82
83
84
85
86

87
88
89
90
91
92
93
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94







+







 *	1 = Command returned success or eval returned TCL_OK
 *
 * Side effects:
 *	Evaluates callback command
 *
 *-------------------------------------------------------------------
 */
 
static int
EvalCallback(
    Tcl_Interp *interp,		/* Tcl interpreter */
    State *statePtr,		/* Client state for TLS socket */
    Tcl_Obj *cmdPtr)		/* Command to eval as a Tcl object */
{
    int code, ok = 0;
134
135
136
137
138
139
140

141
142
143
144
145
146
147
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149







+







 *	None
 *
 * Side effects:
 *	Calls callback (if defined)
 *
 *-------------------------------------------------------------------
 */
 
static void
InfoCallback(
    const SSL *ssl,		/* SSL context */
    int where,			/* Source of info */
    int ret)			/* message enum */
{
    State *statePtr = (State*)SSL_get_app_data((SSL *)ssl);
210
211
212
213
214
215
216

217
218
219
220
221
222
223
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226







+







 *	None
 *
 * Side effects:
 *	Calls callback (if defined)
 *
 *-------------------------------------------------------------------
 */
 
#ifndef OPENSSL_NO_SSL_TRACE
static void
MessageCallback(
    int write_p,		/* Message 0=received, 1=sent */
    int version,		/* TLS version */
    int content_type,		/* Protocol content type */
    const void *buf,		/* Protocol message */
359
360
361
362
363
364
365

366
367
368
369
370
371
372
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376







+







 *
 * Side effects:
 *	The err field of the currently operative State is set
 *	  to a string describing the SSL negotiation failure reason
 *
 *-------------------------------------------------------------------
 */
 
static int
VerifyCallback(
    int ok,			/* Verify result */
    X509_STORE_CTX *ctx)	/* CTX context */
{
    Tcl_Obj *cmdPtr;
    SSL   *ssl		= (SSL*)X509_STORE_CTX_get_ex_data(ctx, SSL_get_ex_data_X509_STORE_CTX_idx());
428
429
430
431
432
433
434

435
436
437
438
439
440
441
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446







+







 *
 * Side effects:
 *	The err field of the currently operative State is set to a
 *	string describing the SSL negotiation failure reason
 *
 *-------------------------------------------------------------------
 */
 
void
Tls_Error(
    State *statePtr,		/* Client state for TLS socket */
    const char *msg)		/* Error message */
{
    Tcl_Interp *interp	= statePtr->interp;
    Tcl_Obj *cmdPtr, *listPtr;
485
486
487
488
489
490
491

492
493
494
495
496
497
498
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504







+







 *	Write received key data to log file.
 *
 * Side effects:
 *	none
 *
 *-------------------------------------------------------------------
 */
 
void KeyLogCallback(
    const SSL *ssl,		/* Client state for TLS socket */
    const char *line)		/* Key data to be logged */
{
    char *str = getenv(SSLKEYLOGFILE);
    FILE *fd;

521
522
523
524
525
526
527

528
529
530
531
532
533
534
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541







+







 *	Calls callback (if defined)
 *
 * Returns:
 *	Password size in bytes or -1 for an error.
 *
 *-------------------------------------------------------------------
 */
 
static int
PasswordCallback(
    char *buf,			/* Pointer to buffer to store password in */
    int size,			/* Buffer length in bytes */
    int rwflag,			/* Whether password is needed for read or write */
    void *udata)		/* Client state for TLS socket */
{
605
606
607
608
609
610
611

612
613
614
615
616
617
618
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626







+







 *
 * Return codes:
 *	0 = error where session will be immediately removed from the internal cache.
 *	1 = success where app retains session in session cache, and must call SSL_SESSION_free() when done.
 *
 *-------------------------------------------------------------------
 */
 
static int
SessionCallback(
    SSL *ssl,			/* SSL context */
    SSL_SESSION *session)	/* Session context */
{
    State *statePtr = (State*)SSL_get_app_data((SSL *)ssl);
    Tcl_Interp *interp	= statePtr->interp;
677
678
679
680
681
682
683

684
685
686
687
688
689
690
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699







+







 *	SSL_TLSEXT_ERR_ALERT_FATAL: There was no overlap between the client's
 *	    supplied list and the server configuration. The connection will be aborted.
 *	SSL_TLSEXT_ERR_NOACK: ALPN protocol not selected, e.g., because no ALPN
 *	    protocols are configured for this connection. The connection continues.
 *
 *-------------------------------------------------------------------
 */
 
static int
ALPNCallback(
    SSL *ssl,			/* SSL context */
    const unsigned char **out,	/* Return buffer to store selected protocol */
    unsigned char *outlen,	/* Return buffer size */
    const unsigned char *in,	/* Peer provided protocols */
    unsigned int inlen,		/* Peer buffer size */
751
752
753
754
755
756
757

758
759
760
761
762
763
764
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774







+







 *
 * Return codes:
 *	SSL_TLSEXT_ERR_OK: NPN protocol selected. The connection continues.
 *	SSL_TLSEXT_ERR_NOACK: NPN protocol not selected. The connection continues.
 *
 *-------------------------------------------------------------------
 */
 
#ifdef USE_NPN
static int
NPNCallback(
    const SSL *ssl,		/* SSL context */
    const unsigned char **out,	/* Return buffer to store selected protocol */
    unsigned int *outlen,	/* Return buffer size */
    void *arg)			/* Client state for TLS socket */
805
806
807
808
809
810
811

812
813
814
815
816
817
818
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829







+







 *	SSL_TLSEXT_ERR_ALERT_WARNING: SNI hostname is not accepted, warning alert
 *	    sent (not supported in TLSv1.3). The connection continues.
 *	SSL_TLSEXT_ERR_NOACK: SNI hostname is not accepted and not acknowledged,
 *	    e.g. if SNI has not been configured. The connection continues.
 *
 *-------------------------------------------------------------------
 */
 
static int
SNICallback(
    const SSL *ssl,		/* SSL context */
    int *alert,			/* Returned alert message */
    void *arg)			/* Client state for TLS socket */
{
    State *statePtr = (State*)arg;
881
882
883
884
885
886
887

888
889
890
891
892
893
894
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906







+







 * 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(
    SSL *ssl,			/* SSL context */
    int *alert,			/* Returned alert message */
    void *arg)			/* Client state for TLS socket */
{
    State *statePtr = (State*)arg;
981
982
983
984
985
986
987

988
989
990
991
992
993
994
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007







+







 *	A standard Tcl result list.
 *
 * Side effects:
 *	constructs and destroys SSL context (CTX)
 *
 *-------------------------------------------------------------------
 */
 
static const char *protocols[] = {
    "ssl2", "ssl3", "tls1", "tls1.1", "tls1.2", "tls1.3", NULL
};
enum protocol {
    TLS_SSL2, TLS_SSL3, TLS_TLS1, TLS_TLS1_1, TLS_TLS1_2, TLS_TLS1_3, TLS_NONE
};

1248
1249
1250
1251
1252
1253
1254
1255

1256
1257
1258
1259
1260
1261
1262
1261
1262
1263
1264
1265
1266
1267

1268
1269
1270
1271
1272
1273
1274
1275







-
+







    }
    statePtr = (State *)Tcl_GetChannelInstanceData(chan);

    dprintf("Calling Tls_WaitForConnect");
    ret = Tls_WaitForConnect(statePtr, &err, 1);
    dprintf("Tls_WaitForConnect returned: %i", ret);

    if (ret < 0 && ((statePtr->flags & TLS_TCL_ASYNC) && (err == EAGAIN))) {
    if (ret <= 0 && ((statePtr->flags & TLS_TCL_ASYNC) && (err == EAGAIN))) {
	dprintf("Async set and err = EAGAIN");
	ret = 0;
    } else if (ret < 0) {
	long result;
	errStr = statePtr->err;
	Tcl_ResetResult(interp);
	Tcl_SetErrno(err);
1829
1830
1831
1832
1833
1834
1835

1836
1837
1838
1839
1840
1841
1842
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856







+







 *	Number of certificates loaded or 0 for none.
 *
 * Side effects:
 *	Loads CA certificates
 *
 *-------------------------------------------------------------------
 */
 
static int
TlsLoadClientCAFileFromMemory(
    Tcl_Interp *interp,		/* Tcl interpreter */
    SSL_CTX *ctx,		/* CTX context */
    Tcl_Obj *file)		/* CA certificates filename */
{
    BIO  *bio  = NULL;
2377
2378
2379
2380
2381
2382
2383

2384
2385
2386
2387
2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
2403
2404
2405







+







 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------
 */
 
static int
StatusObjCmd(
    TCL_UNUSED(ClientData),	/* Client data */
    Tcl_Interp *interp,		/* Tcl interpreter */
    int objc,			/* Arg count */
    Tcl_Obj *const objv[])	/* Arguments as Tcl objects */
{
2783
2784
2785
2786
2787
2788
2789

2790
2791
2792
2793
2794
2795
2796
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812







+







 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------
 */
 
static int
VersionObjCmd(
    TCL_UNUSED(ClientData),	/* Client data */
    Tcl_Interp *interp,		/* Tcl interpreter */
    TCL_UNUSED(int),		/* objc - Arg count */
    TCL_UNUSED(Tcl_Obj *const *)) /* objv - Arguments as Tcl objects */
{
2813
2814
2815
2816
2817
2818
2819

2820
2821
2822
2823
2824
2825
2826
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843







+







 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------
 */
 
static int
MiscObjCmd(
    TCL_UNUSED(ClientData),	/* Client data */
    Tcl_Interp *interp,		/* Tcl interpreter */
    int objc,			/* Arg count */
    Tcl_Obj *const objv[])	/* Arguments as Tcl objects */
{
3037
3038
3039
3040
3041
3042
3043

3044
3045
3046
3047
3048
3049
3050
3054
3055
3056
3057
3058
3059
3060
3061
3062
3063
3064
3065
3066
3067
3068







+







 *	none
 *
 * Side effects:
 *	Frees all the state
 *
 *-------------------------------------------------------------------
 */
 
void
Tls_Free(
    tls_free_type *blockPtr)	/* Client state for TLS socket */
{
    State *statePtr = (State *)blockPtr;

    dprintf("Called");
3067
3068
3069
3070
3071
3072
3073

3074
3075
3076
3077
3078
3079
3080
3085
3086
3087
3088
3089
3090
3091
3092
3093
3094
3095
3096
3097
3098
3099







+







 *	none
 *
 * Side effects:
 *	Frees all the state
 *
 *-------------------------------------------------------------------
 */
 
void Tls_Clean(
    State *statePtr)		/* Client state for TLS socket */
{
    dprintf("Called");

    /*
     * we're assuming here that we're single-threaded
3225
3226
3227
3228
3229
3230
3231

3232
3233
3234
3235
3236
3237
3238
3244
3245
3246
3247
3248
3249
3250
3251
3252
3253
3254
3255
3256
3257
3258







+







 *	A standard TCL result
 *
 * Side effects:
 *	Shutdown SSL library
 *
 *------------------------------------------------------*
 */
 
void TlsLibShutdown(
    ClientData clientData)	/* Not used */
{
    dprintf("Called");

    BIO_cleanup();
}
3248
3249
3250
3251
3252
3253
3254

3255
3256
3257
3258
3259
3260
3261
3268
3269
3270
3271
3272
3273
3274
3275
3276
3277
3278
3279
3280
3281
3282







+







 *	A standard Tcl result
 *
 * Side effects:
 *	Initializes SSL library
 *
 *------------------------------------------------------*
 */
 
static int TlsLibInit() {
    static int initialized = 0;

    dprintf("Called");

    if (!initialized) {
	/* Initialize BOTH libcrypto and libssl. */
3355
3356
3357
3358
3359
3360
3361

3362
3363
3364
3365
3366
3367
3376
3377
3378
3379
3380
3381
3382
3383
3384
3385
3386
3387
3388
3389







+






 *	Same as of 'Tls_Init'
 *
 * Side effects:
 *	Same as of 'Tls_Init'
 *
 *-------------------------------------------------------------------
 */
 
DLLEXPORT int Tls_SafeInit(
    Tcl_Interp *interp)		/* Tcl interpreter */
{
    dprintf("Called");
    return Tls_Init(interp);
}