mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-10 22:10:21 +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:
parent
adcd58543c
commit
9eed1010e7
2 changed files with 22 additions and 0 deletions
|
@ -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))))
|
||||||
|
|
||||||
|
|
|
@ -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")
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue