diff options
| author | Mark H Weaver <mhw@netris.org> | 2014-01-21 15:50:58 -0500 |
|---|---|---|
| committer | Mark H Weaver <mhw@netris.org> | 2014-01-21 16:11:04 -0500 |
| commit | d0d8c872afcc0e3384389171ceb32dc26df8c8a6 (patch) | |
| tree | 078bdf7afabe4fb5d2bb642938ed67d87956960f | |
| parent | 6f4cc6a31eaf9a55730e85a096846caaf5a940fc (diff) | |
| download | guile-d0d8c872afcc0e3384389171ceb32dc26df8c8a6.tar.gz | |
Write out HTTP Basic auth headers correctly.
Fixes <http://bugs.gnu.org/14370>.
Reported by Atom X Zane <atomx@deadlyhead.com>.
* module/web/http.scm (write-credentials): Handle the Basic auth scheme
correctly.
* test-suite/tests/web-http.test (pass-if-round-trip): Use
'pass-if-equal' for better error reporting.
("request headers"): Add tests.
* THANKS: Add "Atom X Zane" to bug fix section.
| -rw-r--r-- | THANKS | 1 | ||||
| -rw-r--r-- | module/web/http.scm | 8 | ||||
| -rw-r--r-- | test-suite/tests/web-http.test | 19 |
3 files changed, 16 insertions, 12 deletions
@@ -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)) |