Artifact
728bfdcbe058041ce9e773ae776a4600238f4ab22ce04ccf88edf03478230093:
0000: 23 0a 23 20 53 75 70 70 6f 72 74 20 66 75 6e 63 #.# Support func
0010: 74 69 6f 6e 73 20 66 6f 72 20 74 68 65 20 54 4c tions for the TL
0020: 53 20 65 78 74 65 6e 73 69 6f 6e 0a 23 0a 23 20 S extension.#.#
0030: 43 6f 70 79 72 69 67 68 74 20 28 43 29 20 31 39 Copyright (C) 19
0040: 39 37 2d 32 30 30 30 20 4d 61 74 74 20 4e 65 77 97-2000 Matt New
0050: 6d 61 6e 20 3c 6d 61 74 74 40 6e 6f 76 61 64 69 man <matt@novadi
0060: 67 6d 2e 63 6f 6d 3e 0a 23 0a 6e 61 6d 65 73 70 gm.com>.#.namesp
0070: 61 63 65 20 65 76 61 6c 20 74 6c 73 20 7b 0a 20 ace eval tls {.
0080: 20 20 20 76 61 72 69 61 62 6c 65 20 6c 6f 67 63 variable logc
0090: 6d 64 20 74 63 6c 4c 6f 67 0a 20 20 20 20 76 61 md tclLog. va
00a0: 72 69 61 62 6c 65 20 64 65 62 75 67 20 30 0a 0a riable debug 0..
00b0: 20 20 20 20 23 20 44 65 66 61 75 6c 74 20 66 6c # Default fl
00c0: 61 67 73 20 70 61 73 73 65 64 20 74 6f 20 74 6c ags passed to tl
00d0: 73 3a 3a 69 6d 70 6f 72 74 0a 20 20 20 20 76 61 s::import. va
00e0: 72 69 61 62 6c 65 20 64 65 66 61 75 6c 74 73 20 riable defaults
00f0: 7b 7d 0a 0a 20 20 20 20 23 20 4d 61 70 73 20 55 {}.. # Maps U
0100: 49 44 20 74 6f 20 53 65 72 76 65 72 20 53 6f 63 ID to Server Soc
0110: 6b 65 74 0a 20 20 20 20 76 61 72 69 61 62 6c 65 ket. variable
0120: 20 73 72 76 6d 61 70 0a 20 20 20 20 76 61 72 69 srvmap. vari
0130: 61 62 6c 65 20 73 72 76 75 69 64 20 30 0a 0a 20 able srvuid 0..
0140: 20 20 20 23 20 4f 76 65 72 2d 72 69 64 65 20 74 # Over-ride t
0150: 68 69 73 20 69 66 20 79 6f 75 20 61 72 65 20 75 his if you are u
0160: 73 69 6e 67 20 61 20 64 69 66 66 65 72 65 6e 74 sing a different
0170: 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 0a socket command.
0180: 20 20 20 20 76 61 72 69 61 62 6c 65 20 73 6f 63 variable soc
0190: 6b 65 74 43 6d 64 0a 20 20 20 20 69 66 20 7b 21 ketCmd. if {!
01a0: 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 73 6f 63 [info exists soc
01b0: 6b 65 74 43 6d 64 5d 7d 20 7b 0a 09 73 65 74 20 ketCmd]} {..set
01c0: 73 6f 63 6b 65 74 43 6d 64 20 5b 69 6e 66 6f 20 socketCmd [info
01d0: 63 6f 6d 6d 61 6e 64 20 3a 3a 73 6f 63 6b 65 74 command ::socket
01e0: 5d 0a 20 20 20 20 7d 0a 0a 20 20 20 20 23 20 54 ]. }.. # T
01f0: 68 69 73 20 69 73 20 74 68 65 20 70 6f 73 73 69 his is the possi
0200: 62 6c 65 20 61 72 67 75 6d 65 6e 74 73 20 74 6f ble arguments to
0210: 20 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 61 6e 64 tls::socket and
0220: 20 74 6c 73 3a 3a 69 6e 69 74 0a 20 20 20 20 23 tls::init. #
0230: 20 54 68 65 20 66 6f 72 6d 61 74 20 6f 66 20 74 The format of t
0240: 68 69 73 20 69 73 20 61 20 6c 69 73 74 20 6f 66 his is a list of
0250: 20 6c 69 73 74 73 0a 20 20 20 20 23 23 20 45 61 lists. ## Ea
0260: 63 68 20 69 6e 6e 65 72 20 6c 69 73 74 20 63 6f ch inner list co
0270: 6e 74 61 69 6e 73 20 74 68 65 20 66 6f 6c 6c 6f ntains the follo
0280: 77 69 6e 67 20 65 6c 65 6d 65 6e 74 73 0a 20 20 wing elements.
0290: 20 20 23 23 23 20 53 65 72 76 65 72 20 28 6d 61 ### Server (ma
02a0: 74 63 68 65 64 20 61 67 61 69 6e 73 74 20 22 73 tched against "s
02b0: 74 72 69 6e 67 20 6d 61 74 63 68 22 20 66 6f 72 tring match" for
02c0: 20 30 2f 31 29 0a 20 20 20 20 23 23 23 20 4f 70 0/1). ### Op
02d0: 74 69 6f 6e 20 6e 61 6d 65 0a 20 20 20 20 23 23 tion name. ##
02e0: 23 20 56 61 72 69 61 62 6c 65 20 74 6f 20 61 64 # Variable to ad
02f0: 64 20 74 68 65 20 6f 70 74 69 6f 6e 20 74 6f 3a d the option to:
0300: 0a 20 20 20 20 23 23 23 23 20 73 6f 70 74 73 3a . #### sopts:
0310: 20 5b 73 6f 63 6b 65 74 5d 20 6f 70 74 69 6f 6e [socket] option
0320: 0a 20 20 20 20 23 23 23 23 20 69 6f 70 74 73 3a . #### iopts:
0330: 20 5b 74 6c 73 3a 3a 69 6d 70 6f 72 74 5d 20 6f [tls::import] o
0340: 70 74 69 6f 6e 0a 20 20 20 20 23 23 23 20 48 6f ption. ### Ho
0350: 77 20 6d 61 6e 79 20 61 72 67 75 6d 65 6e 74 73 w many arguments
0360: 20 74 68 65 20 66 6f 6c 6c 6f 77 69 6e 67 20 74 the following t
0370: 68 65 20 6f 70 74 69 6f 6e 20 74 6f 20 63 6f 6e he option to con
0380: 73 75 6d 65 0a 20 20 20 20 76 61 72 69 61 62 6c sume. variabl
0390: 65 20 73 6f 63 6b 65 74 4f 70 74 69 6f 6e 52 75 e socketOptionRu
03a0: 6c 65 73 20 7b 0a 09 7b 30 20 2d 61 73 79 6e 63 les {..{0 -async
03b0: 20 73 6f 70 74 73 20 30 7d 0a 09 7b 2a 20 2d 6d sopts 0}..{* -m
03c0: 79 61 64 64 72 20 73 6f 70 74 73 20 31 7d 0a 09 yaddr sopts 1}..
03d0: 7b 30 20 2d 6d 79 70 6f 72 74 20 73 6f 70 74 73 {0 -myport sopts
03e0: 20 31 7d 0a 09 7b 2a 20 2d 74 79 70 65 20 73 6f 1}..{* -type so
03f0: 70 74 73 20 31 7d 0a 09 7b 2a 20 2d 61 6c 70 6e pts 1}..{* -alpn
0400: 20 69 6f 70 74 73 20 31 7d 0a 09 7b 2a 20 2d 63 iopts 1}..{* -c
0410: 61 64 69 72 20 69 6f 70 74 73 20 31 7d 0a 09 7b adir iopts 1}..{
0420: 2a 20 2d 63 61 66 69 6c 65 20 69 6f 70 74 73 20 * -cafile iopts
0430: 31 7d 0a 09 7b 2a 20 2d 63 61 73 74 6f 72 65 20 1}..{* -castore
0440: 69 6f 70 74 73 20 31 7d 0a 09 7b 2a 20 2d 63 65 iopts 1}..{* -ce
0450: 72 74 20 69 6f 70 74 73 20 31 7d 0a 09 7b 2a 20 rt iopts 1}..{*
0460: 2d 63 65 72 74 66 69 6c 65 20 69 6f 70 74 73 20 -certfile iopts
0470: 31 7d 0a 09 7b 2a 20 2d 63 69 70 68 65 72 20 69 1}..{* -cipher i
0480: 6f 70 74 73 20 31 7d 0a 09 7b 2a 20 2d 63 69 70 opts 1}..{* -cip
0490: 68 65 72 73 75 69 74 65 73 20 69 6f 70 74 73 20 hersuites iopts
04a0: 31 7d 0a 09 7b 2a 20 2d 63 6f 6d 6d 61 6e 64 20 1}..{* -command
04b0: 69 6f 70 74 73 20 31 7d 0a 09 7b 2a 20 2d 64 68 iopts 1}..{* -dh
04c0: 70 61 72 61 6d 73 20 69 6f 70 74 73 20 31 7d 0a params iopts 1}.
04d0: 09 7b 2a 20 2d 6b 65 79 20 69 6f 70 74 73 20 31 .{* -key iopts 1
04e0: 7d 0a 09 7b 2a 20 2d 6b 65 79 66 69 6c 65 20 69 }..{* -keyfile i
04f0: 6f 70 74 73 20 31 7d 0a 09 7b 2a 20 2d 70 61 73 opts 1}..{* -pas
0500: 73 77 6f 72 64 20 69 6f 70 74 73 20 31 7d 0a 09 sword iopts 1}..
0510: 7b 2a 20 2d 70 6f 73 74 5f 68 61 6e 64 73 68 61 {* -post_handsha
0520: 6b 65 20 69 6f 70 74 73 20 31 7d 0a 09 7b 2a 20 ke iopts 1}..{*
0530: 2d 72 65 71 75 65 73 74 20 69 6f 70 74 73 20 31 -request iopts 1
0540: 7d 0a 09 7b 2a 20 2d 72 65 71 75 69 72 65 20 69 }..{* -require i
0550: 6f 70 74 73 20 31 7d 0a 09 7b 2a 20 2d 73 65 63 opts 1}..{* -sec
0560: 75 72 69 74 79 5f 6c 65 76 65 6c 20 69 6f 70 74 urity_level iopt
0570: 73 20 31 7d 0a 09 7b 2a 20 2d 61 75 74 6f 73 65 s 1}..{* -autose
0580: 72 76 65 72 6e 61 6d 65 20 64 69 73 63 61 72 64 rvername discard
0590: 4f 70 74 73 20 31 7d 0a 09 7b 2a 20 2d 73 65 72 Opts 1}..{* -ser
05a0: 76 65 72 20 69 6f 70 74 73 20 31 7d 0a 09 7b 2a ver iopts 1}..{*
05b0: 20 2d 73 65 72 76 65 72 6e 61 6d 65 20 69 6f 70 -servername iop
05c0: 74 73 20 31 7d 0a 09 7b 2a 20 2d 73 65 73 73 69 ts 1}..{* -sessi
05d0: 6f 6e 5f 69 64 20 69 6f 70 74 73 20 31 7d 0a 09 on_id iopts 1}..
05e0: 7b 2a 20 2d 73 73 6c 32 20 69 6f 70 74 73 20 31 {* -ssl2 iopts 1
05f0: 7d 0a 09 7b 2a 20 2d 73 73 6c 33 20 69 6f 70 74 }..{* -ssl3 iopt
0600: 73 20 31 7d 0a 09 7b 2a 20 2d 74 6c 73 31 20 69 s 1}..{* -tls1 i
0610: 6f 70 74 73 20 31 7d 0a 09 7b 2a 20 2d 74 6c 73 opts 1}..{* -tls
0620: 31 2e 31 20 69 6f 70 74 73 20 31 7d 0a 09 7b 2a 1.1 iopts 1}..{*
0630: 20 2d 74 6c 73 31 2e 32 20 69 6f 70 74 73 20 31 -tls1.2 iopts 1
0640: 7d 0a 09 7b 2a 20 2d 74 6c 73 31 2e 33 20 69 6f }..{* -tls1.3 io
0650: 70 74 73 20 31 7d 0a 09 7b 2a 20 2d 76 61 6c 69 pts 1}..{* -vali
0660: 64 61 74 65 63 6f 6d 6d 61 6e 64 20 69 6f 70 74 datecommand iopt
0670: 73 20 31 7d 0a 09 7b 2a 20 2d 76 63 6d 64 20 69 s 1}..{* -vcmd i
0680: 6f 70 74 73 20 31 7d 0a 20 20 20 20 7d 0a 0a 20 opts 1}. }..
0690: 20 20 20 23 20 74 6c 73 3a 3a 73 6f 63 6b 65 74 # tls::socket
06a0: 20 61 6e 64 20 74 6c 73 3a 3a 69 6e 69 74 20 6f and tls::init o
06b0: 70 74 69 6f 6e 73 20 61 73 20 61 20 68 75 6d 61 ptions as a huma
06c0: 6e 65 20 72 65 61 64 61 62 6c 65 20 73 74 72 69 ne readable stri
06d0: 6e 67 0a 20 20 20 20 76 61 72 69 61 62 6c 65 20 ng. variable
06e0: 73 6f 63 6b 65 74 4f 70 74 69 6f 6e 73 4e 6f 53 socketOptionsNoS
06f0: 65 72 76 65 72 0a 20 20 20 20 76 61 72 69 61 62 erver. variab
0700: 6c 65 20 73 6f 63 6b 65 74 4f 70 74 69 6f 6e 73 le socketOptions
0710: 53 65 72 76 65 72 0a 0a 20 20 20 20 23 20 49 6e Server.. # In
0720: 74 65 72 6e 61 6c 20 5b 73 77 69 74 63 68 5d 20 ternal [switch]
0730: 62 6f 64 79 20 74 6f 20 76 61 6c 69 64 61 74 65 body to validate
0740: 20 6f 70 74 69 6f 6e 73 0a 20 20 20 20 76 61 72 options. var
0750: 69 61 62 6c 65 20 73 6f 63 6b 65 74 4f 70 74 69 iable socketOpti
0760: 6f 6e 73 53 77 69 74 63 68 42 6f 64 79 0a 7d 0a onsSwitchBody.}.
0770: 0a 70 72 6f 63 20 74 6c 73 3a 3a 5f 69 6e 69 74 .proc tls::_init
0780: 73 6f 63 6b 65 74 6f 70 74 69 6f 6e 73 20 7b 7d socketoptions {}
0790: 20 7b 0a 20 20 20 20 76 61 72 69 61 62 6c 65 20 {. variable
07a0: 73 6f 63 6b 65 74 4f 70 74 69 6f 6e 52 75 6c 65 socketOptionRule
07b0: 73 0a 20 20 20 20 76 61 72 69 61 62 6c 65 20 73 s. variable s
07c0: 6f 63 6b 65 74 4f 70 74 69 6f 6e 73 4e 6f 53 65 ocketOptionsNoSe
07d0: 72 76 65 72 0a 20 20 20 20 76 61 72 69 61 62 6c rver. variabl
07e0: 65 20 73 6f 63 6b 65 74 4f 70 74 69 6f 6e 73 53 e socketOptionsS
07f0: 65 72 76 65 72 0a 20 20 20 20 76 61 72 69 61 62 erver. variab
0800: 6c 65 20 73 6f 63 6b 65 74 4f 70 74 69 6f 6e 73 le socketOptions
0810: 53 77 69 74 63 68 42 6f 64 79 0a 0a 20 20 20 20 SwitchBody..
0820: 23 20 44 6f 20 6e 6f 74 20 72 65 2d 72 75 6e 20 # Do not re-run
0830: 69 66 20 77 65 20 68 61 76 65 20 61 6c 72 65 61 if we have alrea
0840: 64 79 20 62 65 65 6e 20 69 6e 69 74 69 61 6c 69 dy been initiali
0850: 7a 65 64 0a 20 20 20 20 69 66 20 7b 5b 69 6e 66 zed. if {[inf
0860: 6f 20 65 78 69 73 74 73 20 73 6f 63 6b 65 74 4f o exists socketO
0870: 70 74 69 6f 6e 73 53 77 69 74 63 68 42 6f 64 79 ptionsSwitchBody
0880: 5d 7d 20 7b 0a 09 72 65 74 75 72 6e 0a 20 20 20 ]} {..return.
0890: 20 7d 0a 0a 20 20 20 20 23 20 43 72 65 61 74 65 }.. # Create
08a0: 20 73 65 76 65 72 61 6c 20 73 74 72 75 63 74 75 several structu
08b0: 72 65 73 20 66 72 6f 6d 20 6f 75 72 20 6c 69 73 res from our lis
08c0: 74 20 6f 66 20 6f 70 74 69 6f 6e 73 0a 20 20 20 t of options.
08d0: 20 23 23 20 31 2e 20 6f 70 74 69 6f 6e 73 3a 20 ## 1. options:
08e0: 61 20 74 65 78 74 20 72 65 70 72 65 73 65 6e 74 a text represent
08f0: 61 74 69 6f 6e 20 6f 66 20 74 68 65 20 76 61 6c ation of the val
0900: 69 64 20 6f 70 74 69 6f 6e 73 20 66 6f 72 20 74 id options for t
0910: 68 65 20 63 75 72 72 65 6e 74 0a 20 20 20 20 23 he current. #
0920: 23 20 20 20 20 20 20 20 20 20 20 20 20 20 73 65 # se
0930: 72 76 65 72 20 74 79 70 65 0a 20 20 20 20 23 23 rver type. ##
0940: 20 32 2e 20 61 72 67 53 77 69 74 63 68 42 6f 64 2. argSwitchBod
0950: 79 3a 20 53 77 69 74 63 68 20 62 6f 64 79 20 66 y: Switch body f
0960: 6f 72 20 70 72 6f 63 65 73 73 69 6e 67 20 61 72 or processing ar
0970: 67 75 6d 65 6e 74 73 0a 20 20 20 20 73 65 74 20 guments. set
0980: 6f 70 74 69 6f 6e 73 28 30 29 20 5b 6c 69 73 74 options(0) [list
0990: 5d 0a 20 20 20 20 73 65 74 20 6f 70 74 69 6f 6e ]. set option
09a0: 73 28 31 29 20 5b 6c 69 73 74 5d 0a 20 20 20 20 s(1) [list].
09b0: 73 65 74 20 61 72 67 53 77 69 74 63 68 42 6f 64 set argSwitchBod
09c0: 79 20 5b 6c 69 73 74 5d 0a 20 20 20 20 66 6f 72 y [list]. for
09d0: 65 61 63 68 20 6f 70 74 69 6f 6e 52 75 6c 65 20 each optionRule
09e0: 24 73 6f 63 6b 65 74 4f 70 74 69 6f 6e 52 75 6c $socketOptionRul
09f0: 65 73 20 7b 0a 09 73 65 74 20 72 75 6c 65 53 65 es {..set ruleSe
0a00: 72 76 65 72 20 5b 6c 69 6e 64 65 78 20 24 6f 70 rver [lindex $op
0a10: 74 69 6f 6e 52 75 6c 65 20 30 5d 0a 09 73 65 74 tionRule 0]..set
0a20: 20 72 75 6c 65 4f 70 74 69 6f 6e 20 5b 6c 69 6e ruleOption [lin
0a30: 64 65 78 20 24 6f 70 74 69 6f 6e 52 75 6c 65 20 dex $optionRule
0a40: 31 5d 0a 09 73 65 74 20 72 75 6c 65 56 61 72 54 1]..set ruleVarT
0a50: 6f 55 70 64 61 74 65 20 5b 6c 69 6e 64 65 78 20 oUpdate [lindex
0a60: 24 6f 70 74 69 6f 6e 52 75 6c 65 20 32 5d 0a 09 $optionRule 2]..
0a70: 73 65 74 20 72 75 6c 65 56 61 72 41 72 67 73 54 set ruleVarArgsT
0a80: 6f 43 6f 6e 73 75 6d 65 20 5b 6c 69 6e 64 65 78 oConsume [lindex
0a90: 20 24 6f 70 74 69 6f 6e 52 75 6c 65 20 33 5d 0a $optionRule 3].
0aa0: 0a 09 66 6f 72 65 61 63 68 20 73 65 72 76 65 72 ..foreach server
0ab0: 20 5b 6c 69 73 74 20 30 20 31 5d 20 7b 0a 09 20 [list 0 1] {..
0ac0: 20 20 20 69 66 20 7b 21 5b 73 74 72 69 6e 67 20 if {![string
0ad0: 6d 61 74 63 68 20 24 72 75 6c 65 53 65 72 76 65 match $ruleServe
0ae0: 72 20 24 73 65 72 76 65 72 5d 7d 20 7b 0a 09 09 r $server]} {...
0af0: 63 6f 6e 74 69 6e 75 65 0a 09 20 20 20 20 7d 0a continue.. }.
0b00: 0a 09 20 20 20 20 6c 61 70 70 65 6e 64 20 6f 70 .. lappend op
0b10: 74 69 6f 6e 73 28 24 73 65 72 76 65 72 29 20 24 tions($server) $
0b20: 72 75 6c 65 4f 70 74 69 6f 6e 0a 09 7d 0a 0a 09 ruleOption..}...
0b30: 73 77 69 74 63 68 20 2d 2d 20 24 72 75 6c 65 56 switch -- $ruleV
0b40: 61 72 41 72 67 73 54 6f 43 6f 6e 73 75 6d 65 20 arArgsToConsume
0b50: 7b 0a 09 20 20 20 20 30 20 7b 0a 09 09 73 65 74 {.. 0 {...set
0b60: 20 61 72 67 54 6f 45 78 65 63 75 74 65 20 7b 0a argToExecute {.
0b70: 09 09 20 20 20 20 6c 61 70 70 65 6e 64 20 40 56 .. lappend @V
0b80: 41 52 40 20 24 61 72 67 0a 09 09 20 20 20 20 73 AR@ $arg... s
0b90: 65 74 20 61 72 67 73 41 72 72 61 79 28 24 61 72 et argsArray($ar
0ba0: 67 29 20 74 72 75 65 0a 09 09 7d 0a 09 20 20 20 g) true...}..
0bb0: 20 7d 0a 09 20 20 20 20 31 20 7b 0a 09 09 73 65 }.. 1 {...se
0bc0: 74 20 61 72 67 54 6f 45 78 65 63 75 74 65 20 7b t argToExecute {
0bd0: 0a 09 09 20 20 20 20 69 6e 63 72 20 69 64 78 0a ... incr idx.
0be0: 09 09 20 20 20 20 69 66 20 7b 24 69 64 78 20 3e .. if {$idx >
0bf0: 3d 20 5b 6c 6c 65 6e 67 74 68 20 24 61 72 67 73 = [llength $args
0c00: 5d 7d 20 7b 0a 09 09 09 72 65 74 75 72 6e 20 2d ]} {....return -
0c10: 63 6f 64 65 20 65 72 72 6f 72 20 22 5c 22 24 61 code error "\"$a
0c20: 72 67 5c 22 20 6f 70 74 69 6f 6e 20 6d 75 73 74 rg\" option must
0c30: 20 62 65 20 66 6f 6c 6c 6f 77 65 64 20 62 79 20 be followed by
0c40: 76 61 6c 75 65 22 0a 09 09 20 20 20 20 7d 0a 09 value"... }..
0c50: 09 20 20 20 20 73 65 74 20 61 72 67 56 61 6c 75 . set argValu
0c60: 65 20 5b 6c 69 6e 64 65 78 20 24 61 72 67 73 20 e [lindex $args
0c70: 24 69 64 78 5d 0a 09 09 20 20 20 20 6c 61 70 70 $idx]... lapp
0c80: 65 6e 64 20 40 56 41 52 40 20 24 61 72 67 20 24 end @VAR@ $arg $
0c90: 61 72 67 56 61 6c 75 65 0a 09 09 20 20 20 20 73 argValue... s
0ca0: 65 74 20 61 72 67 73 41 72 72 61 79 28 24 61 72 et argsArray($ar
0cb0: 67 29 20 24 61 72 67 56 61 6c 75 65 0a 09 09 7d g) $argValue...}
0cc0: 0a 09 20 20 20 20 7d 0a 09 20 20 20 20 64 65 66 .. }.. def
0cd0: 61 75 6c 74 20 7b 0a 09 09 72 65 74 75 72 6e 20 ault {...return
0ce0: 2d 63 6f 64 65 20 65 72 72 6f 72 20 22 49 6e 74 -code error "Int
0cf0: 65 72 6e 61 6c 20 61 72 67 75 6d 65 6e 74 20 63 ernal argument c
0d00: 6f 6e 73 74 72 75 63 74 69 6f 6e 20 65 72 72 6f onstruction erro
0d10: 72 22 0a 09 20 20 20 20 7d 0a 09 7d 0a 0a 09 6c r".. }..}...l
0d20: 61 70 70 65 6e 64 20 61 72 67 53 77 69 74 63 68 append argSwitch
0d30: 42 6f 64 79 20 24 72 75 6c 65 53 65 72 76 65 72 Body $ruleServer
0d40: 2c 24 72 75 6c 65 4f 70 74 69 6f 6e 20 5b 73 74 ,$ruleOption [st
0d50: 72 69 6e 67 20 6d 61 70 20 5b 6c 69 73 74 20 40 ring map [list @
0d60: 56 41 52 40 20 24 72 75 6c 65 56 61 72 54 6f 55 VAR@ $ruleVarToU
0d70: 70 64 61 74 65 5d 20 24 61 72 67 54 6f 45 78 65 pdate] $argToExe
0d80: 63 75 74 65 5d 0a 20 20 20 20 7d 0a 0a 20 20 20 cute]. }..
0d90: 20 23 20 41 64 64 20 69 6e 20 74 68 65 20 66 69 # Add in the fi
0da0: 6e 61 6c 20 6f 70 74 69 6f 6e 73 0a 20 20 20 20 nal options.
0db0: 6c 61 70 70 65 6e 64 20 61 72 67 53 77 69 74 63 lappend argSwitc
0dc0: 68 42 6f 64 79 20 7b 2a 2c 2d 2a 7d 20 7b 72 65 hBody {*,-*} {re
0dd0: 74 75 72 6e 20 2d 63 6f 64 65 20 65 72 72 6f 72 turn -code error
0de0: 20 22 62 61 64 20 6f 70 74 69 6f 6e 20 5c 22 24 "bad option \"$
0df0: 61 72 67 5c 22 3a 20 6d 75 73 74 20 62 65 20 6f arg\": must be o
0e00: 6e 65 20 6f 66 20 24 6f 70 74 69 6f 6e 73 22 7d ne of $options"}
0e10: 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 61 72 67 . lappend arg
0e20: 53 77 69 74 63 68 42 6f 64 79 20 64 65 66 61 75 SwitchBody defau
0e30: 6c 74 20 62 72 65 61 6b 0a 0a 20 20 20 20 23 20 lt break.. #
0e40: 53 65 74 20 74 68 65 20 66 69 6e 61 6c 20 76 61 Set the final va
0e50: 72 69 61 62 6c 65 73 0a 20 20 20 20 73 65 74 20 riables. set
0e60: 73 6f 63 6b 65 74 4f 70 74 69 6f 6e 73 4e 6f 53 socketOptionsNoS
0e70: 65 72 76 65 72 20 20 20 5b 6a 6f 69 6e 20 24 6f erver [join $o
0e80: 70 74 69 6f 6e 73 28 30 29 20 7b 2c 20 7d 5d 0a ptions(0) {, }].
0e90: 20 20 20 20 73 65 74 20 73 6f 63 6b 65 74 4f 70 set socketOp
0ea0: 74 69 6f 6e 73 53 65 72 76 65 72 20 20 20 20 20 tionsServer
0eb0: 5b 6a 6f 69 6e 20 24 6f 70 74 69 6f 6e 73 28 31 [join $options(1
0ec0: 29 20 7b 2c 20 7d 5d 0a 20 20 20 20 73 65 74 20 ) {, }]. set
0ed0: 73 6f 63 6b 65 74 4f 70 74 69 6f 6e 73 53 77 69 socketOptionsSwi
0ee0: 74 63 68 42 6f 64 79 20 24 61 72 67 53 77 69 74 tchBody $argSwit
0ef0: 63 68 42 6f 64 79 0a 7d 0a 0a 70 72 6f 63 20 74 chBody.}..proc t
0f00: 6c 73 3a 3a 69 6e 69 74 6c 69 62 20 7b 64 69 72 ls::initlib {dir
0f10: 20 64 6c 6c 7d 20 7b 0a 20 20 20 20 23 20 50 61 dll} {. # Pa
0f20: 63 6b 61 67 65 20 69 6e 64 65 78 20 63 64 27 73 ckage index cd's
0f30: 20 69 6e 74 6f 20 74 68 65 20 70 61 63 6b 61 67 into the packag
0f40: 65 20 64 69 72 65 63 74 6f 72 79 20 66 6f 72 20 e directory for
0f50: 6c 6f 61 64 69 6e 67 2e 0a 20 20 20 20 23 20 49 loading.. # I
0f60: 72 72 65 6c 65 76 61 6e 74 20 74 6f 20 75 6e 69 rrelevant to uni
0f70: 78 6f 69 64 73 2c 20 62 75 74 20 66 6f 72 20 57 xoids, but for W
0f80: 69 6e 64 6f 77 73 20 74 68 69 73 20 65 6e 61 62 indows this enab
0f90: 6c 65 73 20 74 68 65 20 4f 53 20 74 6f 20 66 69 les the OS to fi
0fa0: 6e 64 0a 20 20 20 20 23 20 74 68 65 20 64 65 70 nd. # the dep
0fb0: 65 6e 64 65 6e 74 20 44 4c 4c 27 73 20 69 6e 20 endent DLL's in
0fc0: 74 68 65 20 43 57 44 2c 20 77 68 65 72 65 20 74 the CWD, where t
0fd0: 68 65 79 20 6d 61 79 20 62 65 2e 0a 20 20 20 20 hey may be..
0fe0: 73 65 74 20 63 77 64 20 5b 70 77 64 5d 0a 20 20 set cwd [pwd].
0ff0: 20 20 63 61 74 63 68 20 7b 63 64 20 24 64 69 72 catch {cd $dir
1000: 7d 0a 20 20 20 20 69 66 20 7b 5b 73 74 72 69 6e }. if {[strin
1010: 67 20 65 71 75 61 6c 20 24 3a 3a 74 63 6c 5f 70 g equal $::tcl_p
1020: 6c 61 74 66 6f 72 6d 28 70 6c 61 74 66 6f 72 6d latform(platform
1030: 29 20 22 77 69 6e 64 6f 77 73 22 5d 20 26 26 0a ) "windows"] &&.
1040: 09 21 5b 73 74 72 69 6e 67 20 65 71 75 61 6c 20 .![string equal
1050: 5b 6c 69 6e 64 65 78 20 5b 66 69 6c 65 20 73 79 [lindex [file sy
1060: 73 74 65 6d 20 24 64 69 72 5d 20 30 5d 20 22 6e stem $dir] 0] "n
1070: 61 74 69 76 65 22 5d 7d 20 7b 0a 09 23 20 49 66 ative"]} {..# If
1080: 20 69 74 20 69 73 20 61 20 77 72 61 70 70 65 64 it is a wrapped
1090: 20 65 78 65 63 75 74 61 62 6c 65 20 72 75 6e 6e executable runn
10a0: 69 6e 67 20 6f 6e 20 77 69 6e 64 6f 77 73 2c 20 ing on windows,
10b0: 74 68 65 20 6f 70 65 6e 73 73 6c 0a 09 23 20 64 the openssl..# d
10c0: 6c 6c 73 20 6d 75 73 74 20 62 65 20 63 6f 70 69 lls must be copi
10d0: 65 64 20 6f 75 74 20 6f 66 20 74 68 65 20 76 69 ed out of the vi
10e0: 72 74 75 61 6c 20 66 69 6c 65 73 79 73 74 65 6d rtual filesystem
10f0: 20 74 6f 20 74 68 65 20 64 69 73 6b 0a 09 23 20 to the disk..#
1100: 77 68 65 72 65 20 57 69 6e 64 6f 77 73 20 77 69 where Windows wi
1110: 6c 6c 20 66 69 6e 64 20 74 68 65 6d 20 77 68 65 ll find them whe
1120: 6e 20 72 65 73 6f 6c 76 69 6e 67 20 74 68 65 20 n resolving the
1130: 64 65 70 65 6e 64 65 6e 63 79 20 69 6e 0a 09 23 dependency in..#
1140: 20 74 68 65 20 74 6c 73 20 64 6c 6c 2e 20 57 65 the tls dll. We
1150: 20 63 68 6f 6f 73 65 20 74 6f 20 6d 61 6b 65 20 choose to make
1160: 74 68 65 6d 20 73 69 62 6c 69 6e 67 73 20 6f 66 them siblings of
1170: 20 74 68 65 20 65 78 65 63 75 74 61 62 6c 65 2e the executable.
1180: 0a 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 ..package requir
1190: 65 20 73 74 61 72 6b 69 74 0a 09 73 65 74 20 64 e starkit..set d
11a0: 73 74 20 5b 66 69 6c 65 20 6e 61 74 69 76 65 6e st [file nativen
11b0: 61 6d 65 20 5b 66 69 6c 65 20 64 69 72 6e 61 6d ame [file dirnam
11c0: 65 20 24 73 74 61 72 6b 69 74 3a 3a 74 6f 70 64 e $starkit::topd
11d0: 69 72 5d 5d 0a 09 66 6f 72 65 61 63 68 20 73 64 ir]]..foreach sd
11e0: 6c 6c 20 5b 67 6c 6f 62 20 2d 6e 6f 63 6f 6d 70 ll [glob -nocomp
11f0: 6c 61 69 6e 20 2d 64 69 72 65 63 74 6f 72 79 20 lain -directory
1200: 24 64 69 72 20 2d 74 61 69 6c 73 20 6c 69 62 73 $dir -tails libs
1210: 73 6c 33 32 2e 64 6c 6c 20 6c 69 62 63 72 79 70 sl32.dll libcryp
1220: 74 6f 2a 2e 64 6c 6c 20 6c 69 62 73 73 6c 2a 2e to*.dll libssl*.
1230: 64 6c 6c 20 6c 69 62 73 73 70 2a 2e 64 6c 6c 5d dll libssp*.dll]
1240: 20 7b 0a 09 20 20 20 20 63 61 74 63 68 20 7b 66 {.. catch {f
1250: 69 6c 65 20 64 65 6c 65 74 65 20 2d 66 6f 72 63 ile delete -forc
1260: 65 20 20 20 20 20 20 20 20 20 20 20 20 24 64 73 e $ds
1270: 74 2f 24 73 64 6c 6c 7d 0a 09 20 20 20 20 63 61 t/$sdll}.. ca
1280: 74 63 68 20 7b 66 69 6c 65 20 63 6f 70 79 20 20 tch {file copy
1290: 20 2d 66 6f 72 63 65 20 24 64 69 72 2f 24 73 64 -force $dir/$sd
12a0: 6c 6c 20 24 64 73 74 2f 24 73 64 6c 6c 7d 0a 09 ll $dst/$sdll}..
12b0: 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 }. }. set
12c0: 72 65 73 20 5b 63 61 74 63 68 20 7b 75 70 6c 65 res [catch {uple
12d0: 76 65 6c 20 23 30 20 5b 6c 69 73 74 20 6c 6f 61 vel #0 [list loa
12e0: 64 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 5b 70 77 d [file join [pw
12f0: 64 5d 20 24 64 6c 6c 5d 5d 7d 20 65 72 72 5d 0a d] $dll]]} err].
1300: 20 20 20 20 63 61 74 63 68 20 7b 63 64 20 24 63 catch {cd $c
1310: 77 64 7d 0a 20 20 20 20 69 66 20 7b 24 72 65 73 wd}. if {$res
1320: 7d 20 7b 0a 09 6e 61 6d 65 73 70 61 63 65 20 65 } {..namespace e
1330: 76 61 6c 20 5b 6e 61 6d 65 73 70 61 63 65 20 70 val [namespace p
1340: 61 72 65 6e 74 5d 20 7b 6e 61 6d 65 73 70 61 63 arent] {namespac
1350: 65 20 64 65 6c 65 74 65 20 74 6c 73 7d 0a 09 72 e delete tls}..r
1360: 65 74 75 72 6e 20 2d 63 6f 64 65 20 24 72 65 73 eturn -code $res
1370: 20 24 65 72 72 0a 20 20 20 20 7d 0a 20 20 20 20 $err. }.
1380: 72 65 6e 61 6d 65 20 74 6c 73 3a 3a 69 6e 69 74 rename tls::init
1390: 6c 69 62 20 7b 7d 0a 7d 0a 0a 0a 23 0a 23 20 42 lib {}.}...#.# B
13a0: 61 63 6b 77 61 72 64 73 20 63 6f 6d 70 61 74 69 ackwards compati
13b0: 62 69 6c 69 74 79 2c 20 61 6c 73 6f 20 75 73 65 bility, also use
13c0: 64 20 74 6f 20 73 65 74 20 74 68 65 20 64 65 66 d to set the def
13d0: 61 75 6c 74 0a 23 20 63 6f 6e 74 65 78 74 20 6f ault.# context o
13e0: 70 74 69 6f 6e 73 0a 23 0a 70 72 6f 63 20 74 6c ptions.#.proc tl
13f0: 73 3a 3a 69 6e 69 74 20 7b 61 72 67 73 7d 20 7b s::init {args} {
1400: 0a 20 20 20 20 76 61 72 69 61 62 6c 65 20 64 65 . variable de
1410: 66 61 75 6c 74 73 0a 20 20 20 20 76 61 72 69 61 faults. varia
1420: 62 6c 65 20 73 6f 63 6b 65 74 4f 70 74 69 6f 6e ble socketOption
1430: 73 4e 6f 53 65 72 76 65 72 0a 20 20 20 20 76 61 sNoServer. va
1440: 72 69 61 62 6c 65 20 73 6f 63 6b 65 74 4f 70 74 riable socketOpt
1450: 69 6f 6e 73 53 65 72 76 65 72 0a 20 20 20 20 76 ionsServer. v
1460: 61 72 69 61 62 6c 65 20 73 6f 63 6b 65 74 4f 70 ariable socketOp
1470: 74 69 6f 6e 73 53 77 69 74 63 68 42 6f 64 79 0a tionsSwitchBody.
1480: 0a 20 20 20 20 74 6c 73 3a 3a 5f 69 6e 69 74 73 . tls::_inits
1490: 6f 63 6b 65 74 6f 70 74 69 6f 6e 73 0a 0a 20 20 ocketoptions..
14a0: 20 20 23 20 54 65 63 68 6e 69 63 61 6c 6c 79 20 # Technically
14b0: 61 20 74 68 69 72 64 20 6f 70 74 69 6f 6e 20 73 a third option s
14c0: 68 6f 75 6c 64 20 62 65 20 75 73 65 64 20 68 65 hould be used he
14d0: 72 65 3a 20 4f 70 74 69 6f 6e 73 20 74 68 61 74 re: Options that
14e0: 20 61 72 65 20 76 61 6c 69 64 0a 20 20 20 20 23 are valid. #
14f0: 20 6f 6e 6c 79 20 61 20 62 6f 74 68 20 73 65 72 only a both ser
1500: 76 65 72 73 20 61 6e 64 20 6e 6f 6e 2d 73 65 72 vers and non-ser
1510: 76 65 72 73 0a 20 20 20 20 73 65 74 20 73 65 72 vers. set ser
1520: 76 65 72 20 2d 31 0a 20 20 20 20 73 65 74 20 6f ver -1. set o
1530: 70 74 69 6f 6e 73 20 24 73 6f 63 6b 65 74 4f 70 ptions $socketOp
1540: 74 69 6f 6e 73 53 65 72 76 65 72 0a 0a 20 20 20 tionsServer..
1550: 20 23 20 56 61 6c 69 64 61 74 65 20 61 72 67 75 # Validate argu
1560: 6d 65 6e 74 73 20 70 61 73 73 65 64 0a 20 20 20 ments passed.
1570: 20 73 65 74 20 69 6e 69 74 69 61 6c 41 72 67 73 set initialArgs
1580: 20 24 61 72 67 73 0a 20 20 20 20 73 65 74 20 61 $args. set a
1590: 72 67 63 20 5b 6c 6c 65 6e 67 74 68 20 24 61 72 rgc [llength $ar
15a0: 67 73 5d 0a 0a 20 20 20 20 61 72 72 61 79 20 73 gs].. array s
15b0: 65 74 20 61 72 67 73 41 72 72 61 79 20 5b 6c 69 et argsArray [li
15c0: 73 74 5d 0a 20 20 20 20 66 6f 72 20 7b 73 65 74 st]. for {set
15d0: 20 69 64 78 20 30 7d 20 7b 24 69 64 78 20 3c 20 idx 0} {$idx <
15e0: 24 61 72 67 63 7d 20 7b 69 6e 63 72 20 69 64 78 $argc} {incr idx
15f0: 7d 20 7b 0a 09 73 65 74 20 61 72 67 20 5b 6c 69 } {..set arg [li
1600: 6e 64 65 78 20 24 61 72 67 73 20 24 69 64 78 5d ndex $args $idx]
1610: 0a 09 73 77 69 74 63 68 20 2d 67 6c 6f 62 20 2d ..switch -glob -
1620: 2d 20 24 73 65 72 76 65 72 2c 24 61 72 67 20 24 - $server,$arg $
1630: 73 6f 63 6b 65 74 4f 70 74 69 6f 6e 73 53 77 69 socketOptionsSwi
1640: 74 63 68 42 6f 64 79 0a 20 20 20 20 7d 0a 0a 20 tchBody. }..
1650: 20 20 20 73 65 74 20 64 65 66 61 75 6c 74 73 20 set defaults
1660: 24 69 6e 69 74 69 61 6c 41 72 67 73 0a 7d 0a 23 $initialArgs.}.#
1670: 0a 23 20 48 65 6c 70 65 72 20 66 75 6e 63 74 69 .# Helper functi
1680: 6f 6e 20 2d 20 62 65 68 61 76 65 73 20 65 78 61 on - behaves exa
1690: 63 74 6c 79 20 61 73 20 74 68 65 20 6e 61 74 69 ctly as the nati
16a0: 76 65 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e ve socket comman
16b0: 64 2e 0a 23 0a 70 72 6f 63 20 74 6c 73 3a 3a 73 d..#.proc tls::s
16c0: 6f 63 6b 65 74 20 7b 61 72 67 73 7d 20 7b 0a 20 ocket {args} {.
16d0: 20 20 20 76 61 72 69 61 62 6c 65 20 73 6f 63 6b variable sock
16e0: 65 74 43 6d 64 0a 20 20 20 20 76 61 72 69 61 62 etCmd. variab
16f0: 6c 65 20 64 65 66 61 75 6c 74 73 0a 20 20 20 20 le defaults.
1700: 76 61 72 69 61 62 6c 65 20 73 6f 63 6b 65 74 4f variable socketO
1710: 70 74 69 6f 6e 73 4e 6f 53 65 72 76 65 72 0a 20 ptionsNoServer.
1720: 20 20 20 76 61 72 69 61 62 6c 65 20 73 6f 63 6b variable sock
1730: 65 74 4f 70 74 69 6f 6e 73 53 65 72 76 65 72 0a etOptionsServer.
1740: 20 20 20 20 76 61 72 69 61 62 6c 65 20 73 6f 63 variable soc
1750: 6b 65 74 4f 70 74 69 6f 6e 73 53 77 69 74 63 68 ketOptionsSwitch
1760: 42 6f 64 79 0a 0a 20 20 20 20 74 6c 73 3a 3a 5f Body.. tls::_
1770: 69 6e 69 74 73 6f 63 6b 65 74 6f 70 74 69 6f 6e initsocketoption
1780: 73 0a 0a 20 20 20 20 73 65 74 20 69 64 78 20 5b s.. set idx [
1790: 6c 73 65 61 72 63 68 20 24 61 72 67 73 20 2d 73 lsearch $args -s
17a0: 65 72 76 65 72 5d 0a 20 20 20 20 69 66 20 7b 24 erver]. if {$
17b0: 69 64 78 20 21 3d 20 2d 31 7d 20 7b 0a 09 73 65 idx != -1} {..se
17c0: 74 20 73 65 72 76 65 72 20 31 0a 09 73 65 74 20 t server 1..set
17d0: 63 61 6c 6c 62 61 63 6b 20 5b 6c 69 6e 64 65 78 callback [lindex
17e0: 20 24 61 72 67 73 20 5b 65 78 70 72 20 7b 24 69 $args [expr {$i
17f0: 64 78 2b 31 7d 5d 5d 0a 09 73 65 74 20 61 72 67 dx+1}]]..set arg
1800: 73 20 5b 6c 72 65 70 6c 61 63 65 20 24 61 72 67 s [lreplace $arg
1810: 73 20 24 69 64 78 20 5b 65 78 70 72 20 7b 24 69 s $idx [expr {$i
1820: 64 78 2b 31 7d 5d 5d 0a 0a 09 73 65 74 20 75 73 dx+1}]]...set us
1830: 61 67 65 20 22 77 72 6f 6e 67 20 23 20 61 72 67 age "wrong # arg
1840: 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 5c 22 74 s: should be \"t
1850: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
1860: 65 72 20 63 6f 6d 6d 61 6e 64 20 3f 6f 70 74 69 er command ?opti
1870: 6f 6e 73 3f 20 70 6f 72 74 5c 22 22 0a 09 73 65 ons? port\""..se
1880: 74 20 6f 70 74 69 6f 6e 73 20 24 73 6f 63 6b 65 t options $socke
1890: 74 4f 70 74 69 6f 6e 73 53 65 72 76 65 72 0a 20 tOptionsServer.
18a0: 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 73 65 74 } else {..set
18b0: 20 73 65 72 76 65 72 20 30 0a 0a 09 73 65 74 20 server 0...set
18c0: 75 73 61 67 65 20 22 77 72 6f 6e 67 20 23 20 61 usage "wrong # a
18d0: 72 67 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 5c rgs: should be \
18e0: 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 3f 6f 70 "tls::socket ?op
18f0: 74 69 6f 6e 73 3f 20 68 6f 73 74 20 70 6f 72 74 tions? host port
1900: 5c 22 22 0a 09 73 65 74 20 6f 70 74 69 6f 6e 73 \""..set options
1910: 20 24 73 6f 63 6b 65 74 4f 70 74 69 6f 6e 73 4e $socketOptionsN
1920: 6f 53 65 72 76 65 72 0a 20 20 20 20 7d 0a 0a 20 oServer. }..
1930: 20 20 20 23 20 43 6f 6d 62 69 6e 65 20 64 65 66 # Combine def
1940: 61 75 6c 74 73 20 77 69 74 68 20 63 75 72 72 65 aults with curre
1950: 6e 74 20 6f 70 74 69 6f 6e 73 0a 20 20 20 20 73 nt options. s
1960: 65 74 20 61 72 67 73 20 5b 63 6f 6e 63 61 74 20 et args [concat
1970: 24 64 65 66 61 75 6c 74 73 20 24 61 72 67 73 5d $defaults $args]
1980: 0a 0a 20 20 20 20 73 65 74 20 61 72 67 63 20 5b .. set argc [
1990: 6c 6c 65 6e 67 74 68 20 24 61 72 67 73 5d 0a 20 llength $args].
19a0: 20 20 20 73 65 74 20 73 6f 70 74 73 20 7b 7d 0a set sopts {}.
19b0: 20 20 20 20 73 65 74 20 69 6f 70 74 73 20 5b 6c set iopts [l
19c0: 69 73 74 20 2d 73 65 72 76 65 72 20 24 73 65 72 ist -server $ser
19d0: 76 65 72 5d 0a 0a 20 20 20 20 61 72 72 61 79 20 ver].. array
19e0: 73 65 74 20 61 72 67 73 41 72 72 61 79 20 5b 6c set argsArray [l
19f0: 69 73 74 5d 0a 20 20 20 20 66 6f 72 20 7b 73 65 ist]. for {se
1a00: 74 20 69 64 78 20 30 7d 20 7b 24 69 64 78 20 3c t idx 0} {$idx <
1a10: 20 24 61 72 67 63 7d 20 7b 69 6e 63 72 20 69 64 $argc} {incr id
1a20: 78 7d 20 7b 0a 09 73 65 74 20 61 72 67 20 5b 6c x} {..set arg [l
1a30: 69 6e 64 65 78 20 24 61 72 67 73 20 24 69 64 78 index $args $idx
1a40: 5d 0a 09 73 77 69 74 63 68 20 2d 67 6c 6f 62 20 ]..switch -glob
1a50: 2d 2d 20 24 73 65 72 76 65 72 2c 24 61 72 67 20 -- $server,$arg
1a60: 24 73 6f 63 6b 65 74 4f 70 74 69 6f 6e 73 53 77 $socketOptionsSw
1a70: 69 74 63 68 42 6f 64 79 0a 20 20 20 20 7d 0a 0a itchBody. }..
1a80: 20 20 20 20 69 66 20 7b 24 73 65 72 76 65 72 7d if {$server}
1a90: 20 7b 0a 09 69 66 20 7b 28 24 69 64 78 20 2b 20 {..if {($idx +
1aa0: 31 29 20 21 3d 20 24 61 72 67 63 7d 20 7b 0a 09 1) != $argc} {..
1ab0: 20 20 20 20 72 65 74 75 72 6e 20 2d 63 6f 64 65 return -code
1ac0: 20 65 72 72 6f 72 20 24 75 73 61 67 65 0a 09 7d error $usage..}
1ad0: 0a 09 73 65 74 20 75 69 64 20 5b 69 6e 63 72 20 ..set uid [incr
1ae0: 3a 3a 74 6c 73 3a 3a 73 72 76 75 69 64 5d 0a 0a ::tls::srvuid]..
1af0: 09 73 65 74 20 70 6f 72 74 20 5b 6c 69 6e 64 65 .set port [linde
1b00: 78 20 24 61 72 67 73 20 5b 65 78 70 72 20 7b 24 x $args [expr {$
1b10: 61 72 67 63 2d 31 7d 5d 5d 0a 09 6c 61 70 70 65 argc-1}]]..lappe
1b20: 6e 64 20 73 6f 70 74 73 20 24 70 6f 72 74 0a 09 nd sopts $port..
1b30: 23 73 65 74 20 73 6f 70 74 73 20 5b 6c 69 6e 73 #set sopts [lins
1b40: 65 72 74 20 24 73 6f 70 74 73 20 30 20 2d 73 65 ert $sopts 0 -se
1b50: 72 76 65 72 20 24 63 61 6c 6c 62 61 63 6b 5d 0a rver $callback].
1b60: 09 73 65 74 20 73 6f 70 74 73 20 5b 6c 69 6e 73 .set sopts [lins
1b70: 65 72 74 20 24 73 6f 70 74 73 20 30 20 2d 73 65 ert $sopts 0 -se
1b80: 72 76 65 72 20 5b 6c 69 73 74 20 74 6c 73 3a 3a rver [list tls::
1b90: 5f 61 63 63 65 70 74 20 24 69 6f 70 74 73 20 24 _accept $iopts $
1ba0: 63 61 6c 6c 62 61 63 6b 5d 5d 0a 09 23 73 65 74 callback]]..#set
1bb0: 20 73 6f 70 74 73 20 5b 6c 69 6e 73 65 72 74 20 sopts [linsert
1bc0: 24 73 6f 70 74 73 20 30 20 2d 73 65 72 76 65 72 $sopts 0 -server
1bd0: 20 5b 6c 69 73 74 20 74 6c 73 3a 3a 5f 61 63 63 [list tls::_acc
1be0: 65 70 74 20 24 75 69 64 20 24 63 61 6c 6c 62 61 ept $uid $callba
1bf0: 63 6b 5d 5d 0a 20 20 20 20 7d 20 65 6c 73 65 20 ck]]. } else
1c00: 7b 0a 09 69 66 20 7b 28 24 69 64 78 20 2b 20 32 {..if {($idx + 2
1c10: 29 20 21 3d 20 24 61 72 67 63 7d 20 7b 0a 09 20 ) != $argc} {..
1c20: 20 20 20 72 65 74 75 72 6e 20 2d 63 6f 64 65 20 return -code
1c30: 65 72 72 6f 72 20 24 75 73 61 67 65 0a 09 7d 0a error $usage..}.
1c40: 0a 09 73 65 74 20 68 6f 73 74 20 5b 6c 69 6e 64 ..set host [lind
1c50: 65 78 20 24 61 72 67 73 20 5b 65 78 70 72 20 7b ex $args [expr {
1c60: 24 61 72 67 63 2d 32 7d 5d 5d 0a 09 73 65 74 20 $argc-2}]]..set
1c70: 70 6f 72 74 20 5b 6c 69 6e 64 65 78 20 24 61 72 port [lindex $ar
1c80: 67 73 20 5b 65 78 70 72 20 7b 24 61 72 67 63 2d gs [expr {$argc-
1c90: 31 7d 5d 5d 0a 0a 09 23 20 49 66 20 61 6e 20 22 1}]]...# If an "
1ca0: 2d 61 75 74 6f 73 65 72 76 65 72 6e 61 6d 65 22 -autoservername"
1cb0: 20 6f 70 74 69 6f 6e 20 69 73 20 66 6f 75 6e 64 option is found
1cc0: 2c 20 68 6f 6e 6f 72 20 69 74 0a 09 69 66 20 7b , honor it..if {
1cd0: 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 61 72 67 [info exists arg
1ce0: 73 41 72 72 61 79 28 2d 61 75 74 6f 73 65 72 76 sArray(-autoserv
1cf0: 65 72 6e 61 6d 65 29 5d 20 26 26 20 24 61 72 67 ername)] && $arg
1d00: 73 41 72 72 61 79 28 2d 61 75 74 6f 73 65 72 76 sArray(-autoserv
1d10: 65 72 6e 61 6d 65 29 7d 20 7b 0a 09 20 20 20 20 ername)} {..
1d20: 69 66 20 7b 21 5b 69 6e 66 6f 20 65 78 69 73 74 if {![info exist
1d30: 73 20 61 72 67 73 41 72 72 61 79 28 2d 73 65 72 s argsArray(-ser
1d40: 76 65 72 6e 61 6d 65 29 5d 7d 20 7b 0a 09 09 73 vername)]} {...s
1d50: 65 74 20 61 72 67 73 41 72 72 61 79 28 2d 73 65 et argsArray(-se
1d60: 72 76 65 72 6e 61 6d 65 29 20 24 68 6f 73 74 0a rvername) $host.
1d70: 09 09 6c 61 70 70 65 6e 64 20 69 6f 70 74 73 20 ..lappend iopts
1d80: 2d 73 65 72 76 65 72 6e 61 6d 65 20 24 68 6f 73 -servername $hos
1d90: 74 0a 09 20 20 20 20 7d 0a 09 7d 0a 0a 09 23 20 t.. }..}...#
1da0: 55 73 65 20 68 6f 73 74 20 61 73 20 53 4e 49 20 Use host as SNI
1db0: 73 65 72 76 65 72 20 6e 61 6d 65 20 77 69 74 68 server name with
1dc0: 6f 75 74 20 2d 61 75 74 6f 73 65 72 76 65 72 6e out -autoservern
1dd0: 61 6d 65 20 61 6e 64 20 2d 73 65 72 76 65 72 6e ame and -servern
1de0: 61 6d 65 20 61 72 67 73 0a 09 69 66 20 7b 21 5b ame args..if {![
1df0: 69 6e 66 6f 20 65 78 69 73 74 73 20 61 72 67 73 info exists args
1e00: 41 72 72 61 79 28 2d 61 75 74 6f 73 65 72 76 65 Array(-autoserve
1e10: 72 6e 61 6d 65 29 5d 20 26 26 20 0a 09 09 21 5b rname)] && ...![
1e20: 69 6e 66 6f 20 65 78 69 73 74 73 20 61 72 67 73 info exists args
1e30: 41 72 72 61 79 28 2d 73 65 72 76 65 72 6e 61 6d Array(-servernam
1e40: 65 29 5d 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 e)]} {.. set
1e50: 61 72 67 73 41 72 72 61 79 28 2d 73 65 72 76 65 argsArray(-serve
1e60: 72 6e 61 6d 65 29 20 24 68 6f 73 74 0a 09 20 20 rname) $host..
1e70: 20 20 6c 61 70 70 65 6e 64 20 69 6f 70 74 73 20 lappend iopts
1e80: 2d 73 65 72 76 65 72 6e 61 6d 65 20 24 68 6f 73 -servername $hos
1e90: 74 0a 09 7d 0a 0a 09 6c 61 70 70 65 6e 64 20 73 t..}...lappend s
1ea0: 6f 70 74 73 20 24 68 6f 73 74 20 24 70 6f 72 74 opts $host $port
1eb0: 0a 20 20 20 20 7d 0a 20 20 20 20 23 0a 20 20 20 . }. #.
1ec0: 20 23 20 43 72 65 61 74 65 20 54 43 50 2f 49 50 # Create TCP/IP
1ed0: 20 73 6f 63 6b 65 74 0a 20 20 20 20 23 0a 20 20 socket. #.
1ee0: 20 20 73 65 74 20 63 68 61 6e 20 5b 65 76 61 6c set chan [eval
1ef0: 20 24 73 6f 63 6b 65 74 43 6d 64 20 24 73 6f 70 $socketCmd $sop
1f00: 74 73 5d 0a 20 20 20 20 69 66 20 7b 21 24 73 65 ts]. if {!$se
1f10: 72 76 65 72 20 26 26 20 5b 63 61 74 63 68 20 7b rver && [catch {
1f20: 0a 09 23 0a 09 23 20 50 75 73 68 20 53 53 4c 20 ..#..# Push SSL
1f30: 6c 61 79 65 72 20 6f 6e 74 6f 20 73 6f 63 6b 65 layer onto socke
1f40: 74 0a 09 23 0a 09 65 76 61 6c 20 5b 6c 69 73 74 t..#..eval [list
1f50: 20 74 6c 73 3a 3a 69 6d 70 6f 72 74 5d 20 24 63 tls::import] $c
1f60: 68 61 6e 20 24 69 6f 70 74 73 0a 20 20 20 20 7d han $iopts. }
1f70: 20 65 72 72 5d 7d 20 7b 0a 09 73 65 74 20 69 6e err]} {..set in
1f80: 66 6f 20 24 7b 3a 3a 65 72 72 6f 72 49 6e 66 6f fo ${::errorInfo
1f90: 7d 0a 09 63 61 74 63 68 20 7b 63 6c 6f 73 65 20 }..catch {close
1fa0: 24 63 68 61 6e 7d 0a 09 72 65 74 75 72 6e 20 2d $chan}..return -
1fb0: 63 6f 64 65 20 65 72 72 6f 72 20 2d 65 72 72 6f code error -erro
1fc0: 72 69 6e 66 6f 20 24 69 6e 66 6f 20 24 65 72 72 rinfo $info $err
1fd0: 0a 20 20 20 20 7d 0a 20 20 20 20 72 65 74 75 72 . }. retur
1fe0: 6e 20 24 63 68 61 6e 0a 7d 0a 0a 23 20 74 6c 73 n $chan.}..# tls
1ff0: 3a 3a 5f 61 63 63 65 70 74 20 2d 2d 0a 23 0a 23 ::_accept --.#.#
2000: 20 20 20 54 68 69 73 20 69 73 20 74 68 65 20 61 This is the a
2010: 63 74 75 61 6c 20 61 63 63 65 70 74 20 74 68 61 ctual accept tha
2020: 74 20 54 4c 53 20 73 6f 63 6b 65 74 73 20 75 73 t TLS sockets us
2030: 65 2c 20 77 68 69 63 68 20 74 68 65 6e 20 63 61 e, which then ca
2040: 6c 6c 73 0a 23 20 20 20 74 68 65 20 63 61 6c 6c lls.# the call
2050: 62 61 63 6b 20 72 65 67 69 73 74 65 72 65 64 20 back registered
2060: 62 79 20 74 6c 73 3a 3a 73 6f 63 6b 65 74 2e 0a by tls::socket..
2070: 23 0a 23 20 41 72 67 75 6d 65 6e 74 73 3a 0a 23 #.# Arguments:.#
2080: 20 20 20 69 6f 70 74 73 09 74 6c 73 3a 3a 69 6d iopts.tls::im
2090: 70 6f 72 74 20 6f 70 74 73 0a 23 20 20 20 63 61 port opts.# ca
20a0: 6c 6c 62 61 63 6b 09 73 65 72 76 65 72 20 63 61 llback.server ca
20b0: 6c 6c 62 61 63 6b 20 74 6f 20 69 6e 76 6f 6b 65 llback to invoke
20c0: 0a 23 20 20 20 63 68 61 6e 09 73 6f 63 6b 65 74 .# chan.socket
20d0: 20 63 68 61 6e 6e 65 6c 20 74 6f 20 61 63 63 65 channel to acce
20e0: 70 74 2f 64 65 6e 79 0a 23 20 20 20 69 70 61 64 pt/deny.# ipad
20f0: 64 72 09 63 61 6c 6c 69 6e 67 20 49 50 20 61 64 dr.calling IP ad
2100: 64 72 65 73 73 0a 23 20 20 20 70 6f 72 74 09 63 dress.# port.c
2110: 61 6c 6c 69 6e 67 20 70 6f 72 74 0a 23 0a 23 20 alling port.#.#
2120: 52 65 73 75 6c 74 73 3a 0a 23 20 20 20 52 65 74 Results:.# Ret
2130: 75 72 6e 73 20 61 6e 20 65 72 72 6f 72 20 69 66 urns an error if
2140: 20 74 68 65 20 63 61 6c 6c 62 61 63 6b 20 74 68 the callback th
2150: 72 6f 77 73 20 6f 6e 65 2e 0a 23 0a 70 72 6f 63 rows one..#.proc
2160: 20 74 6c 73 3a 3a 5f 61 63 63 65 70 74 20 7b 20 tls::_accept {
2170: 69 6f 70 74 73 20 63 61 6c 6c 62 61 63 6b 20 63 iopts callback c
2180: 68 61 6e 20 69 70 61 64 64 72 20 70 6f 72 74 20 han ipaddr port
2190: 7d 20 7b 0a 20 20 20 20 6c 6f 67 20 32 20 5b 6c } {. log 2 [l
21a0: 69 73 74 20 74 6c 73 3a 3a 5f 61 63 63 65 70 74 ist tls::_accept
21b0: 20 24 69 6f 70 74 73 20 24 63 61 6c 6c 62 61 63 $iopts $callbac
21c0: 6b 20 24 63 68 61 6e 20 24 69 70 61 64 64 72 20 k $chan $ipaddr
21d0: 24 70 6f 72 74 5d 0a 0a 20 20 20 20 73 65 74 20 $port].. set
21e0: 63 68 61 6e 20 5b 65 76 61 6c 20 5b 6c 69 73 74 chan [eval [list
21f0: 20 74 6c 73 3a 3a 69 6d 70 6f 72 74 20 24 63 68 tls::import $ch
2200: 61 6e 5d 20 24 69 6f 70 74 73 5d 0a 0a 20 20 20 an] $iopts]..
2210: 20 6c 61 70 70 65 6e 64 20 63 61 6c 6c 62 61 63 lappend callbac
2220: 6b 20 24 63 68 61 6e 20 24 69 70 61 64 64 72 20 k $chan $ipaddr
2230: 24 70 6f 72 74 0a 20 20 20 20 69 66 20 7b 5b 63 $port. if {[c
2240: 61 74 63 68 20 7b 0a 09 75 70 6c 65 76 65 6c 20 atch {..uplevel
2250: 23 30 20 24 63 61 6c 6c 62 61 63 6b 0a 20 20 20 #0 $callback.
2260: 20 7d 20 65 72 72 5d 7d 20 7b 0a 09 6c 6f 67 20 } err]} {..log
2270: 31 20 22 74 6c 73 3a 3a 5f 61 63 63 65 70 74 20 1 "tls::_accept
2280: 65 72 72 6f 72 3a 20 24 7b 3a 3a 65 72 72 6f 72 error: ${::error
2290: 49 6e 66 6f 7d 22 0a 09 63 6c 6f 73 65 20 24 63 Info}"..close $c
22a0: 68 61 6e 0a 09 65 72 72 6f 72 20 24 65 72 72 20 han..error $err
22b0: 24 3a 3a 65 72 72 6f 72 49 6e 66 6f 20 24 3a 3a $::errorInfo $::
22c0: 65 72 72 6f 72 43 6f 64 65 0a 20 20 20 20 7d 20 errorCode. }
22d0: 65 6c 73 65 20 7b 0a 09 6c 6f 67 20 32 20 22 74 else {..log 2 "t
22e0: 6c 73 3a 3a 5f 61 63 63 65 70 74 20 2d 20 63 61 ls::_accept - ca
22f0: 6c 6c 65 64 20 5c 22 24 63 61 6c 6c 62 61 63 6b lled \"$callback
2300: 5c 22 20 73 75 63 63 65 65 64 65 64 22 0a 20 20 \" succeeded".
2310: 20 20 7d 0a 7d 0a 0a 23 0a 23 20 53 61 6d 70 6c }.}..#.# Sampl
2320: 65 20 63 61 6c 6c 62 61 63 6b 20 66 6f 72 20 73 e callback for s
2330: 74 61 74 75 73 20 64 61 74 61 20 66 72 6f 6d 20 tatus data from
2340: 4f 70 65 6e 53 53 4c 0a 23 0a 70 72 6f 63 20 74 OpenSSL.#.proc t
2350: 6c 73 3a 3a 63 61 6c 6c 62 61 63 6b 20 7b 6f 70 ls::callback {op
2360: 74 69 6f 6e 20 63 68 61 6e 20 61 72 67 73 7d 20 tion chan args}
2370: 7b 0a 20 20 20 20 76 61 72 69 61 62 6c 65 20 64 {. variable d
2380: 65 62 75 67 0a 0a 20 20 20 20 73 77 69 74 63 68 ebug.. switch
2390: 20 2d 2d 20 24 6f 70 74 69 6f 6e 20 7b 0a 09 22 -- $option {.."
23a0: 65 72 72 6f 72 22 20 7b 0a 09 20 20 20 20 6c 61 error" {.. la
23b0: 73 73 69 67 6e 20 24 61 72 67 73 20 6d 73 67 0a ssign $args msg.
23c0: 0a 09 20 20 20 20 6c 6f 67 20 30 20 22 54 4c 53 .. log 0 "TLS
23d0: 2f 24 63 68 61 6e 3a 20 65 72 72 6f 72 3a 20 24 /$chan: error: $
23e0: 6d 73 67 22 0a 09 7d 0a 09 22 69 6e 66 6f 22 20 msg"..}.."info"
23f0: 7b 0a 09 20 20 20 20 73 65 74 20 74 79 70 65 20 {.. set type
2400: 22 22 0a 09 20 20 20 20 6c 61 73 73 69 67 6e 20 "".. lassign
2410: 24 61 72 67 73 20 6d 61 6a 6f 72 20 6d 69 6e 6f $args major mino
2420: 72 20 6d 73 67 20 74 79 70 65 0a 0a 09 20 20 20 r msg type...
2430: 20 69 66 20 7b 24 6d 73 67 20 6e 65 20 22 22 7d if {$msg ne ""}
2440: 20 7b 0a 09 09 61 70 70 65 6e 64 20 73 74 61 74 {...append stat
2450: 65 20 22 3a 20 24 6d 73 67 22 0a 09 20 20 20 20 e ": $msg"..
2460: 7d 0a 09 20 20 20 20 23 20 46 6f 72 20 74 72 61 }.. # For tra
2470: 63 69 6e 67 0a 09 20 20 20 20 75 70 76 61 72 20 cing.. upvar
2480: 23 30 20 74 6c 73 3a 3a 24 63 68 61 6e 20 63 62 #0 tls::$chan cb
2490: 0a 09 20 20 20 20 73 65 74 20 63 62 28 24 6d 61 .. set cb($ma
24a0: 6a 6f 72 29 20 24 6d 69 6e 6f 72 0a 0a 09 20 20 jor) $minor...
24b0: 20 20 6c 6f 67 20 32 20 22 54 4c 53 2f 24 63 68 log 2 "TLS/$ch
24c0: 61 6e 3a 20 24 6d 61 6a 6f 72 2f 24 6d 69 6e 6f an: $major/$mino
24d0: 72 3a 20 24 73 74 61 74 65 22 0a 09 7d 0a 09 22 r: $state"..}.."
24e0: 6d 65 73 73 61 67 65 22 20 7b 0a 09 20 20 20 20 message" {..
24f0: 6c 61 73 73 69 67 6e 20 24 61 72 67 73 20 64 69 lassign $args di
2500: 72 65 63 74 69 6f 6e 20 76 65 72 73 69 6f 6e 20 rection version
2510: 63 6f 6e 74 65 6e 74 5f 74 79 70 65 20 6d 73 67 content_type msg
2520: 0a 0a 09 20 20 20 20 6c 6f 67 20 30 20 22 54 4c ... log 0 "TL
2530: 53 2f 24 63 68 61 6e 3a 20 69 6e 66 6f 3a 20 24 S/$chan: info: $
2540: 64 69 72 65 63 74 69 6f 6e 20 24 6d 73 67 22 0a direction $msg".
2550: 09 7d 0a 09 22 73 65 73 73 69 6f 6e 22 20 7b 0a .}.."session" {.
2560: 09 20 20 20 20 6c 61 73 73 69 67 6e 20 24 61 72 . lassign $ar
2570: 67 73 20 73 65 73 73 69 6f 6e 5f 69 64 20 74 69 gs session_id ti
2580: 63 6b 65 74 20 6c 69 66 65 74 69 6d 65 0a 0a 09 cket lifetime...
2590: 20 20 20 20 6c 6f 67 20 30 20 22 54 4c 53 2f 24 log 0 "TLS/$
25a0: 63 68 61 6e 3a 20 73 65 73 73 69 6f 6e 3a 20 6c chan: session: l
25b0: 69 66 65 74 69 6d 65 20 24 6c 69 66 65 74 69 6d ifetime $lifetim
25c0: 65 22 0a 09 7d 0a 09 22 76 65 72 69 66 79 22 20 e"..}.."verify"
25d0: 7b 0a 09 20 20 20 20 23 20 42 61 63 6b 77 61 72 {.. # Backwar
25e0: 64 73 20 63 6f 6d 70 61 74 69 62 6c 65 20 66 6f ds compatible fo
25f0: 72 20 76 31 2e 37 0a 09 20 20 20 20 72 65 74 75 r v1.7.. retu
2600: 72 6e 20 5b 74 6c 73 3a 3a 76 61 6c 69 64 61 74 rn [tls::validat
2610: 65 5f 63 6f 6d 6d 61 6e 64 20 24 6f 70 74 69 6f e_command $optio
2620: 6e 20 24 63 68 61 6e 20 7b 2a 7d 24 61 72 67 73 n $chan {*}$args
2630: 5d 0a 09 7d 0a 09 64 65 66 61 75 6c 74 09 7b 0a ]..}..default.{.
2640: 09 20 20 20 20 72 65 74 75 72 6e 20 2d 63 6f 64 . return -cod
2650: 65 20 65 72 72 6f 72 20 22 62 61 64 20 6f 70 74 e error "bad opt
2660: 69 6f 6e 20 5c 22 24 6f 70 74 69 6f 6e 5c 22 3a ion \"$option\":
2670: 5c 0a 09 09 20 20 20 20 6d 75 73 74 20 62 65 20 \... must be
2680: 6f 6e 65 20 6f 66 20 65 72 72 6f 72 2c 20 69 6e one of error, in
2690: 66 6f 2c 20 6d 65 73 73 61 67 65 2c 20 6f 72 20 fo, message, or
26a0: 73 65 73 73 69 6f 6e 22 0a 09 7d 0a 20 20 20 20 session"..}.
26b0: 7d 0a 7d 0a 0a 23 0a 23 20 53 61 6d 70 6c 65 20 }.}..#.# Sample
26c0: 63 61 6c 6c 62 61 63 6b 20 77 68 65 6e 20 72 65 callback when re
26d0: 74 75 72 6e 20 76 61 6c 75 65 20 69 73 20 6e 65 turn value is ne
26e0: 65 64 65 64 2e 20 4e 65 77 20 66 6f 72 20 54 4c eded. New for TL
26f0: 53 20 31 2e 38 2b 2e 0a 23 0a 70 72 6f 63 20 74 S 1.8+..#.proc t
2700: 6c 73 3a 3a 76 61 6c 69 64 61 74 65 5f 63 6f 6d ls::validate_com
2710: 6d 61 6e 64 20 7b 6f 70 74 69 6f 6e 20 63 68 61 mand {option cha
2720: 6e 20 61 72 67 73 7d 20 7b 0a 20 20 20 20 76 61 n args} {. va
2730: 72 69 61 62 6c 65 20 64 65 62 75 67 0a 0a 20 20 riable debug..
2740: 20 20 73 77 69 74 63 68 20 2d 2d 20 24 6f 70 74 switch -- $opt
2750: 69 6f 6e 20 7b 0a 09 22 61 6c 70 6e 22 20 7b 0a ion {.."alpn" {.
2760: 09 20 20 20 20 6c 61 73 73 69 67 6e 20 24 61 72 . lassign $ar
2770: 67 73 20 70 72 6f 74 6f 63 6f 6c 20 6d 61 74 63 gs protocol matc
2780: 68 0a 0a 09 20 20 20 20 6c 6f 67 20 30 20 22 54 h... log 0 "T
2790: 4c 53 2f 24 63 68 61 6e 3a 20 61 6c 70 6e 3a 20 LS/$chan: alpn:
27a0: 24 70 72 6f 74 6f 63 6f 6c 20 24 6d 61 74 63 68 $protocol $match
27b0: 22 0a 09 7d 0a 09 22 68 65 6c 6c 6f 22 20 7b 0a "..}.."hello" {.
27c0: 09 20 20 20 6c 61 73 73 69 67 6e 20 24 61 72 67 . lassign $arg
27d0: 73 20 73 65 72 76 65 72 6e 61 6d 65 0a 0a 09 20 s servername...
27e0: 20 20 20 6c 6f 67 20 30 20 22 54 4c 53 2f 24 63 log 0 "TLS/$c
27f0: 68 61 6e 3a 20 68 65 6c 6c 6f 3a 20 24 73 65 72 han: hello: $ser
2800: 76 65 72 6e 61 6d 65 22 0a 09 7d 0a 09 22 73 6e vername"..}.."sn
2810: 69 22 20 7b 0a 09 20 20 20 20 6c 61 73 73 69 67 i" {.. lassig
2820: 6e 20 24 61 72 67 73 20 73 65 72 76 65 72 6e 61 n $args serverna
2830: 6d 65 0a 0a 09 20 20 20 20 6c 6f 67 20 30 20 22 me... log 0 "
2840: 54 4c 53 2f 24 63 68 61 6e 3a 20 73 6e 69 3a 20 TLS/$chan: sni:
2850: 24 73 65 72 76 65 72 6e 61 6d 65 22 0a 09 7d 0a $servername"..}.
2860: 09 22 76 65 72 69 66 79 22 20 7b 0a 09 20 20 20 ."verify" {..
2870: 20 6c 61 73 73 69 67 6e 20 24 61 72 67 73 20 64 lassign $args d
2880: 65 70 74 68 20 63 65 72 74 20 72 63 20 65 72 72 epth cert rc err
2890: 0a 0a 09 20 20 20 20 61 72 72 61 79 20 73 65 74 ... array set
28a0: 20 63 20 24 63 65 72 74 0a 0a 09 20 20 20 20 69 c $cert... i
28b0: 66 20 7b 24 72 63 20 6e 65 20 22 31 22 7d 20 7b f {$rc ne "1"} {
28c0: 0a 09 09 6c 6f 67 20 31 20 22 54 4c 53 2f 24 63 ...log 1 "TLS/$c
28d0: 68 61 6e 3a 20 76 65 72 69 66 79 2f 24 64 65 70 han: verify/$dep
28e0: 74 68 3a 20 42 61 64 20 43 65 72 74 3a 20 24 65 th: Bad Cert: $e
28f0: 72 72 20 28 72 63 20 3d 20 24 72 63 29 22 0a 09 rr (rc = $rc)"..
2900: 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 6c } else {...l
2910: 6f 67 20 32 20 22 54 4c 53 2f 24 63 68 61 6e 3a og 2 "TLS/$chan:
2920: 20 76 65 72 69 66 79 2f 24 64 65 70 74 68 3a 20 verify/$depth:
2930: 24 63 28 73 75 62 6a 65 63 74 29 22 0a 09 20 20 $c(subject)"..
2940: 20 20 7d 0a 09 20 20 20 20 69 66 20 7b 24 64 65 }.. if {$de
2950: 62 75 67 20 3e 20 30 7d 20 7b 0a 09 09 72 65 74 bug > 0} {...ret
2960: 75 72 6e 20 31 3b 09 23 20 46 4f 52 43 45 20 4f urn 1;.# FORCE O
2970: 4b 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a K.. } else {.
2980: 09 09 72 65 74 75 72 6e 20 24 72 63 0a 09 20 20 ..return $rc..
2990: 20 20 7d 0a 09 7d 0a 09 64 65 66 61 75 6c 74 09 }..}..default.
29a0: 7b 0a 09 20 20 20 20 72 65 74 75 72 6e 20 2d 63 {.. return -c
29b0: 6f 64 65 20 65 72 72 6f 72 20 22 62 61 64 20 6f ode error "bad o
29c0: 70 74 69 6f 6e 20 5c 22 24 6f 70 74 69 6f 6e 5c ption \"$option\
29d0: 22 3a 5c 0a 09 09 20 20 20 20 6d 75 73 74 20 62 ":\... must b
29e0: 65 20 6f 6e 65 20 6f 66 20 61 6c 70 6e 2c 20 68 e one of alpn, h
29f0: 65 6c 6c 6f 2c 20 73 6e 69 2c 20 6f 72 20 76 65 ello, sni, or ve
2a00: 72 69 66 79 22 0a 09 7d 0a 20 20 20 20 7d 0a 20 rify"..}. }.
2a10: 20 20 20 72 65 74 75 72 6e 20 31 0a 7d 0a 0a 70 return 1.}..p
2a20: 72 6f 63 20 74 6c 73 3a 3a 78 68 61 6e 64 73 68 roc tls::xhandsh
2a30: 61 6b 65 20 7b 63 68 61 6e 7d 20 7b 0a 20 20 20 ake {chan} {.
2a40: 20 75 70 76 61 72 20 23 30 20 74 6c 73 3a 3a 24 upvar #0 tls::$
2a50: 63 68 61 6e 20 63 62 0a 0a 20 20 20 20 69 66 20 chan cb.. if
2a60: 7b 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 63 62 {[info exists cb
2a70: 28 68 61 6e 64 73 68 61 6b 65 29 5d 20 26 26 20 (handshake)] &&
2a80: 5c 0a 09 24 63 62 28 68 61 6e 64 73 68 61 6b 65 \..$cb(handshake
2a90: 29 20 65 71 20 22 64 6f 6e 65 22 7d 20 7b 0a 09 ) eq "done"} {..
2aa0: 72 65 74 75 72 6e 20 31 0a 20 20 20 20 7d 0a 20 return 1. }.
2ab0: 20 20 20 77 68 69 6c 65 20 7b 31 7d 20 7b 0a 09 while {1} {..
2ac0: 76 77 61 69 74 20 74 6c 73 3a 3a 24 7b 63 68 61 vwait tls::${cha
2ad0: 6e 7d 28 68 61 6e 64 73 68 61 6b 65 29 0a 09 69 n}(handshake)..i
2ae0: 66 20 7b 21 5b 69 6e 66 6f 20 65 78 69 73 74 73 f {![info exists
2af0: 20 63 62 28 68 61 6e 64 73 68 61 6b 65 29 5d 7d cb(handshake)]}
2b00: 20 7b 0a 09 20 20 20 20 72 65 74 75 72 6e 20 30 {.. return 0
2b10: 0a 09 7d 0a 09 69 66 20 7b 24 63 62 28 68 61 6e ..}..if {$cb(han
2b20: 64 73 68 61 6b 65 29 20 3d 3d 20 22 64 6f 6e 65 dshake) == "done
2b30: 22 7d 20 7b 0a 09 20 20 20 20 72 65 74 75 72 6e "} {.. return
2b40: 20 31 0a 09 7d 0a 20 20 20 20 7d 0a 7d 0a 0a 23 1..}. }.}..#
2b50: 0a 23 20 53 61 6d 70 6c 65 20 63 61 6c 6c 62 61 .# Sample callba
2b60: 63 6b 20 74 6f 20 67 65 74 20 70 61 73 73 77 6f ck to get passwo
2b70: 72 64 20 77 68 65 6e 20 6e 65 65 64 65 64 2e 20 rd when needed.
2b80: 41 72 67 73 20 61 72 65 20 6e 65 77 20 66 6f 72 Args are new for
2b90: 20 54 4c 53 20 31 2e 38 2b 2e 0a 23 0a 70 72 6f TLS 1.8+..#.pro
2ba0: 63 20 74 6c 73 3a 3a 70 61 73 73 77 6f 72 64 20 c tls::password
2bb0: 7b 7b 6f 70 74 69 6f 6e 20 70 61 73 73 77 6f 72 {{option passwor
2bc0: 64 7d 20 7b 72 77 66 6c 61 67 20 30 7d 20 7b 73 d} {rwflag 0} {s
2bd0: 69 7a 65 20 30 7d 7d 20 7b 0a 20 20 20 20 6c 6f ize 0}} {. lo
2be0: 67 20 30 20 22 54 4c 53 2f 50 61 73 73 77 6f 72 g 0 "TLS/Passwor
2bf0: 64 3a 20 64 69 64 20 79 6f 75 20 66 6f 72 67 65 d: did you forge
2c00: 74 20 74 6f 20 73 65 74 20 79 6f 75 72 20 70 61 t to set your pa
2c10: 73 73 77 64 21 22 0a 20 20 20 20 23 20 52 65 74 sswd!". # Ret
2c20: 75 72 6e 20 74 68 65 20 77 6f 72 6c 64 73 20 62 urn the worlds b
2c30: 65 73 74 20 6b 65 70 74 20 73 65 63 72 65 74 20 est kept secret
2c40: 70 61 73 73 77 6f 72 64 2e 0a 20 20 20 20 72 65 password.. re
2c50: 74 75 72 6e 20 22 73 65 63 72 65 74 22 0a 7d 0a turn "secret".}.
2c60: 0a 70 72 6f 63 20 74 6c 73 3a 3a 6c 6f 67 20 7b .proc tls::log {
2c70: 6c 65 76 65 6c 20 6d 73 67 7d 20 7b 0a 20 20 20 level msg} {.
2c80: 20 76 61 72 69 61 62 6c 65 20 64 65 62 75 67 0a variable debug.
2c90: 20 20 20 20 76 61 72 69 61 62 6c 65 20 6c 6f 67 variable log
2ca0: 63 6d 64 0a 0a 20 20 20 20 69 66 20 7b 24 6c 65 cmd.. if {$le
2cb0: 76 65 6c 20 3e 20 24 64 65 62 75 67 20 7c 7c 20 vel > $debug ||
2cc0: 24 6c 6f 67 63 6d 64 20 65 71 20 22 22 7d 20 7b $logcmd eq ""} {
2cd0: 0a 09 72 65 74 75 72 6e 0a 20 20 20 20 7d 0a 20 ..return. }.
2ce0: 20 20 20 73 65 74 20 63 6d 64 20 24 6c 6f 67 63 set cmd $logc
2cf0: 6d 64 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 63 md. lappend c
2d00: 6d 64 20 24 6d 73 67 0a 20 20 20 20 75 70 6c 65 md $msg. uple
2d10: 76 65 6c 20 23 30 20 24 63 6d 64 0a 7d 0a 0a vel #0 $cmd.}..