master b95bb644ec2 01/15: Fix command-line parsing regression in erc-cmd-DCC

[F. Jason Park]

branch: master
commit b95bb644ec2b9bb9b0aa3ba2a88c828c3c33705a
Author: F. Jason Park <jp@neverwas.me>
Commit: F. Jason Park <jp@neverwas.me>

    Fix command-line parsing regression in erc-cmd-DCC
    
    * lisp/erc/erc-compat.el (erc-compat--28-split-string-shell-command,
    erc-compat--split-string-shell-command): Remove unused function and
    macro.
    * lisp/erc/erc-dcc.el (erc-cmd-DCC): Use own arg-parsing function.
    * lisp/erc/erc.el (erc--shell-parse-regexp,
    erc--split-string-shell-cmd): New regexp constant and arg-parsing
    function based on those in shell.el.
    * test/lisp/erc/erc-dcc-tests.el
    (erc-dcc-tests--erc-dcc-do-GET-command): Accept new `nuh' argument
    representing message source/sender.
    (erc-dcc-do-GET-command): Add tests for regression involving pipe
    character.
    * test/lisp/erc/erc-tests.el (erc--split-string-shell-cmd): New test.
    (Bug#62444)
    
    Thanks to Fernando de Morais for reporting this bug.
---
 lisp/erc/erc-compat.el         | 21 -------------------
 lisp/erc/erc-dcc.el            |  2 +-
 lisp/erc/erc.el                | 36 +++++++++++++++++++++++++++++++++
 test/lisp/erc/erc-dcc-tests.el | 23 ++++++++++++++-------
 test/lisp/erc/erc-tests.el     | 46 ++++++++++++++++++++++++++++++++++++++++++
 5 files changed, 99 insertions(+), 29 deletions(-)

diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el
index 29892b78a39..f451aaee754 100644
--- a/lisp/erc/erc-compat.el
+++ b/lisp/erc/erc-compat.el
@@ -445,27 +445,6 @@ If START or END is negative, it counts from the end."
                        existing))))))
 
 
-;;;; Misc 28.1
-
-(defvar comint-file-name-quote-list)
-(defvar shell-file-name-quote-list)
-(declare-function shell--parse-pcomplete-arguments "shell" nil)
-
-(defun erc-compat--28-split-string-shell-command (string)
-  (require 'comint)
-  (require 'shell)
-  (with-temp-buffer
-    (insert string)
-    (let ((comint-file-name-quote-list shell-file-name-quote-list))
-      (car (shell--parse-pcomplete-arguments)))))
-
-(defmacro erc-compat--split-string-shell-command (string)
-  ;; Autoloaded in Emacs 28.
-  (list (if (fboundp 'split-string-shell-command)
-            'split-string-shell-command
-          'erc-compat--28-split-string-shell-command)
-        string))
-
 (provide 'erc-compat)
 
 ;;; erc-compat.el ends here
diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el
index cc2dcc9a788..f05ae41fc51 100644
--- a/lisp/erc/erc-dcc.el
+++ b/lisp/erc/erc-dcc.el
@@ -399,7 +399,7 @@ where FOO is one of CLOSE, GET, SEND, LIST, CHAT, etc."
     (if compat-args
         (setq cmd line
               args compat-args)
-      (setq args (delete "" (erc-compat--split-string-shell-command line))
+      (setq args (delete "" (erc--split-string-shell-cmd line))
             cmd (pop args)))
     (let ((fn (intern-soft (concat "erc-dcc-do-" (upcase cmd) "-command"))))
       (if fn
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index e23185934f7..1786c8924bd 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -3213,6 +3213,42 @@ this function from interpreting the line as a command."
           (erc-display-message nil 'error (current-buffer) 'no-target)
           nil)))))
 
+(defconst erc--shell-parse-regexp
+  (rx (or (+ (not (any ?\s ?\t ?\n ?\\ ?\" ?' ?\;)))
+          (: ?' (group (* (not ?'))) (? ?'))
+          (: ?\" (group (* (or (not (any ?\" ?\\)) (: ?\\ nonl)))) (? ?\"))
+          (: ?\\ (group (? (or nonl ?\n)))))))
+
+(defun erc--split-string-shell-cmd (string)
+  "Parse whitespace-separated arguments in STRING."
+  ;; From `shell--parse-pcomplete-arguments' and friends.  Quirk:
+  ;; backslash-escaped characters appearing within spans of double
+  ;; quotes are unescaped.
+  (with-temp-buffer
+    (insert string)
+    (let ((end (point))
+          args)
+      (goto-char (point-min))
+      (while (and (skip-chars-forward " \t") (< (point) end))
+        (let (arg)
+          (while (looking-at erc--shell-parse-regexp)
+            (goto-char (match-end 0))
+            (cond ((match-beginning 3) ; backslash escape
+                   (push (if (= (match-beginning 3) (match-end 3))
+                             "\\"
+                           (match-string 3))
+                         arg))
+                  ((match-beginning 2) ; double quote
+                   (push (replace-regexp-in-string (rx ?\\ (group nonl))
+                                                   "\\1" (match-string 2))
+                         arg))
+                  ((match-beginning 1) ; single quote
+                   (push (match-string 1) arg))
+                  (t (push (match-string 0) arg))))
+          (push (string-join (nreverse arg)) args)))
+      (nreverse args))))
+
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;                    Input commands handlers
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
diff --git a/test/lisp/erc/erc-dcc-tests.el b/test/lisp/erc/erc-dcc-tests.el
index f02ddf228a2..a750c96c80f 100644
--- a/test/lisp/erc/erc-dcc-tests.el
+++ b/test/lisp/erc/erc-dcc-tests.el
@@ -99,10 +99,11 @@
 (ert-deftest erc-dcc-handle-ctcp-send--turbo ()
   (erc-dcc-tests--dcc-handle-ctcp-send t))
 
-(defun erc-dcc-tests--erc-dcc-do-GET-command (file &optional sep)
+(defun erc-dcc-tests--erc-dcc-do-GET-command (file &optional sep nuh)
+  (unless nuh (setq nuh "tester!~tester@fake.irc"))
   (with-temp-buffer
     (let* ((proc (start-process "fake" (current-buffer) "sleep" "10"))
-           (elt (list :nick "tester!~tester@fake.irc"
+           (elt (list :nick nuh
                       :type 'GET
                       :peer nil
                       :parent proc
@@ -110,6 +111,7 @@
                       :port "9899"
                       :file file
                       :size 1405135128))
+           (nic (erc-extract-nick nuh))
            (erc-dcc-list (list elt))
            ;;
            erc-accidental-paste-threshold-seconds
@@ -130,7 +132,7 @@
         (ert-info ("No turbo")
           (should-not (plist-member elt :turbo))
           (goto-char erc-input-marker)
-          (insert "/dcc GET tester " (or sep "") (prin1-to-string file))
+          (insert "/dcc GET " nic " " (or sep "") (prin1-to-string file))
           (erc-send-current-line)
           (should-not (plist-member (car erc-dcc-list) :turbo))
           (should (equal (pop calls) (list elt file proc))))
@@ -138,7 +140,7 @@
         (ert-info ("Arg turbo in pos 2")
           (should-not (plist-member elt :turbo))
           (goto-char erc-input-marker)
-          (insert "/dcc GET -t tester " (or sep "") (prin1-to-string file))
+          (insert "/dcc GET -t " nic " " (or sep "") (prin1-to-string file))
           (erc-send-current-line)
           (should (eq t (plist-get (car erc-dcc-list) :turbo)))
           (should (equal (pop calls) (list elt file proc))))
@@ -147,7 +149,7 @@
           (setq elt (plist-put elt :turbo nil)
                 erc-dcc-list (list elt))
           (goto-char erc-input-marker)
-          (insert "/dcc GET tester -t " (or sep "") (prin1-to-string file))
+          (insert "/dcc GET " nic " -t " (or sep "") (prin1-to-string file))
           (erc-send-current-line)
           (should (eq t (plist-get (car erc-dcc-list) :turbo)))
           (should (equal (pop calls) (list elt file proc))))
@@ -156,7 +158,7 @@
           (setq elt (plist-put elt :turbo nil)
                 erc-dcc-list (list elt))
           (goto-char erc-input-marker)
-          (insert "/dcc GET tester " (prin1-to-string file) " -t" (or sep ""))
+          (insert "/dcc GET " nic " " (prin1-to-string file) " -t" (or sep ""))
           (erc-send-current-line)
           (should (eq (if sep nil t) (plist-get (car erc-dcc-list) :turbo)))
           (should (equal (pop calls) (if sep nil (list elt file proc)))))))))
@@ -165,7 +167,14 @@
   (erc-dcc-tests--erc-dcc-do-GET-command "foo.bin")
   (erc-dcc-tests--erc-dcc-do-GET-command "foo - file.bin")
   (erc-dcc-tests--erc-dcc-do-GET-command "foo -t file.bin")
-  (erc-dcc-tests--erc-dcc-do-GET-command "-t" "-- "))
+  (erc-dcc-tests--erc-dcc-do-GET-command "-t" "-- ")
+
+  ;; Regression involving pipe character in nickname.
+  (let ((nuh "test|r!~test|r@fake.irc"))
+    (erc-dcc-tests--erc-dcc-do-GET-command "foo.bin" nil nuh)
+    (erc-dcc-tests--erc-dcc-do-GET-command "foo - file.bin" nil nuh)
+    (erc-dcc-tests--erc-dcc-do-GET-command "foo -t file.bin" nil nuh)
+    (erc-dcc-tests--erc-dcc-do-GET-command "-t" "-- " nuh)))
 
 (defun erc-dcc-tests--pcomplete-common (test-fn &optional file)
   (with-current-buffer (get-buffer-create "*erc-dcc-do-GET-command*")
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index 80c7c708fc5..f5c900df408 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -1218,6 +1218,52 @@
 
           (should-not calls))))))
 
+(ert-deftest erc--split-string-shell-cmd ()
+
+  ;; Leading and trailing space
+  (should (equal (erc--split-string-shell-cmd "1 2 3") '("1" "2" "3")))
+  (should (equal (erc--split-string-shell-cmd " 1  2 3 ") '("1" "2" "3")))
+
+  ;; Empty string
+  (should (equal (erc--split-string-shell-cmd "\"\"") '("")))
+  (should (equal (erc--split-string-shell-cmd " \"\" ") '("")))
+  (should (equal (erc--split-string-shell-cmd "1 \"\"") '("1" "")))
+  (should (equal (erc--split-string-shell-cmd "1 \"\" ") '("1" "")))
+  (should (equal (erc--split-string-shell-cmd "\"\" 1") '("" "1")))
+  (should (equal (erc--split-string-shell-cmd " \"\" 1") '("" "1")))
+
+  (should (equal (erc--split-string-shell-cmd "''") '("")))
+  (should (equal (erc--split-string-shell-cmd " '' ") '("")))
+  (should (equal (erc--split-string-shell-cmd "1 ''") '("1" "")))
+  (should (equal (erc--split-string-shell-cmd "1 '' ") '("1" "")))
+  (should (equal (erc--split-string-shell-cmd "'' 1") '("" "1")))
+  (should (equal (erc--split-string-shell-cmd " '' 1") '("" "1")))
+
+  ;; Backslash
+  (should (equal (erc--split-string-shell-cmd "\\ ") '(" ")))
+  (should (equal (erc--split-string-shell-cmd " \\  ") '(" ")))
+  (should (equal (erc--split-string-shell-cmd "1\\  ") '("1 ")))
+  (should (equal (erc--split-string-shell-cmd "1\\ 2") '("1 2")))
+
+  ;; Embedded
+  (should (equal (erc--split-string-shell-cmd "\"\\\"\"") '("\"")))
+  (should (equal (erc--split-string-shell-cmd "1 \"2 \\\" \\\" 3\"")
+                 '("1" "2 \" \" 3")))
+  (should (equal (erc--split-string-shell-cmd "1 \"2 ' ' 3\"")
+                 '("1" "2 ' ' 3")))
+  (should (equal (erc--split-string-shell-cmd "1 '2 \" \" 3'")
+                 '("1" "2 \" \" 3")))
+  (should (equal (erc--split-string-shell-cmd "1 '2 \\  3'")
+                 '("1" "2 \\  3")))
+  (should (equal (erc--split-string-shell-cmd "1 \"2 \\\\  3\"")
+                 '("1" "2 \\  3"))) ; see comment re ^
+
+  ;; Realistic
+  (should (equal (erc--split-string-shell-cmd "GET bob \"my file.txt\"")
+                 '("GET" "bob" "my file.txt")))
+  (should (equal (erc--split-string-shell-cmd "GET EXAMPLE|bob \"my 
file.txt\"")
+                 '("GET" "EXAMPLE|bob" "my file.txt")))) ; regression
+
 
 ;; The behavior of `erc-pre-send-functions' differs between versions
 ;; in how hook members see and influence a trailing newline that's