Make relative URL parsing and resolution consistent with RFC 3986 (bug#22044)
* test/lisp/url/url-parse-tests.el: Add tests covering url-generic-parse-url.
* test/lisp/url/url-expand-tests.el: Add tests covering url-expand-file-name.
* lisp/url/url-parse.el (url-generic-parse-url): Keep empty fragment
information in URL-struct.
* lisp/url/url-parse.el (url-path-and-query): Do not artificially turn empty
path and query into nil path and query, respectively.
* lisp/url/url-expand.el (url-expander-remove-relative-links): Do not turn
empty path into an absolute ("/") path.
* lisp/url/url-expand.el (url-expand-file-name): Properly resolve
fragment-only URIs. Do not just return them unchanged.
* lisp/url/url-expand.el (url-default-expander): An empty path in the relative
reference URI should not drop the last segment.
This commit is contained in:
Alain Schneble
Lars Ingebrigtsen
parent
1dee11d874
commit
b792ecea17
3 changed files with 142 additions and 44 deletions
|
|
@ -26,32 +26,35 @@
|
|||
(require 'url-parse)
|
||||
|
||||
(defun url-expander-remove-relative-links (name)
|
||||
;; Strip . and .. from pathnames
|
||||
(let ((new (if (not (string-match "^/" name))
|
||||
(concat "/" name)
|
||||
name)))
|
||||
(if (equal name "")
|
||||
;; An empty name is a properly valid relative URL reference/path.
|
||||
""
|
||||
;; Strip . and .. from pathnames
|
||||
(let ((new (if (not (string-match "^/" name))
|
||||
(concat "/" name)
|
||||
name)))
|
||||
|
||||
;; If it ends with a '/.' or '/..', tack on a trailing '/' sot hat
|
||||
;; the tests that follow are not too complicated in terms of
|
||||
;; looking for '..' or '../', etc.
|
||||
(if (string-match "/\\.+$" new)
|
||||
(setq new (concat new "/")))
|
||||
;; If it ends with a '/.' or '/..', tack on a trailing '/' sot hat
|
||||
;; the tests that follow are not too complicated in terms of
|
||||
;; looking for '..' or '../', etc.
|
||||
(if (string-match "/\\.+$" new)
|
||||
(setq new (concat new "/")))
|
||||
|
||||
;; Remove '/./' first
|
||||
(while (string-match "/\\(\\./\\)" new)
|
||||
(setq new (concat (substring new 0 (match-beginning 1))
|
||||
(substring new (match-end 1)))))
|
||||
;; Remove '/./' first
|
||||
(while (string-match "/\\(\\./\\)" new)
|
||||
(setq new (concat (substring new 0 (match-beginning 1))
|
||||
(substring new (match-end 1)))))
|
||||
|
||||
;; Then remove '/../'
|
||||
(while (string-match "/\\([^/]*/\\.\\./\\)" new)
|
||||
(setq new (concat (substring new 0 (match-beginning 1))
|
||||
(substring new (match-end 1)))))
|
||||
;; Then remove '/../'
|
||||
(while (string-match "/\\([^/]*/\\.\\./\\)" new)
|
||||
(setq new (concat (substring new 0 (match-beginning 1))
|
||||
(substring new (match-end 1)))))
|
||||
|
||||
;; Remove cruft at the beginning of the string, so people that put
|
||||
;; in extraneous '..' because they are morons won't lose.
|
||||
(while (string-match "^/\\.\\.\\(/\\)" new)
|
||||
(setq new (substring new (match-beginning 1) nil)))
|
||||
new))
|
||||
;; Remove cruft at the beginning of the string, so people that put
|
||||
;; in extraneous '..' because they are morons won't lose.
|
||||
(while (string-match "^/\\.\\.\\(/\\)" new)
|
||||
(setq new (substring new (match-beginning 1) nil)))
|
||||
new)))
|
||||
|
||||
(defun url-expand-file-name (url &optional default)
|
||||
"Convert URL to a fully specified URL, and canonicalize it.
|
||||
|
|
@ -89,8 +92,6 @@ path components followed by `..' are removed, along with the `..' itself."
|
|||
(cond
|
||||
((= (length url) 0) ; nil or empty string
|
||||
(url-recreate-url default))
|
||||
((string-match "^#" url) ; Offset link, use it raw
|
||||
url)
|
||||
((string-match url-nonrelative-link url) ; Fully-qualified URL, return it immediately
|
||||
url)
|
||||
(t
|
||||
|
|
@ -120,29 +121,24 @@ path components followed by `..' are removed, along with the `..' itself."
|
|||
(setf (url-host urlobj) (or (url-host urlobj) (url-host defobj))))
|
||||
(if (string= "ftp" (url-type urlobj))
|
||||
(setf (url-user urlobj) (or (url-user urlobj) (url-user defobj))))
|
||||
(if (string= (url-filename urlobj) "")
|
||||
(setf (url-filename urlobj) "/"))
|
||||
;; If the object we're expanding from is full, then we are now
|
||||
;; full.
|
||||
(unless (url-fullness urlobj)
|
||||
(setf (url-fullness urlobj) (url-fullness defobj)))
|
||||
(if (string-match "^/" (url-filename urlobj))
|
||||
nil
|
||||
(let ((query nil)
|
||||
(file nil)
|
||||
(sepchar nil))
|
||||
(if (string-match "[?#]" (url-filename urlobj))
|
||||
(setq query (substring (url-filename urlobj) (match-end 0))
|
||||
file (substring (url-filename urlobj) 0 (match-beginning 0))
|
||||
sepchar (substring (url-filename urlobj) (match-beginning 0) (match-end 0)))
|
||||
(setq file (url-filename urlobj)))
|
||||
(let* ((pathandquery (url-path-and-query urlobj))
|
||||
(defpathandquery (url-path-and-query defobj))
|
||||
(file (car pathandquery))
|
||||
(query (or (cdr pathandquery) (and (equal file "") (cdr defpathandquery)))))
|
||||
(if (string-match "^/" (url-filename urlobj))
|
||||
(setq file (url-expander-remove-relative-links file))
|
||||
;; We use concat rather than expand-file-name to combine
|
||||
;; directory and file name, since urls do not follow the same
|
||||
;; rules as local files on all platforms.
|
||||
(setq file (url-expander-remove-relative-links
|
||||
(concat (url-file-directory (url-filename defobj)) file)))
|
||||
(setf (url-filename urlobj)
|
||||
(if query (concat file sepchar query) file))))))
|
||||
(setq file (url-expander-remove-relative-links
|
||||
(if (equal file "")
|
||||
(or (car (url-path-and-query defobj)) "")
|
||||
(concat (url-file-directory (url-filename defobj)) file)))))
|
||||
(setf (url-filename urlobj) (if query (concat file "?" query) file)))))
|
||||
|
||||
(provide 'url-expand)
|
||||
|
||||
|
|
|
|||
|
|
@ -59,8 +59,6 @@ where each of PATH and QUERY are strings or nil."
|
|||
(setq path (substring name 0 (match-beginning 0))
|
||||
query (substring name (match-end 0)))
|
||||
(setq path name)))
|
||||
(if (equal path "") (setq path nil))
|
||||
(if (equal query "") (setq query nil))
|
||||
(cons path query)))
|
||||
|
||||
(defun url-port-if-non-default (urlobj)
|
||||
|
|
@ -217,8 +215,7 @@ parses to
|
|||
(when (looking-at "#")
|
||||
(let ((opoint (point)))
|
||||
(forward-char 1)
|
||||
(unless (eobp)
|
||||
(setq fragment (buffer-substring (point) (point-max))))
|
||||
(setq fragment (buffer-substring (point) (point-max)))
|
||||
(delete-region opoint (point-max)))))
|
||||
|
||||
(if (and host (string-match "%[0-9][0-9]" host))
|
||||
|
|
|
|||
105
test/lisp/url/url-expand-tests.el
Normal file
105
test/lisp/url/url-expand-tests.el
Normal file
|
|
@ -0,0 +1,105 @@
|
|||
;;; url-expand-tests.el --- Test suite for relative URI/URL resolution.
|
||||
|
||||
;; Copyright (C) 2012-2015 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Alain Schneble <a.s@realize.ch>
|
||||
;; Version: 1.0
|
||||
|
||||
;; This file is part of GNU Emacs.
|
||||
|
||||
;; GNU Emacs is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Emacs 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 General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; Test cases covering URI reference resolution as described in RFC3986,
|
||||
;; section 5. Reference Resolution and especially the relative resolution
|
||||
;; rules specified in section 5.2. Relative Resolution.
|
||||
|
||||
;; Each test calls `url-expand-file-name', typically with a relative
|
||||
;; reference URI and a base URI as string and compares the result (Actual)
|
||||
;; against a manually specified URI (Expected)
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'url-expand)
|
||||
(require 'ert)
|
||||
|
||||
(ert-deftest url-expand-file-name/relative-resolution-normal-examples ()
|
||||
"RFC 3986, Section 5.4 Reference Resolution Examples / Section 5.4.1. Normal Examples"
|
||||
(should (equal (url-expand-file-name "g:h" "http://a/b/c/d;p?q") "g:h"))
|
||||
(should (equal (url-expand-file-name "g" "http://a/b/c/d;p?q") "http://a/b/c/g"))
|
||||
(should (equal (url-expand-file-name "./g" "http://a/b/c/d;p?q") "http://a/b/c/g"))
|
||||
(should (equal (url-expand-file-name "g/" "http://a/b/c/d;p?q") "http://a/b/c/g/"))
|
||||
(should (equal (url-expand-file-name "/g" "http://a/b/c/d;p?q") "http://a/g"))
|
||||
(should (equal (url-expand-file-name "//g" "http://a/b/c/d;p?q") "http://g"))
|
||||
(should (equal (url-expand-file-name "?y" "http://a/b/c/d;p?q") "http://a/b/c/d;p?y"))
|
||||
(should (equal (url-expand-file-name "g?y" "http://a/b/c/d;p?q") "http://a/b/c/g?y"))
|
||||
(should (equal (url-expand-file-name "#s" "http://a/b/c/d;p?q") "http://a/b/c/d;p?q#s"))
|
||||
(should (equal (url-expand-file-name "g#s" "http://a/b/c/d;p?q") "http://a/b/c/g#s"))
|
||||
(should (equal (url-expand-file-name "g?y#s" "http://a/b/c/d;p?q") "http://a/b/c/g?y#s"))
|
||||
(should (equal (url-expand-file-name ";x" "http://a/b/c/d;p?q") "http://a/b/c/;x"))
|
||||
(should (equal (url-expand-file-name "g;x" "http://a/b/c/d;p?q") "http://a/b/c/g;x"))
|
||||
(should (equal (url-expand-file-name "g;x?y#s" "http://a/b/c/d;p?q") "http://a/b/c/g;x?y#s"))
|
||||
(should (equal (url-expand-file-name "" "http://a/b/c/d;p?q") "http://a/b/c/d;p?q"))
|
||||
(should (equal (url-expand-file-name "." "http://a/b/c/d;p?q") "http://a/b/c/"))
|
||||
(should (equal (url-expand-file-name "./" "http://a/b/c/d;p?q") "http://a/b/c/"))
|
||||
(should (equal (url-expand-file-name ".." "http://a/b/c/d;p?q") "http://a/b/"))
|
||||
(should (equal (url-expand-file-name "../" "http://a/b/c/d;p?q") "http://a/b/"))
|
||||
(should (equal (url-expand-file-name "../g" "http://a/b/c/d;p?q") "http://a/b/g"))
|
||||
(should (equal (url-expand-file-name "../.." "http://a/b/c/d;p?q") "http://a/"))
|
||||
(should (equal (url-expand-file-name "../../" "http://a/b/c/d;p?q") "http://a/"))
|
||||
(should (equal (url-expand-file-name "../../g" "http://a/b/c/d;p?q") "http://a/g")))
|
||||
|
||||
(ert-deftest url-expand-file-name/relative-resolution-absolute-examples ()
|
||||
"RFC 3986, Section 5.4 Reference Resolution Examples / Section 5.4.2. Abnormal Examples"
|
||||
(should (equal (url-expand-file-name "../../../g" "http://a/b/c/d;p?q") "http://a/g"))
|
||||
(should (equal (url-expand-file-name "../../../../g" "http://a/b/c/d;p?q") "http://a/g"))
|
||||
|
||||
(should (equal (url-expand-file-name "/./g" "http://a/b/c/d;p?q") "http://a/g"))
|
||||
(should (equal (url-expand-file-name "/../g" "http://a/b/c/d;p?q") "http://a/g"))
|
||||
(should (equal (url-expand-file-name "g." "http://a/b/c/d;p?q") "http://a/b/c/g."))
|
||||
(should (equal (url-expand-file-name ".g" "http://a/b/c/d;p?q") "http://a/b/c/.g"))
|
||||
(should (equal (url-expand-file-name "g.." "http://a/b/c/d;p?q") "http://a/b/c/g.."))
|
||||
(should (equal (url-expand-file-name "..g" "http://a/b/c/d;p?q") "http://a/b/c/..g"))
|
||||
|
||||
(should (equal (url-expand-file-name "./../g" "http://a/b/c/d;p?q") "http://a/b/g"))
|
||||
(should (equal (url-expand-file-name "./g/." "http://a/b/c/d;p?q") "http://a/b/c/g/"))
|
||||
(should (equal (url-expand-file-name "g/./h" "http://a/b/c/d;p?q") "http://a/b/c/g/h"))
|
||||
(should (equal (url-expand-file-name "g/../h" "http://a/b/c/d;p?q") "http://a/b/c/h"))
|
||||
(should (equal (url-expand-file-name "g;x=1/./y" "http://a/b/c/d;p?q") "http://a/b/c/g;x=1/y"))
|
||||
(should (equal (url-expand-file-name "g;x=1/../y" "http://a/b/c/d;p?q") "http://a/b/c/y"))
|
||||
|
||||
(should (equal (url-expand-file-name "g?y/./x" "http://a/b/c/d;p?q") "http://a/b/c/g?y/./x"))
|
||||
(should (equal (url-expand-file-name "g?y/../x" "http://a/b/c/d;p?q") "http://a/b/c/g?y/../x"))
|
||||
(should (equal (url-expand-file-name "g#s/./x" "http://a/b/c/d;p?q") "http://a/b/c/g#s/./x"))
|
||||
(should (equal (url-expand-file-name "g#s/../x" "http://a/b/c/d;p?q") "http://a/b/c/g#s/../x"))
|
||||
|
||||
(should (equal (url-expand-file-name "http:g" "http://a/b/c/d;p?q") "http:g")) ; for strict parsers
|
||||
)
|
||||
|
||||
(ert-deftest url-expand-file-name/relative-resolution-additional-examples ()
|
||||
"Reference Resolution Examples / Arbitrary Examples"
|
||||
(should (equal (url-expand-file-name "" "http://host/foobar") "http://host/foobar"))
|
||||
(should (equal (url-expand-file-name "?y" "http://a/b/c/d") "http://a/b/c/d?y"))
|
||||
(should (equal (url-expand-file-name "?y" "http://a/b/c/d/") "http://a/b/c/d/?y"))
|
||||
(should (equal (url-expand-file-name "?y#fragment" "http://a/b/c/d;p?q") "http://a/b/c/d;p?y#fragment"))
|
||||
(should (equal (url-expand-file-name "#bar" "http://host") "http://host#bar"))
|
||||
(should (equal (url-expand-file-name "#bar" "http://host/") "http://host/#bar"))
|
||||
(should (equal (url-expand-file-name "#bar" "http://host/foo") "http://host/foo#bar"))
|
||||
(should (equal (url-expand-file-name "foo#bar" "http://host/foobar") "http://host/foo#bar"))
|
||||
(should (equal (url-expand-file-name "foo#bar" "http://host/foobar/") "http://host/foobar/foo#bar")))
|
||||
|
||||
(provide 'url-expand-tests)
|
||||
|
||||
;;; url-expand-tests.el ends here
|
||||
Loading…
Add table
Reference in a new issue