From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: "J.P." Newsgroups: gmane.emacs.bugs Subject: bug#62444: [PATCH] erc: Fix "dcc get" flag parsing Date: Sun, 26 Mar 2023 20:50:00 -0700 Message-ID: <87jzz2n993.fsf__9162.61696709029$1679889100$gmane$org@neverwas.me> References: <87a600xidp.fsf@neverwas.me> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="4528"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Cc: 62444@debbugs.gnu.org, emacs-erc@gnu.org To: Daniel Pettersson Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Mon Mar 27 05:51:31 2023 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1pgdtK-0000qr-JF for geb-bug-gnu-emacs@m.gmane-mx.org; Mon, 27 Mar 2023 05:51:31 +0200 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1pgdsu-0007on-38; Sun, 26 Mar 2023 23:51:04 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1pgdss-0007oY-8H for bug-gnu-emacs@gnu.org; Sun, 26 Mar 2023 23:51:02 -0400 Original-Received: from debbugs.gnu.org ([209.51.188.43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1pgdss-00069W-0Y for bug-gnu-emacs@gnu.org; Sun, 26 Mar 2023 23:51:02 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1pgdsr-0003Yx-ML for bug-gnu-emacs@gnu.org; Sun, 26 Mar 2023 23:51:01 -0400 X-Loop: help-debbugs@gnu.org Resent-From: "J.P." Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Mon, 27 Mar 2023 03:51:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 62444 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch Original-Received: via spool by 62444-submit@debbugs.gnu.org id=B62444.167988901813634 (code B ref 62444); Mon, 27 Mar 2023 03:51:01 +0000 Original-Received: (at 62444) by debbugs.gnu.org; 27 Mar 2023 03:50:18 +0000 Original-Received: from localhost ([127.0.0.1]:46191 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pgds8-0003Xp-Ra for submit@debbugs.gnu.org; Sun, 26 Mar 2023 23:50:18 -0400 Original-Received: from mail-108-mta181.mxroute.com ([136.175.108.181]:44533) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pgds5-0003Xb-Nn for 62444@debbugs.gnu.org; Sun, 26 Mar 2023 23:50:15 -0400 Original-Received: from mail-111-mta2.mxroute.com ([136.175.111.2] filter006.mxroute.com) (Authenticated sender: mN4UYu2MZsgR) by mail-108-mta181.mxroute.com (ZoneMTA) with ESMTPSA id 187212ffe64000edb4.001 for <62444@debbugs.gnu.org> (version=TLSv1/SSLv3 cipher=ECDHE-RSA-AES128-GCM-SHA256); Mon, 27 Mar 2023 03:50:06 +0000 X-Zone-Loop: 1677648de492e62bf0a5ee3ec3f0ffaa0e79fc520231 X-Originating-IP: [136.175.111.2] DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=neverwas.me ; s=x; h=Content-Type:MIME-Version:Message-ID:Date:References:In-Reply-To: Subject:Cc:To:From:Sender:Reply-To:Content-Transfer-Encoding:Content-ID: Content-Description:Resent-Date:Resent-From:Resent-Sender:Resent-To:Resent-Cc :Resent-Message-ID:List-Id:List-Help:List-Unsubscribe:List-Subscribe: List-Post:List-Owner:List-Archive; bh=IjheHvDg9CXJsj2vI0WAvles0F0zHYwjxLrS5HsPabI=; b=H4ZRvIVbP+iVsuqXzSfp+kE4Os xnVKnMivqttob2ePXUA3EHDC7K12voI8Dlc9DYioQ+rJVIGdFV70pbukKEbDmQFcfycoKlDSOOWID zapfazXYCe/5H0lVqNWsKbcB3c7FK+H9zD/0BsHVr1+R+5Vt+yFCGcidXSelRAZSeCRkjG95XzbrY CzypHj7cE+45gE0fBiBibU+48ZImsmEYIS296wc1liv2cFAehADHDc7ddAJcuzB9d61/BY4t/hcEA TykRj5UAqDbbiWw5BJcg7Lq4sWPcekTg23KgaUvE+aJWwC+J4kHqMJSYFKeTjzltKokSHiISPbpgA TumadP9g==; In-Reply-To: <87a600xidp.fsf@neverwas.me> (J. P.'s message of "Sat, 25 Mar 2023 21:10:26 -0700") X-Authenticated-Id: masked@neverwas.me X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Original-Sender: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Xref: news.gmane.io gmane.emacs.bugs:258709 Archived-At: --=-=-= Content-Type: text/plain Hi Daniel, Daniel Pettersson 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! --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0000-v0-v1.diff >From 76baf9840010ba181547bbed5d86a29171922054 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" 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 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0001-Add-subcommand-dispatch-facility-to-erc-cmd-HELP.patch >From e4aa6d281e492edb1ca8a6f3c50586fdffe7867e Mon Sep 17 00:00:00 2001 From: "F. Jason Park" 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 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0002-Add-subcommand-erc-cmd-HELP-handler-to-erc-dcc.patch >From c287eeaa4dd5f6ec592fdc4138492a034723d398 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" 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 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0003-Fix-DCC-GET-flag-parsing-in-erc-dcc.patch >From 76baf9840010ba181547bbed5d86a29171922054 Mon Sep 17 00:00:00 2001 From: Daniel Pettersson Date: Sat, 25 Mar 2023 16:25:48 +0100 Subject: [PATCH 3/3] Fix DCC GET flag parsing in erc-dcc * lisp/erc/erc-dcc.el (erc-cmd-DCC): Elect to tokenize line specially. (pcomplete/erc-mode/DCC): Quote file names when suggesting. Account for double-hyphen end-of-options separator. (erc-dcc-do-GET-command): Simplify signature, subsuming NICK in variadic args, now ARGS instead of FILE, which changes the arity from (2 . many) to (1 . many). Explain usage in doc string. Honor an optional separator, "--", if present. (Bug#62444) * test/lisp/erc/erc-dcc-tests.el (erc-dcc-do-GET-command): Call new parameterized helper with various flags/file combinations. (erc-dcc-tests--erc-dcc-do-GET-command): New fixture function. (pcomplete/erc-mode/DCC--get-quoted, pcomplete/erc-mode/DCC--get-sep): New tests. --- lisp/erc/erc-dcc.el | 56 +++++++++++++++++++++------- test/lisp/erc/erc-dcc-tests.el | 67 +++++++++++++++++++++++++++------- 2 files changed, 95 insertions(+), 28 deletions(-) diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el index 05eced6a391..5406369c62f 100644 --- a/lisp/erc/erc-dcc.el +++ b/lisp/erc/erc-dcc.el @@ -43,7 +43,7 @@ ;; /dcc chat nick - Either accept pending chat offer from nick, or offer ;; DCC chat to nick ;; /dcc close type [nick] - Close DCC connection (SEND/GET/CHAT) with nick -;; /dcc get [-t][-s] nick [file] - Accept DCC offer from nick +;; /dcc get [-t][-s] nick [--] file - Accept DCC offer from nick ;; /dcc list - List all DCC offers/connections ;; /dcc send nick file - Offer DCC SEND to nick @@ -389,12 +389,18 @@ erc-dcc-get-default-directory :type '(choice (const :value nil :tag "Default directory") directory)) ;;;###autoload -(defun erc-cmd-DCC (cmd &rest args) +(defun erc-cmd-DCC (line &rest compat-args) "Parser for /dcc command. This figures out the dcc subcommand and calls the appropriate routine to handle it. The function dispatched should be named \"erc-dcc-do-FOO-command\", where FOO is one of CLOSE, GET, SEND, LIST, CHAT, etc." - (when cmd + (let (cmd args) + ;; Called as library function (i.e., not directly as /dcc) + (if compat-args + (setq cmd line + args compat-args) + (setq args (delete "" (split-string-shell-command line)) + cmd (pop args))) (let ((fn (intern-soft (concat "erc-dcc-do-" (upcase cmd) "-command")))) (if fn (apply fn erc-server-process args) @@ -439,15 +445,20 @@ pcomplete/erc-mode/DCC (eq (plist-get elt :type) 'GET)) erc-dcc-list))) ('send (pcomplete-erc-all-nicks)))) + (when (equal "get" (downcase (pcomplete-arg 'first 1))) + (pcomplete-opt "-")) (pcomplete-here (pcase (intern (downcase (pcomplete-arg 'first 1))) - ('get (mapcar (lambda (elt) (plist-get elt :file)) + ('get (mapcar (lambda (elt) + (combine-and-quote-strings (list (plist-get elt :file)))) (cl-remove-if-not (lambda (elt) (and (eq (plist-get elt :type) 'GET) (erc-nick-equal-p (erc-extract-nick (plist-get elt :nick)) - (pcomplete-arg 1)))) + (pcase (pcomplete-arg 1) + ("--" (pcomplete-arg 2)) + (v v))))) erc-dcc-list))) ('close (mapcar #'erc-dcc-nick (cl-remove-if-not @@ -513,16 +524,33 @@ erc-dcc-do-CLOSE-command ?n (erc-extract-nick (plist-get ret :nick)))))) t)) -(defun erc-dcc-do-GET-command (proc nick &rest file) - "Do a DCC GET command. NICK is the person who is sending the file. -FILE is the filename. If FILE is split into multiple arguments, -re-join the arguments, separated by a space. -PROC is the server process." - (let* ((args (seq-group-by (lambda (s) (eq ?- (aref s 0))) (cons nick file))) +(defun erc-dcc-do-GET-command (proc &rest args) + "Perform a DCC GET command. +Recognize input conforming to the following usage syntax: + + /DCC GET [-t|-s] nick [--] filename + + nick The person who is sending the file. + filename The filename to be downloaded. Can be split into multiple + arguments that are then joined by a space. + flags \"-t\" sets `:turbo' see `erc-dcc-list' + \"-s\" sets `:secure' see `erc-dcc-list' + \"--\" indicates end of options + All of which are optional. + +Expect PROC to be the server process and ARGS to contain +everything after the subcommand \"GET\" in the usage description +above." + ;; Despite the advertised syntax above, we currently respect flags + ;; in these positions: [flag] nick [flag] filename [flag] + (let* ((trailing (and-let* ((trailing (member "--" args))) + (setq args (butlast args (length trailing))) + (cdr trailing))) + (args (seq-group-by (lambda (s) (eq ?- (aref s 0))) args)) (flags (prog1 (cdr (assq t args)) - (setq args (cdr (assq nil args)) - nick (pop args) - file (and args (mapconcat #'identity args " "))))) + (setq args (nconc (cdr (assq nil args)) trailing)))) + (nick (pop args)) + (file (and args (mapconcat #'identity args " "))) (elt (erc-dcc-member :nick nick :type 'GET :file file)) (filename (or file (plist-get elt :file) "unknown"))) (if elt diff --git a/test/lisp/erc/erc-dcc-tests.el b/test/lisp/erc/erc-dcc-tests.el index bd8a9fc7951..fed86eff2c5 100644 --- a/test/lisp/erc/erc-dcc-tests.el +++ b/test/lisp/erc/erc-dcc-tests.el @@ -100,7 +100,7 @@ erc-dcc-handle-ctcp-send--base (ert-deftest erc-dcc-handle-ctcp-send--turbo () (erc-dcc-tests--dcc-handle-ctcp-send t)) -(ert-deftest erc-dcc-do-GET-command () +(defun erc-dcc-tests--erc-dcc-do-GET-command (file &optional sep) (with-temp-buffer (let* ((proc (start-process "fake" (current-buffer) "sleep" "10")) (elt (list :nick "tester!~tester@fake.irc" @@ -109,7 +109,7 @@ erc-dcc-do-GET-command :parent proc :ip "127.0.0.1" :port "9899" - :file "foo.bin" + :file file :size 1405135128)) (erc-dcc-list (list elt)) ;; @@ -124,7 +124,7 @@ erc-dcc-do-GET-command erc-server-current-nick "dummy") (set-process-query-on-exit-flag proc nil) (cl-letf (((symbol-function 'read-file-name) - (lambda (&rest _) "foo.bin")) + (lambda (&rest _) file)) ((symbol-function 'erc-dcc-get-file) (lambda (&rest r) (push r calls)))) (goto-char (point-max)) @@ -134,38 +134,44 @@ erc-dcc-do-GET-command (ert-info ("No turbo") (should-not (plist-member elt :turbo)) (goto-char erc-input-marker) - (insert "/dcc GET tester foo.bin") + (insert "/dcc GET tester " (or sep "") (prin1-to-string file)) (erc-send-current-line) (should-not (plist-member (car erc-dcc-list) :turbo)) - (should (equal (pop calls) (list elt "foo.bin" proc)))) + (should (equal (pop calls) (list elt file proc)))) (ert-info ("Arg turbo in pos 2") (should-not (plist-member elt :turbo)) (goto-char erc-input-marker) - (insert "/dcc GET -t tester foo.bin") + (insert "/dcc GET -t tester " (or sep "") (prin1-to-string file)) (erc-send-current-line) (should (eq t (plist-get (car erc-dcc-list) :turbo))) - (should (equal (pop calls) (list elt "foo.bin" proc)))) + (should (equal (pop calls) (list elt file proc)))) (ert-info ("Arg turbo in pos 4") (setq elt (plist-put elt :turbo nil) erc-dcc-list (list elt)) (goto-char erc-input-marker) - (insert "/dcc GET tester -t foo.bin") + (insert "/dcc GET tester -t " (or sep "") (prin1-to-string file)) (erc-send-current-line) (should (eq t (plist-get (car erc-dcc-list) :turbo))) - (should (equal (pop calls) (list elt "foo.bin" proc)))) + (should (equal (pop calls) (list elt file proc)))) (ert-info ("Arg turbo in pos 6") (setq elt (plist-put elt :turbo nil) erc-dcc-list (list elt)) (goto-char erc-input-marker) - (insert "/dcc GET tester foo.bin -t") + (insert "/dcc GET tester " (prin1-to-string file) " -t" (or sep "")) (erc-send-current-line) - (should (eq t (plist-get (car erc-dcc-list) :turbo))) - (should (equal (pop calls) (list elt "foo.bin" proc)))))))) + (should (eq (if sep nil t) (plist-get (car erc-dcc-list) :turbo))) + (should (equal (pop calls) (if sep nil (list elt file proc))))))))) + +(ert-deftest erc-dcc-do-GET-command () + (erc-dcc-tests--erc-dcc-do-GET-command "foo.bin") + (erc-dcc-tests--erc-dcc-do-GET-command "foo - file.bin") + (erc-dcc-tests--erc-dcc-do-GET-command "foo -t file.bin") + (erc-dcc-tests--erc-dcc-do-GET-command "-t" "-- ")) -(defun erc-dcc-tests--pcomplete-common (test-fn) +(defun erc-dcc-tests--pcomplete-common (test-fn &optional file) (with-current-buffer (get-buffer-create "*erc-dcc-do-GET-command*") (let* ((inhibit-message noninteractive) (proc (start-process "fake" (current-buffer) "sleep" "10")) @@ -175,7 +181,7 @@ erc-dcc-tests--pcomplete-common :parent proc :ip "127.0.0.1" :port "9899" - :file "foo.bin" + :file (or file "foo.bin") :size 1405135128)) ;; erc-accidental-paste-threshold-seconds @@ -211,6 +217,20 @@ pcomplete/erc-mode/DCC--get-basic (beginning-of-line) (should (search-forward "/dcc get tester foo.bin" nil t)))))) +(ert-deftest pcomplete/erc-mode/DCC--get-quoted () + (erc-dcc-tests--pcomplete-common + (lambda () + (insert "/dcc get ") + (call-interactively #'completion-at-point) + (save-excursion + (beginning-of-line) + (should (search-forward "/dcc get tester" nil t))) + (call-interactively #'completion-at-point) + (save-excursion + (beginning-of-line) + (should (search-forward "/dcc get tester \"foo bar.bin\"" nil t)))) + "foo bar.bin")) + (ert-deftest pcomplete/erc-mode/DCC--get-1flag () (erc-dcc-tests--pcomplete-common (lambda () @@ -282,4 +302,23 @@ pcomplete/erc-mode/DCC--get-2flags-reverse (beginning-of-line) (should (search-forward "/dcc get -t -s tester foo.bin" nil t)))))) +(ert-deftest pcomplete/erc-mode/DCC--get-sep () + (erc-dcc-tests--pcomplete-common + (lambda () + (insert "/dcc get ") + (call-interactively #'completion-at-point) + (save-excursion + (beginning-of-line) + (should (search-forward "/dcc get tester" nil t))) + (insert "-") + (call-interactively #'completion-at-point) + (save-excursion + (beginning-of-line) + (should (search-forward "/dcc get tester -- " nil t))) + (call-interactively #'completion-at-point) + (save-excursion + (beginning-of-line) + (should (search-forward "/dcc get tester -- -t" nil t)))) + "-t")) + ;;; erc-dcc-tests.el ends here -- 2.39.2 --=-=-=--