Adding net/http-client and using it underneath net/url

original commit: e8bafbd9b9

pkgs/racket-pkgs/racket-doc/net/scribblings/http-client.scrbl

@@ -0,0 +1,120 @@
+#lang scribble/doc
+@(require "common.rkt" scribble/bnf
+          (for-label net/http-client
+                     racket/list
+                     openssl))
+
+@title[#:tag "http-client"]{HTTP Client}
+
+@defmodule[net/http-client]{The @racketmodname[net/http-client] library provides
+utilities to use the HTTP protocol.}
+
+@defproc[(http-conn? [x any/c])
+         boolean?]{
+
+Identifies an HTTP connection.
+                   
+}
+
+@defproc[(http-conn-live? [x any/c])
+         boolean?]{
+
+Identifies an HTTP connection that is "live", i.e. one for which
+@racket[http-conn-send!] is valid.
+
+}
+
+@defproc[(http-conn)
+         http-conn?]{
+
+Returns a fresh HTTP connection.
+
+}
+
+@defproc[(http-conn-open! [hc http-conn?] [host (or/c bytes? string?)]
+                          [#:ssl? ssl? (or/c boolean? ssl-client-context? symbol?) #f]
+                          [#:port port (between/c 1 65535) (if ssl? 443 80)])
+         void?]{
+
+Uses @racket[hc] to connect to @racket[host] on port @racket[port]
+using SSL if @racket[ssl?] is not @racket[#f] (using @racket[ssl?] as
+an argument to @racket[ssl-connect] to, for example, check
+certificates.)
+
+If @racket[hc] is live, the connection is closed.
+
+}
+
+@defproc[(http-conn-open [host (or/c bytes? string?)]
+                         [#:ssl? ssl? (or/c boolean? ssl-client-context? symbol?) #f]
+                         [#:port port (between/c 1 65535) (if ssl? 443 80)])
+         http-conn?]{
+
+Calls @racket[http-conn-open!] with a fresh connection, which is returned.
+
+}
+
+@defproc[(http-conn-close! [hc http-conn?])
+         void?]{
+
+Closes @racket[hc] if it is live.
+
+}
+
+@defproc[(http-conn-send! [hc http-conn-live?] [uri (or/c bytes? string?)]
+                          [#:method method (or/c bytes? string? symbol?) #"GET"]
+                          [#:headers headers (listof (or/c bytes? string?)) empty]
+                          [#:data data (or/c false/c bytes? string?) #f])
+         void?]{
+
+Sends an HTTP request to @racket[hc] to the URI @racket[uri] using the
+method @racket[method] and the additional headers given in
+@racket[headers] and the additional data @racket[data].
+
+}
+
+@defproc[(http-conn-recv! [hc http-conn-live?]
+                          [#:close? close? boolean? #f])
+         (values bytes? (listof bytes?) input-port?)]{
+
+Parses an HTTP response from @racket[hc].
+
+Returns the status line, a list of headers, and an port which contains
+the contents of the response.
+
+If @racket[close?] is @racket[#t], then the connection will be closed
+following the response parsing. If @racket[close?] is @racket[#f],
+then the connection is only closed if the server instructs the client
+to do so.
+
+}
+
+@defproc[(http-conn-sendrecv! [hc http-conn-live?] [uri (or/c bytes? string?)]
+                              [#:method method (or/c bytes? string? symbol?) #"GET"]
+                              [#:headers headers (listof (or/c bytes? string?)) empty]
+                              [#:data data (or/c false/c bytes? string?) #f]
+                              [#:close? close? boolean? #f])
+         (values bytes? (listof bytes?) input-port?)]{
+
+Calls @racket[http-conn-send!] and @racket[http-conn-recv!] in sequence.
+
+}
+
+@defproc[(http-sendrecv [host (or/c bytes? string?)] [uri (or/c bytes? string?)]
+                        [#:ssl? ssl? (or/c boolean? ssl-client-context? symbol?) #f]
+                        [#:port port (between/c 1 65535) (if ssl? 443 80)]
+                        [#:method method (or/c bytes? string? symbol?) #"GET"]
+                        [#:headers headers (listof (or/c bytes? string?)) empty]
+                        [#:data data (or/c false/c bytes? string?) #f])
+         (values bytes? (listof bytes?) input-port?)]{
+
+Calls @racket[http-conn-send!] and @racket[http-conn-recv!] in
+sequence on a fresh HTTP connection produced by
+@racket[http-conn-open].
+
+The HTTP connection is not returned, so it is always closed after one
+response, which is why there is no @racket[#:closed?] argument like
+@racket[http-conn-recv!].
+
+}
+

pkgs/racket-pkgs/racket-doc/net/scribblings/net.scrbl

@@ -5,6 +5,7 @@
 
 @table-of-contents[]
 
+@include-section["http-client.scrbl"]
 @include-section["url.scrbl"]
 @include-section["uri-codec.scrbl"]
 @include-section["websocket.scrbl"]

pkgs/racket-pkgs/racket-doc/net/scribblings/url.scrbl

@@ -1,7 +1,9 @@
 #lang scribble/doc
 @(require "common.rkt" scribble/bnf
           (for-label net/url net/url-unit net/url-sig 
+                     racket/list
                      net/head net/uri-codec net/tcp-sig
+                     net/http-client
                      (only-in net/url-connect current-https-protocol)
                      openssl))
 
@@ -428,6 +430,18 @@ mapping is the empty list (i.e., no proxies).}
  Identifies an error thrown by URL functions.         
 }
 
+@defproc[(http-sendrecv/url [u url?]
+                            [#:method method (or/c bytes? string? symbol?) #"GET"]
+                            [#:headers headers (listof (or/c bytes? string?)) empty]
+                            [#:data data (or/c false/c bytes? string?) #f])
+         (values bytes? (listof bytes?) input-port?)]{
+
+Calls @racket[http-sendrecv] using @racket[u] to populate the host, URI, port, and SSL parameters.
+
+This function does not support proxies.
+                                                      
+}
+
 @section{URL HTTPS mode}
 
 @defmodule[net/url-connect]

pkgs/racket-pkgs/racket-test/tests/net/http-client.rkt

@@ -0,0 +1,146 @@
+#lang racket/base
+(module+ test
+  (require rackunit
+           racket/tcp
+           racket/port
+           racket/list
+           (prefix-in hc: net/http-client)
+           (prefix-in u: net/url))
+
+  (define (port->bytes* in)
+    (define ob (open-output-bytes))
+    (let loop ()
+      (sleep)
+      (when (byte-ready? in)
+        (define b (read-byte in))
+        (unless (eof-object? b)
+          (write-byte b ob)
+          (loop))))
+    (get-output-bytes ob))
+
+  (define-syntax-rule (tests [t ...] ...)
+    (begin (test t ...) ...))
+
+  (define-syntax-rule (test-e the-port e raw ereq estatus eheaders econtent)
+    (let ()
+      (define l (tcp-listen 0 40 #t "127.0.0.1"))
+      (define-values (_1 the-port _2 _3)
+        (tcp-addresses l #t))
+      (define req #f)
+      (define lt
+        (thread
+         (λ ()
+           (define-values (in out) (tcp-accept l))
+           (tcp-close l)
+           (display raw out)
+           (flush-output out)
+           (tcp-abandon-port out)
+           (close-output-port out)
+           (set! req (port->bytes* in))
+           (tcp-abandon-port in)
+           (close-input-port in))))
+      (define-values (status headers content-port)
+        e)
+      (thread-wait lt)
+      (check-equal? req ereq)
+      (check-equal? status estatus)
+      (check-equal? headers eheaders)
+      (check-equal? (port->bytes content-port) econtent)))
+
+  (define-syntax-rule (test raw ereq estatus eheaders econtent)
+    (begin
+      (test-e the-port
+              (hc:http-sendrecv "localhost" "/"
+                                #:ssl? #f
+                                #:port the-port
+                                #:method "GET"
+                                #:headers empty
+                                #:data #f)
+              raw ereq estatus eheaders econtent)
+      (test-e the-port
+              (u:http-sendrecv/url
+               (u:make-url "http" #f "localhost" the-port #t (list (u:path/param "" empty)) empty #f)
+               #:method "GET"
+               #:headers empty
+               #:data #f)
+              raw ereq estatus eheaders econtent)))
+
+  (tests
+   ["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"
+    #"GET / HTTP/1.1\r\nHost: localhost\r\n\r\n"
+    #"HTTP/1.1 200 OK"
+    '(#"Content-Type: text/plain" #"Transfer-Encoding: chunked")
+    #"This is the data in the first chunk and this is the second one"]
+
+   ["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"
+    #"GET / HTTP/1.1\r\nHost: localhost\r\n\r\n"
+    #"HTTP/1.0 200 OK"
+    '(#"Content-Type: text/plain")
+    #"This is the data in the first chunk and this is the second one"]
+
+   ["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"
+
+    #"GET / HTTP/1.1\r\nHost: localhost\r\n\r\n"
+    #"HTTP/1.1 200 OK"
+    '(#"Content-Type: text/plain" #"Transfer-Encoding: chunked")
+    #"This is the data in the first chand this is the second oneXXXXXXX"]
+
+   ["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"
+    #"GET / HTTP/1.1\r\nHost: localhost\r\n\r\n"
+    #"HTTP/1.1 200 OK"
+    '(#"Content-Type: text/plain" #"Transfer-Encoding: chunked")
+    #"This is the data in the first chunk and this is the second one"]
+
+   ["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"
+    #"GET / HTTP/1.1\r\nHost: localhost\r\n\r\n"
+    #"HTTP/1.0 200 OK"
+    '(#"Content-Type: text/plain")
+    #"This is the data in the first chunk and this is the second one"]
+
+   ["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"
+    #"GET / HTTP/1.1\r\nHost: localhost\r\n\r\n"
+    #"HTTP/1.1 200 OK"
+    '(#"Content-Type: text/plain" #"Transfer-Encoding: chunked")
+    #"This is the data in the first chand this is the second oneXXXXXXX"]
+
+   ["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"
+    #"GET / HTTP/1.1\r\nHost: localhost\r\n\r\n"
+    #"HTTP/1.0 200 OK"
+    '(#"Content-Type: text/plain")
+    #"This is the data in the first chunk and this is the second one\r\n"]
+
+   ["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"
+    #"GET / HTTP/1.1\r\nHost: localhost\r\n\r\n"
+    #"HTTP/1.1 200 OK"
+    '(#"Content-Type: text/plain" #"Transfer-Encoding: chunked")
+    #"This is the data in the first chunk and this is the second one"]
+
+   ["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"
+    #"GET / HTTP/1.1\r\nHost: localhost\r\n\r\n"
+    #"HTTP/1.0 200 OK"
+    '(#"Content-Type: text/plain")
+    #"This is the data in the first chunk and this is the second one"]
+
+   ["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"
+    #"GET / HTTP/1.1\r\nHost: localhost\r\n\r\n"
+    #"HTTP/1.1 200 OK"
+    '(#"Content-Type: text/plain" #"Transfer-Encoding: chunked")
+    #"This is the data in the first chand this is the second oneXXXXXXX"]
+
+   ["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"
+    #"GET / HTTP/1.1\r\nHost: localhost\r\n\r\n"
+    #"HTTP/1.1 200 OK"
+    '(#"Content-Type: text/plain" #"Transfer-Encoding: chunked" #"Another-Header: ta-daa")
+    #"This is the data in the first chand this is the second oneXXXXXXX"]
+
+   ["HTTP/1.1 301 Moved Permanently\r\nLocation: http://localhost:9002/whatever\r\n\r\nstuff"
+    #"GET / HTTP/1.1\r\nHost: localhost\r\n\r\n"
+    #"HTTP/1.1 301 Moved Permanently"
+    '(#"Location: http://localhost:9002/whatever")
+    #"stuff"]
+
+   ["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"
+    #"GET / HTTP/1.1\r\nHost: localhost\r\n\r\n"
+    #"HTTP/1.1 200 OK"
+    '(#"Content-Type: text/plain" #"Transfer-Encoding: chunked" #"Another-Header: ta-daa")
+    #"This is the data in the first chand this is the second oneXXXXXXX"]))