mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00
Code Activity

web client: Support relative URIs in some headers.

Browse source 
Fixes <http://bugs.gnu.org/12827>.

* module/web/http.scm (declare-relative-uri-header!): New procedure.
  ("Content-Location", "Referer"): Use it.
  Based on discussions with Daniel Hartwig <mandyke@gmail.com>.
This commit is contained in:
Ludovic Courtès 2012-11-27 00:10:09 +01:00
parent ca8be3f5b3
commit 261af76005
1 changed files with 17 additions and 2 deletions
Download patch file Download diff file Expand all files Collapse all files

19
module/web/http.scm
View file

@ -1185,6 +1185,21 @@ treated specially, and is just returned as a plain string."
uri?
write-uri))
;; emacs: (put 'declare-relative-uri-header! 'scheme-indent-function 1)
(define (declare-relative-uri-header! name)
(declare-header! name
(lambda (str)
;; XXX: Attempt to build an absolute URI, and fall back to a URI
;; with no scheme to represent a relative URI.
;; See <http://bugs.gnu.org/12827> for ideas to fully support
;; relative URIs (aka. "URI references").
(or (string->uri str) ; absolute URI
(build-uri #f ; relative URI
#:path str
#:validate? #f)))
uri?
write-uri))
;; emacs: (put 'declare-quality-list-header! 'scheme-indent-function 1)
(define (declare-quality-list-header! name)
(declare-header! name
@ -1437,7 +1452,7 @@ treated specially, and is just returned as a plain string."
;; Content-Location = ( absoluteURI | relativeURI )
;;
(declare-uri-header! "Content-Location")
(declare-relative-uri-header! "Content-Location")
;; Content-MD5 = <base64 of 128 bit MD5 digest as per RFC 1864>
;;
@ -1726,7 +1741,7 @@ treated specially, and is just returned as a plain string."
;; Referer = ( absoluteURI | relativeURI )
;;
(declare-uri-header! "Referer")
(declare-relative-uri-header! "Referer")
;; TE = #( t-codings )
;; t-codings = "trailers" | ( transfer-extension [ accept-params ] )