web/uri: reimplement for rfc 3986, add tests

* module/web/uri.scm: Reimplement for RFC 3986.

* module/Makefile.am: Add to build.

* test-suite/Makefile.am:
* test-suite/tests/web-uri.test: Add tests.

module/Makefile.am

@@ -60,7 +60,8 @@ SOURCES =					\
   $(ECMASCRIPT_LANG_SOURCES)			\
   $(ELISP_LANG_SOURCES)				\
   $(BRAINFUCK_LANG_SOURCES)			\
-  $(LIB_SOURCES)
+  $(LIB_SOURCES)				\
+  $(WEB_SOURCES)
 
 ## test.scm is not currently installed.
 EXTRA_DIST +=					\
@@ -346,6 +347,9 @@ LIB_SOURCES =					\
   texinfo/reflection.scm			\
   texinfo/serialize.scm
 
+WEB_SOURCES =					\
+  web/uri.scm
+
 EXTRA_DIST += oop/ChangeLog-2008
 
 NOCOMP_SOURCES =				\

module/web/uri.scm

@@ -1,187 +1,300 @@
-;;; www/url.scm --- URL manipulation tools
+;;;; (web uri) --- URI manipulation tools
-
+;;;;
-;; 	Copyright (C) 1997,2001,2002 Free Software Foundation, Inc.
+;;;; Copyright (C) 1997,2001,2002,2010 Free Software Foundation, Inc.
-;;
+;;;;
-;; This program is free software; you can redistribute it and/or modify
+;;;; This library is free software; you can redistribute it and/or
-;; it under the terms of the GNU General Public License as published by
+;;;; modify it under the terms of the GNU Lesser General Public
-;; the Free Software Foundation; either version 2, or (at your option)
+;;;; License as published by the Free Software Foundation; either
-;; any later version.
+;;;; version 3 of the License, or (at your option) any later version.
-;;
+;;;; 
-;; This program is distributed in the hope that it will be useful,
+;;;; This library is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-;; GNU General Public License for more details.
+;;;; Lesser General Public License for more details.
-;;
+;;;; 
-;; You should have received a copy of the GNU General Public License
+;;;; You should have received a copy of the GNU Lesser General Public
-;; along with this software; see the file COPYING.  If not, write to
+;;;; License along with this library; if not, write to the Free Software
-;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
-;; Boston, MA 02111-1307 USA
+;;;;
-;;
 
 ;;; Commentary:
 
-;; This module exports the following procedures:
+;; Based on (www url). To be documented.
-;;   (url:scheme url)
-;;   (url:address url)
-;;   (url:unknown url)
-;;   (url:user url)
-;;   (url:host url)
-;;   (url:port url)
-;;   (url:path url)
-;;   (url:make scheme . args)
-;;   (url:make-http host port path)
-;;   (url:make-ftp user host port path)
-;;   (url:make-mailto address)
-;;   (url:parse url)
-;;   (url:unparse url)
-;;   (url:decode str)
-;;   (url:encode str reserved-chars)
 
 ;;; Code:
 
-
+(define-module (web uri)
-;; TODO:
+  #:export (uri?
-;;   * support `user:password@' strings where appropriate in URLs.
+            uri-scheme uri-userinfo uri-host uri-port
-;;   * make URL parsing smarter.  This is good for most TCP/IP-based
+            uri-path uri-query uri-fragment
-;;	 URL schemes, but parsing is actually specific to each URL scheme.
-;;   * fill out url:encode, include facilities for URL-scheme-specific
-;;     encoding methods (e.g. a url-scheme-reserved-char-alist)
 
-(define-module (tekuti url)
+            build-uri
-  #:use-module ((srfi srfi-1) #:select (filter))
+            parse-uri unparse-uri
-  #:use-module (ice-9 regex))
+            uri-decode uri-encode
+            split-and-decode-uri-path
+            encode-and-join-uri-path)
+  #:use-module (srfi srfi-9)
+  #:use-module (ice-9 regex)
+  #:use-module (ice-9 control)
+  #:use-module (rnrs bytevectors)
+  #:use-module (rnrs io ports))
 
-;; `url:scheme' is an unfortunate term, but it is the technical
+(define-record-type <uri>
-;; name for that portion of the URL according to RFC 1738. Sigh.
+  (make-uri scheme userinfo host port path query fragment)
+  uri?
+  (scheme uri-scheme)
+  (userinfo uri-userinfo)
+  (host uri-host)
+  (port uri-port)
+  (path uri-path)
+  (query uri-query)
+  (fragment uri-fragment))
 
-(define-public (url:scheme url)  (vector-ref url 0))
+(define (positive-exact-integer? port)
-(define-public (url:address url) (vector-ref url 1))
+  (and (number? port) (exact? port) (integer? port) (positive? port)))
-(define-public (url:unknown url) (vector-ref url 1))
-(define-public (url:user url)    (vector-ref url 1))
-(define-public (url:host url)    (vector-ref url 2))
-(define-public (url:port url)    (vector-ref url 3))
-(define-public (url:path url)    (vector-ref url 4))
 
-(define-public (url:make scheme . args)
+(define (validate-uri scheme userinfo host port path query fragment)
-  (apply vector scheme args))
-(define-public (url:make-http host port path)
-  (vector 'http #f host port path))
-(define-public (url:make-ftp user host port path)
-  (vector 'ftp user host port path))
-(define-public (url:make-mailto address)
-  (vector 'mailto address))
-
-(define http-regexp (make-regexp "^http://([^:/]+)(:([0-9]+))?(/(.*))?$"))
-(define ftp-regexp
-  (make-regexp "^ftp://(([^@:/]+)@)?([^:/]+)(:([0-9]+))?(/(.*))?$"))
-(define mailto-regexp (make-regexp "^mailto:(.*)$"))
-
-(define-public (url:parse url)
   (cond
-   ((regexp-exec http-regexp url)
+   ((not (symbol? scheme))
-    => (lambda (m)
+    (error "expected a symbol for the URI scheme" scheme))
-	 (url:make-http (match:substring m 1)
+   ((and (or userinfo port) (not host))
-			(cond ((match:substring m 3) => string->number)
+    (error "expected host, given userinfo or port"))
-			      (else #f))
+   ((and port (not (positive-exact-integer? port)))
-			(match:substring m 5))))
+    (error "expected integer port" port))
+   ((and host (or (not (string? host)) (not (valid-host? host))))
+    (error "expected valid host" host))
+   ((and userinfo (not (string? userinfo)))
+    (error "expected string for userinfo" userinfo))
+   ((not (string? path))
+    (error "expected string for path" path))
+   ((and host (not (string-null? path))
+         (not (eqv? (string-ref path 0) #\/)))
+    (error "expected path of absolute URI to start with a /" path))))
 
-   ((regexp-exec ftp-regexp url)
+(define* (build-uri scheme #:key userinfo host port (path "") query fragment
-    => (lambda (m)
+                    (validate? #t))
-	 (url:make-ftp (match:substring m 2)
+  (if validate?
-		       (match:substring m 3)
+      (validate-uri scheme userinfo host port path query fragment))
-		       (cond ((match:substring m 5) => string->number)
+  (make-uri scheme userinfo host port path query fragment))
-			     (else #f))
-		       (match:substring m 7))))
 
-   ((regexp-exec mailto-regexp url)
+;; See RFC 3986 #3.2.2 for comments on percent-encodings, IDNA (RFC
-    => (lambda (m)
+;; 3490), and non-ASCII host names.
-	 (url:make-mailto (match:substring m 1))))
+;;
+(define ipv4-regexp
+  (make-regexp "^([0-9.]+)"))
+(define ipv6-regexp
+  (make-regexp "^\\[([0-9a-fA-F:]+)\\]+"))
+(define domain-label-regexp
+  (make-regexp "^[a-zA-Z0-9]([a-zA-Z0-9-]*[a-zA-Z0-9])?$"))
+(define top-label-regexp
+  (make-regexp "^[a-zA-Z]([a-zA-Z0-9-]*[a-zA-Z0-9])?$"))
 
+(define (valid-host? host)
+  (cond
+   ((regexp-exec ipv4-regexp host)
+    => (lambda (m)
+         (false-if-exception (inet-pton AF_INET (match:substring m 1)))))
+   ((regexp-exec ipv6-regexp host)
+    => (lambda (m)
+         (false-if-exception (inet-pton AF_INET6 (match:substring m 1)))))
    (else
-    (url:make 'unknown url))))
+    (let ((labels (reverse (string-split host #\.))))
+      (and (pair? labels)
+           (regexp-exec top-label-regexp (car labels))
+           (and-map (lambda (label)
+                      (regexp-exec domain-label-regexp label))
+                    (cdr labels)))))))
+
+(define userinfo-pat
+  "[a-zA-Z0-9_.!~*'();:&=+$,-]+")
+(define host-pat
+  "[a-zA-Z0-9.-]+")
+(define port-pat
+  "[0-9]*")
+(define authority-regexp
+  (make-regexp
+   (format #f "^//((~a)@)?(~a)(:(~a))?$"
+           userinfo-pat host-pat port-pat)))
+
+(define (parse-authority authority fail)
+  (let ((m (regexp-exec authority-regexp authority)))
+    (if (and m (valid-host? (match:substring m 3)))
+        (values (match:substring m 2)
+                (match:substring m 3)
+                (let ((port (match:substring m 5)))
+                  (and port (not (string-null? port))
+                       (string->number port))))
+        (fail))))
 
 
-(define-public (url:unparse url)
+;;; RFC 3986, #3.
-  (define (pathy scheme username url)   ; username not used!
+;;;
-    (format #f "~A://~A~A~A"
+;;;   URI         = scheme ":" hier-part [ "?" query ] [ "#" fragment ]
-            scheme
+;;;
-            (url:host url)
+;;;   hier-part   = "//" authority path-abempty
-            (cond ((url:port url) => (lambda (port) (format #f ":~A" port)))
+;;;               / path-absolute
-                  (else ""))
+;;;               / path-rootless
-            (cond ((url:path url) => (lambda (path) (format #f "/~A" path)))
+;;;               / path-empty
-                  (else ""))))
+
-  (case (url:scheme url)
+(define scheme-pat
-    ((http) (pathy 'http #f url))
+  "[a-zA-Z][a-zA-Z0-9+.-]*")
-    ((ftp)  (pathy 'ftp (url:user url) url))
+(define authority-pat
-    ((mailto) (format #f "mailto:~A" (url:address url)))
+  "[^/?#]*")
-    ((unknown) (url:unknown url))))
+(define path-pat
+  "[^?#]*")
+(define query-pat
+  "[^#]*")
+(define fragment-pat
+  ".*")
+(define uri-pat
+  (format #f "^(~a):(//~a)?(~a)(\\?(~a))?(#(~a))?$"
+          scheme-pat authority-pat path-pat query-pat fragment-pat))
+(define uri-regexp
+  (make-regexp uri-pat))
+
+(define (parse-uri string)
+  (% (let ((m (regexp-exec uri-regexp string)))
+       (if (not m) (abort))
+       (let ((scheme (string->symbol
+                      (string-downcase (match:substring m 1))))
+             (authority (match:substring m 2))
+             (path (match:substring m 3))
+             (query (match:substring m 5))
+             (fragment (match:substring m 7)))
+         (call-with-values
+             (lambda ()
+               (if authority
+                   (parse-authority authority abort)
+                   (values #f #f #f)))
+           (lambda (userinfo host port)
+             (make-uri scheme userinfo host port path query fragment)))))
+     (lambda (k)
+       #f)))
+
+(define (unparse-uri uri)
+  (let* ((scheme-str (string-append
+                      (symbol->string (uri-scheme uri)) ":"))
+         (userinfo (uri-userinfo uri))
+         (host (uri-host uri))
+         (port (uri-port uri))
+         (path (uri-path uri))
+         (query (uri-query uri))
+         (fragment (uri-fragment uri)))
+    (string-append
+     scheme-str
+     (if host
+         (string-append "//"
+                        (if userinfo (string-append userinfo "@")
+                            "")
+                        host
+                        (if port
+                            (string-append ":" (number->string port))
+                            ""))
+         "")
+     path
+     (if query
+         (string-append "?" query)
+         "")
+     (if fragment
+         (string-append "#" fragment)
+         ""))))
 
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; A note on characters and bytes: URIs are defined to be sequences of
-;; (url-decode STR)
+;; characters in a subset of ASCII. Those characters may encode a
-;; Turn + into space, and hex-encoded %XX strings into their
+;; sequence of bytes (octets), which in turn may encode sequences of
-;; eight-bit characters.  Is a regexp faster than character
+;; characters in other character sets.
-;; scanning?  Does it incur more overhead (which may be more
+;;
-;; important for code that frequently gets restarted)?
 
-(define-public (url:decode str)
+;; Return a new string made from uri-decoding @var{str}.  Specifically,
-  (regexp-substitute/global
+;; turn @code{+} into space, and hex-encoded @code{%XX} strings into
-   #f "\\+|%([0-9A-Fa-f][0-9A-Fa-f])" str
+;; their eight-bit characters.
-   'pre
+;;
-   (lambda (m)
+(define hex-chars
-     (cond ((string=? "+" (match:substring m 0)) " ")
+  (string->char-set "0123456789abcdefABCDEF"))
-           (else (integer->char
-                  (string->number
-                   (match:substring m 1)
-                   16)))))
-   'post))
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define* (uri-decode str #:key (charset 'utf-8))
-;; (url-encode STR)
+  (let ((len (string-length str)))
-;; The inverse of url-decode.  Can't be done easily with
+    (call-with-values open-bytevector-output-port
-;; a regexp: we would have to construct a regular expression
+      (lambda (port get-bytevector)
-;; like "[\277-\377]", for example, and Guile strings don't
+        (let lp ((i 0))
-;; let you interpolate character literals.  Pity.
+          (if (= i len)
-;;   URL-encode any characters in STR that are not safe: these
+              ((case charset
-;; include any character not in the SAFE-CHARS list and any
+                 ((utf-8) utf8->string)
-;; character that *is* in the RESERVED-CHARS list argument.
+                 ((#f) (lambda (x) x)) ; raw bytevector
+                 (else (error "unknown charset" charset)))
+               (get-bytevector))
+              (let ((ch (string-ref str i)))
+                (cond
+                 ((eqv? ch #\+)
+                  (put-u8 port (char->integer #\space))
+                  (lp (1+ i)))
+                 ((and (< (+ i 2) len) (eqv? ch #\%)
+                       (let ((a (string-ref str (+ i 1)))
+                             (b (string-ref str (+ i 2))))
+                         (and (char-set-contains? hex-chars a)
+                              (char-set-contains? hex-chars b)
+                              (string->number (string a b) 16))))
+                  => (lambda (u8)
+                       (put-u8 port u8)
+                       (lp (+ i 3))))
+                 ((< (char->integer ch) 128)
+                  (put-u8 port (char->integer ch))
+                  (lp (1+ i)))
+                 (else
+                  (error "invalid character in encoded URI" str ch))))))))))
+  
+(define ascii-alnum-chars
+  (string->char-set
+   "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"))
 
-(define-public (url:encode str)
+;; RFC 3986, #2.2.
-  (with-output-to-string
+(define gen-delims
-    (lambda ()
+  (string->char-set ":/?#[]@"))
-      (for-each (lambda (ch)
+(define sub-delims
-		  (if (safe-char? ch)
+  (string->char-set "!$&'()*+,l="))
-		      (display ch)
-		      (begin
-			(display #\%)
-			(display (number->string (char->integer ch) 16)))))
-		(string->list str)))))
-
-(define special-chars
-  (string->list "$-_.+!*'()"))
 (define reserved-chars
-  (string->list ";/?:@&="))
+  (char-set-union gen-delims sub-delims))
 
-(define (safe-char? ch)
+;; RFC 3986, #2.3
-  ;; ``Thus, only alphanumerics, the special characters "$-_.+!*'(),", and
+(define unreserved-chars
-  ;; reserved characters used for their reserved purposes may be used
+  (char-set-union ascii-alnum-chars
-  ;; unencoded within a URL.'' RFC 1738, #2.2.
+                  (string->char-set "-._~")))
-  (or (char-alphabetic? ch)
-      (char-numeric? ch)
-      (memv ch special-chars)))
 
-(define-public (url:path-part path)
+;; Return a new string made from uri-encoding @var{str}, unconditionally
-  (substring path 0 (or (string-index path #\?) (string-length path))))
+;; transforming any characters not in @var{unescaped-chars}.
+;;
+(define* (uri-encode str #:key (charset 'utf-8)
+                     (unescaped-chars unreserved-chars))
+  (define (put-utf8 binary-port str)
+    (put-bytevector binary-port (string->utf8 str)))
 
-(define-public (url:query-part path)
+  ((case charset
-  (let ((q (string-index path #\?)))
+     ((utf-8) utf8->string)
-    (if q (substring path (1+ q)) #f)))
+     ((#f) (lambda (x) x)) ; raw bytevector
+     (else (error "unknown charset" charset)))
+   (call-with-values open-bytevector-output-port
+     (lambda (port get-bytevector)
+       (string-for-each
+        (lambda (ch)
+          (if (char-set-contains? unescaped-chars ch)
+              (put-utf8 port (string ch))
+              (let* ((utf8 (string->utf8 (string ch)))
+                     (len (bytevector-length utf8)))
+                ;; Encode each byte.
+                (let lp ((i 0))
+                  (if (< i len)
+                      (begin
+                        (put-utf8 port (string #\%))
+                        (put-utf8 port
+                                  (number->string (bytevector-u8-ref utf8 i) 16))
+                        (lp (1+ i))))))))
+        str)
+       (get-bytevector)))))
 
-(define-public (url:path-split path)
+(define (split-and-decode-uri-path path)
   (filter (lambda (x) (not (string-null? x)))
-          (map url:decode (string-split (url:path-part path) #\/))))
+          (map uri-decode (string-split path #\/))))
 
-(define-public (url:path-join path)
+(define (encode-and-join-uri-path parts)
-  (string-join (map url:encode path) "/"))
+  (string-join (map uri-encode parts) "/"))
-
-;;; www/url.scm ends here

test-suite/Makefile.am

@@ -148,7 +148,8 @@ SCM_TESTS = tests/00-initial-env.test		\
 	    tests/tree-il.test			\
 	    tests/version.test			\
 	    tests/vlist.test			\
-	    tests/weaks.test
+	    tests/weaks.test			\
+	    tests/web-uri.test
 
 EXTRA_DIST = \
 	guile-test \

test-suite/tests/web-uri.test

@@ -0,0 +1,174 @@
+;;;; web-uri.test --- URI library          -*- mode: scheme; coding: utf-8; -*-
+;;;;
+;;;; 	Copyright (C) 2010 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
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;;
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+
+(define-module (test-web-uri)
+  #:use-module (web uri)
+  #:use-module (test-suite lib))
+
+
+;; FIXME: need more decode / encode tests
+
+
+(define* (uri=? uri #:key scheme userinfo host port path query fragment)
+  (and (uri? uri)
+       (equal? (uri-scheme uri) scheme)
+       (equal? (uri-userinfo uri) userinfo)
+       (equal? (uri-host uri) host)
+       (equal? (uri-port uri) port)
+       (equal? (uri-path uri) path)
+       (equal? (uri-query uri) query)
+       (equal? (uri-fragment uri) fragment)))
+
+(define ex:expected '(misc-error . "expected"))
+
+(with-test-prefix "build-uri"
+  (pass-if "ftp:"
+    (uri=? (build-uri 'ftp)
+           #:scheme 'ftp
+           #:path ""))
+  
+  (pass-if "ftp:foo"
+    (uri=? (build-uri 'ftp #:path "foo")
+           #:scheme 'ftp
+           #:path "foo"))
+  
+  (pass-if "ftp://foo"
+    (uri=? (build-uri 'ftp #:host "foo")
+           #:scheme 'ftp
+           #:host "foo"
+           #:path ""))
+  
+  (pass-if "ftp://foo/bar"
+    (uri=? (build-uri 'ftp #:host "foo" #:path "/bar")
+           #:scheme 'ftp
+           #:host "foo"
+           #:path "/bar"))
+  
+  (pass-if "ftp://foo@bar:22/baz"
+    (uri=? (build-uri 'ftp #:userinfo "foo" #:host "bar" #:port 22 #:path "/baz")
+           #:scheme 'ftp
+           #:userinfo "foo"
+           #:host "bar"
+           #:port 22
+           #:path "/baz"))
+
+  (pass-if-exception "non-symbol scheme"
+                     ex:expected
+                     (build-uri "nonsym"))
+
+  (pass-if-exception "http://bad.host.1"
+                     ex:expected
+                     (build-uri 'http #:host "bad.host.1"))
+
+  (pass-if "http://bad.host.1 (no validation)"
+    (uri=? (build-uri 'http #:host "bad.host.1" #:validate? #f)
+           #:scheme 'http #:host "bad.host.1" #:path ""))
+
+  (pass-if-exception "http://foo:not-a-port"
+                     ex:expected
+                     (build-uri 'http #:host "foo" #:port "not-a-port"))
+
+  (pass-if-exception "http://foo:10 but port as string"
+                     ex:expected
+                     (build-uri 'http #:host "foo" #:port "10"))
+
+  (pass-if-exception "http://:10"
+                     ex:expected
+                     (build-uri 'http #:port 10))
+
+  (pass-if-exception "http://foo@"
+                     ex:expected
+                     (build-uri 'http #:userinfo "foo")))
+
+
+(with-test-prefix "parse-uri"
+  (pass-if "ftp:"
+    (uri=? (parse-uri "ftp:")
+           #:scheme 'ftp
+           #:path ""))
+  
+  (pass-if "ftp:foo"
+    (uri=? (parse-uri "ftp:foo")
+           #:scheme 'ftp
+           #:path "foo"))
+  
+  (pass-if "ftp://foo/bar"
+    (uri=? (parse-uri "ftp://foo/bar")
+           #:scheme 'ftp
+           #:host "foo"
+           #:path "/bar"))
+  
+  (pass-if "ftp://foo@bar:22/baz"
+    (uri=? (parse-uri "ftp://foo@bar:22/baz")
+           #:scheme 'ftp
+           #:userinfo "foo"
+           #:host "bar"
+           #:port 22
+           #:path "/baz"))
+
+  (pass-if "http://bad.host.1"
+    (not (parse-uri "http://bad.host.1")))
+
+  (pass-if "http://foo:"
+    (uri=? (parse-uri "http://foo:")
+           #:scheme 'http #:host "foo" #:path ""))
+
+  (pass-if "http://foo:/"
+    (uri=? (parse-uri "http://foo:/")
+           #:scheme 'http #:host "foo" #:path "/"))
+
+  (pass-if "http://foo:not-a-port"
+    (not (parse-uri "http://foo:not-a-port")))
+  
+  (pass-if "http://:10"
+    (not (parse-uri "http://:10")))
+
+  (pass-if "http://foo@"
+    (not (parse-uri "http://foo@"))))
+
+(with-test-prefix "unparse-uri"
+  (pass-if "ftp:"
+    (equal? "ftp:"
+            (unparse-uri (parse-uri "ftp:"))))
+  
+  (pass-if "ftp:foo"
+    (equal? "ftp:foo"
+            (unparse-uri (parse-uri "ftp:foo"))))
+  
+  (pass-if "ftp://foo/bar"
+    (equal? "ftp://foo/bar"
+            (unparse-uri (parse-uri "ftp://foo/bar"))))
+  
+  (pass-if "ftp://foo@bar:22/baz"
+    (equal? "ftp://foo@bar:22/baz"
+            (unparse-uri (parse-uri "ftp://foo@bar:22/baz"))))
+  
+  (pass-if "http://foo:"
+    (equal? "http://foo"
+            (unparse-uri (parse-uri "http://foo:"))))
+  
+  (pass-if "http://foo:/"
+    (equal? "http://foo/"
+            (unparse-uri (parse-uri "http://foo:/")))))
+
+(with-test-prefix "decode"
+  (pass-if (equal? "foo bar" (uri-decode "foo%20bar"))))
+
+(with-test-prefix "encode"
+  (pass-if (equal? "foo%20bar" (uri-encode "foo bar"))))