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

Fix “git-checkout” by adding HTTP auto-reconnect

Browse Source
This commit is contained in:
Leandro Facchinetti 2017-02-10 07:14:55 -05:00
parent 6632beeca9
commit 7ae83ba1e6
4 changed files with 113 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

39
pkgs/net-doc/net/scribblings/http-client.scrbl
View File

@ -21,8 +21,17 @@ Identifies an HTTP connection.
@defproc[(http-conn-live? [x any/c]) @defproc[(http-conn-live? [x any/c])
boolean?]{ boolean?]{
Identifies an HTTP connection that is "live", i.e. one for which Identifies an HTTP connection that is "live", i.e. one that is still
@racket[http-conn-send!] is valid. 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?)] @defproc[(http-conn-open! [hc http-conn?] [host (or/c bytes? string?)]
[#:ssl? ssl? base-ssl?-tnl/c #f] [#: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?]{ void?]{
Uses @racket[hc] to connect to @racket[host] on port @racket[port] 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 using SSL if @racket[ssl?] is not @racket[#f] (using @racket[ssl?] as
an argument to @racket[ssl-connect] to, for example, check 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. 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?)] @defproc[(http-conn-open [host (or/c bytes? string?)]
[#:ssl? ssl? base-ssl?-tnl/c #f] [#: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?]{ http-conn?]{
Calls @racket[http-conn-open!] with a fresh connection, which is returned. 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"] [#:version version (or/c bytes? string?) #"1.1"]
[#:method method (or/c bytes? string? symbol?) #"GET"] [#:method method (or/c bytes? string? symbol?) #"GET"]
[#:close? close? boolean? #f] [#: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)] [#:content-decode decodes (listof symbol?) '(gzip)]
[#:method method (or/c bytes? string? symbol?) #"GET"] [#:method method (or/c bytes? string? symbol?) #"GET"]
[#:close? close? boolean? #f]) [#:close? close? boolean? #f])
@ -126,7 +149,7 @@ to do so.
@history[#:changed "6.1.1.6" @elem{Added the @racket[#:method] argument.}]} @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"] [#:version version (or/c bytes? string?) #"1.1"]
[#:method method (or/c bytes? string? symbol?) #"GET"] [#:method method (or/c bytes? string? symbol?) #"GET"]
[#:headers headers (listof (or/c bytes? string?)) empty] [#:headers headers (listof (or/c bytes? string?)) empty]

38
pkgs/net-test/tests/net/http-client.rkt
View File

@ -103,6 +103,7 @@
#:port the-port #:port the-port
#:ssl? #f)]) #:ssl? #f)])
(check-equal? #t (hc:http-conn-live? c)) (check-equal? #t (hc:http-conn-live? c))
(check-equal? #t (hc:http-conn-liveable? c))
(hc:http-conn-send! c (hc:http-conn-send! c
"/" "/"
#:method method #:method method
@ -113,17 +114,20 @@
(hc:http-conn-recv! c (hc:http-conn-recv! c
#:method method #:method method
#:close? #t) #: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)) raw ereq estatus eheaders econtent))
#,(syntax/loc stx #,(syntax/loc stx
(test-e the-port (test-e the-port
3 (hc:http-conn) 3 (hc:http-conn)
(lambda (c) (lambda (c)
(check-equal? #f (hc:http-conn-live? c)) (check-equal? #f (hc:http-conn-live? c))
(check-equal? #f (hc:http-conn-liveable? c))
(hc:http-conn-open! c "localhost" (hc:http-conn-open! c "localhost"
#:port the-port #:port the-port
#:ssl? #f) #:ssl? #f)
(check-equal? #t (hc:http-conn-live? c)) (check-equal? #t (hc:http-conn-live? c))
(check-equal? #t (hc:http-conn-liveable? c))
(hc:http-conn-send! c (hc:http-conn-send! c
"/" "/"
#:method method #:method method
@ -134,7 +138,8 @@
(hc:http-conn-recv! c (hc:http-conn-recv! c
#:method method #:method method
#:close? #t) #: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)) raw ereq estatus eheaders econtent))
#,(syntax/loc stx #,(syntax/loc stx
(test-e the-port (test-e the-port
@ -318,5 +323,34 @@
(abandon-p from))) (abandon-p from)))
"MONKEYS") "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) (ps:shutdown-server)
(es:shutdown-server)) (es:shutdown-server))

3
racket/collects/net/git-checkout.rkt
View File

@ -745,7 +745,8 @@
#:ssl? (if (eq? transport 'https) #:ssl? (if (eq? transport 'https)
(ssl-context verify?) (ssl-context verify?)
#f) #f)
#:port port) #:port port
#:auto-reconnect? #t)
(define packfiles (define packfiles
(get-packfile-list conn repo)) (get-packfile-list conn repo))

59
racket/collects/net/http-client.rkt
View File

@ -47,17 +47,23 @@
;; Core ;; 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) (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) (define (http-conn-live? hc)
(and (http-conn-to hc) (and (http-conn-to hc)
(http-conn-from hc) (http-conn-from hc)
#t)) #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) (http-conn-close! hc)
(define host (->string host-bs)) (define host (->string host-bs))
(define ssl-version (if (boolean? ssl?) 'auto ssl?)) (define ssl-version (if (boolean? ssl?) 'auto ssl?))
@ -97,10 +103,15 @@
;; (thread (λ () (copy-port log-i to (current-error-port)))) ;; (thread (λ () (copy-port log-i to (current-error-port))))
(set-http-conn-to! hc to) (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) (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) (set-http-conn-host! hc #f)
(when to (when to
(close-output-port to) (close-output-port to)
@ -111,11 +122,17 @@
(set-http-conn-abandon-p! hc #f)) (set-http-conn-abandon-p! hc #f))
(define (http-conn-abandon! hc) (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 (when to
(abandon to) (abandon to)
(set-http-conn-to! hc #f))) (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) (define (write-chunk out data)
(let ([bytes (->bytes data)]) (let ([bytes (->bytes data)])
(define len (bytes-length bytes)) (define len (bytes-length bytes))
@ -129,7 +146,9 @@
#:headers [headers-bs empty] #:headers [headers-bs empty]
#:content-decode [decodes '(gzip)] #:content-decode [decodes '(gzip)]
#:data [data #f]) #: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) (fprintf to "~a ~a HTTP/~a\r\n" method-bss url-bs version-bs)
(unless (regexp-member #rx"^(?i:Host:) +.+$" headers-bs) (unless (regexp-member #rx"^(?i:Host:) +.+$" headers-bs)
(fprintf to "Host: ~a\r\n" (fprintf to "Host: ~a\r\n"
@ -240,9 +259,10 @@
;; Derived ;; 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)) (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) hc)
(define (http-conn-CONNECT-tunnel proxy-host proxy-port target-host target-port #:ssl? [ssl? #f]) (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))) (error 'make-ports "HTTP CONNECT failed: ~a" tunnel-status)))
;; SSL secure the ports ;; 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 (cond [(not ssl?) ; it's just a tunnel... no ssl
(define abandon-p (lambda (p) ((http-conn-abandon-p hc) p))) (define abandon-p (lambda (p) ((http-conn-abandon-p hc) p)))
(values ssl? t:from t:to abandon-p)] (values ssl? t:from t:to abandon-p)]
@ -300,6 +321,7 @@
#:method [method-bss #"GET"] #:method [method-bss #"GET"]
#:content-decode [decodes '(gzip)] #:content-decode [decodes '(gzip)]
#:close? [iclose? #f]) #:close? [iclose? #f])
(http-conn-enliven! hc)
(define status (http-conn-status! hc)) (define status (http-conn-status! hc))
(define headers (http-conn-headers! hc)) (define headers (http-conn-headers! hc))
(define close? (define close?
@ -409,21 +431,27 @@
[http-conn-live? [http-conn-live?
(-> any/c (-> any/c
boolean?)] boolean?)]
[http-conn-liveable?
(-> any/c
boolean?)]
[rename [rename
make-http-conn http-conn make-http-conn http-conn
(-> http-conn?)] (-> http-conn?)]
[http-conn-open! [http-conn-open!
(->* (http-conn? (or/c bytes? string?)) (->* (http-conn? (or/c bytes? string?))
(#:ssl? base-ssl?-tnl/c (#:ssl? base-ssl?-tnl/c
#:port (between/c 1 65535)) #:port (between/c 1 65535)
#:auto-reconnect? boolean?)
void?)] void?)]
[http-conn-close! [http-conn-close!
(-> http-conn? void?)] (-> http-conn? void?)]
[http-conn-abandon! [http-conn-abandon!
(-> http-conn? void?)] (-> http-conn? void?)]
[http-conn-enliven!
(-> http-conn-liveable? void?)]
[http-conn-send! [http-conn-send!
(->* (->*
(http-conn-live? (or/c bytes? string?)) (http-conn-liveable? (or/c bytes? string?))
(#:version (or/c bytes? string?) (#:version (or/c bytes? string?)
#:method (or/c bytes? string? symbol?) #:method (or/c bytes? string? symbol?)
#:close? boolean? #:close? boolean?
@ -435,7 +463,8 @@
[http-conn-open [http-conn-open
(->* ((or/c bytes? string?)) (->* ((or/c bytes? string?))
(#:ssl? base-ssl?-tnl/c (#:ssl? base-ssl?-tnl/c
#:port (between/c 1 65535)) #:port (between/c 1 65535)
#:auto-reconnect? boolean?)
http-conn?)] http-conn?)]
[http-conn-CONNECT-tunnel [http-conn-CONNECT-tunnel
(->* ((or/c bytes? string?) (->* ((or/c bytes? string?)
@ -445,13 +474,13 @@
(#:ssl? base-ssl?/c) (#:ssl? base-ssl?/c)
(values base-ssl?/c input-port? output-port? (-> port? void?)))] (values base-ssl?/c input-port? output-port? (-> port? void?)))]
[http-conn-recv! [http-conn-recv!
(->* (http-conn-live?) (->* (http-conn-liveable?)
(#:content-decode (listof symbol?) (#:content-decode (listof symbol?)
#:method (or/c bytes? string? symbol?) #:method (or/c bytes? string? symbol?)
#:close? boolean?) #:close? boolean?)
(values bytes? (listof bytes?) input-port?))] (values bytes? (listof bytes?) input-port?))]
[http-conn-sendrecv! [http-conn-sendrecv!
(->* (http-conn-live? (or/c bytes? string?)) (->* (http-conn-liveable? (or/c bytes? string?))
(#:version (or/c bytes? string?) (#:version (or/c bytes? string?)
#:method (or/c bytes? string? symbol?) #:method (or/c bytes? string? symbol?)
#:headers (listof (or/c bytes? string?)) #:headers (listof (or/c bytes? string?))