* 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
* 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
* 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
* 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
* 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
* 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.