From b95bb644ec2b9bb9b0aa3ba2a88c828c3c33705a Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Fri, 7 Jul 2023 21:27:03 -0700 Subject: [PATCH] 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 -- 2.39.2