home *** CD-ROM | disk | FTP | other *** search
/ Practical Programming in Tcl & Tk (4th Edition) / TCLBOOK4.BIN / pc / exsource.old / 17_13.tcl < prev    next >
Text File  |  2003-04-15  |  820b  |  39 lines
  1. #
  2. # Example 17-13
  3. # Basic Authentication using http::geturl.
  4. #
  5.  
  6. package require base64
  7. package require http
  8. proc BasicAuthentication {url promptProc} {
  9.     set token [http::geturl $url]
  10.     http::wait $token
  11.     if {[string match *401* [http::code $token]]} {
  12.         upvar #0 $token data
  13.  
  14.         # Extract the realm from the Www-Authenticate line
  15.  
  16.         array set reply $data(meta)
  17.         if {[regexp {realm=(.*)} $reply(Www-Authenticate) \
  18.                 x realm]} {
  19.  
  20.             # Call back to prompt for username, password
  21.  
  22.             set answer [$promptProc $realm]
  23.             http::cleanup $token
  24.  
  25.             # Encode username:password and pass this in
  26.             # the Authorization header
  27.  
  28.             set auth [base64::encode \
  29.                 [lindex $answer 0]:[lindex $answer 1]]
  30.             set token [http::geturl $url -headers \
  31.                 [list Authorization "Basic $auth"]]
  32.             http::wait $token
  33.         }
  34.     }
  35.     return $token
  36. }
  37.  
  38.  
  39.