Posted to tcl by jima at Thu Nov 26 10:09:00 GMT 2015view raw

  1. set ::showTheError 1;# make this 0 or 1 to show or not the bad behavior.
  2.  
  3. package require http
  4. #package require -exact tls 1.6
  5. package require tls
  6. proc JIMA_TLS {args} {
  7. puts JIMA_TLS($args)
  8. }
  9. proc JIMA_OTHER_TLS {args} {
  10. puts JIMA_OTHER_TLS($args)
  11. }
  12. set ::caFile caFile
  13. set ::certFile certFile
  14. set ::keyFile keyFile
  15. http::register https 443 [
  16. list ::tls::socket -cafile {} -certfile {} -keyfile {} -require 0 -request 0 -ssl3 0 -ssl2 0 -tls1 1 -tls1.1 1 -tls1.2 1 -command JIMA_OTHER_TLS
  17. ]
  18.  
  19. # Procedure called whenever a new connection is made by a client.
  20. proc on_connect {serverPort newsock clientAddress clientPort} {
  21. fconfigure $newsock -blocking 0
  22. puts $newsock/$clientAddress/$clientPort
  23. fileevent $newsock readable [
  24. list handleInput $newsock $clientPort $serverPort
  25. ]
  26. }
  27.  
  28. # Procedure called whenever input arrives on a connection.
  29. proc handleInput {f clientPort serverPort} {
  30. # Delete the handler if the input was exhausted.
  31. if {[eof $f]} {
  32. fileevent $f readable {}
  33. close $f
  34. return
  35. }
  36. #
  37. gets $f
  38. #
  39. set code OK
  40. if {$::showTheError} {
  41. set tok [http::geturl https://www.google.es]
  42. set code [http::code $tok]
  43. http::cleanup $tok
  44. }
  45. #
  46. puts HANDLING($f)($code)
  47. puts $f $code/$serverPort/$clientPort
  48. close $f
  49. return
  50. }
  51.  
  52. # Server 0
  53. ::tls::socket -server {on_connect 8080} -cafile $::caFile -certfile $::certFile -keyfile $::keyFile -require 0 -request 0 -ssl3 0 -ssl2 0 -tls1 1 -tls1.1 1 -tls1.2 1 -command JIMA_TLS 8080
  54.  
  55. # Server 1
  56. #::tls::socket -server {on_connect 8090} -cafile $::caFile -certfile $::certFile -keyfile $::keyFile -require 0 -request 0 -ssl3 0 -ssl2 0 -tls1 1 -tls1.1 1 -tls1.2 1 -command JIMA_TLS 8090
  57.  
  58.  
  59. vwait forever