From 8597c3eda5163824612e8f1ff079dc647eb5424c Mon Sep 17 00:00:00 2001
From: Alex Shinn <alexshinn@gmail.com>
Date: Wed, 2 Sep 2020 11:53:49 +0900
Subject: [PATCH] better error handling in http-server request parsing

---
 lib/chibi/net/http-server.scm | 30 +++++++++++++++++++++---------
 lib/chibi/net/http-server.sld | 13 +++++++------
 lib/chibi/net/servlet.sld     |  2 +-
 3 files changed, 29 insertions(+), 16 deletions(-)

diff --git a/lib/chibi/net/http-server.scm b/lib/chibi/net/http-server.scm
index 7563f80e..e1fa01d3 100644
--- a/lib/chibi/net/http-server.scm
+++ b/lib/chibi/net/http-server.scm
@@ -40,16 +40,28 @@
         (cond
          ((= 2 (length ls))
           (let ((request
-                 (make-request command (car ls) (cadr ls) in out sock addr)))
-            (log-info `(request: ,command ,(car ls) ,(cadr ls)
-                                 ,(request-headers request)))
-            (protect (exn
+                 (protect
+                     (exn
                       (else
-                       (log-error "internal error: " exn)
-                       (print-stack-trace exn)
-                       (servlet-respond request 500 "Internal server error")))
-              (let restart ((request request))
-                (servlet cfg request servlet-bad-request restart)))))
+                       ;; error parsing headers, can't use servlet-respond
+                       (log-error "request error: " exn ls
+                                  (sockaddr-name (address-info-address addr)))
+                       (servlet-write-status out 500 "Internal server error")
+                       (mime-write-headers `((Status . "500")) out)
+                       (display "\r\n" out)
+                       #f))
+                   (make-request command (car ls) (cadr ls) in out sock addr))))
+            (cond
+             (request
+              (log-info `(request: ,command ,(car ls) ,(cadr ls)
+                                   ,(request-headers request)))
+              (protect (exn
+                        (else
+                         (log-error "internal error: " exn)
+                         (print-stack-trace exn)
+                         (servlet-respond request 500 "Internal server error")))
+                (let restart ((request request))
+                  (servlet cfg request servlet-bad-request restart)))))))
          (else
           (let ((request (make-request command #f #f in out sock addr)))
             (servlet-respond request 400 "bad request")))))))))
diff --git a/lib/chibi/net/http-server.sld b/lib/chibi/net/http-server.sld
index 053e2687..360611d6 100644
--- a/lib/chibi/net/http-server.sld
+++ b/lib/chibi/net/http-server.sld
@@ -9,10 +9,11 @@
    http-regexp-servlet http-path-regexp-servlet http-uri-regexp-servlet
    http-host-regexp-servlet http-redirect-servlet http-rewrite-servlet
    http-cgi-bin-dir-servlet http-scheme-script-dir-servlet)
-  (import (scheme time) (srfi 39) (srfi 95)
-          (chibi) (chibi mime) (chibi regexp) (chibi pathname) (chibi uri)
-          (chibi filesystem) (chibi io) (chibi string) (chibi process)
-          (chibi net server) (chibi net server-util) (chibi net servlet)
-          (chibi app) (chibi ast) (chibi config) (chibi log) (chibi memoize)
-          (chibi temp-file))
+  (import
+   (scheme time) (srfi 39) (srfi 95)
+   (chibi) (chibi mime) (chibi regexp) (chibi pathname) (chibi uri)
+   (chibi filesystem) (chibi io) (chibi string) (chibi process)
+   (chibi net) (chibi net server) (chibi net server-util) (chibi net servlet)
+   (chibi app) (chibi ast) (chibi config) (chibi log) (chibi memoize)
+   (chibi temp-file))
   (include "http-server.scm"))
diff --git a/lib/chibi/net/servlet.sld b/lib/chibi/net/servlet.sld
index 75cb44e0..db012bad 100644
--- a/lib/chibi/net/servlet.sld
+++ b/lib/chibi/net/servlet.sld
@@ -17,7 +17,7 @@
    request-uri-string request-with-uri request-path
    copy-request make-request make-cgi-request
    ;; servlets
-   servlet-write servlet-respond servlet-parse-body!
+   servlet-write servlet-write-status servlet-respond servlet-parse-body!
    make-status-servlet servlet-handler servlet-run
    servlet-bad-request)
   (import