proc vfs::http::urlparse {url} {
    # Taken from http 2.5.3

    # Validate URL by parts.  We suck out user:pass if it exists as the
    # core http package does not automate HTTP Basic Auth yet.

    # Returns data in [array get] format.  The url, host and file keys are
    # guaranteed to exist.  proto, port, query, anchor, and user should be
    # checked with [info exists]. (user may contain password)

    # URLs have basically four parts.
    # First, before the colon, is the protocol scheme (e.g. http)
    # Second, for HTTP-like protocols, is the authority
    #        The authority is preceded by // and lasts up to (but not including)
    #        the following / and it identifies up to four parts, of which only one,
    #        the host, is required (if an authority is present at all). All other
    #        parts of the authority (user name, password, port number) are optional.
    # Third is the resource name, which is split into two parts at a ?
    #        The first part (from the single "/" up to "?") is the path, and the
    #        second part (from that "?" up to "#") is the query. *HOWEVER*, we do
    #        not need to separate them; we send the whole lot to the server.
    # Fourth is the fragment identifier, which is everything after the first
    #        "#" in the URL. The fragment identifier MUST NOT be sent to the server
    #        and indeed, we don't bother to validate it (it could be an error to
    #        pass it in here, but it's cheap to strip).
    #
    # An example of a URL that has all the parts:
    #   http://jschmoe:[email protected]:8000/foo/bar.tml?q=foo#changes
    # The "http" is the protocol, the user is "jschmoe", the password is
    # "xyzzy", the host is "www.bogus.net", the port is "8000", the path is
    # "/foo/bar.tml", the query is "q=foo", and the fragment is "changes".
    #
    # Note that the RE actually combines the user and password parts, as
    # recommended in RFC 3986. Indeed, that RFC states that putting passwords
    # in URLs is a Really Bad Idea, something with which I would agree utterly.
    # Also note that we do not currently support IPv6 addresses.
    #
    # From a validation perspective, we need to ensure that the parts of the
    # URL that are going to the server are correctly encoded.

    set URLmatcher {(?x)                # this is _expanded_ syntax
        ^
        (?: (\w+) : ) ?                        # <protocol scheme>
        (?: //
            (?:
                (
                    [^@/\#?]+                # <userinfo part of authority>
                ) @
            )?
            ( [^/:\#?]+ )                # <host part of authority>
            (?: : (\d+) )?                # <port part of authority>
        )?
        ( / [^\#?]* (?: \? [^\#?]* )?)?        # <path> (including query)
        (?: \# (.*) )?                        # <fragment> (aka anchor)
        $
    }

    # Phase one: parse
    if {![regexp -- $URLmatcher $url -> proto user host port srvurl anchor]} {
        unset $token
        return -code error "Unsupported URL: $url"
    }
    # Phase two: validate
    if {$host eq ""} {
        # Caller has to provide a host name; we do not have a "default host"
        # that would enable us to handle relative URLs.
        unset $token
        return -code error "Missing host part: $url"
        # Note that we don't check the hostname for validity here; if it's
        # invalid, we'll simply fail to resolve it later on.
    }
    if {$port ne "" && $port>65535} {
        unset $token
        return -code error "Invalid port number: $port"
    }
    # The user identification and resource identification parts of the URL can
    # have encoded characters in them; take care!
    if {$user ne ""} {
        # Check for validity according to RFC 3986, Appendix A
        set validityRE {(?xi)
            ^
            (?: [-\w.~!$&'()*+,;=:] | %[0-9a-f][0-9a-f] )+
            $
        }
        if {![regexp -- $validityRE $user]} {
            unset $token
            # Provide a better error message in this error case
            if {[regexp {(?i)%(?![0-9a-f][0-9a-f]).?.?} $user bad]} {
                return -code error \
                        "Illegal encoding character usage \"$bad\" in URL user"
            }
            return -code error "Illegal characters in URL user"
        }
    }
    if {$srvurl ne ""} {
        # Check for validity according to RFC 3986, Appendix A
        set validityRE {(?xi)
            ^
            # Path part (already must start with / character)
            (?:              [-\w.~!$&'()*+,;=:@/]  | %[0-9a-f][0-9a-f] )*
            # Query part (optional, permits ? characters)
            (?: \? (?: [-\w.~!$&'()*+,;=:@/?] | %[0-9a-f][0-9a-f] )* )?
            $
        }
        if {![regexp -- $validityRE $srvurl]} {
            unset $token
            # Provide a better error message in this error case
            if {[regexp {(?i)%(?![0-9a-f][0-9a-f])..} $srvurl bad]} {
                return -code error \
                        "Illegal encoding character usage \"$bad\" in URL path"
            }
            return -code error "Illegal characters in URL path"
        }
    } else {
        set srvurl /
    }
    if {$proto eq ""} {
        set proto http
    } else {
        set result(proto) $proto
    }

    # Here we vary from core http

    # vfs::http supports all the protocols that http knows about...
    if { [catch {::http::unregister $proto} spec] == 0 } {
        ::http::register $proto [lindex $spec 0] [lindex $spec 1]
    } else {
        return -code error "Unsupported URL type \"$proto\""
    }

    # OK, now reassemble into a full URL, with result containing the
    # parts that exist and will be returned to the user
    array set result {}
    set url ${proto}://
    if {$user ne ""} {
        set result(user) $user
        # vfs::http will do HTTP basic auth on their existence,
        # but we pass these through as they are innocuous
        append url $user
        append url @
    }
    append url $host
    set result(host) $host
    if {$port ne ""} {
        # don't bother with adding default port
        append url : $port
        set result(port) $port
    }
    append url $srvurl
    if {$anchor ne ""} {
        # XXX: Don't append see the anchor, as it is generally a client-side
        # XXX: item.  The user can add it back if they want.
        #append url \# $anchor
        set result(anchor) $anchor
    }

    set idx [string first ? $srvurl]
    if {$idx >= 0} {
        set query [string range [expr {$idx+1}] end]
        set file  [string range 0 [expr {$idx-1}]]
        set result(file) $file
        set result(query) $query
    } else {
        set result(file) $srvurl
    }

    set result(url) $url

    # return array format list of items
    return [array get result]
}