bug#26826: user trys to copy spam link but ends up contacting spam site

[npostavs@users.sourceforge.net]

[-- Attachment #1: Type: text/plain, Size: 362 bytes --]

tags 26826 = patch
quit

積丹尼 Dan Jacobson <jidanni@jidanni.org> writes:

> Have the dangerous commands mapped to a different key,
> not piggybacked on a usually safe key.

Here's a patch to split out dwim behaviour into separate commands.  I'm
not sure if we should favour safety or convenience for the default
keybindings.  Thoughts, anyone?


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: patch --]
[-- Type: text/x-diff, Size: 4572 bytes --]

From af9fb0ef26f6624c490d8177599e517ed1799ad5 Mon Sep 17 00:00:00 2001
From: Noam Postavsky <npostavs@gmail.com>
Date: Thu, 11 May 2017 19:40:45 -0400
Subject: [PATCH v1] Split shr-copy-url dwim behavior into separate functions
 (Bug#26826)

* lisp/net/shr.el (shr-url-at-point, shr-probe-url)
(shr-probe-and-copy-url, shr-maybe-probe-and-copy-url): New functions,
split out from `shr-copy-url'.
(shr-copy-url): Only copy the url, don't fetch it.
(shr-map): Bind 'w' and 'u' to `shr-maybe-probe-and-copy-url', which
has the same behavior as the old `shr-copy-url'.
---
 lisp/net/shr.el | 81 ++++++++++++++++++++++++++++++++-------------------------
 1 file changed, 46 insertions(+), 35 deletions(-)

diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index 6b62a05227..2a9283680c 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -185,8 +185,8 @@ shr-map
     (define-key map [follow-link] 'mouse-face)
     (define-key map [mouse-2] 'shr-browse-url)
     (define-key map "I" 'shr-insert-image)
-    (define-key map "w" 'shr-copy-url)
-    (define-key map "u" 'shr-copy-url)
+    (define-key map "w" 'shr-maybe-probe-and-copy-url)
+    (define-key map "u" 'shr-maybe-probe-and-copy-url)
     (define-key map "v" 'shr-browse-url)
     (define-key map "O" 'shr-save-contents)
     (define-key map "\r" 'shr-browse-url)
@@ -290,43 +290,54 @@ shr--remove-blank-lines-at-the-end
         (forward-line 1)
         (delete-region (point) (point-max))))))
 
-(defun shr-copy-url (&optional image-url)
+(defun shr-url-at-point (image-url)
+  "Return the URL under point as a string.
+If IMAGE-URL is non-nil, or there is no link under point, but
+there is an image under point then copy the URL of the image
+under point instead."
+  (if image-url
+      (get-text-property (point) 'image-url)
+    (or (get-text-property (point) 'shr-url)
+        (get-text-property (point) 'image-url))))
+
+(defun shr-copy-url (url)
   "Copy the URL under point to the kill ring.
 If IMAGE-URL (the prefix) is non-nil, or there is no link under
 point, but there is an image under point then copy the URL of the
-image under point instead.
-If called twice, then try to fetch the URL and see whether it
-redirects somewhere else."
+image under point instead."
+  (interactive (list (shr-url-at-point current-prefix-arg)))
+  (if (not url)
+      (message "No URL under point")
+    (setq url (url-encode-url url))
+    (kill-new url)
+    (message "Copied %s" url)))
+
+(defun shr-probe-url (url)
+  "Return URL's redirect destination, if it has one."
   (interactive "P")
-  (let ((url (if image-url
-                 (get-text-property (point) 'image-url)
-               (or (get-text-property (point) 'shr-url)
-                   (get-text-property (point) 'image-url)))))
-    (cond
-     ((not url)
-      (message "No URL under point"))
-     ;; Resolve redirected URLs.
-     ((equal url (car kill-ring))
-      (url-retrieve
-       url
-       (lambda (a)
-	 (when (and (consp a)
-		    (eq (car a) :redirect))
-	   (with-temp-buffer
-	     (insert (cadr a))
-	     (goto-char (point-min))
-	     ;; Remove common tracking junk from the URL.
-	     (when (re-search-forward ".utm_.*" nil t)
-	       (replace-match "" t t))
-	     (message "Copied %s" (buffer-string))
-	     (copy-region-as-kill (point-min) (point-max)))))
-       nil t))
-     ;; Copy the URL to the kill ring.
-     (t
-      (with-temp-buffer
-	(insert (url-encode-url url))
-	(copy-region-as-kill (point-min) (point-max))
-	(message "Copied %s" (buffer-string)))))))
+  (url-retrieve url
+                (lambda (a)
+                  (pcase a
+                    (`(:redirect ,destination)
+                     ;; Remove common tracking junk from the URL.
+                     (replace-regexp-in-string ".utm_.*" "" destination))))
+                nil t))
+
+(defun shr-probe-and-copy-url (url)
+  "Copy the URL under point to the kill ring.
+Like `shr-copy-url', but additionally fetch URL and use its
+redirection destination if it has one."
+  (interactive (list (shr-url-at-point current-prefix-arg)))
+  (shr-copy-url (or (if url (shr-probe-url url)) url)))
+
+(defun shr-maybe-probe-and-copy-url (url)
+  "Copy the URL under point to the kill ring.
+If the URL is already at the front of the kill ring act like
+`shr-probe-and-copy-url', otherwise like `shr-copy-url'."
+  (interactive (list (shr-url-at-point current-prefix-arg)))
+  (if (equal url (car kill-ring))
+      (shr-probe-and-copy-url url)
+    (shr-copy-url url)))
 
 (defun shr-next-link ()
   "Skip to the next link."
-- 
2.11.1