* 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 test. --- module/web/http.scm | 6 ++++-- test-suite/tests/web-http.test | 2 ++ 2 files changed, 6 insertions(+), 2 deletions(-)
diff --git a/module/web/http.scm b/module/web/http.scm index 4276e1744..7443bd6a4 100644 --- a/module/web/http.scm +++ b/module/web/http.scm @@ -1187,8 +1187,10 @@ 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))))) + (d1 (and d0 (or (string-index line char-set:whitespace + (skip-whitespace line d0)) + ;; tolerate responses with empty "reason phrase" + (string-length line))))) (unless (and d0 d1) (bad-response "Bad Response-Line: ~s" line)) (values (parse-http-version line 0 d0) diff --git a/test-suite/tests/web-http.test b/test-suite/tests/web-http.test index 63377349c..6d8cd1642 100644 --- a/test-suite/tests/web-http.test +++ b/test-suite/tests/web-http.test @@ -216,6 +216,8 @@ ;; Empty reason phrases are valid; see <http://bugs.gnu.org/22273>. (pass-if-read-response-line "HTTP/1.1 302 " + (1 . 1) 302 "") + (pass-if-read-response-line "HTTP/1.1 302" (1 . 1) 302 "")) (with-test-prefix "write-response-line" -- 2.31.1