parsing HTTP headers (body content not supported)
This commit is contained in:
parent
2921a80b83
commit
d8b7dd876a
|
@ -12,10 +12,11 @@
|
|||
write-http-body)
|
||||
|
||||
(require racket/match
|
||||
racket/port
|
||||
"./util.rkt")
|
||||
|
||||
(module+ test
|
||||
(require rackunit racket/port))
|
||||
(require rackunit))
|
||||
|
||||
;; ---------------------------------------------------------------------------------------
|
||||
;; HTTP messages
|
||||
|
@ -136,3 +137,70 @@
|
|||
|
||||
(define (write-http-body bdy [port (current-output-port)])
|
||||
(when bdy (write-bytes bdy port)))
|
||||
|
||||
;; ---------------------------------------------------------------------------------------
|
||||
;; Parsing
|
||||
|
||||
(struct exn:fail:read-http exn:fail [] #:transparent)
|
||||
|
||||
(define (raise-read-http-error . fmt)
|
||||
(raise (exn:fail:read-http (string-append "read-http-msg: " (apply format fmt))
|
||||
(current-continuation-marks))))
|
||||
|
||||
(define (string->start-line s)
|
||||
(match (regexp-match #px"^(HTTP/1\\.1 (\\d+) .*)|(([A-Z]+) ([^ ]+) HTTP/1\\.1)$" s)
|
||||
[(list _ _ code #f #f #f)
|
||||
(http-start-line:res (string->number code))]
|
||||
[(list _ #f #f _ method path)
|
||||
(http-start-line:req (string->symbol method) (build-path path))]
|
||||
[_ #f]))
|
||||
|
||||
(define (string->header-kv s)
|
||||
(match (regexp-match #px"^([^:]+):\\s*(.*)$" s)
|
||||
[(list _ k v) (cons (string->symbol (string-downcase k))
|
||||
(->bytes v))]
|
||||
[_ #f]))
|
||||
|
||||
(define (read-crlf-line port)
|
||||
(match (regexp-match #px"^([^\r]*)\r\n" port)
|
||||
[(list _ line) (bytes->string/utf-8 line)]
|
||||
[_ (port->string port)]))
|
||||
|
||||
;; (read-http-msg [port]) -> http-msg?
|
||||
;; port : input-port?
|
||||
(define (read-http-msg [port (current-input-port)])
|
||||
(define sln/str
|
||||
(read-crlf-line port))
|
||||
(define sln
|
||||
(or (string->start-line sln/str)
|
||||
(raise-read-http-error "invalid start line: ~s" sln/str)))
|
||||
(define hdrs
|
||||
(for/list ([hln (in-port read-crlf-line port)])
|
||||
#:break (string=? hln "")
|
||||
(or (string->header-kv hln)
|
||||
(raise-read-http-error "read-http-msg: invalid header line: ~s" hln))))
|
||||
;; TODO: response body; the reader should be determined by the headers
|
||||
(make-msg sln hdrs))
|
||||
|
||||
;; ==========================================
|
||||
|
||||
(module+ test
|
||||
(define-syntax-rule (check-bytes->http-msg bs ... msg-expr)
|
||||
(let ([p (open-input-bytes (bytes-append bs ...))])
|
||||
(check-equal? (read-http-msg p) msg-expr)
|
||||
(check-eq? (read-char p) eof)))
|
||||
|
||||
(check-bytes->http-msg #"GET /foo?a=z HTTP/1.1\r\n"
|
||||
#"host: foobar\r\n"
|
||||
#"\r\n"
|
||||
(make-http-req 'GET "/foo?a=z" '([host . "foobar"])))
|
||||
|
||||
(check-bytes->http-msg #"HTTP/1.1 200 OK\r\n"
|
||||
#"Content-Type: text/html\r\n"
|
||||
#"\r\n"
|
||||
(make-http-res 200 '([content-type . "text/html"])))
|
||||
|
||||
;; "write --> read" works
|
||||
(let-values ([(in out) (make-pipe)])
|
||||
(thread (λ () (write-http-msg ex-req-/ out)))
|
||||
(check-equal? (read-http-msg in) ex-req-/)))
|
||||
|
|
Loading…
Reference in New Issue