From b589595db9ab448aa52d002c34d7919a601904e4 Mon Sep 17 00:00:00 2001 From: Alexey Abramov Date: Thu, 7 Oct 2021 13:45:02 +0200 Subject: [PATCH] http: Tolerate http response line without a reason phrase * module/web/http.scm (read-response-line): Use the end of the string, in case a line doesn't have char-set:whitespace at the end. * test-suite/tests/web-http.test ("read-response-line"): Add tests. * .dir-locals.el (scheme-mode): Add indentation rule for pass-if-named-exception. --- .dir-locals.el | 1 + module/web/http.scm | 20 +++++++++++++------- test-suite/tests/web-http.test | 8 +++++++- 3 files changed, 21 insertions(+), 8 deletions(-) diff --git a/.dir-locals.el b/.dir-locals.el index 90257e7bf..e94ceb723 100644 --- a/.dir-locals.el +++ b/.dir-locals.el @@ -10,6 +10,7 @@ (eval . (put 'let/ec 'scheme-indent-function 1)) (eval . (put 'pass-if 'scheme-indent-function 1)) (eval . (put 'pass-if-exception 'scheme-indent-function 2)) + (eval . (put 'pass-if-named-exception 'scheme-indent-function 3)) (eval . (put 'pass-if-equal 'scheme-indent-function 2)) (eval . (put 'with-test-prefix 'scheme-indent-function 1)) (eval . (put 'with-test-prefix/c&e 'scheme-indent-function 1)) diff --git a/module/web/http.scm b/module/web/http.scm index 4276e1744..4053e5271 100644 --- a/module/web/http.scm +++ b/module/web/http.scm @@ -1187,14 +1187,20 @@ values: the HTTP version, the response code, and the (possibly empty) \"reason phrase\"." (let* ((line (read-header-line port)) (d0 (string-index line char-set:whitespace)) ; "delimiter zero" - (d1 (and d0 (string-index line char-set:whitespace - (skip-whitespace line d0))))) - (unless (and d0 d1) + (d1 (and d0 (or (string-index line char-set:whitespace + (skip-whitespace line d0)) + ;; tolerate responses with empty "reason phrase" + (string-length line))))) + (cond + ((not d0) + (bad-response "Bad Response-Line: ~s" line)) + ((and d0 d1 (string-null? (string-trim (substring line d0 d1)))) (bad-response "Bad Response-Line: ~s" line)) - (values (parse-http-version line 0 d0) - (parse-non-negative-integer line (skip-whitespace line d0 d1) - d1) - (string-trim-both line char-set:whitespace d1)))) + (else + (values (parse-http-version line 0 d0) + (parse-non-negative-integer line (skip-whitespace line d0 d1) + d1) + (string-trim-both line char-set:whitespace d1)))))) (define (write-response-line version code reason-phrase port) "Write the first line of an HTTP response to PORT." diff --git a/test-suite/tests/web-http.test b/test-suite/tests/web-http.test index 63377349c..7d4885722 100644 --- a/test-suite/tests/web-http.test +++ b/test-suite/tests/web-http.test @@ -216,7 +216,13 @@ ;; Empty reason phrases are valid; see . (pass-if-read-response-line "HTTP/1.1 302 " - (1 . 1) 302 "")) + (1 . 1) 302 "") + (pass-if-read-response-line "HTTP/1.1 302" + (1 . 1) 302 "") + (pass-if-named-exception "missing HTTP code" bad-response "Bad Response-Line" + (call-with-input-string "HTTP/1.1 \n" + (lambda (port) + (read-response-line port))))) (with-test-prefix "write-response-line" (pass-if-write-response-line "HTTP/1.0 404 Not Found" -- 2.31.1