diff --git a/THANKS b/THANKS index f16376b59..ddb11c14d 100644 --- a/THANKS +++ b/THANKS @@ -192,6 +192,7 @@ For fixes or providing information which led to a fix: Andy Wingo Keith Wright William Xu + Atom X Zane ;; Local Variables: diff --git a/module/web/http.scm b/module/web/http.scm index d22c70c6e..aa75142fc 100644 --- a/module/web/http.scm +++ b/module/web/http.scm @@ -918,10 +918,10 @@ as an ordered alist." (define (write-credentials val port) (display (car val) port) - (if (pair? (cdr val)) - (begin - (display #\space port) - (write-key-value-list (cdr val) port)))) + (display #\space port) + (case (car val) + ((basic) (display (cdr val) port)) + (else (write-key-value-list (cdr val) port)))) ;; challenges = 1#challenge ;; challenge = auth-scheme 1*SP 1#auth-param diff --git a/test-suite/tests/web-http.test b/test-suite/tests/web-http.test index aa607afad..45cce0229 100644 --- a/test-suite/tests/web-http.test +++ b/test-suite/tests/web-http.test @@ -49,14 +49,14 @@ (define-syntax pass-if-round-trip (syntax-rules () ((_ str) - (pass-if (format #f "~s round trip" str) - (equal? (call-with-output-string - (lambda (port) - (call-with-values - (lambda () (read-header (open-input-string str))) - (lambda (sym val) - (write-header sym val port))))) - str))))) + (pass-if-equal (format #f "~s round trip" str) + str + (call-with-output-string + (lambda (port) + (call-with-values + (lambda () (read-header (open-input-string str))) + (lambda (sym val) + (write-header sym val port))))))))) (define-syntax pass-if-any-error (syntax-rules () @@ -292,6 +292,9 @@ (pass-if-parse authorization "Digest foooo" '(digest foooo)) (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: 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 from "foo@bar" "foo@bar") (pass-if-parse host "qux" '("qux" . #f))