diff options
| -rw-r--r-- | ChangeLog | 6 | ||||
| -rw-r--r-- | library/http/http.tcl | 10 | ||||
| -rw-r--r-- | library/http/pkgIndex.tcl | 2 | ||||
| -rw-r--r-- | tests/http.test | 8 |
4 files changed, 20 insertions, 6 deletions
@@ -1,3 +1,9 @@ +2003-07-18 Jeff Hobbs <jeffh@ActiveState.com> + + * library/http/pkgIndex.tcl: upped to http v2.4.4 + * library/http/http.tcl: add support for user:pass info in URL. + * tests/http.test: [Bug 759888] (shiobara) + 2003-07-18 Don Porter <dgp@users.sourceforge.net> * doc/AddErrInfo.3: Improved consistency of documentation diff --git a/library/http/http.tcl b/library/http/http.tcl index 3e6f8ec..31938cf 100644 --- a/library/http/http.tcl +++ b/library/http/http.tcl @@ -9,7 +9,7 @@ # See the file "license.terms" for information on usage and # redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: http.tcl,v 1.44 2003/03/19 21:57:47 dgp Exp $ +# RCS: @(#) $Id: http.tcl,v 1.45 2003/07/18 19:36:40 hobbs Exp $ # Rough version history: # 1.0 Old http_get interface @@ -25,7 +25,7 @@ package require Tcl 8.2 # keep this in sync with pkgIndex.tcl # and with the install directories in Makefiles -package provide http 2.4.3 +package provide http 2.4.4 namespace eval http { variable http @@ -288,9 +288,11 @@ proc http::geturl { url args } { } # Validate URL, determine the server host and port, and check proxy case + # Recognize user:pass@host URLs also, although we do not do anything + # with that info yet. - if {![regexp -nocase {^(([^:]*)://)?([^/:]+)(:([0-9]+))?(/.*)?$} $url \ - x prefix proto host y port srvurl]} { + set exp {^(([^:]*)://)?([^@]+@)?([^/:]+)(:([0-9]+))?(/.*)?$} + if {![regexp -nocase $exp $url x prefix proto user host y port srvurl]} { unset $token return -code error "Unsupported URL: $url" } diff --git a/library/http/pkgIndex.tcl b/library/http/pkgIndex.tcl index 3adc591..82c68f5 100644 --- a/library/http/pkgIndex.tcl +++ b/library/http/pkgIndex.tcl @@ -9,4 +9,4 @@ # full path name of this file's directory. if {![package vsatisfies [package provide Tcl] 8.2]} {return} -package ifneeded http 2.4.3 [list tclPkgSetup $dir http 2.4.3 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister}}}] +package ifneeded http 2.4.4 [list tclPkgSetup $dir http 2.4.4 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister}}}] diff --git a/tests/http.test b/tests/http.test index 3049742..905abdd 100644 --- a/tests/http.test +++ b/tests/http.test @@ -12,7 +12,7 @@ # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # -# RCS: @(#) $Id: http.test,v 1.34 2003/06/27 17:22:41 dgp Exp $ +# RCS: @(#) $Id: http.test,v 1.35 2003/07/18 19:36:40 hobbs Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -134,6 +134,7 @@ test http-3.3 {http::geturl} { set tail /a/b/c set url [info hostname]:$port/a/b/c +set fullurl http://user:pass@[info hostname]:$port/a/b/c set binurl [info hostname]:$port/binary set posturl [info hostname]:$port/post set badposturl [info hostname]:$port/droppost @@ -309,6 +310,11 @@ test http-3.13 {http::geturl socket leak test} { expr {[llength [file channels]] == $chanCount} } 1 +test http-3.14 "http::geturl $fullurl" { + set token [http::geturl $fullurl -validate 1] + http::code $token +} "HTTP/1.0 200 OK" + test http-4.1 {http::Event} { set token [http::geturl $url] upvar #0 $token data |