unofficial mirror of bug-gnu-emacs@gnu.org 
 help / color / mirror / code / Atom feed
* 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

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