Check-in [fe79338a36]
Overview
Comment: * win/makefile.vc: Added the MSVC build system (from the Tcl * win/rules.vc: sampleextension). * win/nmakehlp.c: * win/tls.rc Added Windows resource file. * tls.tcl: From patch #948155, added support for alternate socket commands. * tls.c: Quieten some MSVC warnings. Prefer ckalloc over Tcl_Alloc. (David Graveraux).
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: fe79338a36de2b2b953a427cf5c4b4110ae4191e
User & Date: patthoyts on 2004-12-17 16:01:43
Other Links: manifest | tags
Context
2004-12-23
01:26
Incremented minor version to 1.5.1 check-in: fa0664ed31 user: patthoyts tags: trunk
2004-12-17
16:01
* win/makefile.vc: Added the MSVC build system (from the Tcl * win/rules.vc: sampleextension). * win/nmakehlp.c: * win/tls.rc Added Windows resource file. * tls.tcl: From patch #948155, added support for alternate socket commands. * tls.c: Quieten some MSVC warnings. Prefer ckalloc over Tcl_Alloc. (David Graveraux). check-in: fe79338a36 user: patthoyts tags: trunk
2004-06-29
11:07
* tls.c: Fixup to build against tcl 8.3.3. Handle * tlsIO.c: 8.4 constification. check-in: 9633ce0e5c user: patthoyts tags: trunk
Changes
Modified ChangeLog from [fec6460738] to [22aa1345a6].












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







2004-12-17  Pat Thoyts  <patthoyts@users.sourceforge.net>

	* win/makefile.vc:  Added the MSVC build system (from the Tcl
	* win/rules.vc:     sampleextension).
	* win/nmakehlp.c:
	* win/tls.rc        Added Windows resource file.
	
	* tls.tcl:          From patch #948155, added support for
	                    alternate socket commands.
	* tls.c:            Quieten some MSVC warnings. Prefer ckalloc
	                    over Tcl_Alloc. (David Graveraux).

2004-06-29  Pat Thoyts  <patthoyts@users.sourceforge.net>

	* tls.c:            Fixup to build against tcl 8.3.3. Handle
	* tlsIO.c:          8.4 constification.

	* tlsInt.h:         Added headers required with MSVC on Win32.
	* tlsX509.c:        undef min and max if defined (win32).
Modified tls.c from [823c68fcb0] to [c3a95bcf2f].
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







-
+







/*
 * 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 
 *
 * $Header: /home/rkeene/tmp/cvs2fossil/../tcltls/tls/tls/tls.c,v 1.23 2004/06/29 11:07:08 patthoyts Exp $
 * $Header: /home/rkeene/tmp/cvs2fossil/../tcltls/tls/tls/tls.c,v 1.24 2004/12/17 16:01:44 patthoyts Exp $
 *
 * 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
 *
35
36
37
38
39
40
41


42
43
44
45
46
47
48
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50







+
+







 * Forward declarations
 */

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

static void	InfoCallback _ANSI_ARGS_ ((CONST SSL *ssl, int where, int ret));

static int	CiphersObjCmd _ANSI_ARGS_ ((ClientData clientData,
			Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));

static int	HandshakeObjCmd _ANSI_ARGS_ ((ClientData clientData,
			Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));

112
113
114
115
116
117
118
119

120
121
122
123
124
125
126
114
115
116
117
118
119
120

121
122
123
124
125
126
127
128







-
+







 */

#ifdef BSAFE
#define PRE_OPENSSL_0_9_4 1
#endif

/*
 * Per OpenSSL 0.9.4 Compat
 * 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))
#endif
137
138
139
140
141
142
143
144

145
146

147
148
149
150
151
152
153
139
140
141
142
143
144
145

146
147

148
149
150
151
152
153
154
155







-
+

-
+







 *	None
 *
 * Side effects:
 *	Calls callback (if defined)
 *-------------------------------------------------------------------
 */
static void
InfoCallback(SSL *ssl, int where, int ret)
InfoCallback(CONST SSL *ssl, int where, int ret)
{
    State *statePtr = (State*)SSL_get_app_data(ssl);
    State *statePtr = (State*)SSL_get_app_data((SSL *)ssl);
    Tcl_Obj *cmdPtr;
    char *major; char *minor;

    if (statePtr->callback == (Tcl_Obj*)NULL)
	return;

    cmdPtr = Tcl_DuplicateObj(statePtr->callback);
732
733
734
735
736
737
738
739

740
741
742
743
744
745
746
734
735
736
737
738
739
740

741
742
743
744
745
746
747
748







-
+







    if (cert && !*cert)		cert	= NULL;
    if (key && !*key)		key	= NULL;
    if (ciphers && !*ciphers)	ciphers	= NULL;
    if (CAfile && !*CAfile)	CAfile	= NULL;
    if (CAdir && !*CAdir)	CAdir	= NULL;

    /* new SSL state */
    statePtr		= (State *) Tcl_Alloc((unsigned) sizeof(State));
    statePtr		= (State *) ckalloc((unsigned) sizeof(State));
    statePtr->self	= (Tcl_Channel)NULL;
    statePtr->timer	= (Tcl_TimerToken)NULL;

    statePtr->flags	= flags;
    statePtr->watchMask	= 0;
    statePtr->mode	= 0;

849
850
851
852
853
854
855
856

857
858
859
860
861
862
863
851
852
853
854
855
856
857

858
859
860
861
862
863
864
865







-
+







     * 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, (void (*)())InfoCallback);
    SSL_CTX_set_info_callback(statePtr->ctx, InfoCallback);

    /* Create Tcl_Channel BIO Handler */
    statePtr->p_bio	= BIO_new_tcl(statePtr, BIO_CLOSE);
    statePtr->bio	= BIO_new(BIO_f_ssl());

    if (server) {
	statePtr->flags |= TLS_TCL_SERVER;
1328
1329
1330
1331
1332
1333
1334
1335

1336
1337
1338
1339
1340
1341
1342
1330
1331
1332
1333
1334
1335
1336

1337
1338
1339
1340
1341
1342
1343
1344







-
+







 */
void
Tls_Free( char *blockPtr )
{
    State *statePtr = (State *)blockPtr;

    Tls_Clean(statePtr);
    Tcl_Free(blockPtr);
    ckfree(blockPtr);
}

/*
 *-------------------------------------------------------------------
 *
 * Tls_Clean --
 *
Modified tls.tcl from [cf05a5fb78] to [e85b1d9a97].
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
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



-
+











+
+
+
+
+
+














+







#
# Copyright (C) 1997-2000 Matt Newman <matt@novadigm.com> 
#
# $Header: /home/rkeene/tmp/cvs2fossil/../tcltls/tls/tls/tls.tcl,v 1.6 2004/02/11 22:36:31 razzell Exp $
# $Header: /home/rkeene/tmp/cvs2fossil/../tcltls/tls/tls/tls.tcl,v 1.7 2004/12/17 16:02:03 patthoyts Exp $
#
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

    # Over-ride this if you are using a different socket command
    variable socketCmd
    if {![info exists socketCmd]} {
        set socketCmd [info command ::socket]
    }
}
#
# Backwards compatibility, also used to set the default
# context options
#
proc tls::init {args} {
    variable defaults

    set defaults $args
}
#
# Helper function - behaves exactly as the native socket command.
#
proc tls::socket {args} {
    variable socketCmd
    set idx [lsearch $args -server]
    if {$idx != -1} {
	set server 1
	set callback [lindex $args [expr {$idx+1}]]
	set args [lreplace $args $idx [expr {$idx+1}]]

	set usage "wrong # args: should be \"tls::socket -server command ?options? port\""
85
86
87
88
89
90
91
92

93
94
95
96
97
98
99
92
93
94
95
96
97
98

99
100
101
102
103
104
105
106







-
+







	set host [lindex $args [expr {$argc-2}]]
	set port [lindex $args [expr {$argc-1}]]
	lappend sopts $host $port
    }
    #
    # Create TCP/IP socket
    #
    set chan [eval ::socket $sopts]
    set chan [eval $socketCmd $sopts]
    if {!$server && [catch {
	#
	# Push SSL layer onto socket
	#
	eval [list tls::import] $chan $iopts
    } err]} {
	set info ${::errorInfo}
Added win/makefile.vc version [ded96baf4e].
Added win/nmakehlp.c version [5a07dd3536].
Added win/rules.vc version [f7a656a7f6].
Added win/tls.rc version [93d9423ff3].