fix: decode HTTP/1.1 chunked transfer-encoding in non-streaming POST
ober
d38fa38ca3efb780705718ec087149bb173bacfb
--- a/src/jcode/provider/provider.ss +++ b/src/jcode/provider/provider.ss @@ -286,6 +286,29 @@ (bytevector-copy! buf 0 r 0 n) r))) (loop))))))) +;; TLS I/O: decode HTTP/1.1 chunked transfer-encoding into a single string. +;; Each chunk is `<hex-size>[;ext]\r\n<chunk-bytes>\r\n`, terminated by a +;; zero-size chunk followed by optional trailers and a blank line. We honour +;; only the size and discard chunk extensions / trailers. +(def (tls-read-chunked conn) + (let ((out (open-output-string))) + (let loop () + (let* ((size-line (or (tls-read-line conn) "")) + (semi (string-index size-line #\;)) + (hex (if semi (substring size-line 0 semi) size-line)) + (size (string->number (string-trim hex) 16))) + (cond + ((or (not size) (zero? size)) + ;; Drain trailers + final CRLF + (let trailer () + (let ((l (tls-read-line conn))) + (when (and l (> (string-length l) 0)) (trailer)))) + (get-output-string out)) + (else + (put-string out (tls-read-n conn size)) + (tls-read-line conn) ;; trailing CRLF after chunk + (loop))))))) + ;; Parse HTTP status line "HTTP/1.1 200 OK" -> 200 (def (parse-http-status line) (if (and (string? line) (> (string-length line) 12)) @@ -358,9 +381,14 @@ (status (parse-http-status status-line)) (resp-headers (read-tls-headers conn)) (cl (assoc "content-length" resp-headers)) - (body (if cl - (tls-read-n conn (string->number (cdr cl))) - (tls-read-all conn)))) + (te (assoc "transfer-encoding" resp-headers)) + (chunked? (and te (string-contains + (string-downcase (cdr te)) + "chunked"))) + (body (cond + (cl (tls-read-n conn (string->number (cdr cl)))) + (chunked? (tls-read-chunked conn)) + (else (tls-read-all conn))))) (values status body))) (lambda () (jcode-tls-close conn)))) ;; Plain HTTP via tcp