* bug#62444: [PATCH] erc: Fix "dcc get" flag parsing @ 2023-03-25 15:25 Daniel Pettersson 2023-03-26 4:10 ` J.P. ` (2 more replies) 0 siblings, 3 replies; 11+ messages in thread From: Daniel Pettersson @ 2023-03-25 15:25 UTC (permalink / raw) To: 62444 In erc mode when receiving a file with "/dcc get" if the nick or filename starts with a dash or the filename contains the following string " -", "/dcc get" is unable to download the file. Reproduce: As this is a bit cumbersome to reproduce without mocking files. I included a patch of erc-dcc-tests where the file name contains a the string " - ". Apply the following patch for erc-dcc-tests and run lisp-erc tests. --- diff --git a/test/lisp/erc/erc-dcc-tests.el b/test/lisp/erc/erc-dcc-tests.el index bd8a9fc7951..a487f9067cd 100644 --- a/test/lisp/erc/erc-dcc-tests.el +++ b/test/lisp/erc/erc-dcc-tests.el @@ -109,7 +109,7 @@ erc-dcc-do-GET-command :parent proc :ip "127.0.0.1" :port "9899" - :file "foo.bin" + :file "foo - .bin" :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 _) "foo - .bin")) ((symbol-function 'erc-dcc-get-file) (lambda (&rest r) (push r calls)))) (goto-char (point-max)) @@ -134,36 +134,36 @@ 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 foo - .bin") (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 "foo - .bin" 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 foo - .bin") (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 "foo - .bin" 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 foo - .bin") (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 "foo - .bin" 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 foo - .bin -t") (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 "foo - .bin" proc)))))))) (defun erc-dcc-tests--pcomplete-common (test-fn) (with-current-buffer (get-buffer-create "*erc-dcc-do-GET-command*") --- Issue present since: df1e553688b * Accommodate nonstandard turbo file senders in erc-dcc Proposed patch: erc: Fix "dcc get" flag parsing When nick or filename starts with `?-' or filename contains the following string " -", "dcc get" is unable determine nick/filename and fails to download file. Flag parsing rules is kept as is: [flag] nick [flag] filename [flag] Flags have the highest priority when parsing the arguments to dcc get. This is not an complete fix as dcc will fail on: - nicks "-s" and "-t" - filenames starting with r"-s|t +" - filenames with ending with r" -s|t" An more robust solution and cleaner implementation would be possible if flag position was limited to the end of the arguments list. This would also make it easier to implement pcomplete for flags as well. --- lisp/erc/erc-dcc.el | 36 +++++++++++++++++++++++----------- test/lisp/erc/erc-dcc-tests.el | 27 ++++++++++++++----------- 2 files changed, 41 insertions(+), 22 deletions(-) diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el index 4c557e0e0f9..d7c685e9413 100644 --- a/lisp/erc/erc-dcc.el +++ b/lisp/erc/erc-dcc.el @@ -504,18 +504,32 @@ 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. +(defun erc-dcc-do-GET-command (proc &rest args) + "Do a DCC GET command. +ARGS are expected to contain: + nick The person who is sending the file. + filename The filename to be downloaded. Can be split into multiple arguments + which is then joined by a space. + flags \"-t\" sets `:turbo' see `erc-dcc-list' + \"-s\" sets `:secure' see `erc-dcc-list' +ARGS are parsed as follows: + [flag] nick [flag] filename [flag] PROC is the server process." - (let* ((args (seq-group-by (lambda (s) (eq ?- (aref s 0))) (cons nick file))) - (flags (prog1 (cdr (assq t args)) - (setq args (cdr (assq nil args)) - 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"))) + (let ((possible-flags '("-s" "-t")) + flags nick elt possible-files filename) + ;; Get flags between get and nick + (while (seq-contains-p possible-flags (car args) 'equal) + (setq flags (cons (pop args) flags))) + (setq nick (or (pop args) "")) + ;; Get flags between nick and filename + (while (seq-contains-p possible-flags (car args) 'equal) + (setq flags (cons (pop args) flags))) + ;; Get flags after filename + (setq args (reverse args)) + (while (seq-contains-p possible-flags (car args) 'equal) + (setq flags (cons (pop args) flags))) + (setq filename (or (mapconcat #'identity (reverse args) " ") "") + elt (erc-dcc-member :nick nick :type 'GET :file filename)) (if elt (let* ((file (read-file-name (format-prompt "Local filename" diff --git a/test/lisp/erc/erc-dcc-tests.el b/test/lisp/erc/erc-dcc-tests.el index bd8a9fc7951..f21463bb5a0 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) (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,36 +134,41 @@ 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 " 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 " 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 " 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 " file " -t") (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-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")) (defun erc-dcc-tests--pcomplete-common (test-fn) (with-current-buffer (get-buffer-create "*erc-dcc-do-GET-command*") -- 2.32.0 (Apple Git-132) ^ permalink raw reply related [flat|nested] 11+ messages in thread
* bug#62444: [PATCH] erc: Fix "dcc get" flag parsing 2023-03-25 15:25 bug#62444: [PATCH] erc: Fix "dcc get" flag parsing Daniel Pettersson @ 2023-03-26 4:10 ` J.P. [not found] ` <87a600xidp.fsf@neverwas.me> 2023-04-05 18:27 ` Daniel Pettersson 2 siblings, 0 replies; 11+ messages in thread From: J.P. @ 2023-03-26 4:10 UTC (permalink / raw) To: Daniel Pettersson; +Cc: 62444, emacs-erc [-- Attachment #1: Type: text/plain, Size: 3186 bytes --] Hi Daniel, Thanks for submitting this report. I haven't gotten around to reviewing your proposed changes properly but definitely will in the coming days. For now, all I can offer are a few boring administrative notes. Daniel Pettersson <daniel@dpettersson.net> writes: > In erc mode when receiving a file with "/dcc get" if the nick or > filename starts with a dash or the filename contains the following > string " -", "/dcc get" is unable to download the file. Indeed, sorry for any inconvenience this might have caused. > Reproduce: > As this is a bit cumbersome to reproduce without mocking files. I > included a patch of erc-dcc-tests where the file name contains a the > string " - ". > Apply the following patch for erc-dcc-tests and run lisp-erc tests. > --- > > diff --git a/test/lisp/erc/erc-dcc-tests.el b/test/lisp/erc/erc-dcc-tests.el > index bd8a9fc7951..a487f9067cd 100644 > --- a/test/lisp/erc/erc-dcc-tests.el > +++ b/test/lisp/erc/erc-dcc-tests.el > @@ -109,7 +109,7 @@ erc-dcc-do-GET-command [...] > > --- This example makes sense, thanks. BTW, in the future, can you save out your patches with git-format-patch and attach them somehow? This and other conventions worth noting, such as formatting change-log style commit messages, are detailed in CONTRIBUTE. As an example, I've re-attached your patch with a reformatted commit message more along the lines of what's expected (if you wouldn't mind taking a look). Also, if you can remember, please add the header: X-Debbugs-CC: emacs-erc@gnu.org to any future bug reports (see also `erc-bug'). > Issue present since: > df1e553688b * Accommodate nonstandard turbo file senders in erc-dcc > > Proposed patch: > erc: Fix "dcc get" flag parsing > > When nick or filename starts with `?-' or filename contains the > following string " -", "dcc get" is unable determine nick/filename and > fails to download file. > > Flag parsing rules is kept as is: > [flag] nick [flag] filename [flag] > > Flags have the highest priority when parsing the arguments to dcc > get. This is not an complete fix as dcc will fail on: > - nicks "-s" and "-t" > - filenames starting with r"-s|t +" > - filenames with ending with r" -s|t" Guessing r"..." just means regexp? If not, please clarify. > An more robust solution and cleaner implementation would be possible > if flag position was limited to the end of the arguments list. > > This would also make it easier to implement pcomplete for flags as well. I would tend to agree. Perhaps we ought to go ahead and only make these -s and -t flags valid in the terminal position. Normally, that'd be a hassle, likely involving the introduction of a "compat" user option. But we've deliberately refrained from announcing these DCC features (other than in the "usage" portion of the Commentary section atop the library file). So I think a trivially breaking change in a patch version, like 5.5.1, might be doable. Lastly, I have to mention the dreaded copyright thing because I couldn't tell from the discussion for bug#57905 whether you ended up filing. If not and we go with changes resembling those you've proposed, you'll probably want to do so. Thanks, J.P. [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0001-POC-Demo-broken-flags-parsing-in-erc-dcc-do-GET-comm.patch --] [-- Type: text/x-patch, Size: 3869 bytes --] From 7a349e180d1f99fecfb1179e5885e9aa9a7b0ac2 Mon Sep 17 00:00:00 2001 From: Daniel Pettersson <daniel@dpettersson.net> Date: Sat, 25 Mar 2023 16:25:48 +0100 Subject: [PATCH 1/2] [POC] Demo broken flags parsing in erc-dcc-do-GET-command (bug#62444) In erc mode when receiving a file with "/dcc get" if the nick or filename starts with a dash or the filename contains the following string " -", "/dcc get" is unable to download the file. Reproduce: As this is a bit cumbersome to reproduce without mocking files. I included a patch of erc-dcc-tests where the file name contains a the string " - ". Apply the following patch for erc-dcc-tests and run lisp-erc tests. --- test/lisp/erc/erc-dcc-tests.el | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/test/lisp/erc/erc-dcc-tests.el b/test/lisp/erc/erc-dcc-tests.el index bd8a9fc7951..a487f9067cd 100644 --- a/test/lisp/erc/erc-dcc-tests.el +++ b/test/lisp/erc/erc-dcc-tests.el @@ -109,7 +109,7 @@ erc-dcc-do-GET-command :parent proc :ip "127.0.0.1" :port "9899" - :file "foo.bin" + :file "foo - .bin" :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 _) "foo - .bin")) ((symbol-function 'erc-dcc-get-file) (lambda (&rest r) (push r calls)))) (goto-char (point-max)) @@ -134,36 +134,36 @@ 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 foo - .bin") (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 "foo - .bin" 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 foo - .bin") (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 "foo - .bin" 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 foo - .bin") (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 "foo - .bin" 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 foo - .bin -t") (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 "foo - .bin" proc)))))))) (defun erc-dcc-tests--pcomplete-common (test-fn) (with-current-buffer (get-buffer-create "*erc-dcc-do-GET-command*") -- 2.39.2 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #3: 0002-Fix-DCC-GET-flag-parsing-in-erc-dcc.patch --] [-- Type: text/x-patch, Size: 7419 bytes --] From 9917469aef02a54db9eec4b3f22f85e596e1fb52 Mon Sep 17 00:00:00 2001 From: Daniel Pettersson <daniel@dpettersson.net> Date: Sat, 25 Mar 2023 16:25:48 +0100 Subject: [PATCH 2/2] Fix DCC GET flag parsing in erc-dcc * lisp/erc/erc-dcc.el (erc-dcc-do-GET-command): Explain usage in doc string. Fix flag parsing so ERC better recognizes files that look like flags. This issue started with df1e553688b "Accommodate nonstandard turbo file senders in erc-dcc". When a nick or filename starts with `?-' or contains a literal " -", "dcc get" is unable to the determine the token type and fails to download the file. This change retains the existing parsing rules, namely, "FLAG nick FLAG filename FLAG", where flags have the highest priority. This is not a complete fix as the command will still fail on things like nicks being "-s" and "-t", filenames starting with r"-s|t +", and filenames ending with " -s|t". A more robust solution and a cleaner implementation would be possible if flag position was limited to the end of the arguments list. This would also make it easier to implement pcomplete for the command as well (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. --- lisp/erc/erc-dcc.el | 36 +++++++++++++++++++++++----------- test/lisp/erc/erc-dcc-tests.el | 27 ++++++++++++++----------- 2 files changed, 41 insertions(+), 22 deletions(-) diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el index 4c557e0e0f9..d7c685e9413 100644 --- a/lisp/erc/erc-dcc.el +++ b/lisp/erc/erc-dcc.el @@ -504,18 +504,32 @@ 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. +(defun erc-dcc-do-GET-command (proc &rest args) + "Do a DCC GET command. +ARGS are expected to contain: + nick The person who is sending the file. + filename The filename to be downloaded. Can be split into multiple arguments + which is then joined by a space. + flags \"-t\" sets `:turbo' see `erc-dcc-list' + \"-s\" sets `:secure' see `erc-dcc-list' +ARGS are parsed as follows: + [flag] nick [flag] filename [flag] PROC is the server process." - (let* ((args (seq-group-by (lambda (s) (eq ?- (aref s 0))) (cons nick file))) - (flags (prog1 (cdr (assq t args)) - (setq args (cdr (assq nil args)) - 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"))) + (let ((possible-flags '("-s" "-t")) + flags nick elt possible-files filename) + ;; Get flags between get and nick + (while (seq-contains-p possible-flags (car args) 'equal) + (setq flags (cons (pop args) flags))) + (setq nick (or (pop args) "")) + ;; Get flags between nick and filename + (while (seq-contains-p possible-flags (car args) 'equal) + (setq flags (cons (pop args) flags))) + ;; Get flags after filename + (setq args (reverse args)) + (while (seq-contains-p possible-flags (car args) 'equal) + (setq flags (cons (pop args) flags))) + (setq filename (or (mapconcat #'identity (reverse args) " ") "") + elt (erc-dcc-member :nick nick :type 'GET :file filename)) (if elt (let* ((file (read-file-name (format-prompt "Local filename" diff --git a/test/lisp/erc/erc-dcc-tests.el b/test/lisp/erc/erc-dcc-tests.el index a487f9067cd..f21463bb5a0 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) (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,36 +134,41 @@ 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 " 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 " 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 " 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 " file " -t") (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-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")) (defun erc-dcc-tests--pcomplete-common (test-fn) (with-current-buffer (get-buffer-create "*erc-dcc-do-GET-command*") -- 2.39.2 ^ permalink raw reply related [flat|nested] 11+ messages in thread
[parent not found: <87a600xidp.fsf@neverwas.me>]
* bug#62444: [PATCH] erc: Fix "dcc get" flag parsing [not found] ` <87a600xidp.fsf@neverwas.me> @ 2023-03-27 3:50 ` J.P. 0 siblings, 0 replies; 11+ messages in thread From: J.P. @ 2023-03-27 3:50 UTC (permalink / raw) To: Daniel Pettersson; +Cc: 62444, emacs-erc [-- Attachment #1: Type: text/plain, Size: 6318 bytes --] Hi Daniel, Daniel Pettersson <daniel@dpettersson.net> writes: > Proposed patch: > erc: Fix "dcc get" flag parsing > > When nick or filename starts with `?-' or filename contains the > following string " -", "dcc get" is unable determine nick/filename and > fails to download file. > > Flag parsing rules is kept as is: > [flag] nick [flag] filename [flag] As you've mentioned elsewhere, we should probably try to reduce the complexity WRT these flag positions. I agree that "terminal" is best, but since we're already nominally in bed with "initial", how 'bout we try sticking with that for now? > Flags have the highest priority when parsing the arguments to dcc > get. This is not an complete fix as dcc will fail on: > - nicks "-s" and "-t" AFAIK, nicknames can't normally begin with a ?-, and attempting to procure one like that will earn you a :mercury.libera.chat 432 testing123 -testing123 :Erroneous nickname or similar. Of course, if you know of any popular servers where this isn't the case, please share. > - filenames starting with r"-s|t +" In the attached changes, which iterate on yours and which I'd like your comments on, I've tried adding a familiar "end of options" separator, i.e., "--", to cover this case. Given the unlikelihood of such collisions, I think it's worth the occasional inconvenience. > - filenames with ending with r" -s|t" In the interest of preserving some symmetry with DCC SEND, which quotes its outgoing arguments, I think erc-dcc should parse its own input line rather than rely on the treatment from `erc-extract-command-from-line'. This approach seems to work in cursory trials, but a few complications arise when it comes to completion (also present in ERC <5.5.), although there are workarounds. (How's your pcomplete-fu?) > An more robust solution and cleaner implementation would be possible > if flag position was limited to the end of the arguments list. > > This would also make it easier to implement pcomplete for flags as well. Agreed. See above. Alas, the following are just mechanical, style-related nits. Ignore them if you wish, but please see the attached patches for a reprise of your initial proposal with the changes I've outlined applied atop. (The first two patches are just thrown in for convenience but ultimately unrelated.) > --- > lisp/erc/erc-dcc.el | 36 +++++++++++++++++++++++----------- > test/lisp/erc/erc-dcc-tests.el | 27 ++++++++++++++----------- > 2 files changed, 41 insertions(+), 22 deletions(-) > > diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el > index 4c557e0e0f9..d7c685e9413 100644 > --- a/lisp/erc/erc-dcc.el > +++ b/lisp/erc/erc-dcc.el > @@ -504,18 +504,32 @@ 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. > +(defun erc-dcc-do-GET-command (proc &rest args) > + "Do a DCC GET command. > +ARGS are expected to contain: > + nick The person who is sending the file. > + filename The filename to be downloaded. Can be split into multiple arguments ^1 2^ Two spaces between sentences. Not my preference either, but them's the rules. Also, the doc-string fill column is a parsimonious 65. I often ignore it for preformatted, "tabular" stuff like this and thus take it up to 70 or so, but 78 is likely pushing it. > + which is then joined by a space. > + flags \"-t\" sets `:turbo' see `erc-dcc-list' > + \"-s\" sets `:secure' see `erc-dcc-list' > +ARGS are parsed as follows: > + [flag] nick [flag] filename [flag] > PROC is the server process." > - (let* ((args (seq-group-by (lambda (s) (eq ?- (aref s 0))) (cons nick file))) > - (flags (prog1 (cdr (assq t args)) > - (setq args (cdr (assq nil args)) > - 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"))) > + (let ((possible-flags '("-s" "-t")) > + flags nick elt possible-files filename) > + ;; Get flags between get and nick > + (while (seq-contains-p possible-flags (car args) 'equal) > + (setq flags (cons (pop args) flags))) > + (setq nick (or (pop args) "")) > + ;; Get flags between nick and filename > + (while (seq-contains-p possible-flags (car args) 'equal) > + (setq flags (cons (pop args) flags))) > + ;; Get flags after filename > + (setq args (reverse args)) > + (while (seq-contains-p possible-flags (car args) 'equal) > + (setq flags (cons (pop args) flags))) > + (setq filename (or (mapconcat #'identity (reverse args) " ") "") > + elt (erc-dcc-member :nick nick :type 'GET :file filename)) Some of the above, such as (setq foo (cons x foo)) instead of `push' and `seq-contains-p' instead of `member', might distract a few readers. I don't really care, personally. > (if elt > (let* ((file (read-file-name > (format-prompt "Local filename" > diff --git a/test/lisp/erc/erc-dcc-tests.el b/test/lisp/erc/erc-dcc-tests.el > index bd8a9fc7951..f21463bb5a0 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 () > + (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")) This is nice. I should have done this originally. > (defun erc-dcc-tests--pcomplete-common (test-fn) > (with-current-buffer (get-buffer-create "*erc-dcc-do-GET-command*") As mentioned, I've taken a slightly different tack WRT parsing based on the presence of pre-quoted args. Please check it out, give feedback, and by all means iterate. Thanks! [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0000-v0-v1.diff --] [-- Type: text/x-patch, Size: 12500 bytes --] From 76baf9840010ba181547bbed5d86a29171922054 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <jp@neverwas.me> Date: Sun, 26 Mar 2023 19:40:58 -0700 Subject: [PATCH 0/3] *** NOT A PATCH *** *** BLURB HERE *** Daniel Pettersson (1): Fix DCC GET flag parsing in erc-dcc F. Jason Park (2): Add subcommand dispatch facility to erc-cmd-HELP Add subcommand erc-cmd-HELP handler to erc-dcc lisp/erc/erc-dcc.el | 65 ++++++++++++++++++++++++++------- lisp/erc/erc.el | 7 +++- test/lisp/erc/erc-dcc-tests.el | 67 +++++++++++++++++++++++++++------- 3 files changed, 110 insertions(+), 29 deletions(-) Interdiff: diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el index d7c685e9413..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) @@ -404,8 +410,17 @@ erc-cmd-DCC (apropos "erc-dcc-do-.*-command") t)))) +(put 'erc-cmd-DCC 'do-not-parse-args t) (autoload 'pcomplete-erc-all-nicks "erc-pcomplete") +(defun erc-dcc--cmd-help (&rest args) + (describe-function + (or (and args (intern-soft (concat "erc-dcc-do-" + (upcase (car args)) "-command"))) + 'erc-cmd-DCC))) + +(put 'erc-cmd-DCC 'erc--cmd-help #'erc-dcc--cmd-help) + ;;;###autoload (defun pcomplete/erc-mode/DCC () "Provide completion for the /DCC command." @@ -430,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 @@ -505,31 +525,34 @@ erc-dcc-do-CLOSE-command t)) (defun erc-dcc-do-GET-command (proc &rest args) - "Do a DCC GET command. -ARGS are expected to contain: + "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 - which is then joined by a space. + 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' -ARGS are parsed as follows: - [flag] nick [flag] filename [flag] -PROC is the server process." - (let ((possible-flags '("-s" "-t")) - flags nick elt possible-files filename) - ;; Get flags between get and nick - (while (seq-contains-p possible-flags (car args) 'equal) - (setq flags (cons (pop args) flags))) - (setq nick (or (pop args) "")) - ;; Get flags between nick and filename - (while (seq-contains-p possible-flags (car args) 'equal) - (setq flags (cons (pop args) flags))) - ;; Get flags after filename - (setq args (reverse args)) - (while (seq-contains-p possible-flags (car args) 'equal) - (setq flags (cons (pop args) flags))) - (setq filename (or (mapconcat #'identity (reverse args) " ") "") - elt (erc-dcc-member :nick nick :type 'GET :file filename)) + \"--\" 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 (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 (let* ((file (read-file-name (format-prompt "Local filename" diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 69bdb5d71b1..60aa26579c5 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -3203,7 +3203,7 @@ erc-cmd-CTCP (erc-send-ctcp-message nick str) t)) -(defun erc-cmd-HELP (&optional func) +(defun erc-cmd-HELP (&optional func &rest rest) "Popup help information. If FUNC contains a valid function or variable, help about that @@ -3236,6 +3236,11 @@ erc-cmd-HELP nil))))) (if sym (cond + ((progn (autoloadp (symbol-function sym)) + (autoload-do-load (symbol-function sym)) + nil)) + ((get sym 'erc--cmd-help) + (apply (get sym 'erc--cmd-help) rest)) ((boundp sym) (describe-variable sym)) ((fboundp sym) (describe-function sym)) (t nil)) diff --git a/test/lisp/erc/erc-dcc-tests.el b/test/lisp/erc/erc-dcc-tests.el index f21463bb5a0..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)) -(defun erc-dcc-tests--erc-dcc-do-GET-command (file) +(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" @@ -134,7 +134,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 " file) + (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 file proc)))) @@ -142,7 +142,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 " file) + (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 file proc)))) @@ -151,7 +151,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 " file) + (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 file proc)))) @@ -160,17 +160,18 @@ 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 " file " -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 file 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 "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")) @@ -180,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 @@ -216,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 () @@ -287,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 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #3: 0001-Add-subcommand-dispatch-facility-to-erc-cmd-HELP.patch --] [-- Type: text/x-patch, Size: 1402 bytes --] From e4aa6d281e492edb1ca8a6f3c50586fdffe7867e Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <jp@neverwas.me> Date: Sat, 25 Mar 2023 09:13:40 -0700 Subject: [PATCH 1/3] Add subcommand dispatch facility to erc-cmd-HELP * lisp/erc/erc.el (erc-cmd-HELP): Change signature by adding &rest parameter. Attempt to autoload symbol. Look for symbol property `erc--cmd-help' and, if found, assume it's a function and call it with &rest args. --- lisp/erc/erc.el | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 69bdb5d71b1..60aa26579c5 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -3203,7 +3203,7 @@ erc-cmd-CTCP (erc-send-ctcp-message nick str) t)) -(defun erc-cmd-HELP (&optional func) +(defun erc-cmd-HELP (&optional func &rest rest) "Popup help information. If FUNC contains a valid function or variable, help about that @@ -3236,6 +3236,11 @@ erc-cmd-HELP nil))))) (if sym (cond + ((progn (autoloadp (symbol-function sym)) + (autoload-do-load (symbol-function sym)) + nil)) + ((get sym 'erc--cmd-help) + (apply (get sym 'erc--cmd-help) rest)) ((boundp sym) (describe-variable sym)) ((fboundp sym) (describe-function sym)) (t nil)) -- 2.39.2 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #4: 0002-Add-subcommand-erc-cmd-HELP-handler-to-erc-dcc.patch --] [-- Type: text/x-patch, Size: 1112 bytes --] From c287eeaa4dd5f6ec592fdc4138492a034723d398 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <jp@neverwas.me> Date: Sat, 25 Mar 2023 09:13:40 -0700 Subject: [PATCH 2/3] Add subcommand erc-cmd-HELP handler to erc-dcc * lisp/erc/erc-dcc.el (erc-cmd-DCC): Elect to tokenize line specially. (erc-dcc--cmd-help): Add help handler. --- lisp/erc/erc-dcc.el | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el index 4c557e0e0f9..05eced6a391 100644 --- a/lisp/erc/erc-dcc.el +++ b/lisp/erc/erc-dcc.el @@ -404,8 +404,17 @@ erc-cmd-DCC (apropos "erc-dcc-do-.*-command") t)))) +(put 'erc-cmd-DCC 'do-not-parse-args t) (autoload 'pcomplete-erc-all-nicks "erc-pcomplete") +(defun erc-dcc--cmd-help (&rest args) + (describe-function + (or (and args (intern-soft (concat "erc-dcc-do-" + (upcase (car args)) "-command"))) + 'erc-cmd-DCC))) + +(put 'erc-cmd-DCC 'erc--cmd-help #'erc-dcc--cmd-help) + ;;;###autoload (defun pcomplete/erc-mode/DCC () "Provide completion for the /DCC command." -- 2.39.2 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #5: 0003-Fix-DCC-GET-flag-parsing-in-erc-dcc.patch --] [-- Type: text/x-patch, Size: 11801 bytes --] From 76baf9840010ba181547bbed5d86a29171922054 Mon Sep 17 00:00:00 2001 From: Daniel Pettersson <daniel@dpettersson.net> 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 ^ permalink raw reply related [flat|nested] 11+ messages in thread
* bug#62444: [PATCH] erc: Fix "dcc get" flag parsing 2023-03-25 15:25 bug#62444: [PATCH] erc: Fix "dcc get" flag parsing Daniel Pettersson 2023-03-26 4:10 ` J.P. [not found] ` <87a600xidp.fsf@neverwas.me> @ 2023-04-05 18:27 ` Daniel Pettersson 2023-04-08 22:53 ` J.P. 2 siblings, 1 reply; 11+ messages in thread From: Daniel Pettersson @ 2023-04-05 18:27 UTC (permalink / raw) To: 62444 [-- Attachment #1: Type: text/plain, Size: 2275 bytes --] Hi J.P., Sorry for the delay for some reason the responses bounced my mailbox, first and foremost I would like to thank you for your patience and clarity in your response. > Lastly, I have to mention the dreaded copyright thing because I couldn't > tell from the discussion for bug#57905 whether you ended up filing. If > not and we go with changes resembling those you've proposed, you'll > probably want to do so. Attached my assignment. > AFAIK, nicknames can't normally begin with a ?-, and attempting to > procure one like that will earn you a > > :mercury.libera.chat 432 testing123 -testing123 :Erroneous nickname > > or similar. Of course, if you know of any popular servers where this > isn't the case, please share. I didn't manage to find a case where ?- is allowed, don't really know where I got that idea from. > In the interest of preserving some symmetry with DCC SEND, which quotes > its outgoing arguments, I think erc-dcc should parse its own input line > rather than rely on the treatment from `erc-extract-command-from-line'. > This approach seems to work in cursory trials, but a few complications > arise when it comes to completion (also present in ERC <5.5.), although > there are workarounds. (How's your pcomplete-fu?) I can't say that I am one of the enlightened ones ;). > Alas, the following are just mechanical, style-related nits. Ignore them > if you wish, but please see the attached patches for a reprise of your > initial proposal with the changes I've outlined applied atop. (The first > two patches are just thrown in for convenience but ultimately > unrelated.) This is great, reminds me that I have some homework here; coding standard, reading some more elisp in emacs packages and the bug reporting. Sorry about that. > Some of the above, such as (setq foo (cons x foo)) instead of `push' and > `seq-contains-p' instead of `member', might distract a few readers. I > don't really care, personally. I'll also add that I was not really happy with my implementation as it was far from elegant. > As mentioned, I've taken a slightly different tack WRT parsing based on > the presence of pre-quoted args. Please check it out, give feedback, and > by all means iterate. I don't have any feedback, looks great to me! Thanks! [-- Attachment #2: Pettersson.GNU.EMACS.1875138.pdf --] [-- Type: application/pdf, Size: 1102367 bytes --] ^ permalink raw reply [flat|nested] 11+ messages in thread
* bug#62444: [PATCH] erc: Fix "dcc get" flag parsing 2023-04-05 18:27 ` Daniel Pettersson @ 2023-04-08 22:53 ` J.P. 2023-07-08 3:22 ` Fernando de Morais [not found] ` <878rbrxfkl.fsf@gmail.com> 0 siblings, 2 replies; 11+ messages in thread From: J.P. @ 2023-04-08 22:53 UTC (permalink / raw) To: Daniel Pettersson; +Cc: emacs-erc, 62444-done Hi Daniel, Daniel Pettersson <daniel@dpettersson.net> writes: > Hi J.P., > > Sorry for the delay for some reason the responses bounced my mailbox, > first and foremost I would like to thank you for your patience and > clarity in your response. Not at all, and you're welcome. >> Lastly, I have to mention the dreaded copyright thing because I couldn't >> tell from the discussion for bug#57905 whether you ended up filing. If >> not and we go with changes resembling those you've proposed, you'll >> probably want to do so. > > Attached my assignment. Thanks. (I would have taken your word for it). >> Alas, the following are just mechanical, style-related nits. Ignore them >> if you wish, but please see the attached patches for a reprise of your >> initial proposal with the changes I've outlined applied atop. (The first >> two patches are just thrown in for convenience but ultimately >> unrelated.) > > This is great, reminds me that I have some homework here; coding > standard, reading some more elisp in emacs packages and the bug > reporting. > > Sorry about that. No worries. I'm quite the serial offender myself. >> As mentioned, I've taken a slightly different tack WRT parsing based on >> the presence of pre-quoted args. Please check it out, give feedback, and >> by all means iterate. > > I don't have any feedback, looks great to me! Cool. I've added your changes to master and will probably backport the bug-fixing portion to 29.1 (or 29.2) once we figure out what to do with ERC's version number on the release branch. Thanks, and please consider contributing to ERC again in the future! ^ permalink raw reply [flat|nested] 11+ messages in thread
* bug#62444: [PATCH] erc: Fix "dcc get" flag parsing 2023-04-08 22:53 ` J.P. @ 2023-07-08 3:22 ` Fernando de Morais [not found] ` <878rbrxfkl.fsf@gmail.com> 1 sibling, 0 replies; 11+ messages in thread From: Fernando de Morais @ 2023-07-08 3:22 UTC (permalink / raw) To: 62444; +Cc: emacs-erc, daniel, jp Hello J.P. and Daniel, I don't know if this behaviour is related to the changes discussed in this bug report, but I can no longer receive files from senders whose nicknames contains a "|" pipe character. Example: /DCC GET EXAMPLE|Nick file_name.txt ERC returns in its buffer (followed by an *Apropos* buffer showing up in another window): *** DCC: Nick undefined subcommand. GET, CHAT and LIST are defined. Thanks in advance for any help. -- Regards, Fernando de Morais. ^ permalink raw reply [flat|nested] 11+ messages in thread
[parent not found: <878rbrxfkl.fsf@gmail.com>]
* bug#62444: [PATCH] erc: Fix "dcc get" flag parsing [not found] ` <878rbrxfkl.fsf@gmail.com> @ 2023-07-08 4:24 ` J.P. 2023-07-08 12:56 ` Fernando de Morais [not found] ` <87sf9ywohp.fsf@gmail.com> 0 siblings, 2 replies; 11+ messages in thread From: J.P. @ 2023-07-08 4:24 UTC (permalink / raw) To: Fernando de Morais; +Cc: 62444, emacs-erc, daniel [-- Attachment #1: Type: text/plain, Size: 527 bytes --] Hi Fernando, Fernando de Morais <fernandodemorais.jf@gmail.com> writes: > I can no longer receive files from senders whose > nicknames contains a "|" pipe character. > > Example: > > /DCC GET EXAMPLE|Nick file_name.txt > > ERC returns in its buffer (followed by an *Apropos* buffer showing up in > another window): > > *** DCC: Nick undefined subcommand. GET, CHAT and LIST are defined. Thanks for the heads up. This looks like my bad. Would something like the attached (untried) maybe suffice as a temporary workaround? [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: fernando.diff --] [-- Type: text/x-patch, Size: 861 bytes --] diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el index 29892b78a39..6f091668087 100644 --- a/lisp/erc/erc-compat.el +++ b/lisp/erc/erc-compat.el @@ -461,10 +461,14 @@ erc-compat--28-split-string-shell-command (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)) + `(progn + (advice-add 'shell-backward-command :override #'goto-char) + (unwind-protect + ,(list (if (fboundp 'split-string-shell-command) + 'split-string-shell-command + 'erc-compat--28-split-string-shell-command) + string) + (advice-remove 'shell-backward-command #'goto-char)))) (provide 'erc-compat) ^ permalink raw reply related [flat|nested] 11+ messages in thread
* bug#62444: [PATCH] erc: Fix "dcc get" flag parsing 2023-07-08 4:24 ` J.P. @ 2023-07-08 12:56 ` Fernando de Morais [not found] ` <87sf9ywohp.fsf@gmail.com> 1 sibling, 0 replies; 11+ messages in thread From: Fernando de Morais @ 2023-07-08 12:56 UTC (permalink / raw) To: J.P.; +Cc: 62444, emacs-erc, daniel 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... 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). Thanks! -- Regards, Fernando de Morais. ^ permalink raw reply [flat|nested] 11+ messages in thread
[parent not found: <87sf9ywohp.fsf@gmail.com>]
* bug#62444: [PATCH] erc: Fix "dcc get" flag parsing [not found] ` <87sf9ywohp.fsf@gmail.com> @ 2023-07-08 14:18 ` J.P. [not found] ` <87ttue32rd.fsf@neverwas.me> 1 sibling, 0 replies; 11+ messages in thread From: J.P. @ 2023-07-08 14:18 UTC (permalink / raw) To: Fernando de Morais; +Cc: 62444, emacs-erc, daniel [-- 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 ^ permalink raw reply related [flat|nested] 11+ messages in thread
[parent not found: <87ttue32rd.fsf@neverwas.me>]
* bug#62444: [PATCH] erc: Fix "dcc get" flag parsing [not found] ` <87ttue32rd.fsf@neverwas.me> @ 2023-07-09 18:02 ` Fernando de Morais [not found] ` <871qhh55g2.fsf@gmail.com> 1 sibling, 0 replies; 11+ messages in thread From: Fernando de Morais @ 2023-07-09 18:02 UTC (permalink / raw) To: J.P.; +Cc: 62444, emacs-erc, daniel Hi J.P., "J.P." <jp@neverwas.me> writes: > Gah, right, that was a dumb hack anyway. I shouldn't have suggested it. It's always nice to help test ERC solutions, so don't worry about it! 😄 > 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. I've applied the patch and tested it: the problem was solved! Thanks for all the work on ERC! -- Regards, Fernando de Morais. ^ permalink raw reply [flat|nested] 11+ messages in thread
[parent not found: <871qhh55g2.fsf@gmail.com>]
* bug#62444: [PATCH] erc: Fix "dcc get" flag parsing [not found] ` <871qhh55g2.fsf@gmail.com> @ 2023-07-14 2:22 ` J.P. 0 siblings, 0 replies; 11+ messages in thread From: J.P. @ 2023-07-14 2:22 UTC (permalink / raw) To: Fernando de Morais; +Cc: 62444, emacs-erc, daniel Hi Fernando, Fernando de Morais <fernandodemorais.jf@gmail.com> writes: > I've applied the patch and tested it: the problem was solved! Awesome! I've just now installed the patch [1]. Really appreciate the feedback, as always. > Thanks for all the work on ERC! You bet. (Not sure I'm owed much gratitude for cleaning up my own messes, but I'll take it!) Cheers, J.P. [1] https://git.savannah.gnu.org/cgit/emacs.git/commit/?id=b95bb644 ^ permalink raw reply [flat|nested] 11+ messages in thread
end of thread, other threads:[~2023-07-14 2:22 UTC | newest] Thread overview: 11+ messages (download: mbox.gz follow: Atom feed -- links below jump to the message on this page -- 2023-03-25 15:25 bug#62444: [PATCH] erc: Fix "dcc get" flag parsing Daniel Pettersson 2023-03-26 4:10 ` J.P. [not found] ` <87a600xidp.fsf@neverwas.me> 2023-03-27 3:50 ` J.P. 2023-04-05 18:27 ` Daniel Pettersson 2023-04-08 22:53 ` J.P. 2023-07-08 3:22 ` Fernando de Morais [not found] ` <878rbrxfkl.fsf@gmail.com> 2023-07-08 4:24 ` J.P. 2023-07-08 12:56 ` Fernando de Morais [not found] ` <87sf9ywohp.fsf@gmail.com> 2023-07-08 14:18 ` J.P. [not found] ` <87ttue32rd.fsf@neverwas.me> 2023-07-09 18:02 ` Fernando de Morais [not found] ` <871qhh55g2.fsf@gmail.com> 2023-07-14 2:22 ` J.P.
Code repositories for project(s) associated with this external index https://git.savannah.gnu.org/cgit/emacs.git https://git.savannah.gnu.org/cgit/emacs/org-mode.git This is an external index of several public inboxes, see mirroring instructions on how to clone and mirror all data and code used by this external index.