From 7ae83ba1e6f44ce4b506aceaf4bed85088a5dc0a Mon Sep 17 00:00:00 2001 From: Leandro Facchinetti Date: Fri, 10 Feb 2017 07:14:55 -0500 Subject: [PATCH] =?UTF-8?q?Fix=20=E2=80=9Cgit-checkout=E2=80=9D=20by=20add?= =?UTF-8?q?ing=20HTTP=20auto-reconnect?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- .../net-doc/net/scribblings/http-client.scrbl | 39 +++++++++--- pkgs/net-test/tests/net/http-client.rkt | 38 +++++++++++- racket/collects/net/git-checkout.rkt | 3 +- racket/collects/net/http-client.rkt | 59 ++++++++++++++----- 4 files changed, 113 insertions(+), 26 deletions(-) diff --git a/pkgs/net-doc/net/scribblings/http-client.scrbl b/pkgs/net-doc/net/scribblings/http-client.scrbl index 46e0418f03..d0ad117443 100644 --- a/pkgs/net-doc/net/scribblings/http-client.scrbl +++ b/pkgs/net-doc/net/scribblings/http-client.scrbl @@ -21,8 +21,17 @@ 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. +Identifies an HTTP connection that is "live", i.e. one that is still +connected to the server. + +} + +@defproc[(http-conn-liveable? [x any/c]) + boolean?]{ + +Identifies an HTTP connection that can be made "live", i.e. one for which +@racket[http-conn-send!] is valid. Either the HTTP connection is already +@racket[http-conn-live?], or it can @tech{auto-reconnect}. } @@ -35,13 +44,18 @@ Returns a fresh HTTP connection. @defproc[(http-conn-open! [hc http-conn?] [host (or/c bytes? string?)] [#:ssl? ssl? base-ssl?-tnl/c #f] - [#:port port (between/c 1 65535) (if ssl? 443 80)]) + [#:port port (between/c 1 65535) (if ssl? 443 80)] + [#:auto-reconnect? auto-reconnect? boolean? #f]) 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.) +certificates.) If @racket[auto-reconnect?] is @racket[#t], then the HTTP +connection is going to try to @deftech{auto-reconnect} for subsequent requests. +I.e., if the connection is closed when performing @racket[http-conn-send!] or +@racket[http-conn-recv!], then @racket[http-conn-enliven!] is going to be +called on it. If @racket[hc] is live, the connection is closed. @@ -49,7 +63,8 @@ If @racket[hc] is live, the connection is closed. @defproc[(http-conn-open [host (or/c bytes? string?)] [#:ssl? ssl? base-ssl?-tnl/c #f] - [#:port port (between/c 1 65535) (if ssl? 443 80)]) + [#:port port (between/c 1 65535) (if ssl? 443 80)] + [#:auto-reconnect? auto-reconnect? boolean? #f]) http-conn?]{ Calls @racket[http-conn-open!] with a fresh connection, which is returned. @@ -70,7 +85,15 @@ Closes the output side of @racket[hc], if it is live. } -@defproc[(http-conn-send! [hc http-conn-live?] [uri (or/c bytes? string?)] +@defproc[(http-conn-enliven! [hc http-conn?]) + void?]{ + +Reconnects @racket[hc] to the server, if it is @emph{not} live but it is +configured to @tech{auto-reconnect}. + +} + +@defproc[(http-conn-send! [hc http-conn-liveable?] [uri (or/c bytes? string?)] [#:version version (or/c bytes? string?) #"1.1"] [#:method method (or/c bytes? string? symbol?) #"GET"] [#:close? close? boolean? #f] @@ -104,7 +127,7 @@ This function does not support requests that expect } -@defproc[(http-conn-recv! [hc http-conn-live?] +@defproc[(http-conn-recv! [hc http-conn-liveable?] [#:content-decode decodes (listof symbol?) '(gzip)] [#:method method (or/c bytes? string? symbol?) #"GET"] [#:close? close? boolean? #f]) @@ -126,7 +149,7 @@ to do so. @history[#:changed "6.1.1.6" @elem{Added the @racket[#:method] argument.}]} -@defproc[(http-conn-sendrecv! [hc http-conn-live?] [uri (or/c bytes? string?)] +@defproc[(http-conn-sendrecv! [hc http-conn-liveable?] [uri (or/c bytes? string?)] [#:version version (or/c bytes? string?) #"1.1"] [#:method method (or/c bytes? string? symbol?) #"GET"] [#:headers headers (listof (or/c bytes? string?)) empty] diff --git a/pkgs/net-test/tests/net/http-client.rkt b/pkgs/net-test/tests/net/http-client.rkt index 770914dec6..12ea2b1b21 100644 --- a/pkgs/net-test/tests/net/http-client.rkt +++ b/pkgs/net-test/tests/net/http-client.rkt @@ -103,6 +103,7 @@ #:port the-port #:ssl? #f)]) (check-equal? #t (hc:http-conn-live? c)) + (check-equal? #t (hc:http-conn-liveable? c)) (hc:http-conn-send! c "/" #:method method @@ -113,17 +114,20 @@ (hc:http-conn-recv! c #:method method #:close? #t) - (check-equal? #f (hc:http-conn-live? c))))) + (check-equal? #f (hc:http-conn-live? c)) + (check-equal? #f (hc:http-conn-liveable? c))))) raw ereq estatus eheaders econtent)) #,(syntax/loc stx (test-e the-port 3 (hc:http-conn) (lambda (c) (check-equal? #f (hc:http-conn-live? c)) + (check-equal? #f (hc:http-conn-liveable? c)) (hc:http-conn-open! c "localhost" #:port the-port #:ssl? #f) (check-equal? #t (hc:http-conn-live? c)) + (check-equal? #t (hc:http-conn-liveable? c)) (hc:http-conn-send! c "/" #:method method @@ -134,7 +138,8 @@ (hc:http-conn-recv! c #:method method #:close? #t) - (check-equal? #f (hc:http-conn-live? c)))) + (check-equal? #f (hc:http-conn-live? c)) + (check-equal? #f (hc:http-conn-liveable? c)))) raw ereq estatus eheaders econtent)) #,(syntax/loc stx (test-e the-port @@ -318,5 +323,34 @@ (abandon-p from))) "MONKEYS") + (let ([c (hc:http-conn)]) + (check-equal? #f (hc:http-conn-live? c)) + (check-equal? #f (hc:http-conn-liveable? c)) + + (hc:http-conn-open! c "localhost" + #:port es:port + #:ssl? #f + #:auto-reconnect? #t) + (check-equal? #t (hc:http-conn-live? c)) + (check-equal? #t (hc:http-conn-liveable? c)) + + (let-values ([(status headers content-port) + (hc:http-conn-sendrecv! c + "/" + #:close? #t + #:data #"BANANAS")]) + (check-equal? #f (hc:http-conn-live? c)) + (check-equal? #t (hc:http-conn-liveable? c)) + (check-equal? (port->bytes content-port) #"BANANAS")) + + (let-values ([(status headers content-port) + (hc:http-conn-sendrecv! c + "/" + #:close? #t + #:data #"MONKEYS")]) + (check-equal? #f (hc:http-conn-live? c)) + (check-equal? #t (hc:http-conn-liveable? c)) + (check-equal? (port->bytes content-port) #"MONKEYS"))) + (ps:shutdown-server) (es:shutdown-server)) diff --git a/racket/collects/net/git-checkout.rkt b/racket/collects/net/git-checkout.rkt index dbc323cf2e..d9e79665a2 100644 --- a/racket/collects/net/git-checkout.rkt +++ b/racket/collects/net/git-checkout.rkt @@ -745,7 +745,8 @@ #:ssl? (if (eq? transport 'https) (ssl-context verify?) #f) - #:port port) + #:port port + #:auto-reconnect? #t) (define packfiles (get-packfile-list conn repo)) diff --git a/racket/collects/net/http-client.rkt b/racket/collects/net/http-client.rkt index e965a6ff3d..cb4c222d31 100644 --- a/racket/collects/net/http-client.rkt +++ b/racket/collects/net/http-client.rkt @@ -47,17 +47,23 @@ ;; Core -(struct http-conn (host port port-usual? to from abandon-p) #:mutable) +(struct http-conn (host port port-usual? to from abandon-p + auto-reconnect? auto-reconnect-host auto-reconnect-ssl?) #:mutable) (define (make-http-conn) - (http-conn #f #f #f #f #f #f)) + (http-conn #f #f #f #f #f #f #f #f #f)) (define (http-conn-live? hc) (and (http-conn-to hc) (http-conn-from hc) #t)) -(define (http-conn-open! hc host-bs #:ssl? [ssl? #f] #:port [port (if ssl? 443 80)]) +(define (http-conn-liveable? hc) + (or (http-conn-live? hc) + (http-conn-auto-reconnect? hc))) + +(define (http-conn-open! hc host-bs #:ssl? [ssl? #f] #:port [port (if ssl? 443 80)] + #:auto-reconnect? [auto-reconnect? #f]) (http-conn-close! hc) (define host (->string host-bs)) (define ssl-version (if (boolean? ssl?) 'auto ssl?)) @@ -97,10 +103,15 @@ ;; (thread (λ () (copy-port log-i to (current-error-port)))) (set-http-conn-to! hc to) - (set-http-conn-from! hc from)) + (set-http-conn-from! hc from) + + (set-http-conn-auto-reconnect?! hc auto-reconnect?) + (set-http-conn-auto-reconnect-host! hc host-bs) + (set-http-conn-auto-reconnect-ssl?! hc ssl?)) (define (http-conn-close! hc) - (match-define (http-conn host port port-usual? to from abandon) hc) + (match-define (http-conn host port port-usual? to from abandon + auto-reconnect? auto-reconnect-host auto-reconnect-ssl?) hc) (set-http-conn-host! hc #f) (when to (close-output-port to) @@ -111,11 +122,17 @@ (set-http-conn-abandon-p! hc #f)) (define (http-conn-abandon! hc) - (match-define (http-conn host port port-usual? to from abandon) hc) + (match-define (http-conn host port port-usual? to from abandon + auto-reconnect? auto-reconnect-host auto-reconnect-ssl?) hc) (when to (abandon to) (set-http-conn-to! hc #f))) +(define (http-conn-enliven! hc) + (when (and (not (http-conn-live? hc)) (http-conn-auto-reconnect? hc)) + (http-conn-open! hc (http-conn-auto-reconnect-host hc) #:ssl? (http-conn-auto-reconnect-ssl? hc) + #:port (http-conn-port hc) #:auto-reconnect? (http-conn-auto-reconnect? hc)))) + (define (write-chunk out data) (let ([bytes (->bytes data)]) (define len (bytes-length bytes)) @@ -129,7 +146,9 @@ #:headers [headers-bs empty] #:content-decode [decodes '(gzip)] #:data [data #f]) - (match-define (http-conn host port port-usual? to from _) hc) + (http-conn-enliven! hc) + (match-define (http-conn host port port-usual? to from _ + auto-reconnect? auto-reconnect-host auto-reconnect-ssl?) hc) (fprintf to "~a ~a HTTP/~a\r\n" method-bss url-bs version-bs) (unless (regexp-member #rx"^(?i:Host:) +.+$" headers-bs) (fprintf to "Host: ~a\r\n" @@ -240,9 +259,10 @@ ;; Derived -(define (http-conn-open host-bs #:ssl? [ssl? #f] #:port [port (if ssl? 443 80)]) +(define (http-conn-open host-bs #:ssl? [ssl? #f] #:port [port (if ssl? 443 80)] + #:auto-reconnect? [auto-reconnect? #f]) (define hc (make-http-conn)) - (http-conn-open! hc host-bs #:ssl? ssl? #:port port) + (http-conn-open! hc host-bs #:ssl? ssl? #:port port #:auto-reconnect? auto-reconnect?) hc) (define (http-conn-CONNECT-tunnel proxy-host proxy-port target-host target-port #:ssl? [ssl? #f]) @@ -260,7 +280,8 @@ (error 'make-ports "HTTP CONNECT failed: ~a" tunnel-status))) ;; SSL secure the ports - (match-define (http-conn _ _ _ t:to t:from _) hc) + (match-define (http-conn _ _ _ t:to t:from _ + auto-reconnect? auto-reconnect-host auto-reconnect-ssl?) hc) (cond [(not ssl?) ; it's just a tunnel... no ssl (define abandon-p (lambda (p) ((http-conn-abandon-p hc) p))) (values ssl? t:from t:to abandon-p)] @@ -300,6 +321,7 @@ #:method [method-bss #"GET"] #:content-decode [decodes '(gzip)] #:close? [iclose? #f]) + (http-conn-enliven! hc) (define status (http-conn-status! hc)) (define headers (http-conn-headers! hc)) (define close? @@ -409,21 +431,27 @@ [http-conn-live? (-> any/c boolean?)] + [http-conn-liveable? + (-> any/c + boolean?)] [rename make-http-conn http-conn (-> http-conn?)] [http-conn-open! (->* (http-conn? (or/c bytes? string?)) (#:ssl? base-ssl?-tnl/c - #:port (between/c 1 65535)) + #:port (between/c 1 65535) + #:auto-reconnect? boolean?) void?)] [http-conn-close! (-> http-conn? void?)] [http-conn-abandon! (-> http-conn? void?)] + [http-conn-enliven! + (-> http-conn-liveable? void?)] [http-conn-send! (->* - (http-conn-live? (or/c bytes? string?)) + (http-conn-liveable? (or/c bytes? string?)) (#:version (or/c bytes? string?) #:method (or/c bytes? string? symbol?) #:close? boolean? @@ -435,7 +463,8 @@ [http-conn-open (->* ((or/c bytes? string?)) (#:ssl? base-ssl?-tnl/c - #:port (between/c 1 65535)) + #:port (between/c 1 65535) + #:auto-reconnect? boolean?) http-conn?)] [http-conn-CONNECT-tunnel (->* ((or/c bytes? string?) @@ -445,13 +474,13 @@ (#:ssl? base-ssl?/c) (values base-ssl?/c input-port? output-port? (-> port? void?)))] [http-conn-recv! - (->* (http-conn-live?) + (->* (http-conn-liveable?) (#:content-decode (listof symbol?) #:method (or/c bytes? string? symbol?) #:close? boolean?) (values bytes? (listof bytes?) input-port?))] [http-conn-sendrecv! - (->* (http-conn-live? (or/c bytes? string?)) + (->* (http-conn-liveable? (or/c bytes? string?)) (#:version (or/c bytes? string?) #:method (or/c bytes? string? symbol?) #:headers (listof (or/c bytes? string?))