Make HTTP request bodies byte-safe
ober
b4793ed518a898646963a4bc36b79981efeb32ec
--- a/lib/std/net/request.ss +++ b/lib/std/net/request.ss @@ -82,8 +82,12 @@ (defstruct http-response (status-code header-alist body closed?)) (def (request-status resp) (http-response-status-code resp)) - (def (request-text resp) (http-response-body resp)) - (def (request-content resp) (http-response-body resp)) + (def (request-text resp) + (let ([body (http-response-body resp)]) + (if (bytevector? body) (utf8->string body) body))) + (def (request-content resp) + (let ([body (http-response-body resp)]) + (if (bytevector? body) body (string->utf8 (or body ""))))) (def (request-headers resp) (http-response-header-alist resp)) (def (request-header resp name) (let ([pair (assoc (string-downcase name) (http-response-header-alist resp))]) @@ -124,7 +128,9 @@ (def (http-request method url headers-or-kwargs data-or-rest . rest) (let* ([headers (if (list? headers-or-kwargs) headers-or-kwargs '())] - [data (if (string? data-or-rest) data-or-rest #f)] + [data (if (or (string? data-or-rest) (bytevector? data-or-rest)) + data-or-rest + #f)] [parsed (parse-url url)] [scheme (url-parts-scheme parsed)] [host (url-parts-host parsed)] @@ -137,19 +143,42 @@ ;; ========== HTTP (plain TCP) ========== (def (http-request-http method host port path headers data) - (let-values ([(in out) (tcp-connect host port)]) + (let-values ([(in out) (tcp-connect-binary host port)]) (dynamic-wind (lambda () (void)) (lambda () - (send-http-request out method host path headers data) - (let* ([status-code (parse-status-code (read-line-crlf in))] - [resp-headers (read-headers in)] - [body (read-body in resp-headers)]) + (send-http-request/bytes out method host path headers data) + (let* ([status-code (parse-status-code (read-line-crlf/bytes in))] + [resp-headers (read-headers/bytes in)] + [body (read-body/bytes in resp-headers)]) (make-http-response status-code resp-headers body #f))) (lambda () (close-port in) (close-port out))))) + (def (send-http-request/bytes out method host path headers data) + (validate-no-crlf! path 'http-request "path") + (validate-no-crlf! host 'http-request "host") + (let* ([body-bv (and data (body->bytevector data))] + [hdrs (open-output-string)]) + (put-string hdrs (string-append method " " path " HTTP/1.1\r\n")) + (put-string hdrs (string-append "Host: " host "\r\n")) + (put-string hdrs "Connection: close\r\n") + (for-each (lambda (h) + (validate-no-crlf! (car h) 'http-request "header name") + (validate-no-crlf! (cdr h) 'http-request "header value") + (put-string hdrs (string-append (car h) ": " (cdr h) "\r\n"))) + headers) + (when body-bv + (put-string hdrs + (string-append "Content-Length: " + (number->string (bytevector-length body-bv)) + "\r\n"))) + (put-string hdrs "\r\n") + (put-bytevector out (string->utf8 (get-output-string hdrs))) + (when body-bv (put-bytevector out body-bv)) + (flush-output-port out))) + (def (send-http-request out method host path headers data) (validate-no-crlf! path 'http-request "path") (validate-no-crlf! host 'http-request "host") @@ -178,11 +207,10 @@ (set! handle (rustls-connect host port)) (send-https-request handle method host path headers data) (let* ([resp-bv (rustls-read-until-eof handle)] - [resp-str (utf8->string resp-bv)] - [resp-port (open-input-string resp-str)] - [status (parse-status-code (read-line-crlf resp-port))] - [resp-hdrs (read-headers resp-port)] - [body (read-body resp-port resp-hdrs)]) + [resp-port (open-bytevector-input-port resp-bv)] + [status (parse-status-code (read-line-crlf/bytes resp-port))] + [resp-hdrs (read-headers/bytes resp-port)] + [body (read-body/bytes resp-port resp-hdrs)]) (make-http-response status resp-hdrs body #f))) (lambda () (when handle @@ -192,7 +220,8 @@ (def (send-https-request handle method host path headers data) (validate-no-crlf! path 'https-request "path") (validate-no-crlf! host 'https-request "host") - (let ([out (open-output-string)]) + (let ([out (open-output-string)] + [body-bv (and data (body->bytevector data))]) (put-string out (string-append method " " path " HTTP/1.1\r\n")) (put-string out (string-append "Host: " host "\r\n")) (put-string out "Connection: close\r\n") @@ -201,17 +230,15 @@ (validate-no-crlf! (cdr h) 'https-request "header value") (put-string out (string-append (car h) ": " (cdr h) "\r\n"))) headers) - (when data - (let ([byte-len (bytevector-length (string->utf8 data))]) + (when body-bv + (let ([byte-len (bytevector-length body-bv)]) (put-string out (string-append "Content-Length: " (number->string byte-len) "\r\n")))) (put-string out "\r\n") ;; Flush headers (let ([hdrs-bv (string->utf8 (get-output-string out))]) (rustls-write handle hdrs-bv (bytevector-length hdrs-bv))) - ;; Send body separately (avoids double UTF-8 encode for Content-Length calc) - (when data - (let ([body-bv (string->utf8 data)]) - (rustls-write handle body-bv (bytevector-length body-bv)))))) + (when body-bv + (rustls-write handle body-bv (bytevector-length body-bv))))) (def (rustls-read-until-eof handle) (let ([buf (make-bytevector 32768)]) @@ -234,6 +261,12 @@ (bytevector-copy! bv 0 result offset len) (loop (+ offset len) (cdr bvs))))))) + (def (body->bytevector data) + (cond + [(bytevector? data) data] + [(string? data) (string->utf8 data)] + [else (string->utf8 (format "~a" data))])) + ;; ========== Response Parsing ========== (def (parse-status-code line) @@ -335,6 +368,105 @@ (read-line-crlf port) (loop)]))))) + (def (read-line-crlf/bytes port) + (let-values ([(out get-bv) (open-bytevector-output-port)]) + (let ([max-len (*http-max-line-length*)]) + (let loop ([len 0]) + (when (> len max-len) + (error 'http-request "HTTP line too long" len)) + (let ([b (get-u8 port)]) + (cond + [(eof-object? b) (utf8->string (get-bv))] + [(= b 13) + (let ([next (get-u8 port)]) + (if (and (integer? next) (= next 10)) + (utf8->string (get-bv)) + (begin + (put-u8 out b) + (unless (eof-object? next) (put-u8 out next)) + (loop (+ len 2)))))] + [else (put-u8 out b) (loop (+ len 1))])))))) + + (def (read-headers/bytes port) + (let ([max-count (*http-max-header-count*)] + [max-size (*http-max-header-size*)]) + (let loop ([headers '()] [count 0]) + (when (> count max-count) + (error 'http-request "too many response headers" count)) + (let ([line (read-line-crlf/bytes port)]) + (when (and (string? line) (> (string-length line) max-size)) + (error 'http-request "response header too long" (string-length line))) + (if (or (equal? line "") (eof-object? line)) + (reverse headers) + (let ([colon-pos (string-find line #\:)]) + (if colon-pos + (let ([key (string-downcase (substring line 0 colon-pos))] + [val (string-trim-left + (substring line (+ colon-pos 1) (string-length line)))]) + (loop (cons (cons key val) headers) (+ count 1))) + (loop headers count)))))))) + + (def (read-body/bytes port headers) + (let* ([max-body (*http-max-body-size*)] + [cl (assoc "content-length" headers)] + [chunked? (let ([te (assoc "transfer-encoding" headers)]) + (and te (string-contains (string-downcase (cdr te)) "chunked")))]) + (cond + [chunked? + (read-chunked-body/bytes port max-body)] + [cl + (let ([len (string->number (cdr cl))]) + (cond + [(not len) #vu8()] + [(<= len 0) #vu8()] + [(> len max-body) + (error 'http-request "Content-Length exceeds max body size" len max-body)] + [else (read-exact-bytevector port len)]))] + [else + (let loop ([total 0] [chunks '()]) + (when (> total max-body) + (error 'http-request "body exceeds max size" max-body)) + (let ([chunk (get-bytevector-n port 32768)]) + (if (or (eof-object? chunk) (= (bytevector-length chunk) 0)) + (bytevector-concat (reverse chunks)) + (loop (+ total (bytevector-length chunk)) (cons chunk chunks)))))]))) + + (def (read-exact-bytevector port len) + (let ([out (make-bytevector len 0)]) + (let loop ([offset 0]) + (if (= offset len) + out + (let ([chunk (get-bytevector-n port (- len offset))]) + (when (eof-object? chunk) + (error 'http-request "unexpected EOF while reading body" len offset)) + (let ([n (bytevector-length chunk)]) + (bytevector-copy! chunk 0 out offset n) + (loop (+ offset n)))))))) + + (def (read-chunked-body/bytes port max-body) + (let loop ([chunks '()] [total 0]) + (let* ([size-line (read-line-crlf/bytes port)] + [semi-pos (string-find size-line #\;)] + [hex-str (if semi-pos + (substring size-line 0 semi-pos) + size-line)] + [chunk-len (string->number (string-trim hex-str) 16)]) + (cond + [(not chunk-len) #vu8()] + [(= chunk-len 0) + ;; Consume trailer headers until the terminating empty line. + (let trailer-loop () + (let ([line (read-line-crlf/bytes port)]) + (unless (or (eof-object? line) (string=? line "")) + (trailer-loop)))) + (bytevector-concat (reverse chunks))] + [else + (when (> (+ total chunk-len) max-body) + (error 'http-request "chunked body exceeds max size" max-body)) + (let ([chunk (read-exact-bytevector port chunk-len)]) + (read-line-crlf/bytes port) + (loop (cons chunk chunks) (+ total chunk-len)))])))) + ;; ========== Helpers ========== (def (validate-no-crlf! s who field)