diff options
| author | Alain Schneble | 2015-12-26 00:50:25 +0100 |
|---|---|---|
| committer | Lars Ingebrigtsen | 2015-12-26 00:50:25 +0100 |
| commit | b792ecea1715e080ad8e232d3d154b8a25d2edfb (patch) | |
| tree | 5b0408a86822ea31104518f6d730ec886e86645e /lisp | |
| parent | 1dee11d874de5ff3d5634e1629054c4398b27b72 (diff) | |
| download | emacs-b792ecea1715e080ad8e232d3d154b8a25d2edfb.tar.gz emacs-b792ecea1715e080ad8e232d3d154b8a25d2edfb.zip | |
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.
Diffstat (limited to 'lisp')
| -rw-r--r-- | lisp/url/url-expand.el | 84 | ||||
| -rw-r--r-- | lisp/url/url-parse.el | 5 |
2 files changed, 41 insertions, 48 deletions
diff --git a/lisp/url/url-expand.el b/lisp/url/url-expand.el index c468a7952ec..600a36dc73d 100644 --- a/lisp/url/url-expand.el +++ b/lisp/url/url-expand.el | |||
| @@ -26,32 +26,35 @@ | |||
| 26 | (require 'url-parse) | 26 | (require 'url-parse) |
| 27 | 27 | ||
| 28 | (defun url-expander-remove-relative-links (name) | 28 | (defun url-expander-remove-relative-links (name) |
| 29 | ;; Strip . and .. from pathnames | 29 | (if (equal name "") |
| 30 | (let ((new (if (not (string-match "^/" name)) | 30 | ;; An empty name is a properly valid relative URL reference/path. |
| 31 | (concat "/" name) | 31 | "" |
| 32 | name))) | 32 | ;; Strip . and .. from pathnames |
| 33 | 33 | (let ((new (if (not (string-match "^/" name)) | |
| 34 | ;; If it ends with a '/.' or '/..', tack on a trailing '/' sot hat | 34 | (concat "/" name) |
| 35 | ;; the tests that follow are not too complicated in terms of | 35 | name))) |
| 36 | ;; looking for '..' or '../', etc. | 36 | |
| 37 | (if (string-match "/\\.+$" new) | 37 | ;; If it ends with a '/.' or '/..', tack on a trailing '/' sot hat |
| 38 | (setq new (concat new "/"))) | 38 | ;; the tests that follow are not too complicated in terms of |
| 39 | 39 | ;; looking for '..' or '../', etc. | |
| 40 | ;; Remove '/./' first | 40 | (if (string-match "/\\.+$" new) |
| 41 | (while (string-match "/\\(\\./\\)" new) | 41 | (setq new (concat new "/"))) |
| 42 | (setq new (concat (substring new 0 (match-beginning 1)) | 42 | |
| 43 | (substring new (match-end 1))))) | 43 | ;; Remove '/./' first |
| 44 | 44 | (while (string-match "/\\(\\./\\)" new) | |
| 45 | ;; Then remove '/../' | 45 | (setq new (concat (substring new 0 (match-beginning 1)) |
| 46 | (while (string-match "/\\([^/]*/\\.\\./\\)" new) | 46 | (substring new (match-end 1))))) |
| 47 | (setq new (concat (substring new 0 (match-beginning 1)) | 47 | |
| 48 | (substring new (match-end 1))))) | 48 | ;; Then remove '/../' |
| 49 | 49 | (while (string-match "/\\([^/]*/\\.\\./\\)" new) | |
| 50 | ;; Remove cruft at the beginning of the string, so people that put | 50 | (setq new (concat (substring new 0 (match-beginning 1)) |
| 51 | ;; in extraneous '..' because they are morons won't lose. | 51 | (substring new (match-end 1))))) |
| 52 | (while (string-match "^/\\.\\.\\(/\\)" new) | 52 | |
| 53 | (setq new (substring new (match-beginning 1) nil))) | 53 | ;; Remove cruft at the beginning of the string, so people that put |
| 54 | new)) | 54 | ;; in extraneous '..' because they are morons won't lose. |
| 55 | (while (string-match "^/\\.\\.\\(/\\)" new) | ||
| 56 | (setq new (substring new (match-beginning 1) nil))) | ||
| 57 | new))) | ||
| 55 | 58 | ||
| 56 | (defun url-expand-file-name (url &optional default) | 59 | (defun url-expand-file-name (url &optional default) |
| 57 | "Convert URL to a fully specified URL, and canonicalize it. | 60 | "Convert URL to a fully specified URL, and canonicalize it. |
| @@ -89,8 +92,6 @@ path components followed by `..' are removed, along with the `..' itself." | |||
| 89 | (cond | 92 | (cond |
| 90 | ((= (length url) 0) ; nil or empty string | 93 | ((= (length url) 0) ; nil or empty string |
| 91 | (url-recreate-url default)) | 94 | (url-recreate-url default)) |
| 92 | ((string-match "^#" url) ; Offset link, use it raw | ||
| 93 | url) | ||
| 94 | ((string-match url-nonrelative-link url) ; Fully-qualified URL, return it immediately | 95 | ((string-match url-nonrelative-link url) ; Fully-qualified URL, return it immediately |
| 95 | url) | 96 | url) |
| 96 | (t | 97 | (t |
| @@ -120,29 +121,24 @@ path components followed by `..' are removed, along with the `..' itself." | |||
| 120 | (setf (url-host urlobj) (or (url-host urlobj) (url-host defobj)))) | 121 | (setf (url-host urlobj) (or (url-host urlobj) (url-host defobj)))) |
| 121 | (if (string= "ftp" (url-type urlobj)) | 122 | (if (string= "ftp" (url-type urlobj)) |
| 122 | (setf (url-user urlobj) (or (url-user urlobj) (url-user defobj)))) | 123 | (setf (url-user urlobj) (or (url-user urlobj) (url-user defobj)))) |
| 123 | (if (string= (url-filename urlobj) "") | ||
| 124 | (setf (url-filename urlobj) "/")) | ||
| 125 | ;; If the object we're expanding from is full, then we are now | 124 | ;; If the object we're expanding from is full, then we are now |
| 126 | ;; full. | 125 | ;; full. |
| 127 | (unless (url-fullness urlobj) | 126 | (unless (url-fullness urlobj) |
| 128 | (setf (url-fullness urlobj) (url-fullness defobj))) | 127 | (setf (url-fullness urlobj) (url-fullness defobj))) |
| 129 | (if (string-match "^/" (url-filename urlobj)) | 128 | (let* ((pathandquery (url-path-and-query urlobj)) |
| 130 | nil | 129 | (defpathandquery (url-path-and-query defobj)) |
| 131 | (let ((query nil) | 130 | (file (car pathandquery)) |
| 132 | (file nil) | 131 | (query (or (cdr pathandquery) (and (equal file "") (cdr defpathandquery))))) |
| 133 | (sepchar nil)) | 132 | (if (string-match "^/" (url-filename urlobj)) |
| 134 | (if (string-match "[?#]" (url-filename urlobj)) | 133 | (setq file (url-expander-remove-relative-links file)) |
| 135 | (setq query (substring (url-filename urlobj) (match-end 0)) | ||
| 136 | file (substring (url-filename urlobj) 0 (match-beginning 0)) | ||
| 137 | sepchar (substring (url-filename urlobj) (match-beginning 0) (match-end 0))) | ||
| 138 | (setq file (url-filename urlobj))) | ||
| 139 | ;; We use concat rather than expand-file-name to combine | 134 | ;; We use concat rather than expand-file-name to combine |
| 140 | ;; directory and file name, since urls do not follow the same | 135 | ;; directory and file name, since urls do not follow the same |
| 141 | ;; rules as local files on all platforms. | 136 | ;; rules as local files on all platforms. |
| 142 | (setq file (url-expander-remove-relative-links | 137 | (setq file (url-expander-remove-relative-links |
| 143 | (concat (url-file-directory (url-filename defobj)) file))) | 138 | (if (equal file "") |
| 144 | (setf (url-filename urlobj) | 139 | (or (car (url-path-and-query defobj)) "") |
| 145 | (if query (concat file sepchar query) file)))))) | 140 | (concat (url-file-directory (url-filename defobj)) file))))) |
| 141 | (setf (url-filename urlobj) (if query (concat file "?" query) file))))) | ||
| 146 | 142 | ||
| 147 | (provide 'url-expand) | 143 | (provide 'url-expand) |
| 148 | 144 | ||
diff --git a/lisp/url/url-parse.el b/lisp/url/url-parse.el index dbf0c386871..c3159a7e103 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." | |||
| 59 | (setq path (substring name 0 (match-beginning 0)) | 59 | (setq path (substring name 0 (match-beginning 0)) |
| 60 | query (substring name (match-end 0))) | 60 | query (substring name (match-end 0))) |
| 61 | (setq path name))) | 61 | (setq path name))) |
| 62 | (if (equal path "") (setq path nil)) | ||
| 63 | (if (equal query "") (setq query nil)) | ||
| 64 | (cons path query))) | 62 | (cons path query))) |
| 65 | 63 | ||
| 66 | (defun url-port-if-non-default (urlobj) | 64 | (defun url-port-if-non-default (urlobj) |
| @@ -217,8 +215,7 @@ parses to | |||
| 217 | (when (looking-at "#") | 215 | (when (looking-at "#") |
| 218 | (let ((opoint (point))) | 216 | (let ((opoint (point))) |
| 219 | (forward-char 1) | 217 | (forward-char 1) |
| 220 | (unless (eobp) | 218 | (setq fragment (buffer-substring (point) (point-max))) |
| 221 | (setq fragment (buffer-substring (point) (point-max)))) | ||
| 222 | (delete-region opoint (point-max))))) | 219 | (delete-region opoint (point-max))))) |
| 223 | 220 | ||
| 224 | (if (and host (string-match "%[0-9][0-9]" host)) | 221 | (if (and host (string-match "%[0-9][0-9]" host)) |