From: "J.P." <jp@neverwas.me>
To: Daniel Pettersson <daniel@dpettersson.net>
Cc: 62444@debbugs.gnu.org, emacs-erc@gnu.org
Subject: bug#62444: [PATCH] erc: Fix "dcc get" flag parsing
Date: Sun, 26 Mar 2023 20:50:00 -0700 [thread overview]
Message-ID: <87jzz2n993.fsf__9162.61696709029$1679889100$gmane$org@neverwas.me> (raw)
In-Reply-To: <87a600xidp.fsf@neverwas.me> (J. P.'s message of "Sat, 25 Mar 2023 21:10:26 -0700")
[-- 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
next prev parent reply other threads:[~2023-03-27 3:50 UTC|newest]
Thread overview: 11+ messages / expand[flat|nested] mbox.gz Atom feed top
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. [this message]
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.
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to='87jzz2n993.fsf__9162.61696709029$1679889100$gmane$org@neverwas.me' \
--to=jp@neverwas.me \
--cc=62444@debbugs.gnu.org \
--cc=daniel@dpettersson.net \
--cc=emacs-erc@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).