DN550199948

Subject: Re: HTTP example of handling redirection (302 errors) - DN [1]

Brent Welch <welch@scriptics.com> - 18 Nov 1999 - comp.lang.tcl

 I added an example about Basic authentication and http::geturl.
 For redirects, you'll have to adapt the code from another example
 that uses the books' Http package (the old code base.)
 I'll append a "geturl" script that I use to fetch URLs from
 the command line, and I've just added redirect handling to it.

 >>>Christopher Nelson said:
  > I can't seem to get HTTP redirection working with the http 2.0 package under
       Tcl
  > 8.0 or 8.2 on Win32 or UNIX.  The man page doesn't really help.  Can anyone
      give
  > me a working example?
  >
  > Brent, does your 3rd ed go into any more detail on HTTP?

 --    Brent Welch    <welch@scriptics.com>
     http://www.scriptics.com
     Scriptics: The Tcl Platform Company

 #!/bin/sh
 #
 # geturl
 #
 # \
 exec tclsh8.2 "$0" ${1+"$@"}

 package require http 2.1

 if {$argc < 1} {
     puts stderr "Usage: geturl url ?file?"
     exit 1
 }
 set url [lindex $argv 0]
 if {$argc >= 2} {
     set file [lindex $argv 1]
     set channel [open $file w]
 } else {
     set channel stdout
 }

 # Do the initial URL fetch

 set token [http::geturl $url -channel $channel]
 http::wait $token

 # Get a useful name for the state array

 upvar #0 $token data

 # http::code is the first line of the protocol,
 # $code is 200, 302, 404, or some other code
 # The 300 series of codes is for redirects

 set code [lindex  [http::code $token] 1]
 while {[string match 3* $code]} {
     array set headers $data(meta)
     if {[string compare $channel "stdout"] != 0} {
     puts "Location:$headers(Location)"
     }

     # http::cleanup is new in http 2.1, it is equivalent to
     # unset $token

     http::cleanup $token

     # Try the redirected location.  There is an extra space
     # that confuses http::geturl, hence the string trim

     set token [http::geturl [string trim $headers(Location)] -channel $channel]
     http::wait $token
     upvar #0 $token data
     set code [lindex  [http::code $token] 1]
     unset headers
 }

 # If we are copying the URL to a file, then we dump the
 # protocol headers to standard output.

 if {[string compare $channel "stdout"] != 0} {
     close $channel
     puts $data(http)
     foreach {name value} $data(meta) {
         puts "$name: $value"
     }
 }