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

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"]))

racket/collects/net/http-client.rkt

@@ -0,0 +1,255 @@
+#lang racket/base
+(require racket/contract/base
+         racket/match
+         racket/list
+         racket/port
+         (rename-in racket/tcp
+                    [tcp-connect plain-tcp-connect]
+                    [tcp-abandon-port plain-tcp-abandon-port])
+         openssl
+         "win32-ssl.rkt")
+
+;; Lib
+
+(define (->string bs)
+  (if (bytes? bs)
+    (bytes->string/utf-8 bs)
+    bs))
+
+(define (read-bytes-line/not-eof ip kind)
+  (define bs (read-bytes-line ip kind))
+  (when (eof-object? bs)
+    (error 'http-client "Connection ended early"))
+  bs)
+
+;; Core
+
+(struct http-conn (host to from abandon-p) #:mutable)
+
+(define (make-http-conn)
+  (http-conn #f #f #f #f))
+
+(define (http-conn-live? hc)
+  (and (http-conn-to hc)
+       (http-conn-from hc)))
+
+(define (http-conn-open! hc host-bs #:ssl? [ssl? #f] #:port [port (if ssl? 443 80)])
+  (http-conn-close! hc)
+  (define host (->string host-bs))
+  (define ssl-version (if (boolean? ssl?) 'sslv2-or-v3 ssl?))
+
+  (define-values (from to)
+    (cond [ssl?
+           (cond
+             [(or ssl-available? (not win32-ssl-available?))
+              (set-http-conn-abandon-p! hc ssl-abandon-port)
+              (ssl-connect host port ssl-version)]
+             [else
+              (set-http-conn-abandon-p! hc win32-ssl-abandon-port)
+              (win32-ssl-connect host port ssl-version)])]
+          [else
+           (set-http-conn-abandon-p! hc plain-tcp-abandon-port)
+           (plain-tcp-connect host port)]))
+
+  (set-http-conn-host! hc host)
+  (set-http-conn-to! hc to)
+  (set-http-conn-from! hc from))
+
+(define (http-conn-close! hc)
+  (match-define (http-conn host to from abandon) hc)
+  (set-http-conn-host! hc #f)
+  (when to
+    (abandon to)
+    (set-http-conn-to! hc #f))
+  (when from
+    ;; (abandon from)
+    (set-http-conn-from! hc #f))
+  (set-http-conn-abandon-p! hc #f))
+
+(define (http-conn-send! hc url-bs
+                         #:method [method-bss #"GET"]
+                         #:headers [headers-bs empty]
+                         #:data [data-bsf #f])
+  (match-define (http-conn host to from _) hc)
+  (fprintf to "~a ~a HTTP/1.1\r\n" method-bss url-bs)
+  (fprintf to "Host: ~a\r\n" host)
+  (define data
+    (if (string? data-bsf)
+      (string->bytes/utf-8 data-bsf)
+      data-bsf))
+  (when data
+    (fprintf to "Content-Length: ~a\r\n" (bytes-length data)))
+  (for ([h (in-list headers-bs)])
+    (fprintf to "~a\r\n" h))
+  (fprintf to "\r\n")
+  (when data
+    (display data to))
+  (flush-output to))
+
+(define (http-conn-status! hc)
+  (read-bytes-line/not-eof (http-conn-from hc) 'return-linefeed))
+
+(define (http-conn-headers! hc)
+  (define top (read-bytes-line/not-eof (http-conn-from hc) 'return-linefeed))
+  (if (bytes=? top #"")
+    empty
+    (cons top (http-conn-headers! hc))))
+
+;; xxx read more at a time
+(define (copy-bytes in out count)
+  (unless (zero? count)
+    (define b (read-byte in))
+    (unless (eof-object? b)
+      (write-byte b out)
+      (copy-bytes in out (sub1 count)))))
+
+(define (http-conn-response-port/rest! hc)
+  (http-conn-response-port/length! hc +inf.0 #:close? #t))
+
+(define (http-conn-response-port/length! hc count #:close? [close? #f])
+  (define-values (in out) (make-pipe))
+  (thread
+   (λ ()
+     (copy-bytes (http-conn-from hc) out count)
+     (when close?
+       (http-conn-close! hc))
+     (close-output-port out)))
+  in)
+
+(define (http-conn-response-port/chunked! hc #:close? [close? #f])
+  (define (http-pipe-chunk ip op)
+    (define crlf-bytes (make-bytes 2))
+    (let loop ([last-bytes #f])
+      (define size-str (read-line ip 'return-linefeed))
+      (define chunk-size (string->number size-str 16))
+      (unless chunk-size
+        (error 'http-conn-response/chunked "Could not parse ~S as hexadecimal number" size-str))
+      (define use-last-bytes?
+        (and last-bytes (<= chunk-size (bytes-length last-bytes))))
+      (if (zero? chunk-size)
+        (begin (flush-output op)
+               (close-output-port op))
+        (let* ([bs (if use-last-bytes?
+                     (begin
+                       (read-bytes! last-bytes ip 0 chunk-size)
+                       last-bytes)
+                     (read-bytes chunk-size ip))]
+               [crlf (read-bytes! crlf-bytes ip 0 2)])
+          (write-bytes bs op 0 chunk-size)
+          (loop bs)))))
+
+  (define-values (in out) (make-pipe))
+  (thread
+   (λ ()
+     (http-pipe-chunk (http-conn-from hc) out)
+     (when close?
+       (http-conn-close! hc))
+     (close-output-port out)))
+  in)
+
+;; Derived
+
+(define (http-conn-open host-bs #:ssl? [ssl? #f] #:port [port (if ssl? 443 80)])
+  (define hc (make-http-conn))
+  (http-conn-open! hc host-bs #:ssl? ssl? #:port port)
+  hc)
+
+(define (http-conn-recv! hc
+                         #:close? [iclose? #f])
+  (define status (http-conn-status! hc))
+  (define headers (http-conn-headers! hc))
+  (define close?
+    (or iclose?
+        (member #"Connection: close" headers)))
+  (define response-port
+    (cond
+      [(member #"Transfer-Encoding: chunked" headers)
+       (http-conn-response-port/chunked! hc #:close? #t)]
+      [(ormap (λ (h)
+                (match (regexp-match #rx#"^Content-Length: (.+)$" h)
+                  [#f #f]
+                  [(list _ cl-bs)
+                   (string->number
+                    (bytes->string/utf-8 cl-bs))]))
+              headers)
+       =>
+       (λ (count)
+         (http-conn-response-port/length! hc count #:close? close?))]
+      [else
+       (http-conn-response-port/rest! hc)]))
+  (values status headers response-port))
+
+(define (http-conn-sendrecv! hc url-bs
+                             #:method [method-bss #"GET"]
+                             #:headers [headers-bs empty]
+                             #:data [data-bsf #f]
+                             #:close? [close? #f])
+  (http-conn-send! hc url-bs
+                   #:method method-bss
+                   #:headers headers-bs
+                   #:data data-bsf)
+  (http-conn-recv! hc #:close? close?))
+
+(define (http-sendrecv host-bs url-bs
+                       #:ssl? [ssl? #f]
+                       #:port [port (if ssl? 443 80)]
+                       #:method [method-bss #"GET"]
+                       #:headers [headers-bs empty]
+                       #:data [data-bsf #f])
+  (define hc (http-conn-open host-bs #:ssl? ssl? #:port port))
+  (http-conn-sendrecv! hc url-bs
+                       #:method method-bss
+                       #:headers headers-bs
+                       #:data data-bsf
+                       #:close? #t))
+
+(provide
+ (contract-out
+  [http-conn?
+   (-> any/c
+       boolean?)]
+  [http-conn-live?
+   (-> any/c
+       boolean?)]
+  [rename
+   make-http-conn http-conn
+   (-> http-conn?)]
+  [http-conn-open!
+   (->* (http-conn? (or/c bytes? string?))
+        (#:ssl? (or/c boolean? ssl-client-context? symbol?)
+                #:port (between/c 1 65535))
+        void?)]
+  [http-conn-close!
+   (-> http-conn? void?)]
+  [http-conn-send!
+   (->*
+    (http-conn-live? (or/c bytes? string?))
+    (#:method (or/c bytes? string? symbol?)
+              #:headers (listof (or/c bytes? string?))
+              #:data (or/c false/c bytes? string?))
+    void)]
+  ;; Derived
+  [http-conn-open
+   (->* ((or/c bytes? string?))
+        (#:ssl? (or/c boolean? ssl-client-context? symbol?)
+                #:port (between/c 1 65535))
+        http-conn?)]
+  [http-conn-recv!
+   (->* (http-conn-live?)
+        (#:close? boolean?)
+        (values bytes? (listof bytes?) input-port?))]
+  [http-conn-sendrecv!
+   (->* (http-conn-live? (or/c bytes? string?))
+        (#:method (or/c bytes? string? symbol?)
+                  #:headers (listof (or/c bytes? string?))
+                  #:data (or/c false/c bytes? string?)
+                  #:close? boolean?)
+        (values bytes? (listof bytes?) input-port?))]
+  [http-sendrecv
+   (->* ((or/c bytes? string?) (or/c bytes? string?))
+        (#:ssl? (or/c boolean? ssl-client-context? symbol?)
+                #:port (between/c 1 65535)
+                #:method (or/c bytes? string? symbol?)
+                #:headers (listof (or/c bytes? string?))
+                #:data (or/c false/c bytes? string?))
+        (values bytes? (listof bytes?) input-port?))]))

racket/collects/net/url.rkt

@@ -1,7 +1,11 @@
 #lang racket/base
-(require racket/port racket/string racket/contract/base
+(require racket/port
+         racket/string
+         racket/contract/base
          racket/list
-         "url-connect.rkt"
+         racket/match
+         (prefix-in hc: "http-client.rkt")
+         (only-in "url-connect.rkt" current-https-protocol)
          "url-structs.rkt"
          "uri-codec.rkt")
 
@@ -21,7 +25,7 @@
 (define-struct (url-exception exn:fail) ())
 (define (-url-exception? x)
   (or (url-exception? x)
-      
+
       ;; two of the errors that string->url can raise are
       ;; now contract violations instead of url-expcetion
       ;; structs. since only the url-exception? predicate
@@ -34,25 +38,25 @@
 
 (define current-proxy-servers
   (make-parameter null
-    (lambda (v)
-      (unless (and (list? v)
-                   (andmap (lambda (v)
-                             (and (list? v)
-                                  (= 3 (length v))
-                                  (equal? (car v) "http")
-                                  (string? (car v))
-                                  (exact-integer? (caddr v))
-                                  (<= 1 (caddr v) 65535)))
-                           v))
-        (raise-type-error
-         'current-proxy-servers
-         "list of list of scheme, string, and exact integer in [1,65535]"
-         v))
-      (map (lambda (v)
-             (list (string->immutable-string (car v))
-                   (string->immutable-string (cadr v))
-                   (caddr v)))
-           v))))
+                  (lambda (v)
+                    (unless (and (list? v)
+                                 (andmap (lambda (v)
+                                           (and (list? v)
+                                                (= 3 (length v))
+                                                (equal? (car v) "http")
+                                                (string? (car v))
+                                                (exact-integer? (caddr v))
+                                                (<= 1 (caddr v) 65535)))
+                                         v))
+                      (raise-type-error
+                       'current-proxy-servers
+                       "list of list of scheme, string, and exact integer in [1,65535]"
+                       v))
+                    (map (lambda (v)
+                           (list (string->immutable-string (car v))
+                                 (string->immutable-string (cadr v))
+                                 (caddr v)))
+                         v))))
 
 (define (url-error fmt . args)
   (raise (make-url-exception
@@ -74,12 +78,12 @@
                (apply string-append
                       (let loop ([l l])
                         (cond
-                         [(null? l) l]
-                         [(pair? (car l))
-                          (append (loop (car l))
-                                  (loop (cdr l)))]
-                         [(null? (car l)) (loop (cdr l))]
-                         [else (cons (car l) (loop (cdr l)))]))))])
+                          [(null? l) l]
+                          [(pair? (car l))
+                           (append (loop (car l))
+                                   (loop (cdr l)))]
+                          [(null? (car l)) (loop (cdr l))]
+                          [else (cons (car l) (loop (cdr l)))]))))])
     (when (and (equal? scheme "file")
                (not (url-path-absolute? url)))
       (raise-mismatch-error 'url->string
@@ -89,13 +93,13 @@
      (append
       (if scheme (sa scheme ":") null)
       (if (or user host port)
-          (sa "//"
-              (if user (sa (uri-userinfo-encode user) "@") null)
-              (if host host null)
-              (if port (sa ":" (number->string port)) null))
-          (if (equal? "file" scheme) ; always need "//" for "file" URLs
-              '("//")
-              null))
+        (sa "//"
+            (if user (sa (uri-userinfo-encode user) "@") null)
+            (if host host null)
+            (if port (sa ":" (number->string port)) null))
+        (if (equal? "file" scheme) ; always need "//" for "file" URLs
+          '("//")
+          null))
       (combine-path-strings (url-path-absolute? url) path)
       ;; (if query (sa "?" (uri-encode query)) "")
       (if (null? query) null (sa "?" (alist->form-urlencoded query)))
@@ -109,21 +113,24 @@
           [(string=? scheme "https") 443]
           [else (url-error "URL scheme ~s not supported" scheme)])))
 
-;; make-ports : url -> in-port x out-port
+;; make-ports : url -> hc
 (define (make-ports url proxy)
   (let ([port-number (if proxy
                        (caddr proxy)
                        (or (url-port url) (url->default-port url)))]
         [host (if proxy (cadr proxy) (url-host url))])
-    (parameterize ([current-connect-scheme (url-scheme url)])
-      (tcp-connect host port-number))))
+    (hc:http-conn-open host
+                       #:port port-number
+                       #:ssl? (if (equal? "https" (url-scheme url))
+                                (current-https-protocol)
+                                #f))))
 
 ;; http://getpost-impure-port : bool x url x union (str, #f) x list (str)
-;                               -> (values in-port out-port)
+                                        ;                               -> hc
 (define (http://getpost-impure-port get? url post-data strings
                                     make-ports 1.1?)
   (define proxy (assoc (url-scheme url) (current-proxy-servers)))
-  (define-values (server->client client->server) (make-ports url proxy))
+  (define hc (make-ports url proxy))
   (define access-string
     (url->string
      (if proxy
@@ -136,20 +143,12 @@
                        (values #t (list (make-path/param "" '())))
                        (values (url-path-absolute? url) (url-path url)))])
          (make-url #f #f #f #f abs? path (url-query url) (url-fragment url))))))
-  (define (println . xs)
-    (for-each (lambda (x) (display x client->server)) xs)
-    (display "\r\n" client->server))
-  (println (if get? "GET " "POST ") access-string " HTTP/1." (if 1.1? "1" "0"))
-  (println "Host: " (url-host url)
-           (let ([p (url-port url)]) (if p (format ":~a" p) "")))
-  (when post-data (println "Content-Length: " (bytes-length post-data)))
-  (for-each println strings)
-  (println)
-  (when post-data (display post-data client->server))
-  (flush-output client->server)
-  (unless 1.1?
-    (tcp-abandon-port client->server))
-  (values server->client client->server))
+
+  (hc:http-conn-send! hc access-string
+                      #:method (if get? "GET" "POST")
+                      #:headers strings
+                      #:data post-data)
+  hc)
 
 (define (file://->path url [kind (system-path-convention-type)])
   (let ([strs (map path/param-path (url-path url))]
@@ -196,12 +195,25 @@
     (cond [(not scheme)
            (schemeless-url url)]
           [(or (string=? scheme "http") (string=? scheme "https"))
-           (define-values (s->c c->s) (http://getpost-impure-port get? url post-data strings make-ports #f))
-           s->c]
+           (define hc (http://getpost-impure-port get? url post-data strings make-ports #f))
+           (http-conn-impure-port hc)]
           [(string=? scheme "file")
            (url-error "There are no impure file: ports")]
           [else (url-error "Scheme ~a unsupported" scheme)])))
 
+(define (http-conn-impure-port hc)
+  (define-values (in out) (make-pipe))
+  (define-values (status headers response-port) (hc:http-conn-recv! hc))
+  (fprintf out "~a\r\n" status)
+  (for ([h (in-list headers)])
+    (fprintf out "~a\r\n" h))
+  (fprintf out "\r\n")
+  (thread
+   (λ ()
+     (copy-port response-port out)
+     (close-output-port out)))
+  in)
+
 ;; get-impure-port : url [x list (str)] -> in-port
 (define (get-impure-port url [strings '()])
   (getpost-impure-port #t url #f strings))
@@ -218,108 +230,77 @@
           [(or (string=? scheme "http")
                (string=? scheme "https"))
            (cond
-             [(or (not get?) 
+             [(or (not get?)
                   ;; do not follow redirections for POST
                   (zero? redirections))
-              (let-values ([(s->c c->s) (http://getpost-impure-port
-                                         get? url post-data strings
-                                         make-ports #f)])
-                (purify-http-port s->c))]
+              (define-values (status headers response-port)
+                (hc:http-conn-recv!
+                 (http://getpost-impure-port
+                  get? url post-data strings
+                  make-ports #f)))
+              response-port]
              [else
-              (define-values (port header) 
+              (define-values (port header)
                 (get-pure-port/headers url strings #:redirections redirections))
               port])]
           [(string=? scheme "file")
            (file://get-pure-port url)]
           [else (url-error "Scheme ~a unsupported" scheme)])))
 
-(struct http-connection (s->c c->s)
-  #:mutable)
+(define (make-http-connection)
+  (hc:http-conn))
 
-(define (make-http-connection) (http-connection #f #f))
+(define (http-connection-close hc)
+  (hc:http-conn-close! hc))
 
-(define (http-connection-close conn)
-  (when (http-connection-c->s conn)
-    (tcp-abandon-port (http-connection-c->s conn))
-    (set-http-connection-c->s! conn #f)
-    (close-input-port (http-connection-s->c conn))
-    (set-http-connection-s->c! conn #f)))
-
-(define (get-pure-port/headers url [strings '()] 
+(define (get-pure-port/headers url [strings '()]
                                #:redirections [redirections 0]
                                #:status? [status? #f]
                                #:connection [conn #f])
   (let redirection-loop ([redirections redirections] [url url] [use-conn conn])
-    (define-values (ip op)
-      (http://getpost-impure-port #t url #f strings 
+    (define hc
+      (http://getpost-impure-port #t url #f strings
                                   (if (and use-conn
-                                           (http-connection-s->c use-conn))
-                                      (lambda (url proxy)
-                                        (log-net/url-debug "reusing connection")
-                                        (values (http-connection-s->c use-conn)
-                                                (http-connection-c->s use-conn)))
-                                      make-ports)
+                                           (hc:http-conn-live? use-conn))
+                                    (lambda (url proxy)
+                                      (log-net/url-debug "reusing connection")
+                                      use-conn)
+                                    make-ports)
                                   (and conn #t)))
-    (define status (read-line ip 'return-linefeed))
-    (define-values (new-url chunked? close? headers)
-      (let loop ([new-url #f] [chunked? #f] [close? #f] [headers '()])
-        (define line (read-line ip 'return-linefeed))
-        (when (eof-object? line)
-          (error 'getpost-pure-port 
-                 "connection ended before headers ended"))
-        (cond
-          [(equal? line "") (values new-url chunked? close? headers)]
-          [(equal? chunked-header-line line) (loop new-url #t close? (cons line headers))]
-          [(equal? close-header-line line) (loop new-url chunked? #t (cons line headers))]
-          [(regexp-match #rx"^Location: (.*)$" line)
-           =>
-           (λ (m) 
-             (define m1 (list-ref m 1))
-             (define next-url 
-               (with-handlers ((exn:fail? (λ (x) #f)))
-                 (define next-url (string->url m1))
-                 (make-url
-                  (or (url-scheme next-url) (url-scheme url))
-                  (or (url-user next-url) (url-user url))
-                  (or (url-host next-url) (url-host url))
-                  (or (url-port next-url) (url-port url))
-                  (url-path-absolute? next-url)
-                  (url-path next-url)
-                  (url-query next-url)
-                  (url-fragment next-url))))
-             (loop (or next-url new-url) chunked? close? (cons line headers)))]
-          [else (loop new-url chunked? close? (cons line headers))])))
+    (define-values (status headers response-port)
+      (hc:http-conn-recv! hc))
+
+    (define new-url
+      (ormap (λ (h)
+               (match (regexp-match #rx#"^Location: (.*)$" h)
+                 [#f #f]
+                 [(list _ m1b)
+                  (define m1 (bytes->string/utf-8 m1b))
+                  (with-handlers ((exn:fail? (λ (x) #f)))
+                    (define next-url (string->url m1))
+                    (make-url
+                     (or (url-scheme next-url) (url-scheme url))
+                     (or (url-user next-url) (url-user url))
+                     (or (url-host next-url) (url-host url))
+                     (or (url-port next-url) (url-port url))
+                     (url-path-absolute? next-url)
+                     (url-path next-url)
+                     (url-query next-url)
+                     (url-fragment next-url)))]))
+             headers))
     (define redirection-status-line?
-      (regexp-match #rx"^HTTP/[0-9]+[.][0-9]+ 3[0-9][0-9]" status))
-    (define (close-ip)
-      (unless (and use-conn (not close?))
-        (close-input-port ip)))
-    (when use-conn
-      (if close?
-          (begin
-            (log-net/url-info "connection closed by server")
-            (tcp-abandon-port op)
-            (set-http-connection-s->c! use-conn #f)
-            (set-http-connection-c->s! use-conn #f))
-          (begin
-            (set-http-connection-s->c! use-conn ip)
-            (set-http-connection-c->s! use-conn op))))
+      (regexp-match #rx#"^HTTP/[0-9]+[.][0-9]+ 3[0-9][0-9]" status))
     (cond
-      [(and redirection-status-line? new-url (not (zero? redirections))) 
-       (close-ip)
+      [(and redirection-status-line? new-url (not (zero? redirections)))
        (log-net/url-info "redirection: ~a" (url->string new-url))
        (redirection-loop (- redirections 1) new-url #f)]
       [else
-       (define-values (in-pipe out-pipe) (make-pipe))
-       (thread
-        (λ ()
-          (http-pipe-data chunked? ip out-pipe)
-          (close-ip)))
-       (values in-pipe
-               (apply string-append (map (λ (x) (string-append x "\r\n"))
-                                         (if status?
-                                           (cons status (reverse headers))
-                                           (reverse headers)))))])))
+       (values response-port
+               (apply string-append
+                      (map (λ (x) (format "~a\r\n" x))
+                           (if status?
+                             (cons status headers)
+                             headers))))])))
 
 ;; get-pure-port : url [x list (str)] -> in-port
 (define (get-pure-port url [strings '()] #:redirections [redirections 0])
@@ -423,8 +404,8 @@
   (let ([handle-port
          (lambda (server->client handler)
            (dynamic-wind (lambda () 'do-nothing)
-             (lambda () (handler server->client))
-             (lambda () (close-input-port server->client))))])
+               (lambda () (handler server->client))
+               (lambda () (close-input-port server->client))))])
     (case-lambda
       [(url getter handler)
        (handle-port (getter url) handler)]
@@ -457,11 +438,11 @@
   (when (eof-object? l)
     (error 'purify-http-port "Connection ended before headers ended"))
   (if (string=? l "")
-      #f
-      (if (string=? l chunked-header-line)
-          (begin (http-read-headers ip)
-                 #t)
-          (http-read-headers ip))))
+    #f
+    (if (string=? l chunked-header-line)
+      (begin (http-read-headers ip)
+             #t)
+      (http-read-headers ip))))
 
 (define chunked-header-line "Transfer-Encoding: chunked")
 (define close-header-line "Connection: close")
@@ -470,11 +451,11 @@
   (with-handlers ([exn:fail? (lambda (exn)
                                (log-net/url-error (exn-message exn)))])
     (if chunked?
-        (http-pipe-chunk ip op)
-        (begin
-          (copy-port ip op)
-          (flush-output op)
-          (close-output-port op)))))
+      (http-pipe-chunk ip op)
+      (begin
+        (copy-port ip op)
+        (flush-output op)
+        (close-output-port op)))))
 
 (define (http-pipe-chunk ip op)
   (define crlf-bytes (make-bytes 2))
@@ -486,16 +467,16 @@
     (define use-last-bytes?
       (and last-bytes (<= chunk-size (bytes-length last-bytes))))
     (if (zero? chunk-size)
-        (begin (flush-output op)
-               (close-output-port op))
-        (let* ([bs (if use-last-bytes?
-                       (begin
-                         (read-bytes! last-bytes ip 0 chunk-size)
-                         last-bytes)
-                       (read-bytes chunk-size ip))]
-               [crlf (read-bytes! crlf-bytes ip 0 2)])
-          (write-bytes bs op 0 chunk-size)
-          (loop bs)))))
+      (begin (flush-output op)
+             (close-output-port op))
+      (let* ([bs (if use-last-bytes?
+                   (begin
+                     (read-bytes! last-bytes ip 0 chunk-size)
+                     last-bytes)
+                   (read-bytes chunk-size ip))]
+             [crlf (read-bytes! crlf-bytes ip 0 2)])
+        (write-bytes bs op 0 chunk-size)
+        (loop bs)))))
 
 (define character-set-size 256)
 
@@ -506,7 +487,7 @@
           [(string=? string "")
            (url-error "Can't resolve empty string as URL")]
           [else (set-url-scheme! url
-                  (if (char=? (string-ref string 0) #\/) "file" "http"))
+                                 (if (char=? (string-ref string 0) #\/) "file" "http"))
                 url])))
 
 ;; URL parsing regexp
@@ -610,10 +591,10 @@
 
 (define (join-params s)
   (if (null? (path/param-param s))
-      (path-segment-encode (path/param-path s))
-      (string-join (map path-segment-encode
-                        (cons (path/param-path s) (path/param-param s)))
-                   ";")))
+    (path-segment-encode (path/param-path s))
+    (string-join (map path-segment-encode
+                      (cons (path/param-path s) (path/param-param s)))
+                 ";")))
 
 (define (path->url path)
   (let* ([spath (simplify-path path #f)]
@@ -627,41 +608,41 @@
               (cond
                 [(not base)
                  (if (eq? (path-convention-type path) 'windows)
-                     ;; For Windows, massage the root:
-                     (append (map
-                              (lambda (s)
-                                (make-path/param s null))
-                              (let ([s (regexp-replace
-                                        #rx"[/\\\\]$"
-                                        (bytes->string/utf-8 (path->bytes name))
-                                        "")])
-                                (cond
-                                 [(regexp-match? #rx"^\\\\\\\\[?]\\\\[a-zA-Z]:" s)
-                                  ;; \\?\<drive>: path:
-                                  (regexp-split #rx"[/\\]+" (substring s 4))]
-                                 [(regexp-match? #rx"^\\\\\\\\[?]\\\\UNC" s)
-                                  ;; \\?\ UNC path:
-                                  (regexp-split #rx"[/\\]+" (substring s 7))]
-                                 [(regexp-match? #rx"^[/\\]" s)
-                                  ;; UNC path:
-                                  (regexp-split #rx"[/\\]+" s)]
-                                 [else
-                                  (list s)])))
-                             accum)
-                     ;; On other platforms, we drop the root:
-                     accum)]
+                   ;; For Windows, massage the root:
+                   (append (map
+                            (lambda (s)
+                              (make-path/param s null))
+                            (let ([s (regexp-replace
+                                      #rx"[/\\\\]$"
+                                      (bytes->string/utf-8 (path->bytes name))
+                                      "")])
+                              (cond
+                                [(regexp-match? #rx"^\\\\\\\\[?]\\\\[a-zA-Z]:" s)
+                                 ;; \\?\<drive>: path:
+                                 (regexp-split #rx"[/\\]+" (substring s 4))]
+                                [(regexp-match? #rx"^\\\\\\\\[?]\\\\UNC" s)
+                                 ;; \\?\ UNC path:
+                                 (regexp-split #rx"[/\\]+" (substring s 7))]
+                                [(regexp-match? #rx"^[/\\]" s)
+                                 ;; UNC path:
+                                 (regexp-split #rx"[/\\]+" s)]
+                                [else
+                                 (list s)])))
+                           accum)
+                   ;; On other platforms, we drop the root:
+                   accum)]
                 [else
                  (let ([accum (cons (make-path/param
                                      (if (symbol? name)
-                                         name
-                                         (bytes->string/utf-8
-                                          (path-element->bytes name)))
+                                       name
+                                       (bytes->string/utf-8
+                                        (path-element->bytes name)))
                                      null)
                                     accum)])
                    (if (eq? base 'relative)
-                       accum
-                       (loop base accum)))])))])
-    (make-url "file" #f "" #f (absolute-path? path) 
+                     accum
+                     (loop base accum)))])))])
+    (make-url "file" #f "" #f (absolute-path? path)
               (if (null? url-tail) url-path (append url-path url-tail))
               '() #f)))
 
@@ -719,14 +700,13 @@
 
 ;; http://metod-impure-port : symbol x url x union (str, #f) x list (str) -> in-port
 (define (http://method-impure-port method url data strings)
-  (let*-values
-      ([(method) (case method
+  (let* ([method (case method
                    [(get) "GET"] [(post) "POST"] [(head) "HEAD"]
                    [(put) "PUT"] [(delete) "DELETE"]
                    [else (url-error "unsupported method: ~a" method)])]
-       [(proxy) (assoc (url-scheme url) (current-proxy-servers))]
-       [(server->client client->server) (make-ports url proxy)]
-       [(access-string) (url->string
+         [proxy (assoc (url-scheme url) (current-proxy-servers))]
+         [hc (make-ports url proxy)]
+         [access-string (url->string
                          (if proxy
                            url
                            (make-url #f #f #f #f
@@ -734,19 +714,11 @@
                                      (url-path url)
                                      (url-query url)
                                      (url-fragment url))))])
-    (define (println . xs)
-      (for-each (lambda (x) (display x client->server)) xs)
-      (display "\r\n" client->server))
-    (println method " " access-string " HTTP/1.0")
-    (println "Host: " (url-host url)
-             (let ([p (url-port url)]) (if p (format ":~a" p) "")))
-    (when data (println "Content-Length: " (bytes-length data)))
-    (for-each println strings)
-    (println)
-    (when data (display data client->server))
-    (flush-output client->server)
-    (tcp-abandon-port client->server)
-    server->client))
+    (hc:http-conn-send! hc access-string
+                        #:method method
+                        #:headers strings
+                        #:data data)
+    hc))
 
 (define current-url-encode-mode (make-parameter 'recommended))
 
@@ -783,15 +755,15 @@
  (put-impure-port (->* (url? bytes?) ((listof string?)) input-port?))
  (display-pure-port (input-port? . -> . void?))
  (purify-port (input-port? . -> . string?))
- (get-pure-port/headers (->* (url?) 
-                             ((listof string?) 
-                              #:redirections exact-nonnegative-integer? 
+ (get-pure-port/headers (->* (url?)
+                             ((listof string?)
+                              #:redirections exact-nonnegative-integer?
                               #:status? boolean?
-                              #:connection (or/c #f http-connection?))
+                              #:connection (or/c #f hc:http-conn?))
                              (values input-port? string?)))
- (http-connection? (any/c . -> . boolean?))
- (make-http-connection (-> http-connection?))
- (http-connection-close (http-connection? . -> . void?))
+ (rename hc:http-conn? http-connection? (any/c . -> . boolean?))
+ (make-http-connection (-> hc:http-conn?))
+ (http-connection-close (hc:http-conn? . -> . void?))
  (netscape/string->url (string? . -> . url?))
  (call/input-url (case-> (-> url?
                              (-> url? input-port?)
@@ -809,3 +781,44 @@
  (file-url-path-convention-type
   (parameter/c (one-of/c 'unix 'windows)))
  (current-url-encode-mode (parameter/c (one-of/c 'recommended 'unreserved))))
+
+(define (http-sendrecv/url u
+                           #:method [method-bss #"GET"]
+                           #:headers [headers-bs empty]
+                           #:data [data-bsf #f])
+  (unless (member (url-scheme u) '(#f "http" "https"))
+    (error 'http-sendrecv/url "URL scheme ~e not supported" (url-scheme u)))
+  (define ssl?
+    (equal? (url-scheme u) "https"))
+  (define port
+    (or (url-port u)
+        (if ssl?
+          443
+          80)))
+  (unless (url-host u)
+    (error 'http-sendrecv/url "Host required: ~e" u))
+  (hc:http-sendrecv
+   (url-host u)
+   (url->string
+    (make-url #f #f #f #f
+              (url-path-absolute? u)
+              (url-path u)
+              (url-query u)
+              (url-fragment u)))
+   #:ssl?
+   (if (equal? "https" (url-scheme u))
+     (current-https-protocol)
+     #f)
+   #:port port
+   #:method method-bss
+   #:headers headers-bs
+   #:data data-bsf))
+
+(provide
+ (contract-out
+  [http-sendrecv/url
+   (->* (url?)
+        (#:method (or/c bytes? string? symbol?)
+                  #:headers (listof (or/c bytes? string?))
+                  #:data (or/c false/c bytes? string?))
+        (values bytes? (listof bytes?) input-port?))]))