Hex Artifact Content

Artifact 195a9115ab11833dbd2071a5bc83377d6850605f58ed1a998fc4dbb61ca70a98:


0000: 23 20 43 6f 6d 6d 61 6e 64 73 20 74 65 73 74 65  # Commands teste
0010: 64 20 69 6e 20 74 68 69 73 20 66 69 6c 65 3a 20  d in this file: 
0020: 73 6f 63 6b 65 74 2e 20 20 20 20 20 20 20 20 20  socket.         
0030: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
0040: 20 2d 2a 2d 20 74 63 6c 20 2d 2a 2d 0a 23 0a 23   -*- tcl -*-.#.#
0050: 20 54 68 69 73 20 66 69 6c 65 20 63 6f 6e 74 61   This file conta
0060: 69 6e 73 20 61 20 63 6f 6c 6c 65 63 74 69 6f 6e  ins a collection
0070: 20 6f 66 20 74 65 73 74 73 20 66 6f 72 20 6f 6e   of tests for on
0080: 65 20 6f 72 20 6d 6f 72 65 20 6f 66 20 74 68 65  e or more of the
0090: 20 54 63 6c 0a 23 20 62 75 69 6c 74 2d 69 6e 20   Tcl.# built-in 
00a0: 63 6f 6d 6d 61 6e 64 73 2e 20 20 53 6f 75 72 63  commands.  Sourc
00b0: 69 6e 67 20 74 68 69 73 20 66 69 6c 65 20 69 6e  ing this file in
00c0: 74 6f 20 54 63 6c 20 72 75 6e 73 20 74 68 65 20  to Tcl runs the 
00d0: 74 65 73 74 73 20 61 6e 64 0a 23 20 67 65 6e 65  tests and.# gene
00e0: 72 61 74 65 73 20 6f 75 74 70 75 74 20 66 6f 72  rates output for
00f0: 20 65 72 72 6f 72 73 2e 20 20 4e 6f 20 6f 75 74   errors.  No out
0100: 70 75 74 20 6d 65 61 6e 73 20 6e 6f 20 65 72 72  put means no err
0110: 6f 72 73 20 77 65 72 65 20 66 6f 75 6e 64 2e 0a  ors were found..
0120: 23 0a 23 20 43 6f 70 79 72 69 67 68 74 20 28 63  #.# Copyright (c
0130: 29 20 31 39 39 34 2d 31 39 39 36 20 53 75 6e 20  ) 1994-1996 Sun 
0140: 4d 69 63 72 6f 73 79 73 74 65 6d 73 2c 20 49 6e  Microsystems, In
0150: 63 2e 0a 23 20 43 6f 70 79 72 69 67 68 74 20 28  c..# Copyright (
0160: 63 29 20 31 39 39 38 2d 32 30 30 30 20 41 6a 75  c) 1998-2000 Aju
0170: 62 61 20 53 6f 6c 75 74 69 6f 6e 73 2e 20 0a 23  ba Solutions. .#
0180: 0a 23 20 53 65 65 20 74 68 65 20 66 69 6c 65 20  .# See the file 
0190: 22 6c 69 63 65 6e 73 65 2e 74 65 72 6d 73 22 20  "license.terms" 
01a0: 66 6f 72 20 69 6e 66 6f 72 6d 61 74 69 6f 6e 20  for information 
01b0: 6f 6e 20 75 73 61 67 65 20 61 6e 64 20 72 65 64  on usage and red
01c0: 69 73 74 72 69 62 75 74 69 6f 6e 0a 23 20 6f 66  istribution.# of
01d0: 20 74 68 69 73 20 66 69 6c 65 2c 20 61 6e 64 20   this file, and 
01e0: 66 6f 72 20 61 20 44 49 53 43 4c 41 49 4d 45 52  for a DISCLAIMER
01f0: 20 4f 46 20 41 4c 4c 20 57 41 52 52 41 4e 54 49   OF ALL WARRANTI
0200: 45 53 2e 0a 23 0a 23 20 52 43 53 3a 20 40 28 23  ES..#.# RCS: @(#
0210: 29 20 24 49 64 3a 20 74 6c 73 49 4f 2e 74 65 73  ) $Id: tlsIO.tes
0220: 74 2c 76 20 31 2e 32 34 20 32 30 31 35 2f 30 36  t,v 1.24 2015/06
0230: 2f 30 36 20 30 39 3a 30 37 3a 30 38 20 61 70 6e  /06 09:07:08 apn
0240: 61 64 6b 61 72 6e 69 20 45 78 70 20 24 0a 0a 23  adkarni Exp $..#
0250: 20 52 75 6e 6e 69 6e 67 20 73 6f 63 6b 65 74 20   Running socket 
0260: 74 65 73 74 73 20 77 69 74 68 20 61 20 72 65 6d  tests with a rem
0270: 6f 74 65 20 73 65 72 76 65 72 3a 0a 23 20 2d 2d  ote server:.# --
0280: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d  ----------------
0290: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d  ----------------
02a0: 2d 2d 2d 2d 2d 2d 2d 2d 0a 23 20 0a 23 20 53 6f  --------.# .# So
02b0: 6d 65 20 74 65 73 74 73 20 69 6e 20 73 6f 63 6b  me tests in sock
02c0: 65 74 2e 74 65 73 74 20 64 65 70 65 6e 64 20 6f  et.test depend o
02d0: 6e 20 74 68 65 20 65 78 69 73 74 65 6e 63 65 20  n the existence 
02e0: 6f 66 20 61 20 72 65 6d 6f 74 65 20 73 65 72 76  of a remote serv
02f0: 65 72 20 74 6f 0a 23 20 77 68 69 63 68 20 74 68  er to.# which th
0300: 65 79 20 63 6f 6e 6e 65 63 74 2e 20 54 68 65 20  ey connect. The 
0310: 72 65 6d 6f 74 65 20 73 65 72 76 65 72 20 6d 75  remote server mu
0320: 73 74 20 62 65 20 61 6e 20 69 6e 73 74 61 6e 63  st be an instanc
0330: 65 20 6f 66 20 74 63 6c 74 65 73 74 20 61 6e 64  e of tcltest and
0340: 20 69 74 0a 23 20 6d 75 73 74 20 72 75 6e 20 74   it.# must run t
0350: 68 65 20 73 63 72 69 70 74 20 66 6f 75 6e 64 20  he script found 
0360: 69 6e 20 74 68 65 20 66 69 6c 65 20 22 72 65 6d  in the file "rem
0370: 6f 74 65 2e 74 63 6c 22 20 69 6e 20 74 68 69 73  ote.tcl" in this
0380: 20 64 69 72 65 63 74 6f 72 79 2e 20 59 6f 75 0a   directory. You.
0390: 23 20 63 61 6e 20 73 74 61 72 74 20 74 68 65 20  # can start the 
03a0: 72 65 6d 6f 74 65 20 73 65 72 76 65 72 20 6f 6e  remote server on
03b0: 20 61 6e 79 20 6d 61 63 68 69 6e 65 20 72 65 61   any machine rea
03c0: 63 68 61 62 6c 65 20 66 72 6f 6d 20 74 68 65 20  chable from the 
03d0: 6d 61 63 68 69 6e 65 20 6f 6e 0a 23 20 77 68 69  machine on.# whi
03e0: 63 68 20 79 6f 75 20 77 61 6e 74 20 74 6f 20 72  ch you want to r
03f0: 75 6e 20 74 68 65 20 73 6f 63 6b 65 74 20 74 65  un the socket te
0400: 73 74 73 2c 20 62 79 20 69 73 73 75 69 6e 67 3a  sts, by issuing:
0410: 0a 23 20 0a 23 20 20 20 20 20 74 63 6c 74 65 73  .# .#     tcltes
0420: 74 20 72 65 6d 6f 74 65 2e 74 63 6c 20 2d 70 6f  t remote.tcl -po
0430: 72 74 20 38 30 34 38 09 23 20 4f 72 20 63 68 6f  rt 8048.# Or cho
0440: 6f 73 65 20 61 6e 6f 74 68 65 72 20 70 6f 72 74  ose another port
0450: 20 6e 75 6d 62 65 72 2e 0a 23 20 0a 23 20 49 66   number..# .# If
0460: 20 74 68 65 20 6d 61 63 68 69 6e 65 20 79 6f 75   the machine you
0470: 20 61 72 65 20 72 75 6e 6e 69 6e 67 20 74 68 65   are running the
0480: 20 72 65 6d 6f 74 65 20 73 65 72 76 65 72 20 6f   remote server o
0490: 6e 20 68 61 73 20 73 65 76 65 72 61 6c 20 49 50  n has several IP
04a0: 0a 23 20 69 6e 74 65 72 66 61 63 65 73 2c 20 79  .# interfaces, y
04b0: 6f 75 20 63 61 6e 20 63 68 6f 6f 73 65 20 77 68  ou can choose wh
04c0: 69 63 68 20 69 6e 74 65 72 66 61 63 65 20 74 68  ich interface th
04d0: 65 20 73 65 72 76 65 72 20 6c 69 73 74 65 6e 73  e server listens
04e0: 20 6f 6e 20 66 6f 72 0a 23 20 63 6f 6e 6e 65 63   on for.# connec
04f0: 74 69 6f 6e 73 20 62 79 20 73 70 65 63 69 66 79  tions by specify
0500: 69 6e 67 20 74 68 65 20 2d 61 64 64 72 65 73 73  ing the -address
0510: 20 63 6f 6d 6d 61 6e 64 20 6c 69 6e 65 20 66 6c   command line fl
0520: 61 67 2c 20 73 6f 3a 0a 23 20 0a 23 20 20 20 20  ag, so:.# .#    
0530: 20 74 63 6c 74 65 73 74 20 72 65 6d 6f 74 65 2e   tcltest remote.
0540: 74 63 6c 20 2d 61 64 64 72 65 73 73 20 79 6f 75  tcl -address you
0550: 72 2e 6d 61 63 68 69 6e 65 2e 63 6f 6d 0a 23 20  r.machine.com.# 
0560: 0a 23 20 54 68 65 73 65 20 6f 70 74 69 6f 6e 73  .# These options
0570: 20 63 61 6e 20 61 6c 73 6f 20 62 65 20 73 65 74   can also be set
0580: 20 62 79 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 20   by environment 
0590: 76 61 72 69 61 62 6c 65 73 2e 20 4f 6e 20 55 6e  variables. On Un
05a0: 69 78 2c 20 79 6f 75 20 63 61 6e 0a 23 20 74 79  ix, you can.# ty
05b0: 70 65 20 74 68 65 73 65 20 63 6f 6d 6d 61 6e 64  pe these command
05c0: 73 20 74 6f 20 74 68 65 20 73 68 65 6c 6c 20 66  s to the shell f
05d0: 72 6f 6d 20 77 68 69 63 68 20 74 68 65 20 72 65  rom which the re
05e0: 6d 6f 74 65 20 73 65 72 76 65 72 20 69 73 20 73  mote server is s
05f0: 74 61 72 74 65 64 3a 0a 23 20 0a 23 20 20 20 20  tarted:.# .#    
0600: 20 73 68 65 6c 6c 25 20 73 65 74 65 6e 76 20 73   shell% setenv s
0610: 65 72 76 65 72 50 6f 72 74 20 38 30 34 38 0a 23  erverPort 8048.#
0620: 20 20 20 20 20 73 68 65 6c 6c 25 20 73 65 74 65       shell% sete
0630: 6e 76 20 73 65 72 76 65 72 41 64 64 72 65 73 73  nv serverAddress
0640: 20 79 6f 75 72 2e 6d 61 63 68 69 6e 65 2e 63 6f   your.machine.co
0650: 6d 0a 23 20 0a 23 20 61 6e 64 20 73 75 62 73 65  m.# .# and subse
0660: 71 75 65 6e 74 6c 79 20 79 6f 75 20 63 61 6e 20  quently you can 
0670: 73 74 61 72 74 20 74 68 65 20 72 65 6d 6f 74 65  start the remote
0680: 20 73 65 72 76 65 72 20 77 69 74 68 3a 0a 23 20   server with:.# 
0690: 0a 23 20 20 20 20 20 74 63 6c 74 65 73 74 20 72  .#     tcltest r
06a0: 65 6d 6f 74 65 2e 74 63 6c 0a 23 20 0a 23 20 74  emote.tcl.# .# t
06b0: 6f 20 68 61 76 65 20 69 74 20 6c 69 73 74 65 6e  o have it listen
06c0: 20 6f 6e 20 70 6f 72 74 20 38 30 34 38 20 6f 6e   on port 8048 on
06d0: 20 74 68 65 20 69 6e 74 65 72 66 61 63 65 20 79   the interface y
06e0: 6f 75 72 2e 6d 61 63 68 69 6e 65 2e 63 6f 6d 2e  our.machine.com.
06f0: 0a 23 20 20 20 20 20 0a 23 20 57 68 65 6e 20 74  .#     .# When t
0700: 68 65 20 73 65 72 76 65 72 20 73 74 61 72 74 73  he server starts
0710: 2c 20 69 74 20 70 72 69 6e 74 73 20 6f 75 74 20  , it prints out 
0720: 61 20 64 65 74 61 69 6c 65 64 20 6d 65 73 73 61  a detailed messa
0730: 67 65 20 63 6f 6e 74 61 69 6e 69 6e 67 20 69 74  ge containing it
0740: 73 0a 23 20 63 6f 6e 66 69 67 75 72 61 74 69 6f  s.# configuratio
0750: 6e 20 69 6e 66 6f 72 6d 61 74 69 6f 6e 2c 20 61  n information, a
0760: 6e 64 20 69 74 20 77 69 6c 6c 20 62 6c 6f 63 6b  nd it will block
0770: 20 75 6e 74 69 6c 20 6b 69 6c 6c 65 64 20 77 69   until killed wi
0780: 74 68 20 61 20 43 74 72 6c 2d 43 2e 0a 23 20 4f  th a Ctrl-C..# O
0790: 6e 63 65 20 74 68 65 20 72 65 6d 6f 74 65 20 73  nce the remote s
07a0: 65 72 76 65 72 20 65 78 69 73 74 73 2c 20 79 6f  erver exists, yo
07b0: 75 20 63 61 6e 20 72 75 6e 20 74 68 65 20 74 65  u can run the te
07c0: 73 74 73 20 69 6e 20 73 6f 63 6b 65 74 2e 74 65  sts in socket.te
07d0: 73 74 20 77 69 74 68 0a 23 20 74 68 65 20 73 65  st with.# the se
07e0: 72 76 65 72 20 62 79 20 73 65 74 74 69 6e 67 20  rver by setting 
07f0: 74 77 6f 20 54 63 6c 20 76 61 72 69 61 62 6c 65  two Tcl variable
0800: 73 3a 0a 23 20 0a 23 20 20 20 20 20 25 20 73 65  s:.# .#     % se
0810: 74 20 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50  t remoteServerIP
0820: 20 3c 6e 61 6d 65 20 6f 72 20 61 64 64 72 65 73   <name or addres
0830: 73 20 6f 66 20 6d 61 63 68 69 6e 65 20 6f 6e 20  s of machine on 
0840: 77 68 69 63 68 20 73 65 72 76 65 72 20 72 75 6e  which server run
0850: 73 3e 0a 23 20 20 20 20 20 25 20 73 65 74 20 72  s>.#     % set r
0860: 65 6d 6f 74 65 53 65 72 76 65 72 50 6f 72 74 20  emoteServerPort 
0870: 38 30 34 38 0a 23 20 0a 23 20 54 68 65 73 65 20  8048.# .# These 
0880: 76 61 72 69 61 62 6c 65 73 20 61 72 65 20 61 6c  variables are al
0890: 73 6f 20 73 65 74 74 61 62 6c 65 20 66 72 6f 6d  so settable from
08a0: 20 74 68 65 20 65 6e 76 69 72 6f 6e 6d 65 6e 74   the environment
08b0: 2e 20 4f 6e 20 55 6e 69 78 2c 20 79 6f 75 20 63  . On Unix, you c
08c0: 61 6e 3a 0a 23 20 0a 23 20 20 20 20 20 73 68 65  an:.# .#     she
08d0: 6c 6c 25 20 73 65 74 65 6e 76 20 72 65 6d 6f 74  ll% setenv remot
08e0: 65 53 65 72 76 65 72 49 50 20 6d 61 63 68 69 6e  eServerIP machin
08f0: 65 2e 77 68 65 72 65 2e 73 65 72 76 65 72 2e 72  e.where.server.r
0900: 75 6e 73 0a 23 20 20 20 20 20 73 68 65 6c 6c 25  uns.#     shell%
0910: 20 73 65 74 65 6e 76 20 72 65 6d 6f 74 65 53 65   setenv remoteSe
0920: 72 76 65 72 50 6f 72 74 20 38 30 34 38 0a 23 20  rverPort 8048.# 
0930: 0a 23 20 54 68 65 20 70 72 65 61 6d 62 6c 65 20  .# The preamble 
0940: 6f 66 20 74 68 65 20 73 6f 63 6b 65 74 2e 74 65  of the socket.te
0950: 73 74 20 66 69 6c 65 20 63 68 65 63 6b 73 20 74  st file checks t
0960: 6f 20 73 65 65 20 69 66 20 74 68 65 20 76 61 72  o see if the var
0970: 69 61 62 6c 65 73 20 61 72 65 20 73 65 74 0a 23  iables are set.#
0980: 20 65 69 74 68 65 72 20 69 6e 20 54 63 6c 20 6f   either in Tcl o
0990: 72 20 69 6e 20 74 68 65 20 65 6e 76 69 72 6f 6e  r in the environ
09a0: 6d 65 6e 74 3b 20 69 66 20 74 68 65 79 20 61 72  ment; if they ar
09b0: 65 2c 20 69 74 20 61 74 74 65 6d 70 74 73 20 74  e, it attempts t
09c0: 6f 20 63 6f 6e 6e 65 63 74 20 74 6f 0a 23 20 74  o connect to.# t
09d0: 68 65 20 73 65 72 76 65 72 2e 20 49 66 20 74 68  he server. If th
09e0: 65 20 63 6f 6e 6e 65 63 74 69 6f 6e 20 69 73 20  e connection is 
09f0: 73 75 63 63 65 73 73 66 75 6c 2c 20 74 68 65 20  successful, the 
0a00: 74 65 73 74 73 20 75 73 69 6e 67 20 74 68 65 20  tests using the 
0a10: 72 65 6d 6f 74 65 0a 23 20 73 65 72 76 65 72 20  remote.# server 
0a20: 77 69 6c 6c 20 62 65 20 70 65 72 66 6f 72 6d 65  will be performe
0a30: 64 3b 20 6f 74 68 65 72 77 69 73 65 2c 20 69 74  d; otherwise, it
0a40: 20 77 69 6c 6c 20 61 74 74 65 6d 70 74 20 74 6f   will attempt to
0a50: 20 73 74 61 72 74 20 74 68 65 20 72 65 6d 6f 74   start the remot
0a60: 65 0a 23 20 73 65 72 76 65 72 20 28 76 69 61 20  e.# server (via 
0a70: 65 78 65 63 29 20 6f 6e 20 70 6c 61 74 66 6f 72  exec) on platfor
0a80: 6d 73 20 74 68 61 74 20 73 75 70 70 6f 72 74 20  ms that support 
0a90: 74 68 69 73 2c 20 6f 6e 20 74 68 65 20 6c 6f 63  this, on the loc
0aa0: 61 6c 20 68 6f 73 74 2c 0a 23 20 6c 69 73 74 65  al host,.# liste
0ab0: 6e 69 6e 67 20 61 74 20 70 6f 72 74 20 38 30 34  ning at port 804
0ac0: 38 2e 20 49 66 20 61 6c 6c 20 66 61 69 6c 73 2c  8. If all fails,
0ad0: 20 61 20 6d 65 73 73 61 67 65 20 69 73 20 70 72   a message is pr
0ae0: 69 6e 74 65 64 20 61 6e 64 20 74 68 65 20 74 65  inted and the te
0af0: 73 74 73 0a 23 20 75 73 69 6e 67 20 74 68 65 20  sts.# using the 
0b00: 72 65 6d 6f 74 65 20 73 65 72 76 65 72 20 61 72  remote server ar
0b10: 65 20 6e 6f 74 20 70 65 72 66 6f 72 6d 65 64 2e  e not performed.
0b20: 0a 0a 70 72 6f 63 20 64 70 75 74 73 20 7b 6d 73  ..proc dputs {ms
0b30: 67 7d 20 7b 20 72 65 74 75 72 6e 20 3b 20 70 75  g} { return ; pu
0b40: 74 73 20 73 74 64 65 72 72 20 24 6d 73 67 20 3b  ts stderr $msg ;
0b50: 20 66 6c 75 73 68 20 73 74 64 65 72 72 20 7d 0a   flush stderr }.
0b60: 0a 69 66 20 7b 5b 6c 73 65 61 72 63 68 20 5b 6e  .if {[lsearch [n
0b70: 61 6d 65 73 70 61 63 65 20 63 68 69 6c 64 72 65  amespace childre
0b80: 6e 5d 20 3a 3a 74 63 6c 74 65 73 74 5d 20 3d 3d  n] ::tcltest] ==
0b90: 20 2d 31 7d 20 7b 0a 20 20 20 20 70 61 63 6b 61   -1} {.    packa
0ba0: 67 65 20 72 65 71 75 69 72 65 20 74 63 6c 74 65  ge require tclte
0bb0: 73 74 0a 20 20 20 20 6e 61 6d 65 73 70 61 63 65  st.    namespace
0bc0: 20 69 6d 70 6f 72 74 20 2d 66 6f 72 63 65 20 3a   import -force :
0bd0: 3a 74 63 6c 74 65 73 74 3a 3a 2a 0a 7d 0a 0a 23  :tcltest::*.}..#
0be0: 20 54 68 65 20 62 75 69 6c 64 20 64 69 72 20 69   The build dir i
0bf0: 73 20 61 64 64 65 64 20 61 73 20 74 68 65 20 66  s added as the f
0c00: 69 72 73 74 20 65 6c 65 6d 65 6e 74 20 6f 66 20  irst element of 
0c10: 24 50 41 54 48 0a 23 20 4c 6f 61 64 20 74 68 65  $PATH.# Load the
0c20: 20 74 6c 73 20 70 61 63 6b 61 67 65 0a 70 61 63   tls package.pac
0c30: 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73  kage require tls
0c40: 0a 0a 73 65 74 20 74 6c 73 53 65 72 76 65 72 50  ..set tlsServerP
0c50: 6f 72 74 20 38 30 34 38 0a 0a 23 20 53 70 65 63  ort 8048..# Spec
0c60: 69 66 79 20 77 68 65 72 65 20 74 68 65 20 63 65  ify where the ce
0c70: 72 74 69 66 69 63 61 74 65 73 20 61 72 65 0a 0a  rtificates are..
0c80: 73 65 74 20 63 65 72 74 73 44 69 72 09 5b 66 69  set certsDir.[fi
0c90: 6c 65 20 6a 6f 69 6e 20 5b 66 69 6c 65 20 64 69  le join [file di
0ca0: 72 6e 61 6d 65 20 5b 69 6e 66 6f 20 73 63 72 69  rname [info scri
0cb0: 70 74 5d 5d 20 63 65 72 74 73 5d 0a 73 65 74 20  pt]] certs].set 
0cc0: 73 65 72 76 65 72 43 65 72 74 09 5b 66 69 6c 65  serverCert.[file
0cd0: 20 6a 6f 69 6e 20 24 63 65 72 74 73 44 69 72 20   join $certsDir 
0ce0: 73 65 72 76 65 72 2e 70 65 6d 5d 0a 73 65 74 20  server.pem].set 
0cf0: 63 6c 69 65 6e 74 43 65 72 74 09 5b 66 69 6c 65  clientCert.[file
0d00: 20 6a 6f 69 6e 20 24 63 65 72 74 73 44 69 72 20   join $certsDir 
0d10: 63 6c 69 65 6e 74 2e 70 65 6d 5d 0a 73 65 74 20  client.pem].set 
0d20: 63 61 43 65 72 74 09 5b 66 69 6c 65 20 6a 6f 69  caCert.[file joi
0d30: 6e 20 24 63 65 72 74 73 44 69 72 20 63 61 2e 70  n $certsDir ca.p
0d40: 65 6d 5d 0a 73 65 74 20 73 65 72 76 65 72 4b 65  em].set serverKe
0d50: 79 09 5b 66 69 6c 65 20 6a 6f 69 6e 20 24 63 65  y.[file join $ce
0d60: 72 74 73 44 69 72 20 73 65 72 76 65 72 2e 6b 65  rtsDir server.ke
0d70: 79 5d 0a 73 65 74 20 63 6c 69 65 6e 74 4b 65 79  y].set clientKey
0d80: 09 5b 66 69 6c 65 20 6a 6f 69 6e 20 24 63 65 72  .[file join $cer
0d90: 74 73 44 69 72 20 63 6c 69 65 6e 74 2e 6b 65 79  tsDir client.key
0da0: 5d 0a 0a 23 20 53 6f 6d 65 20 74 65 73 74 73 20  ]..# Some tests 
0db0: 72 65 71 75 69 72 65 20 74 68 65 20 74 65 73 74  require the test
0dc0: 74 68 72 65 61 64 20 61 6e 64 20 65 78 65 63 20  thread and exec 
0dd0: 63 6f 6d 6d 61 6e 64 73 0a 0a 73 65 74 20 3a 3a  commands..set ::
0de0: 74 63 6c 74 65 73 74 3a 3a 74 65 73 74 43 6f 6e  tcltest::testCon
0df0: 73 74 72 61 69 6e 74 73 28 74 65 73 74 74 68 72  straints(testthr
0e00: 65 61 64 29 20 5c 0a 09 5b 65 78 70 72 20 7b 5b  ead) \..[expr {[
0e10: 69 6e 66 6f 20 63 6f 6d 6d 61 6e 64 73 20 74 65  info commands te
0e20: 73 74 74 68 72 65 61 64 5d 20 21 3d 20 7b 7d 7d  stthread] != {}}
0e30: 5d 0a 73 65 74 20 3a 3a 74 63 6c 74 65 73 74 3a  ].set ::tcltest:
0e40: 3a 74 65 73 74 43 6f 6e 73 74 72 61 69 6e 74 73  :testConstraints
0e50: 28 65 78 65 63 29 20 5b 65 78 70 72 20 7b 5b 69  (exec) [expr {[i
0e60: 6e 66 6f 20 63 6f 6d 6d 61 6e 64 73 20 65 78 65  nfo commands exe
0e70: 63 5d 20 21 3d 20 7b 7d 7d 5d 0a 0a 23 0a 23 20  c] != {}}]..#.# 
0e80: 49 66 20 72 65 6d 6f 74 65 53 65 72 76 65 72 49  If remoteServerI
0e90: 50 20 6f 72 20 72 65 6d 6f 74 65 53 65 72 76 65  P or remoteServe
0ea0: 72 50 6f 72 74 20 61 72 65 20 6e 6f 74 20 73 65  rPort are not se
0eb0: 74 2c 20 63 68 65 63 6b 20 69 6e 20 74 68 65 0a  t, check in the.
0ec0: 23 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 20 76 61  # environment va
0ed0: 72 69 61 62 6c 65 73 20 66 6f 72 20 65 78 74 65  riables for exte
0ee0: 72 6e 61 6c 6c 79 20 73 65 74 20 76 61 6c 75 65  rnally set value
0ef0: 73 2e 0a 23 0a 0a 69 66 20 7b 21 5b 69 6e 66 6f  s..#..if {![info
0f00: 20 65 78 69 73 74 73 20 72 65 6d 6f 74 65 53 65   exists remoteSe
0f10: 72 76 65 72 49 50 5d 7d 20 7b 0a 20 20 20 20 69  rverIP]} {.    i
0f20: 66 20 7b 5b 69 6e 66 6f 20 65 78 69 73 74 73 20  f {[info exists 
0f30: 65 6e 76 28 72 65 6d 6f 74 65 53 65 72 76 65 72  env(remoteServer
0f40: 49 50 29 5d 7d 20 7b 0a 09 73 65 74 20 72 65 6d  IP)]} {..set rem
0f50: 6f 74 65 53 65 72 76 65 72 49 50 20 24 65 6e 76  oteServerIP $env
0f60: 28 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 29  (remoteServerIP)
0f70: 0a 20 20 20 20 7d 0a 7d 0a 69 66 20 7b 21 5b 69  .    }.}.if {![i
0f80: 6e 66 6f 20 65 78 69 73 74 73 20 72 65 6d 6f 74  nfo exists remot
0f90: 65 53 65 72 76 65 72 50 6f 72 74 5d 7d 20 7b 0a  eServerPort]} {.
0fa0: 20 20 20 20 69 66 20 7b 5b 69 6e 66 6f 20 65 78      if {[info ex
0fb0: 69 73 74 73 20 65 6e 76 28 72 65 6d 6f 74 65 53  ists env(remoteS
0fc0: 65 72 76 65 72 50 6f 72 74 29 5d 7d 20 7b 0a 09  erverPort)]} {..
0fd0: 73 65 74 20 72 65 6d 6f 74 65 53 65 72 76 65 72  set remoteServer
0fe0: 50 6f 72 74 20 24 65 6e 76 28 72 65 6d 6f 74 65  Port $env(remote
0ff0: 53 65 72 76 65 72 50 6f 72 74 29 0a 20 20 20 20  ServerPort).    
1000: 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 20  } else {.       
1010: 20 69 66 20 7b 5b 69 6e 66 6f 20 65 78 69 73 74   if {[info exist
1020: 73 20 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50  s remoteServerIP
1030: 5d 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 72 65  ]} {..    set re
1040: 6d 6f 74 65 53 65 72 76 65 72 50 6f 72 74 20 24  moteServerPort $
1050: 74 6c 73 53 65 72 76 65 72 50 6f 72 74 0a 20 20  tlsServerPort.  
1060: 20 20 20 20 20 20 7d 0a 20 20 20 20 7d 0a 7d 0a        }.    }.}.
1070: 0a 70 72 6f 63 20 64 6f 5f 68 61 6e 64 73 68 61  .proc do_handsha
1080: 6b 65 20 7b 73 20 7b 74 79 70 65 20 72 65 61 64  ke {s {type read
1090: 61 62 6c 65 7d 20 7b 63 6d 64 20 7b 7d 7d 20 61  able} {cmd {}} a
10a0: 72 67 73 7d 20 7b 0a 20 20 20 20 69 66 20 7b 5b  rgs} {.    if {[
10b0: 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 63 6c 6f 73  eof $s]} {..clos
10c0: 65 20 24 73 0a 09 64 70 75 74 73 20 22 68 61 6e  e $s..dputs "han
10d0: 64 73 68 61 6b 65 3a 20 65 6f 66 22 0a 09 73 65  dshake: eof"..se
10e0: 74 20 3a 3a 64 6f 5f 68 61 6e 64 73 68 61 6b 65  t ::do_handshake
10f0: 20 22 65 6f 66 22 0a 20 20 20 20 7d 20 65 6c 73   "eof".    } els
1100: 65 69 66 20 7b 5b 63 61 74 63 68 20 7b 74 6c 73  eif {[catch {tls
1110: 3a 3a 68 61 6e 64 73 68 61 6b 65 20 24 73 7d 20  ::handshake $s} 
1120: 72 65 73 75 6c 74 5d 7d 20 7b 0a 09 23 20 53 6f  result]} {..# So
1130: 6d 65 20 65 72 72 6f 72 73 20 61 72 65 20 6e 6f  me errors are no
1140: 72 6d 61 6c 2e 0a 09 64 70 75 74 73 20 22 68 61  rmal...dputs "ha
1150: 6e 64 73 68 61 6b 65 3a 20 24 72 65 73 75 6c 74  ndshake: $result
1160: 22 0a 20 20 20 20 7d 20 65 6c 73 65 69 66 20 7b  ".    } elseif {
1170: 24 72 65 73 75 6c 74 20 3d 3d 20 31 7d 20 7b 0a  $result == 1} {.
1180: 09 23 20 48 61 6e 64 73 68 61 6b 65 20 63 6f 6d  .# Handshake com
1190: 70 6c 65 74 65 0a 09 69 66 20 7b 5b 6c 6c 65 6e  plete..if {[llen
11a0: 67 74 68 20 24 61 72 67 73 5d 7d 20 7b 20 65 76  gth $args]} { ev
11b0: 61 6c 20 5b 6c 69 73 74 20 66 63 6f 6e 66 69 67  al [list fconfig
11c0: 75 72 65 20 24 73 5d 20 24 61 72 67 73 20 7d 0a  ure $s] $args }.
11d0: 09 69 66 20 7b 24 63 6d 64 20 3d 3d 20 22 22 7d  .if {$cmd == ""}
11e0: 20 7b 0a 09 20 20 20 20 66 69 6c 65 65 76 65 6e   {..    fileeven
11f0: 74 20 24 73 20 24 74 79 70 65 20 22 22 0a 09 7d  t $s $type ""..}
1200: 20 65 6c 73 65 20 7b 0a 09 20 20 20 20 66 69 6c   else {..    fil
1210: 65 65 76 65 6e 74 20 24 73 20 24 74 79 70 65 20  eevent $s $type 
1220: 22 24 63 6d 64 20 5b 6c 69 73 74 20 24 73 5d 22  "$cmd [list $s]"
1230: 0a 09 7d 0a 09 64 70 75 74 73 20 22 68 61 6e 64  ..}..dputs "hand
1240: 73 68 61 6b 65 3a 20 63 6f 6d 70 6c 65 74 65 22  shake: complete"
1250: 0a 09 73 65 74 20 3a 3a 64 6f 5f 68 61 6e 64 73  ..set ::do_hands
1260: 68 61 6b 65 20 22 63 6f 6d 70 6c 65 74 65 22 0a  hake "complete".
1270: 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 64 70      } else {..dp
1280: 75 74 73 20 22 68 61 6e 64 73 68 61 6b 65 3a 20  uts "handshake: 
1290: 69 6e 20 70 72 6f 67 72 65 73 73 22 0a 20 20 20  in progress".   
12a0: 20 7d 0a 7d 0a 0a 23 0a 23 20 43 68 65 63 6b 20   }.}..#.# Check 
12b0: 69 66 20 77 65 27 72 65 20 73 75 70 70 6f 73 65  if we're suppose
12c0: 64 20 74 6f 20 64 6f 20 74 65 73 74 73 20 61 67  d to do tests ag
12d0: 61 69 6e 73 74 20 74 68 65 20 72 65 6d 6f 74 65  ainst the remote
12e0: 20 73 65 72 76 65 72 0a 23 0a 0a 73 65 74 20 64   server.#..set d
12f0: 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65  oTestsWithRemote
1300: 53 65 72 76 65 72 20 31 0a 69 66 20 7b 21 5b 69  Server 1.if {![i
1310: 6e 66 6f 20 65 78 69 73 74 73 20 72 65 6d 6f 74  nfo exists remot
1320: 65 53 65 72 76 65 72 49 50 5d 20 26 26 20 28 24  eServerIP] && ($
1330: 74 63 6c 5f 70 6c 61 74 66 6f 72 6d 28 70 6c 61  tcl_platform(pla
1340: 74 66 6f 72 6d 29 20 21 3d 20 22 6d 61 63 69 6e  tform) != "macin
1350: 74 6f 73 68 22 29 7d 20 7b 0a 20 20 20 20 73 65  tosh")} {.    se
1360: 74 20 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50  t remoteServerIP
1370: 20 31 32 37 2e 30 2e 30 2e 31 0a 7d 0a 69 66 20   127.0.0.1.}.if 
1380: 7b 28 24 64 6f 54 65 73 74 73 57 69 74 68 52 65  {($doTestsWithRe
1390: 6d 6f 74 65 53 65 72 76 65 72 20 3d 3d 20 31 29  moteServer == 1)
13a0: 20 26 26 20 28 21 5b 69 6e 66 6f 20 65 78 69 73   && (![info exis
13b0: 74 73 20 72 65 6d 6f 74 65 53 65 72 76 65 72 50  ts remoteServerP
13c0: 6f 72 74 5d 29 7d 20 7b 0a 20 20 20 20 73 65 74  ort])} {.    set
13d0: 20 72 65 6d 6f 74 65 53 65 72 76 65 72 50 6f 72   remoteServerPor
13e0: 74 20 24 74 6c 73 53 65 72 76 65 72 50 6f 72 74  t $tlsServerPort
13f0: 0a 7d 0a 0a 23 20 41 74 74 65 6d 70 74 20 74 6f  .}..# Attempt to
1400: 20 63 6f 6e 6e 65 63 74 20 74 6f 20 61 20 72 65   connect to a re
1410: 6d 6f 74 65 20 73 65 72 76 65 72 20 69 66 20 6f  mote server if o
1420: 6e 65 20 69 73 20 61 6c 72 65 61 64 79 20 72 75  ne is already ru
1430: 6e 6e 69 6e 67 2e 20 49 66 20 69 74 0a 23 20 69  nning. If it.# i
1440: 73 20 6e 6f 74 20 72 75 6e 6e 69 6e 67 20 6f 72  s not running or
1450: 20 66 6f 72 20 73 6f 6d 65 20 6f 74 68 65 72 20   for some other 
1460: 72 65 61 73 6f 6e 20 74 68 65 20 63 6f 6e 6e 65  reason the conne
1470: 63 74 20 66 61 69 6c 73 2c 20 61 74 74 65 6d 70  ct fails, attemp
1480: 74 20 74 6f 0a 23 20 73 74 61 72 74 20 74 68 65  t to.# start the
1490: 20 72 65 6d 6f 74 65 20 73 65 72 76 65 72 20 6f   remote server o
14a0: 6e 20 74 68 65 20 6c 6f 63 61 6c 20 68 6f 73 74  n the local host
14b0: 20 6c 69 73 74 65 6e 69 6e 67 20 6f 6e 20 70 6f   listening on po
14c0: 72 74 20 38 30 34 38 2e 20 54 68 69 73 0a 23 20  rt 8048. This.# 
14d0: 69 73 20 6f 6e 6c 79 20 64 6f 6e 65 20 6f 6e 20  is only done on 
14e0: 70 6c 61 74 66 6f 72 6d 73 20 74 68 61 74 20 73  platforms that s
14f0: 75 70 70 6f 72 74 20 65 78 65 63 20 28 69 2e 65  upport exec (i.e
1500: 2e 20 6e 6f 74 20 6f 6e 20 74 68 65 20 4d 61 63  . not on the Mac
1510: 29 2e 20 4f 6e 0a 23 20 70 6c 61 74 66 6f 72 6d  ). On.# platform
1520: 73 20 74 68 61 74 20 64 6f 20 6e 6f 74 20 73 75  s that do not su
1530: 70 70 6f 72 74 20 65 78 65 63 2c 20 74 68 65 20  pport exec, the 
1540: 72 65 6d 6f 74 65 20 73 65 72 76 65 72 20 6d 75  remote server mu
1550: 73 74 20 62 65 20 73 74 61 72 74 65 64 0a 23 20  st be started.# 
1560: 62 79 20 74 68 65 20 75 73 65 72 20 62 65 66 6f  by the user befo
1570: 72 65 20 72 75 6e 6e 69 6e 67 20 74 68 65 20 74  re running the t
1580: 65 73 74 73 2e 0a 0a 73 65 74 20 72 65 6d 6f 74  ests...set remot
1590: 65 50 72 6f 63 43 68 61 6e 20 22 22 0a 73 65 74  eProcChan "".set
15a0: 20 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 20 22   commandSocket "
15b0: 22 0a 69 66 20 7b 24 64 6f 54 65 73 74 73 57 69  ".if {$doTestsWi
15c0: 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20  thRemoteServer} 
15d0: 7b 0a 20 20 20 20 63 61 74 63 68 20 7b 63 6c 6f  {.    catch {clo
15e0: 73 65 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65  se $commandSocke
15f0: 74 7d 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 63  t}.    if {[catc
1600: 68 20 7b 73 65 74 20 63 6f 6d 6d 61 6e 64 53 6f  h {set commandSo
1610: 63 6b 65 74 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65  cket [tls::socke
1620: 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69  t \..    -certfi
1630: 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d  le $clientCert -
1640: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d  cafile $caCert -
1650: 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b  keyfile $clientK
1660: 65 79 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74  ey \..    $remot
1670: 65 53 65 72 76 65 72 49 50 20 24 72 65 6d 6f 74  eServerIP $remot
1680: 65 53 65 72 76 65 72 50 6f 72 74 5d 7d 5d 20 21  eServerPort]}] !
1690: 3d 20 30 7d 20 7b 0a 09 69 66 20 7b 5b 69 6e 66  = 0} {..if {[inf
16a0: 6f 20 63 6f 6d 6d 61 6e 64 73 20 65 78 65 63 5d  o commands exec]
16b0: 20 3d 3d 20 22 22 7d 20 7b 0a 09 20 20 20 20 73   == ""} {..    s
16c0: 65 74 20 6e 6f 52 65 6d 6f 74 65 54 65 73 74 52  et noRemoteTestR
16d0: 65 61 73 6f 6e 20 22 63 61 6e 27 74 20 65 78 65  eason "can't exe
16e0: 63 22 0a 09 20 20 20 20 73 65 74 20 64 6f 54 65  c"..    set doTe
16f0: 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72  stsWithRemoteSer
1700: 76 65 72 20 30 0a 09 7d 20 65 6c 73 65 20 7b 0a  ver 0..} else {.
1710: 09 20 20 20 20 73 65 74 20 72 65 6d 6f 74 65 53  .    set remoteS
1720: 65 72 76 65 72 49 50 20 31 32 37 2e 30 2e 30 2e  erverIP 127.0.0.
1730: 31 0a 09 20 20 20 20 73 65 74 20 72 65 6d 6f 74  1..    set remot
1740: 65 46 69 6c 65 20 5b 66 69 6c 65 20 6a 6f 69 6e  eFile [file join
1750: 20 5b 70 77 64 5d 20 72 65 6d 6f 74 65 2e 74 63   [pwd] remote.tc
1760: 6c 5d 0a 09 20 20 20 20 69 66 20 7b 5b 63 61 74  l]..    if {[cat
1770: 63 68 20 7b 73 65 74 20 72 65 6d 6f 74 65 50 72  ch {set remotePr
1780: 6f 63 43 68 61 6e 20 5c 0a 09 09 20 20 20 20 5b  ocChan \...    [
1790: 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a  open "|[list $::
17a0: 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74  tcltest::tcltest
17b0: 20 24 72 65 6d 6f 74 65 46 69 6c 65 20 5c 0a 09   $remoteFile \..
17c0: 09 20 20 20 20 2d 73 65 72 76 65 72 49 73 53 69  .    -serverIsSi
17d0: 6c 65 6e 74 20 2d 70 6f 72 74 20 24 72 65 6d 6f  lent -port $remo
17e0: 74 65 53 65 72 76 65 72 50 6f 72 74 20 5c 0a 09  teServerPort \..
17f0: 09 20 20 20 20 2d 61 64 64 72 65 73 73 20 24 72  .    -address $r
1800: 65 6d 6f 74 65 53 65 72 76 65 72 49 50 5d 20 32  emoteServerIP] 2
1810: 3e 20 2f 64 65 76 2f 6e 75 6c 6c 22 20 77 2b 5d  > /dev/null" w+]
1820: 7d 20 6d 73 67 5d 20 3d 3d 20 30 7d 20 7b 0a 09  } msg] == 0} {..
1830: 09 61 66 74 65 72 20 31 30 30 30 0a 09 09 69 66  .after 1000...if
1840: 20 7b 5b 63 61 74 63 68 20 7b 73 65 74 20 63 6f   {[catch {set co
1850: 6d 6d 61 6e 64 53 6f 63 6b 65 74 20 5b 74 6c 73  mmandSocket [tls
1860: 3a 3a 73 6f 63 6b 65 74 20 2d 63 61 66 69 6c 65  ::socket -cafile
1870: 20 24 63 61 43 65 72 74 20 5c 0a 09 09 09 2d 63   $caCert \....-c
1880: 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43  ertfile $clientC
1890: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c  ert -keyfile $cl
18a0: 69 65 6e 74 4b 65 79 20 5c 0a 09 09 09 24 72 65  ientKey \....$re
18b0: 6d 6f 74 65 53 65 72 76 65 72 49 50 20 24 72 65  moteServerIP $re
18c0: 6d 6f 74 65 53 65 72 76 65 72 50 6f 72 74 5d 7d  moteServerPort]}
18d0: 20 6d 73 67 5d 20 3d 3d 20 30 7d 20 7b 0a 09 09   msg] == 0} {...
18e0: 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24      fconfigure $
18f0: 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 20 2d 74  commandSocket -t
1900: 72 61 6e 73 6c 61 74 69 6f 6e 20 63 72 6c 66 20  ranslation crlf 
1910: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a  -buffering line.
1920: 09 09 7d 20 65 6c 73 65 20 7b 0a 09 09 20 20 20  ..} else {...   
1930: 20 73 65 74 20 6e 6f 52 65 6d 6f 74 65 54 65 73   set noRemoteTes
1940: 74 52 65 61 73 6f 6e 20 24 6d 73 67 0a 09 09 20  tReason $msg... 
1950: 20 20 20 73 65 74 20 64 6f 54 65 73 74 73 57 69     set doTestsWi
1960: 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 20 30  thRemoteServer 0
1970: 0a 09 09 7d 0a 09 20 20 20 20 7d 20 65 6c 73 65  ...}..    } else
1980: 20 7b 0a 09 09 73 65 74 20 6e 6f 52 65 6d 6f 74   {...set noRemot
1990: 65 54 65 73 74 52 65 61 73 6f 6e 20 22 24 6d 73  eTestReason "$ms
19a0: 67 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63  g $::tcltest::tc
19b0: 6c 74 65 73 74 22 0a 09 09 73 65 74 20 64 6f 54  ltest"...set doT
19c0: 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65  estsWithRemoteSe
19d0: 72 76 65 72 20 30 0a 09 20 20 20 20 7d 0a 09 7d  rver 0..    }..}
19e0: 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 66  .    } else {..f
19f0: 63 6f 6e 66 69 67 75 72 65 20 24 63 6f 6d 6d 61  configure $comma
1a00: 6e 64 53 6f 63 6b 65 74 20 2d 74 72 61 6e 73 6c  ndSocket -transl
1a10: 61 74 69 6f 6e 20 63 72 6c 66 20 2d 62 75 66 66  ation crlf -buff
1a20: 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 7d  ering line.    }
1a30: 0a 7d 0a 0a 23 20 53 6f 6d 65 20 74 65 73 74 73  .}..# Some tests
1a40: 20 61 72 65 20 72 75 6e 20 6f 6e 6c 79 20 69 66   are run only if
1a50: 20 77 65 20 61 72 65 20 64 6f 69 6e 67 20 74 65   we are doing te
1a60: 73 74 69 6e 67 20 61 67 61 69 6e 73 74 20 61 20  sting against a 
1a70: 72 65 6d 6f 74 65 20 73 65 72 76 65 72 2e 0a 73  remote server..s
1a80: 65 74 20 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 65  et ::tcltest::te
1a90: 73 74 43 6f 6e 73 74 72 61 69 6e 74 73 28 64 6f  stConstraints(do
1aa0: 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53  TestsWithRemoteS
1ab0: 65 72 76 65 72 29 20 24 64 6f 54 65 73 74 73 57  erver) $doTestsW
1ac0: 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 0a  ithRemoteServer.
1ad0: 69 66 20 7b 24 64 6f 54 65 73 74 73 57 69 74 68  if {$doTestsWith
1ae0: 52 65 6d 6f 74 65 53 65 72 76 65 72 20 3d 3d 20  RemoteServer == 
1af0: 30 7d 20 7b 0a 20 20 20 20 69 66 20 7b 5b 73 74  0} {.    if {[st
1b00: 72 69 6e 67 20 66 69 72 73 74 20 73 20 24 3a 3a  ring first s $::
1b10: 74 63 6c 74 65 73 74 3a 3a 76 65 72 62 6f 73 65  tcltest::verbose
1b20: 5d 20 21 3d 20 2d 31 7d 20 7b 0a 20 20 20 20 09  ] != -1} {.    .
1b30: 70 75 74 73 20 22 53 6b 69 70 70 69 6e 67 20 74  puts "Skipping t
1b40: 65 73 74 73 20 77 69 74 68 20 72 65 6d 6f 74 65  ests with remote
1b50: 20 73 65 72 76 65 72 2e 20 53 65 65 20 74 65 73   server. See tes
1b60: 74 73 2f 73 6f 63 6b 65 74 2e 74 65 73 74 20 66  ts/socket.test f
1b70: 6f 72 22 0a 09 70 75 74 73 20 22 69 6e 66 6f 72  or"..puts "infor
1b80: 6d 61 74 69 6f 6e 20 6f 6e 20 68 6f 77 20 74 6f  mation on how to
1b90: 20 72 75 6e 20 72 65 6d 6f 74 65 20 73 65 72 76   run remote serv
1ba0: 65 72 2e 22 0a 09 70 75 74 73 20 22 52 65 61 73  er."..puts "Reas
1bb0: 6f 6e 20 66 6f 72 20 6e 6f 74 20 64 6f 69 6e 67  on for not doing
1bc0: 20 72 65 6d 6f 74 65 20 74 65 73 74 73 3a 20 24   remote tests: $
1bd0: 6e 6f 52 65 6d 6f 74 65 54 65 73 74 52 65 61 73  noRemoteTestReas
1be0: 6f 6e 22 0a 20 20 20 20 7d 0a 7d 0a 0a 23 0a 23  on".    }.}..#.#
1bf0: 20 49 66 20 77 65 20 64 6f 20 74 68 65 20 74 65   If we do the te
1c00: 73 74 73 2c 20 64 65 66 69 6e 65 20 61 20 63 6f  sts, define a co
1c10: 6d 6d 61 6e 64 20 74 6f 20 73 65 6e 64 20 61 20  mmand to send a 
1c20: 63 6f 6d 6d 61 6e 64 20 74 6f 20 74 68 65 0a 23  command to the.#
1c30: 20 72 65 6d 6f 74 65 20 73 65 72 76 65 72 2e 0a   remote server..
1c40: 23 0a 0a 69 66 20 7b 24 64 6f 54 65 73 74 73 57  #..if {$doTestsW
1c50: 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 20  ithRemoteServer 
1c60: 3d 3d 20 31 7d 20 7b 0a 20 20 20 20 70 72 6f 63  == 1} {.    proc
1c70: 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 7d   sendCommand {c}
1c80: 20 7b 0a 09 67 6c 6f 62 61 6c 20 63 6f 6d 6d 61   {..global comma
1c90: 6e 64 53 6f 63 6b 65 74 0a 0a 09 69 66 20 7b 5b  ndSocket...if {[
1ca0: 65 6f 66 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b  eof $commandSock
1cb0: 65 74 5d 7d 20 7b 0a 09 20 20 20 20 65 72 72 6f  et]} {..    erro
1cc0: 72 20 22 72 65 6d 6f 74 65 20 73 65 72 76 65 72  r "remote server
1cd0: 20 64 69 73 61 70 70 65 61 72 65 64 22 0a 09 7d   disappeared"..}
1ce0: 0a 0a 09 69 66 20 7b 5b 63 61 74 63 68 20 7b 70  ...if {[catch {p
1cf0: 75 74 73 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b  uts $commandSock
1d00: 65 74 20 24 63 7d 20 6d 73 67 5d 7d 20 7b 0a 09  et $c} msg]} {..
1d10: 20 20 20 20 65 72 72 6f 72 20 22 72 65 6d 6f 74      error "remot
1d20: 65 20 73 65 72 76 65 72 20 64 69 73 61 70 70 65  e server disappe
1d30: 61 72 65 64 3a 20 24 6d 73 67 22 0a 09 7d 0a 09  ared: $msg"..}..
1d40: 69 66 20 7b 5b 63 61 74 63 68 20 7b 70 75 74 73  if {[catch {puts
1d50: 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 20   $commandSocket 
1d60: 22 2d 2d 4d 61 72 6b 65 72 2d 2d 4d 61 72 6b 65  "--Marker--Marke
1d70: 72 2d 2d 4d 61 72 6b 65 72 2d 2d 22 7d 20 6d 73  r--Marker--"} ms
1d80: 67 5d 7d 20 7b 0a 09 20 20 20 20 65 72 72 6f 72  g]} {..    error
1d90: 20 22 72 65 6d 6f 74 65 20 73 65 72 76 65 72 20   "remote server 
1da0: 64 69 73 61 70 70 65 61 72 65 64 3a 20 24 6d 73  disappeared: $ms
1db0: 67 22 0a 09 7d 0a 0a 09 73 65 74 20 72 65 73 70  g"..}...set resp
1dc0: 20 22 22 0a 09 77 68 69 6c 65 20 7b 31 7d 20 7b   ""..while {1} {
1dd0: 0a 09 20 20 20 20 73 65 74 20 6c 69 6e 65 20 5b  ..    set line [
1de0: 67 65 74 73 20 24 63 6f 6d 6d 61 6e 64 53 6f 63  gets $commandSoc
1df0: 6b 65 74 5d 0a 09 20 20 20 20 69 66 20 7b 5b 65  ket]..    if {[e
1e00: 6f 66 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65  of $commandSocke
1e10: 74 5d 7d 20 7b 0a 09 09 65 72 72 6f 72 20 22 72  t]} {...error "r
1e20: 65 6d 6f 74 65 20 73 65 72 76 65 72 20 64 69 73  emote server dis
1e30: 61 70 70 65 61 72 65 64 22 0a 09 20 20 20 20 7d  appeared"..    }
1e40: 0a 09 20 20 20 20 69 66 20 7b 5b 73 74 72 69 6e  ..    if {[strin
1e50: 67 20 63 6f 6d 70 61 72 65 20 24 6c 69 6e 65 20  g compare $line 
1e60: 22 2d 2d 4d 61 72 6b 65 72 2d 2d 4d 61 72 6b 65  "--Marker--Marke
1e70: 72 2d 2d 4d 61 72 6b 65 72 2d 2d 22 5d 20 3d 3d  r--Marker--"] ==
1e80: 20 30 7d 20 7b 0a 09 09 69 66 20 7b 5b 73 74 72   0} {...if {[str
1e90: 69 6e 67 20 63 6f 6d 70 61 72 65 20 5b 6c 69 6e  ing compare [lin
1ea0: 64 65 78 20 24 72 65 73 70 20 30 5d 20 65 72 72  dex $resp 0] err
1eb0: 6f 72 5d 20 3d 3d 20 30 7d 20 7b 0a 09 09 20 20  or] == 0} {...  
1ec0: 20 20 65 72 72 6f 72 20 5b 6c 69 6e 64 65 78 20    error [lindex 
1ed0: 24 72 65 73 70 20 31 5d 0a 09 09 7d 20 65 6c 73  $resp 1]...} els
1ee0: 65 20 7b 0a 09 09 20 20 20 20 72 65 74 75 72 6e  e {...    return
1ef0: 20 5b 6c 69 6e 64 65 78 20 24 72 65 73 70 20 31   [lindex $resp 1
1f00: 5d 0a 09 09 7d 0a 09 20 20 20 20 7d 20 65 6c 73  ]...}..    } els
1f10: 65 20 7b 0a 09 09 61 70 70 65 6e 64 20 72 65 73  e {...append res
1f20: 70 20 24 6c 69 6e 65 20 22 5c 6e 22 0a 09 20 20  p $line "\n"..  
1f30: 20 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a 0a 20 20    }..}.    }..  
1f40: 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 5b 6c    sendCommand [l
1f50: 69 73 74 20 70 72 6f 63 20 64 70 75 74 73 20 5b  ist proc dputs [
1f60: 69 6e 66 6f 20 61 72 67 73 20 64 70 75 74 73 5d  info args dputs]
1f70: 20 5b 69 6e 66 6f 20 62 6f 64 79 20 64 70 75 74   [info body dput
1f80: 73 5d 5d 0a 0a 20 20 20 20 70 72 6f 63 20 73 65  s]]..    proc se
1f90: 6e 64 43 65 72 74 56 61 6c 75 65 73 20 7b 7d 20  ndCertValues {} 
1fa0: 7b 0a 09 23 20 57 65 20 6e 65 65 64 20 74 6f 20  {..# We need to 
1fb0: 62 65 20 61 62 6c 65 20 74 6f 20 73 65 6e 64 20  be able to send 
1fc0: 63 65 72 74 69 66 69 63 61 74 65 20 76 61 6c 75  certificate valu
1fd0: 65 73 20 74 68 61 74 20 6e 6f 72 6d 61 6c 69 7a  es that normaliz
1fe0: 65 0a 09 23 20 66 69 6c 65 6e 61 6d 65 73 20 61  e..# filenames a
1ff0: 63 72 6f 73 73 20 70 6c 61 74 66 6f 72 6d 73 0a  cross platforms.
2000: 09 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09  .sendCommand {..
2010: 20 20 20 20 73 65 74 20 63 65 72 74 73 44 69 72      set certsDir
2020: 09 5b 66 69 6c 65 20 6a 6f 69 6e 20 5b 66 69 6c  .[file join [fil
2030: 65 20 64 69 72 6e 61 6d 65 20 5b 69 6e 66 6f 20  e dirname [info 
2040: 73 63 72 69 70 74 5d 5d 20 63 65 72 74 73 5d 0a  script]] certs].
2050: 09 20 20 20 20 73 65 74 20 73 65 72 76 65 72 43  .    set serverC
2060: 65 72 74 09 5b 66 69 6c 65 20 6a 6f 69 6e 20 24  ert.[file join $
2070: 63 65 72 74 73 44 69 72 20 73 65 72 76 65 72 2e  certsDir server.
2080: 70 65 6d 5d 0a 09 20 20 20 20 73 65 74 20 63 6c  pem]..    set cl
2090: 69 65 6e 74 43 65 72 74 09 5b 66 69 6c 65 20 6a  ientCert.[file j
20a0: 6f 69 6e 20 24 63 65 72 74 73 44 69 72 20 63 6c  oin $certsDir cl
20b0: 69 65 6e 74 2e 70 65 6d 5d 0a 09 20 20 20 20 73  ient.pem]..    s
20c0: 65 74 20 63 61 43 65 72 74 09 09 5b 66 69 6c 65  et caCert..[file
20d0: 20 6a 6f 69 6e 20 24 63 65 72 74 73 44 69 72 20   join $certsDir 
20e0: 63 61 63 65 72 74 2e 70 65 6d 5d 0a 09 20 20 20  cacert.pem]..   
20f0: 20 73 65 74 20 73 65 72 76 65 72 4b 65 79 09 5b   set serverKey.[
2100: 66 69 6c 65 20 6a 6f 69 6e 20 24 63 65 72 74 73  file join $certs
2110: 44 69 72 20 73 65 72 76 65 72 2e 6b 65 79 5d 0a  Dir server.key].
2120: 09 20 20 20 20 73 65 74 20 63 6c 69 65 6e 74 4b  .    set clientK
2130: 65 79 09 5b 66 69 6c 65 20 6a 6f 69 6e 20 24 63  ey.[file join $c
2140: 65 72 74 73 44 69 72 20 63 6c 69 65 6e 74 2e 6b  ertsDir client.k
2150: 65 79 5d 0a 09 7d 0a 20 20 20 20 7d 0a 7d 0a 0a  ey]..}.    }.}..
2160: 74 65 73 74 20 74 6c 73 49 4f 2d 31 2e 31 20 7b  test tlsIO-1.1 {
2170: 61 72 67 20 70 61 72 73 69 6e 67 20 66 6f 72 20  arg parsing for 
2180: 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20  socket command} 
2190: 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c  {socket} {.    l
21a0: 69 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a  ist [catch {tls:
21b0: 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 7d  :socket -server}
21c0: 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20   msg] $msg.} {1 
21d0: 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 73  {wrong # args: s
21e0: 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73  hould be "tls::s
21f0: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 63 6f  ocket -server co
2200: 6d 6d 61 6e 64 20 3f 6f 70 74 69 6f 6e 73 3f 20  mmand ?options? 
2210: 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 20 74 6c  port"}}..test tl
2220: 73 49 4f 2d 31 2e 32 20 7b 61 72 67 20 70 61 72  sIO-1.2 {arg par
2230: 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 20  sing for socket 
2240: 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 74  command} {socket
2250: 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 61  } {.    list [ca
2260: 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74  tch {tls::socket
2270: 20 2d 73 65 72 76 65 72 20 66 6f 6f 7d 20 6d 73   -server foo} ms
2280: 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72  g] $msg.} {1 {wr
2290: 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 68 6f 75  ong # args: shou
22a0: 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 6b  ld be "tls::sock
22b0: 65 74 20 2d 73 65 72 76 65 72 20 63 6f 6d 6d 61  et -server comma
22c0: 6e 64 20 3f 6f 70 74 69 6f 6e 73 3f 20 70 6f 72  nd ?options? por
22d0: 74 22 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f  t"}}..test tlsIO
22e0: 2d 31 2e 33 20 7b 61 72 67 20 70 61 72 73 69 6e  -1.3 {arg parsin
22f0: 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d  g for socket com
2300: 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b  mand} {socket} {
2310: 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68  .    list [catch
2320: 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 6d   {tls::socket -m
2330: 79 61 64 64 72 7d 20 6d 73 67 5d 20 24 6d 73 67  yaddr} msg] $msg
2340: 0a 7d 20 7b 31 20 7b 22 2d 6d 79 61 64 64 72 22  .} {1 {"-myaddr"
2350: 20 6f 70 74 69 6f 6e 20 6d 75 73 74 20 62 65 20   option must be 
2360: 66 6f 6c 6c 6f 77 65 64 20 62 79 20 76 61 6c 75  followed by valu
2370: 65 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d  e}}..test tlsIO-
2380: 31 2e 34 20 7b 61 72 67 20 70 61 72 73 69 6e 67  1.4 {arg parsing
2390: 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d   for socket comm
23a0: 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a  and} {socket} {.
23b0: 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20      list [catch 
23c0: 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 6d 79  {tls::socket -my
23d0: 61 64 64 72 20 31 32 37 2e 30 2e 30 2e 31 7d 20  addr 127.0.0.1} 
23e0: 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b  msg] $msg.} {1 {
23f0: 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 68  wrong # args: sh
2400: 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f  ould be "tls::so
2410: 63 6b 65 74 20 3f 6f 70 74 69 6f 6e 73 3f 20 68  cket ?options? h
2420: 6f 73 74 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 73  ost port"}}..tes
2430: 74 20 74 6c 73 49 4f 2d 31 2e 35 20 7b 61 72 67  t tlsIO-1.5 {arg
2440: 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73 6f 63   parsing for soc
2450: 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f  ket command} {so
2460: 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74  cket} {.    list
2470: 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f   [catch {tls::so
2480: 63 6b 65 74 20 2d 6d 79 70 6f 72 74 7d 20 6d 73  cket -myport} ms
2490: 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 22 2d  g] $msg.} {1 {"-
24a0: 6d 79 70 6f 72 74 22 20 6f 70 74 69 6f 6e 20 6d  myport" option m
24b0: 75 73 74 20 62 65 20 66 6f 6c 6c 6f 77 65 64 20  ust be followed 
24c0: 62 79 20 76 61 6c 75 65 7d 7d 0a 0a 74 65 73 74  by value}}..test
24d0: 20 74 6c 73 49 4f 2d 31 2e 36 20 7b 61 72 67 20   tlsIO-1.6 {arg 
24e0: 70 61 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b  parsing for sock
24f0: 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63  et command} {soc
2500: 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20  ket} {.    list 
2510: 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63  [catch {tls::soc
2520: 6b 65 74 20 2d 6d 79 70 6f 72 74 20 78 78 78 78  ket -myport xxxx
2530: 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31  } msg] $msg.} {1
2540: 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 20   {wrong # args: 
2550: 73 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a  should be "tls::
2560: 73 6f 63 6b 65 74 20 3f 6f 70 74 69 6f 6e 73 3f  socket ?options?
2570: 20 68 6f 73 74 20 70 6f 72 74 22 7d 7d 0a 0a 74   host port"}}..t
2580: 65 73 74 20 74 6c 73 49 4f 2d 31 2e 37 20 7b 61  est tlsIO-1.7 {a
2590: 72 67 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73  rg parsing for s
25a0: 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b  ocket command} {
25b0: 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69  socket} {.    li
25c0: 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a  st [catch {tls::
25d0: 73 6f 63 6b 65 74 20 2d 6d 79 70 6f 72 74 20 32  socket -myport 2
25e0: 35 32 32 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d  522} msg] $msg.}
25f0: 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 67   {1 {wrong # arg
2600: 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 74 6c  s: should be "tl
2610: 73 3a 3a 73 6f 63 6b 65 74 20 3f 6f 70 74 69 6f  s::socket ?optio
2620: 6e 73 3f 20 68 6f 73 74 20 70 6f 72 74 22 7d 7d  ns? host port"}}
2630: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 2e 38  ..test tlsIO-1.8
2640: 20 7b 61 72 67 20 70 61 72 73 69 6e 67 20 66 6f   {arg parsing fo
2650: 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64  r socket command
2660: 7d 20 2d 63 6f 6e 73 74 72 61 69 6e 74 73 20 7b  } -constraints {
2670: 73 6f 63 6b 65 74 7d 20 2d 62 6f 64 79 20 7b 0a  socket} -body {.
2680: 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20      list [catch 
2690: 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 66 72  {tls::socket -fr
26a0: 6f 62 6f 7a 7d 20 6d 73 67 5d 20 24 6d 73 67 0a  oboz} msg] $msg.
26b0: 7d 20 2d 6d 61 74 63 68 20 67 6c 6f 62 20 2d 72  } -match glob -r
26c0: 65 73 75 6c 74 20 7b 31 20 7b 62 61 64 20 6f 70  esult {1 {bad op
26d0: 74 69 6f 6e 20 22 2d 66 72 6f 62 6f 7a 22 3a 20  tion "-froboz": 
26e0: 6d 75 73 74 20 62 65 20 6f 6e 65 20 6f 66 20 2a  must be one of *
26f0: 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31  }}..test tlsIO-1
2700: 2e 39 20 7b 61 72 67 20 70 61 72 73 69 6e 67 20  .9 {arg parsing 
2710: 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61  for socket comma
2720: 6e 64 7d 20 2d 63 6f 6e 73 74 72 61 69 6e 74 73  nd} -constraints
2730: 20 7b 73 6f 63 6b 65 74 7d 20 2d 62 6f 64 79 20   {socket} -body 
2740: 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63  {.    list [catc
2750: 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d  h {tls::socket -
2760: 73 65 72 76 65 72 20 66 6f 6f 20 2d 6d 79 70 6f  server foo -mypo
2770: 72 74 20 32 35 32 31 20 33 33 33 33 7d 20 6d 73  rt 2521 3333} ms
2780: 67 5d 20 24 6d 73 67 0a 7d 20 2d 6d 61 74 63 68  g] $msg.} -match
2790: 20 67 6c 6f 62 20 2d 72 65 73 75 6c 74 20 7b 31   glob -result {1
27a0: 20 7b 62 61 64 20 6f 70 74 69 6f 6e 20 22 2d 6d   {bad option "-m
27b0: 79 70 6f 72 74 22 3a 20 6d 75 73 74 20 62 65 20  yport": must be 
27c0: 6f 6e 65 20 6f 66 20 2a 7d 7d 0a 0a 74 65 73 74  one of *}}..test
27d0: 20 74 6c 73 49 4f 2d 31 2e 31 30 20 7b 61 72 67   tlsIO-1.10 {arg
27e0: 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73 6f 63   parsing for soc
27f0: 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f  ket command} {so
2800: 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74  cket} {.    list
2810: 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f   [catch {tls::so
2820: 63 6b 65 74 20 68 6f 73 74 20 32 35 32 38 20 2d  cket host 2528 -
2830: 6a 75 6e 6b 7d 20 6d 73 67 5d 20 24 6d 73 67 0a  junk} msg] $msg.
2840: 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 72  } {1 {wrong # ar
2850: 67 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 74  gs: should be "t
2860: 6c 73 3a 3a 73 6f 63 6b 65 74 20 3f 6f 70 74 69  ls::socket ?opti
2870: 6f 6e 73 3f 20 68 6f 73 74 20 70 6f 72 74 22 7d  ons? host port"}
2880: 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 2e  }..test tlsIO-1.
2890: 31 31 20 7b 61 72 67 20 70 61 72 73 69 6e 67 20  11 {arg parsing 
28a0: 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61  for socket comma
28b0: 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20  nd} {socket} {. 
28c0: 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 7b     list [catch {
28d0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72  tls::socket -ser
28e0: 76 65 72 20 63 61 6c 6c 62 61 63 6b 20 32 35 32  ver callback 252
28f0: 30 20 2d 2d 7d 20 6d 73 67 5d 20 24 6d 73 67 0a  0 --} msg] $msg.
2900: 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 72  } {1 {wrong # ar
2910: 67 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 74  gs: should be "t
2920: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76  ls::socket -serv
2930: 65 72 20 63 6f 6d 6d 61 6e 64 20 3f 6f 70 74 69  er command ?opti
2940: 6f 6e 73 3f 20 70 6f 72 74 22 7d 7d 0a 0a 74 65  ons? port"}}..te
2950: 73 74 20 74 6c 73 49 4f 2d 31 2e 31 32 20 7b 61  st tlsIO-1.12 {a
2960: 72 67 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73  rg parsing for s
2970: 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b  ocket command} {
2980: 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69  socket} {.    li
2990: 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a  st [catch {tls::
29a0: 73 6f 63 6b 65 74 20 66 6f 6f 20 62 61 64 70 6f  socket foo badpo
29b0: 72 74 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20  rt} msg] $msg.} 
29c0: 7b 31 20 7b 65 78 70 65 63 74 65 64 20 69 6e 74  {1 {expected int
29d0: 65 67 65 72 20 62 75 74 20 67 6f 74 20 22 62 61  eger but got "ba
29e0: 64 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 20 74  dport"}}..test t
29f0: 6c 73 49 4f 2d 32 2e 31 20 7b 74 63 70 20 63 6f  lsIO-2.1 {tcp co
2a00: 6e 6e 65 63 74 69 6f 6e 7d 20 7b 73 6f 63 6b 65  nnection} {socke
2a10: 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 72  t stdio} {.    r
2a20: 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74  emoveFile script
2a30: 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e  .    set f [open
2a40: 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70   script w].    p
2a50: 75 74 73 20 24 66 20 5b 6c 69 73 74 20 73 65 74  uts $f [list set
2a60: 20 61 75 74 6f 5f 70 61 74 68 20 24 61 75 74 6f   auto_path $auto
2a70: 5f 70 61 74 68 5d 0a 20 20 20 20 70 75 74 73 20  _path].    puts 
2a80: 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 20 72 65  $f {..package re
2a90: 71 75 69 72 65 20 74 6c 73 0a 09 73 65 74 20 74  quire tls..set t
2aa0: 69 6d 65 72 20 5b 61 66 74 65 72 20 32 30 30 30  imer [after 2000
2ab0: 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75   "set x timed_ou
2ac0: 74 22 5d 0a 20 20 20 20 7d 0a 20 20 20 20 70 75  t"].    }.    pu
2ad0: 74 73 20 24 66 20 22 73 65 74 20 66 20 5c 5b 74  ts $f "set f \[t
2ae0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76  ls::socket -serv
2af0: 65 72 20 61 63 63 65 70 74 20 2d 63 65 72 74 66  er accept -certf
2b00: 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20  ile $serverCert 
2b10: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20  -cafile $caCert 
2b20: 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72  -keyfile $server
2b30: 4b 65 79 20 38 38 32 38 20 5c 5d 22 0a 20 20 20  Key 8828 \]".   
2b40: 20 70 75 74 73 20 24 66 20 7b 0a 09 70 72 6f 63   puts $f {..proc
2b50: 20 61 63 63 65 70 74 20 7b 66 69 6c 65 20 61 64   accept {file ad
2b60: 64 72 20 70 6f 72 74 7d 20 7b 0a 09 20 20 20 20  dr port} {..    
2b70: 67 6c 6f 62 61 6c 20 78 0a 09 20 20 20 20 73 65  global x..    se
2b80: 74 20 78 20 64 6f 6e 65 0a 20 20 20 20 20 20 20  t x done.       
2b90: 20 20 20 20 20 63 6c 6f 73 65 20 24 66 69 6c 65       close $file
2ba0: 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 64 79 0a  ..}..puts ready.
2bb0: 09 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 20  .vwait x..after 
2bc0: 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 09 63  cancel $timer..c
2bd0: 6c 6f 73 65 20 24 66 0a 09 70 75 74 73 20 24 78  lose $f..puts $x
2be0: 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65  .    }.    close
2bf0: 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f   $f.    set f [o
2c00: 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74  pen "|[list $::t
2c10: 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20  cltest::tcltest 
2c20: 73 63 72 69 70 74 5d 20 32 3e 20 2f 64 65 76 2f  script] 2> /dev/
2c30: 6e 75 6c 6c 22 20 72 5d 0a 20 20 20 20 67 65 74  null" r].    get
2c40: 73 20 24 66 20 78 0a 20 20 20 20 69 66 20 7b 5b  s $f x.    if {[
2c50: 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b  catch {tls::sock
2c60: 65 74 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c  et -certfile $cl
2c70: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65  ientCert -cafile
2c80: 20 24 63 61 43 65 72 74 20 5c 0a 09 2d 6b 65 79   $caCert \..-key
2c90: 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20  file $clientKey 
2ca0: 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 38 7d 20  127.0.0.1 8828} 
2cb0: 6d 73 67 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20  msg]} {.        
2cc0: 73 65 74 20 78 20 24 6d 73 67 0a 20 20 20 20 7d  set x $msg.    }
2cd0: 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 20   else {.        
2ce0: 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 74 73 20  lappend x [gets 
2cf0: 24 66 5d 0a 20 20 20 20 20 20 20 20 63 6c 6f 73  $f].        clos
2d00: 65 20 24 6d 73 67 0a 20 20 20 20 7d 0a 20 20 20  e $msg.    }.   
2d10: 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 74 73   lappend x [gets
2d20: 20 24 66 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24   $f].    close $
2d30: 66 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 72  f.    set x.} {r
2d40: 65 61 64 79 20 64 6f 6e 65 20 7b 7d 7d 0a 0a 69  eady done {}}..i
2d50: 66 20 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 70  f [info exists p
2d60: 6f 72 74 5d 20 7b 0a 20 20 20 20 69 6e 63 72 20  ort] {.    incr 
2d70: 70 6f 72 74 0a 7d 20 65 6c 73 65 20 7b 0a 20 20  port.} else {.  
2d80: 20 20 73 65 74 20 70 6f 72 74 20 5b 65 78 70 72    set port [expr
2d90: 20 7b 24 74 6c 73 53 65 72 76 65 72 50 6f 72 74   {$tlsServerPort
2da0: 20 2b 20 5b 70 69 64 5d 25 31 30 32 34 7d 5d 0a   + [pid]%1024}].
2db0: 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 32 2e  }..test tlsIO-2.
2dc0: 32 20 7b 74 63 70 20 63 6f 6e 6e 65 63 74 69 6f  2 {tcp connectio
2dd0: 6e 20 77 69 74 68 20 63 6c 69 65 6e 74 20 70 6f  n with client po
2de0: 72 74 20 73 70 65 63 69 66 69 65 64 7d 20 7b 73  rt specified} {s
2df0: 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20  ocket stdio} {. 
2e00: 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63     removeFile sc
2e10: 72 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b  ript.    set f [
2e20: 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20  open script w]. 
2e30: 20 20 20 70 75 74 73 20 24 66 20 5b 6c 69 73 74     puts $f [list
2e40: 20 73 65 74 20 61 75 74 6f 5f 70 61 74 68 20 24   set auto_path $
2e50: 61 75 74 6f 5f 70 61 74 68 5d 0a 20 20 20 20 70  auto_path].    p
2e60: 75 74 73 20 24 66 20 7b 0a 09 70 61 63 6b 61 67  uts $f {..packag
2e70: 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 73  e require tls..s
2e80: 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20  et timer [after 
2e90: 32 30 30 30 20 22 73 65 74 20 78 20 64 6f 6e 65  2000 "set x done
2ea0: 22 5d 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74  "].    }.    put
2eb0: 73 20 24 66 20 22 73 65 74 20 66 20 5c 5b 74 6c  s $f "set f \[tl
2ec0: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65  s::socket -serve
2ed0: 72 20 61 63 63 65 70 74 20 2d 63 65 72 74 66 69  r accept -certfi
2ee0: 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d  le $serverCert -
2ef0: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d  cafile $caCert -
2f00: 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b  keyfile $serverK
2f10: 65 79 20 38 38 32 39 20 5c 5d 22 0a 20 20 20 20  ey 8829 \]".    
2f20: 70 75 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 20  puts $f {..proc 
2f30: 61 63 63 65 70 74 20 7b 73 6f 63 6b 20 61 64 64  accept {sock add
2f40: 72 20 70 6f 72 74 7d 20 7b 0a 20 20 20 20 20 20  r port} {.      
2f50: 20 20 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20        global x. 
2f60: 20 20 20 20 20 20 20 20 20 20 20 70 75 74 73 20             puts 
2f70: 22 5b 67 65 74 73 20 24 73 6f 63 6b 5d 20 24 70  "[gets $sock] $p
2f80: 6f 72 74 22 0a 20 20 20 20 20 20 20 20 20 20 20  ort".           
2f90: 20 63 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 20 20   close $sock.   
2fa0: 20 20 20 20 20 20 20 20 20 73 65 74 20 78 20 64           set x d
2fb0: 6f 6e 65 0a 09 7d 0a 09 70 75 74 73 20 72 65 61  one..}..puts rea
2fc0: 64 79 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74  dy..vwait x..aft
2fd0: 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72  er cancel $timer
2fe0: 0a 09 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 7d  ..close $f.    }
2ff0: 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20  .    close $f.  
3000: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c    set f [open "|
3010: 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74  [list $::tcltest
3020: 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74  ::tcltest script
3030: 5d 20 32 3e 20 2f 64 65 76 2f 6e 75 6c 6c 22 20  ] 2> /dev/null" 
3040: 72 5d 0a 20 20 20 20 67 65 74 73 20 24 66 20 78  r].    gets $f x
3050: 0a 20 20 20 20 67 6c 6f 62 61 6c 20 70 6f 72 74  .    global port
3060: 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 63 68 20  .    if {[catch 
3070: 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 6d 79  {tls::socket -my
3080: 70 6f 72 74 20 24 70 6f 72 74 20 5c 0a 09 2d 63  port $port \..-c
3090: 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43  ertfile $clientC
30a0: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43  ert -cafile $caC
30b0: 65 72 74 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 20  ert \..-keyfile 
30c0: 24 63 6c 69 65 6e 74 4b 65 79 20 31 32 37 2e 30  $clientKey 127.0
30d0: 2e 30 2e 31 20 38 38 32 39 7d 20 73 6f 63 6b 5d  .0.1 8829} sock]
30e0: 7d 20 7b 0a 20 20 20 20 20 20 20 20 73 65 74 20  } {.        set 
30f0: 78 20 24 73 6f 63 6b 0a 09 63 61 74 63 68 20 7b  x $sock..catch {
3100: 63 6c 6f 73 65 20 5b 74 6c 73 3a 3a 73 6f 63 6b  close [tls::sock
3110: 65 74 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 32  et 127.0.0.1 882
3120: 39 5d 7d 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b  9]}.    } else {
3130: 0a 20 20 20 20 20 20 20 20 70 75 74 73 20 24 73  .        puts $s
3140: 6f 63 6b 20 68 65 6c 6c 6f 0a 09 66 6c 75 73 68  ock hello..flush
3150: 20 24 73 6f 63 6b 0a 20 20 20 20 20 20 20 20 6c   $sock.        l
3160: 61 70 70 65 6e 64 20 78 20 5b 67 65 74 73 20 24  append x [gets $
3170: 66 5d 0a 20 20 20 20 20 20 20 20 63 6c 6f 73 65  f].        close
3180: 20 24 73 6f 63 6b 0a 20 20 20 20 7d 0a 20 20 20   $sock.    }.   
3190: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65   close $f.    se
31a0: 74 20 78 0a 7d 20 5b 6c 69 73 74 20 72 65 61 64  t x.} [list read
31b0: 79 20 22 68 65 6c 6c 6f 20 24 70 6f 72 74 22 5d  y "hello $port"]
31c0: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 32 2e 33  ..test tlsIO-2.3
31d0: 20 7b 74 63 70 20 63 6f 6e 6e 65 63 74 69 6f 6e   {tcp connection
31e0: 20 77 69 74 68 20 63 6c 69 65 6e 74 20 69 6e 74   with client int
31f0: 65 72 66 61 63 65 20 73 70 65 63 69 66 69 65 64  erface specified
3200: 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d  } {socket stdio}
3210: 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c   {.    removeFil
3220: 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 74  e script.    set
3230: 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20   f [open script 
3240: 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 5b  w].    puts $f [
3250: 6c 69 73 74 20 73 65 74 20 61 75 74 6f 5f 70 61  list set auto_pa
3260: 74 68 20 24 61 75 74 6f 5f 70 61 74 68 5d 0a 20  th $auto_path]. 
3270: 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 61     puts $f {..pa
3280: 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c  ckage require tl
3290: 73 0a 09 73 65 74 20 74 69 6d 65 72 20 5b 61 66  s..set timer [af
32a0: 74 65 72 20 32 30 30 30 20 22 73 65 74 20 78 20  ter 2000 "set x 
32b0: 64 6f 6e 65 22 5d 0a 20 20 20 20 7d 0a 20 20 20  done"].    }.   
32c0: 20 70 75 74 73 20 24 66 20 22 73 65 74 20 66 20   puts $f "set f 
32d0: 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73  \[tls::socket -s
32e0: 65 72 76 65 72 20 61 63 63 65 70 74 20 2d 63 65  erver accept -ce
32f0: 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65  rtfile $serverCe
3300: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65  rt -cafile $caCe
3310: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72  rt -keyfile $ser
3320: 76 65 72 4b 65 79 20 38 38 33 30 20 5c 5d 22 0a  verKey 8830 \]".
3330: 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70      puts $f {..p
3340: 72 6f 63 20 61 63 63 65 70 74 20 7b 73 6f 63 6b  roc accept {sock
3350: 20 61 64 64 72 20 70 6f 72 74 7d 20 7b 0a 20 20   addr port} {.  
3360: 20 20 20 20 20 20 20 20 20 20 67 6c 6f 62 61 6c            global
3370: 20 78 0a 20 20 20 20 20 20 20 20 20 20 20 20 70   x.            p
3380: 75 74 73 20 22 5b 67 65 74 73 20 24 73 6f 63 6b  uts "[gets $sock
3390: 5d 20 24 61 64 64 72 22 0a 20 20 20 20 20 20 20  ] $addr".       
33a0: 20 20 20 20 20 63 6c 6f 73 65 20 24 73 6f 63 6b       close $sock
33b0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 73 65 74  .            set
33c0: 20 78 20 64 6f 6e 65 0a 09 7d 0a 09 70 75 74 73   x done..}..puts
33d0: 20 72 65 61 64 79 0a 09 76 77 61 69 74 20 78 0a   ready..vwait x.
33e0: 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74  .after cancel $t
33f0: 69 6d 65 72 0a 09 63 6c 6f 73 65 20 24 66 0a 20  imer..close $f. 
3400: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24     }.    close $
3410: 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65  f.    set f [ope
3420: 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c  n "|[list $::tcl
3430: 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63  test::tcltest sc
3440: 72 69 70 74 5d 20 32 3e 20 2f 64 65 76 2f 6e 75  ript] 2> /dev/nu
3450: 6c 6c 22 20 72 5d 0a 20 20 20 20 67 65 74 73 20  ll" r].    gets 
3460: 24 66 20 78 0a 20 20 20 20 69 66 20 7b 5b 63 61  $f x.    if {[ca
3470: 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74  tch {tls::socket
3480: 20 2d 6d 79 61 64 64 72 20 31 32 37 2e 30 2e 30   -myaddr 127.0.0
3490: 2e 31 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20  .1 \..-certfile 
34a0: 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66  $clientCert -caf
34b0: 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 2d  ile $caCert \..-
34c0: 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b  keyfile $clientK
34d0: 65 79 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 33  ey 127.0.0.1 883
34e0: 30 7d 20 73 6f 63 6b 5d 7d 20 7b 0a 20 20 20 20  0} sock]} {.    
34f0: 20 20 20 20 73 65 74 20 78 20 24 73 6f 63 6b 0a      set x $sock.
3500: 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20      } else {.   
3510: 20 20 20 20 20 70 75 74 73 20 24 73 6f 63 6b 20       puts $sock 
3520: 68 65 6c 6c 6f 0a 09 63 61 74 63 68 20 7b 66 6c  hello..catch {fl
3530: 75 73 68 20 24 73 6f 63 6b 7d 0a 20 20 20 20 20  ush $sock}.     
3540: 20 20 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 65     lappend x [ge
3550: 74 73 20 24 66 5d 0a 20 20 20 20 20 20 20 20 63  ts $f].        c
3560: 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 20 20 20 7d  lose $sock.    }
3570: 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20  .    close $f.  
3580: 20 20 73 65 74 20 78 0a 7d 20 7b 72 65 61 64 79    set x.} {ready
3590: 20 7b 68 65 6c 6c 6f 20 31 32 37 2e 30 2e 30 2e   {hello 127.0.0.
35a0: 31 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d  1}}..test tlsIO-
35b0: 32 2e 34 20 7b 74 63 70 20 63 6f 6e 6e 65 63 74  2.4 {tcp connect
35c0: 69 6f 6e 20 77 69 74 68 20 73 65 72 76 65 72 20  ion with server 
35d0: 69 6e 74 65 72 66 61 63 65 20 73 70 65 63 69 66  interface specif
35e0: 69 65 64 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64  ied} {socket std
35f0: 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65  io} {.    remove
3600: 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20  File script.    
3610: 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69  set f [open scri
3620: 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24  pt w].    puts $
3630: 66 20 5b 6c 69 73 74 20 73 65 74 20 61 75 74 6f  f [list set auto
3640: 5f 70 61 74 68 20 24 61 75 74 6f 5f 70 61 74 68  _path $auto_path
3650: 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a  ].    puts $f {.
3660: 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65  .package require
3670: 20 74 6c 73 0a 09 73 65 74 20 74 69 6d 65 72 20   tls..set timer 
3680: 5b 61 66 74 65 72 20 32 30 30 30 20 22 73 65 74  [after 2000 "set
3690: 20 78 20 64 6f 6e 65 22 5d 0a 20 20 20 20 7d 0a   x done"].    }.
36a0: 20 20 20 20 70 75 74 73 20 24 66 20 22 73 65 74      puts $f "set
36b0: 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74   f \[tls::socket
36c0: 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20   -server accept 
36d0: 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65  -certfile $serve
36e0: 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63  rCert -cafile $c
36f0: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24  aCert -keyfile $
3700: 73 65 72 76 65 72 4b 65 79 20 2d 6d 79 61 64 64  serverKey -myadd
3710: 72 20 6c 6f 63 61 6c 68 6f 73 74 20 38 38 33 31  r localhost 8831
3720: 20 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 24 66   \]".    puts $f
3730: 20 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20   {..proc accept 
3740: 7b 73 6f 63 6b 20 61 64 64 72 20 70 6f 72 74 7d  {sock addr port}
3750: 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 67   {.            g
3760: 6c 6f 62 61 6c 20 78 0a 20 20 20 20 20 20 20 20  lobal x.        
3770: 20 20 20 20 70 75 74 73 20 22 5b 67 65 74 73 20      puts "[gets 
3780: 24 73 6f 63 6b 5d 22 0a 20 20 20 20 20 20 20 20  $sock]".        
3790: 20 20 20 20 63 6c 6f 73 65 20 24 73 6f 63 6b 0a      close $sock.
37a0: 20 20 20 20 20 20 20 20 20 20 20 20 73 65 74 20              set 
37b0: 78 20 64 6f 6e 65 0a 09 7d 0a 09 70 75 74 73 20  x done..}..puts 
37c0: 72 65 61 64 79 0a 09 76 77 61 69 74 20 78 0a 09  ready..vwait x..
37d0: 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69  after cancel $ti
37e0: 6d 65 72 0a 09 63 6c 6f 73 65 20 24 66 0a 20 20  mer..close $f.  
37f0: 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66    }.    close $f
3800: 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e  .    set f [open
3810: 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74   "|[list $::tclt
3820: 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72  est::tcltest scr
3830: 69 70 74 5d 20 32 3e 20 2f 64 65 76 2f 6e 75 6c  ipt] 2> /dev/nul
3840: 6c 22 20 72 5d 0a 20 20 20 20 67 65 74 73 20 24  l" r].    gets $
3850: 66 20 78 0a 20 20 20 20 69 66 20 7b 5b 63 61 74  f x.    if {[cat
3860: 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20  ch {tls::socket 
3870: 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e  -certfile $clien
3880: 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63  tCert -cafile $c
3890: 61 43 65 72 74 20 5c 0a 09 2d 6b 65 79 66 69 6c  aCert \..-keyfil
38a0: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 6c 6f 63  e $clientKey loc
38b0: 61 6c 68 6f 73 74 20 38 38 33 31 7d 20 73 6f 63  alhost 8831} soc
38c0: 6b 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 73 65  k]} {.        se
38d0: 74 20 78 20 24 73 6f 63 6b 0a 20 20 20 20 7d 20  t x $sock.    } 
38e0: 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 20 70  else {.        p
38f0: 75 74 73 20 24 73 6f 63 6b 20 68 65 6c 6c 6f 0a  uts $sock hello.
3900: 09 66 6c 75 73 68 20 24 73 6f 63 6b 0a 20 20 20  .flush $sock.   
3910: 20 20 20 20 20 6c 61 70 70 65 6e 64 20 78 20 5b       lappend x [
3920: 67 65 74 73 20 24 66 5d 0a 20 20 20 20 20 20 20  gets $f].       
3930: 20 63 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 20 20   close $sock.   
3940: 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a   }.    close $f.
3950: 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 72 65 61      set x.} {rea
3960: 64 79 20 68 65 6c 6c 6f 7d 0a 0a 74 65 73 74 20  dy hello}..test 
3970: 74 6c 73 49 4f 2d 32 2e 35 20 7b 74 63 70 20 63  tlsIO-2.5 {tcp c
3980: 6f 6e 6e 65 63 74 69 6f 6e 20 77 69 74 68 20 72  onnection with r
3990: 65 64 75 6e 64 61 6e 74 20 73 65 72 76 65 72 20  edundant server 
39a0: 70 6f 72 74 7d 20 7b 73 6f 63 6b 65 74 20 73 74  port} {socket st
39b0: 64 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76  dio} {.    remov
39c0: 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20  eFile script.   
39d0: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72   set f [open scr
39e0: 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20  ipt w].    puts 
39f0: 24 66 20 5b 6c 69 73 74 20 73 65 74 20 61 75 74  $f [list set aut
3a00: 6f 5f 70 61 74 68 20 24 61 75 74 6f 5f 70 61 74  o_path $auto_pat
3a10: 68 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b  h].    puts $f {
3a20: 0a 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72  ..package requir
3a30: 65 20 74 6c 73 0a 09 73 65 74 20 74 69 6d 65 72  e tls..set timer
3a40: 20 5b 61 66 74 65 72 20 32 30 30 30 20 22 73 65   [after 2000 "se
3a50: 74 20 78 20 64 6f 6e 65 22 5d 0a 20 20 20 20 7d  t x done"].    }
3a60: 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 73 65  .    puts $f "se
3a70: 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65  t f \[tls::socke
3a80: 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74  t -server accept
3a90: 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76   -certfile $serv
3aa0: 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24  erCert -cafile $
3ab0: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20  caCert -keyfile 
3ac0: 24 73 65 72 76 65 72 4b 65 79 20 38 38 33 32 20  $serverKey 8832 
3ad0: 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 24 66 20  \]".    puts $f 
3ae0: 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b  {..proc accept {
3af0: 73 6f 63 6b 20 61 64 64 72 20 70 6f 72 74 7d 20  sock addr port} 
3b00: 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 67 6c  {.            gl
3b10: 6f 62 61 6c 20 78 0a 20 20 20 20 20 20 20 20 20  obal x.         
3b20: 20 20 20 70 75 74 73 20 22 5b 67 65 74 73 20 24     puts "[gets $
3b30: 73 6f 63 6b 5d 22 0a 20 20 20 20 20 20 20 20 20  sock]".         
3b40: 20 20 20 63 6c 6f 73 65 20 24 73 6f 63 6b 0a 20     close $sock. 
3b50: 20 20 20 20 20 20 20 20 20 20 20 73 65 74 20 78             set x
3b60: 20 64 6f 6e 65 0a 09 7d 0a 09 70 75 74 73 20 72   done..}..puts r
3b70: 65 61 64 79 0a 09 76 77 61 69 74 20 78 0a 09 61  eady..vwait x..a
3b80: 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d  fter cancel $tim
3b90: 65 72 0a 09 63 6c 6f 73 65 20 24 66 0a 20 20 20  er..close $f.   
3ba0: 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a   }.    close $f.
3bb0: 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20      set f [open 
3bc0: 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65  "|[list $::tclte
3bd0: 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69  st::tcltest scri
3be0: 70 74 5d 20 32 3e 20 2f 64 65 76 2f 6e 75 6c 6c  pt] 2> /dev/null
3bf0: 22 20 72 5d 0a 20 20 20 20 67 65 74 73 20 24 66  " r].    gets $f
3c00: 20 78 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 63   x.    if {[catc
3c10: 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d  h {tls::socket -
3c20: 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74  certfile $client
3c30: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61  Cert -cafile $ca
3c40: 43 65 72 74 20 5c 0a 09 2d 6b 65 79 66 69 6c 65  Cert \..-keyfile
3c50: 20 24 63 6c 69 65 6e 74 4b 65 79 20 31 32 37 2e   $clientKey 127.
3c60: 30 2e 30 2e 31 20 38 38 33 32 7d 20 73 6f 63 6b  0.0.1 8832} sock
3c70: 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 73 65 74  ]} {.        set
3c80: 20 78 20 24 73 6f 63 6b 0a 20 20 20 20 7d 20 65   x $sock.    } e
3c90: 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 20 70 75  lse {.        pu
3ca0: 74 73 20 24 73 6f 63 6b 20 68 65 6c 6c 6f 0a 09  ts $sock hello..
3cb0: 66 6c 75 73 68 20 24 73 6f 63 6b 0a 20 20 20 20  flush $sock.    
3cc0: 20 20 20 20 6c 61 70 70 65 6e 64 20 78 20 5b 67      lappend x [g
3cd0: 65 74 73 20 24 66 5d 0a 20 20 20 20 20 20 20 20  ets $f].        
3ce0: 63 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 20 20 20  close $sock.    
3cf0: 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20  }.    close $f. 
3d00: 20 20 20 73 65 74 20 78 0a 7d 20 7b 72 65 61 64     set x.} {read
3d10: 79 20 68 65 6c 6c 6f 7d 0a 74 65 73 74 20 74 6c  y hello}.test tl
3d20: 73 49 4f 2d 32 2e 36 20 7b 74 63 70 20 63 6f 6e  sIO-2.6 {tcp con
3d30: 6e 65 63 74 69 6f 6e 7d 20 7b 73 6f 63 6b 65 74  nection} {socket
3d40: 7d 20 7b 0a 20 20 20 20 73 65 74 20 73 74 61 74  } {.    set stat
3d50: 75 73 20 6f 6b 0a 20 20 20 20 69 66 20 7b 21 5b  us ok.    if {![
3d60: 63 61 74 63 68 20 7b 73 65 74 20 73 6f 63 6b 20  catch {set sock 
3d70: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 31 32 37  [tls::socket 127
3d80: 2e 30 2e 30 2e 31 20 38 38 33 33 5d 7d 5d 7d 20  .0.0.1 8833]}]} 
3d90: 7b 0a 09 69 66 20 7b 21 5b 63 61 74 63 68 20 7b  {..if {![catch {
3da0: 67 65 74 73 20 24 73 6f 63 6b 7d 5d 7d 20 7b 0a  gets $sock}]} {.
3db0: 09 20 20 20 20 73 65 74 20 73 74 61 74 75 73 20  .    set status 
3dc0: 62 72 6f 6b 65 6e 0a 09 7d 0a 09 63 6c 6f 73 65  broken..}..close
3dd0: 20 24 73 6f 63 6b 0a 20 20 20 20 7d 0a 20 20 20   $sock.    }.   
3de0: 20 73 65 74 20 73 74 61 74 75 73 0a 7d 20 6f 6b   set status.} ok
3df0: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 32 2e 37  ..test tlsIO-2.7
3e00: 20 7b 65 63 68 6f 20 73 65 72 76 65 72 2c 20 6f   {echo server, o
3e10: 6e 65 20 6c 69 6e 65 7d 20 7b 73 6f 63 6b 65 74  ne line} {socket
3e20: 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 72 65   stdio} {.    re
3e30: 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a  moveFile script.
3e40: 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20      set f [open 
3e50: 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75  script w].    pu
3e60: 74 73 20 24 66 20 5b 6c 69 73 74 20 73 65 74 20  ts $f [list set 
3e70: 61 75 74 6f 5f 70 61 74 68 20 24 61 75 74 6f 5f  auto_path $auto_
3e80: 70 61 74 68 5d 0a 20 20 20 20 70 75 74 73 20 24  path].    puts $
3e90: 66 20 7b 0a 09 70 61 63 6b 61 67 65 20 72 65 71  f {..package req
3ea0: 75 69 72 65 20 74 6c 73 0a 09 73 65 74 20 74 69  uire tls..set ti
3eb0: 6d 65 72 20 5b 61 66 74 65 72 20 32 30 30 30 20  mer [after 2000 
3ec0: 22 73 65 74 20 78 20 64 6f 6e 65 22 5d 0a 20 20  "set x done"].  
3ed0: 20 20 7d 0a 20 20 20 20 70 75 74 73 20 24 66 20    }.    puts $f 
3ee0: 22 73 65 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f  "set f \[tls::so
3ef0: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63  cket -server acc
3f00: 65 70 74 20 2d 63 65 72 74 66 69 6c 65 20 24 73  ept -certfile $s
3f10: 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c  erverCert -cafil
3f20: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69  e $caCert -keyfi
3f30: 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 38  le $serverKey 88
3f40: 33 34 20 5c 5d 22 0a 20 20 20 20 70 75 74 73 20  34 \]".    puts 
3f50: 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 65 70  $f {..proc accep
3f60: 74 20 7b 73 20 61 20 70 7d 20 7b 0a 20 20 20 20  t {s a p} {.    
3f70: 20 20 20 20 20 20 20 20 66 69 6c 65 65 76 65 6e          fileeven
3f80: 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c  t $s readable [l
3f90: 69 73 74 20 65 63 68 6f 20 24 73 5d 0a 09 20 20  ist echo $s]..  
3fa0: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20    fconfigure $s 
3fb0: 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 6c 66 20  -translation lf 
3fc0: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a  -buffering line.
3fd0: 20 20 20 20 20 20 20 20 7d 0a 09 70 72 6f 63 20          }..proc 
3fe0: 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 20 20 20 20  echo {s} {..    
3ff0: 20 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 5d   set l [gets $s]
4000: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 69 66  .             if
4010: 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 20 20   {[eof $s]} {.  
4020: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 67                 g
4030: 6c 6f 62 61 6c 20 78 0a 20 20 20 20 20 20 20 20  lobal x.        
4040: 20 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24           close $
4050: 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20  s.              
4060: 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 20 20     set x done.  
4070: 20 20 20 20 20 20 20 20 20 20 20 7d 20 65 6c 73             } els
4080: 65 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20  e {.            
4090: 20 20 20 20 20 70 75 74 73 20 24 73 20 24 6c 0a       puts $s $l.
40a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 7d 0a 09               }..
40b0: 7d 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 76  }..puts ready..v
40c0: 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 61  wait x..after ca
40d0: 6e 63 65 6c 20 24 74 69 6d 65 72 0a 09 63 6c 6f  ncel $timer..clo
40e0: 73 65 20 24 66 0a 09 70 75 74 73 20 64 6f 6e 65  se $f..puts done
40f0: 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65  .    }.    close
4100: 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f   $f.    set f [o
4110: 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74  pen "|[list $::t
4120: 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20  cltest::tcltest 
4130: 73 63 72 69 70 74 5d 20 32 3e 20 2f 64 65 76 2f  script] 2> /dev/
4140: 6e 75 6c 6c 22 20 72 5d 0a 20 20 20 20 67 65 74  null" r].    get
4150: 73 20 24 66 0a 20 20 20 20 73 65 74 20 73 20 5b  s $f.    set s [
4160: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 72  tls::socket -cer
4170: 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72  tfile $clientCer
4180: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72  t -cafile $caCer
4190: 74 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 63  t \..-keyfile $c
41a0: 6c 69 65 6e 74 4b 65 79 20 31 32 37 2e 30 2e 30  lientKey 127.0.0
41b0: 2e 31 20 38 38 33 34 5d 0a 20 20 20 20 66 63 6f  .1 8834].    fco
41c0: 6e 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 66  nfigure $s -buff
41d0: 65 72 69 6e 67 20 6c 69 6e 65 20 2d 74 72 61 6e  ering line -tran
41e0: 73 6c 61 74 69 6f 6e 20 6c 66 0a 20 20 20 20 70  slation lf.    p
41f0: 75 74 73 20 24 73 20 22 68 65 6c 6c 6f 20 61 62  uts $s "hello ab
4200: 63 64 65 66 67 68 69 6a 6b 6c 6d 6e 6f 70 22 0a  cdefghijklmnop".
4210: 20 20 20 20 61 66 74 65 72 20 31 30 30 30 0a 20      after 1000. 
4220: 20 20 20 73 65 74 20 78 20 5b 67 65 74 73 20 24     set x [gets $
4230: 73 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a  s].    close $s.
4240: 20 20 20 20 73 65 74 20 79 20 5b 67 65 74 73 20      set y [gets 
4250: 24 66 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66  $f].    close $f
4260: 0a 20 20 20 20 6c 69 73 74 20 24 78 20 24 79 0a  .    list $x $y.
4270: 7d 20 7b 7b 68 65 6c 6c 6f 20 61 62 63 64 65 66  } {{hello abcdef
4280: 67 68 69 6a 6b 6c 6d 6e 6f 70 7d 20 64 6f 6e 65  ghijklmnop} done
4290: 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 32 2e  }..test tlsIO-2.
42a0: 38 20 7b 65 63 68 6f 20 73 65 72 76 65 72 2c 20  8 {echo server, 
42b0: 6c 6f 6f 70 20 35 30 20 74 69 6d 65 73 2c 20 73  loop 50 times, s
42c0: 69 6e 67 6c 65 20 63 6f 6e 6e 65 63 74 69 6f 6e  ingle connection
42d0: 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d  } {socket stdio}
42e0: 20 7b 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70   {.    set f [op
42f0: 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20  en script w].   
4300: 20 70 75 74 73 20 24 66 20 5b 6c 69 73 74 20 73   puts $f [list s
4310: 65 74 20 61 75 74 6f 5f 70 61 74 68 20 24 61 75  et auto_path $au
4320: 74 6f 5f 70 61 74 68 5d 0a 20 20 20 20 70 75 74  to_path].    put
4330: 73 20 24 66 20 7b 0a 20 20 20 20 09 70 61 63 6b  s $f {.    .pack
4340: 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a  age require tls.
4350: 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 20 24      }.    puts $
4360: 66 20 22 73 65 74 20 66 20 5c 5b 74 6c 73 3a 3a  f "set f \[tls::
4370: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61  socket -server a
4380: 63 63 65 70 74 20 2d 63 65 72 74 66 69 6c 65 20  ccept -certfile 
4390: 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66  $serverCert -caf
43a0: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79  ile $caCert -key
43b0: 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20  file $serverKey 
43c0: 38 38 33 35 20 5c 5d 22 0a 20 20 20 20 70 75 74  8835 \]".    put
43d0: 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 63  s $f {..proc acc
43e0: 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 20 20  ept {s a p} {.  
43f0: 20 20 20 20 20 20 20 20 20 20 66 69 6c 65 65 76            fileev
4400: 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20  ent $s readable 
4410: 5b 6c 69 73 74 20 65 63 68 6f 20 24 73 5d 0a 20  [list echo $s]. 
4420: 20 20 20 20 20 20 20 20 20 20 20 66 63 6f 6e 66             fconf
4430: 69 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 72  igure $s -buffer
4440: 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 20 20 20  ing line.       
4450: 20 7d 0a 09 70 72 6f 63 20 65 63 68 6f 20 7b 73   }..proc echo {s
4460: 7d 20 7b 0a 09 20 20 20 20 20 67 6c 6f 62 61 6c  } {..     global
4470: 20 69 0a 20 20 20 20 20 20 20 20 20 20 20 20 20   i.             
4480: 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a  set l [gets $s].
4490: 20 20 20 20 20 20 20 20 20 20 20 20 20 69 66 20               if 
44a0: 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 20 20 20  {[eof $s]} {.   
44b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 67 6c                gl
44c0: 6f 62 61 6c 20 78 0a 20 20 20 20 20 20 20 20 20  obal x.         
44d0: 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 73          close $s
44e0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20  .               
44f0: 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 20 20 20    set x done.   
4500: 20 20 20 20 20 20 20 20 20 20 7d 20 65 6c 73 65            } else
4510: 20 7b 20 0a 09 20 20 20 20 20 20 20 20 20 69 6e   { ..         in
4520: 63 72 20 69 0a 20 20 20 20 20 20 20 20 20 20 20  cr i.           
4530: 20 20 20 20 20 20 70 75 74 73 20 24 73 20 24 6c        puts $s $l
4540: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 7d 0a  .             }.
4550: 09 7d 0a 09 73 65 74 20 69 20 30 0a 09 70 75 74  .}..set i 0..put
4560: 73 20 72 65 61 64 79 0a 09 73 65 74 20 74 69 6d  s ready..set tim
4570: 65 72 20 5b 61 66 74 65 72 20 32 30 30 30 30 20  er [after 20000 
4580: 22 73 65 74 20 78 20 64 6f 6e 65 22 5d 0a 09 76  "set x done"]..v
4590: 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 61  wait x..after ca
45a0: 6e 63 65 6c 20 24 74 69 6d 65 72 0a 09 63 6c 6f  ncel $timer..clo
45b0: 73 65 20 24 66 0a 09 70 75 74 73 20 22 64 6f 6e  se $f..puts "don
45c0: 65 20 24 69 22 0a 20 20 20 20 7d 0a 20 20 20 20  e $i".    }.    
45d0: 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74  close $f.    set
45e0: 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74   f [open "|[list
45f0: 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c   $::tcltest::tcl
4600: 74 65 73 74 20 73 63 72 69 70 74 5d 20 32 3e 20  test script] 2> 
4610: 2f 64 65 76 2f 6e 75 6c 6c 22 20 72 5d 0a 20 20  /dev/null" r].  
4620: 20 20 67 65 74 73 20 24 66 0a 20 20 20 20 73 65    gets $f.    se
4630: 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74  t s [tls::socket
4640: 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65   -certfile $clie
4650: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24  ntCert -cafile $
4660: 63 61 43 65 72 74 20 5c 0a 09 2d 6b 65 79 66 69  caCert \..-keyfi
4670: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 31 32  le $clientKey 12
4680: 37 2e 30 2e 30 2e 31 20 38 38 33 35 5d 0a 20 20  7.0.0.1 8835].  
4690: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20    fconfigure $s 
46a0: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a  -buffering line.
46b0: 20 20 20 20 63 61 74 63 68 20 7b 0a 09 66 6f 72      catch {..for
46c0: 20 7b 73 65 74 20 78 20 30 7d 20 7b 24 78 20 3c   {set x 0} {$x <
46d0: 20 35 30 7d 20 7b 69 6e 63 72 20 78 7d 20 7b 0a   50} {incr x} {.
46e0: 09 20 20 20 20 70 75 74 73 20 24 73 20 22 68 65  .    puts $s "he
46f0: 6c 6c 6f 20 61 62 63 64 65 66 67 68 69 6a 6b 6c  llo abcdefghijkl
4700: 6d 6e 6f 70 22 0a 09 20 20 20 20 67 65 74 73 20  mnop"..    gets 
4710: 24 73 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20  $s..}.    }.    
4720: 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 63 61 74  close $s.    cat
4730: 63 68 20 7b 73 65 74 20 78 20 5b 67 65 74 73 20  ch {set x [gets 
4740: 24 66 5d 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24  $f]}.    close $
4750: 66 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 64  f.    set x.} {d
4760: 6f 6e 65 20 35 30 7d 0a 0a 74 65 73 74 20 74 6c  one 50}..test tl
4770: 73 49 4f 2d 32 2e 39 20 7b 73 6f 63 6b 65 74 20  sIO-2.9 {socket 
4780: 63 6f 6e 66 6c 69 63 74 7d 20 7b 73 6f 63 6b 65  conflict} {socke
4790: 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 73  t stdio} {.    s
47a0: 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65  et s [tls::socke
47b0: 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74  t -server accept
47c0: 20 38 38 32 38 5d 0a 20 20 20 20 72 65 6d 6f 76   8828].    remov
47d0: 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20  eFile script.   
47e0: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72   set f [open scr
47f0: 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20  ipt w].    puts 
4800: 24 66 20 5b 6c 69 73 74 20 73 65 74 20 61 75 74  $f [list set aut
4810: 6f 5f 70 61 74 68 20 24 61 75 74 6f 5f 70 61 74  o_path $auto_pat
4820: 68 5d 0a 20 20 20 20 70 75 74 73 20 2d 6e 6f 6e  h].    puts -non
4830: 65 77 6c 69 6e 65 20 24 66 20 7b 0a 09 70 61 63  ewline $f {..pac
4840: 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73  kage require tls
4850: 0a 09 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73  ..tls::socket -s
4860: 65 72 76 65 72 20 61 63 63 65 70 74 20 38 38 32  erver accept 882
4870: 38 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73  8.    }.    clos
4880: 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b  e $f.    set f [
4890: 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a  open "|[list $::
48a0: 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74  tcltest::tcltest
48b0: 20 73 63 72 69 70 74 5d 22 20 72 5d 0a 20 20 20   script]" r].   
48c0: 20 67 65 74 73 20 24 66 0a 20 20 20 20 61 66 74   gets $f.    aft
48d0: 65 72 20 31 30 30 0a 20 20 20 20 73 65 74 20 78  er 100.    set x
48e0: 20 5b 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 63   [list [catch {c
48f0: 6c 6f 73 65 20 24 66 7d 20 6d 73 67 5d 20 5b 73  lose $f} msg] [s
4900: 74 72 69 6e 67 20 72 61 6e 67 65 20 24 6d 73 67  tring range $msg
4910: 20 30 20 34 33 5d 5d 0a 20 20 20 20 63 6c 6f 73   0 43]].    clos
4920: 65 20 24 73 0a 20 20 20 20 73 65 74 20 78 0a 7d  e $s.    set x.}
4930: 20 7b 31 20 7b 63 6f 75 6c 64 6e 27 74 20 6f 70   {1 {couldn't op
4940: 65 6e 20 73 6f 63 6b 65 74 3a 20 61 64 64 72 65  en socket: addre
4950: 73 73 20 61 6c 72 65 61 64 79 20 69 6e 20 75 73  ss already in us
4960: 65 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d  e}}..test tlsIO-
4970: 32 2e 31 30 20 7b 63 6c 6f 73 65 20 6f 6e 20 61  2.10 {close on a
4980: 63 63 65 70 74 2c 20 61 63 63 65 70 74 65 64 20  ccept, accepted 
4990: 73 6f 63 6b 65 74 20 6c 69 76 65 73 7d 20 7b 73  socket lives} {s
49a0: 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 73 65 74  ocket} {.    set
49b0: 20 64 6f 6e 65 20 30 0a 20 20 20 20 73 65 74 20   done 0.    set 
49c0: 74 69 6d 65 72 20 5b 61 66 74 65 72 20 32 30 30  timer [after 200
49d0: 30 30 20 22 73 65 74 20 64 6f 6e 65 20 74 69 6d  00 "set done tim
49e0: 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 73 65 74  ed_out"].    set
49f0: 20 73 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74   ss [tls::socket
4a00: 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20   -server accept 
4a10: 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65  -certfile $serve
4a20: 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63  rCert -cafile $c
4a30: 61 43 65 72 74 20 5c 0a 09 2d 6b 65 79 66 69 6c  aCert \..-keyfil
4a40: 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 38 33  e $serverKey 883
4a50: 30 5d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65  0].    proc acce
4a60: 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 67 6c  pt {s a p} {..gl
4a70: 6f 62 61 6c 20 73 73 0a 09 63 6c 6f 73 65 20 24  obal ss..close $
4a80: 73 73 0a 09 66 69 6c 65 65 76 65 6e 74 20 24 73  ss..fileevent $s
4a90: 20 72 65 61 64 61 62 6c 65 20 22 72 65 61 64 69   readable "readi
4aa0: 74 20 24 73 22 0a 09 66 63 6f 6e 66 69 67 75 72  t $s"..fconfigur
4ab0: 65 20 24 73 20 2d 74 72 61 6e 73 20 6c 66 0a 20  e $s -trans lf. 
4ac0: 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 72 65     }.    proc re
4ad0: 61 64 69 74 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62  adit {s} {..glob
4ae0: 61 6c 20 64 6f 6e 65 0a 09 67 65 74 73 20 24 73  al done..gets $s
4af0: 0a 09 63 6c 6f 73 65 20 24 73 0a 09 73 65 74 20  ..close $s..set 
4b00: 64 6f 6e 65 20 31 0a 20 20 20 20 7d 0a 20 20 20  done 1.    }.   
4b10: 20 73 65 74 20 63 73 20 5b 74 6c 73 3a 3a 73 6f   set cs [tls::so
4b20: 63 6b 65 74 20 2d 63 65 72 74 66 69 6c 65 20 24  cket -certfile $
4b30: 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69  clientCert -cafi
4b40: 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 2d 6b  le $caCert \..-k
4b50: 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65  eyfile $clientKe
4b60: 79 20 6c 6f 63 61 6c 68 6f 73 74 20 38 38 33 30  y localhost 8830
4b70: 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 63 73 0a  ].    close $cs.
4b80: 0a 20 20 20 20 76 77 61 69 74 20 64 6f 6e 65 0a  .    vwait done.
4b90: 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c      after cancel
4ba0: 20 24 74 69 6d 65 72 0a 20 20 20 20 73 65 74 20   $timer.    set 
4bb0: 64 6f 6e 65 0a 7d 20 31 0a 0a 74 65 73 74 20 74  done.} 1..test t
4bc0: 6c 73 49 4f 2d 32 2e 31 31 20 7b 64 65 74 65 63  lsIO-2.11 {detec
4bd0: 74 69 6e 67 20 6e 65 77 20 64 61 74 61 7d 20 7b  ting new data} {
4be0: 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 70 72  socket} {.    pr
4bf0: 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70  oc accept {s a p
4c00: 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 73 6f 63 6b  } {..global sock
4c10: 0a 09 23 20 77 68 65 6e 20 64 6f 69 6e 67 20 61  ..# when doing a
4c20: 6e 20 69 6e 2d 70 72 6f 63 65 73 73 20 63 6c 69  n in-process cli
4c30: 65 6e 74 2f 73 65 72 76 65 72 20 74 65 73 74 2c  ent/server test,
4c40: 20 62 6f 74 68 20 73 69 64 65 73 20 6e 65 65 64   both sides need
4c50: 0a 09 23 20 74 6f 20 62 65 20 6e 6f 6e 2d 62 6c  ..# to be non-bl
4c60: 6f 63 6b 69 6e 67 20 66 6f 72 20 74 68 65 20 54  ocking for the T
4c70: 4c 53 20 68 61 6e 64 73 68 61 6b 65 2e 20 20 41  LS handshake.  A
4c80: 6c 73 6f 20 6d 61 6b 65 20 73 75 72 65 0a 09 23  lso make sure..#
4c90: 20 74 6f 20 72 65 74 75 72 6e 20 74 68 65 20 63   to return the c
4ca0: 68 61 6e 6e 65 6c 20 74 6f 20 6c 69 6e 65 20 62  hannel to line b
4cb0: 75 66 66 65 72 69 6e 67 20 6d 6f 64 65 2e 0a 09  uffering mode...
4cc0: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62  fconfigure $s -b
4cd0: 6c 6f 63 6b 69 6e 67 20 30 20 2d 62 75 66 66 65  locking 0 -buffe
4ce0: 72 69 6e 67 20 6c 69 6e 65 0a 09 73 65 74 20 73  ring line..set s
4cf0: 6f 63 6b 20 24 73 0a 09 66 69 6c 65 65 76 65 6e  ock $s..fileeven
4d00: 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c  t $s readable [l
4d10: 69 73 74 20 64 6f 5f 68 61 6e 64 73 68 61 6b 65  ist do_handshake
4d20: 20 24 73 5d 0a 20 20 20 20 7d 0a 0a 20 20 20 20   $s].    }..    
4d30: 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b  set s [tls::sock
4d40: 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70  et -server accep
4d50: 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69  t \..    -certfi
4d60: 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d  le $serverCert -
4d70: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d  cafile $caCert -
4d80: 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b  keyfile $serverK
4d90: 65 79 20 38 34 30 30 5d 0a 20 20 20 20 73 65 74  ey 8400].    set
4da0: 20 73 6f 63 6b 20 22 22 0a 20 20 20 20 73 65 74   sock "".    set
4db0: 20 73 32 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74   s2 [tls::socket
4dc0: 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65   -certfile $clie
4dd0: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24  ntCert -cafile $
4de0: 63 61 43 65 72 74 20 5c 0a 09 2d 6b 65 79 66 69  caCert \..-keyfi
4df0: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 31 32  le $clientKey 12
4e00: 37 2e 30 2e 30 2e 31 20 38 34 30 30 5d 0a 20 20  7.0.0.1 8400].  
4e10: 20 20 23 20 77 68 65 6e 20 64 6f 69 6e 67 20 61    # when doing a
4e20: 6e 20 69 6e 2d 70 72 6f 63 65 73 73 20 63 6c 69  n in-process cli
4e30: 65 6e 74 2f 73 65 72 76 65 72 20 74 65 73 74 2c  ent/server test,
4e40: 20 62 6f 74 68 20 73 69 64 65 73 20 6e 65 65 64   both sides need
4e50: 0a 20 20 20 20 23 20 74 6f 20 62 65 20 6e 6f 6e  .    # to be non
4e60: 2d 62 6c 6f 63 6b 69 6e 67 20 66 6f 72 20 74 68  -blocking for th
4e70: 65 20 54 4c 53 20 68 61 6e 64 73 68 61 6b 65 20  e TLS handshake 
4e80: 20 41 6c 73 6f 20 6d 61 6b 65 20 73 75 72 65 20   Also make sure 
4e90: 74 6f 0a 20 20 20 20 23 20 72 65 74 75 72 6e 20  to.    # return 
4ea0: 74 68 65 20 63 68 61 6e 6e 65 6c 20 74 6f 20 6c  the channel to l
4eb0: 69 6e 65 20 62 75 66 66 65 72 69 6e 67 20 6d 6f  ine buffering mo
4ec0: 64 65 20 28 54 4c 53 20 73 65 74 73 20 69 74 20  de (TLS sets it 
4ed0: 74 6f 20 27 6e 6f 6e 65 27 29 2e 0a 20 20 20 20  to 'none')..    
4ee0: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 32 20 2d  fconfigure $s2 -
4ef0: 62 6c 6f 63 6b 69 6e 67 20 30 20 2d 62 75 66 66  blocking 0 -buff
4f00: 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 76  ering line.    v
4f10: 77 61 69 74 20 73 6f 63 6b 0a 20 20 20 20 70 75  wait sock.    pu
4f20: 74 73 20 24 73 32 20 6f 6e 65 0a 20 20 20 20 66  ts $s2 one.    f
4f30: 6c 75 73 68 20 24 73 32 0a 20 20 20 20 23 20 6e  lush $s2.    # n
4f40: 65 65 64 20 75 70 64 61 74 65 20 74 6f 20 63 6f  eed update to co
4f50: 6d 70 6c 65 74 65 20 54 4c 53 20 68 61 6e 64 73  mplete TLS hands
4f60: 68 61 6b 65 20 69 6e 2d 70 72 6f 63 65 73 73 0a  hake in-process.
4f70: 20 20 20 20 75 70 64 61 74 65 0a 20 20 20 20 61      update.    a
4f80: 66 74 65 72 20 35 30 30 0a 20 20 20 20 66 63 6f  fter 500.    fco
4f90: 6e 66 69 67 75 72 65 20 24 73 6f 63 6b 20 2d 62  nfigure $sock -b
4fa0: 6c 6f 63 6b 69 6e 67 20 30 0a 20 20 20 20 73 65  locking 0.    se
4fb0: 74 20 72 65 73 75 6c 74 20 61 3a 5b 67 65 74 73  t result a:[gets
4fc0: 20 24 73 6f 63 6b 5d 0a 20 20 20 20 6c 61 70 70   $sock].    lapp
4fd0: 65 6e 64 20 72 65 73 75 6c 74 20 62 3a 5b 67 65  end result b:[ge
4fe0: 74 73 20 24 73 6f 63 6b 5d 0a 20 20 20 20 66 63  ts $sock].    fc
4ff0: 6f 6e 66 69 67 75 72 65 20 24 73 6f 63 6b 20 2d  onfigure $sock -
5000: 62 6c 6f 63 6b 69 6e 67 20 31 0a 20 20 20 20 70  blocking 1.    p
5010: 75 74 73 20 24 73 32 20 74 77 6f 0a 20 20 20 20  uts $s2 two.    
5020: 66 6c 75 73 68 20 24 73 32 0a 20 20 20 20 66 63  flush $s2.    fc
5030: 6f 6e 66 69 67 75 72 65 20 24 73 6f 63 6b 20 2d  onfigure $sock -
5040: 62 6c 6f 63 6b 69 6e 67 20 31 0a 20 20 20 20 6c  blocking 1.    l
5050: 61 70 70 65 6e 64 20 72 65 73 75 6c 74 20 63 3a  append result c:
5060: 5b 67 65 74 73 20 24 73 6f 63 6b 5d 0a 20 20 20  [gets $sock].   
5070: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 6f 63   fconfigure $soc
5080: 6b 20 2d 62 6c 6f 63 6b 69 6e 67 20 31 0a 20 20  k -blocking 1.  
5090: 20 20 63 6c 6f 73 65 20 24 73 32 0a 20 20 20 20    close $s2.    
50a0: 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 63 6c 6f  close $s.    clo
50b0: 73 65 20 24 73 6f 63 6b 0a 20 20 20 20 73 65 74  se $sock.    set
50c0: 20 72 65 73 75 6c 74 0a 7d 20 7b 61 3a 6f 6e 65   result.} {a:one
50d0: 20 62 3a 20 63 3a 74 77 6f 7d 0a 0a 74 65 73 74   b: c:two}..test
50e0: 20 74 6c 73 49 4f 2d 32 2e 31 32 20 7b 74 63 70   tlsIO-2.12 {tcp
50f0: 20 63 6f 6e 6e 65 63 74 69 6f 6e 3b 20 6e 6f 20   connection; no 
5100: 63 65 72 74 69 66 69 63 61 74 65 73 20 73 70 65  certificates spe
5110: 63 69 66 69 65 64 7d 20 5c 0a 09 7b 73 6f 63 6b  cified} \..{sock
5120: 65 74 20 73 74 64 69 6f 20 75 6e 69 78 4f 6e 6c  et stdio unixOnl
5130: 79 7d 20 7b 0a 20 20 20 20 23 20 54 68 65 72 65  y} {.    # There
5140: 20 69 73 20 61 20 64 65 62 75 67 20 61 73 73 65   is a debug asse
5150: 72 74 69 6f 6e 20 6f 6e 20 57 69 6e 64 6f 77 73  rtion on Windows
5160: 2f 53 53 4c 20 74 68 61 74 20 63 61 75 73 65 73  /SSL that causes
5170: 20 61 20 63 72 61 73 68 20 77 68 65 6e 20 74 68   a crash when th
5180: 65 0a 20 20 20 20 23 20 63 65 72 74 69 66 69 63  e.    # certific
5190: 61 74 65 20 69 73 6e 27 74 20 73 70 65 63 69 66  ate isn't specif
51a0: 69 65 64 2e 0a 20 20 20 20 72 65 6d 6f 76 65 46  ied..    removeF
51b0: 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 73  ile script.    s
51c0: 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70  et f [open scrip
51d0: 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66  t w].    puts $f
51e0: 20 5b 6c 69 73 74 20 73 65 74 20 61 75 74 6f 5f   [list set auto_
51f0: 70 61 74 68 20 24 61 75 74 6f 5f 70 61 74 68 5d  path $auto_path]
5200: 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09  .    puts $f {..
5210: 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 20  package require 
5220: 74 6c 73 0a 09 73 65 74 20 74 69 6d 65 72 20 5b  tls..set timer [
5230: 61 66 74 65 72 20 32 30 30 30 20 22 73 65 74 20  after 2000 "set 
5240: 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 09 73  x timed_out"]..s
5250: 65 74 20 66 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65  et f [tls::socke
5260: 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74  t -server accept
5270: 20 38 38 32 38 5d 0a 09 70 72 6f 63 20 61 63 63   8828]..proc acc
5280: 65 70 74 20 7b 66 69 6c 65 20 61 64 64 72 20 70  ept {file addr p
5290: 6f 72 74 7d 20 7b 0a 09 20 20 20 20 67 6c 6f 62  ort} {..    glob
52a0: 61 6c 20 78 0a 09 20 20 20 20 73 65 74 20 78 20  al x..    set x 
52b0: 64 6f 6e 65 0a 20 20 20 20 20 20 20 20 20 20 20  done.           
52c0: 20 63 6c 6f 73 65 20 24 66 69 6c 65 0a 09 7d 0a   close $file..}.
52d0: 09 70 75 74 73 20 72 65 61 64 79 0a 09 76 77 61  .puts ready..vwa
52e0: 69 74 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63  it x..after canc
52f0: 65 6c 20 24 74 69 6d 65 72 0a 09 63 6c 6f 73 65  el $timer..close
5300: 20 24 66 0a 09 70 75 74 73 20 24 78 0a 20 20 20   $f..puts $x.   
5310: 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a   }.    close $f.
5320: 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20      set f [open 
5330: 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65  "|[list $::tclte
5340: 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69  st::tcltest scri
5350: 70 74 5d 20 32 3e 20 2f 64 65 76 2f 6e 75 6c 6c  pt] 2> /dev/null
5360: 22 20 72 5d 0a 20 20 20 20 67 65 74 73 20 24 66  " r].    gets $f
5370: 20 78 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 63   x.    if {[catc
5380: 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 31  h {tls::socket 1
5390: 32 37 2e 30 2e 30 2e 31 20 38 38 32 38 7d 20 6d  27.0.0.1 8828} m
53a0: 73 67 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 73  sg]} {.        s
53b0: 65 74 20 78 20 24 6d 73 67 0a 20 20 20 20 7d 20  et x $msg.    } 
53c0: 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 20 6c  else {.        l
53d0: 61 70 70 65 6e 64 20 78 20 5b 67 65 74 73 20 24  append x [gets $
53e0: 66 5d 0a 20 20 20 20 20 20 20 20 63 6c 6f 73 65  f].        close
53f0: 20 24 6d 73 67 0a 20 20 20 20 7d 0a 20 20 20 20   $msg.    }.    
5400: 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 74 73 20  lappend x [gets 
5410: 24 66 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66  $f].    close $f
5420: 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 72 65  .    set x.} {re
5430: 61 64 79 20 64 6f 6e 65 20 7b 7d 7d 0a 0a 74 65  ady done {}}..te
5440: 73 74 20 74 6c 73 49 4f 2d 33 2e 31 20 7b 73 6f  st tlsIO-3.1 {so
5450: 63 6b 65 74 20 63 6f 6e 66 6c 69 63 74 7d 20 7b  cket conflict} {
5460: 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a  socket stdio} {.
5470: 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73      removeFile s
5480: 63 72 69 70 74 0a 20 20 20 20 73 65 74 20 66 20  cript.    set f 
5490: 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a  [open script w].
54a0: 20 20 20 20 70 75 74 73 20 24 66 20 5b 6c 69 73      puts $f [lis
54b0: 74 20 73 65 74 20 61 75 74 6f 5f 70 61 74 68 20  t set auto_path 
54c0: 24 61 75 74 6f 5f 70 61 74 68 5d 0a 20 20 20 20  $auto_path].    
54d0: 70 75 74 73 20 24 66 20 7b 0a 09 70 61 63 6b 61  puts $f {..packa
54e0: 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 20  ge require tls. 
54f0: 20 20 20 7d 0a 20 20 20 20 70 75 74 73 20 24 66     }.    puts $f
5500: 20 22 73 65 74 20 66 20 5c 5b 74 6c 73 3a 3a 73   "set f \[tls::s
5510: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63  ocket -server ac
5520: 63 65 70 74 20 2d 63 65 72 74 66 69 6c 65 20 24  cept -certfile $
5530: 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69  serverCert -cafi
5540: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66  le $caCert -keyf
5550: 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 38  ile $serverKey 8
5560: 38 32 38 20 5c 5d 22 0a 20 20 20 20 70 75 74 73  828 \]".    puts
5570: 20 24 66 20 7b 0a 09 70 75 74 73 20 72 65 61 64   $f {..puts read
5580: 79 0a 09 67 65 74 73 20 73 74 64 69 6e 0a 09 63  y..gets stdin..c
5590: 6c 6f 73 65 20 24 66 0a 20 20 20 20 7d 0a 20 20  lose $f.    }.  
55a0: 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73    close $f.    s
55b0: 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69  et f [open "|[li
55c0: 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74  st $::tcltest::t
55d0: 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d 20 32  cltest script] 2
55e0: 3e 20 2f 64 65 76 2f 6e 75 6c 6c 22 20 72 2b 5d  > /dev/null" r+]
55f0: 0a 20 20 20 20 67 65 74 73 20 24 66 0a 20 20 20  .    gets $f.   
5600: 20 73 65 74 20 78 20 5b 6c 69 73 74 20 5b 63 61   set x [list [ca
5610: 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74  tch {tls::socket
5620: 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c   \..    -certfil
5630: 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63  e $clientCert -c
5640: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b  afile $caCert -k
5650: 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65  eyfile $clientKe
5660: 79 20 5c 0a 20 20 20 20 09 2d 73 65 72 76 65 72  y \.    .-server
5670: 20 61 63 63 65 70 74 20 38 38 32 38 7d 20 6d 73   accept 8828} ms
5680: 67 5d 20 5c 0a 09 09 24 6d 73 67 5d 0a 20 20 20  g] \...$msg].   
5690: 20 70 75 74 73 20 24 66 20 62 79 65 0a 20 20 20   puts $f bye.   
56a0: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65   close $f.    se
56b0: 74 20 78 0a 7d 20 7b 31 20 7b 63 6f 75 6c 64 6e  t x.} {1 {couldn
56c0: 27 74 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20  't open socket: 
56d0: 61 64 64 72 65 73 73 20 61 6c 72 65 61 64 79 20  address already 
56e0: 69 6e 20 75 73 65 7d 7d 0a 0a 74 65 73 74 20 74  in use}}..test t
56f0: 6c 73 49 4f 2d 33 2e 32 20 7b 73 65 72 76 65 72  lsIO-3.2 {server
5700: 20 77 69 74 68 20 73 65 76 65 72 61 6c 20 63 6c   with several cl
5710: 69 65 6e 74 73 7d 20 7b 73 6f 63 6b 65 74 20 73  ients} {socket s
5720: 74 64 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f  tdio} {.    remo
5730: 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20  veFile script.  
5740: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63    set f [open sc
5750: 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73  ript w].    puts
5760: 20 24 66 20 5b 6c 69 73 74 20 73 65 74 20 61 75   $f [list set au
5770: 74 6f 5f 70 61 74 68 20 24 61 75 74 6f 5f 70 61  to_path $auto_pa
5780: 74 68 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20  th].    puts $f 
5790: 7b 0a 09 70 61 63 6b 61 67 65 20 72 65 71 75 69  {..package requi
57a0: 72 65 20 74 6c 73 0a 09 73 65 74 20 74 31 20 5b  re tls..set t1 [
57b0: 61 66 74 65 72 20 33 30 30 30 30 20 22 73 65 74  after 30000 "set
57c0: 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 09   x timed_out"]..
57d0: 73 65 74 20 74 32 20 5b 61 66 74 65 72 20 33 31  set t2 [after 31
57e0: 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 64  000 "set x timed
57f0: 5f 6f 75 74 22 5d 0a 09 73 65 74 20 74 33 20 5b  _out"]..set t3 [
5800: 61 66 74 65 72 20 33 32 30 30 30 20 22 73 65 74  after 32000 "set
5810: 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 09   x timed_out"]..
5820: 73 65 74 20 63 6f 75 6e 74 65 72 20 30 0a 20 20  set counter 0.  
5830: 20 20 7d 0a 20 20 20 20 70 75 74 73 20 24 66 20    }.    puts $f 
5840: 22 73 65 74 20 73 20 5c 5b 74 6c 73 3a 3a 73 6f  "set s \[tls::so
5850: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63  cket -server acc
5860: 65 70 74 20 2d 63 65 72 74 66 69 6c 65 20 24 73  ept -certfile $s
5870: 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c  erverCert -cafil
5880: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69  e $caCert -keyfi
5890: 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 38  le $serverKey 88
58a0: 32 38 20 5c 5d 22 0a 20 20 20 20 70 75 74 73 20  28 \]".    puts 
58b0: 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 65 70  $f {..proc accep
58c0: 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 20  t {s a p} {..   
58d0: 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65   fileevent $s re
58e0: 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 65 63 68  adable [list ech
58f0: 6f 20 24 73 5d 0a 09 20 20 20 20 66 63 6f 6e 66  o $s]..    fconf
5900: 69 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 72  igure $s -buffer
5910: 69 6e 67 20 6c 69 6e 65 0a 09 7d 0a 09 70 72 6f  ing line..}..pro
5920: 63 20 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 20 20  c echo {s} {..  
5930: 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 20 20 20     global x.    
5940: 20 20 20 20 20 20 20 20 20 73 65 74 20 6c 20 5b           set l [
5950: 67 65 74 73 20 24 73 5d 0a 20 20 20 20 20 20 20  gets $s].       
5960: 20 20 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 24        if {[eof $
5970: 73 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 20  s]} {.          
5980: 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 73 0a         close $s.
5990: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
59a0: 20 73 65 74 20 78 20 64 6f 6e 65 0a 20 20 20 20   set x done.    
59b0: 20 20 20 20 20 20 20 20 20 7d 20 65 6c 73 65 20           } else 
59c0: 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20  {.              
59d0: 20 20 20 70 75 74 73 20 24 73 20 24 6c 0a 20 20     puts $s $l.  
59e0: 20 20 20 20 20 20 20 20 20 20 20 7d 0a 09 7d 0a             }..}.
59f0: 09 70 75 74 73 20 72 65 61 64 79 0a 09 76 77 61  .puts ready..vwa
5a00: 69 74 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63  it x..after canc
5a10: 65 6c 20 24 74 31 0a 09 76 77 61 69 74 20 78 0a  el $t1..vwait x.
5a20: 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74  .after cancel $t
5a30: 32 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 65  2..vwait x..afte
5a40: 72 20 63 61 6e 63 65 6c 20 24 74 33 0a 09 63 6c  r cancel $t3..cl
5a50: 6f 73 65 20 24 73 0a 09 70 75 74 73 20 24 78 0a  ose $s..puts $x.
5a60: 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20      }.    close 
5a70: 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70  $f.    set f [op
5a80: 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63  en "|[list $::tc
5a90: 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73  ltest::tcltest s
5aa0: 63 72 69 70 74 5d 20 32 3e 20 2f 64 65 76 2f 6e  cript] 2> /dev/n
5ab0: 75 6c 6c 22 20 72 2b 5d 0a 20 20 20 20 73 65 74  ull" r+].    set
5ac0: 20 78 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 20   x [gets $f].   
5ad0: 20 73 65 74 20 73 31 20 5b 74 6c 73 3a 3a 73 6f   set s1 [tls::so
5ae0: 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72  cket \..    -cer
5af0: 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72  tfile $clientCer
5b00: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72  t -cafile $caCer
5b10: 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65  t -keyfile $clie
5b20: 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 31 32 37  ntKey \..    127
5b30: 2e 30 2e 30 2e 31 20 38 38 32 38 5d 0a 20 20 20  .0.0.1 8828].   
5b40: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 31 20   fconfigure $s1 
5b50: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a  -buffering line.
5b60: 20 20 20 20 73 65 74 20 73 32 20 5b 74 6c 73 3a      set s2 [tls:
5b70: 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d  :socket \..    -
5b80: 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74  certfile $client
5b90: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61  Cert -cafile $ca
5ba0: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63  Cert -keyfile $c
5bb0: 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20  lientKey \..    
5bc0: 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 38 5d 0a  127.0.0.1 8828].
5bd0: 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24      fconfigure $
5be0: 73 32 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69  s2 -buffering li
5bf0: 6e 65 0a 20 20 20 20 73 65 74 20 73 33 20 5b 74  ne.    set s3 [t
5c00: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20  ls::socket \..  
5c10: 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69    -certfile $cli
5c20: 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20  entCert -cafile 
5c30: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65  $caCert -keyfile
5c40: 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20   $clientKey \.. 
5c50: 20 20 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 32     127.0.0.1 882
5c60: 38 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72  8].    fconfigur
5c70: 65 20 24 73 33 20 2d 62 75 66 66 65 72 69 6e 67  e $s3 -buffering
5c80: 20 6c 69 6e 65 0a 20 20 20 20 66 6f 72 20 7b 73   line.    for {s
5c90: 65 74 20 69 20 30 7d 20 7b 24 69 20 3c 20 31 30  et i 0} {$i < 10
5ca0: 30 7d 20 7b 69 6e 63 72 20 69 7d 20 7b 0a 09 70  0} {incr i} {..p
5cb0: 75 74 73 20 24 73 31 20 68 65 6c 6c 6f 2c 74 6c  uts $s1 hello,tl
5cc0: 73 49 4f 2d 33 2e 32 2c 73 31 0a 09 67 65 74 73  sIO-3.2,s1..gets
5cd0: 20 24 73 31 0a 09 70 75 74 73 20 24 73 32 20 68   $s1..puts $s2 h
5ce0: 65 6c 6c 6f 2c 74 6c 73 49 4f 2d 33 2e 32 2c 73  ello,tlsIO-3.2,s
5cf0: 32 0a 09 67 65 74 73 20 24 73 32 0a 09 70 75 74  2..gets $s2..put
5d00: 73 20 24 73 33 20 68 65 6c 6c 6f 2c 74 6c 73 49  s $s3 hello,tlsI
5d10: 4f 2d 33 2e 32 2c 73 33 0a 09 67 65 74 73 20 24  O-3.2,s3..gets $
5d20: 73 33 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f  s3.    }.    clo
5d30: 73 65 20 24 73 31 0a 20 20 20 20 63 6c 6f 73 65  se $s1.    close
5d40: 20 24 73 32 0a 20 20 20 20 63 6c 6f 73 65 20 24   $s2.    close $
5d50: 73 33 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 78  s3.    lappend x
5d60: 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 20 63   [gets $f].    c
5d70: 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20  lose $f.    set 
5d80: 78 0a 7d 20 7b 72 65 61 64 79 20 64 6f 6e 65 7d  x.} {ready done}
5d90: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 34 2e 31  ..test tlsIO-4.1
5da0: 20 7b 73 65 72 76 65 72 20 77 69 74 68 20 73 65   {server with se
5db0: 76 65 72 61 6c 20 63 6c 69 65 6e 74 73 7d 20 7b  veral clients} {
5dc0: 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a  socket stdio} {.
5dd0: 20 20 20 20 23 20 68 61 76 65 20 73 65 65 6e 20      # have seen 
5de0: 69 6e 74 65 72 6d 69 74 74 65 6e 74 20 68 61 6e  intermittent han
5df0: 67 73 20 6f 6e 20 57 69 6e 64 6f 77 73 0a 20 20  gs on Windows.  
5e00: 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72    removeFile scr
5e10: 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f  ipt.    set f [o
5e20: 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20  pen script w].  
5e30: 20 20 70 75 74 73 20 24 66 20 5b 6c 69 73 74 20    puts $f [list 
5e40: 73 65 74 20 61 75 74 6f 5f 70 61 74 68 20 24 61  set auto_path $a
5e50: 75 74 6f 5f 70 61 74 68 5d 0a 20 20 20 20 70 75  uto_path].    pu
5e60: 74 73 20 24 66 20 7b 0a 09 70 61 63 6b 61 67 65  ts $f {..package
5e70: 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 67 65   require tls..ge
5e80: 74 73 20 73 74 64 69 6e 0a 20 20 20 20 7d 0a 20  ts stdin.    }. 
5e90: 20 20 20 70 75 74 73 20 24 66 20 22 73 65 74 20     puts $f "set 
5ea0: 73 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20  s \[tls::socket 
5eb0: 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e  -certfile $clien
5ec0: 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63  tCert -cafile $c
5ed0: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24  aCert -keyfile $
5ee0: 63 6c 69 65 6e 74 4b 65 79 20 31 32 37 2e 30 2e  clientKey 127.0.
5ef0: 30 2e 31 20 38 38 32 38 20 5c 5d 22 0a 20 20 20  0.1 8828 \]".   
5f00: 20 70 75 74 73 20 24 66 20 7b 0a 09 66 63 6f 6e   puts $f {..fcon
5f10: 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 66 65  figure $s -buffe
5f20: 72 69 6e 67 20 6c 69 6e 65 0a 09 66 6f 72 20 7b  ring line..for {
5f30: 73 65 74 20 69 20 30 7d 20 7b 24 69 20 3c 20 31  set i 0} {$i < 1
5f40: 30 30 7d 20 7b 69 6e 63 72 20 69 7d 20 7b 0a 09  00} {incr i} {..
5f50: 20 20 20 20 70 75 74 73 20 24 73 20 68 65 6c 6c      puts $s hell
5f60: 6f 0a 09 20 20 20 20 67 65 74 73 20 24 73 0a 09  o..    gets $s..
5f70: 7d 0a 09 63 6c 6f 73 65 20 24 73 0a 09 70 75 74  }..close $s..put
5f80: 73 20 62 79 65 0a 09 67 65 74 73 20 73 74 64 69  s bye..gets stdi
5f90: 6e 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73  n.    }.    clos
5fa0: 65 20 24 66 0a 20 20 20 20 73 65 74 20 70 31 20  e $f.    set p1 
5fb0: 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a  [open "|[list $:
5fc0: 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73  :tcltest::tcltes
5fd0: 74 20 73 63 72 69 70 74 5d 20 32 3e 20 2f 64 65  t script] 2> /de
5fe0: 76 2f 6e 75 6c 6c 22 20 72 2b 5d 0a 20 20 20 20  v/null" r+].    
5ff0: 66 63 6f 6e 66 69 67 75 72 65 20 24 70 31 20 2d  fconfigure $p1 -
6000: 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20  buffering line. 
6010: 20 20 20 73 65 74 20 70 32 20 5b 6f 70 65 6e 20     set p2 [open 
6020: 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65  "|[list $::tclte
6030: 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69  st::tcltest scri
6040: 70 74 5d 20 32 3e 20 2f 64 65 76 2f 6e 75 6c 6c  pt] 2> /dev/null
6050: 22 20 72 2b 5d 0a 20 20 20 20 66 63 6f 6e 66 69  " r+].    fconfi
6060: 67 75 72 65 20 24 70 32 20 2d 62 75 66 66 65 72  gure $p2 -buffer
6070: 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 73 65 74  ing line.    set
6080: 20 70 33 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73   p3 [open "|[lis
6090: 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63  t $::tcltest::tc
60a0: 6c 74 65 73 74 20 73 63 72 69 70 74 5d 20 32 3e  ltest script] 2>
60b0: 20 2f 64 65 76 2f 6e 75 6c 6c 22 20 72 2b 5d 0a   /dev/null" r+].
60c0: 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24      fconfigure $
60d0: 70 33 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69  p3 -buffering li
60e0: 6e 65 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65  ne.    proc acce
60f0: 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 66 63  pt {s a p} {..fc
6100: 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 75 66  onfigure $s -buf
6110: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 66 69 6c  fering line..fil
6120: 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62  eevent $s readab
6130: 6c 65 20 5b 6c 69 73 74 20 65 63 68 6f 20 24 73  le [list echo $s
6140: 5d 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 6f 63  ].    }.    proc
6150: 20 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 67 6c 6f   echo {s} {..glo
6160: 62 61 6c 20 78 0a 20 20 20 20 20 20 20 20 73 65  bal x.        se
6170: 74 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a 20 20  t l [gets $s].  
6180: 20 20 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 24        if {[eof $
6190: 73 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 20  s]} {.          
61a0: 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 20    close $s.     
61b0: 20 20 20 20 20 20 20 73 65 74 20 78 20 64 6f 6e         set x don
61c0: 65 0a 20 20 20 20 20 20 20 20 7d 20 65 6c 73 65  e.        } else
61d0: 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 70   {.            p
61e0: 75 74 73 20 24 73 20 24 6c 0a 20 20 20 20 20 20  uts $s $l.      
61f0: 20 20 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65    }.    }.    se
6200: 74 20 74 31 20 5b 61 66 74 65 72 20 33 30 30 30  t t1 [after 3000
6210: 30 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 6f  0 "set x timed_o
6220: 75 74 22 5d 0a 20 20 20 20 73 65 74 20 74 32 20  ut"].    set t2 
6230: 5b 61 66 74 65 72 20 33 31 30 30 30 20 22 73 65  [after 31000 "se
6240: 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a  t x timed_out"].
6250: 20 20 20 20 73 65 74 20 74 33 20 5b 61 66 74 65      set t3 [afte
6260: 72 20 33 32 30 30 30 20 22 73 65 74 20 78 20 74  r 32000 "set x t
6270: 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 73  imed_out"].    s
6280: 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65  et s [tls::socke
6290: 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69  t \..    -certfi
62a0: 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d  le $serverCert -
62b0: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d  cafile $caCert -
62c0: 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b  keyfile $serverK
62d0: 65 79 20 5c 0a 09 20 20 20 20 2d 73 65 72 76 65  ey \..    -serve
62e0: 72 20 61 63 63 65 70 74 20 38 38 32 38 5d 0a 20  r accept 8828]. 
62f0: 20 20 20 70 75 74 73 20 24 70 31 20 6f 70 65 6e     puts $p1 open
6300: 0a 20 20 20 20 70 75 74 73 20 24 70 32 20 6f 70  .    puts $p2 op
6310: 65 6e 0a 20 20 20 20 70 75 74 73 20 24 70 33 20  en.    puts $p3 
6320: 6f 70 65 6e 0a 20 20 20 20 76 77 61 69 74 20 78  open.    vwait x
6330: 0a 20 20 20 20 76 77 61 69 74 20 78 0a 20 20 20  .    vwait x.   
6340: 20 76 77 61 69 74 20 78 0a 20 20 20 20 61 66 74   vwait x.    aft
6350: 65 72 20 63 61 6e 63 65 6c 20 24 74 31 0a 20 20  er cancel $t1.  
6360: 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24    after cancel $
6370: 74 32 0a 20 20 20 20 61 66 74 65 72 20 63 61 6e  t2.    after can
6380: 63 65 6c 20 24 74 33 0a 20 20 20 20 63 6c 6f 73  cel $t3.    clos
6390: 65 20 24 73 0a 20 20 20 20 73 65 74 20 6c 20 22  e $s.    set l "
63a0: 22 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20  ".    lappend l 
63b0: 5b 6c 69 73 74 20 70 31 20 5b 67 65 74 73 20 24  [list p1 [gets $
63c0: 70 31 5d 20 24 78 5d 0a 20 20 20 20 6c 61 70 70  p1] $x].    lapp
63d0: 65 6e 64 20 6c 20 5b 6c 69 73 74 20 70 32 20 5b  end l [list p2 [
63e0: 67 65 74 73 20 24 70 32 5d 20 24 78 5d 0a 20 20  gets $p2] $x].  
63f0: 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 6c 69 73    lappend l [lis
6400: 74 20 70 33 20 5b 67 65 74 73 20 24 70 33 5d 20  t p3 [gets $p3] 
6410: 24 78 5d 0a 20 20 20 20 70 75 74 73 20 24 70 31  $x].    puts $p1
6420: 20 62 79 65 0a 20 20 20 20 70 75 74 73 20 24 70   bye.    puts $p
6430: 32 20 62 79 65 0a 20 20 20 20 70 75 74 73 20 24  2 bye.    puts $
6440: 70 33 20 62 79 65 0a 20 20 20 20 63 6c 6f 73 65  p3 bye.    close
6450: 20 24 70 31 0a 20 20 20 20 63 6c 6f 73 65 20 24   $p1.    close $
6460: 70 32 0a 20 20 20 20 63 6c 6f 73 65 20 24 70 33  p2.    close $p3
6470: 0a 20 20 20 20 73 65 74 20 6c 0a 7d 20 7b 7b 70  .    set l.} {{p
6480: 31 20 62 79 65 20 64 6f 6e 65 7d 20 7b 70 32 20  1 bye done} {p2 
6490: 62 79 65 20 64 6f 6e 65 7d 20 7b 70 33 20 62 79  bye done} {p3 by
64a0: 65 20 64 6f 6e 65 7d 7d 0a 0a 74 65 73 74 20 74  e done}}..test t
64b0: 6c 73 49 4f 2d 34 2e 32 20 7b 62 79 74 65 20 6f  lsIO-4.2 {byte o
64c0: 72 64 65 72 20 70 72 6f 62 6c 65 6d 73 2c 20 73  rder problems, s
64d0: 6f 63 6b 65 74 20 6e 75 6d 62 65 72 73 2c 20 68  ocket numbers, h
64e0: 74 6f 6e 73 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b  tons} {socket} {
64f0: 0a 20 20 20 20 73 65 74 20 78 20 6f 6b 0a 20 20  .    set x ok.  
6500: 20 20 69 66 20 7b 5b 63 61 74 63 68 20 7b 74 6c    if {[catch {tl
6510: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65  s::socket -serve
6520: 72 20 64 6f 64 6f 20 30 78 33 30 30 30 7d 20 6d  r dodo 0x3000} m
6530: 73 67 5d 7d 20 7b 0a 09 73 65 74 20 78 20 24 6d  sg]} {..set x $m
6540: 73 67 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a  sg.    } else {.
6550: 09 63 6c 6f 73 65 20 24 6d 73 67 0a 20 20 20 20  .close $msg.    
6560: 7d 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 6f 6b  }.    set x.} ok
6570: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 35 2e 31  ..test tlsIO-5.1
6580: 20 7b 62 79 74 65 20 6f 72 64 65 72 20 70 72 6f   {byte order pro
6590: 62 6c 65 6d 73 2c 20 73 6f 63 6b 65 74 20 6e 75  blems, socket nu
65a0: 6d 62 65 72 73 2c 20 68 74 6f 6e 73 7d 20 5c 0a  mbers, htons} \.
65b0: 09 7b 73 6f 63 6b 65 74 20 75 6e 69 78 4f 6e 6c  .{socket unixOnl
65c0: 79 20 6e 6f 74 52 6f 6f 74 7d 20 7b 0a 20 20 20  y notRoot} {.   
65d0: 20 73 65 74 20 78 20 7b 63 6f 75 6c 64 6e 27 74   set x {couldn't
65e0: 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 6e 6f   open socket: no
65f0: 74 20 6f 77 6e 65 72 7d 0a 20 20 20 20 69 66 20  t owner}.    if 
6600: 7b 21 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73  {![catch {tls::s
6610: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 64 6f  ocket -server do
6620: 64 6f 20 30 78 31 7d 20 6d 73 67 5d 7d 20 7b 0a  do 0x1} msg]} {.
6630: 20 20 20 20 20 20 20 20 73 65 74 20 78 20 7b 68          set x {h
6640: 74 6f 6e 73 20 70 72 6f 62 6c 65 6d 2c 20 73 68  tons problem, sh
6650: 6f 75 6c 64 20 62 65 20 64 69 73 61 6c 6c 6f 77  ould be disallow
6660: 65 64 2c 20 61 72 65 20 79 6f 75 20 72 75 6e 6e  ed, are you runn
6670: 69 6e 67 20 61 73 20 53 55 3f 7d 0a 09 63 6c 6f  ing as SU?}..clo
6680: 73 65 20 24 6d 73 67 0a 20 20 20 20 7d 0a 20 20  se $msg.    }.  
6690: 20 20 73 65 74 20 78 0a 7d 20 7b 63 6f 75 6c 64    set x.} {could
66a0: 6e 27 74 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a  n't open socket:
66b0: 20 6e 6f 74 20 6f 77 6e 65 72 7d 0a 74 65 73 74   not owner}.test
66c0: 20 74 6c 73 49 4f 2d 35 2e 32 20 7b 62 79 74 65   tlsIO-5.2 {byte
66d0: 20 6f 72 64 65 72 20 70 72 6f 62 6c 65 6d 73 2c   order problems,
66e0: 20 73 6f 63 6b 65 74 20 6e 75 6d 62 65 72 73 2c   socket numbers,
66f0: 20 68 74 6f 6e 73 7d 20 7b 73 6f 63 6b 65 74 7d   htons} {socket}
6700: 20 7b 0a 20 20 20 20 73 65 74 20 78 20 7b 63 6f   {.    set x {co
6710: 75 6c 64 6e 27 74 20 6f 70 65 6e 20 73 6f 63 6b  uldn't open sock
6720: 65 74 3a 20 70 6f 72 74 20 6e 75 6d 62 65 72 20  et: port number 
6730: 74 6f 6f 20 68 69 67 68 7d 0a 20 20 20 20 69 66  too high}.    if
6740: 20 7b 21 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a   {![catch {tls::
6750: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 64  socket -server d
6760: 6f 64 6f 20 30 78 31 30 30 30 30 7d 20 6d 73 67  odo 0x10000} msg
6770: 5d 7d 20 7b 0a 09 73 65 74 20 78 20 7b 70 6f 72  ]} {..set x {por
6780: 74 20 72 65 73 6f 6c 75 74 69 6f 6e 20 70 72 6f  t resolution pro
6790: 62 6c 65 6d 2c 20 73 68 6f 75 6c 64 20 62 65 20  blem, should be 
67a0: 64 69 73 61 6c 6c 6f 77 65 64 7d 0a 09 63 6c 6f  disallowed}..clo
67b0: 73 65 20 24 6d 73 67 0a 20 20 20 20 7d 0a 20 20  se $msg.    }.  
67c0: 20 20 73 65 74 20 78 0a 7d 20 7b 63 6f 75 6c 64    set x.} {could
67d0: 6e 27 74 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a  n't open socket:
67e0: 20 70 6f 72 74 20 6e 75 6d 62 65 72 20 74 6f 6f   port number too
67f0: 20 68 69 67 68 7d 0a 74 65 73 74 20 74 6c 73 49   high}.test tlsI
6800: 4f 2d 35 2e 33 20 7b 62 79 74 65 20 6f 72 64 65  O-5.3 {byte orde
6810: 72 20 70 72 6f 62 6c 65 6d 73 2c 20 73 6f 63 6b  r problems, sock
6820: 65 74 20 6e 75 6d 62 65 72 73 2c 20 68 74 6f 6e  et numbers, hton
6830: 73 7d 20 5c 0a 09 7b 73 6f 63 6b 65 74 20 75 6e  s} \..{socket un
6840: 69 78 4f 6e 6c 79 20 6e 6f 74 52 6f 6f 74 7d 20  ixOnly notRoot} 
6850: 7b 0a 20 20 20 20 73 65 74 20 78 20 7b 63 6f 75  {.    set x {cou
6860: 6c 64 6e 27 74 20 6f 70 65 6e 20 73 6f 63 6b 65  ldn't open socke
6870: 74 3a 20 6e 6f 74 20 6f 77 6e 65 72 7d 0a 20 20  t: not owner}.  
6880: 20 20 69 66 20 7b 21 5b 63 61 74 63 68 20 7b 74    if {![catch {t
6890: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76  ls::socket -serv
68a0: 65 72 20 64 6f 64 6f 20 32 31 7d 20 6d 73 67 5d  er dodo 21} msg]
68b0: 7d 20 7b 0a 09 73 65 74 20 78 20 7b 68 74 6f 6e  } {..set x {hton
68c0: 73 20 70 72 6f 62 6c 65 6d 2c 20 73 68 6f 75 6c  s problem, shoul
68d0: 64 20 62 65 20 64 69 73 61 6c 6c 6f 77 65 64 2c  d be disallowed,
68e0: 20 61 72 65 20 79 6f 75 20 72 75 6e 6e 69 6e 67   are you running
68f0: 20 61 73 20 53 55 3f 7d 0a 09 63 6c 6f 73 65 20   as SU?}..close 
6900: 24 6d 73 67 0a 20 20 20 20 7d 0a 20 20 20 20 73  $msg.    }.    s
6910: 65 74 20 78 0a 7d 20 7b 63 6f 75 6c 64 6e 27 74  et x.} {couldn't
6920: 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 6e 6f   open socket: no
6930: 74 20 6f 77 6e 65 72 7d 0a 0a 74 65 73 74 20 74  t owner}..test t
6940: 6c 73 49 4f 2d 36 2e 31 20 7b 61 63 63 65 70 74  lsIO-6.1 {accept
6950: 20 63 61 6c 6c 62 61 63 6b 20 65 72 72 6f 72 7d   callback error}
6960: 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20   {socket stdio} 
6970: 7b 0a 20 20 20 20 23 20 54 68 65 72 65 20 69 73  {.    # There is
6980: 20 61 20 64 65 62 75 67 20 61 73 73 65 72 74 69   a debug asserti
6990: 6f 6e 20 6f 6e 20 57 69 6e 64 6f 77 73 2f 53 53  on on Windows/SS
69a0: 4c 20 74 68 61 74 20 63 61 75 73 65 73 20 61 20  L that causes a 
69b0: 63 72 61 73 68 20 77 68 65 6e 20 74 68 65 0a 20  crash when the. 
69c0: 20 20 20 23 20 63 65 72 74 69 66 69 63 61 74 65     # certificate
69d0: 20 69 73 6e 27 74 20 73 70 65 63 69 66 69 65 64   isn't specified
69e0: 2e 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65  ..    removeFile
69f0: 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 20   script.    set 
6a00: 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77  f [open script w
6a10: 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 5b 6c  ].    puts $f [l
6a20: 69 73 74 20 73 65 74 20 61 75 74 6f 5f 70 61 74  ist set auto_pat
6a30: 68 20 24 61 75 74 6f 5f 70 61 74 68 5d 0a 20 20  h $auto_path].  
6a40: 20 20 70 75 74 73 20 24 66 20 7b 0a 20 20 20 20    puts $f {.    
6a50: 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65  .package require
6a60: 20 74 6c 73 0a 09 67 65 74 73 20 73 74 64 69 6e   tls..gets stdin
6a70: 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 20  .    }.    puts 
6a80: 24 66 20 5b 6c 69 73 74 20 74 6c 73 3a 3a 73 6f  $f [list tls::so
6a90: 63 6b 65 74 20 2d 63 61 66 69 6c 65 20 24 63 61  cket -cafile $ca
6aa0: 43 65 72 74 20 31 32 37 2e 30 2e 30 2e 31 20 38  Cert 127.0.0.1 8
6ab0: 38 34 38 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24  848].    close $
6ac0: 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65  f.    set f [ope
6ad0: 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c  n "|[list $::tcl
6ae0: 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63  test::tcltest sc
6af0: 72 69 70 74 5d 20 32 3e 20 2f 64 65 76 2f 6e 75  ript] 2> /dev/nu
6b00: 6c 6c 22 20 72 2b 5d 0a 20 20 20 20 70 72 6f 63  ll" r+].    proc
6b10: 20 62 67 65 72 72 6f 72 20 61 72 67 73 20 7b 0a   bgerror args {.
6b20: 09 67 6c 6f 62 61 6c 20 78 0a 09 73 65 74 20 78  .global x..set x
6b30: 20 24 61 72 67 73 0a 20 20 20 20 7d 0a 20 20 20   $args.    }.   
6b40: 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20   proc accept {s 
6b50: 61 20 70 7d 20 7b 65 78 70 72 20 31 30 20 2f 20  a p} {expr 10 / 
6b60: 30 7d 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c  0}.    set s [tl
6b70: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65  s::socket -serve
6b80: 72 20 61 63 63 65 70 74 20 5c 0a 09 20 20 20 20  r accept \..    
6b90: 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65  -certfile $serve
6ba0: 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63  rCert -cafile $c
6bb0: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24  aCert -keyfile $
6bc0: 73 65 72 76 65 72 4b 65 79 20 38 38 34 38 5d 0a  serverKey 8848].
6bd0: 20 20 20 20 70 75 74 73 20 24 66 20 68 65 6c 6c      puts $f hell
6be0: 6f 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20  o.    close $f. 
6bf0: 20 20 20 73 65 74 20 74 69 6d 65 72 20 5b 61 66     set timer [af
6c00: 74 65 72 20 31 30 30 30 30 20 22 73 65 74 20 78  ter 10000 "set x
6c10: 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20   timed_out"].   
6c20: 20 76 77 61 69 74 20 78 0a 20 20 20 20 61 66 74   vwait x.    aft
6c30: 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72  er cancel $timer
6c40: 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20  .    close $s.  
6c50: 20 20 72 65 6e 61 6d 65 20 62 67 65 72 72 6f 72    rename bgerror
6c60: 20 7b 7d 0a 20 20 20 20 73 65 74 20 78 0a 7d 20   {}.    set x.} 
6c70: 7b 7b 64 69 76 69 64 65 20 62 79 20 7a 65 72 6f  {{divide by zero
6c80: 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 37  }}..test tlsIO-7
6c90: 2e 31 20 7b 74 65 73 74 69 6e 67 20 73 6f 63 6b  .1 {testing sock
6ca0: 65 74 20 73 70 65 63 69 66 69 63 20 6f 70 74 69  et specific opti
6cb0: 6f 6e 73 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64  ons} {socket std
6cc0: 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65  io} {.    remove
6cd0: 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20  File script.    
6ce0: 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69  set f [open scri
6cf0: 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24  pt w].    puts $
6d00: 66 20 5b 6c 69 73 74 20 73 65 74 20 61 75 74 6f  f [list set auto
6d10: 5f 70 61 74 68 20 24 61 75 74 6f 5f 70 61 74 68  _path $auto_path
6d20: 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a  ].    puts $f {.
6d30: 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65  .package require
6d40: 20 74 6c 73 0a 20 20 20 20 7d 0a 20 20 20 20 70   tls.    }.    p
6d50: 75 74 73 20 24 66 20 5b 6c 69 73 74 20 74 6c 73  uts $f [list tls
6d60: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72  ::socket -server
6d70: 20 61 63 63 65 70 74 20 5c 0a 09 20 20 20 20 2d   accept \..    -
6d80: 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72  certfile $server
6d90: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61  Cert -cafile $ca
6da0: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73  Cert -keyfile $s
6db0: 65 72 76 65 72 4b 65 79 20 38 38 32 30 5d 0a 20  erverKey 8820]. 
6dc0: 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 72     puts $f {..pr
6dd0: 6f 63 20 61 63 63 65 70 74 20 61 72 67 73 20 7b  oc accept args {
6de0: 0a 09 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 09  ..    global x..
6df0: 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 09      set x done..
6e00: 7d 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 73  }..puts ready..s
6e10: 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20  et timer [after 
6e20: 31 30 30 30 30 20 22 73 65 74 20 78 20 74 69 6d  10000 "set x tim
6e30: 65 64 5f 6f 75 74 22 5d 0a 09 76 77 61 69 74 20  ed_out"]..vwait 
6e40: 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20  x..after cancel 
6e50: 24 74 69 6d 65 72 0a 20 20 20 20 7d 0a 20 20 20  $timer.    }.   
6e60: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65   close $f.    se
6e70: 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73  t f [open "|[lis
6e80: 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63  t $::tcltest::tc
6e90: 6c 74 65 73 74 20 73 63 72 69 70 74 5d 20 32 3e  ltest script] 2>
6ea0: 20 2f 64 65 76 2f 6e 75 6c 6c 22 20 72 5d 0a 20   /dev/null" r]. 
6eb0: 20 20 20 67 65 74 73 20 24 66 0a 20 20 20 20 73     gets $f.    s
6ec0: 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65  et s [tls::socke
6ed0: 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69  t \..    -certfi
6ee0: 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d  le $clientCert -
6ef0: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d  cafile $caCert -
6f00: 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b  keyfile $clientK
6f10: 65 79 20 5c 0a 09 20 20 20 20 31 32 37 2e 30 2e  ey \..    127.0.
6f20: 30 2e 31 20 38 38 32 30 5d 0a 20 20 20 20 73 65  0.1 8820].    se
6f30: 74 20 70 20 5b 66 63 6f 6e 66 69 67 75 72 65 20  t p [fconfigure 
6f40: 24 73 20 2d 70 65 65 72 6e 61 6d 65 5d 0a 20 20  $s -peername].  
6f50: 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 63    close $s.    c
6f60: 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20  lose $f.    set 
6f70: 6c 20 22 22 0a 20 20 20 20 6c 61 70 70 65 6e 64  l "".    lappend
6f80: 20 6c 20 5b 73 74 72 69 6e 67 20 63 6f 6d 70 61   l [string compa
6f90: 72 65 20 5b 6c 69 6e 64 65 78 20 24 70 20 30 5d  re [lindex $p 0]
6fa0: 20 31 32 37 2e 30 2e 30 2e 31 5d 0a 20 20 20 20   127.0.0.1].    
6fb0: 6c 61 70 70 65 6e 64 20 6c 20 5b 73 74 72 69 6e  lappend l [strin
6fc0: 67 20 63 6f 6d 70 61 72 65 20 5b 6c 69 6e 64 65  g compare [linde
6fd0: 78 20 24 70 20 32 5d 20 38 38 32 30 5d 0a 20 20  x $p 2] 8820].  
6fe0: 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 6c 6c 65    lappend l [lle
6ff0: 6e 67 74 68 20 24 70 5d 0a 7d 20 7b 30 20 30 20  ngth $p].} {0 0 
7000: 33 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 37  3}..test tlsIO-7
7010: 2e 32 20 7b 74 65 73 74 69 6e 67 20 73 6f 63 6b  .2 {testing sock
7020: 65 74 20 73 70 65 63 69 66 69 63 20 6f 70 74 69  et specific opti
7030: 6f 6e 73 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64  ons} {socket std
7040: 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65  io} {.    remove
7050: 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20  File script.    
7060: 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69  set f [open scri
7070: 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24  pt w].    puts $
7080: 66 20 5b 6c 69 73 74 20 73 65 74 20 61 75 74 6f  f [list set auto
7090: 5f 70 61 74 68 20 24 61 75 74 6f 5f 70 61 74 68  _path $auto_path
70a0: 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a  ].    puts $f {.
70b0: 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65  .package require
70c0: 20 74 6c 73 0a 20 20 20 20 7d 0a 20 20 20 20 70   tls.    }.    p
70d0: 75 74 73 20 24 66 20 22 74 6c 73 3a 3a 73 6f 63  uts $f "tls::soc
70e0: 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65  ket -server acce
70f0: 70 74 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65  pt -certfile $se
7100: 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65  rverCert -cafile
7110: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c   $caCert -keyfil
7120: 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 38 32  e $serverKey 882
7130: 31 22 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b  1".    puts $f {
7140: 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 61 72  ..proc accept ar
7150: 67 73 20 7b 0a 09 20 20 20 20 67 6c 6f 62 61 6c  gs {..    global
7160: 20 78 0a 09 20 20 20 20 73 65 74 20 78 20 64 6f   x..    set x do
7170: 6e 65 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 64  ne..}..puts read
7180: 79 0a 09 73 65 74 20 74 69 6d 65 72 20 5b 61 66  y..set timer [af
7190: 74 65 72 20 31 30 30 30 30 20 22 73 65 74 20 78  ter 10000 "set x
71a0: 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 09 76 77   timed_out"]..vw
71b0: 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 61 6e  ait x..after can
71c0: 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 7d  cel $timer.    }
71d0: 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20  .    close $f.  
71e0: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c    set f [open "|
71f0: 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74  [list $::tcltest
7200: 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74  ::tcltest script
7210: 5d 20 32 3e 20 2f 64 65 76 2f 6e 75 6c 6c 22 20  ] 2> /dev/null" 
7220: 72 5d 0a 20 20 20 20 67 65 74 73 20 24 66 0a 20  r].    gets $f. 
7230: 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73     set s [tls::s
7240: 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65  ocket \..    -ce
7250: 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65  rtfile $clientCe
7260: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65  rt -cafile $caCe
7270: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69  rt -keyfile $cli
7280: 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 31 32  entKey \..    12
7290: 37 2e 30 2e 30 2e 31 20 38 38 32 31 5d 0a 20 20  7.0.0.1 8821].  
72a0: 20 20 73 65 74 20 70 20 5b 66 63 6f 6e 66 69 67    set p [fconfig
72b0: 75 72 65 20 24 73 20 2d 73 6f 63 6b 6e 61 6d 65  ure $s -sockname
72c0: 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20  ].    close $s. 
72d0: 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20     close $f.    
72e0: 73 65 74 20 6c 20 22 22 0a 20 20 20 20 6c 61 70  set l "".    lap
72f0: 70 65 6e 64 20 6c 20 5b 6c 6c 65 6e 67 74 68 20  pend l [llength 
7300: 24 70 5d 0a 20 20 20 20 6c 61 70 70 65 6e 64 20  $p].    lappend 
7310: 6c 20 5b 6c 69 6e 64 65 78 20 24 70 20 30 5d 0a  l [lindex $p 0].
7320: 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 73      lappend l [s
7330: 74 72 69 6e 67 20 65 71 75 61 6c 20 5b 6c 69 6e  tring equal [lin
7340: 64 65 78 20 24 70 20 32 5d 20 38 38 32 31 5d 0a  dex $p 2] 8821].
7350: 7d 20 7b 33 20 31 32 37 2e 30 2e 30 2e 31 20 30  } {3 127.0.0.1 0
7360: 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 37 2e  }..test tlsIO-7.
7370: 33 20 7b 74 65 73 74 69 6e 67 20 73 6f 63 6b 65  3 {testing socke
7380: 74 20 73 70 65 63 69 66 69 63 20 6f 70 74 69 6f  t specific optio
7390: 6e 73 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20  ns} {socket} {. 
73a0: 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73     set s [tls::s
73b0: 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 72 74 66 69  ocket \..-certfi
73c0: 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d  le $serverCert -
73d0: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d  cafile $caCert -
73e0: 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b  keyfile $serverK
73f0: 65 79 20 5c 0a 20 20 20 20 09 2d 73 65 72 76 65  ey \.    .-serve
7400: 72 20 61 63 63 65 70 74 20 38 38 32 32 5d 0a 20  r accept 8822]. 
7410: 20 20 20 73 65 74 20 6c 20 5b 6c 6c 65 6e 67 74     set l [llengt
7420: 68 20 5b 66 63 6f 6e 66 69 67 75 72 65 20 24 73  h [fconfigure $s
7430: 5d 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a  ]].    close $s.
7440: 20 20 20 20 75 70 64 61 74 65 0a 20 20 20 20 23      update.    #
7450: 20 41 20 62 75 67 20 66 69 78 65 64 20 69 6e 20   A bug fixed in 
7460: 66 63 6f 6e 66 69 67 75 72 65 20 66 6f 72 20 38  fconfigure for 8
7470: 2e 33 2e 34 2b 20 6d 61 6b 65 20 74 68 69 73 20  .3.4+ make this 
7480: 72 65 74 75 72 6e 20 31 34 20 6e 6f 72 6d 61 6c  return 14 normal
7490: 6c 79 2c 0a 20 20 20 20 23 20 62 75 74 20 31 32  ly,.    # but 12
74a0: 20 69 6e 20 6f 6c 64 65 72 20 76 65 72 73 69 6f   in older versio
74b0: 6e 73 2e 0a 20 20 20 20 65 78 70 72 20 7b 24 6c  ns..    expr {$l
74c0: 20 3e 3d 20 31 32 20 26 26 20 28 28 24 6c 20 25   >= 12 && (($l %
74d0: 20 32 29 20 3d 3d 20 30 29 7d 0a 7d 20 31 0a 0a   2) == 0)}.} 1..
74e0: 23 20 62 75 67 20 72 65 70 6f 72 74 20 23 35 38  # bug report #58
74f0: 31 32 20 66 63 6f 6e 66 69 67 75 72 65 20 64 6f  12 fconfigure do
7500: 65 73 6e 27 74 20 72 65 74 75 72 6e 20 76 61 6c  esn't return val
7510: 75 65 20 66 6f 72 20 27 2d 73 6f 63 6b 6e 61 6d  ue for '-socknam
7520: 65 27 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 37  e'..test tlsIO-7
7530: 2e 34 20 7b 74 65 73 74 69 6e 67 20 73 6f 63 6b  .4 {testing sock
7540: 65 74 20 73 70 65 63 69 66 69 63 20 6f 70 74 69  et specific opti
7550: 6f 6e 73 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a  ons} {socket} {.
7560: 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a      set s [tls::
7570: 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 72 74 66  socket \..-certf
7580: 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20  ile $serverCert 
7590: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20  -cafile $caCert 
75a0: 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72  -keyfile $server
75b0: 4b 65 79 20 5c 0a 20 20 20 20 09 2d 73 65 72 76  Key \.    .-serv
75c0: 65 72 20 61 63 63 65 70 74 20 38 38 32 33 5d 0a  er accept 8823].
75d0: 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 20      proc accept 
75e0: 7b 73 20 61 20 70 7d 20 7b 0a 09 67 6c 6f 62 61  {s a p} {..globa
75f0: 6c 20 78 0a 09 73 65 74 20 78 20 5b 66 63 6f 6e  l x..set x [fcon
7600: 66 69 67 75 72 65 20 24 73 20 2d 73 6f 63 6b 6e  figure $s -sockn
7610: 61 6d 65 5d 0a 09 63 6c 6f 73 65 20 24 73 0a 20  ame]..close $s. 
7620: 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 31 20     }.    set s1 
7630: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09  [tls::socket \..
7640: 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e  -certfile $clien
7650: 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63  tCert -cafile $c
7660: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24  aCert -keyfile $
7670: 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 20 20 20 20  clientKey \.    
7680: 09 6c 6f 63 61 6c 68 6f 73 74 20 38 38 32 33 5d  .localhost 8823]
7690: 0a 20 20 20 20 73 65 74 20 74 69 6d 65 72 20 5b  .    set timer [
76a0: 61 66 74 65 72 20 31 30 30 30 30 20 22 73 65 74  after 10000 "set
76b0: 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20   x timed_out"]. 
76c0: 20 20 20 76 77 61 69 74 20 78 0a 20 20 20 20 61     vwait x.    a
76d0: 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d  fter cancel $tim
76e0: 65 72 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a  er.    close $s.
76f0: 20 20 20 20 63 6c 6f 73 65 20 24 73 31 0a 20 20      close $s1.  
7700: 20 20 73 65 74 20 6c 20 22 22 0a 20 20 20 20 6c    set l "".    l
7710: 61 70 70 65 6e 64 20 6c 20 5b 6c 69 6e 64 65 78  append l [lindex
7720: 20 24 78 20 32 5d 20 5b 6c 6c 65 6e 67 74 68 20   $x 2] [llength 
7730: 24 78 5d 0a 7d 20 7b 38 38 32 33 20 33 7d 0a 0a  $x].} {8823 3}..
7740: 23 20 62 75 67 20 72 65 70 6f 72 74 20 23 35 38  # bug report #58
7750: 31 32 20 66 63 6f 6e 66 69 67 75 72 65 20 64 6f  12 fconfigure do
7760: 65 73 6e 27 74 20 72 65 74 75 72 6e 20 76 61 6c  esn't return val
7770: 75 65 20 66 6f 72 20 27 2d 73 6f 63 6b 6e 61 6d  ue for '-socknam
7780: 65 27 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 37  e'..test tlsIO-7
7790: 2e 35 20 7b 74 65 73 74 69 6e 67 20 73 6f 63 6b  .5 {testing sock
77a0: 65 74 20 73 70 65 63 69 66 69 63 20 6f 70 74 69  et specific opti
77b0: 6f 6e 73 7d 20 7b 73 6f 63 6b 65 74 20 75 6e 69  ons} {socket uni
77c0: 78 4f 72 50 63 7d 20 7b 0a 20 20 20 20 73 65 74  xOrPc} {.    set
77d0: 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20   s [tls::socket 
77e0: 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65  \..    -certfile
77f0: 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61   $serverCert -ca
7800: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65  file $caCert -ke
7810: 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79  yfile $serverKey
7820: 20 5c 0a 09 20 20 20 20 2d 73 65 72 76 65 72 20   \..    -server 
7830: 61 63 63 65 70 74 20 38 38 32 39 5d 0a 20 20 20  accept 8829].   
7840: 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20   proc accept {s 
7850: 61 20 70 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 78  a p} {..global x
7860: 0a 09 73 65 74 20 78 20 5b 66 63 6f 6e 66 69 67  ..set x [fconfig
7870: 75 72 65 20 24 73 20 2d 73 6f 63 6b 6e 61 6d 65  ure $s -sockname
7880: 5d 0a 09 63 6c 6f 73 65 20 24 73 0a 20 20 20 20  ]..close $s.    
7890: 7d 0a 20 20 20 20 73 65 74 20 73 31 20 5b 74 6c  }.    set s1 [tl
78a0: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20  s::socket \..   
78b0: 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65   -certfile $clie
78c0: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24  ntCert -cafile $
78d0: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20  caCert -keyfile 
78e0: 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20  $clientKey \..  
78f0: 20 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 39    127.0.0.1 8829
7900: 5d 0a 20 20 20 20 73 65 74 20 74 69 6d 65 72 20  ].    set timer 
7910: 5b 61 66 74 65 72 20 31 30 30 30 30 20 22 73 65  [after 10000 "se
7920: 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a  t x timed_out"].
7930: 20 20 20 20 76 77 61 69 74 20 78 0a 20 20 20 20      vwait x.    
7940: 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69  after cancel $ti
7950: 6d 65 72 0a 20 20 20 20 63 6c 6f 73 65 20 24 73  mer.    close $s
7960: 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 31 0a 20  .    close $s1. 
7970: 20 20 20 73 65 74 20 6c 20 22 22 0a 20 20 20 20     set l "".    
7980: 6c 61 70 70 65 6e 64 20 6c 20 5b 6c 69 6e 64 65  lappend l [linde
7990: 78 20 24 78 20 30 5d 20 5b 6c 69 6e 64 65 78 20  x $x 0] [lindex 
79a0: 24 78 20 32 5d 20 5b 6c 6c 65 6e 67 74 68 20 24  $x 2] [llength $
79b0: 78 5d 0a 7d 20 7b 31 32 37 2e 30 2e 30 2e 31 20  x].} {127.0.0.1 
79c0: 38 38 32 39 20 33 7d 0a 0a 74 65 73 74 20 74 6c  8829 3}..test tl
79d0: 73 49 4f 2d 38 2e 31 20 7b 74 65 73 74 69 6e 67  sIO-8.1 {testing
79e0: 20 2d 61 73 79 6e 63 20 66 6c 61 67 20 6f 6e 20   -async flag on 
79f0: 73 6f 63 6b 65 74 73 7d 20 7b 73 6f 63 6b 65 74  sockets} {socket
7a00: 7d 20 7b 0a 20 20 20 20 23 20 4e 4f 54 45 3a 20  } {.    # NOTE: 
7a10: 54 68 69 73 20 74 65 73 74 20 6d 61 79 20 66 61  This test may fa
7a20: 69 6c 20 6f 6e 20 73 6f 6d 65 20 53 6f 6c 61 72  il on some Solar
7a30: 69 73 20 32 2e 34 20 73 79 73 74 65 6d 73 2e 0a  is 2.4 systems..
7a40: 20 20 20 20 23 20 53 65 65 20 6e 6f 74 65 73 20      # See notes 
7a50: 69 6e 20 54 63 6c 27 73 20 73 6f 63 6b 65 74 2e  in Tcl's socket.
7a60: 74 65 73 74 2e 0a 20 20 20 20 73 65 74 20 73 20  test..    set s 
7a70: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09  [tls::socket \..
7a80: 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 73      -certfile $s
7a90: 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c  erverCert -cafil
7aa0: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69  e $caCert -keyfi
7ab0: 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a  le $serverKey \.
7ac0: 09 20 20 20 20 2d 73 65 72 76 65 72 20 61 63 63  .    -server acc
7ad0: 65 70 74 20 38 38 33 30 5d 0a 20 20 20 20 70 72  ept 8830].    pr
7ae0: 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70  oc accept {s a p
7af0: 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 78 0a 09 23  } {..global x..#
7b00: 20 77 68 65 6e 20 64 6f 69 6e 67 20 61 6e 20 69   when doing an i
7b10: 6e 2d 70 72 6f 63 65 73 73 20 63 6c 69 65 6e 74  n-process client
7b20: 2f 73 65 72 76 65 72 20 74 65 73 74 2c 20 62 6f  /server test, bo
7b30: 74 68 20 73 69 64 65 73 20 6e 65 65 64 0a 09 23  th sides need..#
7b40: 20 74 6f 20 62 65 20 6e 6f 6e 2d 62 6c 6f 63 6b   to be non-block
7b50: 69 6e 67 20 66 6f 72 20 74 68 65 20 54 4c 53 20  ing for the TLS 
7b60: 68 61 6e 64 73 68 61 6b 65 2e 20 20 41 6c 73 6f  handshake.  Also
7b70: 20 6d 61 6b 65 20 73 75 72 65 0a 09 23 20 74 6f   make sure..# to
7b80: 20 72 65 74 75 72 6e 20 74 68 65 20 63 68 61 6e   return the chan
7b90: 6e 65 6c 20 74 6f 20 6c 69 6e 65 20 62 75 66 66  nel to line buff
7ba0: 65 72 69 6e 67 20 6d 6f 64 65 2e 0a 09 66 63 6f  ering mode...fco
7bb0: 6e 66 69 67 75 72 65 20 24 73 20 2d 62 6c 6f 63  nfigure $s -bloc
7bc0: 6b 69 6e 67 20 30 20 2d 62 75 66 66 65 72 69 6e  king 0 -bufferin
7bd0: 67 20 6c 69 6e 65 0a 09 70 75 74 73 20 24 73 20  g line..puts $s 
7be0: 62 79 65 0a 09 23 20 4f 6e 6c 79 20 4f 70 65 6e  bye..# Only Open
7bf0: 53 53 4c 20 30 2e 39 2e 35 61 20 6f 6e 20 57 69  SSL 0.9.5a on Wi
7c00: 6e 64 6f 77 73 20 73 65 65 6d 73 20 74 6f 20 6e  ndows seems to n
7c10: 65 65 64 20 74 68 65 20 61 66 74 65 72 20 28 64  eed the after (d
7c20: 65 6c 61 79 65 64 29 0a 09 23 20 63 6c 6f 73 65  elayed)..# close
7c30: 2c 20 62 75 74 20 69 74 20 77 6f 72 6b 73 20 6a  , but it works j
7c40: 75 73 74 20 74 68 65 20 73 61 6d 65 20 66 6f 72  ust the same for
7c50: 20 61 6c 6c 20 6f 74 68 65 72 73 2e 20 2d 68 6f   all others. -ho
7c60: 62 62 73 0a 09 61 66 74 65 72 20 35 30 30 20 63  bbs..after 500 c
7c70: 6c 6f 73 65 20 24 73 0a 09 73 65 74 20 78 20 64  lose $s..set x d
7c80: 6f 6e 65 0a 20 20 20 20 7d 0a 20 20 20 20 73 65  one.    }.    se
7c90: 74 20 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65  t s1 [tls::socke
7ca0: 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69  t \..    -certfi
7cb0: 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d  le $clientCert -
7cc0: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d  cafile $caCert -
7cd0: 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b  keyfile $clientK
7ce0: 65 79 20 5c 0a 09 20 20 20 20 2d 61 73 79 6e 63  ey \..    -async
7cf0: 20 6c 6f 63 61 6c 68 6f 73 74 20 38 38 33 30 5d   localhost 8830]
7d00: 0a 20 20 20 20 23 20 77 68 65 6e 20 64 6f 69 6e  .    # when doin
7d10: 67 20 61 6e 20 69 6e 2d 70 72 6f 63 65 73 73 20  g an in-process 
7d20: 63 6c 69 65 6e 74 2f 73 65 72 76 65 72 20 74 65  client/server te
7d30: 73 74 2c 20 62 6f 74 68 20 73 69 64 65 73 20 6e  st, both sides n
7d40: 65 65 64 0a 20 20 20 20 23 20 74 6f 20 62 65 20  eed.    # to be 
7d50: 6e 6f 6e 2d 62 6c 6f 63 6b 69 6e 67 20 66 6f 72  non-blocking for
7d60: 20 74 68 65 20 54 4c 53 20 68 61 6e 64 73 68 61   the TLS handsha
7d70: 6b 65 20 20 41 6c 73 6f 20 6d 61 6b 65 20 73 75  ke  Also make su
7d80: 72 65 20 74 6f 0a 20 20 20 20 23 20 72 65 74 75  re to.    # retu
7d90: 72 6e 20 74 68 65 20 63 68 61 6e 6e 65 6c 20 74  rn the channel t
7da0: 6f 20 6c 69 6e 65 20 62 75 66 66 65 72 69 6e 67  o line buffering
7db0: 20 6d 6f 64 65 20 28 54 4c 53 20 73 65 74 73 20   mode (TLS sets 
7dc0: 69 74 20 74 6f 20 27 6e 6f 6e 65 27 29 2e 0a 20  it to 'none').. 
7dd0: 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73     fconfigure $s
7de0: 31 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 20 2d 62  1 -blocking 0 -b
7df0: 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20  uffering line.  
7e00: 20 20 76 77 61 69 74 20 78 0a 20 20 20 20 23 20    vwait x.    # 
7e10: 54 4c 53 20 68 61 6e 64 73 68 61 6b 69 6e 67 20  TLS handshaking 
7e20: 6e 65 65 64 73 20 6f 6e 65 20 62 79 74 65 20 66  needs one byte f
7e30: 72 6f 6d 20 74 68 65 20 63 6c 69 65 6e 74 2e 2e  rom the client..
7e40: 2e 0a 20 20 20 20 70 75 74 73 20 24 73 31 20 61  ..    puts $s1 a
7e50: 0a 20 20 20 20 23 20 6e 65 65 64 20 75 70 64 61  .    # need upda
7e60: 74 65 20 74 6f 20 63 6f 6d 70 6c 65 74 65 20 54  te to complete T
7e70: 4c 53 20 68 61 6e 64 73 68 61 6b 65 20 69 6e 2d  LS handshake in-
7e80: 70 72 6f 63 65 73 73 0a 20 20 20 20 75 70 64 61  process.    upda
7e90: 74 65 0a 20 20 20 20 73 65 74 20 7a 20 5b 67 65  te.    set z [ge
7ea0: 74 73 20 24 73 31 5d 0a 20 20 20 20 63 6c 6f 73  ts $s1].    clos
7eb0: 65 20 24 73 0a 20 20 20 20 63 6c 6f 73 65 20 24  e $s.    close $
7ec0: 73 31 0a 20 20 20 20 73 65 74 20 7a 0a 7d 20 62  s1.    set z.} b
7ed0: 79 65 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 39  ye..test tlsIO-9
7ee0: 2e 31 20 7b 74 65 73 74 69 6e 67 20 73 70 75 72  .1 {testing spur
7ef0: 69 6f 75 73 20 65 76 65 6e 74 73 7d 20 7b 73 6f  ious events} {so
7f00: 63 6b 65 74 7d 20 7b 0a 20 20 20 20 73 65 74 20  cket} {.    set 
7f10: 6c 65 6e 20 30 0a 20 20 20 20 73 65 74 20 73 70  len 0.    set sp
7f20: 75 72 69 6f 75 73 20 30 0a 20 20 20 20 73 65 74  urious 0.    set
7f30: 20 64 6f 6e 65 20 30 0a 20 20 20 20 70 72 6f 63   done 0.    proc
7f40: 20 72 65 61 64 6c 69 74 74 6c 65 20 7b 73 7d 20   readlittle {s} 
7f50: 7b 0a 09 67 6c 6f 62 61 6c 20 73 70 75 72 69 6f  {..global spurio
7f60: 75 73 20 64 6f 6e 65 20 6c 65 6e 0a 09 73 65 74  us done len..set
7f70: 20 6c 20 5b 72 65 61 64 20 24 73 20 31 5d 0a 09   l [read $s 1]..
7f80: 69 66 20 7b 5b 73 74 72 69 6e 67 20 6c 65 6e 67  if {[string leng
7f90: 74 68 20 24 6c 5d 20 3d 3d 20 30 7d 20 7b 0a 09  th $l] == 0} {..
7fa0: 20 20 20 20 69 66 20 7b 21 5b 65 6f 66 20 24 73      if {![eof $s
7fb0: 5d 7d 20 7b 0a 09 09 69 6e 63 72 20 73 70 75 72  ]} {...incr spur
7fc0: 69 6f 75 73 0a 09 20 20 20 20 7d 20 65 6c 73 65  ious..    } else
7fd0: 20 7b 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 09   {...close $s...
7fe0: 73 65 74 20 64 6f 6e 65 20 31 0a 09 20 20 20 20  set done 1..    
7ff0: 7d 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 20 20 20  }..} else {..   
8000: 20 69 6e 63 72 20 6c 65 6e 20 5b 73 74 72 69 6e   incr len [strin
8010: 67 20 6c 65 6e 67 74 68 20 24 6c 5d 0a 09 7d 0a  g length $l]..}.
8020: 20 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 61      }.    proc a
8030: 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a  ccept {s a p} {.
8040: 09 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d  .fconfigure $s -
8050: 62 6c 6f 63 6b 69 6e 67 20 30 0a 09 66 69 6c 65  blocking 0..file
8060: 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c  event $s readabl
8070: 65 20 5b 6c 69 73 74 20 64 6f 5f 68 61 6e 64 73  e [list do_hands
8080: 68 61 6b 65 20 24 73 20 72 65 61 64 61 62 6c 65  hake $s readable
8090: 20 72 65 61 64 6c 69 74 74 6c 65 20 5c 0a 09 09   readlittle \...
80a0: 2d 62 75 66 66 65 72 69 6e 67 20 6e 6f 6e 65 5d  -buffering none]
80b0: 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73  .    }.    set s
80c0: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a   [tls::socket \.
80d0: 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24  .    -certfile $
80e0: 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69  serverCert -cafi
80f0: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66  le $caCert -keyf
8100: 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c  ile $serverKey \
8110: 0a 09 20 20 20 20 2d 73 65 72 76 65 72 20 61 63  ..    -server ac
8120: 63 65 70 74 20 38 38 33 31 5d 0a 20 20 20 20 73  cept 8831].    s
8130: 65 74 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65  et c [tls::socke
8140: 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69  t \..    -certfi
8150: 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d  le $clientCert -
8160: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d  cafile $caCert -
8170: 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b  keyfile $clientK
8180: 65 79 20 5c 0a 09 20 20 20 20 6c 6f 63 61 6c 68  ey \..    localh
8190: 6f 73 74 20 38 38 33 31 5d 0a 20 20 20 20 23 20  ost 8831].    # 
81a0: 54 68 69 73 20 64 69 66 66 65 72 73 20 66 72 6f  This differs fro
81b0: 6d 20 73 6f 63 6b 65 74 2d 39 2e 31 20 69 6e 20  m socket-9.1 in 
81c0: 74 68 61 74 20 62 6f 74 68 20 73 69 64 65 73 20  that both sides 
81d0: 6e 65 65 64 20 74 6f 20 62 65 0a 20 20 20 20 23  need to be.    #
81e0: 20 6e 6f 6e 2d 62 6c 6f 63 6b 69 6e 67 20 62 65   non-blocking be
81f0: 63 61 75 73 65 20 6f 66 20 54 4c 53 27 20 72 65  cause of TLS' re
8200: 71 75 69 72 65 64 20 68 61 6e 64 73 68 61 6b 65  quired handshake
8210: 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20  .    fconfigure 
8220: 24 63 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 0a 20  $c -blocking 0. 
8230: 20 20 20 70 75 74 73 20 2d 6e 6f 6e 65 77 6c 69     puts -nonewli
8240: 6e 65 20 24 63 20 30 31 32 33 34 35 36 37 38 39  ne $c 0123456789
8250: 30 31 32 33 34 35 36 37 38 39 30 31 32 33 34 35  0123456789012345
8260: 36 37 38 39 30 31 32 33 34 35 36 37 38 39 30 31  6789012345678901
8270: 32 33 34 35 36 37 38 39 0a 20 20 20 20 63 6c 6f  23456789.    clo
8280: 73 65 20 24 63 0a 20 20 20 20 73 65 74 20 74 69  se $c.    set ti
8290: 6d 65 72 20 5b 61 66 74 65 72 20 31 30 30 30 30  mer [after 10000
82a0: 20 22 73 65 74 20 64 6f 6e 65 20 74 69 6d 65 64   "set done timed
82b0: 5f 6f 75 74 22 5d 0a 20 20 20 20 76 77 61 69 74  _out"].    vwait
82c0: 20 64 6f 6e 65 0a 20 20 20 20 61 66 74 65 72 20   done.    after 
82d0: 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20  cancel $timer.  
82e0: 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 6c    close $s.    l
82f0: 69 73 74 20 24 73 70 75 72 69 6f 75 73 20 24 6c  ist $spurious $l
8300: 65 6e 0a 7d 20 7b 30 20 35 30 7d 0a 0a 74 65 73  en.} {0 50}..tes
8310: 74 20 74 6c 73 49 4f 2d 39 2e 32 20 7b 74 65 73  t tlsIO-9.2 {tes
8320: 74 69 6e 67 20 61 73 79 6e 63 20 77 72 69 74 65  ting async write
8330: 2c 20 66 69 6c 65 65 76 65 6e 74 73 2c 20 66 6c  , fileevents, fl
8340: 75 73 68 20 6f 6e 20 63 6c 6f 73 65 7d 20 7b 73  ush on close} {s
8350: 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 73 65 74  ocket} {.    set
8360: 20 66 69 72 73 74 62 6c 6f 63 6b 20 5b 73 74 72   firstblock [str
8370: 69 6e 67 20 72 65 70 65 61 74 20 61 20 33 31 5d  ing repeat a 31]
8380: 0a 20 20 20 20 73 65 74 20 73 65 63 6f 6e 64 62  .    set secondb
8390: 6c 6f 63 6b 20 5b 73 74 72 69 6e 67 20 72 65 70  lock [string rep
83a0: 65 61 74 20 62 20 36 35 35 33 35 5d 0a 20 20 20  eat b 65535].   
83b0: 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20   proc accept {s 
83c0: 61 20 70 7d 20 7b 0a 09 66 63 6f 6e 66 69 67 75  a p} {..fconfigu
83d0: 72 65 20 24 73 20 2d 62 6c 6f 63 6b 69 6e 67 20  re $s -blocking 
83e0: 30 0a 09 66 69 6c 65 65 76 65 6e 74 20 24 73 20  0..fileevent $s 
83f0: 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 64  readable [list d
8400: 6f 5f 68 61 6e 64 73 68 61 6b 65 20 24 73 20 72  o_handshake $s r
8410: 65 61 64 61 62 6c 65 20 72 65 61 64 61 62 6c 65  eadable readable
8420: 20 5c 0a 09 09 2d 74 72 61 6e 73 6c 61 74 69 6f   \...-translatio
8430: 6e 20 6c 66 20 2d 62 75 66 66 65 72 73 69 7a 65  n lf -buffersize
8440: 20 31 36 33 38 34 20 2d 62 75 66 66 65 72 69 6e   16384 -bufferin
8450: 67 20 6c 69 6e 65 5d 0a 20 20 20 20 7d 0a 20 20  g line].    }.  
8460: 20 20 70 72 6f 63 20 72 65 61 64 61 62 6c 65 20    proc readable 
8470: 7b 73 7d 20 7b 0a 09 73 65 74 20 6c 20 5b 67 65  {s} {..set l [ge
8480: 74 73 20 24 73 5d 0a 09 64 70 75 74 73 20 22 67  ts $s]..dputs "g
8490: 6f 74 20 5c 22 5b 73 74 72 69 6e 67 20 72 65 70  ot \"[string rep
84a0: 6c 61 63 65 20 24 6c 20 31 30 20 65 6e 64 2d 33  lace $l 10 end-3
84b0: 20 2e 2e 2e 5d 5c 22 20 5c 0a 09 09 28 5b 73 74   ...]\" \...([st
84c0: 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 6c 5d 29  ring length $l])
84d0: 20 66 72 6f 6d 20 24 73 22 0a 09 66 69 6c 65 65   from $s"..filee
84e0: 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65  vent $s readable
84f0: 20 7b 7d 0a 09 61 66 74 65 72 20 31 30 30 30 20   {}..after 1000 
8500: 72 65 73 70 6f 6e 64 20 24 73 0a 20 20 20 20 7d  respond $s.    }
8510: 0a 20 20 20 20 70 72 6f 63 20 72 65 73 70 6f 6e  .    proc respon
8520: 64 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20  d {s} {..global 
8530: 66 69 72 73 74 62 6c 6f 63 6b 0a 09 64 70 75 74  firstblock..dput
8540: 73 20 22 73 65 6e 64 20 5c 22 5b 73 74 72 69 6e  s "send \"[strin
8550: 67 20 72 65 70 6c 61 63 65 20 24 66 69 72 73 74  g replace $first
8560: 62 6c 6f 63 6b 20 31 30 20 65 6e 64 2d 33 20 2e  block 10 end-3 .
8570: 2e 2e 5d 5c 22 20 5c 0a 09 09 28 5b 73 74 72 69  ..]\" \...([stri
8580: 6e 67 20 6c 65 6e 67 74 68 20 24 66 69 72 73 74  ng length $first
8590: 62 6c 6f 63 6b 5d 29 20 64 6f 77 6e 20 24 73 22  block]) down $s"
85a0: 0a 09 70 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e  ..puts -nonewlin
85b0: 65 20 24 73 20 24 66 69 72 73 74 62 6c 6f 63 6b  e $s $firstblock
85c0: 0a 09 61 66 74 65 72 20 31 30 30 30 20 77 72 69  ..after 1000 wri
85d0: 74 65 64 61 74 61 20 24 73 0a 20 20 20 20 7d 0a  tedata $s.    }.
85e0: 20 20 20 20 70 72 6f 63 20 77 72 69 74 65 64 61      proc writeda
85f0: 74 61 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c  ta {s} {..global
8600: 20 73 65 63 6f 6e 64 62 6c 6f 63 6b 0a 09 64 70   secondblock..dp
8610: 75 74 73 20 22 73 65 6e 64 20 5c 22 5b 73 74 72  uts "send \"[str
8620: 69 6e 67 20 72 65 70 6c 61 63 65 20 24 73 65 63  ing replace $sec
8630: 6f 6e 64 62 6c 6f 63 6b 20 31 30 20 65 6e 64 2d  ondblock 10 end-
8640: 33 20 2e 2e 2e 5d 5c 22 20 5c 0a 09 09 28 5b 73  3 ...]\" \...([s
8650: 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 73 65  tring length $se
8660: 63 6f 6e 64 62 6c 6f 63 6b 5d 29 20 64 6f 77 6e  condblock]) down
8670: 20 24 73 22 0a 09 70 75 74 73 20 2d 6e 6f 6e 65   $s"..puts -none
8680: 77 6c 69 6e 65 20 24 73 20 24 73 65 63 6f 6e 64  wline $s $second
8690: 62 6c 6f 63 6b 0a 09 63 6c 6f 73 65 20 24 73 0a  block..close $s.
86a0: 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 20      }.    set s 
86b0: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09  [tls::socket \..
86c0: 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 73      -certfile $s
86d0: 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c  erverCert -cafil
86e0: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69  e $caCert -keyfi
86f0: 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a  le $serverKey \.
8700: 09 20 20 20 20 2d 73 65 72 76 65 72 20 61 63 63  .    -server acc
8710: 65 70 74 20 38 38 33 32 5d 0a 20 20 20 20 73 65  ept 8832].    se
8720: 74 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74  t c [tls::socket
8730: 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c   \..    -certfil
8740: 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63  e $clientCert -c
8750: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b  afile $caCert -k
8760: 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65  eyfile $clientKe
8770: 79 20 5c 0a 09 20 20 20 20 6c 6f 63 61 6c 68 6f  y \..    localho
8780: 73 74 20 38 38 33 32 5d 0a 20 20 20 20 66 63 6f  st 8832].    fco
8790: 6e 66 69 67 75 72 65 20 24 63 20 2d 62 6c 6f 63  nfigure $c -bloc
87a0: 6b 69 6e 67 20 30 20 2d 74 72 61 6e 73 20 6c 66  king 0 -trans lf
87b0: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65   -buffering line
87c0: 0a 20 20 20 20 73 65 74 20 63 6f 75 6e 74 20 30  .    set count 0
87d0: 0a 20 20 20 20 70 75 74 73 20 24 63 20 68 65 6c  .    puts $c hel
87e0: 6c 6f 0a 20 20 20 20 70 72 6f 63 20 72 65 61 64  lo.    proc read
87f0: 69 74 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c  it {s} {..global
8800: 20 63 6f 75 6e 74 20 64 6f 6e 65 0a 09 73 65 74   count done..set
8810: 20 64 61 74 61 20 5b 72 65 61 64 20 24 73 5d 0a   data [read $s].
8820: 09 64 70 75 74 73 20 22 72 65 61 64 20 5c 22 5b  .dputs "read \"[
8830: 73 74 72 69 6e 67 20 72 65 70 6c 61 63 65 20 24  string replace $
8840: 64 61 74 61 20 31 30 20 65 6e 64 2d 33 20 2e 2e  data 10 end-3 ..
8850: 2e 5d 5c 22 20 5c 0a 09 09 28 5b 73 74 72 69 6e  .]\" \...([strin
8860: 67 20 6c 65 6e 67 74 68 20 24 64 61 74 61 5d 29  g length $data])
8870: 20 66 72 6f 6d 20 24 73 22 0a 09 69 6e 63 72 20   from $s"..incr 
8880: 63 6f 75 6e 74 20 5b 73 74 72 69 6e 67 20 6c 65  count [string le
8890: 6e 67 74 68 20 24 64 61 74 61 5d 0a 09 69 66 20  ngth $data]..if 
88a0: 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 20 20  {[eof $s]} {..  
88b0: 20 20 63 6c 6f 73 65 20 24 73 0a 09 20 20 20 20    close $s..    
88c0: 73 65 74 20 64 6f 6e 65 20 31 0a 09 7d 0a 20 20  set done 1..}.  
88d0: 20 20 7d 0a 20 20 20 20 66 69 6c 65 65 76 65 6e    }.    fileeven
88e0: 74 20 24 63 20 72 65 61 64 61 62 6c 65 20 22 72  t $c readable "r
88f0: 65 61 64 69 74 20 24 63 22 0a 20 20 20 20 73 65  eadit $c".    se
8900: 74 20 64 6f 6e 65 20 30 0a 20 20 20 20 73 65 74  t done 0.    set
8910: 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 31 30   timer [after 10
8920: 30 30 30 20 22 73 65 74 20 64 6f 6e 65 20 74 69  000 "set done ti
8930: 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 76 77  med_out"].    vw
8940: 61 69 74 20 64 6f 6e 65 0a 20 20 20 20 61 66 74  ait done.    aft
8950: 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72  er cancel $timer
8960: 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20  .    close $s.  
8970: 20 20 6c 69 73 74 20 24 63 6f 75 6e 74 20 24 64    list $count $d
8980: 6f 6e 65 0a 7d 20 7b 36 35 35 36 36 20 31 7d 0a  one.} {65566 1}.
8990: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 39 2e 33 20  .test tlsIO-9.3 
89a0: 7b 74 65 73 74 69 6e 67 20 45 4f 46 20 73 74 69  {testing EOF sti
89b0: 63 6b 79 6e 65 73 73 7d 20 7b 75 6e 65 78 70 6c  ckyness} {unexpl
89c0: 61 69 6e 65 64 46 61 69 6c 75 72 65 20 73 6f 63  ainedFailure soc
89d0: 6b 65 74 7d 20 7b 0a 20 20 20 20 23 20 48 4f 42  ket} {.    # HOB
89e0: 42 53 3a 20 6e 65 76 65 72 20 77 6f 72 6b 65 64  BS: never worked
89f0: 20 63 6f 72 72 65 63 74 6c 79 0a 20 20 20 20 70   correctly.    p
8a00: 72 6f 63 20 63 6f 75 6e 74 5f 74 6f 5f 65 6f 66  roc count_to_eof
8a10: 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 63   {s} {..global c
8a20: 6f 75 6e 74 20 64 6f 6e 65 20 74 69 6d 65 72 0a  ount done timer.
8a30: 09 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 5d  .set l [gets $s]
8a40: 0a 09 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20  ..if {[eof $s]} 
8a50: 7b 0a 09 20 20 20 20 69 6e 63 72 20 63 6f 75 6e  {..    incr coun
8a60: 74 0a 09 20 20 20 20 69 66 20 7b 24 63 6f 75 6e  t..    if {$coun
8a70: 74 20 3e 20 39 7d 20 7b 0a 09 09 63 6c 6f 73 65  t > 9} {...close
8a80: 20 24 73 0a 09 09 73 65 74 20 64 6f 6e 65 20 74   $s...set done t
8a90: 72 75 65 0a 09 09 73 65 74 20 63 6f 75 6e 74 20  rue...set count 
8aa0: 7b 65 6f 66 20 69 73 20 73 74 69 63 6b 79 7d 0a  {eof is sticky}.
8ab0: 09 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24  ..after cancel $
8ac0: 74 69 6d 65 72 0a 09 20 20 20 20 7d 0a 09 7d 0a  timer..    }..}.
8ad0: 20 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 74      }.    proc t
8ae0: 69 6d 65 72 70 72 6f 63 20 7b 7d 20 7b 0a 09 67  imerproc {} {..g
8af0: 6c 6f 62 61 6c 20 64 6f 6e 65 20 63 6f 75 6e 74  lobal done count
8b00: 20 63 0a 09 73 65 74 20 64 6f 6e 65 20 74 72 75   c..set done tru
8b10: 65 0a 09 73 65 74 20 63 6f 75 6e 74 20 7b 74 69  e..set count {ti
8b20: 6d 65 72 20 77 65 6e 74 20 6f 66 66 2c 20 65 6f  mer went off, eo
8b30: 66 20 69 73 20 6e 6f 74 20 73 74 69 63 6b 79 7d  f is not sticky}
8b40: 0a 09 63 6c 6f 73 65 20 24 63 0a 20 20 20 20 7d  ..close $c.    }
8b50: 09 0a 20 20 20 20 73 65 74 20 63 6f 75 6e 74 20  ..    set count 
8b60: 30 0a 20 20 20 20 73 65 74 20 64 6f 6e 65 20 66  0.    set done f
8b70: 61 6c 73 65 0a 20 20 20 20 70 72 6f 63 20 77 72  alse.    proc wr
8b80: 69 74 65 5f 74 68 65 6e 5f 63 6c 6f 73 65 20 7b  ite_then_close {
8b90: 73 7d 20 7b 0a 09 70 75 74 73 20 24 73 20 62 79  s} {..puts $s by
8ba0: 65 0a 09 63 6c 6f 73 65 20 24 73 0a 20 20 20 20  e..close $s.    
8bb0: 7d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 70  }.    proc accep
8bc0: 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 66 63 6f  t {s a p} {..fco
8bd0: 6e 66 69 67 75 72 65 20 24 73 20 2d 62 6c 6f 63  nfigure $s -bloc
8be0: 6b 69 6e 67 20 30 20 2d 62 75 66 66 65 72 69 6e  king 0 -bufferin
8bf0: 67 20 6c 69 6e 65 20 2d 74 72 61 6e 73 6c 61 74  g line -translat
8c00: 69 6f 6e 20 6c 66 0a 09 66 69 6c 65 65 76 65 6e  ion lf..fileeven
8c10: 74 20 24 73 20 77 72 69 74 61 62 6c 65 20 5b 6c  t $s writable [l
8c20: 69 73 74 20 64 6f 5f 68 61 6e 64 73 68 61 6b 65  ist do_handshake
8c30: 20 24 73 20 77 72 69 74 61 62 6c 65 20 77 72 69   $s writable wri
8c40: 74 65 5f 74 68 65 6e 5f 63 6c 6f 73 65 20 5c 0a  te_then_close \.
8c50: 09 09 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e  ..-buffering lin
8c60: 65 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 6c  e -translation l
8c70: 66 5d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74  f].    }.    set
8c80: 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20   s [tls::socket 
8c90: 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65  \..    -certfile
8ca0: 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61   $serverCert -ca
8cb0: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65  file $caCert -ke
8cc0: 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79  yfile $serverKey
8cd0: 20 5c 0a 09 20 20 20 20 2d 73 65 72 76 65 72 20   \..    -server 
8ce0: 61 63 63 65 70 74 20 38 38 33 33 5d 0a 20 20 20  accept 8833].   
8cf0: 20 73 65 74 20 63 20 5b 74 6c 73 3a 3a 73 6f 63   set c [tls::soc
8d00: 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74  ket \..    -cert
8d10: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74  file $clientCert
8d20: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74   -cafile $caCert
8d30: 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e   -keyfile $clien
8d40: 74 4b 65 79 20 5c 0a 09 20 20 20 20 6c 6f 63 61  tKey \..    loca
8d50: 6c 68 6f 73 74 20 38 38 33 33 5d 0a 20 20 20 20  lhost 8833].    
8d60: 66 63 6f 6e 66 69 67 75 72 65 20 24 63 20 2d 62  fconfigure $c -b
8d70: 6c 6f 63 6b 69 6e 67 20 30 20 2d 62 75 66 66 65  locking 0 -buffe
8d80: 72 69 6e 67 20 6c 69 6e 65 20 2d 74 72 61 6e 73  ring line -trans
8d90: 6c 61 74 69 6f 6e 20 6c 66 0a 20 20 20 20 66 69  lation lf.    fi
8da0: 6c 65 65 76 65 6e 74 20 24 63 20 72 65 61 64 61  leevent $c reada
8db0: 62 6c 65 20 22 63 6f 75 6e 74 5f 74 6f 5f 65 6f  ble "count_to_eo
8dc0: 66 20 24 63 22 0a 20 20 20 20 73 65 74 20 74 69  f $c".    set ti
8dd0: 6d 65 72 20 5b 61 66 74 65 72 20 32 30 30 30 20  mer [after 2000 
8de0: 74 69 6d 65 72 70 72 6f 63 5d 0a 20 20 20 20 76  timerproc].    v
8df0: 77 61 69 74 20 64 6f 6e 65 0a 20 20 20 20 63 6c  wait done.    cl
8e00: 6f 73 65 20 24 73 0a 20 20 20 20 73 65 74 20 63  ose $s.    set c
8e10: 6f 75 6e 74 0a 7d 20 7b 65 6f 66 20 69 73 20 73  ount.} {eof is s
8e20: 74 69 63 6b 79 7d 0a 0a 72 65 6d 6f 76 65 46 69  ticky}..removeFi
8e30: 6c 65 20 73 63 72 69 70 74 0a 0a 74 65 73 74 20  le script..test 
8e40: 74 6c 73 49 4f 2d 31 30 2e 31 20 7b 74 65 73 74  tlsIO-10.1 {test
8e50: 69 6e 67 20 73 6f 63 6b 65 74 20 61 63 63 65 70  ing socket accep
8e60: 74 20 63 61 6c 6c 62 61 63 6b 20 65 72 72 6f 72  t callback error
8e70: 20 68 61 6e 64 6c 69 6e 67 7d 20 7b 73 6f 63 6b   handling} {sock
8e80: 65 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 67 6f  et} {.    set go
8e90: 74 65 72 72 6f 72 20 30 0a 20 20 20 20 70 72 6f  terror 0.    pro
8ea0: 63 20 62 67 65 72 72 6f 72 20 61 72 67 73 20 7b  c bgerror args {
8eb0: 67 6c 6f 62 61 6c 20 67 6f 74 65 72 72 6f 72 3b  global goterror;
8ec0: 20 73 65 74 20 67 6f 74 65 72 72 6f 72 20 31 7d   set goterror 1}
8ed0: 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a  .    set s [tls:
8ee0: 3a 73 6f 63 6b 65 74 20 2d 63 61 66 69 6c 65 20  :socket -cafile 
8ef0: 24 63 61 43 65 72 74 20 2d 73 65 72 76 65 72 20  $caCert -server 
8f00: 61 63 63 65 70 74 20 38 38 39 38 5d 0a 20 20 20  accept 8898].   
8f10: 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20   proc accept {s 
8f20: 61 20 70 7d 20 7b 63 6c 6f 73 65 20 24 73 3b 20  a p} {close $s; 
8f30: 65 72 72 6f 72 7d 0a 20 20 20 20 73 65 74 20 63  error}.    set c
8f40: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63   [tls::socket -c
8f50: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 31 32  afile $caCert 12
8f60: 37 2e 30 2e 30 2e 31 20 38 38 39 38 5d 0a 20 20  7.0.0.1 8898].  
8f70: 20 20 76 77 61 69 74 20 67 6f 74 65 72 72 6f 72    vwait goterror
8f80: 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20  .    close $s.  
8f90: 20 20 63 6c 6f 73 65 20 24 63 0a 20 20 20 20 73    close $c.    s
8fa0: 65 74 20 67 6f 74 65 72 72 6f 72 0a 7d 20 31 0a  et goterror.} 1.
8fb0: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e 31  .test tlsIO-11.1
8fc0: 20 7b 74 63 70 20 63 6f 6e 6e 65 63 74 69 6f 6e   {tcp connection
8fd0: 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74  } {socket doTest
8fe0: 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65  sWithRemoteServe
8ff0: 72 7d 20 7b 0a 20 20 20 20 73 65 6e 64 43 65 72  r} {.    sendCer
9000: 74 56 61 6c 75 65 73 0a 20 20 20 20 73 65 6e 64  tValues.    send
9010: 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 73  Command {..set s
9020: 6f 63 6b 65 74 39 5f 31 5f 74 65 73 74 5f 73 65  ocket9_1_test_se
9030: 72 76 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65  rver [tls::socke
9040: 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74  t -server accept
9050: 20 5c 0a 09 09 2d 63 65 72 74 66 69 6c 65 20 24   \...-certfile $
9060: 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69  serverCert -cafi
9070: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66  le $caCert -keyf
9080: 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 38  ile $serverKey 8
9090: 38 33 34 5d 0a 09 70 72 6f 63 20 61 63 63 65 70  834]..proc accep
90a0: 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 20  t {s a p} {..   
90b0: 20 74 6c 73 3a 3a 68 61 6e 64 73 68 61 6b 65 20   tls::handshake 
90c0: 24 73 0a 09 20 20 20 20 70 75 74 73 20 24 73 20  $s..    puts $s 
90d0: 64 6f 6e 65 0a 09 20 20 20 20 63 6c 6f 73 65 20  done..    close 
90e0: 24 73 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20  $s..}.    }.    
90f0: 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b  set s [tls::sock
9100: 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66  et \..    -certf
9110: 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20  ile $clientCert 
9120: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20  -cafile $caCert 
9130: 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74  -keyfile $client
9140: 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f  Key \..    $remo
9150: 74 65 53 65 72 76 65 72 49 50 20 38 38 33 34 5d  teServerIP 8834]
9160: 0a 20 20 20 20 73 65 74 20 72 20 5b 67 65 74 73  .    set r [gets
9170: 20 24 73 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24   $s].    close $
9180: 73 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e  s.    sendComman
9190: 64 20 7b 63 6c 6f 73 65 20 24 73 6f 63 6b 65 74  d {close $socket
91a0: 39 5f 31 5f 74 65 73 74 5f 73 65 72 76 65 72 7d  9_1_test_server}
91b0: 0a 20 20 20 20 73 65 74 20 72 0a 7d 20 64 6f 6e  .    set r.} don
91c0: 65 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 31  e..test tlsIO-11
91d0: 2e 32 20 7b 63 6c 69 65 6e 74 20 73 70 65 63 69  .2 {client speci
91e0: 66 69 65 73 20 69 74 73 20 70 6f 72 74 7d 20 7b  fies its port} {
91f0: 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69  socket doTestsWi
9200: 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20  thRemoteServer} 
9210: 7b 0a 20 20 20 20 69 66 20 7b 5b 69 6e 66 6f 20  {.    if {[info 
9220: 65 78 69 73 74 73 20 70 6f 72 74 5d 7d 20 7b 0a  exists port]} {.
9230: 09 69 6e 63 72 20 70 6f 72 74 0a 20 20 20 20 7d  .incr port.    }
9240: 20 65 6c 73 65 20 7b 0a 09 73 65 74 20 70 6f 72   else {..set por
9250: 74 20 5b 65 78 70 72 20 7b 24 74 6c 73 53 65 72  t [expr {$tlsSer
9260: 76 65 72 50 6f 72 74 20 2b 20 5b 70 69 64 5d 25  verPort + [pid]%
9270: 31 30 32 34 7d 5d 0a 20 20 20 20 7d 0a 20 20 20  1024}].    }.   
9280: 20 73 65 6e 64 43 65 72 74 56 61 6c 75 65 73 0a   sendCertValues.
9290: 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20      sendCommand 
92a0: 7b 0a 09 73 65 74 20 73 6f 63 6b 65 74 39 5f 32  {..set socket9_2
92b0: 5f 74 65 73 74 5f 73 65 72 76 65 72 20 5b 74 6c  _test_server [tl
92c0: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65  s::socket -serve
92d0: 72 20 61 63 63 65 70 74 20 5c 0a 09 09 2d 63 65  r accept \...-ce
92e0: 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65  rtfile $serverCe
92f0: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65  rt -cafile $caCe
9300: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72  rt -keyfile $ser
9310: 76 65 72 4b 65 79 20 38 38 33 35 5d 0a 09 70 72  verKey 8835]..pr
9320: 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70  oc accept {s a p
9330: 7d 20 7b 0a 09 20 20 20 20 74 6c 73 3a 3a 68 61  } {..    tls::ha
9340: 6e 64 73 68 61 6b 65 20 24 73 0a 09 20 20 20 20  ndshake $s..    
9350: 70 75 74 73 20 24 73 20 24 70 0a 09 20 20 20 20  puts $s $p..    
9360: 63 6c 6f 73 65 20 24 73 0a 09 7d 0a 20 20 20 20  close $s..}.    
9370: 7d 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73  }.    set s [tls
9380: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20  ::socket \..    
9390: 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e  -certfile $clien
93a0: 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63  tCert -cafile $c
93b0: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24  aCert -keyfile $
93c0: 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20  clientKey \..   
93d0: 20 2d 6d 79 70 6f 72 74 20 24 70 6f 72 74 20 24   -myport $port $
93e0: 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 38  remoteServerIP 8
93f0: 38 33 35 5d 0a 20 20 20 20 73 65 74 20 72 20 5b  835].    set r [
9400: 67 65 74 73 20 24 73 5d 0a 20 20 20 20 63 6c 6f  gets $s].    clo
9410: 73 65 20 24 73 0a 20 20 20 20 73 65 6e 64 43 6f  se $s.    sendCo
9420: 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 73 6f  mmand {close $so
9430: 63 6b 65 74 39 5f 32 5f 74 65 73 74 5f 73 65 72  cket9_2_test_ser
9440: 76 65 72 7d 0a 20 20 20 20 69 66 20 7b 24 72 20  ver}.    if {$r 
9450: 3d 3d 20 24 70 6f 72 74 7d 20 7b 0a 09 73 65 74  == $port} {..set
9460: 20 72 65 73 75 6c 74 20 6f 6b 0a 20 20 20 20 7d   result ok.    }
9470: 20 65 6c 73 65 20 7b 0a 09 73 65 74 20 72 65 73   else {..set res
9480: 75 6c 74 20 62 72 6f 6b 65 6e 0a 20 20 20 20 7d  ult broken.    }
9490: 0a 20 20 20 20 73 65 74 20 72 65 73 75 6c 74 0a  .    set result.
94a0: 7d 20 6f 6b 0a 0a 74 65 73 74 20 74 6c 73 49 4f  } ok..test tlsIO
94b0: 2d 31 31 2e 33 20 7b 74 72 79 69 6e 67 20 74 6f  -11.3 {trying to
94c0: 20 63 6f 6e 6e 65 63 74 2c 20 6e 6f 20 73 65 72   connect, no ser
94d0: 76 65 72 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54  ver} {socket doT
94e0: 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65  estsWithRemoteSe
94f0: 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 74 20  rver} {.    set 
9500: 73 74 61 74 75 73 20 6f 6b 0a 20 20 20 20 69 66  status ok.    if
9510: 20 7b 21 5b 63 61 74 63 68 20 7b 73 65 74 20 73   {![catch {set s
9520: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a   [tls::socket \.
9530: 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24  .    -certfile $
9540: 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69  clientCert -cafi
9550: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66  le $caCert -keyf
9560: 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c  ile $clientKey \
9570: 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 65 72  ..    $remoteSer
9580: 76 65 72 49 70 20 38 38 33 36 5d 7d 5d 7d 20 7b  verIp 8836]}]} {
9590: 0a 09 69 66 20 7b 21 5b 63 61 74 63 68 20 7b 67  ..if {![catch {g
95a0: 65 74 73 20 24 73 7d 5d 7d 20 7b 0a 09 20 20 20  ets $s}]} {..   
95b0: 20 73 65 74 20 73 74 61 74 75 73 20 62 72 6f 6b   set status brok
95c0: 65 6e 0a 09 7d 0a 09 63 6c 6f 73 65 20 24 73 0a  en..}..close $s.
95d0: 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 74      }.    set st
95e0: 61 74 75 73 0a 7d 20 6f 6b 0a 0a 74 65 73 74 20  atus.} ok..test 
95f0: 74 6c 73 49 4f 2d 31 31 2e 34 20 7b 72 65 6d 6f  tlsIO-11.4 {remo
9600: 74 65 20 65 63 68 6f 2c 20 6f 6e 65 20 6c 69 6e  te echo, one lin
9610: 65 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73  e} {socket doTes
9620: 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76  tsWithRemoteServ
9630: 65 72 7d 20 7b 0a 20 20 20 20 73 65 6e 64 43 65  er} {.    sendCe
9640: 72 74 56 61 6c 75 65 73 0a 20 20 20 20 73 65 6e  rtValues.    sen
9650: 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20  dCommand {..set 
9660: 73 6f 63 6b 65 74 31 30 5f 36 5f 74 65 73 74 5f  socket10_6_test_
9670: 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 6f 63  server [tls::soc
9680: 6b 65 74 20 5c 0a 09 09 2d 63 65 72 74 66 69 6c  ket \...-certfil
9690: 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63  e $serverCert -c
96a0: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b  afile $caCert -k
96b0: 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65  eyfile $serverKe
96c0: 79 20 5c 0a 09 09 2d 73 65 72 76 65 72 20 61 63  y \...-server ac
96d0: 63 65 70 74 20 38 38 33 36 5d 0a 09 70 72 6f 63  cept 8836]..proc
96e0: 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20   accept {s a p} 
96f0: 7b 0a 09 20 20 20 20 74 6c 73 3a 3a 68 61 6e 64  {..    tls::hand
9700: 73 68 61 6b 65 20 24 73 0a 09 20 20 20 20 66 69  shake $s..    fi
9710: 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61  leevent $s reada
9720: 62 6c 65 20 5b 6c 69 73 74 20 65 63 68 6f 20 24  ble [list echo $
9730: 73 5d 0a 09 20 20 20 20 66 63 6f 6e 66 69 67 75  s]..    fconfigu
9740: 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e 67  re $s -buffering
9750: 20 6c 69 6e 65 20 2d 74 72 61 6e 73 6c 61 74 69   line -translati
9760: 6f 6e 20 63 72 6c 66 0a 09 7d 0a 09 70 72 6f 63  on crlf..}..proc
9770: 20 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 20 20 20   echo {s} {..   
9780: 20 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 5d   set l [gets $s]
9790: 0a 09 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 24  ..    if {[eof $
97a0: 73 5d 7d 20 7b 0a 09 09 63 6c 6f 73 65 20 24 73  s]} {...close $s
97b0: 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09  ..    } else {..
97c0: 09 70 75 74 73 20 24 73 20 24 6c 0a 09 20 20 20  .puts $s $l..   
97d0: 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20   }..}.    }.    
97e0: 73 65 74 20 66 20 5b 74 6c 73 3a 3a 73 6f 63 6b  set f [tls::sock
97f0: 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66  et \..    -certf
9800: 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20  ile $clientCert 
9810: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20  -cafile $caCert 
9820: 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74  -keyfile $client
9830: 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f  Key \..    $remo
9840: 74 65 53 65 72 76 65 72 49 50 20 38 38 33 36 5d  teServerIP 8836]
9850: 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20  .    fconfigure 
9860: 24 66 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20  $f -translation 
9870: 63 72 6c 66 20 2d 62 75 66 66 65 72 69 6e 67 20  crlf -buffering 
9880: 6c 69 6e 65 0a 20 20 20 20 70 75 74 73 20 24 66  line.    puts $f
9890: 20 68 65 6c 6c 6f 0a 20 20 20 20 73 65 74 20 72   hello.    set r
98a0: 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 20 63   [gets $f].    c
98b0: 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 6e 64  lose $f.    send
98c0: 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24  Command {close $
98d0: 73 6f 63 6b 65 74 31 30 5f 36 5f 74 65 73 74 5f  socket10_6_test_
98e0: 73 65 72 76 65 72 7d 0a 20 20 20 20 73 65 74 20  server}.    set 
98f0: 72 0a 7d 20 68 65 6c 6c 6f 0a 0a 74 65 73 74 20  r.} hello..test 
9900: 74 6c 73 49 4f 2d 31 31 2e 35 20 7b 72 65 6d 6f  tlsIO-11.5 {remo
9910: 74 65 20 65 63 68 6f 2c 20 35 30 20 6c 69 6e 65  te echo, 50 line
9920: 73 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73  s} {socket doTes
9930: 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76  tsWithRemoteServ
9940: 65 72 7d 20 7b 0a 20 20 20 20 73 65 6e 64 43 65  er} {.    sendCe
9950: 72 74 56 61 6c 75 65 73 0a 20 20 20 20 73 65 6e  rtValues.    sen
9960: 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20  dCommand {..set 
9970: 73 6f 63 6b 65 74 31 30 5f 37 5f 74 65 73 74 5f  socket10_7_test_
9980: 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 6f 63  server [tls::soc
9990: 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65  ket -server acce
99a0: 70 74 20 5c 0a 09 09 2d 63 65 72 74 66 69 6c 65  pt \...-certfile
99b0: 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61   $serverCert -ca
99c0: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65  file $caCert -ke
99d0: 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79  yfile $serverKey
99e0: 20 38 38 33 36 5d 0a 09 70 72 6f 63 20 61 63 63   8836]..proc acc
99f0: 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20  ept {s a p} {.. 
9a00: 20 20 20 74 6c 73 3a 3a 68 61 6e 64 73 68 61 6b     tls::handshak
9a10: 65 20 24 73 0a 09 20 20 20 20 66 69 6c 65 65 76  e $s..    fileev
9a20: 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20  ent $s readable 
9a30: 5b 6c 69 73 74 20 65 63 68 6f 20 24 73 5d 0a 09  [list echo $s]..
9a40: 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24      fconfigure $
9a50: 73 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e  s -buffering lin
9a60: 65 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 63  e -translation c
9a70: 72 6c 66 0a 09 7d 0a 09 70 72 6f 63 20 65 63 68  rlf..}..proc ech
9a80: 6f 20 7b 73 7d 20 7b 0a 09 20 20 20 20 73 65 74  o {s} {..    set
9a90: 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a 09 20 20   l [gets $s]..  
9aa0: 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20    if {[eof $s]} 
9ab0: 7b 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 20 20  {...close $s..  
9ac0: 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 70 75 74    } else {...put
9ad0: 73 20 24 73 20 24 6c 0a 09 20 20 20 20 7d 0a 09  s $s $l..    }..
9ae0: 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20  }.    }.    set 
9af0: 66 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c  f [tls::socket \
9b00: 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20  ..    -certfile 
9b10: 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66  $clientCert -caf
9b20: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79  ile $caCert -key
9b30: 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20  file $clientKey 
9b40: 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 65  \..    $remoteSe
9b50: 72 76 65 72 49 50 20 38 38 33 36 5d 0a 20 20 20  rverIP 8836].   
9b60: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 66 20 2d   fconfigure $f -
9b70: 74 72 61 6e 73 6c 61 74 69 6f 6e 20 63 72 6c 66  translation crlf
9b80: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65   -buffering line
9b90: 0a 20 20 20 20 66 6f 72 20 7b 73 65 74 20 63 6e  .    for {set cn
9ba0: 74 20 30 7d 20 7b 24 63 6e 74 20 3c 20 35 30 7d  t 0} {$cnt < 50}
9bb0: 20 7b 69 6e 63 72 20 63 6e 74 7d 20 7b 0a 09 70   {incr cnt} {..p
9bc0: 75 74 73 20 24 66 20 22 68 65 6c 6c 6f 2c 20 24  uts $f "hello, $
9bd0: 63 6e 74 22 0a 09 69 66 20 7b 5b 73 74 72 69 6e  cnt"..if {[strin
9be0: 67 20 63 6f 6d 70 61 72 65 20 5b 67 65 74 73 20  g compare [gets 
9bf0: 24 66 5d 20 22 68 65 6c 6c 6f 2c 20 24 63 6e 74  $f] "hello, $cnt
9c00: 22 5d 20 21 3d 20 30 7d 20 7b 0a 09 20 20 20 20  "] != 0} {..    
9c10: 62 72 65 61 6b 0a 09 7d 0a 20 20 20 20 7d 0a 20  break..}.    }. 
9c20: 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20     close $f.    
9c30: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f  sendCommand {clo
9c40: 73 65 20 24 73 6f 63 6b 65 74 31 30 5f 37 5f 74  se $socket10_7_t
9c50: 65 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 20  est_server}.    
9c60: 73 65 74 20 63 6e 74 0a 7d 20 35 30 0a 0a 23 20  set cnt.} 50..# 
9c70: 4d 61 63 69 6e 74 6f 73 68 20 73 6f 63 6b 65 74  Macintosh socket
9c80: 73 20 63 61 6e 20 68 61 76 65 20 6d 6f 72 65 20  s can have more 
9c90: 74 68 61 6e 20 6f 6e 65 20 73 65 72 76 65 72 20  than one server 
9ca0: 70 65 72 20 70 6f 72 74 0a 69 66 20 7b 24 74 63  per port.if {$tc
9cb0: 6c 5f 70 6c 61 74 66 6f 72 6d 28 70 6c 61 74 66  l_platform(platf
9cc0: 6f 72 6d 29 20 3d 3d 20 22 6d 61 63 69 6e 74 6f  orm) == "macinto
9cd0: 73 68 22 7d 20 7b 0a 20 20 20 20 73 65 74 20 63  sh"} {.    set c
9ce0: 6f 6e 66 6c 69 63 74 52 65 73 75 6c 74 20 7b 30  onflictResult {0
9cf0: 20 38 38 33 36 7d 0a 7d 20 65 6c 73 65 20 7b 0a   8836}.} else {.
9d00: 20 20 20 20 73 65 74 20 63 6f 6e 66 6c 69 63 74      set conflict
9d10: 52 65 73 75 6c 74 20 7b 31 20 7b 63 6f 75 6c 64  Result {1 {could
9d20: 6e 27 74 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a  n't open socket:
9d30: 20 61 64 64 72 65 73 73 20 61 6c 72 65 61 64 79   address already
9d40: 20 69 6e 20 75 73 65 7d 7d 0a 7d 0a 0a 74 65 73   in use}}.}..tes
9d50: 74 20 74 6c 73 49 4f 2d 31 31 2e 36 20 7b 73 6f  t tlsIO-11.6 {so
9d60: 63 6b 65 74 20 63 6f 6e 66 6c 69 63 74 7d 20 7b  cket conflict} {
9d70: 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69  socket doTestsWi
9d80: 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20  thRemoteServer} 
9d90: 7b 0a 20 20 20 20 73 65 74 20 73 31 20 5b 74 6c  {.    set s1 [tl
9da0: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20  s::socket \..   
9db0: 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76   -certfile $serv
9dc0: 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24  erCert -cafile $
9dd0: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20  caCert -keyfile 
9de0: 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 20 20  $serverKey \..  
9df0: 20 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74    -server accept
9e00: 20 38 38 33 36 5d 0a 20 20 20 20 69 66 20 7b 5b   8836].    if {[
9e10: 63 61 74 63 68 20 7b 73 65 74 20 73 32 20 5b 74  catch {set s2 [t
9e20: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20  ls::socket \..  
9e30: 20 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72    -certfile $ser
9e40: 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20  verCert -cafile 
9e50: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65  $caCert -keyfile
9e60: 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 20   $serverKey \.. 
9e70: 20 20 20 2d 73 65 72 76 65 72 20 61 63 63 65 70     -server accep
9e80: 74 20 38 38 33 36 5d 7d 20 6d 73 67 5d 7d 20 7b  t 8836]} msg]} {
9e90: 0a 09 73 65 74 20 72 65 73 75 6c 74 20 5b 6c 69  ..set result [li
9ea0: 73 74 20 31 20 24 6d 73 67 5d 0a 20 20 20 20 7d  st 1 $msg].    }
9eb0: 20 65 6c 73 65 20 7b 0a 09 73 65 74 20 72 65 73   else {..set res
9ec0: 75 6c 74 20 5b 6c 69 73 74 20 30 20 5b 6c 69 6e  ult [list 0 [lin
9ed0: 64 65 78 20 5b 66 63 6f 6e 66 69 67 75 72 65 20  dex [fconfigure 
9ee0: 24 73 32 20 2d 73 6f 63 6b 6e 61 6d 65 5d 20 32  $s2 -sockname] 2
9ef0: 5d 5d 0a 09 63 6c 6f 73 65 20 24 73 32 0a 20 20  ]]..close $s2.  
9f00: 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73    }.    close $s
9f10: 31 0a 20 20 20 20 73 65 74 20 72 65 73 75 6c 74  1.    set result
9f20: 0a 7d 20 24 63 6f 6e 66 6c 69 63 74 52 65 73 75  .} $conflictResu
9f30: 6c 74 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31  lt..test tlsIO-1
9f40: 31 2e 37 20 7b 73 65 72 76 65 72 20 77 69 74 68  1.7 {server with
9f50: 20 73 65 76 65 72 61 6c 20 63 6c 69 65 6e 74 73   several clients
9f60: 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74  } {socket doTest
9f70: 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65  sWithRemoteServe
9f80: 72 7d 20 7b 0a 20 20 20 20 73 65 6e 64 43 65 72  r} {.    sendCer
9f90: 74 56 61 6c 75 65 73 0a 20 20 20 20 73 65 6e 64  tValues.    send
9fa0: 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 73  Command {..set s
9fb0: 6f 63 6b 65 74 31 30 5f 39 5f 74 65 73 74 5f 73  ocket10_9_test_s
9fc0: 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b  erver [tls::sock
9fd0: 65 74 20 5c 0a 09 09 2d 63 65 72 74 66 69 6c 65  et \...-certfile
9fe0: 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61   $serverCert -ca
9ff0: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65  file $caCert -ke
a000: 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79  yfile $serverKey
a010: 20 5c 0a 09 09 2d 73 65 72 76 65 72 20 61 63 63   \...-server acc
a020: 65 70 74 20 38 38 33 36 5d 0a 09 70 72 6f 63 20  ept 8836]..proc 
a030: 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b  accept {s a p} {
a040: 0a 09 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65  ..    fconfigure
a050: 20 24 73 20 2d 62 75 66 66 65 72 69 6e 67 20 6c   $s -buffering l
a060: 69 6e 65 0a 09 20 20 20 20 66 69 6c 65 65 76 65  ine..    fileeve
a070: 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 5b  nt $s readable [
a080: 6c 69 73 74 20 65 63 68 6f 20 24 73 5d 0a 09 7d  list echo $s]..}
a090: 0a 09 70 72 6f 63 20 65 63 68 6f 20 7b 73 7d 20  ..proc echo {s} 
a0a0: 7b 0a 09 20 20 20 20 73 65 74 20 6c 20 5b 67 65  {..    set l [ge
a0b0: 74 73 20 24 73 5d 0a 09 20 20 20 20 69 66 20 7b  ts $s]..    if {
a0c0: 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 09 63 6c  [eof $s]} {...cl
a0d0: 6f 73 65 20 24 73 0a 09 20 20 20 20 7d 20 65 6c  ose $s..    } el
a0e0: 73 65 20 7b 0a 09 09 70 75 74 73 20 24 73 20 24  se {...puts $s $
a0f0: 6c 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 20 20 20  l..    }..}.    
a100: 7d 0a 20 20 20 20 73 65 74 20 73 31 20 5b 74 6c  }.    set s1 [tl
a110: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20  s::socket \..   
a120: 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65   -certfile $clie
a130: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24  ntCert -cafile $
a140: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20  caCert -keyfile 
a150: 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20  $clientKey \..  
a160: 20 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49    $remoteServerI
a170: 50 20 38 38 33 36 5d 0a 20 20 20 20 66 63 6f 6e  P 8836].    fcon
a180: 66 69 67 75 72 65 20 24 73 31 20 2d 62 75 66 66  figure $s1 -buff
a190: 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 73  ering line.    s
a1a0: 65 74 20 73 32 20 5b 74 6c 73 3a 3a 73 6f 63 6b  et s2 [tls::sock
a1b0: 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66  et \..    -certf
a1c0: 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20  ile $clientCert 
a1d0: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20  -cafile $caCert 
a1e0: 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74  -keyfile $client
a1f0: 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f  Key \..    $remo
a200: 74 65 53 65 72 76 65 72 49 50 20 38 38 33 36 5d  teServerIP 8836]
a210: 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20  .    fconfigure 
a220: 24 73 32 20 2d 62 75 66 66 65 72 69 6e 67 20 6c  $s2 -buffering l
a230: 69 6e 65 0a 20 20 20 20 73 65 74 20 73 33 20 5b  ine.    set s3 [
a240: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20  tls::socket \.. 
a250: 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c     -certfile $cl
a260: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65  ientCert -cafile
a270: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c   $caCert -keyfil
a280: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09  e $clientKey \..
a290: 20 20 20 20 24 72 65 6d 6f 74 65 53 65 72 76 65      $remoteServe
a2a0: 72 49 50 20 38 38 33 36 5d 0a 20 20 20 20 66 63  rIP 8836].    fc
a2b0: 6f 6e 66 69 67 75 72 65 20 24 73 33 20 2d 62 75  onfigure $s3 -bu
a2c0: 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20  ffering line.   
a2d0: 20 66 6f 72 20 7b 73 65 74 20 69 20 30 7d 20 7b   for {set i 0} {
a2e0: 24 69 20 3c 20 31 30 30 7d 20 7b 69 6e 63 72 20  $i < 100} {incr 
a2f0: 69 7d 20 7b 0a 09 70 75 74 73 20 24 73 31 20 68  i} {..puts $s1 h
a300: 65 6c 6c 6f 2c 74 6c 73 49 4f 2d 31 31 2e 37 2c  ello,tlsIO-11.7,
a310: 73 31 0a 09 67 65 74 73 20 24 73 31 0a 09 70 75  s1..gets $s1..pu
a320: 74 73 20 24 73 32 20 68 65 6c 6c 6f 2c 74 6c 73  ts $s2 hello,tls
a330: 49 4f 2d 31 31 2e 37 2c 73 32 0a 09 67 65 74 73  IO-11.7,s2..gets
a340: 20 24 73 32 0a 09 70 75 74 73 20 24 73 33 20 68   $s2..puts $s3 h
a350: 65 6c 6c 6f 2c 74 6c 73 49 4f 2d 31 31 2e 37 2c  ello,tlsIO-11.7,
a360: 73 33 0a 09 67 65 74 73 20 24 73 33 0a 20 20 20  s3..gets $s3.   
a370: 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 31   }.    close $s1
a380: 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 32 0a 20  .    close $s2. 
a390: 20 20 20 63 6c 6f 73 65 20 24 73 33 0a 20 20 20     close $s3.   
a3a0: 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c   sendCommand {cl
a3b0: 6f 73 65 20 24 73 6f 63 6b 65 74 31 30 5f 39 5f  ose $socket10_9_
a3c0: 74 65 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 20  test_server}.   
a3d0: 20 73 65 74 20 69 0a 7d 20 31 30 30 20 20 20 20   set i.} 100    
a3e0: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e  ..test tlsIO-11.
a3f0: 38 20 7b 63 6c 69 65 6e 74 20 77 69 74 68 20 73  8 {client with s
a400: 65 76 65 72 61 6c 20 73 65 72 76 65 72 73 7d 20  everal servers} 
a410: 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57  {socket doTestsW
a420: 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d  ithRemoteServer}
a430: 20 7b 0a 20 20 20 20 73 65 6e 64 43 65 72 74 56   {.    sendCertV
a440: 61 6c 75 65 73 0a 20 20 20 20 73 65 6e 64 43 6f  alues.    sendCo
a450: 6d 6d 61 6e 64 20 7b 0a 09 74 6c 73 3a 3a 69 6e  mmand {..tls::in
a460: 69 74 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65  it -certfile $se
a470: 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65  rverCert -cafile
a480: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c   $caCert -keyfil
a490: 65 20 24 73 65 72 76 65 72 4b 65 79 0a 09 73 65  e $serverKey..se
a4a0: 74 20 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65  t s1 [tls::socke
a4b0: 74 20 2d 73 65 72 76 65 72 20 22 61 63 63 65 70  t -server "accep
a4c0: 74 20 34 30 30 33 22 20 34 30 30 33 5d 0a 09 73  t 4003" 4003]..s
a4d0: 65 74 20 73 32 20 5b 74 6c 73 3a 3a 73 6f 63 6b  et s2 [tls::sock
a4e0: 65 74 20 2d 73 65 72 76 65 72 20 22 61 63 63 65  et -server "acce
a4f0: 70 74 20 34 30 30 34 22 20 34 30 30 34 5d 0a 09  pt 4004" 4004]..
a500: 73 65 74 20 73 33 20 5b 74 6c 73 3a 3a 73 6f 63  set s3 [tls::soc
a510: 6b 65 74 20 2d 73 65 72 76 65 72 20 22 61 63 63  ket -server "acc
a520: 65 70 74 20 34 30 30 35 22 20 34 30 30 35 5d 0a  ept 4005" 4005].
a530: 09 70 72 6f 63 20 68 61 6e 64 73 68 61 6b 65 20  .proc handshake 
a540: 7b 73 20 6d 70 7d 20 7b 0a 09 20 20 20 20 69 66  {s mp} {..    if
a550: 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 09   {[eof $s]} {...
a560: 63 6c 6f 73 65 20 24 73 0a 09 20 20 20 20 7d 20  close $s..    } 
a570: 65 6c 73 65 69 66 20 7b 5b 63 61 74 63 68 20 7b  elseif {[catch {
a580: 74 6c 73 3a 3a 68 61 6e 64 73 68 61 6b 65 20 24  tls::handshake $
a590: 73 7d 20 72 65 73 75 6c 74 5d 7d 20 7b 0a 09 09  s} result]} {...
a5a0: 23 20 53 6f 6d 65 20 65 72 72 6f 72 73 20 61 72  # Some errors ar
a5b0: 65 20 6e 6f 72 6d 61 6c 2e 0a 09 20 20 20 20 7d  e normal...    }
a5c0: 20 65 6c 73 65 69 66 20 7b 24 72 65 73 75 6c 74   elseif {$result
a5d0: 20 3d 3d 20 31 7d 20 7b 0a 09 09 23 20 48 61 6e   == 1} {...# Han
a5e0: 64 73 68 61 6b 65 20 63 6f 6d 70 6c 65 74 65 0a  dshake complete.
a5f0: 09 09 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72  ..fileevent $s r
a600: 65 61 64 61 62 6c 65 20 22 22 0a 09 09 70 75 74  eadable ""...put
a610: 73 20 24 73 20 24 6d 70 0a 09 09 63 6c 6f 73 65  s $s $mp...close
a620: 20 24 73 0a 09 20 20 20 20 7d 0a 09 7d 0a 09 70   $s..    }..}..p
a630: 72 6f 63 20 61 63 63 65 70 74 20 7b 6d 70 20 73  roc accept {mp s
a640: 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 23 20 54   a p} {..    # T
a650: 68 65 73 65 20 68 61 76 65 20 74 6f 20 61 63 63  hese have to acc
a660: 65 70 74 20 6e 6f 6e 2d 62 6c 6f 63 6b 69 6e 67  ept non-blocking
a670: 2c 20 62 65 63 61 75 73 65 20 74 68 65 20 68 61  , because the ha
a680: 6e 64 73 68 61 6b 69 6e 67 0a 09 20 20 20 20 23  ndshaking..    #
a690: 20 6f 72 64 65 72 20 69 73 6e 27 74 20 64 65 74   order isn't det
a6a0: 65 72 6d 69 6e 69 73 74 69 63 0a 09 20 20 20 20  erministic..    
a6b0: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62  fconfigure $s -b
a6c0: 6c 6f 63 6b 69 6e 67 20 30 20 2d 62 75 66 66 65  locking 0 -buffe
a6d0: 72 69 6e 67 20 6c 69 6e 65 0a 09 20 20 20 20 66  ring line..    f
a6e0: 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 64  ileevent $s read
a6f0: 61 62 6c 65 20 5b 6c 69 73 74 20 68 61 6e 64 73  able [list hands
a700: 68 61 6b 65 20 24 73 20 24 6d 70 5d 0a 09 7d 0a  hake $s $mp]..}.
a710: 20 20 20 20 7d 0a 20 20 20 20 74 6c 73 3a 3a 69      }.    tls::i
a720: 6e 69 74 20 2d 63 65 72 74 66 69 6c 65 20 24 63  nit -certfile $c
a730: 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c  lientCert -cafil
a740: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69  e $caCert -keyfi
a750: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 0a 20 20  le $clientKey.  
a760: 20 20 73 65 74 20 73 31 20 5b 74 6c 73 3a 3a 73    set s1 [tls::s
a770: 6f 63 6b 65 74 20 24 72 65 6d 6f 74 65 53 65 72  ocket $remoteSer
a780: 76 65 72 49 50 20 34 30 30 33 5d 0a 20 20 20 20  verIP 4003].    
a790: 73 65 74 20 73 32 20 5b 74 6c 73 3a 3a 73 6f 63  set s2 [tls::soc
a7a0: 6b 65 74 20 24 72 65 6d 6f 74 65 53 65 72 76 65  ket $remoteServe
a7b0: 72 49 50 20 34 30 30 34 5d 0a 20 20 20 20 73 65  rIP 4004].    se
a7c0: 74 20 73 33 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65  t s3 [tls::socke
a7d0: 74 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49  t $remoteServerI
a7e0: 50 20 34 30 30 35 5d 0a 20 20 20 20 73 65 74 20  P 4005].    set 
a7f0: 6c 20 22 22 0a 20 20 20 20 6c 61 70 70 65 6e 64  l "".    lappend
a800: 20 6c 20 5b 67 65 74 73 20 24 73 31 5d 20 5b 67   l [gets $s1] [g
a810: 65 74 73 20 24 73 31 5d 20 5b 65 6f 66 20 24 73  ets $s1] [eof $s
a820: 31 5d 20 5b 67 65 74 73 20 24 73 32 5d 20 5b 67  1] [gets $s2] [g
a830: 65 74 73 20 24 73 32 5d 20 5b 65 6f 66 20 24 73  ets $s2] [eof $s
a840: 32 5d 20 5c 0a 09 5b 67 65 74 73 20 24 73 33 5d  2] \..[gets $s3]
a850: 20 5b 67 65 74 73 20 24 73 33 5d 20 5b 65 6f 66   [gets $s3] [eof
a860: 20 24 73 33 5d 0a 20 20 20 20 63 6c 6f 73 65 20   $s3].    close 
a870: 24 73 31 0a 20 20 20 20 63 6c 6f 73 65 20 24 73  $s1.    close $s
a880: 32 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 33 0a  2.    close $s3.
a890: 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20      sendCommand 
a8a0: 7b 0a 09 63 6c 6f 73 65 20 24 73 31 0a 09 63 6c  {..close $s1..cl
a8b0: 6f 73 65 20 24 73 32 0a 09 63 6c 6f 73 65 20 24  ose $s2..close $
a8c0: 73 33 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74  s3.    }.    set
a8d0: 20 6c 0a 7d 20 7b 34 30 30 33 20 7b 7d 20 31 20   l.} {4003 {} 1 
a8e0: 34 30 30 34 20 7b 7d 20 31 20 34 30 30 35 20 7b  4004 {} 1 4005 {
a8f0: 7d 20 31 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f  } 1}..test tlsIO
a900: 2d 31 31 2e 39 20 7b 61 63 63 65 70 74 20 63 61  -11.9 {accept ca
a910: 6c 6c 62 61 63 6b 20 65 72 72 6f 72 7d 20 7b 73  llback error} {s
a920: 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74  ocket doTestsWit
a930: 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b  hRemoteServer} {
a940: 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a  .    set s [tls:
a950: 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d  :socket \..    -
a960: 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72  certfile $server
a970: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61  Cert -cafile $ca
a980: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73  Cert -keyfile $s
a990: 65 72 76 65 72 4b 65 79 20 5c 0a 09 20 20 20 20  erverKey \..    
a9a0: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 38  -server accept 8
a9b0: 38 33 36 5d 0a 20 20 20 20 70 72 6f 63 20 61 63  836].    proc ac
a9c0: 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 65 78  cept {s a p} {ex
a9d0: 70 72 20 31 30 20 2f 20 30 7d 0a 20 20 20 20 70  pr 10 / 0}.    p
a9e0: 72 6f 63 20 62 67 65 72 72 6f 72 20 61 72 67 73  roc bgerror args
a9f0: 20 7b 0a 09 67 6c 6f 62 61 6c 20 78 0a 09 73 65   {..global x..se
aa00: 74 20 78 20 24 61 72 67 73 0a 20 20 20 20 7d 0a  t x $args.    }.
aa10: 20 20 20 20 73 65 6e 64 43 65 72 74 56 61 6c 75      sendCertValu
aa20: 65 73 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 63  es.    if {[catc
aa30: 68 20 7b 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b  h {sendCommand {
aa40: 0a 09 20 20 20 20 73 65 74 20 70 65 65 72 6e 61  ..    set peerna
aa50: 6d 65 20 5b 66 63 6f 6e 66 69 67 75 72 65 20 24  me [fconfigure $
aa60: 63 61 6c 6c 65 72 53 6f 63 6b 65 74 20 2d 70 65  callerSocket -pe
aa70: 65 72 6e 61 6d 65 5d 0a 09 20 20 20 20 73 65 74  ername]..    set
aa80: 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20   s [tls::socket 
aa90: 5c 0a 09 09 20 20 20 20 2d 63 65 72 74 66 69 6c  \...    -certfil
aaa0: 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63  e $clientCert -c
aab0: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b  afile $caCert -k
aac0: 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65  eyfile $clientKe
aad0: 79 20 5c 0a 09 09 20 20 20 20 5b 6c 69 6e 64 65  y \...    [linde
aae0: 78 20 24 70 65 65 72 6e 61 6d 65 20 30 5d 20 38  x $peername 0] 8
aaf0: 38 33 36 5d 0a 09 20 20 20 20 63 6c 6f 73 65 20  836]..    close 
ab00: 24 73 0a 20 20 20 20 09 20 7d 7d 20 6d 73 67 5d  $s.    . }} msg]
ab10: 7d 20 7b 0a 09 63 6c 6f 73 65 20 24 73 0a 09 65  } {..close $s..e
ab20: 72 72 6f 72 20 24 6d 73 67 0a 20 20 20 20 7d 0a  rror $msg.    }.
ab30: 20 20 20 20 73 65 74 20 74 69 6d 65 72 20 5b 61      set timer [a
ab40: 66 74 65 72 20 31 30 30 30 30 20 22 73 65 74 20  fter 10000 "set 
ab50: 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20  x timed_out"].  
ab60: 20 20 76 77 61 69 74 20 78 0a 20 20 20 20 61 66    vwait x.    af
ab70: 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65  ter cancel $time
ab80: 72 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20  r.    close $s. 
ab90: 20 20 20 72 65 6e 61 6d 65 20 62 67 65 72 72 6f     rename bgerro
aba0: 72 20 7b 7d 0a 20 20 20 20 73 65 74 20 78 0a 7d  r {}.    set x.}
abb0: 20 7b 7b 64 69 76 69 64 65 20 62 79 20 7a 65 72   {{divide by zer
abc0: 6f 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d  o}}..test tlsIO-
abd0: 31 31 2e 31 30 20 7b 74 65 73 74 69 6e 67 20 73  11.10 {testing s
abe0: 6f 63 6b 65 74 20 73 70 65 63 69 66 69 63 20 6f  ocket specific o
abf0: 70 74 69 6f 6e 73 7d 20 7b 73 6f 63 6b 65 74 20  ptions} {socket 
ac00: 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74  doTestsWithRemot
ac10: 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 73  eServer} {.    s
ac20: 65 6e 64 43 65 72 74 56 61 6c 75 65 73 0a 20 20  endCertValues.  
ac30: 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a    sendCommand {.
ac40: 09 73 65 74 20 73 6f 63 6b 65 74 31 30 5f 31 32  .set socket10_12
ac50: 5f 74 65 73 74 5f 73 65 72 76 65 72 20 5b 74 6c  _test_server [tl
ac60: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 09 2d 63  s::socket \...-c
ac70: 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43  ertfile $serverC
ac80: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43  ert -cafile $caC
ac90: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65  ert -keyfile $se
aca0: 72 76 65 72 4b 65 79 20 5c 0a 09 09 2d 73 65 72  rverKey \...-ser
acb0: 76 65 72 20 61 63 63 65 70 74 20 38 38 33 36 5d  ver accept 8836]
acc0: 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73  ..proc accept {s
acd0: 20 61 20 70 7d 20 7b 63 6c 6f 73 65 20 24 73 7d   a p} {close $s}
ace0: 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73  .    }.    set s
acf0: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a   [tls::socket \.
ad00: 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24  .    -certfile $
ad10: 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69  clientCert -cafi
ad20: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66  le $caCert -keyf
ad30: 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c  ile $clientKey \
ad40: 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 65 72  ..    $remoteSer
ad50: 76 65 72 49 50 20 38 38 33 36 5d 0a 20 20 20 20  verIP 8836].    
ad60: 73 65 74 20 70 20 5b 66 63 6f 6e 66 69 67 75 72  set p [fconfigur
ad70: 65 20 24 73 20 2d 70 65 65 72 6e 61 6d 65 5d 0a  e $s -peername].
ad80: 20 20 20 20 73 65 74 20 6e 20 5b 66 63 6f 6e 66      set n [fconf
ad90: 69 67 75 72 65 20 24 73 20 2d 73 6f 63 6b 6e 61  igure $s -sockna
ada0: 6d 65 5d 0a 20 20 20 20 73 65 74 20 6c 20 22 22  me].    set l ""
adb0: 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b  .    lappend l [
adc0: 6c 69 6e 64 65 78 20 24 70 20 32 5d 20 5b 6c 6c  lindex $p 2] [ll
add0: 65 6e 67 74 68 20 24 70 5d 20 5b 6c 6c 65 6e 67  ength $p] [lleng
ade0: 74 68 20 24 70 5d 0a 20 20 20 20 63 6c 6f 73 65  th $p].    close
adf0: 20 24 73 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d   $s.    sendComm
ae00: 61 6e 64 20 7b 63 6c 6f 73 65 20 24 73 6f 63 6b  and {close $sock
ae10: 65 74 31 30 5f 31 32 5f 74 65 73 74 5f 73 65 72  et10_12_test_ser
ae20: 76 65 72 7d 0a 20 20 20 20 73 65 74 20 6c 0a 7d  ver}.    set l.}
ae30: 20 7b 38 38 33 36 20 33 20 33 7d 0a 0a 74 65 73   {8836 3 3}..tes
ae40: 74 20 74 6c 73 49 4f 2d 31 31 2e 31 31 20 7b 74  t tlsIO-11.11 {t
ae50: 65 73 74 69 6e 67 20 73 70 75 72 69 6f 75 73 20  esting spurious 
ae60: 65 76 65 6e 74 73 7d 20 7b 73 6f 63 6b 65 74 20  events} {socket 
ae70: 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74  doTestsWithRemot
ae80: 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 23  eServer} {.    #
ae90: 20 72 65 6d 6f 74 65 20 65 71 75 69 76 61 6c 65   remote equivale
aea0: 6e 74 20 6f 66 20 39 2e 31 0a 20 20 20 20 73 65  nt of 9.1.    se
aeb0: 6e 64 43 65 72 74 56 61 6c 75 65 73 0a 20 20 20  ndCertValues.   
aec0: 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09   sendCommand {..
aed0: 73 65 74 20 73 6f 63 6b 65 74 5f 74 65 73 74 5f  set socket_test_
aee0: 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 6f 63  server [tls::soc
aef0: 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65  ket -server acce
af00: 70 74 20 5c 0a 09 09 2d 63 65 72 74 66 69 6c 65  pt \...-certfile
af10: 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61   $serverCert -ca
af20: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65  file $caCert -ke
af30: 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79  yfile $serverKey
af40: 20 38 38 33 36 5d 0a 09 70 72 6f 63 20 68 61 6e   8836]..proc han
af50: 64 73 68 61 6b 65 20 7b 73 7d 20 7b 0a 09 20 20  dshake {s} {..  
af60: 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20    if {[eof $s]} 
af70: 7b 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 20 20  {...close $s..  
af80: 20 20 7d 20 65 6c 73 65 69 66 20 7b 5b 63 61 74    } elseif {[cat
af90: 63 68 20 7b 74 6c 73 3a 3a 68 61 6e 64 73 68 61  ch {tls::handsha
afa0: 6b 65 20 24 73 7d 20 72 65 73 75 6c 74 5d 7d 20  ke $s} result]} 
afb0: 7b 0a 09 09 23 20 53 6f 6d 65 20 65 72 72 6f 72  {...# Some error
afc0: 73 20 61 72 65 20 6e 6f 72 6d 61 6c 2e 0a 09 20  s are normal... 
afd0: 20 20 20 7d 20 65 6c 73 65 69 66 20 7b 24 72 65     } elseif {$re
afe0: 73 75 6c 74 20 3d 3d 20 31 7d 20 7b 0a 09 09 23  sult == 1} {...#
aff0: 20 48 61 6e 64 73 68 61 6b 65 20 63 6f 6d 70 6c   Handshake compl
b000: 65 74 65 0a 09 09 66 69 6c 65 65 76 65 6e 74 20  ete...fileevent 
b010: 24 73 20 77 72 69 74 61 62 6c 65 20 22 22 0a 09  $s writable ""..
b020: 09 61 66 74 65 72 20 31 30 30 20 77 72 69 74 65  .after 100 write
b030: 73 6f 6d 65 20 24 73 0a 09 20 20 20 20 7d 0a 09  some $s..    }..
b040: 7d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b  }..proc accept {
b050: 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 66 63  s a p} {..    fc
b060: 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 74 72 61  onfigure $s -tra
b070: 6e 73 6c 61 74 69 6f 6e 20 22 61 75 74 6f 20 6c  nslation "auto l
b080: 66 22 0a 09 20 20 20 20 66 69 6c 65 65 76 65 6e  f"..    fileeven
b090: 74 20 24 73 20 77 72 69 74 61 62 6c 65 20 5b 6c  t $s writable [l
b0a0: 69 73 74 20 68 61 6e 64 73 68 61 6b 65 20 24 73  ist handshake $s
b0b0: 5d 0a 09 7d 0a 09 70 72 6f 63 20 77 72 69 74 65  ]..}..proc write
b0c0: 73 6f 6d 65 20 7b 73 7d 20 7b 0a 09 20 20 20 20  some {s} {..    
b0d0: 66 6f 72 20 7b 73 65 74 20 69 20 30 7d 20 7b 24  for {set i 0} {$
b0e0: 69 20 3c 20 31 30 30 7d 20 7b 69 6e 63 72 20 69  i < 100} {incr i
b0f0: 7d 20 7b 0a 09 09 70 75 74 73 20 24 73 20 22 6c  } {...puts $s "l
b100: 69 6e 65 20 24 69 20 66 72 6f 6d 20 72 65 6d 6f  ine $i from remo
b110: 74 65 20 73 65 72 76 65 72 22 0a 09 20 20 20 20  te server"..    
b120: 7d 0a 09 20 20 20 20 63 6c 6f 73 65 20 24 73 0a  }..    close $s.
b130: 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74  .}.    }.    set
b140: 20 6c 65 6e 20 30 0a 20 20 20 20 73 65 74 20 73   len 0.    set s
b150: 70 75 72 69 6f 75 73 20 30 0a 20 20 20 20 73 65  purious 0.    se
b160: 74 20 64 6f 6e 65 20 30 0a 20 20 20 20 70 72 6f  t done 0.    pro
b170: 63 20 72 65 61 64 6c 69 74 74 6c 65 20 7b 73 7d  c readlittle {s}
b180: 20 7b 0a 09 67 6c 6f 62 61 6c 20 73 70 75 72 69   {..global spuri
b190: 6f 75 73 20 64 6f 6e 65 20 6c 65 6e 0a 09 73 65  ous done len..se
b1a0: 74 20 6c 20 5b 72 65 61 64 20 24 73 20 31 5d 0a  t l [read $s 1].
b1b0: 09 69 66 20 7b 5b 73 74 72 69 6e 67 20 6c 65 6e  .if {[string len
b1c0: 67 74 68 20 24 6c 5d 20 3d 3d 20 30 7d 20 7b 0a  gth $l] == 0} {.
b1d0: 09 20 20 20 20 69 66 20 7b 21 5b 65 6f 66 20 24  .    if {![eof $
b1e0: 73 5d 7d 20 7b 0a 09 09 69 6e 63 72 20 73 70 75  s]} {...incr spu
b1f0: 72 69 6f 75 73 0a 09 20 20 20 20 7d 20 65 6c 73  rious..    } els
b200: 65 20 7b 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09  e {...close $s..
b210: 09 73 65 74 20 64 6f 6e 65 20 31 0a 09 20 20 20  .set done 1..   
b220: 20 7d 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 20 20   }..} else {..  
b230: 20 20 69 6e 63 72 20 6c 65 6e 20 5b 73 74 72 69    incr len [stri
b240: 6e 67 20 6c 65 6e 67 74 68 20 24 6c 5d 0a 09 7d  ng length $l]..}
b250: 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 63  .    }.    set c
b260: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a   [tls::socket \.
b270: 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24  .    -certfile $
b280: 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69  clientCert -cafi
b290: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66  le $caCert -keyf
b2a0: 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c  ile $clientKey \
b2b0: 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 65 72  ..    $remoteSer
b2c0: 76 65 72 49 50 20 38 38 33 36 5d 0a 20 20 20 20  verIP 8836].    
b2d0: 23 20 47 65 74 20 74 68 65 20 62 75 66 66 65 72  # Get the buffer
b2e0: 69 6e 67 20 63 6f 72 72 65 63 74 65 64 0a 20 20  ing corrected.  
b2f0: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 63 20    fconfigure $c 
b300: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a  -buffering line.
b310: 20 20 20 20 23 20 50 75 74 20 61 20 62 79 74 65      # Put a byte
b320: 20 69 6e 74 6f 20 74 68 65 20 63 6c 69 65 6e 74   into the client
b330: 20 70 69 70 65 20 74 6f 20 74 72 69 67 67 65 72   pipe to trigger
b340: 20 54 4c 53 20 68 61 6e 64 73 68 61 6b 69 6e 67   TLS handshaking
b350: 0a 20 20 20 20 70 75 74 73 20 24 63 20 61 0a 20  .    puts $c a. 
b360: 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 63 20     fileevent $c 
b370: 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 72  readable [list r
b380: 65 61 64 6c 69 74 74 6c 65 20 24 63 5d 0a 20 20  eadlittle $c].  
b390: 20 20 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74    set timer [aft
b3a0: 65 72 20 31 30 30 30 30 20 22 73 65 74 20 64 6f  er 10000 "set do
b3b0: 6e 65 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20  ne timed_out"]. 
b3c0: 20 20 20 76 77 61 69 74 20 64 6f 6e 65 0a 20 20     vwait done.  
b3d0: 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24    after cancel $
b3e0: 74 69 6d 65 72 0a 20 20 20 20 73 65 6e 64 43 6f  timer.    sendCo
b3f0: 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 73 6f  mmand {close $so
b400: 63 6b 65 74 5f 74 65 73 74 5f 73 65 72 76 65 72  cket_test_server
b410: 7d 0a 20 20 20 20 6c 69 73 74 20 24 73 70 75 72  }.    list $spur
b420: 69 6f 75 73 20 24 6c 65 6e 0a 7d 20 7b 30 20 32  ious $len.} {0 2
b430: 36 39 30 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f  690}..test tlsIO
b440: 2d 31 31 2e 31 32 20 7b 74 65 73 74 69 6e 67 20  -11.12 {testing 
b450: 45 4f 46 20 73 74 69 63 6b 79 6e 65 73 73 7d 20  EOF stickyness} 
b460: 7b 75 6e 65 78 70 6c 61 69 6e 65 64 46 61 69 6c  {unexplainedFail
b470: 75 72 65 20 73 6f 63 6b 65 74 20 64 6f 54 65 73  ure socket doTes
b480: 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76  tsWithRemoteServ
b490: 65 72 7d 20 7b 0a 20 20 20 20 23 20 72 65 6d 6f  er} {.    # remo
b4a0: 74 65 20 65 71 75 69 76 61 6c 65 6e 74 20 6f 66  te equivalent of
b4b0: 20 39 2e 33 0a 20 20 20 20 23 20 48 4f 42 42 53   9.3.    # HOBBS
b4c0: 3a 20 6e 65 76 65 72 20 77 6f 72 6b 65 64 20 63  : never worked c
b4d0: 6f 72 72 65 63 74 6c 79 0a 20 20 20 20 73 65 74  orrectly.    set
b4e0: 20 63 6f 75 6e 74 65 72 20 30 0a 20 20 20 20 73   counter 0.    s
b4f0: 65 74 20 64 6f 6e 65 20 30 0a 20 20 20 20 70 72  et done 0.    pr
b500: 6f 63 20 63 6f 75 6e 74 5f 75 70 20 7b 73 7d 20  oc count_up {s} 
b510: 7b 0a 09 67 6c 6f 62 61 6c 20 63 6f 75 6e 74 65  {..global counte
b520: 72 20 64 6f 6e 65 20 61 66 74 65 72 5f 69 64 0a  r done after_id.
b530: 09 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 5d  .set l [gets $s]
b540: 0a 09 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20  ..if {[eof $s]} 
b550: 7b 0a 09 20 20 20 20 69 6e 63 72 20 63 6f 75 6e  {..    incr coun
b560: 74 65 72 0a 09 20 20 20 20 69 66 20 7b 24 63 6f  ter..    if {$co
b570: 75 6e 74 65 72 20 3e 20 39 7d 20 7b 0a 09 09 73  unter > 9} {...s
b580: 65 74 20 64 6f 6e 65 20 7b 45 4f 46 20 69 73 20  et done {EOF is 
b590: 73 74 69 63 6b 79 7d 0a 09 09 61 66 74 65 72 20  sticky}...after 
b5a0: 63 61 6e 63 65 6c 20 24 61 66 74 65 72 5f 69 64  cancel $after_id
b5b0: 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 20 20 20  ...close $s..   
b5c0: 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20   }..}.    }.    
b5d0: 70 72 6f 63 20 74 69 6d 65 64 5f 6f 75 74 20 7b  proc timed_out {
b5e0: 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 63 20 64 6f  } {..global c do
b5f0: 6e 65 0a 09 73 65 74 20 64 6f 6e 65 20 7b 74 69  ne..set done {ti
b600: 6d 65 64 5f 6f 75 74 2c 20 45 4f 46 20 69 73 20  med_out, EOF is 
b610: 6e 6f 74 20 73 74 69 63 6b 79 7d 0a 09 63 6c 6f  not sticky}..clo
b620: 73 65 20 24 63 0a 20 20 20 20 7d 0a 20 20 20 20  se $c.    }.    
b630: 73 65 6e 64 43 65 72 74 56 61 6c 75 65 73 0a 20  sendCertValues. 
b640: 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b     sendCommand {
b650: 0a 09 73 65 74 20 73 6f 63 6b 65 74 31 30 5f 31  ..set socket10_1
b660: 34 5f 74 65 73 74 5f 73 65 72 76 65 72 20 5b 74  4_test_server [t
b670: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 09 2d  ls::socket \...-
b680: 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72  certfile $server
b690: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61  Cert -cafile $ca
b6a0: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73  Cert -keyfile $s
b6b0: 65 72 76 65 72 4b 65 79 20 5c 0a 09 09 2d 73 65  erverKey \...-se
b6c0: 72 76 65 72 20 61 63 63 65 70 74 20 38 38 33 36  rver accept 8836
b6d0: 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b  ]..proc accept {
b6e0: 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 74 6c  s a p} {..    tl
b6f0: 73 3a 3a 68 61 6e 64 73 68 61 6b 65 20 24 73 0a  s::handshake $s.
b700: 09 20 20 20 20 61 66 74 65 72 20 31 30 30 20 63  .    after 100 c
b710: 6c 6f 73 65 20 24 73 0a 09 7d 0a 20 20 20 20 7d  lose $s..}.    }
b720: 0a 20 20 20 20 73 65 74 20 63 20 5b 74 6c 73 3a  .    set c [tls:
b730: 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d  :socket \..    -
b740: 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74  certfile $client
b750: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61  Cert -cafile $ca
b760: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63  Cert -keyfile $c
b770: 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20  lientKey \..    
b780: 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20  $remoteServerIP 
b790: 38 38 33 36 5d 0a 20 20 20 20 66 69 6c 65 65 76  8836].    fileev
b7a0: 65 6e 74 20 24 63 20 72 65 61 64 61 62 6c 65 20  ent $c readable 
b7b0: 22 63 6f 75 6e 74 5f 75 70 20 24 63 22 0a 20 20  "count_up $c".  
b7c0: 20 20 73 65 74 20 61 66 74 65 72 5f 69 64 20 5b    set after_id [
b7d0: 61 66 74 65 72 20 31 30 30 30 20 74 69 6d 65 64  after 1000 timed
b7e0: 5f 6f 75 74 5d 0a 20 20 20 20 76 77 61 69 74 20  _out].    vwait 
b7f0: 64 6f 6e 65 0a 20 20 20 20 73 65 6e 64 43 6f 6d  done.    sendCom
b800: 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 73 6f 63  mand {close $soc
b810: 6b 65 74 31 30 5f 31 34 5f 74 65 73 74 5f 73 65  ket10_14_test_se
b820: 72 76 65 72 7d 0a 20 20 20 20 73 65 74 20 64 6f  rver}.    set do
b830: 6e 65 0a 7d 20 7b 45 4f 46 20 69 73 20 73 74 69  ne.} {EOF is sti
b840: 63 6b 79 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f  cky}..test tlsIO
b850: 2d 31 31 2e 31 33 20 7b 74 65 73 74 69 6e 67 20  -11.13 {testing 
b860: 61 73 79 6e 63 20 77 72 69 74 65 2c 20 61 73 79  async write, asy
b870: 6e 63 20 66 6c 75 73 68 2c 20 61 73 79 6e 63 20  nc flush, async 
b880: 63 6c 6f 73 65 7d 20 5c 0a 09 7b 73 6f 63 6b 65  close} \..{socke
b890: 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d  t doTestsWithRem
b8a0: 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20  oteServer} {.   
b8b0: 20 70 72 6f 63 20 72 65 61 64 69 74 20 7b 73 7d   proc readit {s}
b8c0: 20 7b 0a 09 67 6c 6f 62 61 6c 20 63 6f 75 6e 74   {..global count
b8d0: 20 64 6f 6e 65 0a 09 73 65 74 20 6c 20 5b 72 65   done..set l [re
b8e0: 61 64 20 24 73 5d 0a 09 69 6e 63 72 20 63 6f 75  ad $s]..incr cou
b8f0: 6e 74 20 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74  nt [string lengt
b900: 68 20 24 6c 5d 0a 09 69 66 20 7b 5b 65 6f 66 20  h $l]..if {[eof 
b910: 24 73 5d 7d 20 7b 0a 09 20 20 20 20 63 6c 6f 73  $s]} {..    clos
b920: 65 20 24 73 0a 09 20 20 20 20 73 65 74 20 64 6f  e $s..    set do
b930: 6e 65 20 31 0a 09 7d 0a 20 20 20 20 7d 0a 20 20  ne 1..}.    }.  
b940: 20 20 73 65 6e 64 43 65 72 74 56 61 6c 75 65 73    sendCertValues
b950: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64  .    sendCommand
b960: 20 7b 0a 09 73 65 74 20 66 69 72 73 74 62 6c 6f   {..set firstblo
b970: 63 6b 20 5b 73 74 72 69 6e 67 20 72 65 70 65 61  ck [string repea
b980: 74 20 61 20 33 31 5d 0a 09 73 65 74 20 73 65 63  t a 31]..set sec
b990: 6f 6e 64 62 6c 6f 63 6b 20 5b 73 74 72 69 6e 67  ondblock [string
b9a0: 20 72 65 70 65 61 74 20 62 20 36 35 35 33 35 5d   repeat b 65535]
b9b0: 0a 09 73 65 74 20 6c 20 5b 74 6c 73 3a 3a 73 6f  ..set l [tls::so
b9c0: 63 6b 65 74 20 5c 0a 09 09 2d 63 65 72 74 66 69  cket \...-certfi
b9d0: 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d  le $serverCert -
b9e0: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d  cafile $caCert -
b9f0: 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b  keyfile $serverK
ba00: 65 79 20 5c 0a 09 09 2d 73 65 72 76 65 72 20 61  ey \...-server a
ba10: 63 63 65 70 74 20 38 38 34 35 5d 0a 09 70 72 6f  ccept 8845]..pro
ba20: 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d  c accept {s a p}
ba30: 20 7b 0a 09 20 20 20 20 74 6c 73 3a 3a 68 61 6e   {..    tls::han
ba40: 64 73 68 61 6b 65 20 24 73 0a 09 20 20 20 20 66  dshake $s..    f
ba50: 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 6c  configure $s -bl
ba60: 6f 63 6b 69 6e 67 20 30 20 2d 74 72 61 6e 73 6c  ocking 0 -transl
ba70: 61 74 69 6f 6e 20 6c 66 20 2d 62 75 66 66 65 72  ation lf -buffer
ba80: 73 69 7a 65 20 31 36 33 38 34 20 5c 0a 09 09 20  size 16384 \... 
ba90: 20 20 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69     -buffering li
baa0: 6e 65 0a 09 20 20 20 20 66 69 6c 65 65 76 65 6e  ne..    fileeven
bab0: 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 22 72  t $s readable "r
bac0: 65 61 64 61 62 6c 65 20 24 73 22 0a 09 7d 0a 09  eadable $s"..}..
bad0: 70 72 6f 63 20 72 65 61 64 61 62 6c 65 20 7b 73  proc readable {s
bae0: 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 6c 20 5b  } {..    set l [
baf0: 67 65 74 73 20 24 73 5d 0a 09 20 20 20 20 66 69  gets $s]..    fi
bb00: 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61  leevent $s reada
bb10: 62 6c 65 20 7b 7d 0a 09 20 20 20 20 61 66 74 65  ble {}..    afte
bb20: 72 20 31 30 30 30 20 72 65 73 70 6f 6e 64 20 24  r 1000 respond $
bb30: 73 0a 09 7d 0a 09 70 72 6f 63 20 72 65 73 70 6f  s..}..proc respo
bb40: 6e 64 20 7b 73 7d 20 7b 0a 09 20 20 20 20 67 6c  nd {s} {..    gl
bb50: 6f 62 61 6c 20 66 69 72 73 74 62 6c 6f 63 6b 0a  obal firstblock.
bb60: 09 20 20 20 20 70 75 74 73 20 2d 6e 6f 6e 65 77  .    puts -nonew
bb70: 6c 69 6e 65 20 24 73 20 24 66 69 72 73 74 62 6c  line $s $firstbl
bb80: 6f 63 6b 0a 09 20 20 20 20 61 66 74 65 72 20 31  ock..    after 1
bb90: 30 30 30 20 77 72 69 74 65 64 61 74 61 20 24 73  000 writedata $s
bba0: 0a 09 7d 0a 09 70 72 6f 63 20 77 72 69 74 65 64  ..}..proc writed
bbb0: 61 74 61 20 7b 73 7d 20 7b 0a 09 20 20 20 20 67  ata {s} {..    g
bbc0: 6c 6f 62 61 6c 20 73 65 63 6f 6e 64 62 6c 6f 63  lobal secondbloc
bbd0: 6b 0a 09 20 20 20 20 70 75 74 73 20 2d 6e 6f 6e  k..    puts -non
bbe0: 65 77 6c 69 6e 65 20 24 73 20 24 73 65 63 6f 6e  ewline $s $secon
bbf0: 64 62 6c 6f 63 6b 0a 09 20 20 20 20 63 6c 6f 73  dblock..    clos
bc00: 65 20 24 73 0a 09 7d 0a 20 20 20 20 7d 0a 20 20  e $s..}.    }.  
bc10: 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f    set s [tls::so
bc20: 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72  cket \..    -cer
bc30: 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72  tfile $clientCer
bc40: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72  t -cafile $caCer
bc50: 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65  t -keyfile $clie
bc60: 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 65  ntKey \..    $re
bc70: 6d 6f 74 65 53 65 72 76 65 72 49 50 20 38 38 34  moteServerIP 884
bc80: 35 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72  5].    fconfigur
bc90: 65 20 24 73 20 2d 62 6c 6f 63 6b 69 6e 67 20 30  e $s -blocking 0
bca0: 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 6c 66   -translation lf
bcb0: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65   -buffering line
bcc0: 0a 20 20 20 20 73 65 74 20 63 6f 75 6e 74 20 30  .    set count 0
bcd0: 0a 20 20 20 20 70 75 74 73 20 24 73 20 68 65 6c  .    puts $s hel
bce0: 6c 6f 0a 20 20 20 20 66 69 6c 65 65 76 65 6e 74  lo.    fileevent
bcf0: 20 24 73 20 72 65 61 64 61 62 6c 65 20 22 72 65   $s readable "re
bd00: 61 64 69 74 20 24 73 22 0a 20 20 20 20 73 65 74  adit $s".    set
bd10: 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 31 30   timer [after 10
bd20: 30 30 30 20 22 73 65 74 20 64 6f 6e 65 20 74 69  000 "set done ti
bd30: 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 76 77  med_out"].    vw
bd40: 61 69 74 20 64 6f 6e 65 0a 20 20 20 20 61 66 74  ait done.    aft
bd50: 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72  er cancel $timer
bd60: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64  .    sendCommand
bd70: 20 7b 63 6c 6f 73 65 20 24 6c 7d 0a 20 20 20 20   {close $l}.    
bd80: 73 65 74 20 63 6f 75 6e 74 0a 7d 20 36 35 35 36  set count.} 6556
bd90: 36 0a 0a 70 72 6f 63 20 67 65 74 64 61 74 61 20  6..proc getdata 
bda0: 7b 74 79 70 65 20 66 69 6c 65 7d 20 7b 0a 20 20  {type file} {.  
bdb0: 20 20 23 20 52 65 61 64 20 68 61 6e 64 6c 65 72    # Read handler
bdc0: 20 6f 6e 20 74 68 65 20 61 63 63 65 70 74 65 64   on the accepted
bdd0: 20 73 6f 63 6b 65 74 2e 0a 20 20 20 20 67 6c 6f   socket..    glo
bde0: 62 61 6c 20 78 0a 20 20 20 20 67 6c 6f 62 61 6c  bal x.    global
bdf0: 20 66 61 69 6c 65 64 0a 20 20 20 20 73 65 74 20   failed.    set 
be00: 73 74 61 74 75 73 20 5b 63 61 74 63 68 20 7b 72  status [catch {r
be10: 65 61 64 20 24 66 69 6c 65 7d 20 64 61 74 61 5d  ead $file} data]
be20: 0a 20 20 20 20 69 66 20 7b 24 73 74 61 74 75 73  .    if {$status
be30: 20 21 3d 20 30 7d 20 7b 0a 09 73 65 74 20 78 20   != 0} {..set x 
be40: 22 72 65 61 64 20 66 61 69 6c 65 64 2c 20 65 72  "read failed, er
be50: 72 6f 72 20 77 61 73 20 24 64 61 74 61 22 0a 09  ror was $data"..
be60: 63 61 74 63 68 20 7b 20 63 6c 6f 73 65 20 24 66  catch { close $f
be70: 69 6c 65 20 7d 0a 20 20 20 20 7d 20 65 6c 73 65  ile }.    } else
be80: 69 66 20 7b 5b 73 74 72 69 6e 67 20 63 6f 6d 70  if {[string comp
be90: 61 72 65 20 7b 7d 20 24 64 61 74 61 5d 7d 20 7b  are {} $data]} {
bea0: 0a 20 20 20 20 7d 20 65 6c 73 65 69 66 20 7b 5b  .    } elseif {[
beb0: 66 62 6c 6f 63 6b 65 64 20 24 66 69 6c 65 5d 7d  fblocked $file]}
bec0: 20 7b 0a 20 20 20 20 7d 20 65 6c 73 65 69 66 20   {.    } elseif 
bed0: 7b 5b 65 6f 66 20 24 66 69 6c 65 5d 7d 20 7b 0a  {[eof $file]} {.
bee0: 09 69 66 20 7b 24 66 61 69 6c 65 64 7d 20 7b 0a  .if {$failed} {.
bef0: 09 20 20 20 20 73 65 74 20 78 20 22 24 74 79 70  .    set x "$typ
bf00: 65 20 73 6f 63 6b 65 74 20 77 61 73 20 69 6e 68  e socket was inh
bf10: 65 72 69 74 65 64 22 0a 09 7d 20 65 6c 73 65 20  erited"..} else 
bf20: 7b 0a 09 20 20 20 20 73 65 74 20 78 20 22 24 74  {..    set x "$t
bf30: 79 70 65 20 73 6f 63 6b 65 74 20 77 61 73 20 6e  ype socket was n
bf40: 6f 74 20 69 6e 68 65 72 69 74 65 64 22 0a 09 7d  ot inherited"..}
bf50: 0a 09 63 61 74 63 68 20 7b 20 63 6c 6f 73 65 20  ..catch { close 
bf60: 24 66 69 6c 65 20 7d 0a 20 20 20 20 7d 20 65 6c  $file }.    } el
bf70: 73 65 20 7b 0a 09 73 65 74 20 78 20 7b 69 6d 70  se {..set x {imp
bf80: 6f 73 73 69 62 6c 65 20 63 61 73 65 7d 0a 09 63  ossible case}..c
bf90: 61 74 63 68 20 7b 20 63 6c 6f 73 65 20 24 66 69  atch { close $fi
bfa0: 6c 65 20 7d 0a 20 20 20 20 7d 0a 20 20 20 20 72  le }.    }.    r
bfb0: 65 74 75 72 6e 0a 7d 0a 0a 74 65 73 74 20 74 6c  eturn.}..test tl
bfc0: 73 49 4f 2d 31 32 2e 31 20 7b 74 65 73 74 69 6e  sIO-12.1 {testin
bfd0: 67 20 69 6e 68 65 72 69 74 61 6e 63 65 20 6f 66  g inheritance of
bfe0: 20 73 65 72 76 65 72 20 73 6f 63 6b 65 74 73 7d   server sockets}
bff0: 20 7b 73 6f 63 6b 65 74 20 65 78 65 63 7d 20 7b   {socket exec} {
c000: 0a 20 20 20 20 6d 61 6b 65 46 69 6c 65 20 7b 7d  .    makeFile {}
c010: 20 73 63 72 69 70 74 31 0a 20 20 20 20 6d 61 6b   script1.    mak
c020: 65 46 69 6c 65 20 7b 7d 20 73 63 72 69 70 74 32  eFile {} script2
c030: 0a 0a 20 20 20 20 23 20 53 63 72 69 70 74 31 20  ..    # Script1 
c040: 69 73 20 6a 75 73 74 20 61 20 31 30 20 73 65 63  is just a 10 sec
c050: 6f 6e 64 20 64 65 6c 61 79 2e 20 20 49 66 20 74  ond delay.  If t
c060: 68 65 20 73 65 72 76 65 72 20 73 6f 63 6b 65 74  he server socket
c070: 0a 20 20 20 20 23 20 69 73 20 69 6e 68 65 72 69  .    # is inheri
c080: 74 65 64 2c 20 69 74 20 77 69 6c 6c 20 62 65 20  ted, it will be 
c090: 68 65 6c 64 20 6f 70 65 6e 20 66 6f 72 20 31 30  held open for 10
c0a0: 20 73 65 63 6f 6e 64 73 0a 0a 20 20 20 20 73 65   seconds..    se
c0b0: 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74  t f [open script
c0c0: 31 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66  1 w].    puts $f
c0d0: 20 7b 0a 09 61 66 74 65 72 20 31 30 30 30 30 20   {..after 10000 
c0e0: 65 78 69 74 0a 09 76 77 61 69 74 20 66 6f 72 65  exit..vwait fore
c0f0: 76 65 72 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c  ver.    }.    cl
c100: 6f 73 65 20 24 66 0a 0a 20 20 20 20 23 20 53 63  ose $f..    # Sc
c110: 72 69 70 74 32 20 63 72 65 61 74 65 73 20 74 68  ript2 creates th
c120: 65 20 73 65 72 76 65 72 20 73 6f 63 6b 65 74 2c  e server socket,
c130: 20 6c 61 75 6e 63 68 65 73 20 73 63 72 69 70 74   launches script
c140: 31 2c 0a 20 20 20 20 23 20 77 61 69 74 73 20 61  1,.    # waits a
c150: 20 73 65 63 6f 6e 64 2c 20 61 6e 64 20 65 78 69   second, and exi
c160: 74 73 2e 20 20 54 68 65 20 73 65 72 76 65 72 20  ts.  The server 
c170: 73 6f 63 6b 65 74 20 77 69 6c 6c 20 6e 6f 77 0a  socket will now.
c180: 20 20 20 20 23 20 62 65 20 63 6c 6f 73 65 64 20      # be closed 
c190: 75 6e 6c 65 73 73 20 73 63 72 69 70 74 31 20 69  unless script1 i
c1a0: 6e 68 65 72 69 74 65 64 20 69 74 2e 0a 0a 20 20  nherited it...  
c1b0: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63    set f [open sc
c1c0: 72 69 70 74 32 20 77 5d 0a 20 20 20 20 70 75 74  ript2 w].    put
c1d0: 73 20 24 66 20 5b 6c 69 73 74 20 73 65 74 20 74  s $f [list set t
c1e0: 63 6c 73 68 20 24 3a 3a 74 63 6c 74 65 73 74 3a  clsh $::tcltest:
c1f0: 3a 74 63 6c 74 65 73 74 5d 0a 20 20 20 20 70 75  :tcltest].    pu
c200: 74 73 20 24 66 20 5b 6c 69 73 74 20 73 65 74 20  ts $f [list set 
c210: 61 75 74 6f 5f 70 61 74 68 20 24 61 75 74 6f 5f  auto_path $auto_
c220: 70 61 74 68 5d 0a 20 20 20 20 70 75 74 73 20 24  path].    puts $
c230: 66 20 7b 0a 09 70 61 63 6b 61 67 65 20 72 65 71  f {..package req
c240: 75 69 72 65 20 74 6c 73 0a 20 20 20 20 7d 0a 20  uire tls.    }. 
c250: 20 20 20 70 75 74 73 20 24 66 20 22 73 65 74 20     puts $f "set 
c260: 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20  f \[tls::socket 
c270: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 5c  -server accept \
c280: 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20  ..    -certfile 
c290: 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66  $serverCert -caf
c2a0: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79  ile $caCert -key
c2b0: 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20  file $serverKey 
c2c0: 38 38 32 38 5c 5d 22 0a 20 20 20 20 70 75 74 73  8828\]".    puts
c2d0: 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 65   $f {..proc acce
c2e0: 70 74 20 7b 20 66 69 6c 65 20 61 64 64 72 20 70  pt { file addr p
c2f0: 6f 72 74 20 7d 20 7b 0a 09 20 20 20 20 63 6c 6f  ort } {..    clo
c300: 73 65 20 24 66 69 6c 65 0a 09 7d 0a 09 65 78 65  se $file..}..exe
c310: 63 20 24 74 63 6c 73 68 20 73 63 72 69 70 74 31  c $tclsh script1
c320: 20 26 0a 09 63 6c 6f 73 65 20 24 66 0a 09 61 66   &..close $f..af
c330: 74 65 72 20 31 30 30 30 20 65 78 69 74 0a 09 76  ter 1000 exit..v
c340: 77 61 69 74 20 66 6f 72 65 76 65 72 0a 20 20 20  wait forever.   
c350: 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a   }.    close $f.
c360: 0a 20 20 20 20 23 20 4c 61 75 6e 63 68 20 73 63  .    # Launch sc
c370: 72 69 70 74 32 20 61 6e 64 20 77 61 69 74 20 35  ript2 and wait 5
c380: 20 73 65 63 6f 6e 64 73 0a 0a 20 20 20 20 65 78   seconds..    ex
c390: 65 63 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74  ec $::tcltest::t
c3a0: 63 6c 74 65 73 74 20 73 63 72 69 70 74 32 20 26  cltest script2 &
c3b0: 0a 20 20 20 20 61 66 74 65 72 20 35 30 30 30 20  .    after 5000 
c3c0: 7b 20 73 65 74 20 6f 6b 5f 74 6f 5f 70 72 6f 63  { set ok_to_proc
c3d0: 65 65 64 20 31 20 7d 0a 20 20 20 20 76 77 61 69  eed 1 }.    vwai
c3e0: 74 20 6f 6b 5f 74 6f 5f 70 72 6f 63 65 65 64 0a  t ok_to_proceed.
c3f0: 0a 20 20 20 20 23 20 49 66 20 77 65 20 63 61 6e  .    # If we can
c400: 20 73 74 69 6c 6c 20 63 6f 6e 6e 65 63 74 20 74   still connect t
c410: 6f 20 74 68 65 20 73 65 72 76 65 72 2c 20 74 68  o the server, th
c420: 65 20 73 6f 63 6b 65 74 20 67 6f 74 20 69 6e 68  e socket got inh
c430: 65 72 69 74 65 64 2e 0a 0a 20 20 20 20 69 66 20  erited...    if 
c440: 7b 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f  {[catch {tls::so
c450: 63 6b 65 74 20 5c 0a 09 2d 63 65 72 74 66 69 6c  cket \..-certfil
c460: 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63  e $clientCert -c
c470: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b  afile $caCert -k
c480: 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65  eyfile $clientKe
c490: 79 20 5c 0a 20 20 20 09 20 31 32 37 2e 30 2e 30  y \.   . 127.0.0
c4a0: 2e 31 20 38 38 32 38 7d 20 6d 73 67 5d 7d 20 7b  .1 8828} msg]} {
c4b0: 0a 09 73 65 74 20 78 20 7b 73 65 72 76 65 72 20  ..set x {server 
c4c0: 73 6f 63 6b 65 74 20 77 61 73 20 6e 6f 74 20 69  socket was not i
c4d0: 6e 68 65 72 69 74 65 64 7d 0a 20 20 20 20 7d 20  nherited}.    } 
c4e0: 65 6c 73 65 20 7b 0a 09 63 6c 6f 73 65 20 24 6d  else {..close $m
c4f0: 73 67 0a 09 73 65 74 20 78 20 7b 73 65 72 76 65  sg..set x {serve
c500: 72 20 73 6f 63 6b 65 74 20 77 61 73 20 69 6e 68  r socket was inh
c510: 65 72 69 74 65 64 7d 0a 20 20 20 20 7d 0a 0a 20  erited}.    }.. 
c520: 20 20 20 73 65 74 20 78 0a 7d 20 7b 73 65 72 76     set x.} {serv
c530: 65 72 20 73 6f 63 6b 65 74 20 77 61 73 20 6e 6f  er socket was no
c540: 74 20 69 6e 68 65 72 69 74 65 64 7d 0a 0a 74 65  t inherited}..te
c550: 73 74 20 74 6c 73 49 4f 2d 31 32 2e 32 20 7b 74  st tlsIO-12.2 {t
c560: 65 73 74 69 6e 67 20 69 6e 68 65 72 69 74 61 6e  esting inheritan
c570: 63 65 20 6f 66 20 63 6c 69 65 6e 74 20 73 6f 63  ce of client soc
c580: 6b 65 74 73 7d 20 7b 73 6f 63 6b 65 74 20 65 78  kets} {socket ex
c590: 65 63 7d 20 7b 0a 20 20 20 20 6d 61 6b 65 46 69  ec} {.    makeFi
c5a0: 6c 65 20 7b 7d 20 73 63 72 69 70 74 31 0a 20 20  le {} script1.  
c5b0: 20 20 6d 61 6b 65 46 69 6c 65 20 7b 7d 20 73 63    makeFile {} sc
c5c0: 72 69 70 74 32 0a 0a 20 20 20 20 23 20 53 63 72  ript2..    # Scr
c5d0: 69 70 74 31 20 69 73 20 6a 75 73 74 20 61 20 31  ipt1 is just a 1
c5e0: 30 20 73 65 63 6f 6e 64 20 64 65 6c 61 79 2e 20  0 second delay. 
c5f0: 20 49 66 20 74 68 65 20 73 65 72 76 65 72 20 73   If the server s
c600: 6f 63 6b 65 74 0a 20 20 20 20 23 20 69 73 20 69  ocket.    # is i
c610: 6e 68 65 72 69 74 65 64 2c 20 69 74 20 77 69 6c  nherited, it wil
c620: 6c 20 62 65 20 68 65 6c 64 20 6f 70 65 6e 20 66  l be held open f
c630: 6f 72 20 31 30 20 73 65 63 6f 6e 64 73 0a 0a 20  or 10 seconds.. 
c640: 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73     set f [open s
c650: 63 72 69 70 74 31 20 77 5d 0a 20 20 20 20 70 75  cript1 w].    pu
c660: 74 73 20 24 66 20 7b 0a 09 61 66 74 65 72 20 31  ts $f {..after 1
c670: 30 30 30 30 20 65 78 69 74 0a 09 76 77 61 69 74  0000 exit..vwait
c680: 20 66 6f 72 65 76 65 72 0a 20 20 20 20 7d 0a 20   forever.    }. 
c690: 20 20 20 63 6c 6f 73 65 20 24 66 0a 0a 20 20 20     close $f..   
c6a0: 20 23 20 53 63 72 69 70 74 32 20 6f 70 65 6e 73   # Script2 opens
c6b0: 20 74 68 65 20 63 6c 69 65 6e 74 20 73 6f 63 6b   the client sock
c6c0: 65 74 20 61 6e 64 20 77 72 69 74 65 73 20 74 6f  et and writes to
c6d0: 20 69 74 2e 20 20 49 74 20 74 68 65 6e 0a 20 20   it.  It then.  
c6e0: 20 20 23 20 6c 61 75 6e 63 68 65 73 20 73 63 72    # launches scr
c6f0: 69 70 74 31 20 61 6e 64 20 65 78 69 74 73 2e 20  ipt1 and exits. 
c700: 20 49 66 20 74 68 65 20 63 68 69 6c 64 20 70 72   If the child pr
c710: 6f 63 65 73 73 20 69 6e 68 65 72 69 74 65 64 20  ocess inherited 
c720: 74 68 65 0a 20 20 20 20 23 20 63 6c 69 65 6e 74  the.    # client
c730: 20 73 6f 63 6b 65 74 2c 20 74 68 65 20 73 6f 63   socket, the soc
c740: 6b 65 74 20 77 69 6c 6c 20 73 74 69 6c 6c 20 62  ket will still b
c750: 65 20 6f 70 65 6e 2e 0a 0a 20 20 20 20 73 65 74  e open...    set
c760: 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 32   f [open script2
c770: 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20   w].    puts $f 
c780: 5b 6c 69 73 74 20 73 65 74 20 74 63 6c 73 68 20  [list set tclsh 
c790: 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74  $::tcltest::tclt
c7a0: 65 73 74 5d 0a 20 20 20 20 70 75 74 73 20 24 66  est].    puts $f
c7b0: 20 5b 6c 69 73 74 20 73 65 74 20 61 75 74 6f 5f   [list set auto_
c7c0: 70 61 74 68 20 24 61 75 74 6f 5f 70 61 74 68 5d  path $auto_path]
c7d0: 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09  .    puts $f {..
c7e0: 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 20  package require 
c7f0: 74 6c 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 75  tls.    }.    pu
c800: 74 73 20 24 66 20 22 73 65 74 20 66 20 5c 5b 74  ts $f "set f \[t
c810: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 72 74  ls::socket -cert
c820: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74  file $clientCert
c830: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74   -cafile $caCert
c840: 20 5c 0a 09 20 20 20 20 2d 6b 65 79 66 69 6c 65   \..    -keyfile
c850: 20 24 63 6c 69 65 6e 74 4b 65 79 20 31 32 37 2e   $clientKey 127.
c860: 30 2e 30 2e 31 20 38 38 32 39 5c 5d 22 0a 20 20  0.0.1 8829\]".  
c870: 20 20 70 75 74 73 20 24 66 20 7b 0a 09 65 78 65    puts $f {..exe
c880: 63 20 24 74 63 6c 73 68 20 73 63 72 69 70 74 31  c $tclsh script1
c890: 20 26 0a 09 70 75 74 73 20 24 66 20 74 65 73 74   &..puts $f test
c8a0: 69 6e 67 0a 09 66 6c 75 73 68 20 24 66 0a 09 61  ing..flush $f..a
c8b0: 66 74 65 72 20 31 30 30 30 20 65 78 69 74 0a 09  fter 1000 exit..
c8c0: 76 77 61 69 74 20 66 6f 72 65 76 65 72 0a 20 20  vwait forever.  
c8d0: 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66    }.    close $f
c8e0: 0a 0a 20 20 20 20 23 20 43 72 65 61 74 65 20 74  ..    # Create t
c8f0: 68 65 20 73 65 72 76 65 72 20 73 6f 63 6b 65 74  he server socket
c900: 0a 0a 20 20 20 20 73 65 74 20 73 65 72 76 65 72  ..    set server
c910: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a   [tls::socket \.
c920: 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24  .    -certfile $
c930: 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69  serverCert -cafi
c940: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66  le $caCert -keyf
c950: 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c  ile $serverKey \
c960: 0a 09 20 20 20 20 2d 73 65 72 76 65 72 20 61 63  ..    -server ac
c970: 63 65 70 74 20 38 38 32 39 5d 0a 20 20 20 20 70  cept 8829].    p
c980: 72 6f 63 20 61 63 63 65 70 74 20 7b 20 66 69 6c  roc accept { fil
c990: 65 20 68 6f 73 74 20 70 6f 72 74 20 7d 20 7b 0a  e host port } {.
c9a0: 09 23 20 57 68 65 6e 20 74 68 65 20 63 6c 69 65  .# When the clie
c9b0: 6e 74 20 63 6f 6e 6e 65 63 74 73 2c 20 65 73 74  nt connects, est
c9c0: 61 62 6c 69 73 68 20 74 68 65 20 72 65 61 64 20  ablish the read 
c9d0: 68 61 6e 64 6c 65 72 0a 09 67 6c 6f 62 61 6c 20  handler..global 
c9e0: 73 65 72 76 65 72 0a 09 63 6c 6f 73 65 20 24 73  server..close $s
c9f0: 65 72 76 65 72 0a 09 66 63 6f 6e 66 69 67 75 72  erver..fconfigur
ca00: 65 20 24 66 69 6c 65 20 2d 62 6c 6f 63 6b 69 6e  e $file -blockin
ca10: 67 20 30 0a 09 66 69 6c 65 65 76 65 6e 74 20 24  g 0..fileevent $
ca20: 66 69 6c 65 20 72 65 61 64 61 62 6c 65 20 5b 6c  file readable [l
ca30: 69 73 74 20 64 6f 5f 68 61 6e 64 73 68 61 6b 65  ist do_handshake
ca40: 20 24 66 69 6c 65 20 72 65 61 64 61 62 6c 65 20   $file readable 
ca50: 5c 0a 09 09 5b 6c 69 73 74 20 67 65 74 64 61 74  \...[list getdat
ca60: 61 20 63 6c 69 65 6e 74 5d 20 2d 62 75 66 66 65  a client] -buffe
ca70: 72 69 6e 67 20 6c 69 6e 65 5d 0a 09 72 65 74 75  ring line]..retu
ca80: 72 6e 0a 20 20 20 20 7d 0a 0a 20 20 20 20 23 20  rn.    }..    # 
ca90: 49 66 20 74 68 65 20 73 6f 63 6b 65 74 20 64 6f  If the socket do
caa0: 65 73 6e 27 74 20 68 69 74 20 65 6e 64 2d 6f 66  esn't hit end-of
cab0: 2d 66 69 6c 65 20 69 6e 20 35 20 73 65 63 6f 6e  -file in 5 secon
cac0: 64 73 2c 20 74 68 65 0a 20 20 20 20 23 20 73 63  ds, the.    # sc
cad0: 72 69 70 74 31 20 70 72 6f 63 65 73 73 20 6d 75  ript1 process mu
cae0: 73 74 20 68 61 76 65 20 69 6e 68 65 72 69 74 65  st have inherite
caf0: 64 20 74 68 65 20 63 6c 69 65 6e 74 2e 0a 0a 20  d the client... 
cb00: 20 20 20 73 65 74 20 66 61 69 6c 65 64 20 30 0a     set failed 0.
cb10: 20 20 20 20 61 66 74 65 72 20 35 30 30 30 20 5b      after 5000 [
cb20: 6c 69 73 74 20 73 65 74 20 66 61 69 6c 65 64 20  list set failed 
cb30: 31 5d 0a 0a 20 20 20 20 23 20 4c 61 75 6e 63 68  1]..    # Launch
cb40: 20 74 68 65 20 73 63 72 69 70 74 32 20 70 72 6f   the script2 pro
cb50: 63 65 73 73 0a 0a 20 20 20 20 65 78 65 63 20 24  cess..    exec $
cb60: 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65  ::tcltest::tclte
cb70: 73 74 20 73 63 72 69 70 74 32 20 26 0a 0a 20 20  st script2 &..  
cb80: 20 20 76 77 61 69 74 20 78 0a 20 20 20 20 69 66    vwait x.    if
cb90: 20 7b 21 24 66 61 69 6c 65 64 7d 20 7b 0a 09 76   {!$failed} {..v
cba0: 77 61 69 74 20 66 61 69 6c 65 64 0a 20 20 20 20  wait failed.    
cbb0: 7d 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 63  }.    set x.} {c
cbc0: 6c 69 65 6e 74 20 73 6f 63 6b 65 74 20 77 61 73  lient socket was
cbd0: 20 6e 6f 74 20 69 6e 68 65 72 69 74 65 64 7d 0a   not inherited}.
cbe0: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 32 2e 33  .test tlsIO-12.3
cbf0: 20 7b 74 65 73 74 69 6e 67 20 69 6e 68 65 72 69   {testing inheri
cc00: 74 61 6e 63 65 20 6f 66 20 61 63 63 65 70 74 65  tance of accepte
cc10: 64 20 73 6f 63 6b 65 74 73 7d 20 5c 0a 09 7b 73  d sockets} \..{s
cc20: 6f 63 6b 65 74 20 65 78 65 63 20 75 6e 69 78 4f  ocket exec unixO
cc30: 6e 6c 79 7d 20 7b 0a 20 20 20 20 6d 61 6b 65 46  nly} {.    makeF
cc40: 69 6c 65 20 7b 7d 20 73 63 72 69 70 74 31 0a 20  ile {} script1. 
cc50: 20 20 20 6d 61 6b 65 46 69 6c 65 20 7b 7d 20 73     makeFile {} s
cc60: 63 72 69 70 74 32 0a 0a 20 20 20 20 73 65 74 20  cript2..    set 
cc70: 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 31 20  f [open script1 
cc80: 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b  w].    puts $f {
cc90: 0a 09 61 66 74 65 72 20 31 30 30 30 30 20 65 78  ..after 10000 ex
cca0: 69 74 0a 09 76 77 61 69 74 20 66 6f 72 65 76 65  it..vwait foreve
ccb0: 72 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73  r.    }.    clos
ccc0: 65 20 24 66 0a 0a 20 20 20 20 73 65 74 20 66 20  e $f..    set f 
ccd0: 5b 6f 70 65 6e 20 73 63 72 69 70 74 32 20 77 5d  [open script2 w]
cce0: 0a 20 20 20 20 70 75 74 73 20 24 66 20 5b 6c 69  .    puts $f [li
ccf0: 73 74 20 73 65 74 20 74 63 6c 73 68 20 24 3a 3a  st set tclsh $::
cd00: 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74  tcltest::tcltest
cd10: 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 5b 6c  ].    puts $f [l
cd20: 69 73 74 20 73 65 74 20 61 75 74 6f 5f 70 61 74  ist set auto_pat
cd30: 68 20 24 61 75 74 6f 5f 70 61 74 68 5d 0a 20 20  h $auto_path].  
cd40: 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 61 63    puts $f {..pac
cd50: 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73  kage require tls
cd60: 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 20  .    }.    puts 
cd70: 24 66 20 22 73 65 74 20 66 20 5c 5b 74 6c 73 3a  $f "set f \[tls:
cd80: 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20  :socket -server 
cd90: 61 63 63 65 70 74 20 5c 0a 09 20 20 20 20 2d 63  accept \..    -c
cda0: 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43  ertfile $serverC
cdb0: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43  ert -cafile $caC
cdc0: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65  ert -keyfile $se
cdd0: 72 76 65 72 4b 65 79 20 38 39 33 30 5c 5d 22 0a  rverKey 8930\]".
cde0: 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70      puts $f {..p
cdf0: 72 6f 63 20 61 63 63 65 70 74 20 7b 20 66 69 6c  roc accept { fil
ce00: 65 20 68 6f 73 74 20 70 6f 72 74 20 7d 20 7b 0a  e host port } {.
ce10: 09 20 20 20 20 67 6c 6f 62 61 6c 20 74 63 6c 73  .    global tcls
ce20: 68 0a 09 20 20 20 20 66 63 6f 6e 66 69 67 75 72  h..    fconfigur
ce30: 65 20 24 66 69 6c 65 20 2d 62 75 66 66 65 72 69  e $file -bufferi
ce40: 6e 67 20 6c 69 6e 65 0a 09 20 20 20 20 70 75 74  ng line..    put
ce50: 73 20 24 66 69 6c 65 20 7b 74 65 73 74 20 64 61  s $file {test da
ce60: 74 61 20 6f 6e 20 73 6f 63 6b 65 74 7d 0a 09 20  ta on socket}.. 
ce70: 20 20 20 65 78 65 63 20 24 74 63 6c 73 68 20 73     exec $tclsh s
ce80: 63 72 69 70 74 31 20 26 0a 09 20 20 20 20 61 66  cript1 &..    af
ce90: 74 65 72 20 31 30 30 30 20 65 78 69 74 0a 09 7d  ter 1000 exit..}
cea0: 0a 09 76 77 61 69 74 20 66 6f 72 65 76 65 72 0a  ..vwait forever.
ceb0: 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20      }.    close 
cec0: 24 66 0a 0a 20 20 20 20 23 20 4c 61 75 6e 63 68  $f..    # Launch
ced0: 20 74 68 65 20 73 63 72 69 70 74 32 20 70 72 6f   the script2 pro
cee0: 63 65 73 73 20 61 6e 64 20 63 6f 6e 6e 65 63 74  cess and connect
cef0: 20 74 6f 20 69 74 2e 20 20 53 65 65 20 68 6f 77   to it.  See how
cf00: 20 6c 6f 6e 67 0a 20 20 20 20 23 20 74 68 65 20   long.    # the 
cf10: 73 6f 63 6b 65 74 20 73 74 61 79 73 20 6f 70 65  socket stays ope
cf20: 6e 0a 0a 20 20 20 20 65 78 65 63 20 24 3a 3a 74  n..    exec $::t
cf30: 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20  cltest::tcltest 
cf40: 73 63 72 69 70 74 32 20 26 0a 0a 20 20 20 20 61  script2 &..    a
cf50: 66 74 65 72 20 32 30 30 30 20 73 65 74 20 6f 6b  fter 2000 set ok
cf60: 5f 74 6f 5f 70 72 6f 63 65 65 64 20 31 0a 20 20  _to_proceed 1.  
cf70: 20 20 76 77 61 69 74 20 6f 6b 5f 74 6f 5f 70 72    vwait ok_to_pr
cf80: 6f 63 65 65 64 0a 0a 20 20 20 20 73 65 74 20 66  oceed..    set f
cf90: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a   [tls::socket \.
cfa0: 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24  .    -certfile $
cfb0: 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69  clientCert -cafi
cfc0: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66  le $caCert -keyf
cfd0: 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c  ile $clientKey \
cfe0: 0a 09 20 20 20 20 31 32 37 2e 30 2e 30 2e 31 20  ..    127.0.0.1 
cff0: 38 39 33 30 5d 0a 20 20 20 20 66 63 6f 6e 66 69  8930].    fconfi
d000: 67 75 72 65 20 24 66 20 2d 62 75 66 66 65 72 69  gure $f -bufferi
d010: 6e 67 20 66 75 6c 6c 20 2d 62 6c 6f 63 6b 69 6e  ng full -blockin
d020: 67 20 30 0a 20 20 20 20 23 20 57 65 20 6e 65 65  g 0.    # We nee
d030: 64 20 74 6f 20 70 75 74 20 61 20 62 79 74 65 20  d to put a byte 
d040: 69 6e 74 6f 20 74 68 65 20 72 65 61 64 20 71 75  into the read qu
d050: 65 75 65 2c 20 6f 74 68 65 72 77 69 73 65 20 74  eue, otherwise t
d060: 68 65 0a 20 20 20 20 23 20 54 4c 53 20 68 61 6e  he.    # TLS han
d070: 64 73 68 61 6b 65 20 64 6f 65 73 6e 27 74 20 66  dshake doesn't f
d080: 69 6e 69 73 68 0a 20 20 20 20 70 75 74 73 20 24  inish.    puts $
d090: 66 20 61 3b 20 66 6c 75 73 68 20 24 66 0a 20 20  f a; flush $f.  
d0a0: 20 20 66 69 6c 65 65 76 65 6e 74 20 24 66 20 72    fileevent $f r
d0b0: 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 67 65  eadable [list ge
d0c0: 74 64 61 74 61 20 61 63 63 65 70 74 65 64 20 24  tdata accepted $
d0d0: 66 5d 0a 0a 20 20 20 20 23 20 49 66 20 74 68 65  f]..    # If the
d0e0: 20 73 6f 63 6b 65 74 20 69 73 20 73 74 69 6c 6c   socket is still
d0f0: 20 6f 70 65 6e 20 61 66 74 65 72 20 35 20 73 65   open after 5 se
d100: 63 6f 6e 64 73 2c 20 74 68 65 20 73 63 72 69 70  conds, the scrip
d110: 74 31 20 70 72 6f 63 65 73 73 0a 20 20 20 20 23  t1 process.    #
d120: 20 6d 75 73 74 20 68 61 76 65 20 69 6e 68 65 72   must have inher
d130: 69 74 65 64 20 74 68 65 20 61 63 63 65 70 74 65  ited the accepte
d140: 64 20 73 6f 63 6b 65 74 2e 0a 0a 20 20 20 20 73  d socket...    s
d150: 65 74 20 66 61 69 6c 65 64 20 30 0a 20 20 20 20  et failed 0.    
d160: 61 66 74 65 72 20 35 30 30 30 20 73 65 74 20 66  after 5000 set f
d170: 61 69 6c 65 64 20 31 0a 0a 20 20 20 20 76 77 61  ailed 1..    vwa
d180: 69 74 20 78 0a 20 20 20 20 73 65 74 20 78 0a 7d  it x.    set x.}
d190: 20 7b 61 63 63 65 70 74 65 64 20 73 6f 63 6b 65   {accepted socke
d1a0: 74 20 77 61 73 20 6e 6f 74 20 69 6e 68 65 72 69  t was not inheri
d1b0: 74 65 64 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f  ted}..test tlsIO
d1c0: 2d 31 33 2e 31 20 7b 54 65 73 74 69 6e 67 20 75  -13.1 {Testing u
d1d0: 73 65 20 6f 66 20 73 68 61 72 65 64 20 73 6f 63  se of shared soc
d1e0: 6b 65 74 20 62 65 74 77 65 65 6e 20 74 77 6f 20  ket between two 
d1f0: 74 68 72 65 61 64 73 7d 20 5c 0a 09 7b 73 6f 63  threads} \..{soc
d200: 6b 65 74 20 74 65 73 74 74 68 72 65 61 64 7d 20  ket testthread} 
d210: 7b 0a 20 20 20 20 23 20 48 4f 42 42 53 3a 20 6e  {.    # HOBBS: n
d220: 65 76 65 72 20 74 65 73 74 65 64 0a 20 20 20 20  ever tested.    
d230: 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70  removeFile scrip
d240: 74 0a 20 20 20 20 74 68 72 65 61 64 52 65 61 70  t.    threadReap
d250: 0a 0a 20 20 20 20 6d 61 6b 65 46 69 6c 65 20 7b  ..    makeFile {
d260: 0a 20 20 20 20 09 70 61 63 6b 61 67 65 20 72 65  .    .package re
d270: 71 75 69 72 65 20 74 6c 73 0a 09 73 65 74 20 66  quire tls..set f
d280: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73   [tls::socket -s
d290: 65 72 76 65 72 20 61 63 63 65 70 74 20 38 38 32  erver accept 882
d2a0: 38 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20  8]..proc accept 
d2b0: 7b 73 20 61 20 70 7d 20 7b 0a 20 20 20 20 20 20  {s a p} {.      
d2c0: 20 20 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20        fileevent 
d2d0: 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73  $s readable [lis
d2e0: 74 20 65 63 68 6f 20 24 73 5d 0a 20 20 20 20 20  t echo $s].     
d2f0: 20 20 20 20 20 20 20 66 63 6f 6e 66 69 67 75 72         fconfigur
d300: 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e 67 20  e $s -buffering 
d310: 6c 69 6e 65 0a 20 20 20 20 20 20 20 20 7d 0a 09  line.        }..
d320: 70 72 6f 63 20 65 63 68 6f 20 7b 73 7d 20 7b 0a  proc echo {s} {.
d330: 09 20 20 20 20 20 67 6c 6f 62 61 6c 20 69 0a 20  .     global i. 
d340: 20 20 20 20 20 20 20 20 20 20 20 20 73 65 74 20              set 
d350: 6c 20 5b 67 65 74 73 20 24 73 5d 0a 20 20 20 20  l [gets $s].    
d360: 20 20 20 20 20 20 20 20 20 69 66 20 7b 5b 65 6f           if {[eo
d370: 66 20 24 73 5d 7d 20 7b 0a 20 20 20 20 20 20 20  f $s]} {.       
d380: 20 20 20 20 20 20 20 20 20 20 67 6c 6f 62 61 6c            global
d390: 20 78 0a 20 20 20 20 20 20 20 20 20 20 20 20 20   x.             
d3a0: 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20      close $s.   
d3b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 73 65                se
d3c0: 74 20 78 20 64 6f 6e 65 0a 20 20 20 20 20 20 20  t x done.       
d3d0: 20 20 20 20 20 20 7d 20 65 6c 73 65 20 7b 20 0a        } else { .
d3e0: 09 20 20 20 20 20 20 20 20 20 69 6e 63 72 20 69  .         incr i
d3f0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20  .               
d400: 20 20 70 75 74 73 20 24 73 20 24 6c 0a 20 20 20    puts $s $l.   
d410: 20 20 20 20 20 20 20 20 20 20 7d 0a 09 7d 0a 09            }..}..
d420: 73 65 74 20 69 20 30 0a 09 76 77 61 69 74 20 78  set i 0..vwait x
d430: 0a 09 63 6c 6f 73 65 20 24 66 0a 0a 09 23 20 74  ..close $f...# t
d440: 68 72 65 61 64 20 63 6c 65 61 6e 73 20 69 74 73  hread cleans its
d450: 65 6c 66 20 75 70 2e 0a 09 74 65 73 74 74 68 72  elf up...testthr
d460: 65 61 64 20 65 78 69 74 0a 20 20 20 20 7d 20 73  ead exit.    } s
d470: 63 72 69 70 74 0a 20 20 20 20 0a 20 20 20 20 23  cript.    .    #
d480: 20 63 72 65 61 74 65 20 61 20 74 68 72 65 61 64   create a thread
d490: 0a 20 20 20 20 73 65 74 20 73 65 72 76 65 72 74  .    set servert
d4a0: 68 72 65 61 64 20 5b 74 65 73 74 74 68 72 65 61  hread [testthrea
d4b0: 64 20 63 72 65 61 74 65 20 7b 20 73 6f 75 72 63  d create { sourc
d4c0: 65 20 73 63 72 69 70 74 20 7d 20 5d 0a 20 20 20  e script } ].   
d4d0: 20 75 70 64 61 74 65 0a 20 20 20 20 0a 20 20 20   update.    .   
d4e0: 20 61 66 74 65 72 20 31 30 30 30 0a 20 20 20 20   after 1000.    
d4f0: 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b  set s [tls::sock
d500: 65 74 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 32  et 127.0.0.1 882
d510: 38 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72  8].    fconfigur
d520: 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e 67 20  e $s -buffering 
d530: 6c 69 6e 65 0a 0a 20 20 20 20 63 61 74 63 68 20  line..    catch 
d540: 7b 0a 09 70 75 74 73 20 24 73 20 22 68 65 6c 6c  {..puts $s "hell
d550: 6f 22 0a 09 67 65 74 73 20 24 73 20 72 65 73 75  o"..gets $s resu
d560: 6c 74 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f  lt.    }.    clo
d570: 73 65 20 24 73 0a 20 20 20 20 75 70 64 61 74 65  se $s.    update
d580: 0a 0a 20 20 20 20 61 66 74 65 72 20 32 30 30 30  ..    after 2000
d590: 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 72 65 73  .    lappend res
d5a0: 75 6c 74 20 5b 74 68 72 65 61 64 52 65 61 70 5d  ult [threadReap]
d5b0: 0a 20 20 20 20 0a 20 20 20 20 73 65 74 20 72 65  .    .    set re
d5c0: 73 75 6c 74 0a 0a 7d 20 7b 68 65 6c 6c 6f 20 31  sult..} {hello 1
d5d0: 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 34  }..test tlsIO-14
d5e0: 2e 31 20 7b 74 65 73 74 20 74 6c 73 3a 3a 75 6e  .1 {test tls::un
d5f0: 69 6d 70 6f 72 74 7d 20 7b 73 6f 63 6b 65 74 7d  import} {socket}
d600: 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 74   {.    list [cat
d610: 63 68 20 7b 74 6c 73 3a 3a 75 6e 69 6d 70 6f 72  ch {tls::unimpor
d620: 74 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b  t} msg] $msg.} {
d630: 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 3a  1 {wrong # args:
d640: 20 73 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a   should be "tls:
d650: 3a 75 6e 69 6d 70 6f 72 74 20 63 68 61 6e 6e 65  :unimport channe
d660: 6c 22 7d 7d 0a 74 65 73 74 20 74 6c 73 49 4f 2d  l"}}.test tlsIO-
d670: 31 34 2e 32 20 7b 74 65 73 74 20 74 6c 73 3a 3a  14.2 {test tls::
d680: 75 6e 69 6d 70 6f 72 74 7d 20 7b 73 6f 63 6b 65  unimport} {socke
d690: 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63  t} {.    list [c
d6a0: 61 74 63 68 20 7b 74 6c 73 3a 3a 75 6e 69 6d 70  atch {tls::unimp
d6b0: 6f 72 74 20 66 6f 6f 20 62 61 72 7d 20 6d 73 67  ort foo bar} msg
d6c0: 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 6f  ] $msg.} {1 {wro
d6d0: 6e 67 20 23 20 61 72 67 73 3a 20 73 68 6f 75 6c  ng # args: shoul
d6e0: 64 20 62 65 20 22 74 6c 73 3a 3a 75 6e 69 6d 70  d be "tls::unimp
d6f0: 6f 72 74 20 63 68 61 6e 6e 65 6c 22 7d 7d 0a 74  ort channel"}}.t
d700: 65 73 74 20 74 6c 73 49 4f 2d 31 34 2e 33 20 7b  est tlsIO-14.3 {
d710: 74 65 73 74 20 74 6c 73 3a 3a 75 6e 69 6d 70 6f  test tls::unimpo
d720: 72 74 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20  rt} {socket} {. 
d730: 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 7b     list [catch {
d740: 74 6c 73 3a 3a 75 6e 69 6d 70 6f 72 74 20 62 6f  tls::unimport bo
d750: 67 75 73 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d  gus} msg] $msg.}
d760: 20 7b 31 20 7b 63 61 6e 20 6e 6f 74 20 66 69 6e   {1 {can not fin
d770: 64 20 63 68 61 6e 6e 65 6c 20 6e 61 6d 65 64 20  d channel named 
d780: 22 62 6f 67 75 73 22 7d 7d 0a 74 65 73 74 20 74  "bogus"}}.test t
d790: 6c 73 49 4f 2d 31 34 2e 34 20 7b 74 65 73 74 20  lsIO-14.4 {test 
d7a0: 74 6c 73 3a 3a 75 6e 69 6d 70 6f 72 74 7d 20 7b  tls::unimport} {
d7b0: 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 23 20  socket} {.    # 
d7c0: 73 74 64 69 6e 20 63 61 6e 20 74 61 6b 65 20 64  stdin can take d
d7d0: 69 66 66 65 72 65 6e 74 20 6e 61 6d 65 73 20 61  ifferent names a
d7e0: 73 20 74 68 65 20 22 74 6f 70 22 20 63 68 61 6e  s the "top" chan
d7f0: 6e 65 6c 0a 20 20 20 20 6c 69 73 74 20 5b 63 61  nel.    list [ca
d800: 74 63 68 20 7b 74 6c 73 3a 3a 75 6e 69 6d 70 6f  tch {tls::unimpo
d810: 72 74 20 73 74 64 69 6e 7d 20 6d 73 67 5d 20 5c  rt stdin} msg] \
d820: 0a 09 5b 73 74 72 69 6e 67 20 6d 61 74 63 68 20  ..[string match 
d830: 7b 62 61 64 20 63 68 61 6e 6e 65 6c 20 22 2a 22  {bad channel "*"
d840: 3a 20 6e 6f 74 20 61 20 54 4c 53 20 63 68 61 6e  : not a TLS chan
d850: 6e 65 6c 7d 20 24 6d 73 67 5d 0a 7d 20 7b 31 20  nel} $msg].} {1 
d860: 31 7d 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 34  1}.test tlsIO-14
d870: 2e 35 20 7b 74 65 73 74 20 74 6c 73 3a 3a 75 6e  .5 {test tls::un
d880: 69 6d 70 6f 72 74 7d 20 7b 73 6f 63 6b 65 74 7d  import} {socket}
d890: 20 7b 0a 20 20 20 20 73 65 74 20 6c 65 6e 20 30   {.    set len 0
d8a0: 0a 20 20 20 20 73 65 74 20 73 70 75 72 69 6f 75  .    set spuriou
d8b0: 73 20 30 0a 20 20 20 20 73 65 74 20 64 6f 6e 65  s 0.    set done
d8c0: 20 30 0a 20 20 20 20 70 72 6f 63 20 72 65 61 64   0.    proc read
d8d0: 6c 69 74 74 6c 65 20 7b 73 7d 20 7b 0a 09 67 6c  little {s} {..gl
d8e0: 6f 62 61 6c 20 73 70 75 72 69 6f 75 73 20 64 6f  obal spurious do
d8f0: 6e 65 20 6c 65 6e 0a 09 73 65 74 20 6c 20 5b 72  ne len..set l [r
d900: 65 61 64 20 24 73 20 31 5d 0a 09 69 66 20 7b 5b  ead $s 1]..if {[
d910: 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 6c  string length $l
d920: 5d 20 3d 3d 20 30 7d 20 7b 0a 09 20 20 20 20 69  ] == 0} {..    i
d930: 66 20 7b 21 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a  f {![eof $s]} {.
d940: 09 09 69 6e 63 72 20 73 70 75 72 69 6f 75 73 0a  ..incr spurious.
d950: 09 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09  .    } else {...
d960: 63 6c 6f 73 65 20 24 73 0a 09 09 73 65 74 20 64  close $s...set d
d970: 6f 6e 65 20 31 0a 09 20 20 20 20 7d 0a 09 7d 20  one 1..    }..} 
d980: 65 6c 73 65 20 7b 0a 09 20 20 20 20 69 6e 63 72  else {..    incr
d990: 20 6c 65 6e 20 5b 73 74 72 69 6e 67 20 6c 65 6e   len [string len
d9a0: 67 74 68 20 24 6c 5d 0a 09 7d 0a 20 20 20 20 7d  gth $l]..}.    }
d9b0: 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 74  .    proc accept
d9c0: 20 7b 73 20 61 20 70 7d 20 7b 0a 09 66 63 6f 6e   {s a p} {..fcon
d9d0: 66 69 67 75 72 65 20 24 73 20 2d 62 6c 6f 63 6b  figure $s -block
d9e0: 69 6e 67 20 30 0a 09 66 69 6c 65 65 76 65 6e 74  ing 0..fileevent
d9f0: 20 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c 69   $s readable [li
da00: 73 74 20 64 6f 5f 68 61 6e 64 73 68 61 6b 65 20  st do_handshake 
da10: 24 73 20 72 65 61 64 61 62 6c 65 20 72 65 61 64  $s readable read
da20: 6c 69 74 74 6c 65 20 5c 0a 09 09 2d 62 75 66 66  little \...-buff
da30: 65 72 69 6e 67 20 6e 6f 6e 65 5d 0a 20 20 20 20  ering none].    
da40: 7d 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73  }.    set s [tls
da50: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20  ::socket \..    
da60: 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65  -certfile $serve
da70: 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63  rCert -cafile $c
da80: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24  aCert -keyfile $
da90: 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 20 20 20  serverKey \..   
daa0: 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20   -server accept 
dab0: 38 38 33 31 5d 0a 20 20 20 20 73 65 74 20 63 20  8831].    set c 
dac0: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09  [tls::socket \..
dad0: 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63      -certfile $c
dae0: 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c  lientCert -cafil
daf0: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69  e $caCert -keyfi
db00: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a  le $clientKey \.
db10: 09 20 20 20 20 6c 6f 63 61 6c 68 6f 73 74 20 38  .    localhost 8
db20: 38 33 31 5d 0a 20 20 20 20 23 20 6f 6e 6c 79 20  831].    # only 
db30: 74 68 65 20 63 6c 69 65 6e 74 20 67 65 74 73 20  the client gets 
db40: 74 6c 73 3a 3a 69 6d 70 6f 72 74 0a 20 20 20 20  tls::import.    
db50: 73 65 74 20 72 65 73 20 5b 74 6c 73 3a 3a 75 6e  set res [tls::un
db60: 69 6d 70 6f 72 74 20 24 63 5d 0a 20 20 20 20 6c  import $c].    l
db70: 69 73 74 20 24 72 65 73 20 5b 63 61 74 63 68 20  ist $res [catch 
db80: 7b 63 6c 6f 73 65 20 24 63 7d 20 65 72 72 5d 20  {close $c} err] 
db90: 24 65 72 72 20 5c 0a 09 5b 63 61 74 63 68 20 7b  $err \..[catch {
dba0: 63 6c 6f 73 65 20 24 73 7d 20 65 72 72 5d 20 24  close $s} err] $
dbb0: 65 72 72 0a 7d 20 7b 7b 7d 20 30 20 7b 7d 20 30  err.} {{} 0 {} 0
dbc0: 20 7b 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 2d 62   {}}..test tls-b
dbd0: 75 67 35 38 2d 31 2e 30 20 7b 74 65 73 74 20 70  ug58-1.0 {test p
dbe0: 72 6f 74 6f 63 6f 6c 20 6e 65 67 6f 74 69 61 74  rotocol negotiat
dbf0: 69 6f 6e 20 66 61 69 6c 75 72 65 7d 20 7b 73 6f  ion failure} {so
dc00: 63 6b 65 74 7d 20 7b 0a 20 20 20 20 23 20 46 6f  cket} {.    # Fo
dc10: 6c 6c 6f 77 69 6e 67 20 63 6f 64 65 20 69 73 20  llowing code is 
dc20: 62 61 73 65 64 20 6f 6e 20 77 68 61 74 20 77 61  based on what wa
dc30: 73 20 72 65 70 6f 72 74 65 64 20 69 6e 20 62 75  s reported in bu
dc40: 67 20 23 35 38 2e 20 50 72 69 6f 72 0a 20 20 20  g #58. Prior.   
dc50: 20 23 20 74 6f 20 66 69 78 20 74 68 65 20 70 72   # to fix the pr
dc60: 6f 67 72 61 6d 20 77 6f 75 6c 64 20 63 72 61 73  ogram would cras
dc70: 68 20 77 69 74 68 20 61 20 73 65 67 66 61 75 6c  h with a segfaul
dc80: 74 2e 0a 20 20 20 20 70 72 6f 63 20 41 63 63 65  t..    proc Acce
dc90: 70 74 20 7b 73 6f 63 6b 20 61 72 67 73 7d 20 7b  pt {sock args} {
dca0: 0a 20 20 20 20 20 20 20 20 66 63 6f 6e 66 69 67  .        fconfig
dcb0: 75 72 65 20 24 73 6f 63 6b 20 2d 62 6c 6f 63 6b  ure $sock -block
dcc0: 69 6e 67 20 30 3b 0a 20 20 20 20 20 20 20 20 66  ing 0;.        f
dcd0: 69 6c 65 65 76 65 6e 74 20 24 73 6f 63 6b 20 72  ileevent $sock r
dce0: 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 48 61  eadable [list Ha
dcf0: 6e 64 73 68 61 6b 65 20 24 73 6f 63 6b 5d 0a 20  ndshake $sock]. 
dd00: 20 20 20 7d 20 0a 20 20 20 20 70 72 6f 63 20 48     } .    proc H
dd10: 61 6e 64 73 68 61 6b 65 20 7b 73 6f 63 6b 7d 20  andshake {sock} 
dd20: 7b 0a 20 20 20 20 20 20 20 20 73 65 74 20 3a 3a  {.        set ::
dd30: 64 6f 6e 65 20 48 41 4e 44 0a 20 20 20 20 20 20  done HAND.      
dd40: 20 20 63 61 74 63 68 20 7b 74 6c 73 3a 3a 68 61    catch {tls::ha
dd50: 6e 64 73 68 61 6b 65 20 24 73 6f 63 6b 7d 20 6d  ndshake $sock} m
dd60: 73 67 0a 20 20 20 20 20 20 20 20 73 65 74 20 3a  sg.        set :
dd70: 3a 64 6f 6e 65 20 24 6d 73 67 0a 20 20 20 20 7d  :done $msg.    }
dd80: 20 0a 20 20 20 20 23 20 4e 4f 54 45 3a 20 77 68   .    # NOTE: wh
dd90: 65 6e 20 64 6f 69 6e 67 20 61 6e 20 69 6e 2d 70  en doing an in-p
dda0: 72 6f 63 65 73 73 20 63 6c 69 65 6e 74 2f 73 65  rocess client/se
ddb0: 72 76 65 72 20 74 65 73 74 2c 20 62 6f 74 68 20  rver test, both 
ddc0: 73 69 64 65 73 20 6e 65 65 64 0a 20 20 20 20 23  sides need.    #
ddd0: 20 74 6f 20 62 65 20 6e 6f 6e 2d 62 6c 6f 63 6b   to be non-block
dde0: 69 6e 67 20 66 6f 72 20 74 68 65 20 54 4c 53 20  ing for the TLS 
ddf0: 68 61 6e 64 73 68 61 6b 65 0a 0a 20 20 20 20 23  handshake..    #
de00: 20 53 65 72 76 65 72 20 2d 20 4f 6e 6c 79 20 61   Server - Only a
de10: 63 63 65 70 74 20 54 4c 53 20 31 2e 32 0a 20 20  ccept TLS 1.2.  
de20: 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f    set s [tls::so
de30: 63 6b 65 74 20 5c 0a 20 20 20 20 20 20 20 20 20  cket \.         
de40: 20 20 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20        -certfile 
de50: 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66  $serverCert -caf
de60: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79  ile $caCert -key
de70: 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20  file $serverKey 
de80: 5c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20  \.              
de90: 20 2d 72 65 71 75 65 73 74 20 30 20 2d 72 65 71   -request 0 -req
dea0: 75 69 72 65 20 30 20 2d 73 73 6c 32 20 30 20 2d  uire 0 -ssl2 0 -
deb0: 73 73 6c 33 20 30 20 2d 74 6c 73 31 20 30 20 2d  ssl3 0 -tls1 0 -
dec0: 74 6c 73 31 2e 31 20 30 20 2d 74 6c 73 31 2e 32  tls1.1 0 -tls1.2
ded0: 20 31 20 5c 0a 20 20 20 20 20 20 20 20 20 20 20   1 \.           
dee0: 20 20 20 20 2d 73 65 72 76 65 72 20 41 63 63 65      -server Acce
def0: 70 74 20 38 38 33 31 5d 0a 20 20 20 20 23 20 43  pt 8831].    # C
df00: 6c 69 65 6e 74 20 2d 20 4f 6e 6c 79 20 70 72 6f  lient - Only pro
df10: 70 6f 73 65 20 54 4c 53 31 2e 30 0a 20 20 20 20  pose TLS1.0.    
df20: 73 65 74 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 6b  set c [tls::sock
df30: 65 74 20 2d 61 73 79 6e 63 20 5c 0a 20 20 20 20  et -async \.    
df40: 20 20 20 20 20 20 20 20 20 20 20 2d 63 61 66 69             -cafi
df50: 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 20 20 20  le $caCert \.   
df60: 20 20 20 20 20 20 20 20 20 20 20 20 2d 72 65 71              -req
df70: 75 65 73 74 20 30 20 2d 72 65 71 75 69 72 65 20  uest 0 -require 
df80: 30 20 2d 73 73 6c 32 20 30 20 2d 73 73 6c 33 20  0 -ssl2 0 -ssl3 
df90: 30 20 2d 74 6c 73 31 20 31 20 2d 74 6c 73 31 2e  0 -tls1 1 -tls1.
dfa0: 31 20 30 20 2d 74 6c 73 31 2e 32 20 30 20 5c 0a  1 0 -tls1.2 0 \.
dfb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 6c                 l
dfc0: 6f 63 61 6c 68 6f 73 74 20 38 38 33 31 5d 0a 20  ocalhost 8831]. 
dfd0: 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 63     fconfigure $c
dfe0: 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 0a 20 20 20   -blocking 0.   
dff0: 20 70 75 74 73 20 24 63 20 61 20 3b 20 66 6c 75   puts $c a ; flu
e000: 73 68 20 24 63 0a 20 20 20 20 61 66 74 65 72 20  sh $c.    after 
e010: 35 30 30 30 20 5b 6c 69 73 74 20 73 65 74 20 3a  5000 [list set :
e020: 3a 64 6f 6e 65 20 74 69 6d 65 6f 75 74 5d 0a 20  :done timeout]. 
e030: 20 20 20 76 77 61 69 74 20 3a 3a 64 6f 6e 65 0a     vwait ::done.
e040: 20 20 20 20 73 77 69 74 63 68 20 2d 65 78 61 63      switch -exac
e050: 74 20 2d 2d 20 24 3a 3a 64 6f 6e 65 20 7b 0a 20  t -- $::done {. 
e060: 20 20 20 20 20 20 20 22 68 61 6e 64 73 68 61 6b         "handshak
e070: 65 20 66 61 69 6c 65 64 3a 20 77 72 6f 6e 67 20  e failed: wrong 
e080: 73 73 6c 20 76 65 72 73 69 6f 6e 22 20 2d 0a 20  ssl version" -. 
e090: 20 20 20 20 20 20 20 22 68 61 6e 64 73 68 61 6b         "handshak
e0a0: 65 20 66 61 69 6c 65 64 3a 20 75 6e 73 75 70 70  e failed: unsupp
e0b0: 6f 72 74 65 64 20 70 72 6f 74 6f 63 6f 6c 22 20  orted protocol" 
e0c0: 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 73 65  {.            se
e0d0: 74 20 3a 3a 64 6f 6e 65 20 22 68 61 6e 64 73 68  t ::done "handsh
e0e0: 61 6b 65 20 66 61 69 6c 65 64 3a 20 77 72 6f 6e  ake failed: wron
e0f0: 67 20 76 65 72 73 69 6f 6e 20 6e 75 6d 62 65 72  g version number
e100: 22 0a 20 20 20 20 20 20 20 20 7d 0a 20 20 20 20  ".        }.    
e110: 7d 0a 20 20 20 20 73 65 74 20 3a 3a 64 6f 6e 65  }.    set ::done
e120: 0a 7d 20 7b 68 61 6e 64 73 68 61 6b 65 20 66 61  .} {handshake fa
e130: 69 6c 65 64 3a 20 77 72 6f 6e 67 20 76 65 72 73  iled: wrong vers
e140: 69 6f 6e 20 6e 75 6d 62 65 72 7d 0a 0a 23 20 63  ion number}..# c
e150: 6c 65 61 6e 75 70 0a 69 66 20 7b 5b 73 74 72 69  leanup.if {[stri
e160: 6e 67 20 6d 61 74 63 68 20 73 6f 63 6b 2a 20 24  ng match sock* $
e170: 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 5d 20 3d  commandSocket] =
e180: 3d 20 31 7d 20 7b 0a 20 20 20 70 75 74 73 20 24  = 1} {.   puts $
e190: 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 20 65 78  commandSocket ex
e1a0: 69 74 0a 20 20 20 66 6c 75 73 68 20 24 63 6f 6d  it.   flush $com
e1b0: 6d 61 6e 64 53 6f 63 6b 65 74 0a 7d 0a 63 61 74  mandSocket.}.cat
e1c0: 63 68 20 7b 63 6c 6f 73 65 20 24 63 6f 6d 6d 61  ch {close $comma
e1d0: 6e 64 53 6f 63 6b 65 74 7d 0a 63 61 74 63 68 20  ndSocket}.catch 
e1e0: 7b 63 6c 6f 73 65 20 24 72 65 6d 6f 74 65 50 72  {close $remotePr
e1f0: 6f 63 43 68 61 6e 7d 0a 3a 3a 74 63 6c 74 65 73  ocChan}.::tcltes
e200: 74 3a 3a 63 6c 65 61 6e 75 70 54 65 73 74 73 0a  t::cleanupTests.
e210: 66 6c 75 73 68 20 73 74 64 6f 75 74 0a 72 65 74  flush stdout.ret
e220: 75 72 6e 0a                                      urn.