Changes On Branch e02b79f82fa7adb6

Changes In Branch TEA Through [e02b79f82f] Excluding Merge-Ins

This is equivalent to a diff from c9cb1a525d to e02b79f82f

2023-05-13
20:25
Merged TEA branch into master check-in: 6c02d4d029 user: bohagan tags: trunk
2023-04-30
16:07
Moved files to subdirectories per TEA directory structure. check-in: 3dcd70f98e user: bohagan tags: TEA
02:08
Format clean-ups. check-in: e02b79f82f user: bohagan tags: TEA
2023-04-23
22:31
Updated Window Make Files to add OPENSSL lib directory to includes. Added missing files nmakehlp.c, rules.vc, rules-ext.vc, etc. Source: https://core.tcl-lang.org/tcltls/tktview/316976aff3 check-in: 7c266d8a5b user: bohagan tags: TEA
21:01
Created TEA updates branch check-in: b8dafda9a9 user: bohagan tags: TEA
04:49
Starkit fix to add current library names to tls.tcl starkit load function. Source: https://sourceforge.net/p/tls/bugs/55/ and https://sourceforge.net/p/tls/bugs/44/ check-in: c9cb1a525d user: bohagan tags: trunk
03:34
Use server cipher preference order. Source: https://sourceforge.net/p/tls/bugs/60/ and https://www.androwish.org/home/info/5718c3eb47cced4d and https://core.tcl-lang.org/tcltls/tktview/305ee10b86 check-in: ba1403b62c user: bohagan tags: trunk

Modified tclOpts.h from [b51276a00c] to [26b0fd21c2].
1
2
3
4
5
6

7
8
9
10
11
12
13
1
2
3
4
5
6
7
8
9
10
11
12
13
14






+







/*
 *  Copyright (C) 1997-2000 Matt Newman <matt@novadigm.com>
 *
 * Stylized option processing - requires consistent
 * external vars: opt, idx, objc, objv
 */

#ifndef _TCL_OPTS_H
#define _TCL_OPTS_H

#define OPT_PROLOG(option)			\
    if (strcmp(opt, (option)) == 0) {		\
	if (++idx >= objc) {			\
	    Tcl_AppendResult(interp,		\
1
2
3
4
5
6
7
8
9

10
11
12
13
14
15
16
1
2
3
4
5
6
7
8

9
10
11
12
13
14
15
16








-
+







# all.tcl --
#
# This file contains a top-level script to run all of the Tcl
# tests.  Execute it by invoking "source all.test" when running tcltest
# in this directory.
#
# Copyright (c) 1998-2000 by Ajuba Solutions.
# All rights reserved.
# 
#
# RCS: @(#) $Id: all.tcl,v 1.5 2000/08/15 18:45:01 hobbs Exp $

#set auto_path [linsert $auto_path 0 [file normalize [file join [file dirname [info script]] ..]]]
set auto_path [linsert $auto_path 0 [file normalize [pwd]]]

if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
Modified tls.c from [9adcbda92a] to [4c6200b506].
1
2
3
4
5
6

7
8
9
10
11
12
13
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 
 *	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
 *
31
32
33
34
35
36
37
38

39
40
41
42
43
44
45
46



47
48
49
50
51
52
53
31
32
33
34
35
36
37

38
39
40
41
42
43



44
45
46
47
48
49
50
51
52
53







-
+





-
-
-
+
+
+







 * External functions
 */

/*
 * Forward declarations
 */

#define F2N( key, dsp) \
#define F2N(key, dsp) \
	(((key) == NULL) ? (char *) NULL : \
		Tcl_TranslateFileName(interp, (key), (dsp)))
#define REASON()	ERR_reason_error_string(ERR_get_error())

static SSL_CTX *CTX_Init(State *statePtr, int isServer, int proto, char *key,
			char *certfile, unsigned char *key_asn1, unsigned char *cert_asn1,
			int key_asn1_len, int cert_asn1_len, char *CAdir, char *CAfile,
      char *ciphers, char *DHparams);
		char *certfile, unsigned char *key_asn1, unsigned char *cert_asn1,
		int key_asn1_len, int cert_asn1_len, char *CAdir, char *CAfile,
		char *ciphers, char *DHparams);

static int	TlsLibInit(int uninitialize);

#define TLS_PROTO_SSL2		0x01
#define TLS_PROTO_SSL3		0x02
#define TLS_PROTO_TLS1		0x04
#define TLS_PROTO_TLS1_1	0x08
77
78
79
80
81
82
83
84

85
86
87
88
89
90
91
77
78
79
80
81
82
83

84
85
86
87
88
89
90
91







-
+







/*
 * Pre OpenSSL 0.9.4 Compat
 */

#ifndef STACK_OF
#define STACK_OF(x)			STACK
#define sk_SSL_CIPHER_num(sk)		sk_num((sk))
#define sk_SSL_CIPHER_value( sk, index)	(SSL_CIPHER*)sk_value((sk), (index))
#define sk_SSL_CIPHER_value(sk, index)	(SSL_CIPHER*)sk_value((sk), (index))
#endif

/*
 * Thread-Safe TLS Code
 */

#ifdef TCL_THREADS
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120








121
122

123
124
125
126



127
128
129
130

131
132

133
134

135
136

137
138

139

140
141
142
143
144
145
146
106
107
108
109
110
111
112








113
114
115
116
117
118
119
120
121

122
123



124
125
126
127
128
129

130
131

132
133

134
135

136
137

138
139
140
141
142
143
144
145
146
147







-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+

-
+

-
-
-
+
+
+



-
+

-
+

-
+

-
+

-
+

+







static int locksCount = 0;
static Tcl_Mutex init_mx;

# if OPENSSL_VERSION_NUMBER < 0x10100000L

void CryptoThreadLockCallback(int mode, int n, const char *file, int line) {

	if (mode & CRYPTO_LOCK) {
		/* This debugging is turned off by default -- it's too noisy. */
		/* dprintf("Called to lock (n=%i of %i)", n, locksCount); */
		Tcl_MutexLock(&locks[n]);
	} else {
		/* dprintf("Called to unlock (n=%i of %i)", n, locksCount); */
		Tcl_MutexUnlock(&locks[n]);
	}
    if (mode & CRYPTO_LOCK) {
	/* This debugging is turned off by default -- it's too noisy. */
	/* dprintf("Called to lock (n=%i of %i)", n, locksCount); */
	Tcl_MutexLock(&locks[n]);
    } else {
	/* dprintf("Called to unlock (n=%i of %i)", n, locksCount); */
	Tcl_MutexUnlock(&locks[n]);
    }

	/* dprintf("Returning"); */
    /* dprintf("Returning"); */

	return;
	file = file;
	line = line;
    return;
    file = file;
    line = line;
}

unsigned long CryptoThreadIdCallback(void) {
	unsigned long ret;
    unsigned long ret;

	dprintf("Called");
    dprintf("Called");

	ret = (unsigned long) Tcl_GetCurrentThread();
    ret = (unsigned long) Tcl_GetCurrentThread();

	dprintf("Returning %lu", ret);
    dprintf("Returning %lu", ret);

	return(ret);
    return(ret);
}

#endif
#endif /* OPENSSL_THREADS */
#endif /* TCL_THREADS */


/*
 *-------------------------------------------------------------------
168
169
170
171
172
173
174
175

176
177
178
179
180
181
182
169
170
171
172
173
174
175

176
177
178
179
180
181
182
183







-
+







	return;

    cmdPtr = Tcl_DuplicateObj(statePtr->callback);

#if 0
    if (where & SSL_CB_ALERT) {
	sev = SSL_alert_type_string_long(ret);
	if (strcmp( sev, "fatal")==0) {	/* Map to error */
	if (strcmp(sev, "fatal")==0) {	/* Map to error */
	    Tls_Error(statePtr, SSL_ERROR(ssl, 0));
	    return;
	}
    }
#endif
    if (where & SSL_CB_HANDSHAKE_START) {
	major = "handshake";
193
194
195
196
197
198
199
200

201
202
203
204


205
206

207
208
209

210
211
212
213
214


215
216
217
218

219
220
221
222


223
224
225


226
227

228
229

230
231
232


233
234
235
236
237
238
239
240
194
195
196
197
198
199
200

201




202
203


204



205

206
207


208
209
210
211
212

213

214


215
216
217


218
219
220

221
222

223
224


225
226

227
228
229
230
231
232
233







-
+
-
-
-
-
+
+
-
-
+
-
-
-
+
-


-
-
+
+



-
+
-

-
-
+
+

-
-
+
+

-
+

-
+

-
-
+
+
-







	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_ListObjAppendElement(statePtr->interp, cmdPtr, Tcl_NewStringObj("info", -1));
	    Tcl_NewStringObj( "info", -1));

    Tcl_ListObjAppendElement( statePtr->interp, cmdPtr, 
	    Tcl_NewStringObj( Tcl_GetChannelName(statePtr->self), -1) );
    Tcl_ListObjAppendElement(statePtr->interp, cmdPtr,
	    Tcl_NewStringObj(Tcl_GetChannelName(statePtr->self), -1));

    Tcl_ListObjAppendElement( statePtr->interp, cmdPtr,
    Tcl_ListObjAppendElement(statePtr->interp, cmdPtr, Tcl_NewStringObj(major, -1));
	    Tcl_NewStringObj( major, -1) );

    Tcl_ListObjAppendElement( statePtr->interp, cmdPtr,
    Tcl_ListObjAppendElement(statePtr->interp, cmdPtr, Tcl_NewStringObj(minor, -1));
	    Tcl_NewStringObj( minor, -1) );

    if (where & (SSL_CB_LOOP|SSL_CB_EXIT)) {
	Tcl_ListObjAppendElement( statePtr->interp, cmdPtr,
	    Tcl_NewStringObj( SSL_state_string_long(ssl), -1) );
	Tcl_ListObjAppendElement(statePtr->interp, cmdPtr,
	    Tcl_NewStringObj(SSL_state_string_long(ssl), -1));
    } else if (where & SSL_CB_ALERT) {
	const char *cp = (char *) SSL_alert_desc_string_long(ret);

	Tcl_ListObjAppendElement( statePtr->interp, cmdPtr,
	Tcl_ListObjAppendElement(statePtr->interp, cmdPtr, Tcl_NewStringObj(cp, -1));
	    Tcl_NewStringObj( cp, -1) );
    } else {
	Tcl_ListObjAppendElement( statePtr->interp, cmdPtr,
	    Tcl_NewStringObj( SSL_state_string_long(ssl), -1) );
	Tcl_ListObjAppendElement(statePtr->interp, cmdPtr,
	    Tcl_NewStringObj(SSL_state_string_long(ssl), -1));
    }
    Tcl_Preserve( (ClientData) statePtr->interp);
    Tcl_Preserve( (ClientData) statePtr);
    Tcl_Preserve((ClientData) statePtr->interp);
    Tcl_Preserve((ClientData) statePtr);

    Tcl_IncrRefCount( cmdPtr);
    Tcl_IncrRefCount(cmdPtr);
    (void) Tcl_EvalObjEx(statePtr->interp, cmdPtr, TCL_EVAL_GLOBAL);
    Tcl_DecrRefCount( cmdPtr);
    Tcl_DecrRefCount(cmdPtr);

    Tcl_Release( (ClientData) statePtr);
    Tcl_Release( (ClientData) statePtr->interp);
    Tcl_Release((ClientData) statePtr);
    Tcl_Release((ClientData) statePtr->interp);

}

/*
 *-------------------------------------------------------------------
 *
 * VerifyCallback --
 *
278
279
280
281
282
283
284
285

286
287
288
289


290
291

292
293
294

295
296
297

298
299
300

301
302
303
304


305
306
307
308

309
310
311
312
313
314
315
271
272
273
274
275
276
277

278




279
280


281



282



283



284

285


286
287
288
289
290

291
292
293
294
295
296
297
298







-
+
-
-
-
-
+
+
-
-
+
-
-
-
+
-
-
-
+
-
-
-
+
-

-
-
+
+



-
+







	    return ok;
	} else {
	    return 1;
	}
    }
    cmdPtr = Tcl_DuplicateObj(statePtr->callback);

    Tcl_ListObjAppendElement( statePtr->interp, cmdPtr, 
    Tcl_ListObjAppendElement(statePtr->interp, cmdPtr, Tcl_NewStringObj("verify", -1));
	    Tcl_NewStringObj( "verify", -1));

    Tcl_ListObjAppendElement( statePtr->interp, cmdPtr, 
	    Tcl_NewStringObj( Tcl_GetChannelName(statePtr->self), -1) );
    Tcl_ListObjAppendElement(statePtr->interp, cmdPtr,
	    Tcl_NewStringObj(Tcl_GetChannelName(statePtr->self), -1));

    Tcl_ListObjAppendElement( statePtr->interp, cmdPtr,
    Tcl_ListObjAppendElement(statePtr->interp, cmdPtr, Tcl_NewIntObj(depth));
	    Tcl_NewIntObj( depth) );

    Tcl_ListObjAppendElement( statePtr->interp, cmdPtr,
    Tcl_ListObjAppendElement(statePtr->interp, cmdPtr, Tls_NewX509Obj(statePtr->interp, cert));
	    Tls_NewX509Obj( statePtr->interp, cert) );

    Tcl_ListObjAppendElement( statePtr->interp, cmdPtr,
    Tcl_ListObjAppendElement(statePtr->interp, cmdPtr, Tcl_NewIntObj(ok));
	    Tcl_NewIntObj( ok) );

    Tcl_ListObjAppendElement( statePtr->interp, cmdPtr,
    Tcl_ListObjAppendElement(statePtr->interp, cmdPtr, Tcl_NewStringObj(errStr ? errStr : "", -1));
	    Tcl_NewStringObj( errStr ? errStr : "", -1) );

    Tcl_Preserve( (ClientData) statePtr->interp);
    Tcl_Preserve( (ClientData) statePtr);
    Tcl_Preserve((ClientData) statePtr->interp);
    Tcl_Preserve((ClientData) statePtr);

    statePtr->flags |= TLS_TCL_CALLBACK;

    Tcl_IncrRefCount( cmdPtr);
    Tcl_IncrRefCount(cmdPtr);
    code = Tcl_EvalObjEx(statePtr->interp, cmdPtr, TCL_EVAL_GLOBAL);
    if (code != TCL_OK) {
	/* It got an error - reject the certificate.		*/
#if (TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION < 6)
	Tcl_BackgroundError(statePtr->interp);
#else
	Tcl_BackgroundException(statePtr->interp, code);
327
328
329
330
331
332
333
334

335
336
337
338
339


340
341
342
343
344
345
346
347
310
311
312
313
314
315
316

317
318
319
320


321
322

323
324
325
326
327
328
329







-
+



-
-
+
+
-







#else
		Tcl_BackgroundException(statePtr->interp, code);
#endif
		ok = 0;
	    }
	}
    }
    Tcl_DecrRefCount( cmdPtr);
    Tcl_DecrRefCount(cmdPtr);

    statePtr->flags &= ~(TLS_TCL_CALLBACK);

    Tcl_Release( (ClientData) statePtr);
    Tcl_Release( (ClientData) statePtr->interp);
    Tcl_Release((ClientData) statePtr);
    Tcl_Release((ClientData) statePtr->interp);

    return(ok);	/* By default, leave verification unchanged.	*/
}

/*
 *-------------------------------------------------------------------
 *
 * Tls_Error --
368
369
370
371
372
373
374
375

376
377
378
379
380
381
382
383
384
385

386
387
388

389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425

426
427
428
429
430
431
432
433
434
435
436
437
438
439
440

441
442
443
444
445
446
447
448
449
450
451
452
453
454
455

456
457
458
459
460
461
462
463
350
351
352
353
354
355
356

357
358
359
360
361
362
363
364
365
366

367
368
369

370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388

389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405

406
407
408
409
410
411
412
413
414
415
416
417
418
419
420

421
422
423
424
425
426
427
428
429
430
431
432
433
434
435

436

437
438
439
440
441
442
443







-
+









-
+


-
+


















-

















-
+














-
+














-
+
-







    }
    statePtr->err = msg;

    if (statePtr->callback == (Tcl_Obj*)NULL) {
	char buf[BUFSIZ];
	sprintf(buf, "SSL channel \"%s\": error: %s",
	    Tcl_GetChannelName(statePtr->self), msg);
	Tcl_SetResult( statePtr->interp, buf, TCL_VOLATILE);
	Tcl_SetResult(statePtr->interp, buf, TCL_VOLATILE);
#if (TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION < 6)
	Tcl_BackgroundError(statePtr->interp);
#else
	Tcl_BackgroundException(statePtr->interp, TCL_ERROR);
#endif
	return;
    }
    cmdPtr = Tcl_DuplicateObj(statePtr->callback);

    Tcl_ListObjAppendElement(statePtr->interp, cmdPtr, 
    Tcl_ListObjAppendElement(statePtr->interp, cmdPtr,
	    Tcl_NewStringObj("error", -1));

    Tcl_ListObjAppendElement(statePtr->interp, cmdPtr, 
    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);

    Tcl_IncrRefCount(cmdPtr);
    code = Tcl_EvalObjEx(statePtr->interp, cmdPtr, TCL_EVAL_GLOBAL);
    if (code != TCL_OK) {
#if (TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION < 6)
	Tcl_BackgroundError(statePtr->interp);
#else
	Tcl_BackgroundException(statePtr->interp, code);
#endif
    }
    Tcl_DecrRefCount(cmdPtr);

    Tcl_Release((ClientData) statePtr);
    Tcl_Release((ClientData) statePtr->interp);
}

void KeyLogCallback(const SSL *ssl, const char *line) {
    char *str = getenv(SSLKEYLOGFILE);
    FILE *fd;
    if (str) {
	fd = fopen(str, "a");
	fprintf(fd, "%s\n",line);
	fclose(fd);
    }
}

/*
 *-------------------------------------------------------------------
 *
 * PasswordCallback -- 
 * 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
/*
 * No way to handle user-data therefore no way without a global
 * variable to access the Tcl interpreter.
*/
static int
PasswordCallback(char *buf, int size, int verify) {
    return -1;
    	buf = buf;
	buf = buf;
	size = size;
	verify = verify;
}
#else
static int
PasswordCallback(char *buf, int size, int verify, void *udata) {
    State *statePtr	= (State *) udata;
    Tcl_Interp *interp	= statePtr->interp;
    Tcl_Obj *cmdPtr;
    int code;

    dprintf("Called");

    if (statePtr->password == NULL) {
	if (Tcl_EvalEx(interp, "tls::password", -1, TCL_EVAL_GLOBAL)
	if (Tcl_EvalEx(interp, "tls::password", -1, TCL_EVAL_GLOBAL) == TCL_OK) {
		== TCL_OK) {
	    char *ret = (char *) Tcl_GetStringResult(interp);
	    strncpy(buf, ret, (size_t) size);
	    return (int)strlen(ret);
	} else {
	    return -1;
	}
    }
479
480
481
482
483
484
485
486

487
488

489
490
491
492

493
494
495
496
497
498
499
459
460
461
462
463
464
465

466
467

468
469
470
471
472
473
474
475
476
477
478
479
480







-
+

-
+




+







    Tcl_DecrRefCount(cmdPtr);

    Tcl_Release((ClientData) statePtr);

    if (code == TCL_OK) {
	char *ret = (char *) Tcl_GetStringResult(interp);
	if (strlen(ret) < size - 1) {
	strncpy(buf, ret, (size_t) size);
	    strncpy(buf, ret, (size_t) size);
	    Tcl_Release((ClientData) interp);
	return (int)strlen(ret);
	    return (int)strlen(ret);
	}
    }
    Tcl_Release((ClientData) interp);
    return -1;
	verify = verify;
}
#endif

/*
 *-------------------------------------------------------------------
 *
 * CiphersObjCmd -- list available ciphers
526
527
528
529
530
531
532
533

534
535
536
537

538
539
540
541
542

543
544
545


546
547

548
549

550
551
552


553
554

555
556

557
558
559


560
561

562
563

564
565
566


567
568

569
570

571
572
573


574
575

576
577

578
579
580


581
582
583
584
585




586
587
588


589
590
591
592
593
594
595
596
597
598
599
600

601
602
603
604

605
606

607
608
609
610
611
612
613
614
615

616
617

618
619
620
621
622
623
624

625
626
627
628
629
630
631

632
633

634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658





659
660

661
662
663
664
665




666
667
668
669
670




671
672
673
674
675
676
677
678
679
680









681
682
683
684



685
686
687
688
689
690
691
692







693
694
695
696



697
698
699
700
701
702
703
704







705
706
707


708
709
710
711



712
713

714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
507
508
509
510
511
512
513

514

515
516

517

518
519
520

521
522


523
524
525

526
527

528
529


530
531
532

533
534

535
536


537
538
539

540
541

542
543


544
545
546

547
548

549
550


551
552
553

554
555

556
557


558
559
560




561
562
563
564
565


566
567
568
569
570
571
572
573
574
575
576
577
578

579
580
581
582

583
584

585

586
587
588
589
590
591


592
593

594

595
596
597
598
599

600

601
602
603
604
605

606
607

608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626

627





628
629
630
631
632
633

634
635




636
637
638
639
640




641
642
643
644
645









646
647
648
649
650
651
652
653
654
655



656
657
658
659







660
661
662
663
664
665
666
667



668
669
670
671







672
673
674
675
676
677
678



679
680
681



682
683
684


685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704

705
706
707
708
709
710
711







-
+
-


-
+
-



-
+

-
-
+
+

-
+

-
+

-
-
+
+

-
+

-
+

-
-
+
+

-
+

-
+

-
-
+
+

-
+

-
+

-
-
+
+

-
+

-
+

-
-
+
+

-
-
-
-
+
+
+
+

-
-
+
+











-
+



-
+

-
+
-






-
-
+

-
+
-





-
+
-





-
+

-
+


















-

-
-
-
-
-
+
+
+
+
+

-
+

-
-
-
-
+
+
+
+

-
-
-
-
+
+
+
+

-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+

-
-
-
+
+
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
-
+
+
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+
-
-
-
+
+

-
-
-
+
+
+
-
-
+



















-








    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,
    if (Tcl_GetIndexFromObj(interp, objv[1], protocols, "protocol", 0, &index) != TCL_OK) {
	&index) != TCL_OK) {
	return TCL_ERROR;
    }
    if ((objc > 2) && Tcl_GetBooleanFromObj( interp, objv[2],
    if ((objc > 2) && Tcl_GetBooleanFromObj(interp, objv[2], &verbose) != TCL_OK) {
	&verbose) != TCL_OK) {
	return TCL_ERROR;
    }
    switch ((enum protocol)index) {
    case TLS_SSL2:
	case TLS_SSL2:
#if OPENSSL_VERSION_NUMBER >= 0x10101000L || defined(NO_SSL2) || defined(OPENSSL_NO_SSL2)
		Tcl_AppendResult(interp, protocols[index], ": protocol not supported", NULL);
		return TCL_ERROR;
	    Tcl_AppendResult(interp, protocols[index], ": protocol not supported", NULL);
	    return TCL_ERROR;
#else
		ctx = SSL_CTX_new(SSLv2_method()); break;
	    ctx = SSL_CTX_new(SSLv2_method()); break;
#endif
    case TLS_SSL3:
	case TLS_SSL3:
#if defined(NO_SSL3) || defined(OPENSSL_NO_SSL3)
		Tcl_AppendResult(interp, protocols[index], ": protocol not supported", NULL);
		return TCL_ERROR;
	    Tcl_AppendResult(interp, protocols[index], ": protocol not supported", NULL);
	    return TCL_ERROR;
#else
		ctx = SSL_CTX_new(SSLv3_method()); break;
	    ctx = SSL_CTX_new(SSLv3_method()); break;
#endif
    case TLS_TLS1:
	case TLS_TLS1:
#if defined(NO_TLS1) || defined(OPENSSL_NO_TLS1)
		Tcl_AppendResult(interp, protocols[index], ": protocol not supported", NULL);
		return TCL_ERROR;
	    Tcl_AppendResult(interp, protocols[index], ": protocol not supported", NULL);
	    return TCL_ERROR;
#else
		ctx = SSL_CTX_new(TLSv1_method()); break;
	    ctx = SSL_CTX_new(TLSv1_method()); break;
#endif
    case TLS_TLS1_1:
	case TLS_TLS1_1:
#if defined(NO_TLS1_1) || defined(OPENSSL_NO_TLS1_1)
		Tcl_AppendResult(interp, protocols[index], ": protocol not supported", NULL);
		return TCL_ERROR;
	    Tcl_AppendResult(interp, protocols[index], ": protocol not supported", NULL);
	    return TCL_ERROR;
#else
		ctx = SSL_CTX_new(TLSv1_1_method()); break;
	    ctx = SSL_CTX_new(TLSv1_1_method()); break;
#endif
    case TLS_TLS1_2:
	case TLS_TLS1_2:
#if defined(NO_TLS1_2) || defined(OPENSSL_NO_TLS1_2)
		Tcl_AppendResult(interp, protocols[index], ": protocol not supported", NULL);
		return TCL_ERROR;
	    Tcl_AppendResult(interp, protocols[index], ": protocol not supported", NULL);
	    return TCL_ERROR;
#else
		ctx = SSL_CTX_new(TLSv1_2_method()); break;
	    ctx = SSL_CTX_new(TLSv1_2_method()); break;
#endif
    case TLS_TLS1_3:
	case TLS_TLS1_3:
#if defined(NO_TLS1_3) || defined(OPENSSL_NO_TLS1_3)
		Tcl_AppendResult(interp, protocols[index], ": protocol not supported", NULL);
		return TCL_ERROR;
	    Tcl_AppendResult(interp, protocols[index], ": protocol not supported", NULL);
	    return TCL_ERROR;
#else
		ctx = SSL_CTX_new(TLS_method());
                SSL_CTX_set_min_proto_version (ctx, TLS1_3_VERSION);
                SSL_CTX_set_max_proto_version (ctx, TLS1_3_VERSION);
		break;
	    ctx = SSL_CTX_new(TLS_method());
            SSL_CTX_set_min_proto_version(ctx, TLS1_3_VERSION);
	    SSL_CTX_set_max_proto_version(ctx, TLS1_3_VERSION);
	    break;
#endif
    default:
		break;
	default:
	    break;
    }
    if (ctx == NULL) {
	Tcl_AppendResult(interp, REASON(), NULL);
	return TCL_ERROR;
    }
    ssl = SSL_new(ctx);
    if (ssl == NULL) {
	Tcl_AppendResult(interp, REASON(), NULL);
	SSL_CTX_free(ctx);
	return TCL_ERROR;
    }
    objPtr = Tcl_NewListObj( 0, NULL);
    objPtr = Tcl_NewListObj(0, NULL);

    if (!verbose) {
	for (index = 0; ; index++) {
	    cp = (char*)SSL_get_cipher_list( ssl, index);
	    cp = (char*)SSL_get_cipher_list(ssl, index);
	    if (cp == NULL) break;
	    Tcl_ListObjAppendElement( interp, objPtr,
	    Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(cp, -1));
		Tcl_NewStringObj( cp, -1) );
	}
    } else {
	sk = SSL_get_ciphers(ssl);

	for (index = 0; index < sk_SSL_CIPHER_num(sk); index++) {
	    register size_t i;
	    SSL_CIPHER_description( sk_SSL_CIPHER_value( sk, index),
				    buf, sizeof(buf));
	    SSL_CIPHER_description(sk_SSL_CIPHER_value(sk, index), buf, sizeof(buf));
	    for (i = strlen(buf) - 1; i ; i--) {
		if ((buf[i] == ' ') || (buf[i] == '\n') ||
		if ((buf[i] == ' ') || (buf[i] == '\n') || (buf[i] == '\r') || (buf[i] == '\t')) {
		    (buf[i] == '\r') || (buf[i] == '\t')) {
		    buf[i] = '\0';
		} else {
		    break;
		}
	    }
	    Tcl_ListObjAppendElement( interp, objPtr,
	    Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(buf, -1));
		Tcl_NewStringObj( buf, -1) );
	}
    }
    SSL_free(ssl);
    SSL_CTX_free(ctx);

    Tcl_SetObjResult( interp, objPtr);
    Tcl_SetObjResult(interp, objPtr);
    return TCL_OK;
    	clientData = clientData;
	clientData = clientData;
}

/*
 *-------------------------------------------------------------------
 *
 * HandshakeObjCmd --
 *
 *	This command is used to verify whether the handshake is complete
 *	or not.
 *
 * Results:
 *	A standard Tcl result. 1 means handshake complete, 0 means pending.
 *
 * Side effects:
 *	May force SSL negotiation to take place.
 *
 *-------------------------------------------------------------------
 */

static int HandshakeObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
	Tcl_Channel chan;		/* The channel to set a mode on. */
	State *statePtr;		/* client state for ssl socket */
	const char *errStr = NULL;
	int ret = 1;
	int err = 0;
    Tcl_Channel chan;        /* The channel to set a mode on. */
    State *statePtr;        /* client state for ssl socket */
    const char *errStr = NULL;
    int ret = 1;
    int err = 0;

	dprintf("Called");
    dprintf("Called");

	if (objc != 2) {
		Tcl_WrongNumArgs(interp, 1, objv, "channel");
		return(TCL_ERROR);
	}
    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) {
		return(TCL_ERROR);
	}
    chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], NULL), NULL);
    if (chan == (Tcl_Channel) NULL) {
	return(TCL_ERROR);
    }

	/*
	 * Make sure to operate on the topmost channel
	 */
	chan = Tcl_GetTopChannel(chan);
	if (Tcl_GetChannelType(chan) != Tls_ChannelType()) {
		Tcl_AppendResult(interp, "bad channel \"", Tcl_GetChannelName(chan), "\": not a TLS channel", NULL);
		return(TCL_ERROR);
	}
	statePtr = (State *)Tcl_GetChannelInstanceData(chan);
    /*
     * Make sure to operate on the topmost channel
     */
    chan = Tcl_GetTopChannel(chan);
    if (Tcl_GetChannelType(chan) != Tls_ChannelType()) {
	Tcl_AppendResult(interp, "bad channel \"", Tcl_GetChannelName(chan), "\": not a TLS channel", NULL);
	return(TCL_ERROR);
    }
    statePtr = (State *)Tcl_GetChannelInstanceData(chan);

	dprintf("Calling Tls_WaitForConnect");
	ret = Tls_WaitForConnect(statePtr, &err, 1);
	dprintf("Tls_WaitForConnect returned: %i", ret);
    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))) {
		dprintf("Async set and err = EAGAIN");
		ret = 0;
	} else if (ret < 0) {
		errStr = statePtr->err;
		Tcl_ResetResult(interp);
		Tcl_SetErrno(err);
    if (ret < 0 && ((statePtr->flags & TLS_TCL_ASYNC) && (err == EAGAIN))) {
	dprintf("Async set and err = EAGAIN");
	ret = 0;
    } else if (ret < 0) {
	errStr = statePtr->err;
	Tcl_ResetResult(interp);
	Tcl_SetErrno(err);

		if (!errStr || (*errStr == 0)) {
			errStr = Tcl_PosixError(interp);
		}
	if (!errStr || (*errStr == 0)) {
	    errStr = Tcl_PosixError(interp);
	}

		Tcl_AppendResult(interp, "handshake failed: ", errStr, (char *) NULL);
		dprintf("Returning TCL_ERROR with handshake failed: %s", errStr);
		return(TCL_ERROR);
	} else {
		if (err != 0) {
			dprintf("Got an error with a completed handshake: err = %i", err);
		}
	Tcl_AppendResult(interp, "handshake failed: ", errStr, (char *) NULL);
	dprintf("Returning TCL_ERROR with handshake failed: %s", errStr);
	return(TCL_ERROR);
    } else {
	if (err != 0) {
	    dprintf("Got an error with a completed handshake: err = %i", err);
	}

		ret = 1;
	}
	ret = 1;
    }

	dprintf("Returning TCL_OK with data \"%i\"", ret);
	Tcl_SetObjResult(interp, Tcl_NewIntObj(ret));
	return(TCL_OK);
    dprintf("Returning TCL_OK with data \"%i\"", ret);
    Tcl_SetObjResult(interp, Tcl_NewIntObj(ret));
    return(TCL_OK);

    	clientData = clientData;
	clientData = clientData;
}

/*
 *-------------------------------------------------------------------
 *
 * ImportObjCmd --
 *
 *	This procedure is invoked to process the "ssl" command
 *
 *	The ssl command pushes SSL over a (newly connected) tcp socket
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	May modify the behavior of an IO channel.
 *
 *-------------------------------------------------------------------
 */

static int
ImportObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    Tcl_Channel chan;		/* The channel to set a mode on. */
    State *statePtr;		/* client state for ssl socket */
    SSL_CTX *ctx	        = NULL;
    Tcl_Obj *script	        = NULL;
    Tcl_Obj *password	        = NULL;
800
801
802
803
804
805
806
807
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

834
835
836
837
838
839
840
771
772
773
774
775
776
777












778
779
780
781
782
783
784
785
786
787
788
789
790


791
792
793
794








795
796
797
798
799
800
801
802
803

804
805
806
807
808
809
810
811







-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+

-
-
+
+


-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+

-
+








    for (idx = 2; idx < objc; idx++) {
	char *opt = Tcl_GetStringFromObj(objv[idx], NULL);

	if (opt[0] != '-')
	    break;

	OPTSTR( "-cadir", CAdir);
	OPTSTR( "-cafile", CAfile);
	OPTSTR( "-certfile", certfile);
	OPTSTR( "-cipher", ciphers);
	OPTOBJ( "-command", script);
	OPTSTR( "-dhparams", DHparams);
	OPTSTR( "-keyfile", keyfile);
	OPTSTR( "-model", model);
	OPTOBJ( "-password", password);
	OPTBOOL( "-require", require);
	OPTBOOL( "-request", request);
	OPTBOOL( "-server", server);
	OPTSTR("-cadir", CAdir);
	OPTSTR("-cafile", CAfile);
	OPTSTR("-certfile", certfile);
	OPTSTR("-cipher", ciphers);
	OPTOBJ("-command", script);
	OPTSTR("-dhparams", DHparams);
	OPTSTR("-keyfile", keyfile);
	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);
	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);
	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", "-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");
	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;

887
888
889
890
891
892
893
894
895
896
897




898
899
900


901
902
903
904
905
906
907
858
859
860
861
862
863
864




865
866
867
868
869


870
871
872
873
874
875
876
877
878







-
-
-
-
+
+
+
+

-
-
+
+







	/* Get the "model" context */
	chan = Tcl_GetChannel(interp, model, &mode);
	if (chan == (Tcl_Channel) NULL) {
	    Tls_Free((char *) statePtr);
	    return TCL_ERROR;
	}

        /*
         * Make sure to operate on the topmost channel
         */
        chan = Tcl_GetTopChannel(chan);
	/*
	 * Make sure to operate on the topmost channel
	 */
	chan = Tcl_GetTopChannel(chan);
	if (Tcl_GetChannelType(chan) != Tls_ChannelType()) {
	    Tcl_AppendResult(interp, "bad channel \"",
		    Tcl_GetChannelName(chan), "\": not a TLS channel", NULL);
	    Tcl_AppendResult(interp, "bad channel \"", Tcl_GetChannelName(chan),
		"\": not a TLS channel", NULL);
	    Tls_Free((char *) statePtr);
	    return TCL_ERROR;
	}
	ctx = ((State *)Tcl_GetChannelInstanceData(chan))->ctx;
    } else {
	if ((ctx = CTX_Init(statePtr, server, proto, keyfile, certfile, key, cert,
	    key_len, cert_len, CAdir, CAfile, ciphers, DHparams)) == (SSL_CTX*)0) {
943
944
945
946
947
948
949
950
951
952
953
954

955
956
957
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
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040


1041
1042

1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
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
941
942
943
944
945
946
947
948
949
950

951

952
953
954
955
956
957
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
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022

1023
1024
1025
1026
1027
1028
1029







-



-
+
-






-
-
+
+
-


















-
+
-
















-
+
-












-

-

-



















-
-
+
+

-
+

















-







    Tcl_SetChannelOption(interp, statePtr->self, "-encoding", Tcl_DStringValue(&upperChannelEncoding));
    Tcl_SetChannelOption(interp, statePtr->self, "-eofchar", Tcl_DStringValue(&upperChannelEOFChar));
    Tcl_SetChannelOption(interp, statePtr->self, "-blocking", Tcl_DStringValue(&upperChannelBlocking));

    /*
     * SSL Initialization
     */

    statePtr->ssl = SSL_new(statePtr->ctx);
    if (!statePtr->ssl) {
	/* SSL library error */
	Tcl_AppendResult(interp, "couldn't construct ssl session: ", REASON(),
	Tcl_AppendResult(interp, "couldn't construct ssl session: ", REASON(), (char *) NULL);
		(char *) NULL);
	Tls_Free((char *) statePtr);
	return TCL_ERROR;
    }

#ifndef OPENSSL_NO_TLSEXT
    if (servername) {
        if (!SSL_set_tlsext_host_name(statePtr->ssl, servername) && require) {
            Tcl_AppendResult(interp, "setting TLS host name extension failed",
	if (!SSL_set_tlsext_host_name(statePtr->ssl, servername) && require) {
	    Tcl_AppendResult(interp, "setting TLS host name extension failed", (char *) NULL);
                (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",
		Tcl_AppendResult(interp, "alpn protocol name too long", (char *) NULL);
		  (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",
	    Tcl_AppendResult(interp, "failed to set alpn protocols", (char *) NULL);
	      (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 */

    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_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);
    Tcl_SetResult(interp, (char *) Tcl_GetChannelName(statePtr->self), TCL_VOLATILE);

    return TCL_OK;
    	clientData = clientData;
	clientData = clientData;
}

/*
 *-------------------------------------------------------------------
 *
 * UnimportObjCmd --
 *
 *	This procedure is invoked to remove the topmost channel filter.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	May modify the behavior of an IO channel.
 *
 *-------------------------------------------------------------------
 */

static int
UnimportObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    Tcl_Channel chan;		/* The channel to set a mode on. */

    dprintf("Called");

    if (objc != 2) {
1086
1087
1088
1089
1090
1091
1092
1093

1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1048
1049
1050
1051
1052
1053
1054

1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070

1071
1072
1073
1074
1075
1076
1077







-
+















-







    }

    if (Tcl_UnstackChannel(interp, chan) == TCL_ERROR) {
	return TCL_ERROR;
    }

    return TCL_OK;
    	clientData = clientData;
	clientData = clientData;
}

/*
 *-------------------------------------------------------------------
 *
 * CTX_Init -- construct a SSL_CTX instance
 *
 * Results:
 *	A valid SSL_CTX instance or NULL.
 *
 * Side effects:
 *	constructs SSL context (CTX)
 *
 *-------------------------------------------------------------------
 */

static SSL_CTX *
CTX_Init(State *statePtr, int isServer, int proto, char *keyfile, char *certfile,
    unsigned char *key, unsigned char *cert, int key_len, int cert_len, char *CAdir,
    char *CAfile, char *ciphers, char *DHparams) {
    Tcl_Interp *interp = statePtr->interp;
    SSL_CTX *ctx = NULL;
    Tcl_DString ds;
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199





1200
1201
1202
1203
1204
1205
1206

1207
1208

1209
1210
1211
1212
1213
1214
1215
1149
1150
1151
1152
1153
1154
1155





1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166

1167
1168

1169
1170
1171
1172
1173
1174
1175
1176







-
-
-
-
-
+
+
+
+
+






-
+

-
+







#if !defined(NO_TLS1_2) && !defined(OPENSSL_NO_TLS1_2)
    case TLS_PROTO_TLS1_2:
	method = TLSv1_2_method();
	break;
#endif
#if !defined(NO_TLS1_3) && !defined(OPENSSL_NO_TLS1_3)
    case TLS_PROTO_TLS1_3:
        /*
         * The version range is constrained below,
         * after the context is created.  Use the
         * generic method here.
         */
	/*
	 * The version range is constrained below,
	 * after the context is created.  Use the
	 * generic method here.
	 */
	method = TLS_method();
	break;
#endif
    default:
#if OPENSSL_VERSION_NUMBER >= 0x10100000L
	/* Negotiate highest available SSL/TLS version */
        method = TLS_method();
	method = TLS_method();
#else
        method = SSLv23_method();
	method = SSLv23_method();
#endif
#if OPENSSL_VERSION_NUMBER < 0x10100000L && !defined(NO_SSL2) && !defined(OPENSSL_NO_SSL2)
	off |= (ENABLED(proto, TLS_PROTO_SSL2)   ? 0 : SSL_OP_NO_SSLv2);
#endif
#if !defined(NO_SSL3) && !defined(OPENSSL_NO_SSL3)
	off |= (ENABLED(proto, TLS_PROTO_SSL3)   ? 0 : SSL_OP_NO_SSLv3);
#endif
1223
1224
1225
1226
1227
1228
1229
1230

1231
1232
1233
1234

1235
1236
1237
1238
1239
1240
1241
1242
1243
1244


1245
1246
1247
1248
1249
1250
1251
1252
1253
1254




1255
1256
1257
1258

1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274

1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288

1289
1290
1291
1292

1293
1294
1295
1296
1297
1298

1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317

1318
1319
1320
1321

1322
1323
1324
1325
1326
1327
1328
1329
1330

1331
1332
1333
1334
1335
1336
1337
1338
1339

1340
1341
1342
1343
1344

1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364

1365
1366
1367
1368
1369

1370
1371
1372
1373
1374
1375

1376
1377
1378
1379
1380
1381

1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392

1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408

1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420




1421
1422
1423
1424
1425
1426
1427
1184
1185
1186
1187
1188
1189
1190

1191
1192
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
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233


1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246


1247
1248
1249
1250

1251
1252
1253
1254
1255


1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274

1275

1276


1277
1278
1279
1280
1281
1282
1283
1284
1285

1286

1287
1288
1289
1290
1291
1292
1293

1294

1295
1296


1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316

1317
1318
1319
1320


1321
1322
1323
1324
1325

1326
1327
1328
1329
1330
1331
1332

1333


1334
1335
1336
1337
1338
1339
1340


1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356

1357

1358
1359
1360
1361
1362
1363
1364




1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375







-
+



-
+








-
-
+
+






-
-
-
-
+
+
+
+



-
+














-
-
+












-
-
+



-
+




-
-
+


















-
+
-

-
-
+








-
+
-







-
+
-


-
-
+



















-
+



-
-
+




-

+





-
+
-
-







-
-
+















-
+
-







-
-
-
-
+
+
+
+







	off |= (ENABLED(proto, TLS_PROTO_TLS1_2) ? 0 : SSL_OP_NO_TLSv1_2);
#endif
#if !defined(NO_TLS1_3) && !defined(OPENSSL_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);
	return(NULL);
    }

    if (getenv(SSLKEYLOGFILE)) {
	SSL_CTX_set_keylog_callback(ctx, KeyLogCallback);
    }

#if !defined(NO_TLS1_3) && !defined(OPENSSL_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);
	SSL_CTX_set_min_proto_version(ctx, TLS1_3_VERSION);
	SSL_CTX_set_max_proto_version(ctx, TLS1_3_VERSION);

	if (!isServer) {
	    SSL_CTX_set_options(ctx, SSL_OP_CIPHER_SERVER_PREFERENCE);
	}
    }
#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_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);		/* disable protocol versions */
#if OPENSSL_VERSION_NUMBER < 0x10101000L
    SSL_CTX_set_mode(ctx, SSL_MODE_AUTO_RETRY);	/* handle new handshakes in background */
#endif
    SSL_CTX_sess_set_cache_size( ctx, 128);
    SSL_CTX_sess_set_cache_size(ctx, 128);

    if (ciphers != NULL)
	SSL_CTX_set_cipher_list(ctx, ciphers);

    /* set some callbacks */
    SSL_CTX_set_default_passwd_cb(ctx, PasswordCallback);

#ifndef BSAFE
    SSL_CTX_set_default_passwd_cb_userdata(ctx, (void *)statePtr);
#endif

    /* read a Diffie-Hellman parameters file, or use the built-in one */
#ifdef OPENSSL_NO_DH
    if (DHparams != NULL) {
	Tcl_AppendResult(interp,
	    "DH parameter support not available", (char *) NULL);
	Tcl_AppendResult(interp, "DH parameter support not available", (char *) NULL);
	SSL_CTX_free(ctx);
	return (SSL_CTX *)0;
    }
#else
    {
	DH* dh;
	if (DHparams != NULL) {
	    BIO *bio;
	    Tcl_DStringInit(&ds);
	    bio = BIO_new_file(F2N(DHparams, &ds), "r");
	    if (!bio) {
		Tcl_DStringFree(&ds);
		Tcl_AppendResult(interp,
		    "Could not find DH parameters file", (char *) NULL);
		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);
		Tcl_AppendResult(interp, "Could not read DH parameters from file", (char *) NULL);
		SSL_CTX_free(ctx);
		return (SSL_CTX *)0;
	    }
	} else {
	    dh = get_dhParams();
	}
	SSL_CTX_set_tmp_dh(ctx, dh);
	DH_free(dh);
    }
#endif

    /* set our certificate */
    load_private_key = 0;
    if (certfile != NULL) {
	load_private_key = 1;

	Tcl_DStringInit(&ds);

	if (SSL_CTX_use_certificate_file(ctx, F2N( certfile, &ds),
	if (SSL_CTX_use_certificate_file(ctx, F2N(certfile, &ds), SSL_FILETYPE_PEM) <= 0) {
					SSL_FILETYPE_PEM) <= 0) {
	    Tcl_DStringFree(&ds);
	    Tcl_AppendResult(interp,
			     "unable to set certificate file ", certfile, ": ",
	    Tcl_AppendResult(interp, "unable to set certificate file ", certfile, ": ",
			     REASON(), (char *) NULL);
	    SSL_CTX_free(ctx);
	    return (SSL_CTX *)0;
	}
    } else if (cert != NULL) {
	load_private_key = 1;
	if (SSL_CTX_use_certificate_ASN1(ctx, cert_len, cert) <= 0) {
	    Tcl_DStringFree(&ds);
	    Tcl_AppendResult(interp,
	    Tcl_AppendResult(interp, "unable to set certificate: ",
			     "unable to set certificate: ",
			     REASON(), (char *) NULL);
	    SSL_CTX_free(ctx);
	    return (SSL_CTX *)0;
	}
    } else {
	certfile = (char*)X509_get_default_cert_file();

	if (SSL_CTX_use_certificate_file(ctx, certfile,
	if (SSL_CTX_use_certificate_file(ctx, certfile, SSL_FILETYPE_PEM) <= 0) {
					SSL_FILETYPE_PEM) <= 0) {
#if 0
	    Tcl_DStringFree(&ds);
	    Tcl_AppendResult(interp,
			     "unable to use default certificate file ", certfile, ": ",
	    Tcl_AppendResult(interp, "unable to use default certificate file ", certfile, ": ",
			     REASON(), (char *) NULL);
	    SSL_CTX_free(ctx);
	    return (SSL_CTX *)0;
#endif
	}
    }

    /* set our private key */
    if (load_private_key) {
	if (keyfile == NULL && key == NULL) {
	    keyfile = certfile;
	}

	if (keyfile != NULL) {
	    /* get the private key associated with this certificate */
	    if (keyfile == NULL) {
		keyfile = certfile;
	    }

	    if (SSL_CTX_use_PrivateKey_file(ctx, F2N( keyfile, &ds), SSL_FILETYPE_PEM) <= 0) {
	    if (SSL_CTX_use_PrivateKey_file(ctx, F2N(keyfile, &ds), SSL_FILETYPE_PEM) <= 0) {
		Tcl_DStringFree(&ds);
		/* flush the passphrase which might be left in the result */
		Tcl_SetResult(interp, NULL, TCL_STATIC);
		Tcl_AppendResult(interp,
			         "unable to set public key file ", keyfile, " ",
		Tcl_AppendResult(interp, "unable to set public key file ", keyfile, " ",
			         REASON(), (char *) NULL);
		SSL_CTX_free(ctx);
		return (SSL_CTX *)0;
	    }

	    Tcl_DStringFree(&ds);

	} else if (key != NULL) {
	    if (SSL_CTX_use_PrivateKey_ASN1(EVP_PKEY_RSA, ctx, key,key_len) <= 0) {
		Tcl_DStringFree(&ds);
		/* flush the passphrase which might be left in the result */
		Tcl_SetResult(interp, NULL, TCL_STATIC);
		Tcl_AppendResult(interp,
		Tcl_AppendResult(interp, "unable to set public key: ", REASON(), (char *) NULL);
		                 "unable to set public key: ",
		                 REASON(), (char *) NULL);
		SSL_CTX_free(ctx);
		return (SSL_CTX *)0;
	    }
	}
	/* Now we know that a key and cert have been set against
	 * the SSL context */
	if (!SSL_CTX_check_private_key(ctx)) {
	    Tcl_AppendResult(interp,
			     "private key does not match the certificate public key",
	    Tcl_AppendResult(interp, "private key does not match the certificate public key",
			     (char *) NULL);
	    SSL_CTX_free(ctx);
	    return (SSL_CTX *)0;
	}
    }

    /* Set verification CAs */
    Tcl_DStringInit(&ds);
    Tcl_DStringInit(&ds1);
    if (!SSL_CTX_load_verify_locations(ctx, F2N(CAfile, &ds), F2N(CAdir, &ds1)) ||
	!SSL_CTX_set_default_verify_paths(ctx)) {
#if 0
	Tcl_DStringFree(&ds);
	Tcl_DStringFree(&ds1);
	/* Don't currently care if this fails */
	Tcl_AppendResult(interp, "SSL default verify paths: ",
	Tcl_AppendResult(interp, "SSL default verify paths: ", REASON(), (char *) NULL);
		REASON(), (char *) NULL);
	SSL_CTX_free(ctx);
	return (SSL_CTX *)0;
#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 );
    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;
}
1495
1496
1497
1498
1499
1500
1501
1502

1503
1504

1505
1506
1507
1508
1509

1510
1511

1512
1513
1514
1515
1516
1517
1518
1519

1520
1521
1522

1523
1524

1525
1526
1527

1528
1529

1530
1531
1532
1533
1534
1535
1536
1443
1444
1445
1446
1447
1448
1449

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







-
+
-
-
+
-



-
+
-
-
+
-






-
+
-

-
+
-
-
+
-

-
+

-
+







    if (peer) {
	objPtr = Tls_NewX509Obj(interp, peer);
	if (objc == 2) { X509_free(peer); }
    } else {
	objPtr = Tcl_NewListObj(0, NULL);
    }

    Tcl_ListObjAppendElement (interp, objPtr,
    Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("sbits", -1));
	    Tcl_NewStringObj ("sbits", -1));
    Tcl_ListObjAppendElement (interp, objPtr,
    Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewIntObj(SSL_get_cipher_bits(statePtr->ssl, NULL)));
	    Tcl_NewIntObj (SSL_get_cipher_bits (statePtr->ssl, NULL)));

    ciphers = (char*)SSL_get_cipher(statePtr->ssl);
    if ((ciphers != NULL) && (strcmp(ciphers, "(NONE)") != 0)) {
	Tcl_ListObjAppendElement(interp, objPtr,
	Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("cipher", -1));
		Tcl_NewStringObj("cipher", -1));
	Tcl_ListObjAppendElement(interp, objPtr,
	Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(SSL_get_cipher(statePtr->ssl), -1));
		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_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj((char *)proto, (int)len));
      Tcl_NewStringObj((char *)proto, (int)len));
#endif
    Tcl_ListObjAppendElement(interp, objPtr,
    Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("version", -1));
	Tcl_NewStringObj("version", -1));
    Tcl_ListObjAppendElement(interp, objPtr,
    Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(SSL_get_version(statePtr->ssl), -1));
	Tcl_NewStringObj(SSL_get_version(statePtr->ssl), -1));

    Tcl_SetObjResult( interp, objPtr);
    Tcl_SetObjResult(interp, objPtr);
    return TCL_OK;
    	clientData = clientData;
	clientData = clientData;
}

/*
 *-------------------------------------------------------------------
 *
 * VersionObjCmd -- return version string from OpenSSL.
 *
1545
1546
1547
1548
1549
1550
1551
1552
1553

1554
1555
1556
1557



1558
1559
1560
1561
1562
1563
1564
1486
1487
1488
1489
1490
1491
1492

1493
1494
1495



1496
1497
1498
1499
1500
1501
1502
1503
1504
1505







-

+

-
-
-
+
+
+







static int
VersionObjCmd(ClientData clientData, 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;
    	clientData = clientData;
    	objc = objc;
    	objv = objv;
	clientData = clientData;
	objc = objc;
	objv = objv;
}

/*
 *-------------------------------------------------------------------
 *
 * MiscObjCmd -- misc commands
 *
1605
1606
1607
1608
1609
1610
1611
1612

1613
1614
1615
1616
1617
1618
1619
1546
1547
1548
1549
1550
1551
1552

1553
1554
1555
1556
1557
1558
1559
1560







-
+








#if OPENSSL_VERSION_NUMBER <= 0x10100000L
	    RSA *rsa = NULL;
#elif OPENSSL_VERSION_NUMBER < 0x30000000L
	    BIGNUM *bne = NULL;
	    RSA *rsa = NULL;
#else
	    EVP_PKEY_CTX *ctx = NULL;    
	    EVP_PKEY_CTX *ctx = NULL;
#endif

	    if ((objc<5) || (objc>6)) {
		Tcl_WrongNumArgs(interp, 2, objv, "keysize keyfile certfile ?info?");
		return TCL_ERROR;
	    }

1724
1725
1726
1727
1728
1729
1730
1731

1732
1733
1734
1735
1736
1737
1738
1665
1666
1667
1668
1669
1670
1671

1672
1673
1674
1675
1676
1677
1678
1679







-
+







		X509_gmtime_adj(X509_get_notBefore(cert),0);
		X509_gmtime_adj(X509_get_notAfter(cert),(long)60*60*24*days);
#else
		X509_gmtime_adj(X509_getm_notBefore(cert),0);
		X509_gmtime_adj(X509_getm_notAfter(cert),(long)60*60*24*days);
#endif
		X509_set_pubkey(cert,pkey);
		

		name=X509_get_subject_name(cert);

		X509_NAME_add_entry_by_txt(name,"C", MBSTRING_ASC, (const unsigned char *) k_C, -1, -1, 0);
		X509_NAME_add_entry_by_txt(name,"ST", MBSTRING_ASC, (const unsigned char *) k_ST, -1, -1, 0);
		X509_NAME_add_entry_by_txt(name,"L", MBSTRING_ASC, (const unsigned char *) k_L, -1, -1, 0);
		X509_NAME_add_entry_by_txt(name,"O", MBSTRING_ASC, (const unsigned char *) k_O, -1, -1, 0);
		X509_NAME_add_entry_by_txt(name,"OU", MBSTRING_ASC, (const unsigned char *) k_OU, -1, -1, 0);
1775
1776
1777
1778
1779
1780
1781
1782

1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802

1803
1804
1805
1806
1807
1808
1809
1810
1716
1717
1718
1719
1720
1721
1722

1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742

1743

1744
1745
1746
1747
1748
1749
1750







-
+



















-
+
-







	    }
	}
	break;
    default:
	break;
    }
    return TCL_OK;
    	clientData = clientData;
	clientData = clientData;
}

/*
 *-------------------------------------------------------------------
 *
 * Tls_Free --
 *
 *	This procedure cleans up when a SSL socket based channel
 *	is closed and its reference count falls below 1
 *
 * Results:
 *	none
 *
 * Side effects:
 *	Frees all the state
 *
 *-------------------------------------------------------------------
 */
void
Tls_Free( char *blockPtr )
Tls_Free(char *blockPtr) {
{
    State *statePtr = (State *)blockPtr;

    dprintf("Called");

    Tls_Clean(statePtr);
    ckfree(blockPtr);
}
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885

1886
1887
1888


1889
1890

1891
1892
1893
1894
1895




1896
1897

1898
1899

1900
1901
1902
1903



1904
1905
1906
1907
1908




1909
1910
1911
1912
1913
1914
1915
1916







1917
1918
1919
1920



1921
1922

1923
1924
1925
1926
1927
1928
1929
1930
1931

1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946


1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968


1969
1970

1971
1972
1973
1974
1975



1976
1977
1978


1979
1980

1981
1982
1983

1984
1985
1986
1987


1988
1989
1990


1991
1992
1993
1994
1995
1996
1997





1998
1999

2000
2001
2002

2003
2004
2005
2006


2007
2008
2009
2010
2011




2012
2013

2014
2015
2016

2017
2018

2019
2020
2021
2022

2023
2024

2025
2026
2027
2028



2029
2030
2031
2032


2033
2034
2035


2036
2037
2038
2039
2040
2041
2042
2043




2044
2045
2046
2047



2048
2049
2050
2051
2052


2053
2054
2055

2056
2057
2058

2059
2060
2061
2062
2063
2064
2065





2066
2067
2068
2069
2070
2071

2072
2073
2074
2075
2076
2077
2078
1816
1817
1818
1819
1820
1821
1822

1823

1824
1825


1826
1827
1828

1829
1830




1831
1832
1833
1834
1835

1836
1837

1838
1839



1840
1841
1842
1843




1844
1845
1846
1847
1848







1849
1850
1851
1852
1853
1854
1855
1856



1857
1858
1859
1860

1861
1862
1863
1864
1865
1866
1867
1868
1869

1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881

1882


1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904


1905
1906
1907

1908
1909
1910



1911
1912
1913
1914


1915
1916
1917

1918
1919
1920

1921
1922
1923


1924
1925
1926


1927
1928
1929
1930





1931
1932
1933
1934
1935
1936

1937
1938
1939

1940
1941
1942


1943
1944
1945




1946
1947
1948
1949
1950

1951
1952
1953

1954
1955

1956
1957
1958
1959

1960
1961

1962
1963



1964
1965
1966
1967
1968


1969
1970
1971


1972
1973
1974
1975
1976
1977




1978
1979
1980
1981
1982



1983
1984
1985
1986
1987
1988


1989
1990
1991


1992
1993
1994

1995
1996
1997





1998
1999
2000
2001
2002
2003
2004
2005
2006
2007

2008
2009
2010
2011
2012
2013
2014
2015







-

-
+

-
-
+
+

-
+

-
-
-
-
+
+
+
+

-
+

-
+

-
-
-
+
+
+

-
-
-
-
+
+
+
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
-
+
+
+

-
+








-
+











-

-
-
+
+




















-
-
+
+

-
+


-
-
-
+
+
+

-
-
+
+

-
+


-
+


-
-
+
+

-
-
+
+


-
-
-
-
-
+
+
+
+
+

-
+


-
+


-
-
+
+

-
-
-
-
+
+
+
+

-
+


-
+

-
+



-
+

-
+

-
-
-
+
+
+


-
-
+
+

-
-
+
+




-
-
-
-
+
+
+
+

-
-
-
+
+
+



-
-
+
+

-
-
+


-
+


-
-
-
-
-
+
+
+
+
+





-
+







 * Results:  Ssl configured and loaded
 *
 * Side effects:
 *	 create the ssl command, initialize ssl context
 *
 *-------------------------------------------------------------------
 */

DLLEXPORT int Tls_Init(Tcl_Interp *interp) {
	const char tlsTclInitScript[] = {
    const char tlsTclInitScript[] = {
#include "tls.tcl.h"
            0x00
	};
	0x00
    };

        dprintf("Called");
    dprintf("Called");

	/*
	 * We only support Tcl 8.4 or newer
	 */
	if (
    /*
     * We only support Tcl 8.4 or newer
     */
    if (
#ifdef USE_TCL_STUBS
	    Tcl_InitStubs(interp, "8.4", 0)
	Tcl_InitStubs(interp, "8.4", 0)
#else
	    Tcl_PkgRequire(interp, "Tcl", "8.4-", 0)
	Tcl_PkgRequire(interp, "Tcl", "8.4-", 0)
#endif
	     == NULL) {
		return TCL_ERROR;
	}
	 == NULL) {
	return TCL_ERROR;
    }

	if (TlsLibInit(0) != TCL_OK) {
		Tcl_AppendResult(interp, "could not initialize SSL library", NULL);
		return TCL_ERROR;
	}
    if (TlsLibInit(0) != TCL_OK) {
	Tcl_AppendResult(interp, "could not initialize SSL library", NULL);
	return TCL_ERROR;
    }

	Tcl_CreateObjCommand(interp, "tls::ciphers", CiphersObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
	Tcl_CreateObjCommand(interp, "tls::handshake", HandshakeObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
	Tcl_CreateObjCommand(interp, "tls::import", ImportObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
	Tcl_CreateObjCommand(interp, "tls::unimport", UnimportObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
	Tcl_CreateObjCommand(interp, "tls::status", StatusObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
	Tcl_CreateObjCommand(interp, "tls::version", VersionObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
	Tcl_CreateObjCommand(interp, "tls::misc", MiscObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "tls::ciphers", CiphersObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "tls::handshake", HandshakeObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "tls::import", ImportObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "tls::unimport", UnimportObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "tls::status", StatusObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "tls::version", VersionObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "tls::misc", MiscObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);

	if (interp) {
		Tcl_Eval(interp, tlsTclInitScript);
	}
    if (interp) {
	Tcl_Eval(interp, tlsTclInitScript);
    }

	return(Tcl_PkgProvide(interp, "tls", PACKAGE_VERSION));
    return(Tcl_PkgProvide(interp, "tls", PACKAGE_VERSION));
}

/*
 *------------------------------------------------------*
 *
 *	Tls_SafeInit --
 *
 *	------------------------------------------------*
 *	Standard procedure required by 'load'. 
 *	Standard procedure required by 'load'.
 *	Initializes this extension for a safe interpreter.
 *	------------------------------------------------*
 *
 *	Side effects:
 *		As of 'Tls_Init'
 *
 *	Result:
 *		A standard Tcl error code.
 *
 *------------------------------------------------------*
 */

DLLEXPORT int Tls_SafeInit(Tcl_Interp *interp) {
	dprintf("Called");
	return(Tls_Init(interp));
    dprintf("Called");
    return(Tls_Init(interp));
}

/*
 *------------------------------------------------------*
 *
 *	TlsLibInit --
 *
 *	------------------------------------------------*
 *	Initializes SSL library once per application
 *	------------------------------------------------*
 *
 *	Side effects:
 *		initializes SSL library
 *
 *	Result:
 *		none
 *
 *------------------------------------------------------*
 */
static int TlsLibInit(int uninitialize) {
	static int initialized = 0;
	int status = TCL_OK;
    static int initialized = 0;
    int status = TCL_OK;
#if defined(OPENSSL_THREADS) && defined(TCL_THREADS)
	size_t num_locks;
    size_t num_locks;
#endif

	if (uninitialize) {
		if (!initialized) {
			dprintf("Asked to uninitialize, but we are not initialized");
    if (uninitialize) {
        if (!initialized) {
            dprintf("Asked to uninitialize, but we are not initialized");

			return(TCL_OK);
		}
            return(TCL_OK);
        }

		dprintf("Asked to uninitialize");
        dprintf("Asked to uninitialize");

#if defined(OPENSSL_THREADS) && defined(TCL_THREADS)
		Tcl_MutexLock(&init_mx);
        Tcl_MutexLock(&init_mx);

#if OPENSSL_VERSION_NUMBER < 0x10000000L
		CRYPTO_set_locking_callback(NULL);
		CRYPTO_set_id_callback(NULL);
        CRYPTO_set_locking_callback(NULL);
        CRYPTO_set_id_callback(NULL);
#elif OPENSSL_VERSION_NUMBER < 0x10100000L
		CRYPTO_set_locking_callback(NULL);
		CRYPTO_THREADID_set_callback(NULL)
        CRYPTO_set_locking_callback(NULL);
        CRYPTO_THREADID_set_callback(NULL)
#endif

		if (locks) {
			free(locks);
			locks = NULL;
			locksCount = 0;
		}
        if (locks) {
            free(locks);
            locks = NULL;
            locksCount = 0;
        }
#endif
		initialized = 0;
        initialized = 0;

#if defined(OPENSSL_THREADS) && defined(TCL_THREADS)
		Tcl_MutexUnlock(&init_mx);
        Tcl_MutexUnlock(&init_mx);
#endif

		return(TCL_OK);
	}
        return(TCL_OK);
    }

	if (initialized) {
		dprintf("Called, but using cached value");
		return(status);
	}
    if (initialized) {
        dprintf("Called, but using cached value");
        return(status);
    }

	dprintf("Called");
    dprintf("Called");

#if defined(OPENSSL_THREADS) && defined(TCL_THREADS)
	Tcl_MutexLock(&init_mx);
    Tcl_MutexLock(&init_mx);
#endif
	initialized = 1;
    initialized = 1;

#if defined(OPENSSL_THREADS) && defined(TCL_THREADS)
#if OPENSSL_VERSION_NUMBER < 0x10100000L
	num_locks = CRYPTO_num_locks();
    num_locks = CRYPTO_num_locks();
#else
	num_locks = 1;
    num_locks = 1;
#endif
	locksCount = (int) num_locks;
	locks = malloc(sizeof(*locks) * num_locks);
	memset(locks, 0, sizeof(*locks) * num_locks);
    locksCount = (int) num_locks;
    locks = malloc(sizeof(*locks) * num_locks);
    memset(locks, 0, sizeof(*locks) * num_locks);

#if OPENSSL_VERSION_NUMBER < 0x10000000L
	CRYPTO_set_locking_callback(CryptoThreadLockCallback);
	CRYPTO_set_id_callback(CryptoThreadIdCallback);
    CRYPTO_set_locking_callback(CryptoThreadLockCallback);
    CRYPTO_set_id_callback(CryptoThreadIdCallback);
#elif OPENSSL_VERSION_NUMBER < 0x10100000L
	CRYPTO_set_locking_callback(CryptoThreadLockCallback);
	CRYPTO_THREADID_set_callback(CryptoThreadIdCallback)
    CRYPTO_set_locking_callback(CryptoThreadLockCallback);
    CRYPTO_THREADID_set_callback(CryptoThreadIdCallback)
#endif
#endif

# if OPENSSL_VERSION_NUMBER < 0x10100000L
	if (SSL_library_init() != 1) {
		status = TCL_ERROR;
		goto done;
	}
    if (SSL_library_init() != 1) {
        status = TCL_ERROR;
        goto done;
    }
#else
	/* Initialize BOTH libcrypto and libssl. */
	OPENSSL_init_ssl(OPENSSL_INIT_LOAD_SSL_STRINGS | OPENSSL_INIT_LOAD_CRYPTO_STRINGS
	    | OPENSSL_INIT_ADD_ALL_CIPHERS | OPENSSL_INIT_ADD_ALL_DIGESTS, NULL);
    /* Initialize BOTH libcrypto and libssl. */
    OPENSSL_init_ssl(OPENSSL_INIT_LOAD_SSL_STRINGS | OPENSSL_INIT_LOAD_CRYPTO_STRINGS
	| OPENSSL_INIT_ADD_ALL_CIPHERS | OPENSSL_INIT_ADD_ALL_DIGESTS, NULL);
#endif

# if OPENSSL_VERSION_NUMBER < 0x10100000L
	SSL_load_error_strings();
	ERR_load_crypto_strings();
    SSL_load_error_strings();
    ERR_load_crypto_strings();
#else
	/* Only initialize libcrypto  */
	OPENSSL_init_crypto(OPENSSL_INIT_LOAD_CRYPTO_STRINGS, NULL);
    OPENSSL_init_crypto(OPENSSL_INIT_LOAD_CRYPTO_STRINGS, NULL);
#endif

	BIO_new_tcl(NULL, 0);
    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
	 */
    /*
     * XXX:TODO: Remove this code and replace it with a check
     * for enough entropy and do not try to create our own
     * 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 
     * 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++) {
Modified tls.h from [625cff2305] to [bcbadd0481].
11
12
13
14
15
16
17

18
19
20
21
22
23
24
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25







+







 * to enhance it to support full fileevent semantics.
 *
 * Also work done by the follow people provided the impetus to do this "right":-
 *	tclSSL (Colin McCormack, Shared Technology)
 *	SSLtcl (Peter Antman)
 *
 */
 
#ifndef _TLS_H
#define _TLS_H

#include <tcl.h>

/*
 * Initialization routines -- our entire public C API.
Modified tls.tcl from [6d0b26dfc0] to [3524eca483].
1
2

3
4
5
6
7

8
9
10
11
12
13
14
1

2
3
4
5
6

7
8
9
10
11
12
13
14

-
+




-
+







#
# Copyright (C) 1997-2000 Matt Newman <matt@novadigm.com> 
# Copyright (C) 1997-2000 Matt Newman <matt@novadigm.com>
#
namespace eval tls {
    variable logcmd tclLog
    variable debug 0
 

    # Default flags passed to tls::import
    variable defaults {}

    # Maps UID to Server Socket
    variable srvmap
    variable srvuid 0

96
97
98
99
100
101
102
103

104
105
106
107
108
109
110
96
97
98
99
100
101
102

103
104
105
106
107
108
109
110







-
+







        }

        switch -- $ruleVarArgsToConsume {
            0 {
                set argToExecute {
                    lappend @VAR@ $arg
                    set argsArray($arg) true
                } 
                }
            }
            1 {
                set argToExecute {
                    incr idx
                    if {$idx >= [llength $args]} {
                        return -code error "\"$arg\" option must be followed by value"
                    }
Modified tlsBIO.c from [71885cfb41] to [2e81a5f072].
12
13
14
15
16
17
18
19
20
21



22
23
24
25
26
27
28
29
30
31
32
33



34
35

36
37

38
39

40
41
42


43
44

45
46

47
48
49
50
51
52
53
54
55
56
57












58
59
60
61
62
63
64
65
66









67
68
69
70



71
72
73
74



75
76

77
78
79
80
81
82



83
84

85
86

87
88
89
90



91
92

93
94
95


96
97

98
99

100
101
102
103
104
105
106
107
108
109
110












111
112
113
114
115
116
117
118
119









120
121
122
123



124
125
126
127



128
129

130
131

132
133
134
135

136
137

138
139
140
141
142


143
144

145
146
147
148
149
150
151




152
153
154
155


156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183


























184
185
186
187



188
189
190
191
192
193
194
195
196
197
198
199











200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218


















219
220
221
222
223




224
225
226
227
228
229




230
231
232
233
234
235





236
237

238
239
240
241

242
243
244
245



246
247

248
249
250
251
252
253



254
255

256
257
258
259
260
261





262
263
264
265



266
267

268
269
270
271
272


273
274
275
276
277
278
279






280
281
282

283
284
285
286
287
288
289
290
291
292









293
294
295


296
297
298


299
300
301
302
303
304
305
306






307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322















323
324
325
326
327
328
329






330
331

332
333
334
335
336
337




338
339

340
12
13
14
15
16
17
18



19
20
21
22
23
24
25
26
27
28
29
30



31
32
33
34

35
36

37
38

39
40


41
42
43

44
45

46
47










48
49
50
51
52
53
54
55
56
57
58
59
60








61
62
63
64
65
66
67
68
69
70



71
72
73
74



75
76
77


78
79
80
81



82
83
84
85

86
87

88
89



90
91
92
93

94
95


96
97
98

99
100

101
102










103
104
105
106
107
108
109
110
111
112
113
114
115








116
117
118
119
120
121
122
123
124
125



126
127
128
129



130
131
132
133

134
135

136
137
138
139

140
141

142
143
144
145


146
147
148

149
150
151
152




153
154
155
156
157
158


159
160
161
162


























163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189



190
191
192
193











194
195
196
197
198
199
200
201
202
203
204
205


















206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224




225
226
227
228
229
230




231
232
233
234
235





236
237
238
239
240


241
242
243
244

245
246



247
248
249


250
251
252
253



254
255
256
257

258
259





260
261
262
263
264
265



266
267
268


269
270
271
272


273
274
275






276
277
278
279
280
281
282
283

284
285









286
287
288
289
290
291
292
293
294
295


296
297
298


299
300
301
302






303
304
305
306
307
308
309















310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325






326
327
328
329
330
331
332

333
334
335




336
337
338
339


340
341







-
-
-
+
+
+









-
-
-
+
+
+

-
+

-
+

-
+

-
-
+
+

-
+

-
+

-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+

-
-
-
+
+
+

-
-
-
+
+
+
-
-
+



-
-
-
+
+
+

-
+

-
+

-
-
-
+
+
+

-
+

-
-
+
+

-
+

-
+

-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+

-
-
-
+
+
+

-
-
-
+
+
+

-
+

-
+



-
+

-
+



-
-
+
+

-
+



-
-
-
-
+
+
+
+


-
-
+
+


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
+
+
+

-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
+
+
+
+


-
-
-
-
+
+
+
+

-
-
-
-
-
+
+
+
+
+
-
-
+



-
+

-
-
-
+
+
+
-
-
+



-
-
-
+
+
+

-
+

-
-
-
-
-
+
+
+
+
+

-
-
-
+
+
+
-
-
+



-
-
+
+

-
-
-
-
-
-
+
+
+
+
+
+


-
+

-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+

-
-
+
+

-
-
+
+


-
-
-
-
-
-
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
+
+
+
+
+
+

-
+


-
-
-
-
+
+
+
+
-
-
+

#define BIO_get_shutdown(bio)            ((bio)->shutdown)
#define BIO_set_data(bio, val)           (bio)->ptr = (val)
#define BIO_set_init(bio, val)           (bio)->init = (val)
#define BIO_set_shutdown(bio, val)       (bio)->shutdown = (val)

/* XXX: This assumes the variable being assigned to is BioMethods */
#define BIO_meth_new(type_, name_)       (BIO_METHOD *)Tcl_Alloc(sizeof(BIO_METHOD)); \
                                         memset(BioMethods, 0, sizeof(BIO_METHOD)); \
                                         BioMethods->type = type_; \
                                         BioMethods->name = name_;
					 memset(BioMethods, 0, sizeof(BIO_METHOD)); \
					 BioMethods->type = type_; \
					 BioMethods->name = name_;
#define BIO_meth_set_write(bio, val)     (bio)->bwrite = val;
#define BIO_meth_set_read(bio, val)      (bio)->bread = val;
#define BIO_meth_set_puts(bio, val)      (bio)->bputs = val;
#define BIO_meth_set_ctrl(bio, val)      (bio)->ctrl = val;
#define BIO_meth_set_create(bio, val)    (bio)->create = val;
#define BIO_meth_set_destroy(bio, val)   (bio)->destroy = val;
#endif

static int BioWrite(BIO *bio, const char *buf, int bufLen) {
	Tcl_Channel chan;
	int ret;
	int tclEofChan, tclErrno;
    Tcl_Channel chan;
    int ret;
    int tclEofChan, tclErrno;

	chan = Tls_GetParent((State *) BIO_get_data(bio), 0);
    chan = Tls_GetParent((State *) BIO_get_data(bio), 0);

	dprintf("[chan=%p] BioWrite(%p, <buf>, %d)", (void *)chan, (void *) bio, bufLen);
    dprintf("[chan=%p] BioWrite(%p, <buf>, %d)", (void *)chan, (void *) bio, bufLen);

	ret = Tcl_WriteRaw(chan, buf, bufLen);
    ret = Tcl_WriteRaw(chan, buf, bufLen);

	tclEofChan = Tcl_Eof(chan);
	tclErrno = Tcl_GetErrno();
    tclEofChan = Tcl_Eof(chan);
    tclErrno = Tcl_GetErrno();

	dprintf("[chan=%p] BioWrite(%d) -> %d [tclEof=%d; tclErrno=%d]", (void *) chan, bufLen, ret, tclEofChan, Tcl_GetErrno());
    dprintf("[chan=%p] BioWrite(%d) -> %d [tclEof=%d; tclErrno=%d]", (void *) chan, bufLen, ret, tclEofChan, Tcl_GetErrno());

	BIO_clear_flags(bio, BIO_FLAGS_WRITE | BIO_FLAGS_SHOULD_RETRY);
    BIO_clear_flags(bio, BIO_FLAGS_WRITE | BIO_FLAGS_SHOULD_RETRY);

	if (tclEofChan && ret <= 0) {
		dprintf("Got EOF while reading, returning a Connection Reset error which maps to Soft EOF");
		Tcl_SetErrno(ECONNRESET);
		ret = 0;
	} else if (ret == 0) {
		dprintf("Got 0 from Tcl_WriteRaw, and EOF is not set; ret = 0");
		dprintf("Setting retry read flag");
		BIO_set_retry_read(bio);
	} else if (ret < 0) {
		dprintf("We got some kind of I/O error");
    if (tclEofChan && ret <= 0) {
	dprintf("Got EOF while reading, returning a Connection Reset error which maps to Soft EOF");
	Tcl_SetErrno(ECONNRESET);
	ret = 0;

    } else if (ret == 0) {
	dprintf("Got 0 from Tcl_WriteRaw, and EOF is not set; ret = 0");
	dprintf("Setting retry read flag");
	BIO_set_retry_read(bio);

    } else if (ret < 0) {
	dprintf("We got some kind of I/O error");

		if (tclErrno == EAGAIN) {
			dprintf("It's EAGAIN");
		} else {
			dprintf("It's an unepxected error: %s/%i", Tcl_ErrnoMsg(tclErrno), tclErrno);
		}
	} else {
		dprintf("Successfully wrote some data");
	}
	if (tclErrno == EAGAIN) {
	    dprintf("It's EAGAIN");
	} else {
	    dprintf("It's an unepxected error: %s/%i", Tcl_ErrnoMsg(tclErrno), tclErrno);
	}

    } else {
	dprintf("Successfully wrote some data");
    }

	if (ret != -1 || (ret == -1 && tclErrno == EAGAIN)) {
		if (BIO_should_read(bio)) {
			dprintf("Setting should retry read flag");
    if (ret != -1 || (ret == -1 && tclErrno == EAGAIN)) {
	if (BIO_should_read(bio)) {
	    dprintf("Setting should retry read flag");

			BIO_set_retry_read(bio);
		}
	}
	    BIO_set_retry_read(bio);
	}
    }

	return(ret);
    return(ret);
}

static int BioRead(BIO *bio, char *buf, int bufLen) {
	Tcl_Channel chan;
	int ret = 0;
	int tclEofChan, tclErrno;
    Tcl_Channel chan;
    int ret = 0;
    int tclEofChan, tclErrno;

	chan = Tls_GetParent((State *) BIO_get_data(bio), 0);
    chan = Tls_GetParent((State *) BIO_get_data(bio), 0);

	dprintf("[chan=%p] BioRead(%p, <buf>, %d)", (void *) chan, (void *) bio, bufLen);
    dprintf("[chan=%p] BioRead(%p, <buf>, %d)", (void *) chan, (void *) bio, bufLen);

	if (buf == NULL) {
		return 0;
	}
    if (buf == NULL) {
	return 0;
    }

	ret = Tcl_ReadRaw(chan, buf, bufLen);
    ret = Tcl_ReadRaw(chan, buf, bufLen);

	tclEofChan = Tcl_Eof(chan);
	tclErrno = Tcl_GetErrno();
    tclEofChan = Tcl_Eof(chan);
    tclErrno = Tcl_GetErrno();

	dprintf("[chan=%p] BioRead(%d) -> %d [tclEof=%d; tclErrno=%d]", (void *) chan, bufLen, ret, tclEofChan, tclErrno);
    dprintf("[chan=%p] BioRead(%d) -> %d [tclEof=%d; tclErrno=%d]", (void *) chan, bufLen, ret, tclEofChan, tclErrno);

	BIO_clear_flags(bio, BIO_FLAGS_READ | BIO_FLAGS_SHOULD_RETRY);
    BIO_clear_flags(bio, BIO_FLAGS_READ | BIO_FLAGS_SHOULD_RETRY);

	if (tclEofChan && ret <= 0) {
		dprintf("Got EOF while reading, returning a Connection Reset error which maps to Soft EOF");
		Tcl_SetErrno(ECONNRESET);
		ret = 0;
	} else if (ret == 0) {
		dprintf("Got 0 from Tcl_Read or Tcl_ReadRaw, and EOF is not set; ret = 0");
		dprintf("Setting retry read flag");
		BIO_set_retry_read(bio);
	} else if (ret < 0) {
		dprintf("We got some kind of I/O error");
    if (tclEofChan && ret <= 0) {
	dprintf("Got EOF while reading, returning a Connection Reset error which maps to Soft EOF");
	Tcl_SetErrno(ECONNRESET);
	ret = 0;

    } else if (ret == 0) {
	dprintf("Got 0 from Tcl_Read or Tcl_ReadRaw, and EOF is not set; ret = 0");
	dprintf("Setting retry read flag");
	BIO_set_retry_read(bio);

    } else if (ret < 0) {
	dprintf("We got some kind of I/O error");

		if (tclErrno == EAGAIN) {
			dprintf("It's EAGAIN");
		} else {
			dprintf("It's an unepxected error: %s/%i", Tcl_ErrnoMsg(tclErrno), tclErrno);
		}
	} else {
		dprintf("Successfully read some data");
	}
	if (tclErrno == EAGAIN) {
	    dprintf("It's EAGAIN");
	} else {
	    dprintf("It's an unepxected error: %s/%i", Tcl_ErrnoMsg(tclErrno), tclErrno);
	}

    } else {
	dprintf("Successfully read some data");
    }

	if (ret != -1 || (ret == -1 && tclErrno == EAGAIN)) {
		if (BIO_should_write(bio)) {
			dprintf("Setting should retry write flag");
    if (ret != -1 || (ret == -1 && tclErrno == EAGAIN)) {
	if (BIO_should_write(bio)) {
	    dprintf("Setting should retry write flag");

			BIO_set_retry_write(bio);
		}
	}
	    BIO_set_retry_write(bio);
	}
    }

	dprintf("BioRead(%p, <buf>, %d) [%p] returning %i", (void *) bio, bufLen, (void *) chan, ret);
    dprintf("BioRead(%p, <buf>, %d) [%p] returning %i", (void *) bio, bufLen, (void *) chan, ret);

	return(ret);
    return(ret);
}

static int BioPuts(BIO *bio, const char *str) {
	dprintf("BioPuts(%p, <string:%p>) called", bio, str);
    dprintf("BioPuts(%p, <string:%p>) called", bio, str);

	return BioWrite(bio, str, (int) strlen(str));
    return BioWrite(bio, str, (int) strlen(str));
}

static long BioCtrl(BIO *bio, int cmd, long num, void *ptr) {
	Tcl_Channel chan;
	long ret = 1;
    Tcl_Channel chan;
    long ret = 1;

	chan = Tls_GetParent((State *) BIO_get_data(bio), 0);
    chan = Tls_GetParent((State *) BIO_get_data(bio), 0);

	dprintf("BioCtrl(%p, 0x%x, 0x%lx, %p)", (void *) bio, cmd, num, ptr);

	switch (cmd) {
		case BIO_CTRL_RESET:
			dprintf("Got BIO_CTRL_RESET");
			num = 0;
    switch (cmd) {
	case BIO_CTRL_RESET:
	    dprintf("Got BIO_CTRL_RESET");
	    num = 0;
			ret = 0;
			break;
		case BIO_C_FILE_SEEK:
			dprintf("Got BIO_C_FILE_SEEK");
	case BIO_C_FILE_SEEK:
	    dprintf("Got BIO_C_FILE_SEEK");
			ret = 0;
			break;
		case BIO_C_FILE_TELL:
			dprintf("Got BIO_C_FILE_TELL");
			ret = 0;
			break;
		case BIO_CTRL_INFO:
			dprintf("Got BIO_CTRL_INFO");
			ret = 1;
			break;
		case BIO_C_SET_FD:
			dprintf("Unsupported call: BIO_C_SET_FD");
			ret = -1;
			break;
		case BIO_C_GET_FD:
			dprintf("Unsupported call: BIO_C_GET_FD");
			ret = -1;
			break;
		case BIO_CTRL_GET_CLOSE:
			dprintf("Got BIO_CTRL_CLOSE");
			ret = BIO_get_shutdown(bio);
			break;
		case BIO_CTRL_SET_CLOSE:
			dprintf("Got BIO_SET_CLOSE");
			BIO_set_shutdown(bio, num);
			break;
		case BIO_CTRL_EOF:
			dprintf("Got BIO_CTRL_EOF");
	case BIO_C_FILE_TELL:
	    dprintf("Got BIO_C_FILE_TELL");
	    ret = 0;
	    break;
	case BIO_CTRL_INFO:
	    dprintf("Got BIO_CTRL_INFO");
	    ret = 1;
	    break;
	case BIO_C_SET_FD:
	    dprintf("Unsupported call: BIO_C_SET_FD");
	    ret = -1;
	    break;
	case BIO_C_GET_FD:
	    dprintf("Unsupported call: BIO_C_GET_FD");
	    ret = -1;
	    break;
	case BIO_CTRL_GET_CLOSE:
	    dprintf("Got BIO_CTRL_CLOSE");
	    ret = BIO_get_shutdown(bio);
	    break;
	case BIO_CTRL_SET_CLOSE:
	    dprintf("Got BIO_SET_CLOSE");
	    BIO_set_shutdown(bio, num);
	    break;
	case BIO_CTRL_EOF:
	    dprintf("Got BIO_CTRL_EOF");
			ret = ((chan) ? Tcl_Eof(chan) : 1);
			break;
		case BIO_CTRL_PENDING:
			dprintf("Got BIO_CTRL_PENDING");
	    break;
	case BIO_CTRL_PENDING:
	    dprintf("Got BIO_CTRL_PENDING");
			ret = ((chan) ? ((Tcl_InputBuffered(chan) ? 1 : 0)) : 0);
			dprintf("BIO_CTRL_PENDING(%d)", (int) ret);
			break;
		case BIO_CTRL_WPENDING:
			dprintf("Got BIO_CTRL_WPENDING");
			ret = 0;
			break;
		case BIO_CTRL_DUP:
			dprintf("Got BIO_CTRL_DUP");
			break;
		case BIO_CTRL_FLUSH:
			dprintf("Got BIO_CTRL_FLUSH");
	    dprintf("BIO_CTRL_PENDING(%d)", (int) ret);
	    break;
	case BIO_CTRL_WPENDING:
	    dprintf("Got BIO_CTRL_WPENDING");
	    ret = 0;
	    break;
	case BIO_CTRL_DUP:
	    dprintf("Got BIO_CTRL_DUP");
	    break;
	case BIO_CTRL_FLUSH:
	    dprintf("Got BIO_CTRL_FLUSH");
			ret = ((chan) && (Tcl_WriteRaw(chan, "", 0) >= 0) ? 1 : -1);
			dprintf("BIO_CTRL_FLUSH returning value %li", ret);
			break;
		case BIO_CTRL_PUSH:
			dprintf("Got BIO_CTRL_PUSH");
			ret = 0;
			break;
		case BIO_CTRL_POP:
			dprintf("Got BIO_CTRL_POP");
			ret = 0;
			break;
		case BIO_CTRL_SET:
			dprintf("Got BIO_CTRL_SET");
			ret = 0;
			break;
		case BIO_CTRL_GET :
			dprintf("Got BIO_CTRL_GET ");
			ret = 0;
			break;
	    dprintf("BIO_CTRL_FLUSH returning value %li", ret);
	    break;
	case BIO_CTRL_PUSH:
	    dprintf("Got BIO_CTRL_PUSH");
	    ret = 0;
	    break;
	case BIO_CTRL_POP:
	    dprintf("Got BIO_CTRL_POP");
	    ret = 0;
	    break;
	case BIO_CTRL_SET:
	    dprintf("Got BIO_CTRL_SET");
	    ret = 0;
	    break;
	case BIO_CTRL_GET :
	    dprintf("Got BIO_CTRL_GET ");
	    ret = 0;
	    break;
#ifdef BIO_CTRL_GET_KTLS_SEND
		case BIO_CTRL_GET_KTLS_SEND:
			dprintf("Got BIO_CTRL_GET_KTLS_SEND");
			ret = 0;
			break;
	case BIO_CTRL_GET_KTLS_SEND:
	    dprintf("Got BIO_CTRL_GET_KTLS_SEND");
	    ret = 0;
	    break;
#endif
#ifdef BIO_CTRL_GET_KTLS_RECV
		case BIO_CTRL_GET_KTLS_RECV:
			dprintf("Got BIO_CTRL_GET_KTLS_RECV");
			ret = 0;
			break;
	case BIO_CTRL_GET_KTLS_RECV:
	    dprintf("Got BIO_CTRL_GET_KTLS_RECV");
	    ret = 0;
	    break;
#endif
		default:
			dprintf("Got unknown control command (%i)", cmd);
			ret = 0;
			break;
	}
	default:
	    dprintf("Got unknown control command (%i)", cmd);
	    ret = 0;
	    break;
    }

	return(ret);
    return(ret);
}

static int BioNew(BIO *bio) {
	dprintf("BioNew(%p) called", bio);
    dprintf("BioNew(%p) called", bio);

	BIO_set_init(bio, 0);
	BIO_set_data(bio, NULL);
	BIO_clear_flags(bio, -1);
    BIO_set_init(bio, 0);
    BIO_set_data(bio, NULL);
    BIO_clear_flags(bio, -1);

	return(1);
    return(1);
}

static int BioFree(BIO *bio) {
	if (bio == NULL) {
		return(0);
	}
    if (bio == NULL) {
	return(0);
    }

	dprintf("BioFree(%p) called", bio);
    dprintf("BioFree(%p) called", bio);

	if (BIO_get_shutdown(bio)) {
		if (BIO_get_init(bio)) {
			/*shutdown(bio->num, 2) */
			/*closesocket(bio->num) */
		}
    if (BIO_get_shutdown(bio)) {
	if (BIO_get_init(bio)) {
	    /*shutdown(bio->num, 2) */
	    /*closesocket(bio->num) */
	}

		BIO_set_init(bio, 0);
		BIO_clear_flags(bio, -1);
	}
	BIO_set_init(bio, 0);
	BIO_clear_flags(bio, -1);
    }

	return(1);
    return(1);
}

BIO *BIO_new_tcl(State *statePtr, int flags) {
	BIO *bio;
	static BIO_METHOD *BioMethods = NULL;
    BIO *bio;
    static BIO_METHOD *BioMethods = NULL;
#ifdef TCLTLS_SSL_USE_FASTPATH
	Tcl_Channel parentChannel;
	const Tcl_ChannelType *parentChannelType;
	void *parentChannelFdIn_p, *parentChannelFdOut_p;
	int parentChannelFdIn, parentChannelFdOut, parentChannelFd;
	int validParentChannelFd;
	int tclGetChannelHandleRet;
    Tcl_Channel parentChannel;
    const Tcl_ChannelType *parentChannelType;
    void *parentChannelFdIn_p, *parentChannelFdOut_p;
    int parentChannelFdIn, parentChannelFdOut, parentChannelFd;
    int validParentChannelFd;
    int tclGetChannelHandleRet;
#endif

	dprintf("BIO_new_tcl() called");
    dprintf("BIO_new_tcl() called");

	if (BioMethods == NULL) {
		BioMethods = BIO_meth_new(BIO_TYPE_TCL, "tcl");
		BIO_meth_set_write(BioMethods, BioWrite);
		BIO_meth_set_read(BioMethods, BioRead);
		BIO_meth_set_puts(BioMethods, BioPuts);
		BIO_meth_set_ctrl(BioMethods, BioCtrl);
		BIO_meth_set_create(BioMethods, BioNew);
		BIO_meth_set_destroy(BioMethods, BioFree);
	}
    if (BioMethods == NULL) {
	BioMethods = BIO_meth_new(BIO_TYPE_TCL, "tcl");
	BIO_meth_set_write(BioMethods, BioWrite);
	BIO_meth_set_read(BioMethods, BioRead);
	BIO_meth_set_puts(BioMethods, BioPuts);
	BIO_meth_set_ctrl(BioMethods, BioCtrl);
	BIO_meth_set_create(BioMethods, BioNew);
	BIO_meth_set_destroy(BioMethods, BioFree);
    }

	if (statePtr == NULL) {
		dprintf("Asked to setup a NULL state, just creating the initial configuration");
    if (statePtr == NULL) {
	dprintf("Asked to setup a NULL state, just creating the initial configuration");

		return(NULL);
	}
	return(NULL);
    }

#ifdef TCLTLS_SSL_USE_FASTPATH
	/*
	 * If the channel can be mapped back to a file descriptor, just use the file descriptor
	 * with the SSL library since it will likely be optimized for this.
	 */
	parentChannel = Tls_GetParent(statePtr, 0);
	parentChannelType = Tcl_GetChannelType(parentChannel);
    /*
     * If the channel can be mapped back to a file descriptor, just use the file descriptor
     * with the SSL library since it will likely be optimized for this.
     */
    parentChannel = Tls_GetParent(statePtr, 0);
    parentChannelType = Tcl_GetChannelType(parentChannel);

	validParentChannelFd = 0;
	if (strcmp(parentChannelType->typeName, "tcp") == 0) {
		tclGetChannelHandleRet = Tcl_GetChannelHandle(parentChannel, TCL_READABLE, (ClientData) &parentChannelFdIn_p);
		if (tclGetChannelHandleRet == TCL_OK) {
			tclGetChannelHandleRet = Tcl_GetChannelHandle(parentChannel, TCL_WRITABLE, (ClientData) &parentChannelFdOut_p);
			if (tclGetChannelHandleRet == TCL_OK) {
				parentChannelFdIn = PTR2INT(parentChannelFdIn_p);
				parentChannelFdOut = PTR2INT(parentChannelFdOut_p);
				if (parentChannelFdIn == parentChannelFdOut) {
					parentChannelFd = parentChannelFdIn;
					validParentChannelFd = 1;
				}
			}
		}
	}
    validParentChannelFd = 0;
    if (strcmp(parentChannelType->typeName, "tcp") == 0) {
	tclGetChannelHandleRet = Tcl_GetChannelHandle(parentChannel, TCL_READABLE, (ClientData) &parentChannelFdIn_p);
	if (tclGetChannelHandleRet == TCL_OK) {
	    tclGetChannelHandleRet = Tcl_GetChannelHandle(parentChannel, TCL_WRITABLE, (ClientData) &parentChannelFdOut_p);
	    if (tclGetChannelHandleRet == TCL_OK) {
		parentChannelFdIn = PTR2INT(parentChannelFdIn_p);
		parentChannelFdOut = PTR2INT(parentChannelFdOut_p);
		if (parentChannelFdIn == parentChannelFdOut) {
		    parentChannelFd = parentChannelFdIn;
		    validParentChannelFd = 1;
		}
	    }
	}
    }

	if (validParentChannelFd) {
		dprintf("We found a shortcut, this channel is backed by a socket: %i", parentChannelFdIn);
		bio = BIO_new_socket(parentChannelFd, flags);
		statePtr->flags |= TLS_TCL_FASTPATH;
		return(bio);
	}
    if (validParentChannelFd) {
	dprintf("We found a shortcut, this channel is backed by a socket: %i", parentChannelFdIn);
	bio = BIO_new_socket(parentChannelFd, flags);
	statePtr->flags |= TLS_TCL_FASTPATH;
	return(bio);
    }

	dprintf("Falling back to Tcl I/O for this channel");
    dprintf("Falling back to Tcl I/O for this channel");
#endif

	bio = BIO_new(BioMethods);
	BIO_set_data(bio, statePtr);
	BIO_set_shutdown(bio, flags);
	BIO_set_init(bio, 1);
    bio = BIO_new(BioMethods);
    BIO_set_data(bio, statePtr);
    BIO_set_shutdown(bio, flags);
    BIO_set_init(bio, 1);

	return(bio);
    return(bio);
}
Modified tlsIO.c from [cfd328a393] to [ff0429678e].
8
9
10
11
12
13
14
15
16


17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37

38
39
40

41
42
43

44
45
46
47
48

49
50
51
52
53
54





55
56

57
58
59
60
61
62
63
64
65
66



67
68

69
70
71

72
73
74

75
76
77
78
79

80
81

82
83
84
85



86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101

102
103
104


105
106
107


108
109
110
111
112
113
114



115
116
117


118
119
120
121
122
123





124
125
126
127
128
129
130
131
132
133
134
135
136
137
138














139
140
141
142
143




144
145
146
147




148
149
150


151
152
153


154
155

156
157
158
159
160




161
162

163
164

165
166
167
168
169
170
171
172
173
174
175
176
177
178
179














180
181
182


183
184
185


186
187

188
189
190
191



192
193
194
195



196
197
198
199



200
201
202

203
204
205
206
207
208
209
210
211
212
213










214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
















231
232

233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249


















250
251
252
253


254
255
256
257



258
259
260
261
262
263
264






265
266
267
268


269
270
271


272
273

274
275
276
277
278
279
280
281

282
283
284
285
286
287



288
289
290

291
292
293
294
295
296
297
298
299
300





301
302

303
304

305
306
307
308
309
310





311
312
313
314
315




316
317
318
319
320
321
322
323







324
325
326


327
328
329
330
331
332
333
334
335
336
337
338
339
340
341














342
343

344
345
346
347
348
349
350
351






352
353
354
355
356
357
358
359







360
361
362
363



364
365
366
367




368
369
370
371
372
373
374
375
376
377
378
379
380
381













382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399




















400
401
402


403
404
405
406
407
408
409
410

411
412
413
414
415


416
417
418

419
420
421
422
423
424
425
426
427




428
429

430
431
432


433
434
435
436
437
438
439






440
441
442
443
444




445
446
447
448
449
450
451
452







453
454
455


456
457
458
459



460
461
462


463
464
465
466
467




468
469
470
471
472




473
474
475
476
477
478
479
480
481
482
483
484
485
486
487














488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513






























514
515
516
517
518
519
520
521
522
523
524
525
526
527













528
529
530
531
532
533
534
535
536
537
538












539
540
541


542
543
544
545
546
547
548
549
550


551
552
553
554
555



556
557
558

559
560
561
562
563
564
565
566
567





568
569
570
571
572


573
574
575
576
577
578
579
580
581

582
583
584
585
586
587
588
589
590
591
592
593
594
595


596
597
598
599
600



601
602
603

604
605
606
607
608
609
610
611
612





613
614
615
616
617
618


619
620
621
622

623
624
625
626
627




628
629
630
631
632
633
634
635
636
637
638
639
640

641
642
643

644
645
646
647


648
649
650
651
652
653
654
655



656
657
658
659
660
661
662

663
664
665
666


667
668
669
670
671
672
673
674

675
676
677
678

679
680
681

682
683
684

685
686
687
688
689
690
691
692







693
694
695

696
697

698
699
700
701



702
703
704
705
706
707





708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726


727
728
729

730
731
732

733
734
735
736
737

738
739

740
741
742
743
744
745
746
747
748


749
750
751

752
753
754

755
756
757
758
759
760
761


762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
















779
780
781
782
783




784
785
786
787
788
789





790
791
792


793
794
795


796
797

798
799

800
801
802
803
804
805
806
8
9
10
11
12
13
14


15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36

37
38
39

40
41
42

43
44
45
46
47

48
49





50
51
52
53
54


55
56
57
58
59
60
61
62



63
64
65
66

67
68
69

70
71
72

73
74
75
76
77

78
79

80
81



82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99

100
101


102
103
104


105
106
107
108
109
110



111
112
113
114


115
116
117





118
119
120
121
122
123














124
125
126
127
128
129
130
131
132
133
134
135
136
137
138




139
140
141
142




143
144
145
146



147
148
149


150
151
152

153





154
155
156
157
158

159
160

161
162














163
164
165
166
167
168
169
170
171
172
173
174
175
176
177


178
179
180


181
182
183

184




185
186
187
188



189
190
191
192



193
194
195

196

197
198










199
200
201
202
203
204
205
206
207
208
209
















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

227

















228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247


248
249
250



251
252
253
254






255
256
257
258
259
260
261
262


263
264
265


266
267


268
269
270
271
272
273
274
275

276
277
278
279



280
281
282
283
284

285
286
287
288

289





290
291
292
293
294
295

296
297

298
299





300
301
302
303
304
305




306
307
308
309
310







311
312
313
314
315
316
317



318
319
320














321
322
323
324
325
326
327
328
329
330
331
332
333
334
335

336
337
338






339
340
341
342
343
344
345
346






347
348
349
350
351
352
353
354



355
356
357




358
359
360
361
362













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


















376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396


397
398
399
400
401
402
403
404
405

406
407
408
409


410
411
412
413

414
415
416
417

418




419
420
421
422
423

424
425


426
427
428






429
430
431
432
433
434
435




436
437
438
439
440







441
442
443
444
445
446
447



448
449
450



451
452
453
454


455
456
457




458
459
460
461
462




463
464
465
466
467














468
469
470
471
472
473
474
475
476
477
478
479
480
481
482

























483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513













514
515
516
517
518
519
520
521
522
523
524
525
526











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


540
541
542
543
544
545
546
547
548


549
550
551
552



553
554
555
556
557

558
559
560
561
562





563
564
565
566
567
568
569
570


571
572
573
574
575
576
577
578
579
580

581
582
583
584
585
586
587
588
589
590
591
592
593


594
595
596
597



598
599
600
601
602

603
604
605
606
607





608
609
610
611
612

613
614
615


616
617
618
619
620

621
622




623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638

639
640
641

642
643
644


645
646
647
648
649

650



651
652
653
654
655
656
657
658
659

660
661
662


663
664
665
666
667
668
669
670
671

672

673

674
675
676


677
678
679

680
681







682
683
684
685
686
687
688



689


690
691



692
693
694






695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716


717
718
719
720

721
722
723

724
725
726
727
728

729
730

731
732
733
734
735
736
737
738


739
740
741
742

743
744
745

746
747
748
749

750


751
752
753
















754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770




771
772
773
774
775





776
777
778
779
780
781


782
783
784


785
786
787

788
789

790
791
792
793
794
795
796
797







-
-
+
+




















-
+


-
+


-
+




-
+

-
-
-
-
-
+
+
+
+
+
-
-
+







-
-
-
+
+
+

-
+


-
+


-
+




-
+

-
+

-
-
-
+
+
+















-
+

-
-
+
+

-
-
+
+




-
-
-
+
+
+

-
-
+
+

-
-
-
-
-
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
+
+
+
+
-
-
-
-
+
+
+
+
-
-
-
+
+

-
-
+
+

-
+
-
-
-
-
-
+
+
+
+

-
+

-
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
+
+

-
-
+
+

-
+
-
-
-
-
+
+
+

-
-
-
+
+
+

-
-
-
+
+
+
-

-
+

-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


-
-
+
+

-
-
-
+
+
+

-
-
-
-
-
-
+
+
+
+
+
+


-
-
+
+

-
-
+
+
-
-
+







-
+



-
-
-
+
+
+


-
+



-

-
-
-
-
-
+
+
+
+
+

-
+

-
+

-
-
-
-
-
+
+
+
+
+

-
-
-
-
+
+
+
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+
-
-
-
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+


-
-
-
-
-
-
+
+
+
+
+
+


-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
-
+
+
+
-
-
-
-
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
+
+







-
+



-
-
+
+


-
+



-

-
-
-
-
+
+
+
+

-
+

-
-
+
+

-
-
-
-
-
-
+
+
+
+
+
+

-
-
-
-
+
+
+
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+
-
-
-
+
+

-
-
-
+
+
+

-
-
+
+

-
-
-
-
+
+
+
+

-
-
-
-
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+

-
-
+
+







-
-
+
+


-
-
-
+
+
+


-
+




-
-
-
-
-
+
+
+
+
+



-
-
+
+








-
+












-
-
+
+


-
-
-
+
+
+


-
+




-
-
-
-
-
+
+
+
+
+
-



-
-
+
+



-
+

-
-
-
-
+
+
+
+












-
+


-
+


-
-
+
+



-

-
-
-
+
+
+






-
+


-
-
+
+







-
+
-

-

+

-
-
+


-
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+
-
-
-
+
-
-
+

-
-
-
+
+
+
-
-
-
-
-
-
+
+
+
+
+

















-
-
+
+


-
+


-
+




-
+

-
+







-
-
+
+


-
+


-
+



-

-
-
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
+
+
+
+

-
-
-
-
-
+
+
+
+
+

-
-
+
+

-
-
+
+

-
+

-
+







 * This was built from scratch based upon observation of OpenSSL 0.9.2B
 *
 * Addition credit is due for Andreas Kupries (a.kupries@westend.com), for
 * providing the Tcl_ReplaceChannel mechanism and working closely with me
 * to enhance it to support full fileevent semantics.
 *
 * Also work done by the follow people provided the impetus to do this "right":
 *	tclSSL (Colin McCormack, Shared Technology)
 *	SSLtcl (Peter Antman)
 *    tclSSL (Colin McCormack, Shared Technology)
 *    SSLtcl (Peter Antman)
 *
 */

#include "tlsInt.h"

/*
 * Forward declarations
 */
static void TlsChannelHandlerTimer(ClientData clientData);

/*
 * TLS Channel Type
 */
static Tcl_ChannelType *tlsChannelType = NULL;

/*
 *-------------------------------------------------------------------
 *
 * TlsBlockModeProc --
 *
 *	This procedure is invoked by the generic IO level
 *    This procedure is invoked by the generic IO level
 *       to set blocking and nonblocking modes
 * Results:
 *	0 if successful, errno when failed.
 *    0 if successful, errno when failed.
 *
 * Side effects:
 *	Sets the device into blocking or nonblocking mode.
 *    Sets the device into blocking or nonblocking mode.
 *
 *-------------------------------------------------------------------
 */
static int TlsBlockModeProc(ClientData instanceData, int mode) {
	State *statePtr = (State *) instanceData;
    State *statePtr = (State *) instanceData;

	if (mode == TCL_MODE_NONBLOCKING) {
		statePtr->flags |= TLS_TCL_ASYNC;
	} else {
		statePtr->flags &= ~(TLS_TCL_ASYNC);
	}
    if (mode == TCL_MODE_NONBLOCKING) {
	statePtr->flags |= TLS_TCL_ASYNC;
    } else {
	statePtr->flags &= ~(TLS_TCL_ASYNC);
    }

	return(0);
    return(0);
}

/*
 *-------------------------------------------------------------------
 *
 * TlsCloseProc --
 *
 *	This procedure is invoked by the generic IO level to perform
 *	channel-type-specific cleanup when a SSL socket based channel
 *	is closed.
 *    This procedure is invoked by the generic IO level to perform
 *    channel-type-specific cleanup when a SSL socket based channel
 *    is closed.
 *
 *	Note: we leave the underlying socket alone, is this right?
 *    Note: we leave the underlying socket alone, is this right?
 *
 * Results:
 *	0 if successful, the value of Tcl_GetErrno() if failed.
 *    0 if successful, the value of Tcl_GetErrno() if failed.
 *
 * Side effects:
 *	Closes the socket of the channel.
 *    Closes the socket of the channel.
 *
 *-------------------------------------------------------------------
 */
static int TlsCloseProc(ClientData instanceData, Tcl_Interp *interp) {
	State *statePtr = (State *) instanceData;
    State *statePtr = (State *) instanceData;

	dprintf("TlsCloseProc(%p)", (void *) statePtr);
    dprintf("TlsCloseProc(%p)", (void *) statePtr);

	Tls_Clean(statePtr);
	Tcl_EventuallyFree((ClientData)statePtr, Tls_Free);
	return(0);
    Tls_Clean(statePtr);
    Tcl_EventuallyFree((ClientData)statePtr, Tls_Free);
    return(0);

	/* Interp is unused. */
	interp = interp;
}

static int TlsCloseProc2(ClientData instanceData, Tcl_Interp *interp, int flags) {
    if ((flags & (TCL_CLOSE_READ|TCL_CLOSE_WRITE)) == 0) {
	return TlsCloseProc(instanceData, interp);
    }
    return EINVAL;
}

/*
 *------------------------------------------------------*
 *
 *	Tls_WaitForConnect --
 *    Tls_WaitForConnect --
 *
 *	Sideeffects:
 *		Issues SSL_accept or SSL_connect
 *    Sideeffects:
 *        Issues SSL_accept or SSL_connect
 *
 *	Result:
 *		None.
 *    Result:
 *        None.
 *
 *------------------------------------------------------*
 */
int Tls_WaitForConnect(State *statePtr, int *errorCodePtr, int handshakeFailureIsPermanent) {
	unsigned long backingError;
	int err, rc;
	int bioShouldRetry;
    unsigned long backingError;
    int err, rc;
    int bioShouldRetry;

	dprintf("WaitForConnect(%p)", (void *) statePtr);
	dprintFlags(statePtr);
    dprintf("WaitForConnect(%p)", (void *) statePtr);
    dprintFlags(statePtr);

	if (!(statePtr->flags & TLS_TCL_INIT)) {
		dprintf("Tls_WaitForConnect called on already initialized channel -- returning with immediate success");
		*errorCodePtr = 0;
		return(0);
	}
    if (!(statePtr->flags & TLS_TCL_INIT)) {
	dprintf("Tls_WaitForConnect called on already initialized channel -- returning with immediate success");
	*errorCodePtr = 0;
	return(0);
    }

	if (statePtr->flags & TLS_TCL_HANDSHAKE_FAILED) {
		/*
		 * Different types of operations have different requirements
		 * SSL being established
		 */
		if (handshakeFailureIsPermanent) {
			dprintf("Asked to wait for a TLS handshake that has already failed.  Returning fatal error");
			*errorCodePtr = ECONNABORTED;
		} else {
			dprintf("Asked to wait for a TLS handshake that has already failed.  Returning soft error");
			*errorCodePtr = ECONNRESET;
		}
		return(-1);
	}
    if (statePtr->flags & TLS_TCL_HANDSHAKE_FAILED) {
	/*
	 * Different types of operations have different requirements
	 * SSL being established
	 */
	if (handshakeFailureIsPermanent) {
	    dprintf("Asked to wait for a TLS handshake that has already failed.  Returning fatal error");
	    *errorCodePtr = ECONNABORTED;
	} else {
	    dprintf("Asked to wait for a TLS handshake that has already failed.  Returning soft error");
	    *errorCodePtr = ECONNRESET;
	}
	return(-1);
    }

	for (;;) {
		/* Not initialized yet! */
		if (statePtr->flags & TLS_TCL_SERVER) {
			dprintf("Calling SSL_accept()");
    for (;;) {
	/* Not initialized yet! */
	if (statePtr->flags & TLS_TCL_SERVER) {
	    dprintf("Calling SSL_accept()");

			err = SSL_accept(statePtr->ssl);
		} else {
			dprintf("Calling SSL_connect()");
	    err = SSL_accept(statePtr->ssl);

	} else {
	    dprintf("Calling SSL_connect()");

			err = SSL_connect(statePtr->ssl);
		}
	    err = SSL_connect(statePtr->ssl);
	}

		if (err > 0) {
			dprintf("That seems to have gone okay");
	if (err > 0) {
	    dprintf("That seems to have gone okay");

			err = BIO_flush(statePtr->bio);
	    err = BIO_flush(statePtr->bio);

			if (err <= 0) {
				dprintf("Flushing the lower layers failed, this will probably terminate this session");
			}
		}
	    if (err <= 0) {
		dprintf("Flushing the lower layers failed, this will probably terminate this session");
	    }
	}

		rc = SSL_get_error(statePtr->ssl, err);
	rc = SSL_get_error(statePtr->ssl, err);

		dprintf("Got error: %i (rc = %i)", err, rc);
	dprintf("Got error: %i (rc = %i)", err, rc);

		bioShouldRetry = 0;
		if (err <= 0) {
			if (rc == SSL_ERROR_WANT_CONNECT || rc == SSL_ERROR_WANT_ACCEPT || rc == SSL_ERROR_WANT_READ || rc == SSL_ERROR_WANT_WRITE) {
				bioShouldRetry = 1;
			} else if (BIO_should_retry(statePtr->bio)) {
				bioShouldRetry = 1;
			} else if (rc == SSL_ERROR_SYSCALL && Tcl_GetErrno() == EAGAIN) {
				bioShouldRetry = 1;
			}
		} else {
			if (!SSL_is_init_finished(statePtr->ssl)) {
				bioShouldRetry = 1;
			}
		}
	bioShouldRetry = 0;
	if (err <= 0) {
	    if (rc == SSL_ERROR_WANT_CONNECT || rc == SSL_ERROR_WANT_ACCEPT || rc == SSL_ERROR_WANT_READ || rc == SSL_ERROR_WANT_WRITE) {
		bioShouldRetry = 1;
	    } else if (BIO_should_retry(statePtr->bio)) {
		bioShouldRetry = 1;
	    } else if (rc == SSL_ERROR_SYSCALL && Tcl_GetErrno() == EAGAIN) {
		bioShouldRetry = 1;
	    }
	} else {
	    if (!SSL_is_init_finished(statePtr->ssl)) {
		bioShouldRetry = 1;
	    }
	}

		if (bioShouldRetry) {
			dprintf("The I/O did not complete -- but we should try it again");
	if (bioShouldRetry) {
	    dprintf("The I/O did not complete -- but we should try it again");

			if (statePtr->flags & TLS_TCL_ASYNC) {
				dprintf("Returning EAGAIN so that it can be retried later");
	    if (statePtr->flags & TLS_TCL_ASYNC) {
		dprintf("Returning EAGAIN so that it can be retried later");

				*errorCodePtr = EAGAIN;
		*errorCodePtr = EAGAIN;

				return(-1);
			} else {
				dprintf("Doing so now");
		return(-1);
	    } else {
		dprintf("Doing so now");

				continue;
			}
		}
		continue;
	    }
	}

		dprintf("We have either completely established the session or completely failed it -- there is no more need to ever retry it though");
		break;
	}
	dprintf("We have either completely established the session or completely failed it -- there is no more need to ever retry it though");
	break;
    }


	*errorCodePtr = EINVAL;
    *errorCodePtr = EINVAL;

	switch (rc) {
		case SSL_ERROR_NONE:
			/* The connection is up, we are done here */
			dprintf("The connection is up");
			break;
		case SSL_ERROR_ZERO_RETURN:
			dprintf("SSL_ERROR_ZERO_RETURN: Connect returned an invalid value...")
			return(-1);
		case SSL_ERROR_SYSCALL:
			backingError = ERR_get_error();
    switch (rc) {
	case SSL_ERROR_NONE:
	    /* The connection is up, we are done here */
	    dprintf("The connection is up");
	    break;
	case SSL_ERROR_ZERO_RETURN:
	    dprintf("SSL_ERROR_ZERO_RETURN: Connect returned an invalid value...")
	    return(-1);
	case SSL_ERROR_SYSCALL:
	    backingError = ERR_get_error();

			if (backingError == 0 && err == 0) {
				dprintf("EOF reached")
				*errorCodePtr = ECONNRESET;
			} else if (backingError == 0 && err == -1) {
				dprintf("I/O error occurred (errno = %lu)", (unsigned long) Tcl_GetErrno());
				*errorCodePtr = Tcl_GetErrno();
				if (*errorCodePtr == ECONNRESET) {
					*errorCodePtr = ECONNABORTED;
				}
			} else {
				dprintf("I/O error occurred (backingError = %lu)", backingError);
				*errorCodePtr = backingError;
				if (*errorCodePtr == ECONNRESET) {
					*errorCodePtr = ECONNABORTED;
				}
			}
	    if (backingError == 0 && err == 0) {
		dprintf("EOF reached")
		*errorCodePtr = ECONNRESET;
	    } else if (backingError == 0 && err == -1) {
		dprintf("I/O error occurred (errno = %lu)", (unsigned long) Tcl_GetErrno());
		*errorCodePtr = Tcl_GetErrno();
		if (*errorCodePtr == ECONNRESET) {
		    *errorCodePtr = ECONNABORTED;
		}
	    } else {
		dprintf("I/O error occurred (backingError = %lu)", backingError);
		*errorCodePtr = backingError;
		if (*errorCodePtr == ECONNRESET) {
		    *errorCodePtr = ECONNABORTED;
		}
	    }

			statePtr->flags |= TLS_TCL_HANDSHAKE_FAILED;
	    statePtr->flags |= TLS_TCL_HANDSHAKE_FAILED;

			return(-1);
		case SSL_ERROR_SSL:
			dprintf("Got permanent fatal SSL error, aborting immediately");
			Tls_Error(statePtr, (char *)ERR_reason_error_string(ERR_get_error()));
			statePtr->flags |= TLS_TCL_HANDSHAKE_FAILED;
			*errorCodePtr = ECONNABORTED;
			return(-1);
		case SSL_ERROR_WANT_CONNECT:
		case SSL_ERROR_WANT_ACCEPT:
		case SSL_ERROR_WANT_X509_LOOKUP:
		default:
			dprintf("We got a confusing reply: %i", rc);
			*errorCodePtr = Tcl_GetErrno();
			dprintf("ERR(%d, %d) ", rc, *errorCodePtr);
			return(-1);
	}
	    return(-1);

	case SSL_ERROR_SSL:
	    dprintf("Got permanent fatal SSL error, aborting immediately");
	    Tls_Error(statePtr, (char *)ERR_reason_error_string(ERR_get_error()));
	    statePtr->flags |= TLS_TCL_HANDSHAKE_FAILED;
	    *errorCodePtr = ECONNABORTED;
	    return(-1);

	case SSL_ERROR_WANT_CONNECT:
	case SSL_ERROR_WANT_ACCEPT:
	case SSL_ERROR_WANT_X509_LOOKUP:
	default:
	    dprintf("We got a confusing reply: %i", rc);
	    *errorCodePtr = Tcl_GetErrno();
	    dprintf("ERR(%d, %d) ", rc, *errorCodePtr);
	    return(-1);
    }

#if 0
	if (statePtr->flags & TLS_TCL_SERVER) {
		dprintf("This is an TLS server, checking the certificate for the peer");
    if (statePtr->flags & TLS_TCL_SERVER) {
	dprintf("This is an TLS server, checking the certificate for the peer");

		err = SSL_get_verify_result(statePtr->ssl);
		if (err != X509_V_OK) {
			dprintf("Invalid certificate, returning in failure");
	err = SSL_get_verify_result(statePtr->ssl);
	if (err != X509_V_OK) {
	    dprintf("Invalid certificate, returning in failure");

			Tls_Error(statePtr, (char *)X509_verify_cert_error_string(err));
			statePtr->flags |= TLS_TCL_HANDSHAKE_FAILED;
			*errorCodePtr = ECONNABORTED;
			return(-1);
		}
	}
	    Tls_Error(statePtr, (char *)X509_verify_cert_error_string(err));
	    statePtr->flags |= TLS_TCL_HANDSHAKE_FAILED;
	    *errorCodePtr = ECONNABORTED;
	    return(-1);
	}
    }
#endif

	dprintf("Removing the \"TLS_TCL_INIT\" flag since we have completed the handshake");
	statePtr->flags &= ~TLS_TCL_INIT;
    dprintf("Removing the \"TLS_TCL_INIT\" flag since we have completed the handshake");
    statePtr->flags &= ~TLS_TCL_INIT;

	dprintf("Returning in success");
	*errorCodePtr = 0;
    dprintf("Returning in success");
    *errorCodePtr = 0;

	return(0);
    return(0);
}

/*
 *-------------------------------------------------------------------
 *
 * TlsInputProc --
 *
 *	This procedure is invoked by the generic IO level
 *    This procedure is invoked by the generic IO level
 *       to read input from a SSL socket based channel.
 *
 * Results:
 *	The number of bytes read is returned or -1 on error. An output
 *	argument contains the POSIX error code on error, or zero if no
 *	error occurred.
 *    The number of bytes read is returned or -1 on error. An output
 *    argument contains the POSIX error code on error, or zero if no
 *    error occurred.
 *
 * Side effects:
 *	Reads input from the input device of the channel.
 *    Reads input from the input device of the channel.
 *
 *-------------------------------------------------------------------
 */

static int TlsInputProc(ClientData instanceData, char *buf, int bufSize, int *errorCodePtr) {
	unsigned long backingError;
	State *statePtr = (State *) instanceData;
	int bytesRead;
	int tlsConnect;
	int err;
    unsigned long backingError;
    State *statePtr = (State *) instanceData;
    int bytesRead;
    int tlsConnect;
    int err;

	*errorCodePtr = 0;
    *errorCodePtr = 0;

	dprintf("BIO_read(%d)", bufSize);
    dprintf("BIO_read(%d)", bufSize);

	if (statePtr->flags & TLS_TCL_CALLBACK) {
		/* don't process any bytes while verify callback is running */
		dprintf("Callback is running, reading 0 bytes");
		return(0);
	}
    if (statePtr->flags & TLS_TCL_CALLBACK) {
	/* don't process any bytes while verify callback is running */
	dprintf("Callback is running, reading 0 bytes");
	return(0);
    }

	dprintf("Calling Tls_WaitForConnect");
	tlsConnect = Tls_WaitForConnect(statePtr, errorCodePtr, 0);
	if (tlsConnect < 0) {
		dprintf("Got an error waiting to connect (tlsConnect = %i, *errorCodePtr = %i)", tlsConnect, *errorCodePtr);
    dprintf("Calling Tls_WaitForConnect");
    tlsConnect = Tls_WaitForConnect(statePtr, errorCodePtr, 0);
    if (tlsConnect < 0) {
	dprintf("Got an error waiting to connect (tlsConnect = %i, *errorCodePtr = %i)", tlsConnect, *errorCodePtr);

		bytesRead = -1;
		if (*errorCodePtr == ECONNRESET) {
			dprintf("Got connection reset");
			/* Soft EOF */
			*errorCodePtr = 0;
			bytesRead = 0;
		}
	bytesRead = -1;
	if (*errorCodePtr == ECONNRESET) {
	    dprintf("Got connection reset");
	    /* Soft EOF */
	    *errorCodePtr = 0;
	    bytesRead = 0;
	}

		return(bytesRead);
	}
	return(bytesRead);
    }

	/*
	 * We need to clear the SSL error stack now because we sometimes reach
	 * this function with leftover errors in the stack.  If BIO_read
	 * returns -1 and intends EAGAIN, there is a leftover error, it will be
	 * misconstrued as an error, not EAGAIN.
	 *
	 * Alternatively, we may want to handle the <0 return codes from
	 * BIO_read specially (as advised in the RSA docs).  TLS's lower level BIO
	 * functions play with the retry flags though, and this seems to work
	 * correctly.  Similar fix in TlsOutputProc. - hobbs
	 */
	ERR_clear_error();
	bytesRead = BIO_read(statePtr->bio, buf, bufSize);
	dprintf("BIO_read -> %d", bytesRead);
    /*
     * We need to clear the SSL error stack now because we sometimes reach
     * this function with leftover errors in the stack.  If BIO_read
     * returns -1 and intends EAGAIN, there is a leftover error, it will be
     * misconstrued as an error, not EAGAIN.
     *
     * Alternatively, we may want to handle the <0 return codes from
     * BIO_read specially (as advised in the RSA docs).  TLS's lower level BIO
     * functions play with the retry flags though, and this seems to work
     * correctly.  Similar fix in TlsOutputProc. - hobbs
     */
    ERR_clear_error();
    bytesRead = BIO_read(statePtr->bio, buf, bufSize);
    dprintf("BIO_read -> %d", bytesRead);

	err = SSL_get_error(statePtr->ssl, bytesRead);
    err = SSL_get_error(statePtr->ssl, bytesRead);

#if 0
	if (bytesRead <= 0) {
		if (BIO_should_retry(statePtr->bio)) {
			dprintf("I/O failed, will retry based on EAGAIN");
			*errorCodePtr = EAGAIN;
		}
	}
    if (bytesRead <= 0) {
	if (BIO_should_retry(statePtr->bio)) {
	    dprintf("I/O failed, will retry based on EAGAIN");
	    *errorCodePtr = EAGAIN;
	}
    }
#endif

	switch (err) {
		case SSL_ERROR_NONE:
			dprintBuffer(buf, bytesRead);
			break;
		case SSL_ERROR_SSL:
			dprintf("SSL negotiation error, indicating that the connection has been aborted");
    switch (err) {
	case SSL_ERROR_NONE:
	    dprintBuffer(buf, bytesRead);
	    break;

	case SSL_ERROR_SSL:
	    dprintf("SSL negotiation error, indicating that the connection has been aborted");

			Tls_Error(statePtr, TCLTLS_SSL_ERROR(statePtr->ssl, bytesRead));
			*errorCodePtr = ECONNABORTED;
			bytesRead = -1;
	    Tls_Error(statePtr, TCLTLS_SSL_ERROR(statePtr->ssl, bytesRead));
	    *errorCodePtr = ECONNABORTED;
	    bytesRead = -1;

			break;
		case SSL_ERROR_SYSCALL:
			backingError = ERR_get_error();
	    break;

	case SSL_ERROR_SYSCALL:
	    backingError = ERR_get_error();

			if (backingError == 0 && bytesRead == 0) {
				dprintf("EOF reached")
				*errorCodePtr = 0;
				bytesRead = 0;
			} else if (backingError == 0 && bytesRead == -1) {
				dprintf("I/O error occurred (errno = %lu)", (unsigned long) Tcl_GetErrno());
				*errorCodePtr = Tcl_GetErrno();
				bytesRead = -1;
			} else {
				dprintf("I/O error occurred (backingError = %lu)", backingError);
				*errorCodePtr = backingError;
				bytesRead = -1;
			}
	    if (backingError == 0 && bytesRead == 0) {
		dprintf("EOF reached")
		*errorCodePtr = 0;
		bytesRead = 0;
	    } else if (backingError == 0 && bytesRead == -1) {
		dprintf("I/O error occurred (errno = %lu)", (unsigned long) Tcl_GetErrno());
		*errorCodePtr = Tcl_GetErrno();
		bytesRead = -1;
	    } else {
		dprintf("I/O error occurred (backingError = %lu)", backingError);
		*errorCodePtr = backingError;
		bytesRead = -1;
	    }

			break;
		case SSL_ERROR_ZERO_RETURN:
			dprintf("Got SSL_ERROR_ZERO_RETURN, this means an EOF has been reached");
			bytesRead = 0;
			*errorCodePtr = 0;
			break;
		case SSL_ERROR_WANT_READ:
			dprintf("Got SSL_ERROR_WANT_READ, mapping this to EAGAIN");
			bytesRead = -1;
			*errorCodePtr = EAGAIN;
			break;
		default:
			dprintf("Unknown error (err = %i), mapping to EOF", err);
			*errorCodePtr = 0;
			bytesRead = 0;
			break;
	}
	    break;

	case SSL_ERROR_ZERO_RETURN:
	    dprintf("Got SSL_ERROR_ZERO_RETURN, this means an EOF has been reached");
	    bytesRead = 0;
	    *errorCodePtr = 0;
	    break;

	case SSL_ERROR_WANT_READ:
	    dprintf("Got SSL_ERROR_WANT_READ, mapping this to EAGAIN");
	    bytesRead = -1;
	    *errorCodePtr = EAGAIN;
	    break;

	default:
	    dprintf("Unknown error (err = %i), mapping to EOF", err);
	    *errorCodePtr = 0;
	    bytesRead = 0;
	    break;
    }

	dprintf("Input(%d) -> %d [%d]", bufSize, bytesRead, *errorCodePtr);
	return(bytesRead);
    dprintf("Input(%d) -> %d [%d]", bufSize, bytesRead, *errorCodePtr);
    return(bytesRead);
}

/*
 *-------------------------------------------------------------------
 *
 * TlsOutputProc --
 *
 *	This procedure is invoked by the generic IO level
 *    This procedure is invoked by the generic IO level
 *       to write output to a SSL socket based channel.
 *
 * Results:
 *	The number of bytes written is returned. An output argument is
 *	set to a POSIX error code if an error occurred, or zero.
 *    The number of bytes written is returned. An output argument is
 *    set to a POSIX error code if an error occurred, or zero.
 *
 * Side effects:
 *	Writes output on the output device of the channel.
 *    Writes output on the output device of the channel.
 *
 *-------------------------------------------------------------------
 */

static int TlsOutputProc(ClientData instanceData, const char *buf, int toWrite, int *errorCodePtr) {
	unsigned long backingError;
	State *statePtr = (State *) instanceData;
	int written, err;
	int tlsConnect;
    unsigned long backingError;
    State *statePtr = (State *) instanceData;
    int written, err;
    int tlsConnect;

	*errorCodePtr = 0;
    *errorCodePtr = 0;

	dprintf("BIO_write(%p, %d)", (void *) statePtr, toWrite);
	dprintBuffer(buf, toWrite);
    dprintf("BIO_write(%p, %d)", (void *) statePtr, toWrite);
    dprintBuffer(buf, toWrite);

	if (statePtr->flags & TLS_TCL_CALLBACK) {
		dprintf("Don't process output while callbacks are running")
		written = -1;
		*errorCodePtr = EAGAIN;
		return(-1);
	}
    if (statePtr->flags & TLS_TCL_CALLBACK) {
	dprintf("Don't process output while callbacks are running");
	written = -1;
	*errorCodePtr = EAGAIN;
	return(-1);
    }

	dprintf("Calling Tls_WaitForConnect");
	tlsConnect = Tls_WaitForConnect(statePtr, errorCodePtr, 1);
	if (tlsConnect < 0) {
		dprintf("Got an error waiting to connect (tlsConnect = %i, *errorCodePtr = %i)", tlsConnect, *errorCodePtr);
    dprintf("Calling Tls_WaitForConnect");
    tlsConnect = Tls_WaitForConnect(statePtr, errorCodePtr, 1);
    if (tlsConnect < 0) {
	dprintf("Got an error waiting to connect (tlsConnect = %i, *errorCodePtr = %i)", tlsConnect, *errorCodePtr);

		written = -1;
		if (*errorCodePtr == ECONNRESET) {
			dprintf("Got connection reset");
			/* Soft EOF */
			*errorCodePtr = 0;
			written = 0;
		}
	written = -1;
	if (*errorCodePtr == ECONNRESET) {
	    dprintf("Got connection reset");
	    /* Soft EOF */
	    *errorCodePtr = 0;
	    written = 0;
	}

		return(written);
	}
	return(written);
    }

	if (toWrite == 0) {
		dprintf("zero-write");
		err = BIO_flush(statePtr->bio);
    if (toWrite == 0) {
	dprintf("zero-write");
	err = BIO_flush(statePtr->bio);

		if (err <= 0) {
			dprintf("Flushing failed");
	if (err <= 0) {
	    dprintf("Flushing failed");

			*errorCodePtr = EIO;
			written = 0;
			return(-1);
		}
	    *errorCodePtr = EIO;
	    written = 0;
	    return(-1);
	}

		written = 0;
		*errorCodePtr = 0;
		return(0);
	}
	written = 0;
	*errorCodePtr = 0;
	return(0);
    }

	/*
	 * We need to clear the SSL error stack now because we sometimes reach
	 * this function with leftover errors in the stack.  If BIO_write
	 * returns -1 and intends EAGAIN, there is a leftover error, it will be
	 * misconstrued as an error, not EAGAIN.
	 *
	 * Alternatively, we may want to handle the <0 return codes from
	 * BIO_write specially (as advised in the RSA docs).  TLS's lower level
	 * BIO functions play with the retry flags though, and this seems to
	 * work correctly.  Similar fix in TlsInputProc. - hobbs
	 */
	ERR_clear_error();
	written = BIO_write(statePtr->bio, buf, toWrite);
	dprintf("BIO_write(%p, %d) -> [%d]", (void *) statePtr, toWrite, written);
    /*
     * We need to clear the SSL error stack now because we sometimes reach
     * this function with leftover errors in the stack.  If BIO_write
     * returns -1 and intends EAGAIN, there is a leftover error, it will be
     * misconstrued as an error, not EAGAIN.
     *
     * Alternatively, we may want to handle the <0 return codes from
     * BIO_write specially (as advised in the RSA docs).  TLS's lower level
     * BIO functions play with the retry flags though, and this seems to
     * work correctly.  Similar fix in TlsInputProc. - hobbs
     */
    ERR_clear_error();
    written = BIO_write(statePtr->bio, buf, toWrite);
    dprintf("BIO_write(%p, %d) -> [%d]", (void *) statePtr, toWrite, written);

	err = SSL_get_error(statePtr->ssl, written);
	switch (err) {
		case SSL_ERROR_NONE:
			if (written < 0) {
				written = 0;
			}
			break;
		case SSL_ERROR_WANT_WRITE:
			dprintf("Got SSL_ERROR_WANT_WRITE, mapping it to EAGAIN");
			*errorCodePtr = EAGAIN;
			written = -1;
			break;
		case SSL_ERROR_WANT_READ:
			dprintf(" write R BLOCK");
			break;
		case SSL_ERROR_WANT_X509_LOOKUP:
			dprintf(" write X BLOCK");
			break;
		case SSL_ERROR_ZERO_RETURN:
			dprintf(" closed");
			written = 0;
			*errorCodePtr = 0;
			break;
		case SSL_ERROR_SYSCALL:
			backingError = ERR_get_error();
    err = SSL_get_error(statePtr->ssl, written);
    switch (err) {
	case SSL_ERROR_NONE:
	    if (written < 0) {
		written = 0;
	    }
	    break;

	case SSL_ERROR_WANT_WRITE:
	    dprintf("Got SSL_ERROR_WANT_WRITE, mapping it to EAGAIN");
	    *errorCodePtr = EAGAIN;
	    written = -1;
	    break;

	case SSL_ERROR_WANT_READ:
	    dprintf(" write R BLOCK");
	    break;

	case SSL_ERROR_WANT_X509_LOOKUP:
	    dprintf(" write X BLOCK");
	    break;

	case SSL_ERROR_ZERO_RETURN:
	    dprintf(" closed");
	    written = 0;
	    *errorCodePtr = 0;
	    break;

	case SSL_ERROR_SYSCALL:
	    backingError = ERR_get_error();

			if (backingError == 0 && written == 0) {
				dprintf("EOF reached")
				*errorCodePtr = 0;
				written = 0;
			} else if (backingError == 0 && written == -1) {
				dprintf("I/O error occurred (errno = %lu)", (unsigned long) Tcl_GetErrno());
				*errorCodePtr = Tcl_GetErrno();
				written = -1;
			} else {
				dprintf("I/O error occurred (backingError = %lu)", backingError);
				*errorCodePtr = backingError;
				written = -1;
			}
	    if (backingError == 0 && written == 0) {
		dprintf("EOF reached")
		*errorCodePtr = 0;
		written = 0;
	    } else if (backingError == 0 && written == -1) {
		dprintf("I/O error occurred (errno = %lu)", (unsigned long) Tcl_GetErrno());
		*errorCodePtr = Tcl_GetErrno();
		written = -1;
	    } else {
		dprintf("I/O error occurred (backingError = %lu)", backingError);
		*errorCodePtr = backingError;
		written = -1;
	    }

			break;
		case SSL_ERROR_SSL:
			Tls_Error(statePtr, TCLTLS_SSL_ERROR(statePtr->ssl, written));
			*errorCodePtr = ECONNABORTED;
			written = -1;
			break;
		default:
			dprintf(" unknown err: %d", err);
			break;
	}
	    break;

	case SSL_ERROR_SSL:
	    Tls_Error(statePtr, TCLTLS_SSL_ERROR(statePtr->ssl, written));
	    *errorCodePtr = ECONNABORTED;
	    written = -1;
	    break;

	default:
	    dprintf(" unknown err: %d", err);
	    break;
    }

	dprintf("Output(%d) -> %d", toWrite, written);
	return(written);
    dprintf("Output(%d) -> %d", toWrite, written);
    return(written);
}

/*
 *-------------------------------------------------------------------
 *
 * TlsSetOptionProc --
 *
 *	Computes an option value for a SSL socket based channel, or a
 *	list of all options and their values.
 *    Computes an option value for a SSL socket based channel, or a
 *    list of all options and their values.
 *
 * Results:
 *	A standard Tcl result. The value of the specified option or a
 *	list of all options and	their values is returned in the
 *	supplied DString.
 *    A standard Tcl result. The value of the specified option or a
 *    list of all options and    their values is returned in the
 *    supplied DString.
 *
 * Side effects:
 *	None.
 *    None.
 *
 *-------------------------------------------------------------------
 */
static int
TlsSetOptionProc(ClientData instanceData,	/* Socket state. */
	Tcl_Interp *interp,		/* For errors - can be NULL. */
	const char *optionName,		/* Name of the option to set the value for, or
					 * NULL to get all options and their values. */
	const char *optionValue)	/* Value for option. */
TlsSetOptionProc(ClientData instanceData,    /* Socket state. */
    Tcl_Interp *interp,		/* For errors - can be NULL. */
    const char *optionName,	/* Name of the option to set the value for, or
				 * NULL to get all options and their values. */
    const char *optionValue)	/* Value for option. */
{
    State *statePtr = (State *) instanceData;

   Tcl_Channel downChan = Tls_GetParent(statePtr, TLS_TCL_FASTPATH);
   Tcl_DriverSetOptionProc *setOptionProc;
    Tcl_Channel downChan = Tls_GetParent(statePtr, TLS_TCL_FASTPATH);
    Tcl_DriverSetOptionProc *setOptionProc;

    setOptionProc = Tcl_ChannelSetOptionProc(Tcl_GetChannelType(downChan));
    if (setOptionProc != NULL) {
	return (*setOptionProc)(Tcl_GetChannelInstanceData(downChan), interp, optionName, optionValue);
    } else if (optionName == (char*) NULL) {
	/*
	 * Request is query for all options, this is ok.
	 */
	 return TCL_OK;
	return TCL_OK;
    }
    /*
     * Request for a specific option has to fail, we don't have any.
     */
    return TCL_ERROR;
}

/*
 *-------------------------------------------------------------------
 *
 * TlsGetOptionProc --
 *
 *	Computes an option value for a SSL socket based channel, or a
 *	list of all options and their values.
 *    Computes an option value for a SSL socket based channel, or a
 *    list of all options and their values.
 *
 * Results:
 *	A standard Tcl result. The value of the specified option or a
 *	list of all options and	their values is returned in the
 *	supplied DString.
 *    A standard Tcl result. The value of the specified option or a
 *    list of all options and    their values is returned in the
 *    supplied DString.
 *
 * Side effects:
 *	None.
 *    None.
 *
 *-------------------------------------------------------------------
 */
static int
TlsGetOptionProc(ClientData instanceData,	/* Socket state. */
	Tcl_Interp *interp,		/* For errors - can be NULL. */
	const char *optionName,		/* Name of the option to retrieve the value for, or
					 * NULL to get all options and their values. */
	Tcl_DString *dsPtr)		/* Where to store the computed value
TlsGetOptionProc(ClientData instanceData,    /* Socket state. */
    Tcl_Interp *interp,		/* For errors - can be NULL. */
    const char *optionName,	/* Name of the option to retrieve the value for, or
				 * NULL to get all options and their values. */
    Tcl_DString *dsPtr)		/* Where to store the computed value initialized by caller. */
					 * initialized by caller. */
{
    State *statePtr = (State *) instanceData;

   Tcl_Channel downChan = Tls_GetParent(statePtr, TLS_TCL_FASTPATH);
   Tcl_DriverGetOptionProc *getOptionProc;
    Tcl_Channel downChan = Tls_GetParent(statePtr, TLS_TCL_FASTPATH);
    Tcl_DriverGetOptionProc *getOptionProc;

    getOptionProc = Tcl_ChannelGetOptionProc(Tcl_GetChannelType(downChan));
    if (getOptionProc != NULL) {
        return (*getOptionProc)(Tcl_GetChannelInstanceData(downChan), interp, optionName, dsPtr);
	return (*getOptionProc)(Tcl_GetChannelInstanceData(downChan), interp, optionName, dsPtr);
    } else if (optionName == (char*) NULL) {
        /*
         * Request is query for all options, this is ok.
         */
         return TCL_OK;
	/*
	 * Request is query for all options, this is ok.
	 */
	return TCL_OK;
    }
    /*
     * Request for a specific option has to fail, we don't have any.
     */
    return TCL_ERROR;
}

/*
 *-------------------------------------------------------------------
 *
 * TlsWatchProc --
 *
 *	Initialize the notifier to watch Tcl_Files from this channel.
 *    Initialize the notifier to watch Tcl_Files from this channel.
 *
 * Results:
 *	None.
 *    None.
 *
 * Side effects:
 *	Sets up the notifier so that a future event on the channel
 *	will be seen by Tcl.
 *    Sets up the notifier so that a future event on the channel
 *    will be seen by Tcl.
 *
 *-------------------------------------------------------------------
 */

static void
TlsWatchProc(ClientData instanceData,	/* The socket state. */
	     int mask)			/* Events of interest; an OR-ed combination of */
					/* TCL_READABLE, TCL_WRITABLE and TCL_EXCEPTION. */
TlsWatchProc(ClientData instanceData,    /* The socket state. */
    int mask)		/* Events of interest; an OR-ed combination of
			* TCL_READABLE, TCL_WRITABLE and TCL_EXCEPTION. */
{
    Tcl_Channel     downChan;
    State *statePtr = (State *) instanceData;

    dprintf("TlsWatchProc(0x%x)", mask);

    /* Pretend to be dead as long as the verify callback is running. 
    /* Pretend to be dead as long as the verify callback is running.
     * Otherwise that callback could be invoked recursively. */
    if (statePtr->flags & TLS_TCL_CALLBACK) {
        dprintf("Callback is on-going, doing nothing");
        return;
	dprintf("Callback is on-going, doing nothing");
	return;
    }

    dprintFlags(statePtr);

    downChan = Tls_GetParent(statePtr, TLS_TCL_FASTPATH);

    if (statePtr->flags & TLS_TCL_HANDSHAKE_FAILED) {
        dprintf("Asked to watch a socket with a failed handshake -- nothing can happen here");
	dprintf("Asked to watch a socket with a failed handshake -- nothing can happen here");

	dprintf("Unregistering interest in the lower channel");
	(Tcl_GetChannelType(downChan))->watchProc(Tcl_GetChannelInstanceData(downChan), 0);

	(Tcl_GetChannelType(downChan))->watchProc(Tcl_GetChannelInstanceData(downChan), 0);
	statePtr->watchMask = 0;

        return;
	return;
    }

	statePtr->watchMask = mask;
    statePtr->watchMask = mask;

	/* No channel handlers any more. We will be notified automatically
	 * about events on the channel below via a call to our
	 * 'TransformNotifyProc'. But we have to pass the interest down now.
	 * We are allowed to add additional 'interest' to the mask if we want
	 * to. But this transformation has no such interest. It just passes
	 * the request down, unchanged.
	 */
    /* No channel handlers any more. We will be notified automatically
     * about events on the channel below via a call to our
     * 'TransformNotifyProc'. But we have to pass the interest down now.
     * We are allowed to add additional 'interest' to the mask if we want
     * to. But this transformation has no such interest. It just passes
     * the request down, unchanged.
     */


        dprintf("Registering our interest in the lower channel (chan=%p)", (void *) downChan);
    dprintf("Registering our interest in the lower channel (chan=%p)", (void *) downChan);
	(Tcl_GetChannelType(downChan))
	    ->watchProc(Tcl_GetChannelInstanceData(downChan), mask);
    (Tcl_GetChannelType(downChan))->watchProc(Tcl_GetChannelInstanceData(downChan), mask);

	/*
	 * Management of the internal timer.
	 */
    /*
     * Management of the internal timer.
     */

	if (statePtr->timer != (Tcl_TimerToken) NULL) {
            dprintf("A timer was found, deleting it");
	    Tcl_DeleteTimerHandler(statePtr->timer);
	    statePtr->timer = (Tcl_TimerToken) NULL;
	}
    if (statePtr->timer != (Tcl_TimerToken) NULL) {
	dprintf("A timer was found, deleting it");
	Tcl_DeleteTimerHandler(statePtr->timer);
	statePtr->timer = (Tcl_TimerToken) NULL;
    }

    if ((mask & TCL_READABLE) &&
	((Tcl_InputBuffered(statePtr->self) > 0) || (BIO_ctrl_pending(statePtr->bio) > 0))) {
	    /*
	     * There is interest in readable events and we actually have
	     * data waiting, so generate a timer to flush that.
	     */
	    dprintf("Creating a new timer since data appears to be waiting");
	    statePtr->timer = Tcl_CreateTimerHandler(TLS_TCL_DELAY, TlsChannelHandlerTimer, (ClientData) statePtr);
    }
}

/*
 *-------------------------------------------------------------------
 *
 * TlsGetHandleProc --
 *
 *	Called from Tcl_GetChannelFile to retrieve o/s file handler
 *	from the SSL socket based channel.
 *    Called from Tcl_GetChannelFile to retrieve o/s file handler
 *    from the SSL socket based channel.
 *
 * Results:
 *	The appropriate Tcl_File or NULL if not present. 
 *    The appropriate Tcl_File or NULL if not present.
 *
 * Side effects:
 *	None.
 *    None.
 *
 *-------------------------------------------------------------------
 */
static int TlsGetHandleProc(ClientData instanceData, int direction, ClientData *handlePtr) {
	State *statePtr = (State *) instanceData;
    State *statePtr = (State *) instanceData;

	return(Tcl_GetChannelHandle(Tls_GetParent(statePtr, TLS_TCL_FASTPATH), direction, handlePtr));
    return(Tcl_GetChannelHandle(Tls_GetParent(statePtr, TLS_TCL_FASTPATH), direction, handlePtr));
}

/*
 *-------------------------------------------------------------------
 *
 * TlsNotifyProc --
 *
 *	Handler called by Tcl to inform us of activity
 *	on the underlying channel.
 *    Handler called by Tcl to inform us of activity
 *    on the underlying channel.
 *
 * Results:
 *	None.
 *    None.
 *
 * Side effects:
 *	May process the incoming event by itself.
 *    May process the incoming event by itself.
 *
 *-------------------------------------------------------------------
 */

static int TlsNotifyProc(ClientData instanceData, int mask) {
	State *statePtr = (State *) instanceData;
	int errorCode;
    State *statePtr = (State *) instanceData;
    int errorCode;

	/*
	 * An event occurred in the underlying channel.  This
	 * transformation doesn't process such events thus returns the
	 * incoming mask unchanged.
	 */
	if (statePtr->timer != (Tcl_TimerToken) NULL) {
		/*
		 * Delete an existing timer. It was not fired, yet we are
		 * here, so the channel below generated such an event and we
		 * don't have to. The renewal of the interest after the
		 * execution of channel handlers will eventually cause us to
		 * recreate the timer (in WatchProc).
		 */
		Tcl_DeleteTimerHandler(statePtr->timer);
		statePtr->timer = (Tcl_TimerToken) NULL;
	}
    /*
     * An event occurred in the underlying channel.  This
     * transformation doesn't process such events thus returns the
     * incoming mask unchanged.
     */
    if (statePtr->timer != (Tcl_TimerToken) NULL) {
	/*
	 * Delete an existing timer. It was not fired, yet we are
	 * here, so the channel below generated such an event and we
	 * don't have to. The renewal of the interest after the
	 * execution of channel handlers will eventually cause us to
	 * recreate the timer (in WatchProc).
	 */
	Tcl_DeleteTimerHandler(statePtr->timer);
	statePtr->timer = (Tcl_TimerToken) NULL;
    }

	if (statePtr->flags & TLS_TCL_CALLBACK) {
		dprintf("Returning 0 due to callback");
		return 0;
	}
    if (statePtr->flags & TLS_TCL_CALLBACK) {
	dprintf("Returning 0 due to callback");
	return 0;
    }

	dprintf("Calling Tls_WaitForConnect");
	errorCode = 0;
	if (Tls_WaitForConnect(statePtr, &errorCode, 1) < 0) {
		if (errorCode == EAGAIN) {
			dprintf("Async flag could be set (didn't check) and errorCode == EAGAIN:  Returning 0");
    dprintf("Calling Tls_WaitForConnect");
    errorCode = 0;
    if (Tls_WaitForConnect(statePtr, &errorCode, 1) < 0) {
	if (errorCode == EAGAIN) {
	    dprintf("Async flag could be set (didn't check) and errorCode == EAGAIN:  Returning 0");

			return 0;
		}
	    return 0;
	}

		dprintf("Tls_WaitForConnect returned an error");
	}
	dprintf("Tls_WaitForConnect returned an error");
    }

	dprintf("Returning %i", mask);
    dprintf("Returning %i", mask);

	return(mask);
    return(mask);
}

#if 0
/*
 *------------------------------------------------------*
 *
 *      TlsChannelHandler --
816
817
818
819
820
821
822
823
824
825
826
827
828
829

830
831
832
833
834
835
836
807
808
809
810
811
812
813

814
815
816
817
818

819
820
821
822
823
824
825
826







-





-
+







 *              Tcl_NotifyChannel.
 *
 *      Result:
 *              None.
 *
 *------------------------------------------------------*
 */

static void
TlsChannelHandler (ClientData clientData, int mask) {
    State *statePtr = (State *) clientData;

    dprintf("HANDLER(0x%x)", mask);
    Tcl_Preserve( (ClientData)statePtr);
    Tcl_Preserve((ClientData)statePtr);

    if (mask & TCL_READABLE) {
	BIO_set_flags(statePtr->p_bio, BIO_FLAGS_READ);
    } else {
	BIO_clear_flags(statePtr->p_bio, BIO_FLAGS_READ);
    }

856
857
858
859
860
861
862
863
864
865

866
867
868
869
870
871
872
873
874

875
876
877

878
879
880
881
882
883
884

885
886
887
888
889




890
891
892


893
894
895


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
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
950

951
952
953
954
955

956
957
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
846
847
848
849
850
851
852

853

854
855
856
857
858
859
860
861
862

863

864

865
866
867
868
869
870
871

872
873




874
875
876
877
878


879
880
881


882
883
884
885
886

887


888
889
890

891
892

893
894


895
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
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
950
951


952
953
954

955
956
















957
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







-

-
+








-
+
-

-
+






-
+

-
-
-
-
+
+
+
+

-
-
+
+

-
-
+
+



-

-
-
+
+

-
+

-
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
+

-
+



-
+

-
-
-
-
+
+
+
+
-
-
+







-
+


-
+


-
+




-
+

-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+

-
-
+
+

-
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
+
+

     * Notify the upper channel of the current BIO state so the event
     * continues to propagate up the chain.
     *
     * stanton: It looks like this could result in an infinite loop if
     * the upper channel doesn't cause ChannelHandler to be removed
     * before Tcl_NotifyChannel calls channel handlers on the lower channel.
     */
    
    Tcl_NotifyChannel(statePtr->self, mask);
    

    if (statePtr->timer != (Tcl_TimerToken)NULL) {
	Tcl_DeleteTimerHandler(statePtr->timer);
	statePtr->timer = (Tcl_TimerToken)NULL;
    }
    if ((mask & TCL_READABLE) && Tcl_InputBuffered(statePtr->self) > 0) {
	/*
	 * Data is waiting, flush it out in short time
	 */
	statePtr->timer = Tcl_CreateTimerHandler(TLS_TCL_DELAY,
	statePtr->timer = Tcl_CreateTimerHandler(TLS_TCL_DELAY, TlsChannelHandlerTimer, (ClientData) statePtr);
		TlsChannelHandlerTimer, (ClientData) statePtr);
    }
    Tcl_Release( (ClientData)statePtr);
    Tcl_Release((ClientData)statePtr);
}
#endif

/*
 *------------------------------------------------------*
 *
 *	TlsChannelHandlerTimer --
 *    TlsChannelHandlerTimer --
 *
 *	------------------------------------------------*
 *	Called by the notifier (-> timer) to flush out
 *	information waiting in channel buffers.
 *	------------------------------------------------*
 *    ------------------------------------------------*
 *    Called by the notifier (-> timer) to flush out
 *    information waiting in channel buffers.
 *    ------------------------------------------------*
 *
 *	Sideeffects:
 *		As of 'TlsChannelHandler'.
 *    Sideeffects:
 *        As of 'TlsChannelHandler'.
 *
 *	Result:
 *		None.
 *    Result:
 *        None.
 *
 *------------------------------------------------------*
 */

static void TlsChannelHandlerTimer(ClientData clientData) {
	State *statePtr = (State *) clientData;
	int mask = 0;
    State *statePtr = (State *) clientData;
    int mask = 0;

	dprintf("Called");
    dprintf("Called");

	statePtr->timer = (Tcl_TimerToken) NULL;
    statePtr->timer = (Tcl_TimerToken) NULL;

	if (BIO_wpending(statePtr->bio)) {
		dprintf("[chan=%p] BIO writable", statePtr->self);
    if (BIO_wpending(statePtr->bio)) {
	dprintf("[chan=%p] BIO writable", statePtr->self);

		mask |= TCL_WRITABLE;
	}
	mask |= TCL_WRITABLE;
    }

	if (BIO_pending(statePtr->bio)) {
		dprintf("[chan=%p] BIO readable", statePtr->self);
    if (BIO_pending(statePtr->bio)) {
	dprintf("[chan=%p] BIO readable", statePtr->self);

		mask |= TCL_READABLE;
	}
	mask |= TCL_READABLE;
    }

	dprintf("Notifying ourselves");
	Tcl_NotifyChannel(statePtr->self, mask);
    dprintf("Notifying ourselves");
    Tcl_NotifyChannel(statePtr->self, mask);

	dprintf("Returning");
    dprintf("Returning");

	return;
    return;
}

Tcl_Channel Tls_GetParent(State *statePtr, int maskFlags) {
	dprintf("Requested to get parent of channel %p", statePtr->self);
    dprintf("Requested to get parent of channel %p", statePtr->self);

	if ((statePtr->flags & ~maskFlags) & TLS_TCL_FASTPATH) {
		dprintf("Asked to get the parent channel while we are using FastPath -- returning NULL");
		return(NULL);
	}
    if ((statePtr->flags & ~maskFlags) & TLS_TCL_FASTPATH) {
	dprintf("Asked to get the parent channel while we are using FastPath -- returning NULL");
	return(NULL);
    }

	return(Tcl_GetStackedChannel(statePtr->self));
    return(Tcl_GetStackedChannel(statePtr->self));
}

/*
 *-------------------------------------------------------------------
 *
 * Tls_ChannelType --
 *
 *	Return the correct TLS channel driver info
 *    Return the correct TLS channel driver info
 *
 * Results:
 *	The correct channel driver for the current version of Tcl.
 *    The correct channel driver for the current version of Tcl.
 *
 * Side effects:
 *	None.
 *    None.
 *
 *-------------------------------------------------------------------
 */
Tcl_ChannelType *Tls_ChannelType(void) {
	unsigned int size;
    unsigned int size;

	/*
	 * Initialize the channel type if necessary
	 */
	if (tlsChannelType == NULL) {
		/*
		 * Allocate new channeltype structure
		 */
		size = sizeof(Tcl_ChannelType); /* Base size */
    /*
     * Initialize the channel type if necessary
     */
    if (tlsChannelType == NULL) {
	/*
	 * Allocate new channeltype structure
	 */
	size = sizeof(Tcl_ChannelType); /* Base size */

		tlsChannelType = (Tcl_ChannelType *) ckalloc(size);
		memset((void *) tlsChannelType, 0, size);
	tlsChannelType = (Tcl_ChannelType *) ckalloc(size);
	memset((void *) tlsChannelType, 0, size);

		tlsChannelType->typeName	= "tls";
	tlsChannelType->typeName	= "tls";
#ifdef TCL_CHANNEL_VERSION_5
		tlsChannelType->version		= TCL_CHANNEL_VERSION_5;
		tlsChannelType->closeProc	= TlsCloseProc;
		tlsChannelType->inputProc	= TlsInputProc;
		tlsChannelType->outputProc	= TlsOutputProc;
		tlsChannelType->seekProc	= NULL;
		tlsChannelType->setOptionProc	= TlsSetOptionProc;
		tlsChannelType->getOptionProc	= TlsGetOptionProc;
		tlsChannelType->watchProc	= TlsWatchProc;
		tlsChannelType->getHandleProc	= TlsGetHandleProc;
		tlsChannelType->close2Proc	= TlsCloseProc2;
		tlsChannelType->blockModeProc	= TlsBlockModeProc;
		tlsChannelType->flushProc	= NULL;
		tlsChannelType->handlerProc	= TlsNotifyProc;
		tlsChannelType->wideSeekProc	= NULL;
		tlsChannelType->threadActionProc= NULL;
		tlsChannelType->truncateProc	= NULL;
	tlsChannelType->version		= TCL_CHANNEL_VERSION_5;
	tlsChannelType->closeProc	= TlsCloseProc;
	tlsChannelType->inputProc	= TlsInputProc;
	tlsChannelType->outputProc	= TlsOutputProc;
	tlsChannelType->seekProc	= NULL;
	tlsChannelType->setOptionProc	= TlsSetOptionProc;
	tlsChannelType->getOptionProc	= TlsGetOptionProc;
	tlsChannelType->watchProc	= TlsWatchProc;
	tlsChannelType->getHandleProc	= TlsGetHandleProc;
	tlsChannelType->close2Proc	= TlsCloseProc2;
	tlsChannelType->blockModeProc	= TlsBlockModeProc;
	tlsChannelType->flushProc	= NULL;
	tlsChannelType->handlerProc	= TlsNotifyProc;
	tlsChannelType->wideSeekProc	= NULL;
	tlsChannelType->threadActionProc = NULL;
	tlsChannelType->truncateProc	= NULL;
#else
		tlsChannelType->version		= TCL_CHANNEL_VERSION_2;
		tlsChannelType->closeProc	= TlsCloseProc;
		tlsChannelType->inputProc	= TlsInputProc;
		tlsChannelType->outputProc	= TlsOutputProc;
		tlsChannelType->seekProc	= NULL;
		tlsChannelType->setOptionProc	= TlsSetOptionProc;
		tlsChannelType->getOptionProc	= TlsGetOptionProc;
		tlsChannelType->watchProc	= TlsWatchProc;
		tlsChannelType->getHandleProc	= TlsGetHandleProc;
		tlsChannelType->close2Proc	= NULL;
		tlsChannelType->blockModeProc	= TlsBlockModeProc;
		tlsChannelType->flushProc	= NULL;
		tlsChannelType->handlerProc	= TlsNotifyProc;
	tlsChannelType->version		= TCL_CHANNEL_VERSION_2;
	tlsChannelType->closeProc	= TlsCloseProc;
	tlsChannelType->inputProc	= TlsInputProc;
	tlsChannelType->outputProc	= TlsOutputProc;
	tlsChannelType->seekProc	= NULL;
	tlsChannelType->setOptionProc	= TlsSetOptionProc;
	tlsChannelType->getOptionProc	= TlsGetOptionProc;
	tlsChannelType->watchProc	= TlsWatchProc;
	tlsChannelType->getHandleProc	= TlsGetHandleProc;
	tlsChannelType->close2Proc	= NULL;
	tlsChannelType->blockModeProc	= TlsBlockModeProc;
	tlsChannelType->flushProc	= NULL;
	tlsChannelType->handlerProc	= TlsNotifyProc;
#endif
	}
	return(tlsChannelType);
    }
    return(tlsChannelType);
}
Modified tlsInt.h from [df5a52ff88] to [9a55e93f5a].
64
65
66
67
68
69
70
71
72
73
74
75
76






77
78
79
80
81
82
83
84
85
86
87
88
89
90













91
92
93
94
95
96
97
98
99
100
101
102
103












104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122




123
124
125

126
127
128


129
130
131
132

133
134
135
136
137
138
139
140
141
142
143
144
145
146
147

148
149
150
151
152
153
154
64
65
66
67
68
69
70






71
72
73
74
75
76
77













78
79
80
81
82
83
84
85
86
87
88
89
90
91












92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118




119
120
121
122
123
124

125



126
127
128
129
130

131

132
133
134
135
136
137
138
139
140
141
142
143
144

145
146
147
148
149
150
151
152







-
-
-
-
-
-
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+















-
-
-
-
+
+
+
+


-
+
-
-
-
+
+



-
+
-













-
+







#ifndef ECONNRESET
#define ECONNRESET	131	/* Connection reset by peer */
#endif

#ifdef TCLEXT_TCLTLS_DEBUG
#include <ctype.h>
#define dprintf(...) { \
                       char dprintfBuffer[8192], *dprintfBuffer_p; \
                       dprintfBuffer_p = &dprintfBuffer[0]; \
                       dprintfBuffer_p += sprintf(dprintfBuffer_p, "%s:%i:%s():", __FILE__, __LINE__, __func__); \
                       dprintfBuffer_p += sprintf(dprintfBuffer_p, __VA_ARGS__); \
                       fprintf(stderr, "%s\n", dprintfBuffer); \
                     }
	char dprintfBuffer[8192], *dprintfBuffer_p; \
	dprintfBuffer_p = &dprintfBuffer[0]; \
	dprintfBuffer_p += sprintf(dprintfBuffer_p, "%s:%i:%s():", __FILE__, __LINE__, __func__); \
	dprintfBuffer_p += sprintf(dprintfBuffer_p, __VA_ARGS__); \
	fprintf(stderr, "%s\n", dprintfBuffer); \
}
#define dprintBuffer(bufferName, bufferLength) { \
                                                 int dprintBufferIdx; \
                                                 unsigned char dprintBufferChar; \
                                                 fprintf(stderr, "%s:%i:%s():%s[%llu]={", __FILE__, __LINE__, __func__, #bufferName, (unsigned long long) bufferLength); \
                                                 for (dprintBufferIdx = 0; dprintBufferIdx < bufferLength; dprintBufferIdx++) { \
                                                         dprintBufferChar = bufferName[dprintBufferIdx]; \
                                                         if (isalpha(dprintBufferChar) || isdigit(dprintBufferChar)) { \
                                                                 fprintf(stderr, "'%c' ", dprintBufferChar); \
                                                         } else { \
                                                                 fprintf(stderr, "%02x ", (unsigned int) dprintBufferChar); \
                                                         }; \
                                                 }; \
                                                 fprintf(stderr, "}\n"); \
                                               }
	int dprintBufferIdx; \
	unsigned char dprintBufferChar; \
	fprintf(stderr, "%s:%i:%s():%s[%llu]={", __FILE__, __LINE__, __func__, #bufferName, (unsigned long long) bufferLength); \
	for (dprintBufferIdx = 0; dprintBufferIdx < bufferLength; dprintBufferIdx++) { \
		dprintBufferChar = bufferName[dprintBufferIdx]; \
		if (isalpha(dprintBufferChar) || isdigit(dprintBufferChar)) { \
			fprintf(stderr, "'%c' ", dprintBufferChar); \
		} else { \
			fprintf(stderr, "%02x ", (unsigned int) dprintBufferChar); \
		}; \
	}; \
	fprintf(stderr, "}\n"); \
}
#define dprintFlags(statePtr) { \
                                char dprintfBuffer[8192], *dprintfBuffer_p; \
                                dprintfBuffer_p = &dprintfBuffer[0]; \
                                dprintfBuffer_p += sprintf(dprintfBuffer_p, "%s:%i:%s():%s->flags=0", __FILE__, __LINE__, __func__, #statePtr); \
                                if (((statePtr)->flags & TLS_TCL_ASYNC) == TLS_TCL_ASYNC) { dprintfBuffer_p += sprintf(dprintfBuffer_p, "|TLS_TCL_ASYNC"); }; \
                                if (((statePtr)->flags & TLS_TCL_SERVER) == TLS_TCL_SERVER) { dprintfBuffer_p += sprintf(dprintfBuffer_p, "|TLS_TCL_SERVER"); }; \
                                if (((statePtr)->flags & TLS_TCL_INIT) == TLS_TCL_INIT) { dprintfBuffer_p += sprintf(dprintfBuffer_p, "|TLS_TCL_INIT"); }; \
                                if (((statePtr)->flags & TLS_TCL_DEBUG) == TLS_TCL_DEBUG) { dprintfBuffer_p += sprintf(dprintfBuffer_p, "|TLS_TCL_DEBUG"); }; \
                                if (((statePtr)->flags & TLS_TCL_CALLBACK) == TLS_TCL_CALLBACK) { dprintfBuffer_p += sprintf(dprintfBuffer_p, "|TLS_TCL_CALLBACK"); }; \
                                if (((statePtr)->flags & TLS_TCL_HANDSHAKE_FAILED) == TLS_TCL_HANDSHAKE_FAILED) { dprintfBuffer_p += sprintf(dprintfBuffer_p, "|TLS_TCL_HANDSHAKE_FAILED"); }; \
                                if (((statePtr)->flags & TLS_TCL_FASTPATH) == TLS_TCL_FASTPATH) { dprintfBuffer_p += sprintf(dprintfBuffer_p, "|TLS_TCL_FASTPATH"); }; \
                                fprintf(stderr, "%s\n", dprintfBuffer); \
                              }
	char dprintfBuffer[8192], *dprintfBuffer_p; \
	dprintfBuffer_p = &dprintfBuffer[0]; \
	dprintfBuffer_p += sprintf(dprintfBuffer_p, "%s:%i:%s():%s->flags=0", __FILE__, __LINE__, __func__, #statePtr); \
	if (((statePtr)->flags & TLS_TCL_ASYNC) == TLS_TCL_ASYNC) { dprintfBuffer_p += sprintf(dprintfBuffer_p, "|TLS_TCL_ASYNC"); }; \
	if (((statePtr)->flags & TLS_TCL_SERVER) == TLS_TCL_SERVER) { dprintfBuffer_p += sprintf(dprintfBuffer_p, "|TLS_TCL_SERVER"); }; \
	if (((statePtr)->flags & TLS_TCL_INIT) == TLS_TCL_INIT) { dprintfBuffer_p += sprintf(dprintfBuffer_p, "|TLS_TCL_INIT"); }; \
	if (((statePtr)->flags & TLS_TCL_DEBUG) == TLS_TCL_DEBUG) { dprintfBuffer_p += sprintf(dprintfBuffer_p, "|TLS_TCL_DEBUG"); }; \
	if (((statePtr)->flags & TLS_TCL_CALLBACK) == TLS_TCL_CALLBACK) { dprintfBuffer_p += sprintf(dprintfBuffer_p, "|TLS_TCL_CALLBACK"); }; \
	if (((statePtr)->flags & TLS_TCL_HANDSHAKE_FAILED) == TLS_TCL_HANDSHAKE_FAILED) { dprintfBuffer_p += sprintf(dprintfBuffer_p, "|TLS_TCL_HANDSHAKE_FAILED"); }; \
	if (((statePtr)->flags & TLS_TCL_FASTPATH) == TLS_TCL_FASTPATH) { dprintfBuffer_p += sprintf(dprintfBuffer_p, "|TLS_TCL_FASTPATH"); }; \
	fprintf(stderr, "%s\n", dprintfBuffer); \
}
#else
#define dprintf(...) if (0) { fprintf(stderr, __VA_ARGS__); }
#define dprintBuffer(bufferName, bufferLength) /**/
#define dprintFlags(statePtr) /**/
#endif

#define TCLTLS_SSL_ERROR(ssl,err) ((char*)ERR_reason_error_string((unsigned long)SSL_get_error((ssl),(err))))
/*
 * OpenSSL BIO Routines
 */
#define BIO_TYPE_TCL	(19|0x0400)

/*
 * Defines for State.flags
 */
#define TLS_TCL_ASYNC	(1<<0)	/* non-blocking mode */
#define TLS_TCL_SERVER	(1<<1)	/* Server-Side */
#define TLS_TCL_INIT	(1<<2)	/* Initializing connection */
#define TLS_TCL_DEBUG	(1<<3)	/* Show debug tracing */
#define TLS_TCL_ASYNC		(1<<0)	/* non-blocking mode */
#define TLS_TCL_SERVER		(1<<1)	/* Server-Side */
#define TLS_TCL_INIT		(1<<2)	/* Initializing connection */
#define TLS_TCL_DEBUG		(1<<3)	/* Show debug tracing */
#define TLS_TCL_CALLBACK	(1<<4)	/* In a callback, prevent update
					 * looping problem. [Bug 1652380] */
#define TLS_TCL_HANDSHAKE_FAILED (1<<5) /* Set on handshake failures and once
#define TLS_TCL_HANDSHAKE_FAILED (1<<5) /* Set on handshake failures and once set, all
                                         * set, all further I/O will result
                                         * in ECONNABORTED errors. */
#define TLS_TCL_FASTPATH (1<<6)         /* The parent channel is being used directly by the SSL library */
                                         * further I/O will result in ECONNABORTED errors. */
#define TLS_TCL_FASTPATH 	(1<<6)	/* The parent channel is being used directly by the SSL library */
#define TLS_TCL_DELAY (5)

/*
 * This structure describes the per-instance state
 * This structure describes the per-instance state of an SSL channel.
 * of an ssl channel.
 *
 * The SSL processing context is maintained here, in the ClientData
 */
typedef struct State {
	Tcl_Channel self;       /* this socket channel */
	Tcl_TimerToken timer;

	int flags;              /* see State.flags above  */
	int watchMask;          /* current WatchProc mask */
	int mode;               /* current mode of parent channel */

	Tcl_Interp *interp;     /* interpreter in which this resides */
	Tcl_Obj *callback;      /* script called for tracing, verifying and errors */
	Tcl_Obj *password;      /* script called for certificate password */ 
	Tcl_Obj *password;      /* script called for certificate password */

	int vflags;             /* verify flags */
	SSL *ssl;               /* Struct for SSL processing */
	SSL_CTX *ctx;           /* SSL Context */
	BIO *bio;               /* Struct for SSL processing */
	BIO *p_bio;             /* Parent BIO (that is layered on Tcl_Channel) */

Modified tlsX509.c from [87f16e34d8] to [d4377f05cd].
1
2
3
4
5
6
7
8
9
10
11
12
13
14

15
16
17
18
19
20
21
1
2
3
4
5
6
7
8
9
10
11
12
13

14
15
16
17
18
19
20
21













-
+







/*
 * Copyright (C) 1997-2000 Sensus Consulting Ltd.
 * Matt Newman <matt@sensus.org>
 */
#include <tcl.h>
#include <stdio.h>
#include <openssl/bio.h>
#include <openssl/sha.h>
#include <openssl/x509.h>
#include <openssl/asn1.h>
#include "tlsInt.h"

/*
 *  Ensure these are not macros - known to be defined on Win32 
 *  Ensure these are not macros - known to be defined on Win32
 */
#ifdef min
#undef min
#endif

#ifdef max
#undef max
37
38
39
40
41
42
43
44

45
46
47
48

49
50
51

52
53
54
55
56
57
58
59
60
61
62
63
64

65
66
67


68
69
70
71
72
73
74
75
37
38
39
40
41
42
43

44

45
46

47
48
49

50
51
52
53
54
55
56
57
58
59
60
61


62
63


64
65

66
67
68
69
70
71
72







-
+
-


-
+


-
+











-
-
+

-
-
+
+
-







static char *
ASN1_UTCTIME_tostr(ASN1_UTCTIME *tm)
{
    static char bp[128];
    char *v;
    int gmt=0;
    static char *mon[12]={
        "Jan","Feb","Mar","Apr","May","Jun",
        "Jan","Feb","Mar","Apr","May","Jun", "Jul","Aug","Sep","Oct","Nov","Dec"};
        "Jul","Aug","Sep","Oct","Nov","Dec"};
    int i;
    int y=0,M=0,d=0,h=0,m=0,s=0;
    

    i=tm->length;
    v=(char *)tm->data;
    

    if (i < 10) goto err;
    if (v[i-1] == 'Z') gmt=1;
    for (i=0; i<10; i++)
        if ((v[i] > '9') || (v[i] < '0')) goto err;
    y= (v[0]-'0')*10+(v[1]-'0');
    if (y < 70) y+=100;
    M= (v[2]-'0')*10+(v[3]-'0');
    if ((M > 12) || (M < 1)) goto err;
    d= (v[4]-'0')*10+(v[5]-'0');
    h= (v[6]-'0')*10+(v[7]-'0');
    m=  (v[8]-'0')*10+(v[9]-'0');
    if (	(v[10] >= '0') && (v[10] <= '9') &&
		(v[11] >= '0') && (v[11] <= '9'))
    if ((v[10] >= '0') && (v[10] <= '9') && (v[11] >= '0') && (v[11] <= '9'))
        s=  (v[10]-'0')*10+(v[11]-'0');
    
    sprintf(bp,"%s %2d %02d:%02d:%02d %d%s",

    sprintf(bp,"%s %2d %02d:%02d:%02d %d%s", mon[M-1],d,h,m,s,y+1900,(gmt)?" GMT":"");
                   mon[M-1],d,h,m,s,y+1900,(gmt)?" GMT":"");
    return bp;
 err:
    return "Bad time value";
}

/*
 *------------------------------------------------------*
89
90
91
92
93
94
95
96
97


98
99
100
101
102
103
104
86
87
88
89
90
91
92


93
94
95
96
97
98
99
100
101







-
-
+
+







 *
 *------------------------------------------------------*
 */

#define CERT_STR_SIZE 16384

Tcl_Obj*
Tls_NewX509Obj( Tcl_Interp *interp, X509 *cert) {
    Tcl_Obj *certPtr = Tcl_NewListObj( 0, NULL);
Tls_NewX509Obj(Tcl_Interp *interp, X509 *cert) {
    Tcl_Obj *certPtr = Tcl_NewListObj(0, NULL);
    BIO *bio;
    int n;
    unsigned long flags;
    char subject[BUFSIZ];
    char issuer[BUFSIZ];
    char serial[BUFSIZ];
    char notBefore[BUFSIZ];
121
122
123
124
125
126
127
128

129
130
131
132
133
134
135
118
119
120
121
122
123
124

125
126
127
128
129
130
131
132







-
+







	subject[0] = 0;
	issuer[0]  = 0;
	serial[0]  = 0;
    } else {
	flags = XN_FLAG_RFC2253 | ASN1_STRFLGS_UTF8_CONVERT;
	flags &= ~ASN1_STRFLGS_ESC_MSB;

	X509_NAME_print_ex(bio, X509_get_subject_name(cert), 0, flags); 
	X509_NAME_print_ex(bio, X509_get_subject_name(cert), 0, flags);
	n = BIO_read(bio, subject, min(BIO_pending(bio), BUFSIZ - 1));
	n = max(n, 0);
	subject[n] = 0;
	(void)BIO_flush(bio);

	X509_NAME_print_ex(bio, X509_get_issuer_name(cert), 0, flags);
	n = BIO_read(bio, issuer, min(BIO_pending(bio), BUFSIZ - 1));
164
165
166
167
168
169
170
171
172


173
174
175


176
177
178
179
180
181
182
161
162
163
164
165
166
167


168
169
170


171
172
173
174
175
176
177
178
179







-
-
+
+

-
-
+
+







            (void)BIO_flush(bio);
        }

	BIO_free(bio);
    }

#if OPENSSL_VERSION_NUMBER < 0x10100000L
    strcpy( notBefore, ASN1_UTCTIME_tostr( X509_get_notBefore(cert) ));
    strcpy( notAfter, ASN1_UTCTIME_tostr( X509_get_notAfter(cert) ));
    strcpy(notBefore, ASN1_UTCTIME_tostr(X509_get_notBefore(cert)));
    strcpy(notAfter, ASN1_UTCTIME_tostr(X509_get_notAfter(cert)));
#else
    strcpy( notBefore, ASN1_UTCTIME_tostr( X509_getm_notBefore(cert) ));
    strcpy( notAfter, ASN1_UTCTIME_tostr( X509_getm_notAfter(cert) ));
    strcpy(notBefore, ASN1_UTCTIME_tostr(X509_getm_notBefore(cert)));
    strcpy(notAfter, ASN1_UTCTIME_tostr(X509_getm_notAfter(cert)));
#endif

#ifndef NO_SSL_SHA
    /* SHA1 */
    X509_digest(cert, EVP_sha1(), sha1_hash_binary, NULL);
    for (int n = 0; n < SHA_DIGEST_LENGTH; n++) {
        sha1_hash_ascii[n*2]   = shachars[(sha1_hash_binary[n] & 0xF0) >> 4];
1
2

3
4
5

6
7

8
9
10

11
12
13



14
15


16

17
18


19
20
21

22
23
24
25






26
27

28
29


30
31
32
33

34
35
36
37
38


39
40

41
42

43
44
45
46
47
48
49

50
51

52
53
54
55
56
57
58
59
60
61
62
63
64




1
2
3
4
5

6
7

8
9
10

11
12
13
14
15
16
17


18
19
20
21


22
23
24

25
26




27
28
29
30
31
32
33

34
35
36
37
38
39
40
41

42
43
44
45


46
47
48

49
50

51
52
53
54
55
56
57

58
59

60
61
62
63
64
65
66
67
68
69

70


71
72
73
74


+


-
+

-
+


-
+



+
+
+
-
-
+
+

+
-
-
+
+

-

+
-
-
-
-
+
+
+
+
+
+

-
+


+
+



-
+



-
-
+
+

-
+

-
+






-
+

-
+









-

-
-
+
+
+
+
	Windows DLL Build instructions using nmake build system
	2020-10-15 Harald.Oehlmann@elmicron.de
	2023-04-23 Brian O'Hagan

Properties:
- 32 bit DLL
- 64 bit DLL
- VisualStudio 2015
Note: Vuisual C++ 6 does not build OpenSSL (long long syntax error)
Note: Visual C++ 6 does not build OpenSSL (long long syntax error)
- Cygwin32 (temporary helper, please help to replace by tclsh)
- OpenSSL statically linked to TCLTLS DLL.
Note: Dynamic linking also works but results in a DLL dependeny on OPENSSL DLL's
Note: Dynamic linking also works but results in a DLL dependency on OPENSSL DLL's

1) Build OpenSSL static libraries:

(1a) Get OpenSSL
  https://github.com/openssl/openssl/releases/download/OpenSSL_1_1_1t/openssl-1.1.1t.tar.gz

OpenSSL source distribtution unpacked in:
c:\test\tcltls\Openssl_1_1_1h
  OpenSSL source distribution unpacked in:
  C:\Users\Brian\Documents\Source\Build\openssl-1.1.1t

(1b) Install Perl from https://strawberryperl.com/
- Install Perl from http://strawberryperl.com/download/5.32.0.1/strawberry-perl-5.32.0.1-32bit.msi
  to C:\perl
  https://strawberryperl.com/download/5.32.1.1/strawberry-perl-5.32.1.1-64bit.msi
  to C:\Strawberry\perl
  (ActivePerl failed due to missing 32 bit console module)
- Install NASM Assembler:

(1c) Install NASM Assembler from https://www.nasm.us/
https://www.nasm.us/pub/nasm/releasebuilds/2.15.05/win32/nasm-2.15.05-installer-x86.exe
  to C:\Program Files (x86)\NASM
  
-> Visual Studio x86 native prompt.
  https://www.nasm.us/pub/nasm/releasebuilds/2.16.01/win64/nasm-2.16.01-installer-x64.exe
  to C:\Program Files\NASM

(1d)
- Configure
  At Visual Studio x86 native prompt:

set Path=%PATH%;C:\Program Files (x86)\NASM;C:\Perl\perl\bin
set Path=%PATH%;C:\Program Files\NASM;C:\Strawberry\perl\bin

perl Configure VC-WIN32 --prefix=c:\test\tcltls\openssl --openssldir=c:\test\tcltls\openssldir no-shared no-filenames threads
perl ..\Configure VC-WIN64A no-asm no-ssl3 no-zlib no-comp no-ui-console no-autoload-config --api=1.1.0 --prefix="%installdir%" --openssldir="%commoninstalldir%" -DOPENSSL_NO_DEPRECATED


nmake
nmake test
namke install
nmake install

2) Build TCLTLS

Unzip distribution in:
c:\test\tcltls\tcltls-1.7.22
2a) Unzip distribution in:
C:\Users\Brian\Documents\Source\Build\tcltls-b5c41cdeb6

-> start cygwin bash prompt
2b) Start BASH shell (MinGW62 Git shell)

cd /cygdrive/c/test/tcltls/tcltls-1.7.22
cd /c/Users/Brian/Documents/Source/Build/tcltls-b5c41cdeb6
./gen_dh_params > dh_params.h

od -A n -v -t xC < 'tls.tcl' > tls.tcl.h.new.1
sed 's@[^0-9A-Fa-f]@@g;s@..@0x&, @g' < tls.tcl.h.new.1 > tls.tcl.h
rm -f tls.tcl.h.new.1

-> Visual Studio x86 native prompt.
2c) Start Visual Studio shell

cd C:\test\tcltls\tcltls-1.7.22\win
cd C:\Users\Brian\Documents\Source\Build\tcltls-b5c41cdeb6\win

nmake -f makefile.vc TCLDIR=c:\test\tcl8610 SSL_INSTALL_FOLDER=C:\test\tcltls\openssl

nmake -f makefile.vc install TCLDIR=c:\test\tcl8610 INSTALLDIR=c:\test\tcltls SSL_INSTALL_FOLDER=C:\test\tcltls\openssl

3) Test

Start tclsh or wish

lappend auto_path {C:\test\tcltls\tls1.7.22}
package require tls

A small "1.7.22" showing up is hopefully the end of this long way...
package require http
http::register https 443 [list ::tls::socket -autoservername true]
set tok [http::data [http::geturl https://www.tcl-lang.org]]
::http::cleanup $tok
1
2

3
4
5
6
7
8











9
10
11
12
13
14
15
1

2
3
4
5
6


7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

-
+




-
-
+
+
+
+
+
+
+
+
+
+
+







# call nmake with additional parameter SSL_INSTALL_FOLDER= with the
# OpenSSL instalation folder following.
# OpenSSL installation folder following.

PROJECT=tls
DOTVERSION = 1.7.22

PRJ_INCLUDES	= -I"$(SSL_INSTALL_FOLDER)\include"
PRJ_DEFINES =  -D NO_SSL2 -D NO_SSL3 -D _CRT_SECURE_NO_WARNINGS
PRJ_INCLUDES = -I"$(SSL_INSTALL_FOLDER)\include" -I"$(OPENSSL_INSTALL_DIR)\include"
PRJ_DEFINES = -D NO_SSL2 -D NO_SSL3 -D _CRT_SECURE_NO_WARNINGS
 
# SSL Libs:
#    1. ${LIBCRYPTO}.dll
#    2. ${LIBSSL}.dll
# Where LIBCRYPTO (#1.) and LIBSSL (#2.) are defined as follows:
#    v1.1: libcrypto-1.1-x64.dll and libssl-1.1-x64.dll
#    v3: libcrypto-3-x64.dll and libssl-3-x64.dll
# On *nix libcrypto.so.* and libssl.so.* (where suffix is a version indicator).
#

PRJ_LIBS = \
	"$(SSL_INSTALL_FOLDER)\lib\libssl.lib" \
	"$(SSL_INSTALL_FOLDER)\lib\libcrypto.lib" \
	WS2_32.LIB GDI32.LIB ADVAPI32.LIB CRYPT32.LIB USER32.LIB

PRJ_OBJS = $(TMP_DIR)\tls.obj \
Added win/nmakehlp.c version [b01f822eab].
Added win/rules.vc version [79247ddfc9].
1
2
3
4
5
6
7

8
9
10
11
12
13
14
1
2
3
4
5
6

7
8
9
10
11
12
13
14






-
+







#------------------------------------------------------------- -*- makefile -*-
# targets.vc --
#
# Part of the nmake based build system for Tcl and its extensions.
# This file defines some standard targets for the convenience of extensions
# and can be optionally included by the extension makefile.
# See TIP 477 (https://core.tcl-lang.org/tips/doc/trunk/tip/477.md) for docs.
# See TIP 477 (https://core.tcl-lang.org/tips/doc/main/tip/477.md) for docs.

$(PROJECT): setup pkgindex $(PRJLIB)

!ifdef PRJ_STUBOBJS
$(PROJECT): $(PRJSTUBLIB)
$(PRJSTUBLIB): $(PRJ_STUBOBJS)
	$(LIBCMD) $**