bug#66390: `man' allows to inject arbitrary shell code

[lux <lx@shellcodes.org>]

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

On Tue, 2023-10-10 at 18:21 +0200, Andreas Schwab wrote:
> On Okt 10 2023, lux wrote:
> 
> > +        ;; see Bug#66390
> > +	(mapconcat 'identity
> > +                   (mapcar #'shell-quote-argument
> > +                           (split-string ref " "))
> 
> You need to split on arbitrary sequences of whitespace to not introduce
> spurious empty arguments.
> 

Thanks, I've modified it to (split-string ref "\\s-+").



[-- Attachment #2: 0001-Fix-man.el-code-injection-vulnerability.patch --]
[-- Type: text/x-patch, Size: 2023 bytes --]

From faa49ba78a203d47740280e5c6fd0e075628b507 Mon Sep 17 00:00:00 2001
From: Xi Lu <lx@shellcodes.org>
Date: Tue, 10 Oct 2023 22:20:05 +0800
Subject: [PATCH] Fix man.el code injection vulnerability.

* lisp/man.el (Man-translate-references): Fix code injection.
* test/lisp/man-tests.el (man-tests-Man-translate-references): New.
---
 lisp/man.el            |  6 +++++-
 test/lisp/man-tests.el | 12 ++++++++++++
 2 files changed, 17 insertions(+), 1 deletion(-)

diff --git a/lisp/man.el b/lisp/man.el
index 506d6060269..a95435c7ea0 100644
--- a/lisp/man.el
+++ b/lisp/man.el
@@ -692,7 +692,11 @@ Man-translate-references
       (setq name (match-string 2 ref)
 	    section (match-string 1 ref))))
     (if (string= name "")
-	ref				; Return the reference as is
+        ;; see Bug#66390
+	(mapconcat 'identity
+                   (mapcar #'shell-quote-argument
+                           (split-string ref "\\s-+"))
+                   " ")                 ; Return the reference as is
       (if Man-downcase-section-letters-flag
 	  (setq section (downcase section)))
       (while slist
diff --git a/test/lisp/man-tests.el b/test/lisp/man-tests.el
index e3657d7df8a..1c6dcb63a5c 100644
--- a/test/lisp/man-tests.el
+++ b/test/lisp/man-tests.el
@@ -161,6 +161,18 @@ man-bgproc-filter-buttonize-includes
           (let ((button (button-at (match-beginning 0))))
             (should (and button (eq 'Man-xref-header-file (button-type button))))))))))
 
+(ert-deftest man-tests-Man-translate-references ()
+  (should (equal (Man-translate-references "basename")
+                 "basename"))
+  (should (equal (Man-translate-references "basename(3)")
+                 "3 basename"))
+  (should (equal (Man-translate-references "basename(3v)")
+                 "3v basename"))
+  (should (equal (Man-translate-references ";id")
+                 "\\;id"))
+  (should (equal (Man-translate-references "-k basename")
+                 "-k basename")))
+
 (provide 'man-tests)
 
 ;;; man-tests.el ends here
-- 
2.42.0