[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.7-202-gb1c46fd

[Daniel Hartwig]

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=b1c46fd30a4615b4ab534d6bd824a81e3f536660

The branch, stable-2.0 has been updated
       via  b1c46fd30a4615b4ab534d6bd824a81e3f536660 (commit)
      from  2e08ff38b735020e8ed5403acb637e6041d3d743 (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 b1c46fd30a4615b4ab534d6bd824a81e3f536660
Author: Daniel Hartwig <address@hidden>
Date:   Sat Mar 16 19:53:07 2013 +0800

    http: support IP-literal (IPv6 address) in Host header
    
    * module/web/http.scm ("Host"): Parse and write IP-literals treating
      escapes as uri module does: remove brackets on parse, replace them on
      write.
    * test-suite/tests/web-http.test ("request headers"): Add tests.

-----------------------------------------------------------------------

Summary of changes:
 module/web/http.scm            |   26 ++++++++++++++++++++------
 test-suite/tests/web-http.test |    4 ++++
 2 files changed, 24 insertions(+), 6 deletions(-)

diff --git a/module/web/http.scm b/module/web/http.scm
index 712208b..b5202b6 100644
--- a/module/web/http.scm
+++ b/module/web/http.scm
@@ -1628,18 +1628,32 @@ treated specially, and is just returned as a plain 
string."
 ;; 
 (declare-header! "Host"
   (lambda (str)
-    (let ((colon (string-index str #\:)))
-      (if colon
-          (cons (substring str 0 colon)
-                (parse-non-negative-integer str (1+ colon)))
-          (cons str #f))))
+    (let* ((rbracket (string-index str #\]))
+           (colon (string-index str #\: (or rbracket 0)))
+           (host (cond
+                  (rbracket
+                   (unless (eqv? (string-ref str 0) #\[)
+                     (bad-header 'host str))
+                   (substring str 1 rbracket))
+                  (colon
+                   (substring str 0 colon))
+                  (else
+                   str)))
+           (port (and colon
+                      (parse-non-negative-integer str (1+ colon)))))
+      (cons host port)))
   (lambda (val)
     (and (pair? val)
          (string? (car val))
          (or (not (cdr val))
              (non-negative-integer? (cdr val)))))
   (lambda (val port)
-    (display (car val) port)
+    (if (string-index (car val) #\:)
+        (begin
+          (display #\[ port)
+          (display (car val) port)
+          (display #\] port))
+        (display (car val) port))
     (if (cdr val)
         (begin
           (display #\: port)
diff --git a/test-suite/tests/web-http.test b/test-suite/tests/web-http.test
index 6fa16bd..2913724 100644
--- a/test-suite/tests/web-http.test
+++ b/test-suite/tests/web-http.test
@@ -287,6 +287,10 @@
   (pass-if-parse from "address@hidden" "address@hidden")
   (pass-if-parse host "qux" '("qux" . #f))
   (pass-if-parse host "qux:80" '("qux" . 80))
+  (pass-if-parse host "[2001:db8::1]" '("2001:db8::1" . #f))
+  (pass-if-parse host "[2001:db8::1]:80" '("2001:db8::1" . 80))
+  (pass-if-parse host "[::ffff:192.0.2.1]" '("::ffff:192.0.2.1" . #f))
+  (pass-if-round-trip "Host: [2001:db8::1]\r\n")
   (pass-if-parse if-match "\"xyzzy\", W/\"qux\""
                  '(("xyzzy" . #t) ("qux" . #f)))
   (pass-if-parse if-match "*" '*)


hooks/post-receive
-- 
GNU Guile