Posted to tcl by rmax at Thu Jul 25 09:55:36 GMT 2013view raw

  1. proc GET {args} {
  2. global cookies headers
  3. # puts "GET [lindex $args 0]"
  4. lappend args -headers [array get headers]
  5. set headers(Referer) [regexp -inline {^[^?]+} [lindex $args 0]]
  6. # puts $args
  7. set t [eval [linsert $args 0 http::geturl]]
  8. upvar "#0" $t state
  9. foreach {key value} $state(meta) {
  10. switch -- $key {
  11. Set-Cookie {
  12. # puts "$key: $value"
  13. array set cookies [split [lindex [split $value ";"] 0] =]
  14. }
  15. Location {
  16. set location $value
  17. }
  18. }
  19. }
  20. set c [list]
  21. foreach {name value} [array get cookies] {
  22. lappend c $name=$value
  23. }
  24. set headers(Cookie) [join $c "; "]
  25.  
  26. switch -- [http::ncode $t] {
  27. 200 {
  28. set data [http::data $t]
  29. }
  30. 302 {
  31. if {![regexp {://} $location]} {
  32. set url [lindex $args 0]
  33. regsub {/[^/]*$} $url /$location location
  34. }
  35. # puts "Redirect: $location"
  36. set data [GET $location]
  37. }
  38. default {
  39. puts [http::code $t]
  40. puts [http::error $t]
  41. puts [http::data $t]
  42. exit
  43. }
  44. }
  45. http::cleanup $t
  46. return $data
  47. }
  48.