Add some helpers for handling request bodies

knots/web-server.scm

@@ -42,6 +42,12 @@
 
             make-chunked-output-port/knots
 
+            &request-body-ended-prematurely
+            request-body-ended-prematurely-error?
+
+            request-body-port/knots
+            read-request-body/knots
+
             default-exception-handler
             default-write-response-exception-handler
 
@@ -85,6 +91,75 @@ KEEP-ALIVE? is true."
   (setvbuf ret 'block buffering)
   ret)
 
+(define* (make-delimited-input-port port len fail
+                                    #:key (keep-alive? #t))
+  "Return an input port that reads from PORT, and makes sure that
+exactly LEN bytes are available from PORT.  Closing the returned port
+closes PORT, unless KEEP-ALIVE? is true."
+  (define bytes-read 0)
+
+  (define (read! bv start count)
+    (let ((count (min count (- len bytes-read))))
+      (let loop ((ret (get-bytevector-n! port bv start count)))
+        (cond ((eof-object? ret)
+               (if (= bytes-read len)
+                   0                              ; EOF
+                   (fail bytes-read)))
+              ((and (zero? ret) (> count 0))
+               ;; Do not return zero since zero means EOF, so try again.
+               (loop (get-bytevector-n! port bv start count)))
+              (else
+               (set! bytes-read (+ bytes-read ret))
+               ret)))))
+
+  (define close
+    (and (not keep-alive?)
+         (lambda ()
+           (close-port port))))
+
+  (make-custom-binary-input-port "delimited input port" read! #f #f close))
+
+;; Chunked Responses
+(define &request-body-ended-prematurely
+  (make-exception-type '&request-body-ended-prematurely
+                       &external-error
+                       '(bytes-read)))
+
+(define make-request-body-ended-prematurely-error
+  (record-constructor &request-body-ended-prematurely))
+
+(define request-body-ended-prematurely-error?
+  (record-predicate &request-body-ended-prematurely))
+
+(define (request-body-port/knots r)
+  (cond
+   ((member '(chunked) (request-transfer-encoding r))
+    (make-chunked-input-port (request-port r)
+                             #:keep-alive? #t))
+   (else
+    (let ((content-length
+           (request-content-length r)))
+      (make-delimited-input-port
+       (request-port r)
+       content-length
+       (lambda (bytes-read)
+         (raise-exception
+          (make-request-body-ended-prematurely-error bytes-read))))))))
+
+(define (read-request-body/knots r)
+  (cond
+   ((member '(chunked) (request-transfer-encoding r))
+    (get-bytevector-all
+     (request-body-port/knots r)))
+   (else
+    (let ((content-length
+           (request-content-length r)))
+      (if content-length
+          (get-bytevector-n
+           (request-body-port/knots r)
+           content-length)
+          #f)))))
+
 (define (extend-response r k v . additional)
   (define (extend-alist alist k v)
     (let ((pair (assq k alist)))