mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-22 20:40:29 +02:00
Code Activity

web: send capitalized authorization header scheme

Browse source 
* module/web/http.scm (write-credentials): capitalize authorization
header scheme. The standard allows the scheme to be case-insensitive,
however most libraries out there expect the scheme to be capitalized,
which is what it is actually used in RFC
docs (e.g. https://datatracker.ietf.org/doc/html/rfc7617#section-2). Some
libraries even reject lowercase scheme making Guile incompatible.

Signed-off-by: Ludovic Courtès <ludo@gnu.org>
This commit is contained in:
Aleix Conchillo Flaqué 2022-06-24 09:34:53 -07:00 • committed by Ludovic Courtès
parent 7e048c6c51
commit a84d8f6473
2 changed files with 20 additions and 5 deletions
Download patch file Download diff file Expand all files Collapse all files

14
module/web/http.scm
View file

@ -962,13 +962,23 @@ as an ordered alist."
(((? symbol?) . (? key-value-list?)) #t) (((? symbol?) . (? key-value-list?)) #t)
(_ #f))) (_ #f)))
;; While according to RFC 7617 Schemes are case-insensitive:
;;
;; 'Note that both scheme and parameter names are matched
;; case-insensitive'
;;
;; some software (*) incorrectly assumes title case for scheme
;; names, so use the more titlecase.
;;
;; (*): See, e.g.,
;; https://community.spotify.com/t5/Spotify-for-Developers/API-Authorization-header-doesn-t-follow-HTTP-spec/m-p/5397381#M4917
(define (write-credentials val port) (define (write-credentials val port)
(match val (match val
(('basic . cred) (('basic . cred)
(put-string port "basic ") (put-string port "Basic ")
(put-string port cred)) (put-string port cred))
((scheme . params) ((scheme . params)
(put-symbol port scheme) (put-string port (string-titlecase (symbol->string scheme)))
(put-char port #\space) (put-char port #\space)
(write-key-value-list params port)))) (write-key-value-list params port))))

11
test-suite/tests/web-http.test
View file

@ -336,9 +336,14 @@
(pass-if-parse authorization "Digest foooo" '(digest foooo)) (pass-if-parse authorization "Digest foooo" '(digest foooo))
(pass-if-parse authorization "Digest foo=bar,baz=qux" (pass-if-parse authorization "Digest foo=bar,baz=qux"
'(digest (foo . "bar") (baz . "qux"))) '(digest (foo . "bar") (baz . "qux")))
(pass-if-round-trip "Authorization: basic foooo\r\n") (pass-if-parse authorization "basic foooo" '(basic . "foooo"))
(pass-if-round-trip "Authorization: digest foooo\r\n") (pass-if-parse authorization "digest foooo" '(digest foooo))
(pass-if-round-trip "Authorization: digest foo=bar, baz=qux\r\n") (pass-if-parse authorization "digest foo=bar,baz=qux"
'(digest (foo . "bar") (baz . "qux")))
(pass-if-round-trip "Authorization: Basic foooo\r\n")
(pass-if-round-trip "Authorization: Bearer token\r\n")
(pass-if-round-trip "Authorization: Digest foooo\r\n")
(pass-if-round-trip "Authorization: Digest foo=bar, baz=qux\r\n")
(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")
(pass-if-parse host "qux" '("qux" . #f)) (pass-if-parse host "qux" '("qux" . #f))