Skip to content

Commit

Permalink
url: fix parsing of relative urls in string->url/literal
Browse files Browse the repository at this point in the history
Also, explicitly check for relative Location urls.
  • Loading branch information
Bogdanp committed Oct 30, 2024
1 parent f3f9da6 commit a5dd780
Show file tree
Hide file tree
Showing 3 changed files with 19 additions and 12 deletions.
15 changes: 9 additions & 6 deletions http-easy-lib/http-easy/private/session.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -282,12 +282,15 @@
(string->url/literal location))
(cond
[(url-host location-url) location-url]
[else (struct-copy
url/literal location-url
[scheme #:parent url (url-scheme orig)]
[user #:parent url (url-user orig)]
[host #:parent url (url-host orig)]
[port #:parent url (url-port orig)])]))
[(not (url-path-absolute? location-url))
(error 'ensure-absolute-url "Location destination is relative")]
[else
(struct-copy
url/literal location-url
[scheme #:parent url (url-scheme orig)]
[user #:parent url (url-user orig)]
[host #:parent url (url-host orig)]
[port #:parent url (url-port orig)])]))

(define (same-origin? a b)
(and
Expand Down
12 changes: 7 additions & 5 deletions http-easy-lib/http-easy/private/url.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -55,7 +55,7 @@
(url/literal scheme user host port abs? path query fragment)))

(define (url/literal->string u)
(match-define (url scheme user host port _ path query fragment) u)
(match-define (url scheme user host port abs? path query fragment) u)
(call-with-output-string
(lambda (out)
(when scheme
Expand All @@ -82,17 +82,19 @@
(write-string "//" out)]
[else
(void)])
(let loop ([path-components path])
(unless (null? path-components)
(write-char #\/ out)
(unless (null? path)
(when abs? (write-char #\/ out))
(let loop ([path-components path])
(match-define (path/param path params)
(car path-components))
(write-string
(maybe-percent-encode
(string-append path (string-join params ";"))
uri-path-segment-encode)
out)
(loop (cdr path-components))))
(unless (null? (cdr path-components))
(write-char #\/ out)
(loop (cdr path-components)))))
(unless (null? query)
(write-char #\? out)
(for* ([pair (in-list query)]
Expand Down
4 changes: 3 additions & 1 deletion http-easy-test/net/http-easy/private/url.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -65,7 +65,9 @@
("http://[email protected]:5100" . "http://[email protected]:5100")
("http://example.com/a/b/c" . "http://example.com/a/b/c")
("http://example.com/a%2Bb.mp3" . "http://example.com/a%2Bb.mp3")
("http://example.com/a%2Bb.mp3?c=d+e" . "http://example.com/a%2Bb.mp3?c=d%2Be")))
("http://example.com/a%2Bb.mp3?c=d+e" . "http://example.com/a%2Bb.mp3?c=d%2Be")
("a/b/c" . "a/b/c")
("/a/b/c" . "/a/b/c")))

(for* ([pair (in-list tests)]
[s (in-value (car pair))]
Expand Down

0 comments on commit a5dd780

Please sign in to comment.