diff options
author | Ludovic Courtès <ludo@gnu.org> | 2016-01-06 14:56:00 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2016-05-22 20:02:37 +0200 |
commit | f53145d41cbf6908959e230dc53cfccf38d92380 (patch) | |
tree | 3bcc9dc41debd3d8a4339da712679345731df210 | |
parent | 3829047ec78d8001bf559fd0fb8ceae100f77e8f (diff) | |
download | guile-f53145d41cbf6908959e230dc53cfccf38d92380.tar.gz |
http: Accept empty reason phrases.
Fixes <http://bugs.gnu.org/22273>.
Reported by Ricardo Wurmus <ricardo.wurmus@mdc-berlin.de>.
* module/web/http.scm (read-header-line): New procedure.
(read-response-line): Use it instead of 'read-line*'.
* test-suite/tests/web-http.test ("read-response-line"): Add test.
-rw-r--r-- | module/web/http.scm | 25 | ||||
-rw-r--r-- | test-suite/tests/web-http.test | 6 |
2 files changed, 25 insertions, 6 deletions
diff --git a/module/web/http.scm b/module/web/http.scm index 5ce7e7c67..f46c384ce 100644 --- a/module/web/http.scm +++ b/module/web/http.scm @@ -144,7 +144,22 @@ The default writer is ‘display’." (header-decl-writer decl) display))) -(define (read-line* port) +(define (read-header-line port) + "Read an HTTP header line and return it without its final CRLF or LF. +Raise a 'bad-header' exception if the line does not end in CRLF or LF, +or if EOF is reached." + (match (%read-line port) + (((? string? line) . #\newline) + ;; '%read-line' does not consider #\return a delimiter; so if it's + ;; there, remove it. We are more tolerant than the RFC in that we + ;; tolerate LF-only endings. + (if (string-suffix? "\r" line) + (string-drop-right line 1) + line)) + ((line . _) ;EOF or missing delimiter + (bad-header 'read-header-line line)))) + +(define* (read-line* port) (let* ((pair (%read-line port)) (line (car pair)) (delim (cdr pair))) @@ -1155,10 +1170,10 @@ three values: the method, the URI, and the version." (display "\r\n" port)) (define (read-response-line port) - "Read the first line of an HTTP response from PORT, returning -three values: the HTTP version, the response code, and the \"reason -phrase\"." - (let* ((line (read-line* port)) + "Read the first line of an HTTP response from PORT, returning three +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))))) diff --git a/test-suite/tests/web-http.test b/test-suite/tests/web-http.test index de2ccaa5b..f88f011a6 100644 --- a/test-suite/tests/web-http.test +++ b/test-suite/tests/web-http.test @@ -194,7 +194,11 @@ (pass-if-read-response-line "HTTP/1.0 404 Not Found" (1 . 0) 404 "Not Found") (pass-if-read-response-line "HTTP/1.1 200 OK" - (1 . 1) 200 "OK")) + (1 . 1) 200 "OK") + + ;; Empty reason phrases are valid; see <http://bugs.gnu.org/22273>. + (pass-if-read-response-line "HTTP/1.1 302 " + (1 . 1) 302 "")) (with-test-prefix "write-response-line" (pass-if-write-response-line "HTTP/1.0 404 Not Found" |