mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-10 14:00:21 +02:00
fix validators for various list-style headers
* module/web/http.scm (default-val-validator): Valid with no value. (key-value-list?): Keys are always symbols, do not accept strings. (validate-param-list): Apply `valid?' to list elements. (validate-credentials): Validate param for Basic scheme, which is parsed as a string. (declare-symbol-list-header!): `list-of?' args were in wrong order. ("Cache-Control"): Replace `default-val-validator' with more specific procedure. ("Accept"): Validate on first param which has no value.
This commit is contained in:
parent
2db1dbfe27
commit
69b8c5df14
1 changed files with 18 additions and 8 deletions
|
@ -470,7 +470,7 @@ ordered alist."
|
|||
val)
|
||||
|
||||
(define (default-val-validator k val)
|
||||
(string? val))
|
||||
(or (not val) (string? val)))
|
||||
|
||||
(define (default-val-writer k val port)
|
||||
(if (or (string-index val #\;)
|
||||
|
@ -518,9 +518,9 @@ ordered alist."
|
|||
((pair? elt)
|
||||
(let ((k (car elt))
|
||||
(v (cdr elt)))
|
||||
(and (or (string? k) (symbol? k))
|
||||
(and (symbol? k)
|
||||
(valid? k v))))
|
||||
((or (string? elt) (symbol? elt))
|
||||
((symbol? elt)
|
||||
(valid? elt #f))
|
||||
(else #f)))))
|
||||
|
||||
|
@ -611,7 +611,7 @@ ordered alist."
|
|||
(valid? default-val-validator))
|
||||
(list-of? list
|
||||
(lambda (elt)
|
||||
(key-value-list? list valid?))))
|
||||
(key-value-list? elt valid?))))
|
||||
|
||||
(define* (write-param-list list port #:optional
|
||||
(val-writer default-val-writer))
|
||||
|
@ -871,7 +871,10 @@ ordered alist."
|
|||
(cons scheme (parse-key-value-list str default-val-parser delim end)))))))
|
||||
|
||||
(define (validate-credentials val)
|
||||
(and (pair? val) (symbol? (car val)) (key-value-list? (cdr val))))
|
||||
(and (pair? val) (symbol? (car val))
|
||||
(case (car val)
|
||||
((basic) (string? (cdr val)))
|
||||
(else (key-value-list? (cdr val))))))
|
||||
|
||||
(define (write-credentials val port)
|
||||
(display (car val) port)
|
||||
|
@ -1137,7 +1140,7 @@ phrase\"."
|
|||
(lambda (str)
|
||||
(map string->symbol (split-and-trim str)))
|
||||
(lambda (v)
|
||||
(list-of? symbol? v))
|
||||
(list-of? v symbol?))
|
||||
(lambda (v port)
|
||||
(write-list v port display ", "))))
|
||||
|
||||
|
@ -1242,7 +1245,14 @@ phrase\"."
|
|||
((private no-cache)
|
||||
(and v-str (split-header-names v-str)))
|
||||
(else v-str)))
|
||||
default-val-validator
|
||||
(lambda (k v)
|
||||
(case k
|
||||
((max-age max-stale min-fresh s-maxage)
|
||||
(non-negative-integer? v))
|
||||
((private no-cache)
|
||||
(or (not v) (list-of-header-names? v)))
|
||||
(else
|
||||
(not v))))
|
||||
(lambda (k v port)
|
||||
(cond
|
||||
((string? v) (display v port))
|
||||
|
@ -1522,7 +1532,7 @@ phrase\"."
|
|||
(lambda (k v)
|
||||
(if (eq? k 'q)
|
||||
(valid-quality? v)
|
||||
(string? v)))
|
||||
(or (not v) (string? v))))
|
||||
(lambda (k v port)
|
||||
(if (eq? k 'q)
|
||||
(write-quality v port)
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue