[Guile-commits] 41/47: http: Accept empty reason phrases.

[Andy Wingo]

wingo pushed a commit to branch master
in repository guile.

commit f53145d41cbf6908959e230dc53cfccf38d92380
Author: Ludovic Courtès <address@hidden>
Date:   Wed Jan 6 14:56:00 2016 +0100

    http: Accept empty reason phrases.
    
    Fixes <http://bugs.gnu.org/22273>.
    Reported by Ricardo Wurmus <address@hidden>.
    
    * 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.
---
 module/web/http.scm            |   25 ++++++++++++++++++++-----
 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 5ce7e7c..f46c384 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 de2ccaa..f88f011 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"