This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "GNU Guile".
http://git.savannah.gnu.org/cgit/guile.git/commit/?id=a5cbbaa66a2491453db0edff9b0cb592a98f61bf The branch, stable-2.0 has been updated via a5cbbaa66a2491453db0edff9b0cb592a98f61bf (commit) via e6c8e6047ed2e772cc4e1fb5ad4d389e5c616feb (commit) via d0d8c872afcc0e3384389171ceb32dc26df8c8a6 (commit) from 6f4cc6a31eaf9a55730e85a096846caaf5a940fc (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit a5cbbaa66a2491453db0edff9b0cb592a98f61bf Author: Mark H Weaver <[email protected]> Date: Tue Jan 21 16:21:36 2014 -0500 Fix nested block comment example in manual. Reported by Chris K. Jester-Young <[email protected]>. * doc/ref/api-evaluation.texi (Block Comments): Fix example. commit e6c8e6047ed2e772cc4e1fb5ad4d389e5c616feb Author: Mark H Weaver <[email protected]> Date: Tue Jan 21 16:06:40 2014 -0500 REPL Server: Don't establish a SIGINT handler. * module/system/repl/server.scm (call-with-sigint): Remove. (accept-new-client): Don't wrap 'call-with-sigint' around call to 'accept'. commit d0d8c872afcc0e3384389171ceb32dc26df8c8a6 Author: Mark H Weaver <[email protected]> Date: Tue Jan 21 15:50:58 2014 -0500 Write out HTTP Basic auth headers correctly. Fixes <http://bugs.gnu.org/14370>. Reported by Atom X Zane <[email protected]>. * 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. ----------------------------------------------------------------------- Summary of changes: THANKS | 1 + doc/ref/api-evaluation.texi | 2 +- module/system/repl/server.scm | 19 +------------------ module/web/http.scm | 8 ++++---- test-suite/tests/web-http.test | 19 +++++++++++-------- 5 files changed, 18 insertions(+), 31 deletions(-) diff --git a/THANKS b/THANKS index f16376b..ddb11c1 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/doc/ref/api-evaluation.texi b/doc/ref/api-evaluation.texi index 4a5b3d1..7d67d9a 100644 --- a/doc/ref/api-evaluation.texi +++ b/doc/ref/api-evaluation.texi @@ -238,7 +238,7 @@ comments as specified by R6RS and @url{http://srfi.schemers.org/srfi-30/srfi-30.html, SRFI-30}: @lisp -(+ #| this is a #| nested |# block comment |# 2) +(+ 1 #| this is a #| nested |# block comment |# 2) @result{} 3 @end lisp diff --git a/module/system/repl/server.scm b/module/system/repl/server.scm index ec90677..2df7564 100644 --- a/module/system/repl/server.scm +++ b/module/system/repl/server.scm @@ -67,27 +67,10 @@ (bind sock AF_UNIX path) sock)) -(define call-with-sigint - (if (not (provided? 'posix)) - (lambda (thunk) (thunk)) - (lambda (thunk) - (let ((handler #f)) - (dynamic-wind - (lambda () - (set! handler - (sigaction SIGINT (lambda (sig) (throw 'interrupt))))) - thunk - (lambda () - (if handler - ;; restore Scheme handler, SIG_IGN or SIG_DFL. - (sigaction SIGINT (car handler) (cdr handler)) - ;; restore original C handler. - (sigaction SIGINT #f)))))))) - (define* (run-server #:optional (server-socket (make-tcp-server-socket))) (define (accept-new-client) (catch #t - (lambda () (call-with-sigint (lambda () (accept server-socket)))) + (lambda () (accept server-socket)) (lambda (k . args) (cond ((port-closed? server-socket) diff --git a/module/web/http.scm b/module/web/http.scm index d22c70c..aa75142 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 aa607af..45cce02 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)) hooks/post-receive -- GNU Guile
