Posted to tcl by metasyntax at Wed Mar 13 15:44:52 GMT 2013view raw

  1. #!/usr/bin/env tclsh
  2.  
  3. # Set needed packages
  4. package require Thread
  5. package require http
  6.  
  7. # Create the proc
  8. proc isHTTP {url} {
  9.  
  10. # Set MasterID
  11. set mid [thread::id]
  12.  
  13. # Create the thread
  14. set tid [thread::create {
  15.  
  16. # Create thread proc
  17. proc isThreadHTTP {mid url} {
  18.  
  19. # Set needed packages
  20. package require http
  21. package require tls
  22.  
  23. # Add support for HTTPS
  24. ::http::register https 443 ::tls::socket
  25.  
  26. # Set the token "10000/10s"
  27. if {[catch {set token [::http::geturl $url -binary 1 -timeout 10000]} error]} {
  28. set result "Error: Invalid URL"
  29. } else {
  30. upvar #0 $token state
  31.  
  32. # Check if a timeout has occurred
  33. if {[::http::status $token]=="timeout"} {
  34. set result "Error: timeout occurred"
  35. # Check if statuscode was okay "http://en.wikipedia.org/wiki/List_of_HTTP_status_codes"
  36. } elseif {![regexp -nocase {^(20[0-7]|30[1-2]|405)$} [::http::ncode $token]]} {
  37. set result "Error: $ncode"
  38.  
  39. # Check if whole file is downloaded
  40. } elseif {[::http::size $token]!=$state(totalsize) && [expr [string length $data]+1]!=[::http::size $token]} {
  41. set result "File error: [isWhatSize $state(totalsize)] <-remote local -> [isWhatSize [::http::size $token]]"
  42.  
  43. # Check if the request was successful
  44. } elseif {[::http::status $token]=="ok"} {set data "[::http::data $token]"
  45.  
  46. # Check if we got any error
  47. } elseif {[::http::status $token]=="error"} {set result "Error: [::http::error $token]"
  48.  
  49. # Cleanup the memory we used
  50. } elseif {[info exists token]} {
  51. ::http::cleanup $token
  52. }
  53. }
  54.  
  55. # Return result
  56. if {[info exists result]} {
  57. thread::send -async $mid [list set asdf [list 0 $result]]
  58. } else {
  59. thread::send -async $mid [list set asdf [list 1 $data]]
  60. }
  61. thread::release
  62. }
  63. thread::wait
  64. }]
  65. thread::send -async $tid "isThreadHTTP $mid $url"
  66. }
  67.  
  68. # Set the url
  69. set url "http://www.google.se/images/google_favicon_128.png"
  70.  
  71. isHTTP $url
  72.  
  73. vwait asdf
  74. # Try to get the results
  75. puts "Data: [lindex $asdf 1]"
  76.  
  77. # Try to show something else in mean time
  78. puts "It works"