commit f8308e48f6f3526bf6d89ae5843b5c208c41cbe7
parent efc03614ad227f8c1cba6f2280361a14bfa7ea0f
Author: James Eversole <james@eversole.co>
Date: Thu, 21 May 2026 17:09:43 -0500
Fix HTTP body framing and eliminate request over-read
Diffstat:
| M | lib/http.tri | | | 165 | +++++++++++++++++++++++++++++++++++++++++++++++++++++++------------------------ |
1 file changed, 116 insertions(+), 49 deletions(-)
diff --git a/lib/http.tri b/lib/http.tri
@@ -159,7 +159,7 @@ responseForMethod = (method resp :
-- ---------------------------------------------------------------------------
recvUntilMax_ = (y (self sock pattern maxBytes acc accLen :
- onResult_ (recv sock 4096)
+ onResult_ (recv sock 1)
(err :
pure (err 400 acc))
(chunk :
@@ -518,63 +518,130 @@ contentLength = (headers :
-- Body reading
-- ---------------------------------------------------------------------------
-consumeAvailable_ = (y (self bytes remaining acc :
- lazyList
- (_ : pair (reverse acc) (pair remaining t))
- (h r :
- lazyBool
- (_ : pair (reverse acc) (pair 0 r))
- (_ : self r (pred remaining) (pair h acc))
- (isZero? remaining))
- bytes))
+bodyReadState = (remaining accRev rest :
+ pair remaining (pair accRev rest))
+
+bodyReadRemaining = (state :
+ fst state)
-consumeAvailable = (bytes n :
- consumeAvailable_ bytes n t)
+bodyReadAccRev = (state :
+ fst (snd state))
-readBodyN_ = (y (self sock remaining acc :
+bodyReadRest = (state :
+ snd (snd state))
+
+takeBodyBytes_ = (self bytes remaining accRev :
lazyBool
- (_ : pure (ok acc t))
+ (_ : bodyReadState 0 accRev bytes)
(_ :
- onResult_ (recv sock remaining)
- (err :
- pure (err 400 acc))
- (chunk :
- ((got :
+ lazyList
+ (_ : bodyReadState remaining accRev t)
+ (h r :
+ self r (pred remaining) (pair h accRev))
+ bytes)
+ (isZero? remaining))
+
+takeBodyBytes = (bytes remaining accRev :
+ y takeBodyBytes_ bytes remaining accRev)
+
+readBodyRecv = (self sock remaining accRev recvBytes :
+ onResult_ (recv sock recvBytes)
+ (errMsg :
+ pure
+ (err
+ 400
+ (append "recv failed while reading body: " errMsg)))
+ (chunk :
+ ((state :
+ ((nextRemaining :
+ ((nextAccRev :
lazyBool
- (_ : pure (err 400 acc))
- (_ : self sock (sub remaining got) (append acc chunk))
- (equal? got 0))
- (length chunk))))
- (isZero? remaining)))
-
-readBodyN = (sock n acc :
- readBodyN_ sock n acc)
+ (_ : pure (ok (reverse nextAccRev) (bodyReadRest state)))
+ (_ : self sock nextRemaining nextAccRev)
+ (isZero? nextRemaining))
+ (bodyReadAccRev state)))
+ (bodyReadRemaining state)))
+ (takeBodyBytes chunk remaining accRev))))
+
+readBodyMore_ = (self sock remaining accRev :
+ lazyBool
+ (_ : pure (ok (reverse accRev) t))
+ (_ :
+ lazyBool
+ (_ : readBodyRecv self sock remaining accRev 4096)
+ (_ :
+ lazyBool
+ (_ : readBodyRecv self sock remaining accRev 1024)
+ (_ :
+ lazyBool
+ (_ : readBodyRecv self sock remaining accRev 256)
+ (_ :
+ lazyBool
+ (_ : readBodyRecv self sock remaining accRev 64)
+ (_ :
+ lazyBool
+ (_ : readBodyRecv self sock remaining accRev 16)
+ (_ : readBodyRecv self sock remaining accRev 1)
+ (lte? 16 remaining))
+ (lte? 64 remaining))
+ (lte? 256 remaining))
+ (lte? 1024 remaining))
+ (lte? 4096 remaining))
+ (isZero? remaining))
+
+readBodyMore = (sock remaining accRev :
+ y readBodyMore_ sock remaining accRev)
+
+readBodyExact = (sock expected initialBytes :
+ ((state :
+ ((remaining :
+ ((accRev :
+ lazyBool
+ (_ : pure (ok (reverse accRev) (bodyReadRest state)))
+ (_ : readBodyMore sock remaining accRev)
+ (isZero? remaining))
+ (bodyReadAccRev state)))
+ (bodyReadRemaining state)))
+ (takeBodyBytes initialBytes expected t)))
+
+validateBodyLength = (expected body rest :
+ ((actual :
+ lazyBool
+ (_ : pure (ok body rest))
+ (_ :
+ pure
+ (err
+ 400
+ (append
+ "body length mismatch expected="
+ (append
+ (showNumber expected)
+ (append
+ " actual="
+ (showNumber actual))))))
+ (equal? actual expected))
+ (length body)))
readBody = (sock headers initialBytes :
matchResult
(status msg :
- pure (err status "Bad Request\n"))
+ pure (err status msg))
(maybeLen rest :
lazyMaybe
(_ : pure (ok t initialBytes))
(n :
- ((consumed :
- ((body0 :
- ((remaining :
- lazyBool
- (_ : pure (ok body0 t))
- (_ :
- onOk (readBodyN sock remaining body0)
- (body rest : pure (ok body t)))
- (isZero? remaining))
- (fst (snd consumed))))
- (fst consumed)))
- (consumeAvailable initialBytes n)))
+ lazyBool
+ (_ :
+ onOk (readBodyExact sock n initialBytes)
+ (body rest :
+ validateBodyLength n body rest))
+ (_ : pure (err 400 "Request body too large\n"))
+ (lte? n maxBodyBytes))
maybeLen)
(contentLength headers))
-- ---------------------------------------------------------------------------
--- 10. Request validation
+-- Request validation
-- ---------------------------------------------------------------------------
validMethod? = (method :
@@ -629,12 +696,12 @@ respondAndClose = (sock resp :
pure (ok t t)))
handleReadableRequest = (router client method target headers rest3 :
- onResult_ (readBody client headers rest3)
- (status :
+ onResult (readBody client headers rest3)
+ (status msg :
respondAndClose client
(responseForMethod method
- (badRequestResponse "Bad Request\n")))
- (body :
+ (errorResponse status msg)))
+ (body rest :
respondAndClose client
(responseForMethod method
(router (routerMethod method) target headers body))))
@@ -680,12 +747,12 @@ httpHandler = (router client peer :
-- ---------------------------------------------------------------------------
handleReadableRequestIO = (routerIO client method target headers rest3 :
- onResult_ (readBody client headers rest3)
- (status :
+ onResult (readBody client headers rest3)
+ (status msg :
respondAndClose client
(responseForMethod method
- (badRequestResponse "Bad Request\n")))
- (body :
+ (errorResponse status msg)))
+ (body rest :
bind (routerIO (routerMethod method) target headers body) (resp :
respondAndClose client (responseForMethod method resp))))
