Posted to tcl by marc.ziegenhagen at Tue May 20 11:20:56 GMT 2014view raw

  1. package require http
  2. package require tls
  3.  
  4. ::http::register https 443 [list ::tls::socket \
  5. -require 1 -cadir "/etc/ssl/certs"]
  6.  
  7. proc bgerror {msg} {
  8. puts stderr "bgerror: $msg\n$::errorInfo"
  9. }
  10.  
  11. proc callback {token} {
  12. gloabl G
  13. upvar #0 $token state
  14.  
  15. switch -- $state(status) {
  16. error {
  17. puts stderr "Error: $state(error)"
  18. }
  19. ok {
  20. puts "Body: $state(body)"
  21. }
  22. default {
  23. puts "Unknown state: $state(status)"
  24. }
  25. }
  26.  
  27. set G(run) 0
  28. http::destroy $token
  29. }
  30.  
  31. set url "https://80.254.163.223/ippf/checkapplication"
  32. set timeout 15000
  33.  
  34. puts "URL: $url"
  35.  
  36. if {[catch {::http::geturl $url \
  37. -timeout $timeout -type multipart/form-data \
  38. -command [list callback]} token]} {
  39. puts stderr "Error: $token"
  40. exit 1
  41. }
  42. puts "url runs: $token"
  43.  
  44. set G(run) 1
  45. vwait G(run)
  46.  
  47. puts "G(run): $G(run)"
  48. # -headers [list Authorization $auth]