diff --git a/README.md b/README.md index 85732bd..65a4ead 100644 --- a/README.md +++ b/README.md @@ -145,6 +145,10 @@ which is 10). For 301/302/303 responses the method is changed to GET and the bod dropped. For 307/308 responses the original method and body are preserved. Use the `-with-max-redirects` variants to control the limit, or pass 0 to disable. +A relative `Location` is resolved against the URL of the hop that produced it, +following RFC 3986 §5. A `Location` that carries its own scheme is followed as +given. + ### `RequestConfig` | Function | Purpose | diff --git a/http-client.carp b/http-client.carp index 2122e66..2abd76d 100644 --- a/http-client.carp +++ b/http-client.carp @@ -321,164 +321,41 @@ to follow. Used by `request`, `request-stream`, and convenience methods.") (defn redirect-verb [code verb] (if (or (= code 307) (= code 308)) @verb @"GET")) - (hidden last-index-of-char) - (private last-index-of-char) - (defn last-index-of-char [s c] - (let-do [result -1 - n (String.length s)] - (for [i 0 n] (when (= (String.char-at s i) c) (set! result i))) - result)) - - (hidden min-index) - (private min-index) - (defn min-index [a b] (cond (< a 0) b (< b 0) a (if (< a b) a b))) - - (hidden path-end-index) - (private path-end-index) - (defn path-end-index [s] - (min-index (String.index-of s \?) (String.index-of s \#))) - - (hidden split-query) - (private split-query) - (defn split-query [s] - (let [i (path-end-index s)] - (if (< i 0) - (Pair.init @s @"") - (Pair.init (String.byte-slice s 0 i) - (String.byte-slice s i (String.length s)))))) - - (hidden strip-fragment) - (private strip-fragment) - (defn strip-fragment [s] - (let [h (String.index-of s \#)] (if (< h 0) @s (String.byte-slice s 0 h)))) - - (hidden path-after-authority) - (private path-after-authority) - (defn path-after-authority [url] - (let [scheme-end (String.index-of-string url "://")] - (if (< scheme-end 0) - @url - (let [start (+ scheme-end 3) - slash (String.index-of-from url \/ start)] - (if (< slash 0) @"" (String.byte-slice url slash (String.length url))))))) - - (hidden remove-last-segment) - (private remove-last-segment) - (defn remove-last-segment [s] - (let [idx (last-index-of-char s \/)] - (if (< idx 0) @"" (String.byte-slice s 0 idx)))) - - (hidden first-segment-end) - (private first-segment-end) - (defn first-segment-end [s] - (let [from (if (byte-starts-with? s "/") 1 0) - nxt (String.index-of-from s \/ from)] - (if (< nxt 0) (String.length s) nxt))) - - ; RFC 3986 §5.2.4 remove_dot_segments: collapse `.` and `..` in a path. - (hidden remove-dot-segments) - (private remove-dot-segments) - (defn remove-dot-segments [path] - (let-do [input @path - output @""] - (while (> (String.length &input) 0) - (cond - (byte-starts-with? &input "../") (set! input (drop-bytes &input 3)) - (byte-starts-with? &input "./") (set! input (drop-bytes &input 2)) - (byte-starts-with? &input "/./") - (set! input (String.concat &[@"/" (drop-bytes &input 3)])) - (= &input "/.") (set! input @"/") - (byte-starts-with? &input "/../") - (do - (set! input (String.concat &[@"/" (drop-bytes &input 4)])) - (set! output (remove-last-segment &output))) - (= &input "/..") - (do (set! input @"/") (set! output (remove-last-segment &output))) - (= &input ".") (set! input @"") - (= &input "..") (set! input @"") - (let-do [e (first-segment-end &input)] - (set! output - (String.concat &[@&output (String.byte-slice &input 0 e)])) - (set! input (drop-bytes &input e))))) - output)) - - ; RFC 3986 §5.3 merge: splice a relative-path reference onto the base path. - (hidden merge-paths) - (private merge-paths) - (defn merge-paths [base-path r] - (if (= base-path "") - (String.concat &[@"/" @r]) - (let [idx (last-index-of-char base-path \/)] - (if (< idx 0) - @r - (String.concat &[(String.byte-slice base-path 0 (Int.inc idx)) @r]))))) - - ; Network-path reference (`//authority/path`): keep the base scheme, take the - ; reference's own authority and dot-segment-cleaned path. - (hidden resolve-authority-ref) - (private resolve-authority-ref) - (defn resolve-authority-ref [scheme r] - (let [rest (drop-bytes r 2) - auth-end (min-index (String.index-of &rest \/) (path-end-index &rest)) - authority (if (< auth-end 0) - @&rest - (String.byte-slice &rest 0 auth-end)) - after (if (< auth-end 0) @"" (drop-bytes &rest auth-end)) - pq (split-query &after)] - (String.concat - &[@scheme - @"://" - authority - (remove-dot-segments (Pair.a &pq)) - @(Pair.b &pq)]))) - - ; Absolute-path or relative-path reference: resolve the path against the base - ; path, then re-attach the reference's own query and fragment. - (hidden resolve-path-ref) - (private resolve-path-ref) - (defn resolve-path-ref [origin base-path r] - (let [pq (split-query r) - ref-path (Pair.a &pq) - target (if (byte-starts-with? ref-path "/") - (remove-dot-segments ref-path) - (remove-dot-segments &(merge-paths base-path ref-path)))] - (String.concat &[@origin target @(Pair.b &pq)]))) - - ; Resolves a redirect Location against base-url per RFC 3986 §5. Absolute - ; references are returned unchanged; absolute-path, network-path (//host/…), - ; relative-path (page, ../x), and query-only (?k=v) references are resolved - ; against the base URL's scheme, authority, and path, with ./.. segments - ; removed. If base-url cannot be parsed the location is returned unchanged. + ; uri@0.5.1 parses `/` as an empty path, so URI.resolve inherits the base + ; path; drop this once a uri after 0.5.1 is pinned (carpentry-org/uri#35). + (hidden root-path-ref?) + (private root-path-ref?) + (defn root-path-ref? [location ref] + (and (byte-starts-with? location "/") + (and (not (byte-starts-with? location "//")) + (String.empty? &(Maybe.from @(URI.path ref) @""))))) + + ; RFC 3986 §5 reference resolution. (hidden resolve-location) (private resolve-location) (defn resolve-location [base-url location] - (if (String.contains-string? location "://") - @location - (match (URI.parse base-url) - (Result.Error _) @location - (Result.Success base-uri) - (let [scheme (Maybe.from @(URI.scheme &base-uri) @"http") - host (Maybe.from @(URI.host &base-uri) @"") - port @(URI.port &base-uri) - port-str (match port - (Maybe.Just p) - (if (= p (default-port &scheme)) @"" (fmt ":%d" p)) - (Maybe.Nothing) @"") - origin (String.concat &[@&scheme @"://" @&host @&port-str]) - base-no-fragment (strip-fragment base-url) - base-parts (split-query - &(path-after-authority &base-no-fragment)) - base-path (Pair.a &base-parts) - base-query (Pair.b &base-parts)] - (cond - (byte-starts-with? location "//") - (resolve-authority-ref &scheme location) - (byte-starts-with? location "#") - (String.concat &[@&origin @base-path @base-query @location]) - (byte-starts-with? location "?") - (String.concat &[@&origin @base-path @location]) - (= location "") (String.concat &[@&origin @base-path @base-query]) - (resolve-path-ref &origin base-path location)))))) + (match (URI.parse location) + (Result.Error _) @location + (Result.Success loc-uri) + (if (Maybe.just? (URI.scheme &loc-uri)) + @location + (match (URI.parse base-url) + (Result.Error _) @location + (Result.Success base-uri) + (if (root-path-ref? location &loc-uri) + (URI.str + &(URI.init @(URI.scheme &base-uri) + @(URI.host &base-uri) + @(URI.port &base-uri) + (Maybe.Just @"") + @(URI.query &loc-uri) + @(URI.user &base-uri) + @(URI.password &base-uri) + @(URI.fragment &loc-uri) + (Maybe.Nothing))) + (match (URI.resolve &base-uri location) + (Result.Error _) @location + (Result.Success resolved) (URI.str &resolved))))))) (hidden remove-content-length) (private remove-content-length) diff --git a/test/http-client.carp b/test/http-client.carp index 2298c81..891628b 100644 --- a/test/http-client.carp +++ b/test/http-client.carp @@ -180,6 +180,40 @@ (Result.Error _) true) "cross-origin redirect strips Authorization header") + (assert-equal test + "8791 /echo-path?next=http://127.0.0.1:8791/get" + &(get-body + "http://127.0.0.1:8791/redirect-to?url=%2Fecho-path%3Fnext%3Dhttp%3A%2F%2F127.0.0.1%3A8791%2Fget") + "an absolute-path Location carrying a URL in its query is resolved") + + (assert-true test + (Result.error? + &(Client.get + "http://127.0.0.1:8791/redirect-to?url=mailto%3Anobody%40example.com")) + "a Location with a foreign scheme is not rewritten onto the base origin") + + (assert-equal test + "8792 /echo-path" + &(get-body + "http://127.0.0.1:8791/redirect-to?url=%2F%2F127.0.0.1%3A8792%2Fecho-path") + "a network-path Location keeps the base scheme and takes its own authority") + + (assert-equal test + "8791 /echo-path" + &(get-body "http://127.0.0.1:8791/ü/from") + "a base path with a multi-byte segment resolves a relative Location") + + (assert-true test + (String.contains-string? + &(get-body "http://127.0.0.1:8791/redirect-to?url=%2F") + "