Terminate response read on HTTP framing, not connection close

Message

read-all-data previously read until the peer closed the connection (EOF) and parse-http-response ignored Content-Length, so a keep-alive or half-open peer that sent a COMPLETE response and then held the connection open hung the read forever (the original /mcp wedge) or, once a read timeout existed, tripped a spurious deadline on a request the server had already processed -> the caller retried -> duplicate delivery.

Make the read framing-aware: once headers arrive, complete as soon as the body is fully received per Content-Length, the chunked 0-terminator, or a body-less status/method (HEAD, 1xx, 204, 304). Only an unframed response (no Content-Length, not chunked) falls back to read-until-EOF. This terminates correctly with or without a timeout, so the ack is read reliably and the duplicate-retry trigger is removed at the source.

Verified with a hold-open server (full Content-Length response, never closes): the client now returns the parsed 200 in ~4-25ms instead of hanging (blocking) or timing out at the deadline. Adds framing unit tests; all existing behavior preserved (118/118).

Changed

 src/sigil/http/client.sgl | 158 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++--------------------
 test/test-client.sgl      |  81 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 219 insertions(+), 20 deletions(-)

Diff

src/sigil/http/client.sglmodified

@@ -61,7 +61,12 @@

;; Internal — exported for testing

parse-http-response

−64

decode-chunked-body)

+64

decode-chunked-body

+65

find-header-end-bytes

+66

no-body-expected?

+67

detect-framing

+68

chunked-body-complete?

+69

framing-complete?)

(begin

@@ -406,29 +411,128 @@

411

(dict-set headers name value)))

412

(loop (cdr lines) headers))))))

413

+414

;;; Find the end of the header block (\r\n\r\n) in a bytevector.

+415

;;; Returns the index of the first \r, or #f if not yet present.

+416

(define (find-header-end-bytes bv)

+417

(let ((len (bytevector-length bv)))

+418

(let loop ((i 0))

+419

(if (> (+ i 3) (- len 1))

+420

#f

+421

(if (and (= (bytevector-u8-ref bv i) 13)

+422

(= (bytevector-u8-ref bv (+ i 1)) 10)

+423

(= (bytevector-u8-ref bv (+ i 2)) 13)

+424

(= (bytevector-u8-ref bv (+ i 3)) 10))

+425

i

+426

(loop (+ i 1)))))))

+427

+428

;;; Does this method/status combination forbid a response body?

+429

;;; HEAD never has a body; 1xx/204/304 never have a body (RFC 9112).

+430

(define (no-body-expected? method status)

+431

(or (eq? method 'HEAD)

+432

(and status

+433

(or (= status 204)

+434

(= status 304)

+435

(and (>= status 100) (< status 200))))))

+436

+437

;;; Inspect the accumulated response bytes and determine how the body

+438

;;; is framed. Returns #f while the header block is still incomplete,

+439

;;; otherwise a descriptor:

+440

;;; (no-body) — no body permitted; complete at headers

+441

;;; (length <body-start> <n>) — fixed Content-Length body

+442

;;; (chunked <body-start>) — chunked transfer-encoding

+443

;;; (until-close) — unframed; read until the peer closes

+444

;;; This lets the reader stop as soon as the full body has arrived

+445

;;; instead of waiting for the connection to close (EOF), which a

+446

;;; keep-alive/half-open peer may never do.

+447

(define (detect-framing method bv)

+448

(let ((he (find-header-end-bytes bv)))

+449

(if (not he)

+450

#f

+451

(let* ((body-start (+ he 4))

+452

(header-str (utf8->string (bytevector-copy bv 0 he)))

+453

(lines (string-split header-str "\r\n"))

+454

(status-info (and (pair? lines) (parse-status-line (car lines))))

+455

(status (and status-info (cadr status-info)))

+456

(headers (if (pair? lines)

+457

(parse-response-headers (cdr lines))

+458

#{}))

+459

(te (dict-ref headers transfer-encoding: #f))

+460

(cl (dict-ref headers content-length: #f)))

+461

(cond

+462

((no-body-expected? method status) (list 'no-body))

+463

((and te (string-contains? (string-downcase te) "chunked"))

+464

(list 'chunked body-start))

+465

(cl (let ((n (string->number (string-trim cl))))

+466

(if n (list 'length body-start n) (list 'until-close))))

+467

(else (list 'until-close)))))))

+468

+469

;;; Is the chunked body starting at `start` fully present in `bv`?

+470

;;; Walks chunk-size lines until the terminating 0-size chunk and its

+471

;;; closing CRLF (no trailers). Returns #f if more data is needed.

+472

(define (chunked-body-complete? bv start)

+473

(let ((len (bytevector-length bv)))

+474

(let loop ((pos start))

+475

(let ((line-end (find-crlf-bytes bv pos)))

+476

(if (not line-end)

+477

#f

+478

(let* ((size-str (utf8->string (bytevector-copy bv pos line-end)))

+479

(sz (hex-string->number size-str)))

+480

(cond

+481

((not sz) #f)

+482

((= sz 0)

+483

;; Final chunk: need the closing CRLF after "0\r\n".

+484

(let ((after (+ line-end 2)))

+485

(and (<= (+ after 2) len)

+486

(= (bytevector-u8-ref bv after) 13)

+487

(= (bytevector-u8-ref bv (+ after 1)) 10))))

+488

(else

+489

;; size-line CRLF + data + trailing CRLF

+490

(let ((next (+ line-end 2 sz 2)))

+491

(if (> next len) #f (loop next)))))))))))

+492

+493

;;; Is the response complete per its framing descriptor?

+494

;;; `combined` is the accumulated bytevector (only needed for chunked).

+495

(define (framing-complete? framing total combined)

+496

(let ((mode (car framing)))

+497

(cond

+498

((eq? mode 'no-body) #t)

+499

((eq? mode 'length) (>= (- total (cadr framing)) (caddr framing)))

+500

((eq? mode 'chunked) (chunked-body-complete? combined (cadr framing)))

+501

(else #f)))) ; until-close — rely on EOF

+502

503

;;; Read HTTP response from connection

−410

;;; Returns http-response or #f on error

+504

;;; Returns http-response or #f on error.

+505

;;; `method` is the request method (HEAD responses carry no body).

506

;;; `deadline` is a jiffy deadline (or #f). When set, the read loop

−412

;;; enforces a timeout instead of treating an empty read as EOF.

−413

(define (read-http-response conn deadline)

+507

;;; enforces a timeout instead of blocking on a stalled read.

+508

(define (read-http-response method conn deadline)

509

;; Read all available data

−415

(let ((data (read-all-data conn deadline)))

+510

(let ((data (read-all-data method conn deadline)))

511

(if (or (not data) (string=? data ""))

512

#f

513

(parse-http-response data))))

514

−420

;;; Read all data from connection until closed.

−421

;;; Reads as bytevectors and converts to string once at the end

−422

;;; to avoid splitting multi-byte UTF-8 characters across chunks.

+515

;;; Read a full HTTP response from the connection.

+516

;;; Reads as bytevectors and converts to string once at the end to

+517

;;; avoid splitting multi-byte UTF-8 characters across chunks.

+518

;;;

+519

;;; Termination is HTTP-framing-aware: once the header block has

+520

;;; arrived, the response is considered complete as soon as the body

+521

;;; is fully received per its framing (Content-Length, the chunked

+522

;;; 0-terminator, or a body-less status/method). The reader does NOT

+523

;;; wait for the connection to close — a keep-alive or half-open peer

+524

;;; may hold it open indefinitely even after sending a complete

+525

;;; response, which previously hung the read (or, with a deadline,

+526

;;; tripped a spurious timeout on an already-delivered request).

+527

;;; Only an unframed response (no Content-Length, not chunked) falls

+528

;;; back to reading until EOF.

529

;;;

−424

;;; When `deadline` is #f (the default, no timeout) the connection

−425

;;; is blocking and an empty read means the stream is done — the

−426

;;; original behavior, unchanged. When `deadline` is set the

−427

;;; connection is non-blocking: an empty read means "no data yet",

−428

;;; so we sleep briefly and retry until data arrives, the peer

−429

;;; closes, or the deadline passes (which raises a timeout error).

−430

(define (read-all-data conn deadline)

−431

(let loop ((chunks '()))

+530

;;; When `deadline` is #f, reads block. When set, the connection is

+531

;;; non-blocking: an empty read means "no data yet", so we sleep

+532

;;; briefly and retry until the response completes, the peer closes,

+533

;;; or the deadline passes (which raises a timeout error).

+534

(define (read-all-data method conn deadline)

+535

(let loop ((chunks '()) (total 0) (framing #f))

536

(let ((chunk (conn-read-bytes conn 8192)))

537

(cond

538

((not chunk)

@@ -437,18 +541,32 @@

541

#f

542

(utf8->string (apply bytevector-append (reverse chunks)))))

543

((eof-object? chunk)

−440

;; Done

+544

;; Peer closed — done (the only terminator for until-close).

545

(utf8->string (apply bytevector-append (reverse chunks))))

546

((= (bytevector-length chunk) 0)

547

(if deadline

548

;; Non-blocking: no data yet — enforce the deadline.

549

(if (deadline-expired? deadline)

550

(begin (conn-close conn) (raise-http-timeout))

−447

(begin (sleep *read-poll-interval*) (loop chunks)))

+551

(begin (sleep *read-poll-interval*) (loop chunks total framing)))

552

;; Blocking (no timeout): no data available, done.

553

(utf8->string (apply bytevector-append (reverse chunks)))))

554

(else

−451

(loop (cons chunk chunks)))))))

+555

(let* ((chunks* (cons chunk chunks))

+556

(total* (+ total (bytevector-length chunk)))

+557

;; Combine only while detecting headers or scanning a

+558

;; chunked body; Content-Length completion is a cheap

+559

;; byte-count check needing no recombination.

+560

(need-bytes (or (not framing)

+561

(eq? (car framing) 'chunked)))

+562

(combined (and need-bytes

+563

(apply bytevector-append (reverse chunks*))))

+564

(framing* (or framing

+565

(and combined (detect-framing method combined)))))

+566

(if (and framing* (framing-complete? framing* total* combined))

+567

(utf8->string (or combined

+568

(apply bytevector-append (reverse chunks*))))

+569

(loop chunks* total* framing*))))))))

570

571

;;; Parse HTTP response from string

572

(define (parse-http-response data)

@@ -612,7 +730,7 @@

730

;; non-blocking so the read loop can enforce the deadline.

731

(conn-write conn request-str)

732

(when deadline (conn-set-non-blocking! conn))

−615

(let ((response (read-http-response conn deadline)))

+733

(let ((response (read-http-response method conn deadline)))

734

(conn-close conn)

735

response)))))

736

test/test-client.sglmodified

@@ -1,6 +1,8 @@

;;; Tests for (sigil http client) — chunked decoding and response parsing

(import (sigil test)

(sigil core)

(sigil io)

(sigil string)

(sigil time)

(sigil socket)

@@ -169,6 +171,85 @@

171

(assert-true (procedure? (dict-ref api delete:))))))

172

173

+174

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

+175

;; HTTP Response Framing (Content-Length / chunked / no-body)

+176

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

+177

;;

+178

;; The read loop must terminate as soon as the framed body is fully

+179

;; received, NOT wait for the peer to close (EOF). A keep-alive or

+180

;; half-open peer can send a complete response and then hold the

+181

;; connection open indefinitely — which previously hung the read (or,

+182

;; with a timeout, tripped a spurious deadline on an already-delivered

+183

;; request, causing duplicate retries).

+184

+185

(test-group "find-header-end-bytes"

+186

+187

(test "locates the \\r\\n\\r\\n boundary"

+188

(let* ((bv (string->utf8 "HTTP/1.1 200 OK\r\nContent-Length: 5\r\n\r\nhello"))

+189

(pos (find-header-end-bytes bv)))

+190

(assert-true (and pos (> pos 0)))

+191

;; bytes at pos must be \r \n \r \n

+192

(assert-equal (bytevector-u8-ref bv pos) 13)

+193

(assert-equal (bytevector-u8-ref bv (+ pos 1)) 10)

+194

(assert-equal (bytevector-u8-ref bv (+ pos 2)) 13)

+195

(assert-equal (bytevector-u8-ref bv (+ pos 3)) 10)))

+196

+197

(test "returns #f when headers are incomplete"

+198

(assert-false (find-header-end-bytes

+199

(string->utf8 "HTTP/1.1 200 OK\r\nContent-Len")))))

+200

+201

(test-group "no-body-expected?"

+202

(test "HEAD never has a body" (assert-true (no-body-expected? 'HEAD 200)))

+203

(test "204 No Content" (assert-true (no-body-expected? 'GET 204)))

+204

(test "304 Not Modified" (assert-true (no-body-expected? 'GET 304)))

+205

(test "1xx informational" (assert-true (no-body-expected? 'GET 100)))

+206

(test "200 GET does have a body" (assert-false (no-body-expected? 'GET 200))))

+207

+208

(test-group "detect-framing"

+209

+210

(test "Content-Length response"

+211

(let ((f (detect-framing 'GET

+212

(string->utf8 "HTTP/1.1 200 OK\r\nContent-Length: 5\r\n\r\nhel"))))

+213

(assert-equal (car f) 'length)

+214

(assert-equal (caddr f) 5)))

+215

+216

(test "chunked response"

+217

(let ((f (detect-framing 'GET

+218

(string->utf8 "HTTP/1.1 200 OK\r\nTransfer-Encoding: chunked\r\n\r\n5\r\nhello\r\n"))))

+219

(assert-equal (car f) 'chunked)))

+220

+221

(test "HEAD with Content-Length is still body-less"

+222

(let ((f (detect-framing 'HEAD

+223

(string->utf8 "HTTP/1.1 200 OK\r\nContent-Length: 100\r\n\r\n"))))

+224

(assert-equal (car f) 'no-body)))

+225

+226

(test "no Content-Length and not chunked falls back to until-close"

+227

(let ((f (detect-framing 'GET

+228

(string->utf8 "HTTP/1.1 200 OK\r\nContent-Type: text/plain\r\n\r\nhi"))))

+229

(assert-equal (car f) 'until-close)))

+230

+231

(test "incomplete headers yield #f"

+232

(assert-false (detect-framing 'GET

+233

(string->utf8 "HTTP/1.1 200 OK\r\nContent-Len")))))

+234

+235

(test-group "framing-complete?"

+236

+237

(test "length: complete when body bytes reach Content-Length"

+238

(assert-true (framing-complete? (list 'length 10 5) 15 #f)))

+239

(test "length: incomplete when short"

+240

(assert-false (framing-complete? (list 'length 10 5) 12 #f)))

+241

(test "no-body: always complete"

+242

(assert-true (framing-complete? (list 'no-body) 0 #f)))

+243

(test "until-close: never complete (relies on EOF)"

+244

(assert-false (framing-complete? (list 'until-close) 9999 #f)))

+245

+246

(test "chunked: complete with full 0-terminated stream"

+247

(let ((bv (string->utf8 "5\r\nhello\r\n0\r\n\r\n")))

+248

(assert-true (framing-complete? (list 'chunked 0) (bytevector-length bv) bv))))

+249

(test "chunked: incomplete without terminator"

+250

(let ((bv (string->utf8 "5\r\nhello\r\n")))

+251

(assert-false (framing-complete? (list 'chunked 0) (bytevector-length bv) bv)))))

+252

253

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

254

;; Read Timeout (opt-in)

255

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