Posted to tcl by bohagan at Fri Jul 05 01:50:49 GMT 2024view raw

  1.  
  2. proc callback_handler {fn chan args} {
  3. switch $fn {
  4. "error" {
  5. # New
  6. lassign $args message
  7. }
  8. "info" {
  9. # Updated
  10. set type ""
  11. lassign $args major minor message type
  12. }
  13. "message" {
  14. # New
  15. lassign $args direction version content_type message
  16. }
  17. "session" {
  18. # New
  19. lassign $args session_id ticket lifetime
  20. }
  21. "verify" {
  22. # Obsolete
  23. return [validate_handler verify $chan {*}$args]
  24. }
  25. default {
  26. }
  27. }
  28. }
  29.  
  30. proc password_handler {{fn password} {rwflag 0} {size 0}} {
  31.  
  32. }
  33.  
  34. proc validate_handler {fn chan args} {
  35. switch $fn {
  36. "alpn" {
  37. # new - server obly
  38. lassign $args protocol match
  39. }
  40. "hello" {
  41. # new - server only
  42. lassign $args servername
  43. }
  44. "sni" {
  45. # new - server only
  46. lassign $args servername
  47. }
  48. "verify" {
  49. # Moved
  50. lassign $args depth cert status error
  51. }
  52. default {
  53. }
  54. }
  55. return 1
  56. }
  57.  
  58. set cmd [list tls::import $chan -command callback_handler]
  59. if {[package vsatisfies [package provide tls] 1.8]} {
  60. lappend cmd -password password_handler -validatecommand validate_handler
  61. }
  62. eval $cmd
  63.