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>
Subject: bug#39980: closed (Re: bug#39980: [PATCH] gnus-shorten-url:
 Improve and avoid args-out-of-range error)
Date: Mon, 13 Apr 2020 10:32:02 +0000

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

Your bug report

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

which was filed against the emacs package, has been closed.

The explanation is attached below, along with your original report.
If you require more details, please reply to 39980 <at> debbugs.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: 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

[Message part 3 (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

Previous Next

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