suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

add support for redirections to get-pure-port and add get-pure-port/headers

Browse Source 
original commit: 11a3d9b0ac
This commit is contained in:
Robby Findler 2011-10-03 08:10:43 -05:00
parent 853e6d7827
commit 8f9006e82e
2 changed files with 103 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
collects/net/scribblings/url.scrbl
View File

@ -188,7 +188,8 @@ Determines the default conversion to and from strings for
@deftogether[(
@defproc[(get-pure-port [URL url?]
[header (listof string?) null])
[header (listof string?) null]
[#:redirections redirections exact-nonnegative-integer? 0])
input-port?]
@defproc[(head-pure-port [URL url?]
[header (listof string?) null])
@ -204,7 +205,9 @@ optional list of strings can be used to send header lines to the
server.
The GET method is used to retrieve whatever information is identified
by @racket[URL].
by @racket[URL]. If @racket[redirections] is not @racket[0], then
@racket[get-pure-port] will follow redirections from the server,
up to the limit given by @racket[redirections].
The HEAD method is identical to GET, except the server must not return
a message body. The meta-information returned in a response to a HEAD
@ -304,6 +307,18 @@ empty string, or it will be a string matching the following regexp:
#rx"^HTTP/.*?(\r\n\r\n|\n\n|\r\r)"
]}
@defproc[(get-pure-port/headers
[url url?]
[headers (listof string?) '()]
[#:redirections redirections exact-nonnegative-integer? 0])
(values input-port? string?)]{
This function is an alternative to calling @racket[get-impure-port] and
@racket[purify-port] when needing to follow redirections.
That is, it does a GET request on @racket[url], follows up to
@racket[redirections] redirections and returns a port containing
the data as well as the headers for the final connection.
}
@defproc*[([(call/input-url [URL url?]
[connect (url? . -> . input-port?)]

85
collects/tests/net/url-port.rkt
View File

@ -4,12 +4,14 @@
openssl
tests/eli-tester)
(define (run-tests scheme wrap-ports)
(define ((make-tester url->port) response)
(define port-no 9001)
(define (run-tests scheme wrap-ports skip-actual-redirect?)
(define ((make-tester url->port) response . responses)
(define first-port-no 9001)
(define server-cust
(make-custodian))
(parameterize ([current-custodian server-cust])
(for ([response (in-list (cons response responses))]
[port-no (in-naturals first-port-no)])
(thread
(λ ()
(run-server port-no
@ -19,15 +21,17 @@
(display response op)
(close-output-port op)
(close-input-port ip)))
+inf.0))))
+inf.0)))))
(sleep 1)
(dynamic-wind
void
(λ ()
(port->string
(call-with-values
(λ ()
(url->port
(url scheme #f "localhost" port-no
#t empty empty #f))))
(url scheme #f "localhost" first-port-no
#t empty empty #f)))
(λ vals (apply values (cons (port->string (car vals)) (cdr vals))))))
(λ ()
(custodian-shutdown-all server-cust))))
@ -35,6 +39,12 @@
(make-tester get-pure-port))
(define get-impure
(make-tester get-impure-port))
(define get-pure/redirect
(make-tester (λ (x) (get-pure-port x #:redirections 1))))
(define get-pure/headers
(make-tester get-pure-port/headers))
(define get-pure/headers/redirect
(make-tester (λ (x) (get-pure-port/headers x #:redirections 1))))
(test
(get-pure
@ -52,21 +62,70 @@
=>
"This is the data in the first chand this is the second oneXXXXXXX"
(get-impure
"HTTP/1.1 200 OK\r\nContent-Type: text/plain\r\nTransfer-Encoding: chunked\r\n\r\n23\r\nThis is the data in the first chunk\r\n1A\r\nand this is the second one\r\n0\r\n")
(get-pure/redirect
"HTTP/1.1 200 OK\r\nContent-Type: text/plain\r\nTransfer-Encoding: chunked\r\n\r\n24\r\nThis is the data in the first chunk \r\n1A\r\nand this is the second one\r\n0\r\n")
=>
"HTTP/1.1 200 OK\r\nContent-Type: text/plain\r\nTransfer-Encoding: chunked\r\n\r\n23\r\nThis is the data in the first chunk\r\n1A\r\nand this is the second one\r\n0\r\n"
"This is the data in the first chunk and this is the second one"
(get-pure/redirect
"HTTP/1.0 200 OK\r\nContent-Type: text/plain\r\n\r\nThis is the data in the first chunk and this is the second one")
=>
"This is the data in the first chunk and this is the second one"
(get-pure/redirect
"HTTP/1.1 200 OK\r\nContent-Type: text/plain\r\nTransfer-Encoding: chunked\r\n\r\n20\r\nThis is the data in the first ch\r\n21\r\nand this is the second oneXXXXXXX\r\n0\r\n")
=>
"This is the data in the first chand this is the second oneXXXXXXX"
(get-impure
"HTTP/1.0 200 OK\r\nContent-Type: text/plain\r\n\r\nThis is the data in the first chunk and this is the second one\r\n")
=>
"HTTP/1.0 200 OK\r\nContent-Type: text/plain\r\n\r\nThis is the data in the first chunk and this is the second one\r\n"
))
(run-tests "http" values)
(get-pure/headers
"HTTP/1.1 200 OK\r\nContent-Type: text/plain\r\nTransfer-Encoding: chunked\r\n\r\n24\r\nThis is the data in the first chunk \r\n1A\r\nand this is the second one\r\n0\r\n")
=>
(values "This is the data in the first chunk and this is the second one"
"Content-Type: text/plain\r\nTransfer-Encoding: chunked\r\n")
(get-pure/headers
"HTTP/1.0 200 OK\r\nContent-Type: text/plain\r\n\r\nThis is the data in the first chunk and this is the second one")
=>
(values "This is the data in the first chunk and this is the second one"
"Content-Type: text/plain\r\n")
(get-pure/headers
"HTTP/1.1 200 OK\r\nContent-Type: text/plain\r\nTransfer-Encoding: chunked\r\n\r\n20\r\nThis is the data in the first ch\r\n21\r\nand this is the second oneXXXXXXX\r\n0\r\n")
=>
(values "This is the data in the first chand this is the second oneXXXXXXX"
"Content-Type: text/plain\r\nTransfer-Encoding: chunked\r\n")
(get-pure/headers
"HTTP/1.1 200 OK\r\nContent-Type: text/plain\r\nTransfer-Encoding: chunked\r\nAnother-Header: ta-daa\r\n\r\n20\r\nThis is the data in the first ch\r\n21\r\nand this is the second oneXXXXXXX\r\n0\r\n")
=>
(values "This is the data in the first chand this is the second oneXXXXXXX"
"Content-Type: text/plain\r\nTransfer-Encoding: chunked\r\nAnother-Header: ta-daa\r\n")
)
(unless skip-actual-redirect?
(test
(get-pure/redirect
"HTTP/1.1 301 Moved Permanently\r\nLocation: http://localhost:9002/whatever\r\n\r\nstuff"
(string-append
"HTTP/1.1 200 OK\r\nContent-Type: text/plain\r\nTransfer-Encoding: chunked\r\n\r\n"
"24\r\nThis is the data in the first chunk \r\n1A\r\nand this is the second one\r\n0\r\n"))
(get-pure/headers/redirect
"HTTP/1.1 200 OK\r\nContent-Type: text/plain\r\nTransfer-Encoding: chunked\r\nAnother-Header: ta-daa\r\n\r\n20\r\nThis is the data in the first ch\r\n21\r\nand this is the second oneXXXXXXX\r\n0\r\n")
=>
(values "This is the data in the first chand this is the second oneXXXXXXX"
"Content-Type: text/plain\r\nTransfer-Encoding: chunked\r\nAnother-Header: ta-daa\r\n"))))
(run-tests "http" values #f)
(run-tests "https" (let ([ctx (ssl-make-server-context)])
(ssl-load-certificate-chain! ctx (collection-file-path "test.pem" "openssl"))
(ssl-load-private-key! ctx (collection-file-path "test.pem" "openssl"))
(lambda (in out)
(ports->ssl-ports in out #:mode 'accept #:context ctx))))
(ports->ssl-ports in out #:mode 'accept #:context ctx)))
#t)