streams as http-body's; read chunked transfer-encoding

This commit is contained in:
Milo Turner 2020-04-10 21:14:06 -04:00
parent 9253ba26a0
commit b8431d912f
3 changed files with 52 additions and 10 deletions

View File

@ -9,10 +9,12 @@
http-body? http-body?
empty-http-body empty-http-body
write-http-body) write-http-body
in-http-body-chunks)
(require racket/match (require racket/match
racket/port racket/port
racket/stream
"./util.rkt") "./util.rkt")
(module+ test (module+ test
@ -126,17 +128,33 @@
(define (http-body? x) (define (http-body? x)
(or (eq? x #f) (or (eq? x #f)
(bytes? x))) (bytes? x)
(stream? x)))
(define empty-http-body #f) (define empty-http-body #f)
;; (write-http-body bdy [port]) -> void?
;; bdy : http-body?
;; port : output-port?
(define (write-http-body bdy [port (current-output-port)])
(match bdy
[#f (void)]
[(? bytes? bs) (write-bytes bs port)]
[(? stream? bss) (error 'write-http-body "chunked is not implemented sorry. ;(")]))
;; (in-http-body-chunks bdy) -> (streamof bytes)
;; bdy : http-body?
(define (in-http-body-chunks bdy)
(match bdy
[#f '()]
[(? bytes? bs) (list bs)]
[(? stream? bss) bss]))
(define (http-body-additional-headers bdy) (define (http-body-additional-headers bdy)
(match bdy (match bdy
[#f '()] [#f '()]
[(? bytes? bs) `([content-length . ,(bytes-length bs)])])) [(? bytes? bs) `([content-length . ,(bytes-length bs)])]
[(? stream?) '([transfer-encoding . #"chunked"])]))
(define (write-http-body bdy [port (current-output-port)])
(when bdy (write-bytes bdy port)))
;; --------------------------------------------------------------------------------------- ;; ---------------------------------------------------------------------------------------
;; Parsing ;; Parsing
@ -189,15 +207,21 @@
;; tenc, clen : (or/c #f bytes?) ;; tenc, clen : (or/c #f bytes?)
;; port : input-port? ;; port : input-port?
(define (read-http-body tenc clen [port (current-input-port)]) (define (read-http-body tenc clen [port (current-input-port)])
(define len (and clen (string->number (bytes->string/utf-8 clen)))) (define len (and clen (string->int (bytes->string/utf-8 clen))))
(cond (cond
[(equal? tenc #"chunked") (read-chunked-stream port)] [(equal? tenc #"chunked") (read-chunked-stream port)]
[(number? len) (read-bytes len port)] [(number? len) (read-bytes len port)]
[(and (not tenc) (not len)) #f] [(and (not tenc) (not len)) #f]
[else (raise-read-http-error "read-http-body: not sure how to read HTTP body")])) [else (raise-read-http-error "read-http-body: not sure how to read HTTP body")]))
;; input-port? -> [streamof bytes?]
(define (read-chunked-stream port) (define (read-chunked-stream port)
('...)) (define len (string->number (read-crlf-line port)))
(define data (read-bytes len port))
(match-define #"\r\n" (read-bytes 2 port))
(if (zero? len)
empty-stream
(stream-cons data (read-chunked-stream port))))
;; ========================================== ;; ==========================================
@ -221,6 +245,17 @@
[content-length . 5])) [content-length . 5]))
#"hello")) #"hello"))
(let* ([p (open-input-bytes (bytes-append #"HTTP/1.1 200 OK\r\n"
#"Transfer-Encoding: chunked\r\n"
#"\r\n"
#"5\r\nhello\r\n"
#"2\r\n, \r\n"
#"6\r\nworld!\r\n"
#"0\r\n\r\n"))]
[msg (read-http-msg p)])
(check-equal? (for/list ([bs (in-http-body-chunks (http-msg-body msg))]) bs)
'(#"hello" #", " #"world!")))
;; "write --> read" works ;; "write --> read" works
(let-values ([(in out) (make-pipe)]) (let-values ([(in out) (make-pipe)])
(thread (λ () (write-http-msg ex-req-/ out))) (thread (λ () (write-http-msg ex-req-/ out)))

View File

@ -2,6 +2,8 @@
(require "./util.rkt" (require "./util.rkt"
"./http-msg.rkt") "./http-msg.rkt")
(provide (all-from-out "./http-msg.rkt") (provide (all-from-out "./http-msg.rkt")
(except-out (all-from-out "./util.rkt") ->bytes)) http-request-method?
http-response-code?
http-response-code-name)
(module+ test) (module+ test)

View File

@ -2,7 +2,8 @@
(provide http-request-method? (provide http-request-method?
http-response-code? http-response-code?
http-response-code-name http-response-code-name
->bytes) ->bytes
string->int)
(module+ test (require rackunit)) (module+ test (require rackunit))
@ -33,6 +34,10 @@
x x
(string->bytes/utf-8 (format "~a" x)))) (string->bytes/utf-8 (format "~a" x))))
(define (string->int s)
(define n (string->number s))
(and (exact-integer? n) n))
(module+ test (module+ test
(let ([b #"hello"]) (check-eq? (->bytes b) b)) (let ([b #"hello"]) (check-eq? (->bytes b) b))
(check-equal? (->bytes 5) #"5")) (check-equal? (->bytes 5) #"5"))