mirror of
git://git.sv.gnu.org/emacs.git
synced 2026-01-12 06:21:02 -08:00
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.
This commit is contained in:
F. Jason Park
parent
4e8d579f3d
commit
b95bb644ec
5 changed files with 99 additions and 29 deletions
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
|
|
|||
|
|
@ -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*")
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue