From 261af76005f0e31f570bed201a2ef2a43cdd6e11 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Tue, 27 Nov 2012 00:10:09 +0100 Subject: [PATCH] web client: Support relative URIs in some headers. Fixes . * module/web/http.scm (declare-relative-uri-header!): New procedure. ("Content-Location", "Referer"): Use it. Based on discussions with Daniel Hartwig . --- module/web/http.scm | 19 +++++++++++++++++-- 1 file changed, 17 insertions(+), 2 deletions(-) diff --git a/module/web/http.scm b/module/web/http.scm index 342f43521..f8dba30b5 100644 --- a/module/web/http.scm +++ b/module/web/http.scm @@ -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 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 = ;; @@ -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 ] )