Browse Source

Sanitize link encoding

* lisp/org.el (org-store-link): Improve docstring.
(org-make-link-string): Escape internal links only when absolutely
necessary.
(org-link-escape-chars): Add percent character.
(org-link-escape-chars-browser): Make space character more visible.
(org-link-escape): Refactor code.
(org-display-inline-images): Properly unescape path before creating
the link.
(org-extract-attributes): Remove function.

* lisp/ox.el (org-export-resolve-fuzzy-link): Decode path before
  resolving link.

* testing/lisp/test-ox.el (test-org-export/resolve-fuzzy-link): Add
  test.
Nicolas Goaziou 10 years ago
parent
commit
2c27e85f11
3 changed files with 63 additions and 84 deletions
  1. 56 82
      lisp/org.el
  2. 1 1
      lisp/ox.el
  3. 6 1
      testing/lisp/test-ox.el

+ 56 - 82
lisp/org.el

@@ -9687,16 +9687,16 @@ type.  For a simple example of an export function, see `org-bbdb.el'."
 (defun org-store-link (arg)
 (defun org-store-link (arg)
   "\\<org-mode-map>Store an org-link to the current location.
   "\\<org-mode-map>Store an org-link to the current location.
 This link is added to `org-stored-links' and can later be inserted
 This link is added to `org-stored-links' and can later be inserted
-into an org-buffer with \\[org-insert-link].
+into an Org buffer with \\[org-insert-link].
 
 
-For some link types, a prefix arg is interpreted.
-For links to Usenet articles, arg negates `org-gnus-prefer-web-links'.
-For file links, arg negates `org-context-in-file-links'.
+For some link types, a prefix ARG is interpreted.
+For links to Usenet articles, ARG negates `org-gnus-prefer-web-links'.
+For file links, ARG negates `org-context-in-file-links'.
 
 
-A double prefix arg force skipping storing functions that are not
+A double prefix ARG force skipping storing functions that are not
 part of Org's core.
 part of Org's core.
 
 
-A triple prefix arg force storing a link for each line in the
+A triple prefix ARG force storing a link for each line in the
 active region."
 active region."
   (interactive "P")
   (interactive "P")
   (org-load-modules-maybe)
   (org-load-modules-maybe)
@@ -10006,44 +10006,37 @@ according to FMT (default from `org-email-link-description-format')."
 
 
 (defun org-make-link-string (link &optional description)
 (defun org-make-link-string (link &optional description)
   "Make a link with brackets, consisting of LINK and DESCRIPTION."
   "Make a link with brackets, consisting of LINK and DESCRIPTION."
-  (unless (string-match "\\S-" link)
-    (error "Empty link"))
-  (when (and description
-	     (stringp description)
-	     (not (string-match "\\S-" description)))
-    (setq description nil))
-  (when (stringp description)
-    ;; Remove brackets from the description, they are fatal.
-    (while (string-match "\\[" description)
-      (setq description (replace-match "{" t t description)))
-    (while (string-match "\\]" description)
-      (setq description (replace-match "}" t t description))))
-  (when (equal link description)
-    ;; No description needed, it is identical
-    (setq description nil))
-  (when (and (not description)
-	     (not (string-match (org-image-file-name-regexp) link))
-	     (not (equal link (org-link-escape link))))
-    (setq description (org-extract-attributes link)))
-  (setq link
-	(cond ((string-match (org-image-file-name-regexp) link) link)
-	      ((string-match org-link-types-re link)
-	       (concat (match-string 1 link)
-		       (org-link-escape (substring link (match-end 1)))))
-	      (t (org-link-escape link))))
-  (concat "[[" link "]"
-	  (if description (concat "[" description "]") "")
-	  "]"))
+  (unless (org-string-nw-p link) (error "Empty link"))
+  (let ((uri (cond ((string-match org-link-types-re link)
+		    (concat (match-string 1 link)
+			    (org-link-escape (substring link (match-end 1)))))
+		   ;; For readability, url-encode internal links only
+		   ;; when absolutely needed (i.e, when they contain
+		   ;; square brackets).  File links however, are
+		   ;; encoded since, e.g., spaces are significant.
+		   ((or (file-name-absolute-p link)
+			(org-string-match-p "\\`\\.\\.?/\\|[][]" link))
+		    (org-link-escape link))
+		   (t link)))
+	(description
+	 (and (org-string-nw-p description)
+	      ;; Remove brackets from description, as they are fatal.
+	      (replace-regexp-in-string
+	       "[][]" (lambda (m) (if (equal "[" m) "{" "}"))
+	       (org-trim description)))))
+    (format "[[%s]%s]"
+	    uri
+	    (if description (format "[%s]" description) ""))))
 
 
 (defconst org-link-escape-chars
 (defconst org-link-escape-chars
-  ;;%20 %5B %5D
-  '(?\  ?\[ ?\])
+  ;;%20 %5B %5D %25
+  '(?\s ?\[ ?\] ?%)
   "List of characters that should be escaped in a link when stored to Org.
   "List of characters that should be escaped in a link when stored to Org.
 This is the list that is used for internal purposes.")
 This is the list that is used for internal purposes.")
 
 
 (defconst org-link-escape-chars-browser
 (defconst org-link-escape-chars-browser
   ;;%20 %22
   ;;%20 %22
-  '(?\  ?\")
+  '(?\s ?\")
   "List of characters to be escaped before handing over to the browser.
   "List of characters to be escaped before handing over to the browser.
 If you consider using this constant then you probably want to use
 If you consider using this constant then you probably want to use
 the function `org-link-escape-browser' instead.  See there why
 the function `org-link-escape-browser' instead.  See there why
@@ -10057,28 +10050,20 @@ Optional argument TABLE is a list with characters that should be
 escaped.  When nil, `org-link-escape-chars' is used.
 escaped.  When nil, `org-link-escape-chars' is used.
 If optional argument MERGE is set, merge TABLE into
 If optional argument MERGE is set, merge TABLE into
 `org-link-escape-chars'."
 `org-link-escape-chars'."
-  ;; Don't escape chars in internal links
-  (if (string-match "^\\*[[:alnum:]]+" text)
-      text
-    (cond
-     ((and table merge)
-      (mapc (lambda (defchr)
-	      (unless (member defchr table)
-		(setq table (cons defchr table))))
-	    org-link-escape-chars))
-     ((null table)
-      (setq table org-link-escape-chars)))
+  (let ((characters-to-encode
+	 (cond ((null table) org-link-escape-chars)
+	       (merge (append org-link-escape-chars table))
+	       (t table))))
     (mapconcat
     (mapconcat
-     (lambda (char)
-       (if (or (member char table)
-	       (and (or (< char 32) (= char ?\%) (> char 126))
-		    org-url-hexify-p))
-	   (mapconcat (lambda (sequence-element)
-			(format "%%%.2X" sequence-element))
-		      (or (encode-coding-char char 'utf-8)
-			  (error "Unable to percent escape character: %s"
-				 (char-to-string char))) "")
-	 (char-to-string char))) text "")))
+     (lambda (c)
+       (if (or (memq c characters-to-encode)
+	       (and org-url-hexify-p (or (< c 32) (> c 126))))
+	   (mapconcat (lambda (e) (format "%%%.2X" e))
+		      (or (encode-coding-char c 'utf-8)
+			  (error "Unable to percent escape character: %c" c))
+		      "")
+	 (char-to-string c)))
+     text "")))
 
 
 (defun org-link-escape-browser (text)
 (defun org-link-escape-browser (text)
   "Escape some characters before handing over to the browser.
   "Escape some characters before handing over to the browser.
@@ -10512,19 +10497,6 @@ Should be called like `completing-read'."
 		    (t #'completing-read))
 		    (t #'completing-read))
 	      args)))))
 	      args)))))
 
 
-(defun org-extract-attributes (s)
-  "Extract the attributes cookie from a string and set as text property."
-  (let (a attr (start 0) key value)
-    (save-match-data
-      (when (string-match "{{\\([^}]+\\)}}$" s)
-	(setq a (match-string 1 s) s (substring s 0 (match-beginning 0)))
-	(while (string-match "\\([a-zA-Z]+\\)=\"\\([^\"]*\\)\"" a start)
-	  (setq key (match-string 1 a) value (match-string 2 a)
-		start (match-end 0)
-		attr (plist-put attr (intern key) value))))
-      (org-add-props s nil 'org-attr attr))
-    s))
-
 ;;; Opening/following a link
 ;;; Opening/following a link
 
 
 (defvar org-link-search-failed nil)
 (defvar org-link-search-failed nil)
@@ -19527,7 +19499,9 @@ boundaries."
 			    (not (cdr (org-element-contents parent)))))
 			    (not (cdr (org-element-contents parent)))))
 		      (org-string-match-p file-extension-re
 		      (org-string-match-p file-extension-re
 					  (org-element-property :path link)))
 					  (org-element-property :path link)))
-	     (let ((file (expand-file-name (org-element-property :path link))))
+	     (let ((file (expand-file-name
+			  (org-link-unescape
+			   (org-element-property :path link)))))
 	       (when (file-exists-p file)
 	       (when (file-exists-p file)
 		 (let ((width
 		 (let ((width
 			;; Apply `org-image-actual-width' specifications.
 			;; Apply `org-image-actual-width' specifications.
@@ -19549,13 +19523,13 @@ boundaries."
 			     (when paragraph
 			     (when paragraph
 			       (save-excursion
 			       (save-excursion
 				 (goto-char (org-element-property :begin paragraph))
 				 (goto-char (org-element-property :begin paragraph))
-				   (when
-				       (re-search-forward
-					"^[ \t]*#\\+attr_.*?: +.*?:width +\\(\\S-+\\)"
-					(org-element-property
-					 :post-affiliated paragraph)
-					t)
-				     (string-to-number (match-string 1))))))
+				 (when
+				     (re-search-forward
+				      "^[ \t]*#\\+attr_.*?: +.*?:width +\\(\\S-+\\)"
+				      (org-element-property
+				       :post-affiliated paragraph)
+				      t)
+				   (string-to-number (match-string 1))))))
 			   ;; Otherwise, fall-back to provided number.
 			   ;; Otherwise, fall-back to provided number.
 			   (car org-image-actual-width)))
 			   (car org-image-actual-width)))
 			 ((numberp org-image-actual-width)
 			 ((numberp org-image-actual-width)
@@ -19566,9 +19540,9 @@ boundaries."
 		   (if (and (car-safe old) refresh)
 		   (if (and (car-safe old) refresh)
 		       (image-refresh (overlay-get (cdr old) 'display))
 		       (image-refresh (overlay-get (cdr old) 'display))
 		     (let ((image (create-image file
 		     (let ((image (create-image file
-						  (and width 'imagemagick)
-						  nil
-						  :width width)))
+						(and width 'imagemagick)
+						nil
+						:width width)))
 		       (when image
 		       (when image
 			 (let* ((link
 			 (let* ((link
 				 ;; If inline image is the description
 				 ;; If inline image is the description

+ 1 - 1
lisp/ox.el

@@ -4031,7 +4031,7 @@ Return value can be an object, an element, or nil:
 
 
 Assume LINK type is \"fuzzy\".  White spaces are not
 Assume LINK type is \"fuzzy\".  White spaces are not
 significant."
 significant."
-  (let* ((raw-path (org-element-property :path link))
+  (let* ((raw-path (org-link-unescape (org-element-property :path link)))
 	 (match-title-p (eq (string-to-char raw-path) ?*))
 	 (match-title-p (eq (string-to-char raw-path) ?*))
 	 ;; Split PATH at white spaces so matches are space
 	 ;; Split PATH at white spaces so matches are space
 	 ;; insensitive.
 	 ;; insensitive.

+ 6 - 1
testing/lisp/test-ox.el

@@ -2545,7 +2545,12 @@ Another text. (ref:text)
        (org-test-with-parsed-data "[[hl]]\n* hl"
        (org-test-with-parsed-data "[[hl]]\n* hl"
 	 (org-element-type
 	 (org-element-type
 	  (org-export-resolve-fuzzy-link
 	  (org-export-resolve-fuzzy-link
-	   (org-element-map tree 'link 'identity info t) info))))))
+	   (org-element-map tree 'link 'identity info t) info)))))
+  ;; Handle url-encoded fuzzy links.
+  (should
+   (org-test-with-parsed-data "* A B\n[[A%20B]]"
+     (org-export-resolve-fuzzy-link
+      (org-element-map tree 'link #'identity info t) info))))
 
 
 (ert-deftest test-org-export/resolve-id-link ()
 (ert-deftest test-org-export/resolve-id-link ()
   "Test `org-export-resolve-id-link' specifications."
   "Test `org-export-resolve-id-link' specifications."