GNU bug report logs - #39980
[PATCH] gnus-shorten-url: Improve and avoid args-out-of-range error

Previous Next

Full log

View this message in rfc822 format

From: help-debbugs <at> gnu.org (GNU bug Tracking System)
To: Štěpán Němec
 <stepnem <at> gmail.com>
Cc: tracker <at> debbugs.gnu.org
Subject: bug#39980: closed ([PATCH] gnus-shorten-url: Improve and avoid
 args-out-of-range error)
Date: Mon, 13 Apr 2020 10:32:01 +0000

[Message part 1 (text/plain, inline)]

Your message dated Mon, 13 Apr 2020 12:31:37 +0200
with message-id <874ktnbrsm.fsf <at> gmail.com>
and subject line Re: bug#39980: [PATCH] gnus-shorten-url: Improve and avoid args-out-of-range error
has caused the debbugs.gnu.org bug report #39980,
regarding [PATCH] gnus-shorten-url: Improve and avoid args-out-of-range error
to be marked as done.

(If you believe you have received this mail in error, please contact
help-debbugs <at> gnu.org.)


-- 
39980: http://debbugs.gnu.org/cgi/bugreport.cgi?bug=39980
GNU Bug Tracking System
Contact help-debbugs <at> gnu.org with problems

[Message part 2 (message/rfc822, inline)]

From: Štěpán Němec <stepnem <at> gmail.com>
To: bug-gnu-emacs <at> gnu.org
Subject: [PATCH] gnus-shorten-url: Improve and avoid args-out-of-range error
Date: Sun,  8 Mar 2020 10:06:30 +0100

'gnus-shorten-url' (used by 'gnus-summary-browse-url') ignored
fragment identifiers and didn't check substring bounds, in some cases
leading to runtime errors, e.g.:

  (gnus-shorten-url "https://some.url.with/path/and#also_a_long_target" 40)
  ;; => Lisp error: (args-out-of-range "/path/and" -18 nil)

This commit makes it account for #fragments and fixes faulty string
computation, reusing existing helper function.

* lisp/vc/ediff-init.el
(ediff-truncate-string-left): Rename to 'string-truncate-left'.
* lisp/emacs-lisp/subr-x.el (string-truncate-left): Move here.
* lisp/vc/ediff-mult.el (ediff-meta-insert-file-info1) (ediff-draw-dir-diffs):
'ediff-draw-dir-diffs' renamed to 'string-truncate-left'.
* lisp/gnus/gnus-sum.el (gnus-shorten-url): Fix args-out-of-range
error, don't drop #fragments, use 'string-truncate-left'.
---
 lisp/emacs-lisp/subr-x.el |  8 ++++++++
 lisp/gnus/gnus-sum.el     | 14 +++++++-------
 lisp/vc/ediff-init.el     | 10 ----------
 lisp/vc/ediff-mult.el     | 10 ++++++----
 4 files changed, 21 insertions(+), 21 deletions(-)

diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el
index 044c9aada0..baf20131cc 100644
--- a/lisp/emacs-lisp/subr-x.el
+++ b/lisp/emacs-lisp/subr-x.el
@@ -236,6 +236,14 @@ string-trim
 TRIM-LEFT and TRIM-RIGHT default to \"[ \\t\\n\\r]+\"."
   (string-trim-left (string-trim-right string trim-right) trim-left))
 
+(defsubst string-truncate-left (string length)
+  "Truncate STRING to LENGTH, replacing initial surplus with \"...\"."
+  (let ((strlen (length string)))
+    (if (<= strlen length)
+	string
+      (setq length (max 0 (- length 3)))
+      (concat "..." (substring string (max 0 (- strlen 1 length)))))))
+
 (defsubst string-blank-p (string)
   "Check whether STRING is either empty or only whitespace.
 The following characters count as whitespace here: space, tab, newline and
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index a47e657623..6f367692dd 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -9494,15 +9494,15 @@ gnus-collect-urls
     (delete-dups urls)))
 
 (defun gnus-shorten-url (url max)
-  "Return an excerpt from URL."
+  "Return an excerpt from URL not exceeding MAX characters."
   (if (<= (length url) max)
       url
-    (let ((parsed (url-generic-parse-url url)))
-      (concat (url-host parsed)
-	      "..."
-	      (substring (url-filename parsed)
-			 (- (length (url-filename parsed))
-			    (max (- max (length (url-host parsed))) 0)))))))
+    (let* ((parsed (url-generic-parse-url url))
+           (host (url-host parsed))
+           (rest (concat (url-filename parsed)
+                         (when-let ((target (url-target parsed)))
+                           (concat "#" target)))))
+      (concat host (string-truncate-left rest (- max (length host)))))))
 
 (defun gnus-summary-browse-url (&optional external)
   "Scan the current article body for links, and offer to browse them.
diff --git a/lisp/vc/ediff-init.el b/lisp/vc/ediff-init.el
index cbd8c0d322..c7498064dc 100644
--- a/lisp/vc/ediff-init.el
+++ b/lisp/vc/ediff-init.el
@@ -1524,16 +1524,6 @@ ediff-strip-last-dir
 	(setq dir (substring dir 0 pos)))
     (ediff-abbreviate-file-name (file-name-directory dir))))
 
-(defun ediff-truncate-string-left (str newlen)
-  ;; leave space for ... on the left
-  (let ((len (length str))
-	substr)
-    (if (<= len newlen)
-	str
-      (setq newlen (max 0 (- newlen 3)))
-      (setq substr (substring str (max 0 (- len 1 newlen))))
-      (concat "..." substr))))
-
 (defsubst ediff-nonempty-string-p (string)
   (and (stringp string) (not (string= string ""))))
 
diff --git a/lisp/vc/ediff-mult.el b/lisp/vc/ediff-mult.el
index fee87e8352..5dcb42eb64 100644
--- a/lisp/vc/ediff-mult.el
+++ b/lisp/vc/ediff-mult.el
@@ -113,6 +113,8 @@ ediff-mult
 (require 'ediff-wind)
 (require 'ediff-util)
 
+(eval-when-compile
+  (require 'subr-x))                    ; string-truncate-left
 
 ;; meta-buffer
 (ediff-defvar-local ediff-meta-buffer nil "")
@@ -1172,7 +1174,7 @@ ediff-meta-insert-file-info1
 	  ;; abbreviate the file name, if file exists
 	  (if (and (not (stringp fname)) (< file-size -1))
 	      "-------"		; file doesn't exist
-	    (ediff-truncate-string-left
+	    (string-truncate-left
 	     (ediff-abbreviate-file-name fname)
 	     max-filename-width)))))))
 
@@ -1266,7 +1268,7 @@ ediff-draw-dir-diffs
 	(if (= (mod membership-code ediff-membership-code1) 0) ; dir1
 	    (let ((beg (point)))
 	      (insert (format "%-27s"
-			      (ediff-truncate-string-left
+			      (string-truncate-left
 			       (ediff-abbreviate-file-name
 				(if (file-directory-p (concat dir1 file))
 				    (file-name-as-directory file)
@@ -1281,7 +1283,7 @@ ediff-draw-dir-diffs
 	(if (= (mod membership-code ediff-membership-code2) 0) ; dir2
 	    (let ((beg (point)))
 	      (insert (format "%-26s"
-			      (ediff-truncate-string-left
+			      (string-truncate-left
 			       (ediff-abbreviate-file-name
 				(if (file-directory-p (concat dir2 file))
 				    (file-name-as-directory file)
@@ -1295,7 +1297,7 @@ ediff-draw-dir-diffs
 	    (if (= (mod membership-code ediff-membership-code3) 0) ; dir3
 		(let ((beg (point)))
 		  (insert (format " %-25s"
-				  (ediff-truncate-string-left
+				  (string-truncate-left
 				   (ediff-abbreviate-file-name
 				    (if (file-directory-p (concat dir3 file))
 					(file-name-as-directory file)
-- 
2.25.1

[Message part 3 (message/rfc822, inline)]

From: Štěpán Němec <stepnem <at> gmail.com>
To: Eli Zaretskii <eliz <at> gnu.org>
Cc: larsi <at> gnus.org, 39980-done <at> debbugs.gnu.org
Subject: Re: bug#39980: [PATCH] gnus-shorten-url: Improve and avoid
 args-out-of-range error
Date: Mon, 13 Apr 2020 12:31:37 +0200

On Mon, 13 Apr 2020 07:26:45 +0300
Eli Zaretskii wrote:

> Thanks, this is OK for emacs-27.

Pushed to emacs-27 as

2020-04-12T19:57:59+02:00!stepnem <at> gmail.com
81d07da788 (gnus-shorten-url: Improve and avoid args-out-of-range error)
https://git.sv.gnu.org/cgit/emacs.git/commit/?id=81d07da788

and master as

2020-03-07T18:26:44+01:00!stepnem <at> gmail.com
188bd80a90 (gnus-shorten-url: Improve and avoid args-out-of-range error)
https://git.sv.gnu.org/cgit/emacs.git/commit/?id=188bd80a90

>> ; Do not merge to master, where the helper is put to subr-x.el.
>
> No need to precede this with a semi-colon, I think.

I saw it done in some other commit messages and thought it was a good
way to distinguish this as a meta instruction, as opposed to the commit
message proper. I have removed it.

Thanks,

  Štěpán

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.