net/url: fix problems with new implementation on net/http-client

Various `net/url` operations need to request a close of the
connection after the operation completes, and `het/http-client`
needs to actually close the input-port half of a connection.

Also, add `http-conn-abandon!`.

Also also, add limits on internal pipes, so that data doesn't pile
up in a connection-processing thread, and fix POST/PUT by adding
a needed CRLF after posted data.

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

@@ -61,6 +61,13 @@ Closes @racket[hc] if it is live.
 
 }
 
+@defproc[(http-conn-abandon! [hc http-conn?])
+         void?]{
+
+Closes the output side of @racket[hc], if it is live.
+
+}
+
 @defproc[(http-conn-send! [hc http-conn-live?] [uri (or/c bytes? string?)]
                           [#:version version (or/c bytes? string?) #"1.1"]
                           [#:method method (or/c bytes? string? symbol?) #"GET"]

pkgs/racket-pkgs/racket-test/tests/net/url-port.rkt

@@ -151,12 +151,14 @@
 (module+ main (tests))
 (define (tests)
   (test
-   (run-tests "http" values #f)
+   (for ([i 100]) ; repeat to catch port leaks
-   (run-tests "https" (let ([ctx (ssl-make-server-context)])
+     (run-tests "http" values #f))
-                        (ssl-load-certificate-chain! ctx (collection-file-path "test.pem" "openssl"))
+   (for ([i 100])
-                        (ssl-load-private-key! ctx (collection-file-path "test.pem" "openssl"))
+     (run-tests "https" (let ([ctx (ssl-make-server-context)])
-                        (lambda (in out)
+                          (ssl-load-certificate-chain! ctx (collection-file-path "test.pem" "openssl"))
-                          (ports->ssl-ports in out #:mode 'accept #:context ctx)))
+                          (ssl-load-private-key! ctx (collection-file-path "test.pem" "openssl"))
-              #t)))
+                          (lambda (in out)
+                            (ports->ssl-ports in out #:mode 'accept #:context ctx)))
+                #t))))
 
 (module+ test (require (submod ".." main))) ; for raco test & drdr

racket/collects/net/http-client.rkt

@@ -25,6 +25,8 @@
 (define (regexp-member rx l)
   (ormap (λ (h) (regexp-match rx h)) l))
 
+(define PIPE-SIZE 4096)
+
 ;; Core
 
 (struct http-conn (host to from abandon-p) #:mutable)
@@ -65,10 +67,16 @@
     (abandon to)
     (set-http-conn-to! hc #f))
   (when from
-    ;; (abandon from)
+    (abandon from)
     (set-http-conn-from! hc #f))
   (set-http-conn-abandon-p! hc #f))
 
+(define (http-conn-abandon! hc)
+  (match-define (http-conn host to from abandon) hc)
+  (when to
+    (abandon to)
+    (set-http-conn-to! hc #f)))
+
 (define (http-conn-send! hc url-bs
                          #:version [version-bs #"1.1"]
                          #:method [method-bss #"GET"]
@@ -90,7 +98,8 @@
     (fprintf to "~a\r\n" h))
   (fprintf to "\r\n")
   (when data
-    (display data to))
+    (display data to)
+    (fprintf to "\r\n"))
   (flush-output to))
 
 (define (http-conn-status! hc)
@@ -114,7 +123,7 @@
   (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))
+  (define-values (in out) (make-pipe PIPE-SIZE))
   (thread
    (λ ()
      (copy-bytes (http-conn-from hc) out count)
@@ -145,7 +154,7 @@
           (write-bytes bs op 0 chunk-size)
           (loop bs)))))
 
-  (define-values (in out) (make-pipe))
+  (define-values (in out) (make-pipe PIPE-SIZE))
   (thread
    (λ ()
      (http-pipe-chunk (http-conn-from hc) out)
@@ -168,6 +177,8 @@
   (define close?
     (or iclose?
         (regexp-member #rx#"^(?i:Connection: +close)$" headers)))
+  (when close?
+    (http-conn-abandon! hc))
   (define response-port
     (cond
       [(regexp-member #rx#"^(?i:Transfer-Encoding: +chunked)$" headers)
@@ -232,6 +243,8 @@
         void?)]
   [http-conn-close!
    (-> http-conn? void?)]
+  [http-conn-abandon!
+   (-> http-conn? void?)]
   [http-conn-send!
    (->*
     (http-conn-live? (or/c bytes? string?))

racket/collects/net/url.rkt

@@ -126,7 +126,7 @@
                                 #f))))
 
 ;; http://getpost-impure-port : bool x url x union (str, #f) x list (str)
-                                        ;                               -> hc
+;;                               -> hc
 (define (http://getpost-impure-port get? url post-data strings
                                     make-ports 1.1?)
   (define proxy (assoc (url-scheme url) (current-proxy-servers)))
@@ -202,8 +202,9 @@
           [else (url-error "Scheme ~a unsupported" scheme)])))
 
 (define (http-conn-impure-port hc)
-  (define-values (in out) (make-pipe))
+  (define-values (in out) (make-pipe 4096))
-  (define-values (status headers response-port) (hc:http-conn-recv! hc))
+  (define-values (status headers response-port)
+    (hc:http-conn-recv! hc #:close? #t))
   (fprintf out "~a\r\n" status)
   (for ([h (in-list headers)])
     (fprintf out "~a\r\n" h))
@@ -237,7 +238,8 @@
                 (hc:http-conn-recv!
                  (http://getpost-impure-port
                   get? url post-data strings
-                  make-ports #f)))
+                  make-ports #f)
+                 #:close? #t))
               response-port]
              [else
               (define-values (port header)
@@ -268,7 +270,7 @@
                                     make-ports)
                                   (and conn #t)))
     (define-values (status headers response-port)
-      (hc:http-conn-recv! hc))
+      (hc:http-conn-recv! hc #:close? (not conn)))
 
     (define new-url
       (ormap (λ (h)