summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--module/web/http.scm20
-rw-r--r--test-suite/tests/web-http.test2
2 files changed, 22 insertions, 0 deletions
diff --git a/module/web/http.scm b/module/web/http.scm
index bf54b239b..6416b1bc6 100644
--- a/module/web/http.scm
+++ b/module/web/http.scm
@@ -17,6 +17,16 @@
;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
;; 02110-1301 USA
+;;; Commentary:
+;;;
+;;; This module has a number of routines to parse textual
+;;; representations of HTTP data into native Scheme data structures.
+;;;
+;;; It tries to follow RFCs fairly strictly---the road to perdition
+;;; being paved with compatibility hacks---though some allowances are
+;;; made for not-too-divergent texts (like a quality of .2 which should
+;;; be 0.2, etc).
+;;;
;;; Code:
(define-module (web http)
@@ -316,6 +326,16 @@
(+ q (* place (char->decimal (string-ref str i))))
q))))
(bad-header-component 'quality str))))
+ ;; Allow the nonstandard .2 instead of 0.2.
+ ((and (eqv? (string-ref str start) #\.)
+ (< 1 (- end start) 5))
+ (let lp ((place 1) (i (+ start 3)) (q 0))
+ (if (= i start)
+ q
+ (lp (* 10 place) (1- i)
+ (if (< i end)
+ (+ q (* place (char->decimal (string-ref str i))))
+ q)))))
(else
(bad-header-component 'quality str))))
diff --git a/test-suite/tests/web-http.test b/test-suite/tests/web-http.test
index 5085668fe..4d1fe6cdc 100644
--- a/test-suite/tests/web-http.test
+++ b/test-suite/tests/web-http.test
@@ -143,6 +143,8 @@
(0 . "*")))
(pass-if-parse accept-language "da, en-gb;q=0.8, en;q=0.7"
'((1000 . "da") (800 . "en-gb") (700 . "en")))
+ ;; Allow nonstandard .2 to mean 0.2
+ (pass-if-parse accept-language "en-gb;q=.2" '((200 . "en-gb")))
(pass-if-parse authorization "foo" "foo")
(pass-if-parse expect "100-continue, foo" '((100-continue) ("foo")))
(pass-if-parse from "foo@bar" "foo@bar")