TclTLS
Diff
Login
HomeTimelineDownloadBrowse SourceBranchesTagsTicketsWiki
Annotate Patch Side-by-side Diff

Differences From Artifact [3724c90f30]:

To Artifact [3de2fbdab5]:

1
2
3
4

5
6
7
8
9
10
11

1
2
3

4
5
6
7
8
9
10
11




-
+








#
# Copyright (C) 1997-2000 Matt Newman <matt@novadigm.com>
#
# $Header: /home/rkeene/tmp/cvs2fossil/../tcltls/tls/tls/tls.tcl,v 1.3 2000/07/27 01:58:18 hobbs Exp $
# $Header: /home/rkeene/tmp/cvs2fossil/../tcltls/tls/tls/tls.tcl,v 1.4 2003/05/15 20:44:46 razzell Exp $
#
namespace eval tls {
    variable logcmd tclLog
    variable debug 0
 
    # Default flags passed to tls::import
    variable defaults {}
︙
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

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








-
+




-
+








+
-
-
+
+
-
-



-
+

+
+








    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\""
	set options "-cadir, -cafile, -certfile, -cipher, -keyfile, -myaddr, -request, -require, -ssl2, -ssl3, or -tls1"
	set options "-cadir, -cafile, -certfile, -cipher, -command, -keyfile, -myaddr, -password, -request, -require, -ssl2, -ssl3, or -tls1"
    } else {
	set server 0

	set usage "wrong # args: should be \"tls::socket ?options? host port\""
	set options "-async, -cadir, -cafile, -certfile, -cipher, -keyfile, -myaddr, -myport, -request, -require, -ssl2, -ssl3, or -tls1"
	set options "-async, -cadir, -cafile, -certfile, -cipher, -command, -keyfile, -myaddr, -myport, -password, -request, -require, -ssl2, -ssl3, or -tls1"
    }
    set argc [llength $args]
    set sopts {}
    set iopts [concat [list -server $server] ${tls::defaults}]	;# Import options

    for {set idx 0} {$idx < $argc} {incr idx} {
	set arg [lindex $args $idx]
	switch -glob -- $server,$arg {
	    0,-async	{lappend sopts $arg}
	    0,-myport	-
	    *,-myaddr	{lappend sopts $arg [lindex $args [incr idx]]}
	    0,-myaddr	-
	    *,-myport	{lappend sopts $arg [lindex $args [incr idx]]}
	    0,-async	{lappend sopts $arg}
	    *,-cipher	-
	    *,-cadir	-
	    *,-cafile	-
	    *,-certfile	-
	    *,-keyfile	-
	    *,-cipher	-
	    *,-command	-
	    *,-keyfile	-
	    *,-password	-
	    *,-request	-
	    *,-require	-
	    *,-ssl2	-
	    *,-ssl3	-
	    *,-tls1	{lappend iopts $arg [lindex $args [incr idx]]}
	    -*		{return -code error "bad option \"$arg\": must be one of $options"}
	    default	{break}
︙
133
134
135
136
137
138
139
140
141
142

143
144
145
146
147
148
149

134
135
136
137
138
139
140


141
142
143
144
145
146
147
148
149








-
-

+








	log 2 "tls::_accept - called \"$callback\" succeeded"
    }
}
#
# Sample callback for hooking: -
#
# error
# info
# password
# verify
# info
#
proc tls::callback {option args} {
    variable debug

    #log 2 [concat $option $args]

    switch -- $option {
︙
202
203
204
205
206
207
208

209
210
211
212
213

214
215
216
217
218
219
220
221
222
223
224

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








+





+












	    return 0
	}
	if {$cb(handshake) == "done"} {
	    return 1
	}
    }
}

proc tls::password {} {
    log 0 "TLS/Password: did you forget to set your passwd!"
    # Return the worlds best kept secret password.
    return "secret"
}

proc tls::log {level msg} {
    variable debug
    variable logcmd

    if {$level > $debug || $logcmd == ""} {
	return
    }
    set cmd $logcmd
    lappend cmd $msg
    uplevel #0 $cmd
}
Powered by Fossil · RSS