summaryrefslogtreecommitdiff
path: root/module/web/uri.scm
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2014-10-15 11:49:41 +0200
committerAndy Wingo <wingo@pobox.com>2014-11-01 15:36:56 +0100
commit18c44b29e4438976dac86a3cb53a273dde42e294 (patch)
tree0decd8153038f4775a01776c27ebc724eb94aed3 /module/web/uri.scm
parent7f2c824551aa848b359ef6b79c1d5e15d367eb8a (diff)
downloadguile-18c44b29e4438976dac86a3cb53a273dde42e294.tar.gz
web: Location header is URI-reference; better URI-reference support
* module/web/uri.scm (validate-uri): Add reference? keyword argument, for validating references. (build-uri): Clarify comments to indicate that the result is an absolute URI. (build-uri-reference): New interface, to build URI-references. (string->uri-reference): Rename from string->uri*. Fix fragment parsing to not include the #. (string->uri): Adapt to string->uri-reference name change. * module/web/request.scm (request-absolute-uri): Add default-scheme optional argument. Use it if the request-uri has no scheme, or error. * module/web/http.scm (write-uri): Reflow to use "when". Fix writing of URI-reference instances. (declare-uri-reference-header!): Rename from declare-relative-uri-header!. Use string->uri-reference. ("Location"): Declare as a URI-reference header, as per RFC 7231. * module/web/client.scm (open-socket-for-uri): Handle the case in which there is no URI scheme. * test-suite/tests/web-http.test: * test-suite/tests/web-uri.test: Add tests.
Diffstat (limited to 'module/web/uri.scm')
-rw-r--r--module/web/uri.scm48
1 files changed, 33 insertions, 15 deletions
diff --git a/module/web/uri.scm b/module/web/uri.scm
index 3ab820d14..e1c8b3998 100644
--- a/module/web/uri.scm
+++ b/module/web/uri.scm
@@ -1,6 +1,6 @@
;;;; (web uri) --- URI manipulation tools
;;;;
-;;;; Copyright (C) 1997,2001,2002,2010,2011,2012,2013 Free Software Foundation, Inc.
+;;;; Copyright (C) 1997,2001,2002,2010,2011,2012,2013,2014 Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@@ -36,8 +36,10 @@
uri-path uri-query uri-fragment
build-uri
+ build-uri-reference
declare-default-port!
- string->uri uri->string
+ string->uri string->uri-reference
+ uri->string
uri-decode uri-encode
split-and-decode-uri-path
encode-and-join-uri-path))
@@ -62,9 +64,10 @@
(define (positive-exact-integer? port)
(and (number? port) (exact? port) (integer? port) (positive? port)))
-(define (validate-uri scheme userinfo host port path query fragment)
+(define* (validate-uri scheme userinfo host port path query fragment
+ #:key reference?)
(cond
- ((not (symbol? scheme))
+ ((and (not reference?) (not (symbol? scheme)))
(uri-error "Expected a symbol for the URI scheme: ~s" scheme))
((and (or userinfo port) (not host))
(uri-error "Expected a host, given userinfo or port"))
@@ -82,15 +85,26 @@
(define* (build-uri scheme #:key userinfo host port (path "") query fragment
(validate? #t))
- "Construct a URI object. SCHEME should be a symbol, PORT
-either a positive, exact integer or ‘#f’, and the rest of the
-fields are either strings or ‘#f’. If VALIDATE? is true,
-also run some consistency checks to make sure that the constructed URI
-is valid."
+ "Construct a URI object. SCHEME should be a symbol, PORT either a
+positive, exact integer or ‘#f’, and the rest of the fields are either
+strings or ‘#f’. If VALIDATE? is true, also run some consistency checks
+to make sure that the constructed object is a valid absolute URI."
(if validate?
(validate-uri scheme userinfo host port path query fragment))
(make-uri scheme userinfo host port path query fragment))
+(define* (build-uri-reference #:key scheme userinfo host port (path "") query
+ fragment (validate? #t))
+ "Construct a URI object. SCHEME should be a symbol or ‘#f’, PORT
+either a positive, exact integer or ‘#f’, and the rest of the fields
+are either strings or ‘#f’. If VALIDATE? is true, also run some
+consistency checks to make sure that the constructed URI is a valid URI
+reference (either an absolute URI or a relative reference)."
+ (if validate?
+ (validate-uri scheme userinfo host port path query fragment
+ #:reference? #t))
+ (make-uri scheme userinfo host port path query fragment))
+
;; See RFC 3986 #3.2.2 for comments on percent-encodings, IDNA (RFC
;; 3490), and non-ASCII host names.
;;
@@ -156,6 +170,10 @@ is valid."
;;; / path-absolute
;;; / path-rootless
;;; / path-empty
+;;;
+;;; A URI-reference is the same as URI, but where the scheme is
+;;; optional. If the scheme is not present, its colon isn't present
+;;; either.
(define scheme-pat
"[a-zA-Z][a-zA-Z0-9+.-]*")
@@ -173,9 +191,9 @@ is valid."
(define uri-regexp
(make-regexp uri-pat))
-(define (string->uri* string)
- "Parse STRING into a URI object. Return ‘#f’ if the string
-could not be parsed."
+(define (string->uri-reference string)
+ "Parse the URI reference written as STRING into a URI object. Return
+‘#f’ if the string could not be parsed."
(% (let ((m (regexp-exec uri-regexp string)))
(if (not m) (abort))
(let ((scheme (let ((str (match:substring m 2)))
@@ -183,7 +201,7 @@ could not be parsed."
(authority (match:substring m 3))
(path (match:substring m 4))
(query (match:substring m 6))
- (fragment (match:substring m 7)))
+ (fragment (match:substring m 8)))
(call-with-values
(lambda ()
(if authority
@@ -195,9 +213,9 @@ could not be parsed."
#f)))
(define (string->uri string)
- "Parse STRING into a URI object. Return ‘#f’ if the string
+ "Parse STRING into an absolute URI object. Return ‘#f’ if the string
could not be parsed."
- (let ((uri (string->uri* string)))
+ (let ((uri (string->uri-reference string)))
(and uri (uri-scheme uri) uri)))
(define *default-ports* (make-hash-table))