From 76baf9840010ba181547bbed5d86a29171922054 Mon Sep 17 00:00:00 2001 From: Daniel Pettersson Date: Sat, 25 Mar 2023 16:25:48 +0100 Subject: [PATCH 3/3] Fix DCC GET flag parsing in erc-dcc * lisp/erc/erc-dcc.el (erc-cmd-DCC): Elect to tokenize line specially. (pcomplete/erc-mode/DCC): Quote file names when suggesting. Account for double-hyphen end-of-options separator. (erc-dcc-do-GET-command): Simplify signature, subsuming NICK in variadic args, now ARGS instead of FILE, which changes the arity from (2 . many) to (1 . many). Explain usage in doc string. Honor an optional separator, "--", if present. (Bug#62444) * test/lisp/erc/erc-dcc-tests.el (erc-dcc-do-GET-command): Call new parameterized helper with various flags/file combinations. (erc-dcc-tests--erc-dcc-do-GET-command): New fixture function. (pcomplete/erc-mode/DCC--get-quoted, pcomplete/erc-mode/DCC--get-sep): New tests. --- lisp/erc/erc-dcc.el | 56 +++++++++++++++++++++------- test/lisp/erc/erc-dcc-tests.el | 67 +++++++++++++++++++++++++++------- 2 files changed, 95 insertions(+), 28 deletions(-) diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el index 05eced6a391..5406369c62f 100644 --- a/lisp/erc/erc-dcc.el +++ b/lisp/erc/erc-dcc.el @@ -43,7 +43,7 @@ ;; /dcc chat nick - Either accept pending chat offer from nick, or offer ;; DCC chat to nick ;; /dcc close type [nick] - Close DCC connection (SEND/GET/CHAT) with nick -;; /dcc get [-t][-s] nick [file] - Accept DCC offer from nick +;; /dcc get [-t][-s] nick [--] file - Accept DCC offer from nick ;; /dcc list - List all DCC offers/connections ;; /dcc send nick file - Offer DCC SEND to nick @@ -389,12 +389,18 @@ erc-dcc-get-default-directory :type '(choice (const :value nil :tag "Default directory") directory)) ;;;###autoload -(defun erc-cmd-DCC (cmd &rest args) +(defun erc-cmd-DCC (line &rest compat-args) "Parser for /dcc command. This figures out the dcc subcommand and calls the appropriate routine to handle it. The function dispatched should be named \"erc-dcc-do-FOO-command\", where FOO is one of CLOSE, GET, SEND, LIST, CHAT, etc." - (when cmd + (let (cmd args) + ;; Called as library function (i.e., not directly as /dcc) + (if compat-args + (setq cmd line + args compat-args) + (setq args (delete "" (split-string-shell-command line)) + cmd (pop args))) (let ((fn (intern-soft (concat "erc-dcc-do-" (upcase cmd) "-command")))) (if fn (apply fn erc-server-process args) @@ -439,15 +445,20 @@ pcomplete/erc-mode/DCC (eq (plist-get elt :type) 'GET)) erc-dcc-list))) ('send (pcomplete-erc-all-nicks)))) + (when (equal "get" (downcase (pcomplete-arg 'first 1))) + (pcomplete-opt "-")) (pcomplete-here (pcase (intern (downcase (pcomplete-arg 'first 1))) - ('get (mapcar (lambda (elt) (plist-get elt :file)) + ('get (mapcar (lambda (elt) + (combine-and-quote-strings (list (plist-get elt :file)))) (cl-remove-if-not (lambda (elt) (and (eq (plist-get elt :type) 'GET) (erc-nick-equal-p (erc-extract-nick (plist-get elt :nick)) - (pcomplete-arg 1)))) + (pcase (pcomplete-arg 1) + ("--" (pcomplete-arg 2)) + (v v))))) erc-dcc-list))) ('close (mapcar #'erc-dcc-nick (cl-remove-if-not @@ -513,16 +524,33 @@ erc-dcc-do-CLOSE-command ?n (erc-extract-nick (plist-get ret :nick)))))) t)) -(defun erc-dcc-do-GET-command (proc nick &rest file) - "Do a DCC GET command. NICK is the person who is sending the file. -FILE is the filename. If FILE is split into multiple arguments, -re-join the arguments, separated by a space. -PROC is the server process." - (let* ((args (seq-group-by (lambda (s) (eq ?- (aref s 0))) (cons nick file))) +(defun erc-dcc-do-GET-command (proc &rest args) + "Perform a DCC GET command. +Recognize input conforming to the following usage syntax: + + /DCC GET [-t|-s] nick [--] filename + + nick The person who is sending the file. + filename The filename to be downloaded. Can be split into multiple + arguments that are then joined by a space. + flags \"-t\" sets `:turbo' see `erc-dcc-list' + \"-s\" sets `:secure' see `erc-dcc-list' + \"--\" indicates end of options + All of which are optional. + +Expect PROC to be the server process and ARGS to contain +everything after the subcommand \"GET\" in the usage description +above." + ;; Despite the advertised syntax above, we currently respect flags + ;; in these positions: [flag] nick [flag] filename [flag] + (let* ((trailing (and-let* ((trailing (member "--" args))) + (setq args (butlast args (length trailing))) + (cdr trailing))) + (args (seq-group-by (lambda (s) (eq ?- (aref s 0))) args)) (flags (prog1 (cdr (assq t args)) - (setq args (cdr (assq nil args)) - nick (pop args) - file (and args (mapconcat #'identity args " "))))) + (setq args (nconc (cdr (assq nil args)) trailing)))) + (nick (pop args)) + (file (and args (mapconcat #'identity args " "))) (elt (erc-dcc-member :nick nick :type 'GET :file file)) (filename (or file (plist-get elt :file) "unknown"))) (if elt diff --git a/test/lisp/erc/erc-dcc-tests.el b/test/lisp/erc/erc-dcc-tests.el index bd8a9fc7951..fed86eff2c5 100644 --- a/test/lisp/erc/erc-dcc-tests.el +++ b/test/lisp/erc/erc-dcc-tests.el @@ -100,7 +100,7 @@ erc-dcc-handle-ctcp-send--base (ert-deftest erc-dcc-handle-ctcp-send--turbo () (erc-dcc-tests--dcc-handle-ctcp-send t)) -(ert-deftest erc-dcc-do-GET-command () +(defun erc-dcc-tests--erc-dcc-do-GET-command (file &optional sep) (with-temp-buffer (let* ((proc (start-process "fake" (current-buffer) "sleep" "10")) (elt (list :nick "tester!~tester@fake.irc" @@ -109,7 +109,7 @@ erc-dcc-do-GET-command :parent proc :ip "127.0.0.1" :port "9899" - :file "foo.bin" + :file file :size 1405135128)) (erc-dcc-list (list elt)) ;; @@ -124,7 +124,7 @@ erc-dcc-do-GET-command erc-server-current-nick "dummy") (set-process-query-on-exit-flag proc nil) (cl-letf (((symbol-function 'read-file-name) - (lambda (&rest _) "foo.bin")) + (lambda (&rest _) file)) ((symbol-function 'erc-dcc-get-file) (lambda (&rest r) (push r calls)))) (goto-char (point-max)) @@ -134,38 +134,44 @@ erc-dcc-do-GET-command (ert-info ("No turbo") (should-not (plist-member elt :turbo)) (goto-char erc-input-marker) - (insert "/dcc GET tester foo.bin") + (insert "/dcc GET tester " (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 "foo.bin" proc)))) + (should (equal (pop calls) (list elt file proc)))) (ert-info ("Arg turbo in pos 2") (should-not (plist-member elt :turbo)) (goto-char erc-input-marker) - (insert "/dcc GET -t tester foo.bin") + (insert "/dcc GET -t tester " (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 "foo.bin" proc)))) + (should (equal (pop calls) (list elt file proc)))) (ert-info ("Arg turbo in pos 4") (setq elt (plist-put elt :turbo nil) erc-dcc-list (list elt)) (goto-char erc-input-marker) - (insert "/dcc GET tester -t foo.bin") + (insert "/dcc GET tester -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 "foo.bin" proc)))) + (should (equal (pop calls) (list elt file proc)))) (ert-info ("Arg turbo in pos 6") (setq elt (plist-put elt :turbo nil) erc-dcc-list (list elt)) (goto-char erc-input-marker) - (insert "/dcc GET tester foo.bin -t") + (insert "/dcc GET tester " (prin1-to-string file) " -t" (or sep "")) (erc-send-current-line) - (should (eq t (plist-get (car erc-dcc-list) :turbo))) - (should (equal (pop calls) (list elt "foo.bin" proc)))))))) + (should (eq (if sep nil t) (plist-get (car erc-dcc-list) :turbo))) + (should (equal (pop calls) (if sep nil (list elt file proc))))))))) + +(ert-deftest 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" "-- ")) -(defun erc-dcc-tests--pcomplete-common (test-fn) +(defun erc-dcc-tests--pcomplete-common (test-fn &optional file) (with-current-buffer (get-buffer-create "*erc-dcc-do-GET-command*") (let* ((inhibit-message noninteractive) (proc (start-process "fake" (current-buffer) "sleep" "10")) @@ -175,7 +181,7 @@ erc-dcc-tests--pcomplete-common :parent proc :ip "127.0.0.1" :port "9899" - :file "foo.bin" + :file (or file "foo.bin") :size 1405135128)) ;; erc-accidental-paste-threshold-seconds @@ -211,6 +217,20 @@ pcomplete/erc-mode/DCC--get-basic (beginning-of-line) (should (search-forward "/dcc get tester foo.bin" nil t)))))) +(ert-deftest pcomplete/erc-mode/DCC--get-quoted () + (erc-dcc-tests--pcomplete-common + (lambda () + (insert "/dcc get ") + (call-interactively #'completion-at-point) + (save-excursion + (beginning-of-line) + (should (search-forward "/dcc get tester" nil t))) + (call-interactively #'completion-at-point) + (save-excursion + (beginning-of-line) + (should (search-forward "/dcc get tester \"foo bar.bin\"" nil t)))) + "foo bar.bin")) + (ert-deftest pcomplete/erc-mode/DCC--get-1flag () (erc-dcc-tests--pcomplete-common (lambda () @@ -282,4 +302,23 @@ pcomplete/erc-mode/DCC--get-2flags-reverse (beginning-of-line) (should (search-forward "/dcc get -t -s tester foo.bin" nil t)))))) +(ert-deftest pcomplete/erc-mode/DCC--get-sep () + (erc-dcc-tests--pcomplete-common + (lambda () + (insert "/dcc get ") + (call-interactively #'completion-at-point) + (save-excursion + (beginning-of-line) + (should (search-forward "/dcc get tester" nil t))) + (insert "-") + (call-interactively #'completion-at-point) + (save-excursion + (beginning-of-line) + (should (search-forward "/dcc get tester -- " nil t))) + (call-interactively #'completion-at-point) + (save-excursion + (beginning-of-line) + (should (search-forward "/dcc get tester -- -t" nil t)))) + "-t")) + ;;; erc-dcc-tests.el ends here -- 2.39.2