1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-10 05:50:26 +02:00

leniency regarding quality values in http.scm

* module/web/http.scm: Add commentary.
  (parse-quality): Allow .NNN to be interpreted as 0.NNN.

* test-suite/tests/web-http.test ("request headers"): Add a test.
This commit is contained in:
Andy Wingo 2010-12-06 13:52:56 +01:00
parent adcd58543c
commit 9eed1010e7
2 changed files with 22 additions and 0 deletions

View file

@ -17,6 +17,16 @@
;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA ;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
;; 02110-1301 USA ;; 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: ;;; Code:
(define-module (web http) (define-module (web http)
@ -316,6 +326,16 @@
(+ q (* place (char->decimal (string-ref str i)))) (+ q (* place (char->decimal (string-ref str i))))
q)))) q))))
(bad-header-component 'quality str)))) (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 (else
(bad-header-component 'quality str)))) (bad-header-component 'quality str))))

View file

@ -143,6 +143,8 @@
(0 . "*"))) (0 . "*")))
(pass-if-parse accept-language "da, en-gb;q=0.8, en;q=0.7" (pass-if-parse accept-language "da, en-gb;q=0.8, en;q=0.7"
'((1000 . "da") (800 . "en-gb") (700 . "en"))) '((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 authorization "foo" "foo")
(pass-if-parse expect "100-continue, foo" '((100-continue) ("foo"))) (pass-if-parse expect "100-continue, foo" '((100-continue) ("foo")))
(pass-if-parse from "foo@bar" "foo@bar") (pass-if-parse from "foo@bar" "foo@bar")