mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-24 12:20:20 +02:00
Code Activity

http: support IP-literal (IPv6 address) in Host header

Browse source 
* 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.
This commit is contained in:
Daniel Hartwig 2013-03-16 19:53:07 +08:00
parent 2e08ff38b7
commit b1c46fd30a
2 changed files with 24 additions and 6 deletions
Download patch file Download diff file Expand all files Collapse all files

26
module/web/http.scm
View file

@ -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)