From 97d82f131afb40527340fb7126efaf50f7fe59eb Mon Sep 17 00:00:00 2001
From: Derek Upham <sand@blarg.net>
Date: Tue, 4 Jul 2017 08:54:06 -0700
Subject: [PATCH 1/2] Support HTTP/2 headers from web servers.

For example,

  curl --silent --head https://www.google.com

returns the first line

  HTTP/2 200

which does not match the MAJOR.MINOR format expected by the old code.
---
 module/web/http.scm            | 41 +++++++++++++++++++++-------------
 test-suite/tests/web-http.test | 16 +++++++++++--
 2 files changed, 40 insertions(+), 17 deletions(-)

diff --git a/module/web/http.scm b/module/web/http.scm
index de61c9495..c5e559bea 100644
--- a/module/web/http.scm
+++ b/module/web/http.scm
@@ -1059,7 +1059,11 @@ as an ordered alist."
 (define* (parse-http-version str #:optional (start 0) (end (string-length str)))
   "Parse an HTTP version from STR, returning it as a major–minor
 pair. For example, ‘HTTP/1.1’ parses as the pair of integers,
-‘(1 . 1)’."
+‘(1 . 1)’.
+
+The HTTP/2 working group has explicitly dropped the ‘.0’ minor
+version.  For internal consistency, track the the missing minor
+version as zero."
   (let lp ((known *known-versions*))
     (match known
       (((version-str . version-val) . known)
@@ -1067,28 +1071,35 @@ pair. For example, ‘HTTP/1.1’ parses as the pair of integers,
            version-val
            (lp known)))
       (()
-       (let ((dot-idx (string-index str #\. start end)))
-         (unless (and (string-prefix? "HTTP/" str 0 5 start end)
-                      dot-idx
-                      (= dot-idx (string-rindex str #\. start end)))
-           
-           (bad-header-component 'http-version (substring str start end)))
-         (cons (parse-non-negative-integer str (+ start 5) dot-idx)
-               (parse-non-negative-integer str (1+ dot-idx) end)))))))
+       (if (string=? "HTTP/2" (substring str start end))
+           '(2 . 0)
+           (let ((dot-idx (string-index str #\. start end)))
+             (unless (and (string-prefix? "HTTP/" str 0 5 start end)
+                          dot-idx
+                          (= dot-idx (string-rindex str #\. start end)))
+               (bad-header-component 'http-version (substring str start end)))
+             (cons (parse-non-negative-integer str (+ start 5) dot-idx)
+                   (parse-non-negative-integer str (1+ dot-idx) end))))))))
 
 (define (write-http-version val port)
-  "Write the given major-minor version pair to PORT."
-  (put-string port "HTTP/")
-  (put-non-negative-integer port (car val))
-  (put-char port #\.)
-  (put-non-negative-integer port (cdr val)))
+  "Write the given major-minor version pair to PORT.
+
+For consistency with HTTP/2 standards, print version ‘(2 . 0)’ as
+“HTTP/2”."
+  (if (equal? val '(2 . 0))
+      (put-string port "HTTP/2")
+      (begin
+        (put-string port "HTTP/")
+        (put-non-negative-integer port (car val))
+        (put-char port #\.)
+        (put-non-negative-integer port (cdr val)))))
 
 (for-each
  (lambda (v)
    (set! *known-versions*
          (acons v (parse-http-version v 0 (string-length v))
                 *known-versions*)))
- '("HTTP/1.0" "HTTP/1.1"))
+ '("HTTP/1.0" "HTTP/1.1" "HTTP/2"))
 
 
 ;; Request-URI = "*" | absoluteURI | abs_path | authority
diff --git a/test-suite/tests/web-http.test b/test-suite/tests/web-http.test
index 63377349c..843936bb5 100644
--- a/test-suite/tests/web-http.test
+++ b/test-suite/tests/web-http.test
@@ -170,7 +170,13 @@
                              (build-uri-reference
                               #:path "/etc/hosts"
                               #:query "foo=bar")
-                             (1 . 1)))
+                             (1 . 1))
+  (pass-if-read-request-line "HEAD /etc/hosts?foo=bar HTTP/2"
+                             HEAD
+                             (build-uri-reference
+                              #:path "/etc/hosts"
+                              #:query "foo=bar")
+                             (2 . 0)))
 
 (with-test-prefix "write-request-line"
   (pass-if-write-request-line "GET / HTTP/1.1"
@@ -201,7 +207,13 @@
                               (build-uri-reference
                                #:path "/etc/hosts"
                                #:query "foo=bar")
-                              (1 . 1)))
+                              (1 . 1))
+  (pass-if-write-request-line "HEAD /etc/hosts?foo=bar HTTP/2"
+                              HEAD
+                              (build-uri-reference
+                               #:path "/etc/hosts"
+                               #:query "foo=bar")
+                              (2 . 0)))
 
 (with-test-prefix "read-response-line"
   (pass-if-exception "missing CR/LF"
-- 
2.25.1