From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Andy Wingo Newsgroups: gmane.lisp.guile.devel Subject: [patch] Location header is a URI-reference Date: Wed, 15 Oct 2014 11:54:35 +0200 Message-ID: <874mv5zmhw.fsf@pobox.com> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: ger.gmane.org 1413367046 22641 80.91.229.3 (15 Oct 2014 09:57:26 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Wed, 15 Oct 2014 09:57:26 +0000 (UTC) To: guile-devel@gnu.org Original-X-From: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Wed Oct 15 11:57:22 2014 Return-path: Envelope-to: guile-devel@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1XeLKa-0002bv-3H for guile-devel@m.gmane.org; Wed, 15 Oct 2014 11:57:20 +0200 Original-Received: from localhost ([::1]:43362 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1XeLKZ-0003s0-6F for guile-devel@m.gmane.org; Wed, 15 Oct 2014 05:57:19 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:41710) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1XeLI4-0008Si-Ph for guile-devel@gnu.org; Wed, 15 Oct 2014 05:54:49 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1XeLI0-0000QR-82 for guile-devel@gnu.org; Wed, 15 Oct 2014 05:54:44 -0400 Original-Received: from pb-sasl1.int.icgroup.com ([208.72.237.25]:51911 helo=sasl.smtp.pobox.com) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1XeLI0-0000Pz-1O for guile-devel@gnu.org; Wed, 15 Oct 2014 05:54:40 -0400 Original-Received: from sasl.smtp.pobox.com (unknown [127.0.0.1]) by pb-sasl1.pobox.com (Postfix) with ESMTP id F0F9911960 for ; Wed, 15 Oct 2014 05:54:38 -0400 (EDT) DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=pobox.com; h=from:to :subject:date:message-id:mime-version:content-type; s=sasl; bh=K PxNM9RxKmEpgx1OYZBKeRrir/c=; b=IKyi7YR/+DhaxeXse8n7y3Sdt+8hgk258 CaViH+RpSD2/8tSAOXNVEFFC5OBDAk1JGrEGCmL0iTiik3rj/5wry168OleONOQw 8Uuvxelll8UlPAV4U67LgGtleE5jtIm6yZhXrW9MUhVO3aoxpCPJnNbYPWvv27PG dfkDE3UrWA= DomainKey-Signature: a=rsa-sha1; c=nofws; d=pobox.com; h=from:to:subject :date:message-id:mime-version:content-type; q=dns; s=sasl; b=W6F enwYxXd+zKmvvIg568/i3GCUEcrRMRekBwmHn6nEeliAlFkuM3u/cndnQhW3L1I2 kh5ZsL95DcrmAX2jy2GE3KmDbHsPBW94UPs5oKSZLJkPxptNMHcEdRsPLND4vGaw fcZQPYuUXRe1j0RWAQYzH4gv3n8IKfty1kKJ1bX0= Original-Received: from pb-sasl1.int.icgroup.com (unknown [127.0.0.1]) by pb-sasl1.pobox.com (Postfix) with ESMTP id E892A1195F for ; Wed, 15 Oct 2014 05:54:38 -0400 (EDT) Original-Received: from badger (unknown [88.160.190.192]) (using TLSv1 with cipher ECDHE-RSA-AES256-SHA (256/256 bits)) (No client certificate requested) by pb-sasl1.pobox.com (Postfix) with ESMTPSA id DE1961195E for ; Wed, 15 Oct 2014 05:54:37 -0400 (EDT) User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/24.3 (gnu/linux) X-Pobox-Relay-ID: 4687D800-5451-11E4-B980-BA0234F91D4B-02397024!pb-sasl1.pobox.com X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 208.72.237.25 X-BeenThere: guile-devel@gnu.org X-Mailman-Version: 2.1.14 Precedence: list List-Id: "Developers list for Guile, the GNU extensibility library" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Original-Sender: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.lisp.guile.devel:17585 Archived-At: --=-=-= Content-Type: text/plain Following RFC 7231, the HTTP Location: header is a URI-reference, not a URI. This patch updates Guile's web modules appropriately, fixes a case in which URI fragments were parsed incorrectly, and makes public interfaces for creating URI references. Thoughts? This is also in wip-uri-reference. Andy --=-=-= Content-Type: text/x-diff; charset=utf-8 Content-Disposition: inline; filename=uri-reference.patch Content-Transfer-Encoding: quoted-printable commit 81f61a615ff8c5c5d6e270c255c15eb164f3456c Author: Andy Wingo Date: Wed Oct 15 11:49:41 2014 +0200 web: Location header is URI-reference; better URI-reference support =20=20=20=20 * 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. =20=20=20=20 * module/web/request.scm (request-absolute-uri): Add default-scheme optional argument. Use it if the request-uri has no scheme, or error. =20=20=20=20 * 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. =20=20=20=20 * module/web/client.scm (open-socket-for-uri): Handle the case in which there is no URI scheme. =20=20=20=20 * test-suite/tests/web-http.test: * test-suite/tests/web-uri.test: Add tests. diff --git a/module/web/client.scm b/module/web/client.scm index 3f6c45b..ef2314b 100644 --- a/module/web/client.scm +++ b/module/web/client.scm @@ -1,6 +1,6 @@ ;;; Web client =20 -;; Copyright (C) 2011, 2012, 2013 Free Software Foundation, Inc. +;; Copyright (C) 2011, 2012, 2013, 2014 Free Software Foundation, Inc. =20 ;; This library is free software; you can redistribute it and/or ;; modify it under the terms of the GNU Lesser General Public @@ -74,7 +74,8 @@ (delete-duplicates (getaddrinfo (uri-host uri) (cond (port =3D> number->string) - (else (symbol->string (uri-scheme uri)))) + ((uri-scheme uri) =3D> symbol->string) + (else (error "Not an absolute URI" uri))) (if port AI_NUMERICSERV 0)) diff --git a/module/web/http.scm b/module/web/http.scm index aa75142..a157cf0 100644 --- a/module/web/http.scm +++ b/module/web/http.scm @@ -1090,20 +1090,19 @@ three values: the method, the URI, and the version." (bad-request "Bad Request-Line: ~s" line)))) =20 (define (write-uri uri port) - (if (uri-host uri) - (begin - (display (uri-scheme uri) port) - (display "://" port) - (if (uri-userinfo uri) - (begin - (display (uri-userinfo uri) port) - (display #\@ port))) - (display (uri-host uri) port) - (let ((p (uri-port uri))) - (if (and p (not (eqv? p 80))) - (begin - (display #\: port) - (display p port)))))) + (when (uri-host uri) + (when (uri-scheme uri) + (display (uri-scheme uri) port) + (display #\: port)) + (display "//" port) + (when (uri-userinfo uri) + (display (uri-userinfo uri) port) + (display #\@ port)) + (display (uri-host uri) port) + (let ((p (uri-port uri))) + (when (and p (not (eqv? p 80))) + (display #\: port) + (display p port)))) (let* ((path (uri-path uri)) (len (string-length path))) (cond @@ -1113,10 +1112,9 @@ three values: the method, the URI, and the version." (bad-request "Empty path and no host for URI: ~s" uri)) (else (display path port)))) - (if (uri-query uri) - (begin - (display #\? port) - (display (uri-query uri) port)))) + (when (uri-query uri) + (display #\? port) + (display (uri-query uri) port))) =20 (define (write-request-line method uri version port) "Write the first line of an HTTP request to PORT." @@ -1226,11 +1224,11 @@ treated specially, and is just returned as a plain = string." (@@ (web uri) absolute-uri?) write-uri)) =20 -;; emacs: (put 'declare-relative-uri-header! 'scheme-indent-function 1) -(define (declare-relative-uri-header! name) +;; emacs: (put 'declare-uri-reference-header! 'scheme-indent-function 1) +(define (declare-uri-reference-header! name) (declare-header! name (lambda (str) - (or ((@@ (web uri) string->uri*) str) + (or (string->uri-reference str) (bad-header-component 'uri str))) uri? write-uri)) @@ -1519,9 +1517,9 @@ treated specially, and is just returned as a plain st= ring." ;; (declare-integer-header! "Content-Length") =20 -;; Content-Location =3D ( absoluteURI | relativeURI ) +;; Content-Location =3D URI-reference ;; -(declare-relative-uri-header! "Content-Location") +(declare-uri-reference-header! "Content-Location") =20 ;; Content-MD5 =3D ;; @@ -1822,9 +1820,9 @@ treated specially, and is just returned as a plain st= ring." (display (cdr pair) port))) ","))) =20 -;; Referer =3D ( absoluteURI | relativeURI ) +;; Referer =3D URI-reference ;; -(declare-relative-uri-header! "Referer") +(declare-uri-reference-header! "Referer") =20 ;; TE =3D #( t-codings ) ;; t-codings =3D "trailers" | ( transfer-extension [ accept-params ] ) @@ -1859,9 +1857,13 @@ treated specially, and is just returned as a plain s= tring." entity-tag? write-entity-tag) =20 -;; Location =3D absoluteURI +;; Location =3D URI-reference +;; +;; In RFC 2616, Location was specified as being an absolute URI. This +;; was changed in RFC 7231 to permit URI references generally, which +;; matches web reality. ;;=20 -(declare-uri-header! "Location") +(declare-uri-reference-header! "Location") =20 ;; Proxy-Authenticate =3D 1#challenge ;; diff --git a/module/web/request.scm b/module/web/request.scm index 7ced076..0a206cf 100644 --- a/module/web/request.scm +++ b/module/web/request.scm @@ -300,7 +300,8 @@ request R." (define-request-accessor user-agent #f) =20 ;; Misc accessors -(define* (request-absolute-uri r #:optional default-host default-port) +(define* (request-absolute-uri r #:optional default-host default-port + default-scheme) "A helper routine to determine the absolute URI of a request, using the =E2=80=98host=E2=80=99 header and the default host and port." (let ((uri (request-uri r))) @@ -313,7 +314,10 @@ request R." (bad-request "URI not absolute, no Host header, and no default:= ~s" uri))))) - (build-uri (uri-scheme uri) + (build-uri (or (uri-scheme uri) + default-scheme + (bad-request "URI not absolute and no default-por= t" + uri)) #:host (car host) #:port (cdr host) #:path (uri-path uri) diff --git a/module/web/uri.scm b/module/web/uri.scm index 3ab820d..063d7ee 100644 --- a/module/web/uri.scm +++ b/module/web/uri.scm @@ -36,8 +36,10 @@ uri-path uri-query uri-fragment =20 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))) =20 -(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 @@ =20 (define* (build-uri scheme #:key userinfo host port (path "") query fragme= nt (validate? #t)) - "Construct a URI object. SCHEME should be a symbol, PORT -either a positive, exact integer or =E2=80=98#f=E2=80=99, and the rest of = the -fields are either strings or =E2=80=98#f=E2=80=99. 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 =E2=80=98#f=E2=80=99, and the rest of the field= s are either +strings or =E2=80=98#f=E2=80=99. If VALIDATE? is true, also run some cons= istency 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)) =20 +(define* (build-uri-reference #:key scheme userinfo host port (path "") qu= ery + fragment (validate? #t)) + "Construct a URI object. SCHEME should be a symbol or =E2=80=98#f=E2=80= =99, PORT +either a positive, exact integer or =E2=80=98#f=E2=80=99, and the rest obf= the fields +are either strings or =E2=80=98#f=E2=80=99. If VALIDATE? is true, also ru= n 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. =20 (define scheme-pat "[a-zA-Z][a-zA-Z0-9+.-]*") @@ -173,9 +191,9 @@ is valid." (define uri-regexp (make-regexp uri-pat)) =20 -(define (string->uri* string) - "Parse STRING into a URI object. Return =E2=80=98#f=E2=80=99 if the str= ing -could not be parsed." +(define (string->uri-reference string) + "Parse the URI reference written as STRING into a URI object. Return +=E2=80=98#f=E2=80=99 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))) =20 (define (string->uri string) - "Parse STRING into a URI object. Return =E2=80=98#f=E2=80=99 if the str= ing + "Parse STRING into an absolute URI object. Return =E2=80=98#f=E2=80=99 = if the string could not be parsed." - (let ((uri (string->uri* string))) + (let ((uri (string->uri-reference string))) (and uri (uri-scheme uri) uri))) =20 (define *default-ports* (make-hash-table)) diff --git a/test-suite/tests/web-http.test b/test-suite/tests/web-http.test index 45cce02..dfc9677 100644 --- a/test-suite/tests/web-http.test +++ b/test-suite/tests/web-http.test @@ -345,6 +345,14 @@ (pass-if-parse etag "W/\"foo\"" '("foo" . #f)) (pass-if-parse location "http://other-place" (build-uri 'http #:host "other-place")) + (pass-if-parse location "#foo" + (build-uri-reference #:fragment "foo")) + (pass-if-parse location "/#foo" + (build-uri-reference #:path "/" #:fragment "foo")) + (pass-if-parse location "/foo" + (build-uri-reference #:path "/foo")) + (pass-if-parse location "//server/foo" + (build-uri-reference #:host "server" #:path "/foo")) (pass-if-parse proxy-authenticate "Basic realm=3D\"guile\"" '((basic (realm . "guile")))) (pass-if-parse retry-after "Tue, 15 Nov 1994 08:12:31 GMT" diff --git a/test-suite/tests/web-uri.test b/test-suite/tests/web-uri.test index 3d14d9d..4873d7f 100644 --- a/test-suite/tests/web-uri.test +++ b/test-suite/tests/web-uri.test @@ -1,6 +1,6 @@ ;;;; web-uri.test --- URI library -*- mode: scheme; coding: utf-8= ; -*- ;;;; -;;;; Copyright (C) 2010, 2011, 2012 Free Software Foundation, Inc. +;;;; Copyright (C) 2010, 2011, 2012, 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 @@ -210,7 +210,298 @@ (pass-if "file:///etc/hosts" (uri=3D? (string->uri "file:///etc/hosts") #:scheme 'file - #:path "/etc/hosts"))) + #:path "/etc/hosts")) + + (pass-if "http://foo#bar" + (uri=3D? (string->uri "http://foo#bar") + #:scheme 'http + #:host "foo" + #:path "" + #:fragment "bar")) + + (pass-if "http://foo:/#bar" + (uri=3D? (string->uri "http://foo:/#bar") + #:scheme 'http + #:host "foo" + #:path "/" + #:fragment "bar")) + + (pass-if "http://foo:100#bar" + (uri=3D? (string->uri "http://foo:100#bar") + #:scheme 'http + #:host "foo" + #:port 100 + #:path "" + #:fragment "bar")) + + (pass-if "http://foo:100/#bar" + (uri=3D? (string->uri "http://foo:100/#bar") + #:scheme 'http + #:host "foo" + #:port 100 + #:path "/" + #:fragment "bar")) + + (pass-if "http://foo?q#bar" + (uri=3D? (string->uri "http://foo?q#bar") + #:scheme 'http + #:host "foo" + #:path "" + #:query "q" + #:fragment "bar")) + + (pass-if "http://foo:/?q#bar" + (uri=3D? (string->uri "http://foo:/?q#bar") + #:scheme 'http + #:host "foo" + #:path "/" + #:query "q" + #:fragment "bar")) + + (pass-if "http://foo:100?q#bar" + (uri=3D? (string->uri "http://foo:100?q#bar") + #:scheme 'http + #:host "foo" + #:port 100 + #:path "" + #:query "q" + #:fragment "bar")) + + (pass-if "http://foo:100/?q#bar" + (uri=3D? (string->uri "http://foo:100/?q#bar") + #:scheme 'http + #:host "foo" + #:port 100 + #:path "/" + #:query "q" + #:fragment "bar"))) + +(with-test-prefix "string->uri-reference" + (pass-if "/foo" + (uri=3D? (string->uri-reference "/foo") + #:path "/foo")) +=20=20 + (pass-if "ftp:/foo" + (uri=3D? (string->uri-reference "ftp:/foo") + #:scheme 'ftp + #:path "/foo")) +=20=20 + (pass-if "ftp:foo" + (uri=3D? (string->uri-reference "ftp:foo") + #:scheme 'ftp + #:path "foo")) +=20=20 + (pass-if "//foo/bar" + (uri=3D? (string->uri-reference "//foo/bar") + #:host "foo" + #:path "/bar")) +=20=20 + (pass-if "ftp://foo@bar:22/baz" + (uri=3D? (string->uri-reference "ftp://foo@bar:22/baz") + #:scheme 'ftp + #:userinfo "foo" + #:host "bar" + #:port 22 + #:path "/baz")) + + (pass-if "//foo@bar:22/baz" + (uri=3D? (string->uri-reference "//foo@bar:22/baz") + #:userinfo "foo" + #:host "bar" + #:port 22 + #:path "/baz")) + + (pass-if "http://bad.host.1" + (not (string->uri-reference "http://bad.host.1"))) + + (pass-if "//bad.host.1" + (not (string->uri-reference "//bad.host.1"))) + + (pass-if "http://1.good.host" + (uri=3D? (string->uri-reference "http://1.good.host") + #:scheme 'http #:host "1.good.host" #:path "")) + + (pass-if "//1.good.host" + (uri=3D? (string->uri-reference "//1.good.host") + #:host "1.good.host" #:path "")) + + (when (memq 'socket *features*) + (pass-if "http://192.0.2.1" + (uri=3D? (string->uri-reference "http://192.0.2.1") + #:scheme 'http #:host "192.0.2.1" #:path "")) + + (pass-if "//192.0.2.1" + (uri=3D? (string->uri-reference "//192.0.2.1") + #:host "192.0.2.1" #:path "")) + + (pass-if "http://[2001:db8::1]" + (uri=3D? (string->uri-reference "http://[2001:db8::1]") + #:scheme 'http #:host "2001:db8::1" #:path "")) + + (pass-if "//[2001:db8::1]" + (uri=3D? (string->uri-reference "//[2001:db8::1]") + #:host "2001:db8::1" #:path "")) + + (pass-if "http://[2001:db8::1]:80" + (uri=3D? (string->uri-reference "http://[2001:db8::1]:80") + #:scheme 'http + #:host "2001:db8::1" + #:port 80 + #:path "")) + + (pass-if "//[2001:db8::1]:80" + (uri=3D? (string->uri-reference "//[2001:db8::1]:80") + #:host "2001:db8::1" + #:port 80 + #:path "")) + + (pass-if "http://[::ffff:192.0.2.1]" + (uri=3D? (string->uri-reference "http://[::ffff:192.0.2.1]") + #:scheme 'http #:host "::ffff:192.0.2.1" #:path "")) + + (pass-if "//[::ffff:192.0.2.1]" + (uri=3D? (string->uri-reference "//[::ffff:192.0.2.1]") + #:host "::ffff:192.0.2.1" #:path ""))) + + (pass-if "http://foo:" + (uri=3D? (string->uri-reference "http://foo:") + #:scheme 'http #:host "foo" #:path "")) + + (pass-if "//foo:" + (uri=3D? (string->uri-reference "//foo:") + #:host "foo" #:path "")) + + (pass-if "http://foo:/" + (uri=3D? (string->uri-reference "http://foo:/") + #:scheme 'http #:host "foo" #:path "/")) + + (pass-if "//foo:/" + (uri=3D? (string->uri-reference "//foo:/") + #:host "foo" #:path "/")) + + (pass-if "http://2012.jsconf.us/" + (uri=3D? (string->uri-reference "http://2012.jsconf.us/") + #:scheme 'http #:host "2012.jsconf.us" #:path "/")) + + (pass-if "//2012.jsconf.us/" + (uri=3D? (string->uri-reference "//2012.jsconf.us/") + #:host "2012.jsconf.us" #:path "/")) + + (pass-if "http://foo:not-a-port" + (not (string->uri-reference "http://foo:not-a-port"))) +=20=20 + (pass-if "//foo:not-a-port" + (not (string->uri-reference "//foo:not-a-port"))) +=20=20 + (pass-if "http://:10" + (not (string->uri-reference "http://:10"))) + + (pass-if "//:10" + (not (string->uri-reference "//:10"))) + + (pass-if "http://foo@" + (not (string->uri-reference "http://foo@"))) + + (pass-if "//foo@" + (not (string->uri-reference "//foo@"))) + + (pass-if "file:/" + (uri=3D? (string->uri-reference "file:/") + #:scheme 'file + #:path "/")) + + (pass-if "/" + (uri=3D? (string->uri-reference "/") + #:path "/")) + + (pass-if "foo" + (uri=3D? (string->uri-reference "foo") + #:path "foo")) + + (pass-if "file:/etc/hosts" + (uri=3D? (string->uri-reference "file:/etc/hosts") + #:scheme 'file + #:path "/etc/hosts")) + + (pass-if "/etc/hosts" + (uri=3D? (string->uri-reference "/etc/hosts") + #:path "/etc/hosts")) + + (pass-if "file:///etc/hosts" + (uri=3D? (string->uri-reference "file:///etc/hosts") + #:scheme 'file + #:path "/etc/hosts")) + + (pass-if "///etc/hosts" + (uri=3D? (string->uri-reference "///etc/hosts") + #:path "/etc/hosts")) + + (pass-if "/foo#bar" + (uri=3D? (string->uri-reference "/foo#bar") + #:path "/foo" + #:fragment "bar")) + + (pass-if "//foo#bar" + (uri=3D? (string->uri-reference "//foo#bar") + #:host "foo" + #:path "" + #:fragment "bar")) + + (pass-if "//foo:/#bar" + (uri=3D? (string->uri-reference "//foo:/#bar") + #:host "foo" + #:path "/" + #:fragment "bar")) + + (pass-if "//foo:100#bar" + (uri=3D? (string->uri-reference "//foo:100#bar") + #:host "foo" + #:port 100 + #:path "" + #:fragment "bar")) + + (pass-if "//foo:100/#bar" + (uri=3D? (string->uri-reference "//foo:100/#bar") + #:host "foo" + #:port 100 + #:path "/" + #:fragment "bar")) + + (pass-if "/foo?q#bar" + (uri=3D? (string->uri-reference "/foo?q#bar") + #:path "/foo" + #:query "q" + #:fragment "bar")) + + (pass-if "//foo?q#bar" + (uri=3D? (string->uri-reference "//foo?q#bar") + #:host "foo" + #:path "" + #:query "q" + #:fragment "bar")) + + (pass-if "//foo:/?q#bar" + (uri=3D? (string->uri-reference "//foo:/?q#bar") + #:host "foo" + #:path "/" + #:query "q" + #:fragment "bar")) + + (pass-if "//foo:100?q#bar" + (uri=3D? (string->uri-reference "//foo:100?q#bar") + #:host "foo" + #:port 100 + #:path "" + #:query "q" + #:fragment "bar")) + + (pass-if "//foo:100/?q#bar" + (uri=3D? (string->uri-reference "//foo:100/?q#bar") + #:host "foo" + #:port 100 + #:path "/" + #:query "q" + #:fragment "bar"))) =20 (with-test-prefix "uri->string" (pass-if "ftp:" @@ -225,30 +516,78 @@ (equal? "ftp://foo/bar" (uri->string (string->uri "ftp://foo/bar")))) =20=20=20 + (pass-if "//foo/bar" + (equal? "//foo/bar" + (uri->string (string->uri-reference "//foo/bar")))) +=20=20 (pass-if "ftp://foo@bar:22/baz" (equal? "ftp://foo@bar:22/baz" (uri->string (string->uri "ftp://foo@bar:22/baz")))) =20=20=20 + (pass-if "//foo@bar:22/baz" + (equal? "//foo@bar:22/baz" + (uri->string (string->uri-reference "//foo@bar:22/baz")))) +=20=20 (when (memq 'socket *features*) (pass-if "http://192.0.2.1" (equal? "http://192.0.2.1" (uri->string (string->uri "http://192.0.2.1")))) =20 + (pass-if "//192.0.2.1" + (equal? "//192.0.2.1" + (uri->string (string->uri-reference "//192.0.2.1")))) + (pass-if "http://[2001:db8::1]" (equal? "http://[2001:db8::1]" (uri->string (string->uri "http://[2001:db8::1]")))) =20 + (pass-if "//[2001:db8::1]" + (equal? "//[2001:db8::1]" + (uri->string (string->uri-reference "//[2001:db8::1]")))) + (pass-if "http://[::ffff:192.0.2.1]" (equal? "http://[::ffff:192.0.2.1]" - (uri->string (string->uri "http://[::ffff:192.0.2.1]"))))) + (uri->string (string->uri "http://[::ffff:192.0.2.1]")))) + + (pass-if "//[::ffff:192.0.2.1]" + (equal? "//[::ffff:192.0.2.1]" + (uri->string (string->uri-reference "//[::ffff:192.0.2.1]"))= ))) =20 (pass-if "http://foo:" (equal? "http://foo" (uri->string (string->uri "http://foo:")))) =20=20=20 + (pass-if "//foo" + (equal? "//foo" + (uri->string (string->uri-reference "//foo")))) + (pass-if "http://foo:/" (equal? "http://foo/" - (uri->string (string->uri "http://foo:/"))))) + (uri->string (string->uri "http://foo:/")))) + + (pass-if "//foo:/" + (equal? "//foo/" + (uri->string (string->uri-reference "//foo:/")))) + + (pass-if "/" + (equal? "/" + (uri->string (string->uri-reference "/")))) + + (pass-if "/foo" + (equal? "/foo" + (uri->string (string->uri-reference "/foo")))) + + (pass-if "/foo/" + (equal? "/foo/" + (uri->string (string->uri-reference "/foo/")))) + + (pass-if "/foo/?bar#baz" + (equal? "/foo/?bar#baz" + (uri->string (string->uri-reference "/foo/?bar#baz")))) + + (pass-if "foo/?bar#baz" + (equal? "foo/?bar#baz" + (uri->string (string->uri-reference "foo/?bar#baz"))))) =20 (with-test-prefix "decode" (pass-if "foo%20bar" --=-=-= Content-Type: text/plain -- http://wingolog.org/ --=-=-=--