diff options
-rw-r--r-- | module/web/http.scm | 20 | ||||
-rw-r--r-- | test-suite/tests/web-http.test | 2 |
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") |