streams as http-body's; read chunked transfer-encoding
This commit is contained in:
parent
9253ba26a0
commit
b8431d912f
|
@ -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)))
|
||||||
|
|
|
@ -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)
|
||||||
|
|
|
@ -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"))
|
||||||
|
|
Loading…
Reference in New Issue