Thread connect-timeout: through the client; relock onto sigil-tls 0.16.2

Message

Add an opt-in connect-timeout: keyword (seconds) to http-request and the convenience/JSON wrappers, passed into connect-to-server which hands it to tls-connect (converted to ms) for HTTPS. Bounds the TCP connect phase so a blackholed address fails fast instead of hanging on the OS SYN timeout. Default #f keeps the blocking connect; plain HTTP is unchanged (socket layer has no connect-timeout knob yet).

Changed

 package.sgl               |   2 +-
 sigil.lock                |   4 ++--
 src/sigil/http/client.sgl | 105 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-------------------------------------
 3 files changed, 71 insertions(+), 40 deletions(-)

Diff

package.sglmodified

@@ -5,7 +5,7 @@

(package

name: "sigil-http"

−8

version: "0.16.4"

version: "0.16.5"

sigil: "^0.16"

description: "HTTP client and server library for Sigil"

url: "https://codeberg.org/sigil/sigil-http"

sigil.lockmodified

@@ -14,8 +14,8 @@

(package name: "sigil-tls"

url: "codeberg:sigil/sigil-tls"

ref: "^0.16.0"

−17

sha: "407d9d63ccb6a75a88f39f0588bf012c0eed2d6e"

−18

version: "0.16.1")

+17

sha: "e67c3b00b19bc495e38527203d0a563a8bcd5eab"

+18

version: "0.16.2")

(package name: "sigil-test"

url: "codeberg:sigil/sigil"

ref: "^0.17"

src/sigil/http/client.sglmodified

@@ -101,8 +101,8 @@

101

(define %tls-set-non-blocking! (delay (tls-ref 'tls-set-non-blocking!)))

102

103

;; TLS function wrappers

−104

(define (tls-connect* host port)

−105

((force %tls-connect) host port))

+104

(define (tls-connect* host port . connect-timeout-ms)

+105

(apply (force %tls-connect) host port connect-timeout-ms))

106

107

(define (tls-connection?* conn)

108

(and (force tls-module)

@@ -220,14 +220,22 @@

220

;; Low-level Connection Helpers

221

;; ============================================================

222

−223

;;; Connect to a server, using TLS if scheme is https

−224

;;; Returns connection object or #f on failure

−225

(define (connect-to-server parsed-url)

+223

;;; Connect to a server, using TLS if scheme is https.

+224

;;; Returns connection object or #f on failure.

+225

;;;

+226

;;; `connect-timeout` (seconds, or #f) bounds the TLS connect phase

+227

;;; so a blackholed address can't hang on the OS SYN timeout. It is

+228

;;; only honored for HTTPS (the TLS connect path); plain HTTP uses

+229

;;; the socket layer's blocking connect (no timeout knob there yet).

+230

(define (connect-to-server parsed-url connect-timeout)

231

(let ((host (url-host parsed-url))

232

(port (url-port parsed-url))

233

(scheme (url-scheme parsed-url)))

234

(if (string=? scheme "https")

−230

(tls-connect* host port)

+235

(if (and connect-timeout (> connect-timeout 0))

+236

(tls-connect* host port

+237

(exact (round (* connect-timeout 1000))))

+238

(tls-connect* host port))

239

(tcp-connect host port))))

240

241

;;; Write data to connection (socket or TLS)

@@ -707,6 +715,10 @@

715

;;; connection fails cleanly instead of hanging). When omitted (the

716

;;; default), reads block exactly as before.

717

;;;

+718

;;; The optional `connect-timeout:` keyword (seconds) bounds the

+719

;;; HTTPS connect phase, so a blackholed address can't hang on the

+720

;;; OS SYN timeout. Omitted/#f keeps the blocking connect.

+721

;;;

722

;;; ```scheme

723

;;; (http-request 'GET "https://api.example.com/users"

724

;;; headers: #{ authorization: "Bearer token" })

@@ -716,11 +728,12 @@

728

;;; body: "{\"name\": \"Alice\"}"

729

;;; timeout: 25)

730

;;; ```

−719

(define (http-request method url (keys: (headers #{}) (body #f) (timeout #f)))

+731

(define (http-request method url (keys: (headers #{}) (body #f) (timeout #f)

+732

(connect-timeout #f)))

733

(: symbol? string? (headers: dict?) (body: (maybe string?))

−721

(timeout: (maybe number?)) -> any?)

+734

(timeout: (maybe number?)) (connect-timeout: (maybe number?)) -> any?)

735

(let* ((parsed-url (parse-url url))

−723

(conn (connect-to-server parsed-url)))

+736

(conn (connect-to-server parsed-url connect-timeout)))

737

(if (not conn)

738

#f

739

(let ((deadline (timeout->deadline timeout))

@@ -742,9 +755,11 @@

755

;;; (http-get "https://api.example.com/users"

756

;;; headers: #{ authorization: "Bearer token" })

757

;;; ```

−745

(define (http-get url (keys: (headers #{}) (timeout #f)))

−746

(: string? (headers: dict?) (timeout: (maybe number?)) -> any?)

−747

(http-request 'GET url headers: headers timeout: timeout))

+758

(define (http-get url (keys: (headers #{}) (timeout #f) (connect-timeout #f)))

+759

(: string? (headers: dict?) (timeout: (maybe number?))

+760

(connect-timeout: (maybe number?)) -> any?)

+761

(http-request 'GET url headers: headers timeout: timeout

+762

connect-timeout: connect-timeout))

763

764

;;; HTTP POST request.

765

;;;

@@ -758,12 +773,14 @@

773

;;; "{\"key\": \"value\"}"

774

;;; headers: #{ content-type: "application/json" })

775

;;; ```

−761

(define (http-post url body (keys: (headers #{}) (timeout #f)))

−762

(: string? any? (headers: dict?) (timeout: (maybe number?)) -> any?)

+776

(define (http-post url body (keys: (headers #{}) (timeout #f) (connect-timeout #f)))

+777

(: string? any? (headers: dict?) (timeout: (maybe number?))

+778

(connect-timeout: (maybe number?)) -> any?)

779

(let ((hdrs (if (and (dict? headers) (not (dict-contains? headers content-type:)))

780

(dict-set headers content-type: "application/x-www-form-urlencoded")

781

headers)))

−766

(http-request 'POST url headers: hdrs body: body timeout: timeout)))

+782

(http-request 'POST url headers: hdrs body: body timeout: timeout

+783

connect-timeout: connect-timeout)))

784

785

;;; HTTP PUT request.

786

;;;

@@ -772,9 +789,11 @@

789

;;; "{\"name\": \"Alice\"}"

790

;;; headers: #{ content-type: "application/json" })

791

;;; ```

−775

(define (http-put url body (keys: (headers #{}) (timeout #f)))

−776

(: string? any? (headers: dict?) (timeout: (maybe number?)) -> any?)

−777

(http-request 'PUT url headers: headers body: body timeout: timeout))

+792

(define (http-put url body (keys: (headers #{}) (timeout #f) (connect-timeout #f)))

+793

(: string? any? (headers: dict?) (timeout: (maybe number?))

+794

(connect-timeout: (maybe number?)) -> any?)

+795

(http-request 'PUT url headers: headers body: body timeout: timeout

+796

connect-timeout: connect-timeout))

797

798

;;; HTTP DELETE request.

799

;;;

@@ -784,9 +803,11 @@

803

;;; (http-delete "https://api.example.com/users/123"

804

;;; headers: #{ authorization: "Bearer token" })

805

;;; ```

−787

(define (http-delete url (keys: (headers #{}) (timeout #f)))

−788

(: string? (headers: dict?) (timeout: (maybe number?)) -> any?)

−789

(http-request 'DELETE url headers: headers timeout: timeout))

+806

(define (http-delete url (keys: (headers #{}) (timeout #f) (connect-timeout #f)))

+807

(: string? (headers: dict?) (timeout: (maybe number?))

+808

(connect-timeout: (maybe number?)) -> any?)

+809

(http-request 'DELETE url headers: headers timeout: timeout

+810

connect-timeout: connect-timeout))

811

812

;;; HTTP HEAD request.

813

;;;

@@ -797,9 +818,11 @@

818

;;; (let ((res (http-head "https://example.com/file.pdf")))

819

;;; (http-response-header res "Content-Length"))

820

;;; ```

−800

(define (http-head url (keys: (headers #{}) (timeout #f)))

−801

(: string? (headers: dict?) (timeout: (maybe number?)) -> any?)

−802

(http-request 'HEAD url headers: headers timeout: timeout))

+821

(define (http-head url (keys: (headers #{}) (timeout #f) (connect-timeout #f)))

+822

(: string? (headers: dict?) (timeout: (maybe number?))

+823

(connect-timeout: (maybe number?)) -> any?)

+824

(http-request 'HEAD url headers: headers timeout: timeout

+825

connect-timeout: connect-timeout))

826

827

;;; HTTP OPTIONS request.

828

;;;

@@ -810,9 +833,11 @@

833

;;; (http-response-header res "Allow"))

834

;;; ; => "GET, POST, OPTIONS"

835

;;; ```

−813

(define (http-options url (keys: (headers #{}) (timeout #f)))

−814

(: string? (headers: dict?) (timeout: (maybe number?)) -> any?)

−815

(http-request 'OPTIONS url headers: headers timeout: timeout))

+836

(define (http-options url (keys: (headers #{}) (timeout #f) (connect-timeout #f)))

+837

(: string? (headers: dict?) (timeout: (maybe number?))

+838

(connect-timeout: (maybe number?)) -> any?)

+839

(http-request 'OPTIONS url headers: headers timeout: timeout

+840

connect-timeout: connect-timeout))

841

842

;;; HTTP PATCH request.

843

;;;

@@ -824,9 +849,11 @@

849

;;; "{\"email\": \"[email protected]\"}"

850

;;; headers: #{ content-type: "application/json" })

851

;;; ```

−827

(define (http-patch url body (keys: (headers #{}) (timeout #f)))

−828

(: string? any? (headers: dict?) (timeout: (maybe number?)) -> any?)

−829

(http-request 'PATCH url headers: headers body: body timeout: timeout))

+852

(define (http-patch url body (keys: (headers #{}) (timeout #f) (connect-timeout #f)))

+853

(: string? any? (headers: dict?) (timeout: (maybe number?))

+854

(connect-timeout: (maybe number?)) -> any?)

+855

(http-request 'PATCH url headers: headers body: body timeout: timeout

+856

connect-timeout: connect-timeout))

857

858

;; ============================================================

859

;; JSON Conveniences

@@ -862,9 +889,11 @@

889

;;; (http-get/json "https://api.example.com/users"

890

;;; headers: #{ authorization: "Bearer token" })

891

;;; ```

−865

(define (http-get/json url (keys: (headers #{}) (timeout #f)))

−866

(: string? (headers: dict?) (timeout: (maybe number?)) -> any?)

−867

(let ((res (http-get url headers: headers timeout: timeout)))

+892

(define (http-get/json url (keys: (headers #{}) (timeout #f) (connect-timeout #f)))

+893

(: string? (headers: dict?) (timeout: (maybe number?))

+894

(connect-timeout: (maybe number?)) -> any?)

+895

(let ((res (http-get url headers: headers timeout: timeout

+896

connect-timeout: connect-timeout)))

897

(and res (http-response-json res))))

898

899

;;; HTTP POST request with JSON body, expecting JSON response.

@@ -882,11 +911,13 @@

911

;;; #{ name: "Alice" }

912

;;; headers: #{ authorization: "Bearer token" })

913

;;; ```

−885

(define (http-post/json url body (keys: (headers #{}) (timeout #f)))

−886

(: string? any? (headers: dict?) (timeout: (maybe number?)) -> any?)

+914

(define (http-post/json url body (keys: (headers #{}) (timeout #f) (connect-timeout #f)))

+915

(: string? any? (headers: dict?) (timeout: (maybe number?))

+916

(connect-timeout: (maybe number?)) -> any?)

917

(let* ((json-body (json-encode* body))

918

(hdrs (dict-set headers content-type: "application/json"))

−889

(res (http-request 'POST url headers: hdrs body: json-body timeout: timeout)))

+919

(res (http-request 'POST url headers: hdrs body: json-body timeout: timeout

+920

connect-timeout: connect-timeout)))

921

(and res (http-response-json res))))

922

923

;; ============================================================

@@ -1001,7 +1032,7 @@

1032

(on-progress #f)

1033

(max-redirects 5)))

1034

(let* ((parsed-url (parse-url url))

−1004

(conn (connect-to-server parsed-url)))

+1035

(conn (connect-to-server parsed-url #f)))

1036

(if (not conn)

1037

#f

1038

(let ((request-str (build-request-string 'GET parsed-url headers #f)))