Companies like Google now respond to HTTP requests with HTTP 2.
For example:
curl --silent --head https://www.google.com
returns the first line
HTTP/2 200
The Guile HTTP client code expects a “HTTP/x.y” structure, and
treats this as an error. This patch recognizes and handles
“HTTP/2” on input and output. HTTP version numbers don’t
proliferate quickly, so the code uses a brute force approach for
now.
>From 97d82f131afb40527340fb7126efaf50f7fe59eb Mon Sep 17 00:00:00 2001
From: Derek Upham <s...@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
Derek
--
Derek Upham
derek_up...@mailfence.com
