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 <[email protected]>
#
# $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}
|