home *** CD-ROM | disk | FTP | other *** search
/ Practical Programming in Tcl & Tk (4th Edition) / TCLBOOK4.BIN / pc / exsource.old / 17_6.tcl < prev    next >
Text File  |  2003-04-15  |  1KB  |  50 lines
  1. #
  2. # Example 17-6
  3. # Opening a connection to an HTTP server.
  4. #
  5.  
  6. # Http_Proxy sets or queries the proxy
  7. proc Http_Proxy {{new {}}} {
  8.     global http
  9.     if ![info exists http(proxy)] {
  10.         return {}
  11.     }
  12.     if {[string length $new] == 0} {
  13.         return $http(proxy):$http(proxyPort)
  14.     } else {
  15.         regexp {^([^:]+):([0-9]+)$} $new x \
  16.             http(proxy) http(proxyPort)
  17.     }
  18. }
  19.  
  20. proc Http_Open {url {cmd GET} {query {}}} {
  21.     global http
  22.     if {![regexp -nocase {^(http://)?([^:/]+)(:([0-9]+))?(/.*)} \
  23.             $url x protocol server y port path]} {        error "bogus URL: $url"
  24.     }
  25.     if {[string length $port] == 0} {
  26.         set port 80
  27.     }
  28.     if {[info exists http(proxy)] &&
  29.             [string length $http(proxy)]} {
  30.         set sock [socket $http(proxy) $http(proxyPort)]
  31.         puts $sock "$cmd http://$server:$port$path HTTP/1.0"
  32.     } else {
  33.         set sock [socket $server $port]
  34.         puts $sock "$cmd $path HTTP/1.0"
  35.     }
  36.     puts $sock "User-Agent: Tcl/Tk Http_Open"
  37.     puts $sock "Host: $server"
  38.     if {[string length $query] > 0} {
  39.         puts $sock "Content-Length: [string length $query]"
  40.         puts $sock ""
  41.         puts $sock $query
  42.     }
  43.     puts $sock ""
  44.     flush $sock
  45.     fconfigure $sock -blocking 0
  46.     return $sock
  47. }
  48.  
  49.  
  50.