[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] emacs-25 8dea6fe 1/2: Make relative URL parsing and resolu
|
From: |
Lars Ingebrigtsen |
|
Subject: |
[Emacs-diffs] emacs-25 8dea6fe 1/2: Make relative URL parsing and resolution consistent with RFC 3986 (bug#22044) |
|
Date: |
Sat, 26 Dec 2015 13:53:18 +0000 |
branch: emacs-25
commit 8dea6fe5b5bc2936b046e799ea61afc508e28752
Author: Alain Schneble <address@hidden>
Commit: Lars Ingebrigtsen <address@hidden>
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.
Backport:
(cherry picked from commit b792ecea1715e080ad8e232d3d154b8a25d2edfb)
---
lisp/url/url-expand.el | 84 ++++++++++++++---------------
lisp/url/url-parse.el | 5 +--
test/lisp/url/url-expand-tests.el | 105 +++++++++++++++++++++++++++++++++++++
3 files changed, 146 insertions(+), 48 deletions(-)
diff --git a/lisp/url/url-expand.el b/lisp/url/url-expand.el
index c468a79..600a36d 100644
--- a/lisp/url/url-expand.el
+++ b/lisp/url/url-expand.el
@@ -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 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)))))
-
- ;; 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))
+ (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 "/")))
+
+ ;; 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)))))
+
+ ;; 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)
diff --git a/lisp/url/url-parse.el b/lisp/url/url-parse.el
index dbf0c38..c3159a7 100644
--- a/lisp/url/url-parse.el
+++ b/lisp/url/url-parse.el
@@ -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))
diff --git a/test/lisp/url/url-expand-tests.el
b/test/lisp/url/url-expand-tests.el
new file mode 100644
index 0000000..2bd2868
--- /dev/null
+++ b/test/lisp/url/url-expand-tests.el
@@ -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 <address@hidden>
+;; 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