From d8b7dd876a7026a3c41b2f3bbd4dff90adc65115 Mon Sep 17 00:00:00 2001
From: Milo Turner <iitalics@gmail.com>
Date: Fri, 10 Apr 2020 20:03:23 -0400
Subject: [PATCH] parsing HTTP headers (body content not supported)

---
 smol-http/http-msg.rkt | 70 +++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 69 insertions(+), 1 deletion(-)

diff --git a/smol-http/http-msg.rkt b/smol-http/http-msg.rkt
index 9ced42a..155f703 100644
--- a/smol-http/http-msg.rkt
+++ b/smol-http/http-msg.rkt
@@ -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-/)))