Posted to tcl by jima at Thu Nov 19 13:42:24 GMT 2015view raw

  1. package require http
  2. package require -exact tls 1.6
  3. proc JIMA_TLS {args} {
  4. puts JIMA_TLS($args)
  5. }
  6. set ::caFile caFile
  7. set ::certFile certFile
  8. set ::keyFile keyFile
  9. http::register https 443 [
  10. list ::tls::socket -cafile {} -certfile {} -keyfile {} -require 0 -request 0 -ssl3 0 -ssl2 0 -tls1 1 -tls1.1 1 -tls1.2 1 -command JIMA_TLS
  11. ]
  12.  
  13. # Procedure called whenever a new connection is made by a client.
  14. proc on_connect {newsock clientAddress clientPort} {
  15.  
  16. # This is the place to add checks disallowing connections based
  17. # upon the hostname/ipaddress of the peer.
  18.  
  19. fconfigure $newsock -blocking 0
  20. fileevent $newsock readable [list handleInput $newsock]
  21. }
  22.  
  23. # Procedure called whenever input arrives on a connection.
  24. proc handleInput {f} {
  25. # Delete the handler if the input was exhausted.
  26. if {[eof $f]} {
  27. fileevent $f readable {}
  28. close $f
  29. return
  30. }
  31.  
  32. # Read and handle the incoming information. Here we just log it to
  33. # stdout.
  34.  
  35. set tok [http::geturl https://www.google.es]
  36. set data [http::data $tok]
  37. set code [http::code $tok]
  38. http::cleanup $tok
  39.  
  40. puts $f $code
  41. close $f
  42. return
  43. }
  44.  
  45. # Server
  46. ::tls::socket -server on_connect -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
  47.  
  48. vwait forever