diff options
| -rw-r--r-- | module/web/uri.scm | 20 | ||||
| -rw-r--r-- | test-suite/tests/web-uri.test | 19 |
2 files changed, 29 insertions, 10 deletions
diff --git a/module/web/uri.scm b/module/web/uri.scm index 6f9377c19..67ecbaeb2 100644 --- a/module/web/uri.scm +++ b/module/web/uri.scm @@ -125,14 +125,18 @@ consistency checks to make sure that the constructed URI is valid." 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)))) + (if (equal? authority "//") + ;; Allow empty authorities: file:///etc/hosts is a synonym of + ;; file:/etc/hosts. + (values #f #f #f) + (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))))) ;;; RFC 3986, #3. diff --git a/test-suite/tests/web-uri.test b/test-suite/tests/web-uri.test index 534380af7..9118eea4b 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 Free Software Foundation, Inc. +;;;; Copyright (C) 2010, 2011 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 @@ -150,7 +150,22 @@ (not (string->uri "http://:10"))) (pass-if "http://foo@" - (not (string->uri "http://foo@")))) + (not (string->uri "http://foo@"))) + + (pass-if "file:/" + (uri=? (string->uri "file:/") + #:scheme 'file + #:path "/")) + + (pass-if "file:/etc/hosts" + (uri=? (string->uri "file:/etc/hosts") + #:scheme 'file + #:path "/etc/hosts")) + + (pass-if "file:///etc/hosts" + (uri=? (string->uri "file:///etc/hosts") + #:scheme 'file + #:path "/etc/hosts"))) (with-test-prefix "uri->string" (pass-if "ftp:" |