mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2026-01-04 11:00:45 -08:00
Code Issues Projects Releases Wiki Activity

Make relative URL parsing and resolution consistent with RFC 3986 (bug#22044)

Browse source 
* 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 2015-12-26 00:50:25 +01:00 • committed by Lars Ingebrigtsen
parent 1dee11d874
commit b792ecea17
3 changed files with 142 additions and 44 deletions
Download patch file Download diff file Expand all files Collapse all files

76
lisp/url/url-expand.el
View file

@ -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)

5
lisp/url/url-parse.el
View file

@ -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))