1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
|
# Initialization of TLS for the example applications.
tls::init \
-keyfile $selfdir/certs/${type}.key \
-certfile $selfdir/certs/${type}.crt \
-cafile $selfdir/certs/ca.crt \
-ssl2 1 \
-ssl3 1 \
-tls1 0 \
-require 1 \
-password PWD \
-command CMD
proc PWD {args} {
puts P\t($args)
return $type
}
proc CMD {option args} {
switch -- $option {
error {
return 1
}
info {
foreach {chan major minor message} $args break
puts "@ $chan ($major, $minor) = $message"
return 1
}
verify {
foreach {chan depth cert rc err} $args break
array set c $cert
puts CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
puts "C $chan $depth/$rc = $err"
parray c
puts ____________________________________________________________
# Code to perform additional checks on the cert goes here.
# always accept, even if rc is not 1 application
# connection handler will determine what to do
return 1
}
default {
return -code error "bad option \"$option\": must be one of error, info, or verify"
}
}
return
}
|
