bug#62444: [PATCH] erc: Fix "dcc get" flag parsing

["J.P." <jp@neverwas.me>]

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

Fernando de Morais <fernandodemorais.jf@gmail.com> writes:

> Hello J.P.,
>
> "J.P." <jp@neverwas.me> writes:
>
>> Thanks for the heads up. This looks like my bad. Would something like
>> the attached (untried) maybe suffice as a temporary workaround?
>
> You're welcome!  I've applied the patch but, unfortunately, the reported
> behaviour persists...

Gah, right, that was a dumb hack anyway. I shouldn't have suggested it.

> Not sure if that's why the changes didn't work, as the patch is related
> to a `compat' code for Emacs 28, but I've been following the Emacs
> master branch (I should have informed in the previous message).

This one is more like a proper patch, but it's based on the same
(mis?)understanding of the problem, which is slightly worrying. It may
very well be that I'll need to step back and reassess. But if you're
still willing at this juncture, please give this one a go. And if you're
not already doing something like

  find lisp/erc -name \*.elc -delete

before rerunning make, please do, so we can rule out some corner-case
weirdness (if you wouldn't mind). Thanks again.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-5.6-Fix-command-line-parsing-regression-in-erc-cmd-D.patch --]
[-- Type: text/x-patch, Size: 11355 bytes --]

From b76a7fce8e8643cfa737385a5fdf06d02d71d3e8 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Fri, 7 Jul 2023 21:27:03 -0700
Subject: [PATCH] [5.6] 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--shell-parse-arguments): 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 `nuh' arg representing
message source/sender.
(erc-dcc-do-GET-command): Add tests for pipe-char regression.
* test/lisp/erc/erc-tests.el (erc--shell-parse-arguments): New test.
(Bug#62444)
---
 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 @@ erc-compat--29-browse-url-irc
                        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..0a6b79a5f2f 100644
--- a/lisp/erc/erc-dcc.el
+++ b/lisp/erc/erc-dcc.el
@@ -399,7 +399,7 @@ erc-cmd-DCC
     (if compat-args
         (setq cmd line
               args compat-args)
-      (setq args (delete "" (erc-compat--split-string-shell-command line))
+      (setq args (delete "" (erc--shell-parse-arguments 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..fb1264dab21 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -3213,6 +3213,42 @@ erc-process-input-line
           (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--shell-parse-arguments (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 not preserved (but rather 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 @@ erc-dcc-handle-ctcp-send--base
 (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 @@ erc-dcc-tests--erc-dcc-do-GET-command
                       :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 @@ erc-dcc-tests--erc-dcc-do-GET-command
         (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 @@ erc-dcc-tests--erc-dcc-do-GET-command
         (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 @@ erc-dcc-tests--erc-dcc-do-GET-command
           (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 @@ erc-dcc-tests--erc-dcc-do-GET-command
           (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-do-GET-command
   (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..a732a6bd996 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -1218,6 +1218,52 @@ erc-process-input-line
 
           (should-not calls))))))
 
+(ert-deftest erc--shell-parse-arguments ()
+
+  ;; Leading and trailing space
+  (should (equal (erc--shell-parse-arguments "1 2 3") '("1" "2" "3")))
+  (should (equal (erc--shell-parse-arguments " 1  2 3 ") '("1" "2" "3")))
+
+  ;; Empty string
+  (should (equal (erc--shell-parse-arguments "\"\"") '("")))
+  (should (equal (erc--shell-parse-arguments " \"\" ") '("")))
+  (should (equal (erc--shell-parse-arguments "1 \"\"") '("1" "")))
+  (should (equal (erc--shell-parse-arguments "1 \"\" ") '("1" "")))
+  (should (equal (erc--shell-parse-arguments "\"\" 1") '("" "1")))
+  (should (equal (erc--shell-parse-arguments " \"\" 1") '("" "1")))
+
+  (should (equal (erc--shell-parse-arguments "''") '("")))
+  (should (equal (erc--shell-parse-arguments " '' ") '("")))
+  (should (equal (erc--shell-parse-arguments "1 ''") '("1" "")))
+  (should (equal (erc--shell-parse-arguments "1 '' ") '("1" "")))
+  (should (equal (erc--shell-parse-arguments "'' 1") '("" "1")))
+  (should (equal (erc--shell-parse-arguments " '' 1") '("" "1")))
+
+  ;; Backslash
+  (should (equal (erc--shell-parse-arguments "\\ ") '(" ")))
+  (should (equal (erc--shell-parse-arguments " \\  ") '(" ")))
+  (should (equal (erc--shell-parse-arguments "1\\  ") '("1 ")))
+  (should (equal (erc--shell-parse-arguments "1\\ 2") '("1 2")))
+
+  ;; Embedded
+  (should (equal (erc--shell-parse-arguments "\"\\\"\"") '("\"")))
+  (should (equal (erc--shell-parse-arguments "1 \"2 \\\" \\\" 3\"")
+                 '("1" "2 \" \" 3")))
+  (should (equal (erc--shell-parse-arguments "1 \"2 ' ' 3\"")
+                 '("1" "2 ' ' 3")))
+  (should (equal (erc--shell-parse-arguments "1 '2 \" \" 3'")
+                 '("1" "2 \" \" 3")))
+  (should (equal (erc--shell-parse-arguments "1 '2 \\  3'")
+                 '("1" "2 \\  3")))
+  (should (equal (erc--shell-parse-arguments "1 \"2 \\\\  3\"")
+                 '("1" "2 \\  3"))) ; see comment re ^
+
+  ;; Realistic
+  (should (equal (erc--shell-parse-arguments "GET bob \"my file.txt\"")
+                 '("GET" "bob" "my file.txt")))
+  (should (equal (erc--shell-parse-arguments "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
-- 
2.41.0