Re: bug#54458: 27.2; erc-dcc-get: Re-entering top level after C stack overflow
"J.P." <[email protected]>
| Newsgroups | gmane.emacs.erc.general |
|---|---|
| Message-ID | <[email protected]> |
Hi Fernando, Fernando de Morais <[email protected]> writes: > Unfortunately, however, I couldn't use DCC GET when > `erc-dcc-get-use-subprocess' is t. The transfer fails and a message like > this appears: > > *** DCC: file <file_name> > transfer failed at 0 of <file-size> in 0 seconds > > In this scenario, I tried to receive files from another sender (on the > same server), but the same thing happened. Sorry about that. I shouldn't have asked you to try those patches. That whole idea was half-baked and the execution super shoddy. And on that note, please try these patches! I've abandoned the subprocess stuff and am instead introducing a simple flag that inhibits all reporting. A user can set it explicitly, or it can be activated automatically when something nonstandard (but specific) is detected. If you're willing, please try receiving once as you normally would. But if the loss of control persists, try issuing a /dcc get -t sender file on the next go around. Thanks for your patience!
0000-v3-v4.diff
(text/x-patch, 17.5 KB)
From 36a9c136e23dabfb913ebf98a4a7fb4389604cf6 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> Date: Sat, 30 Apr 2022 00:32:33 -0700 Subject: [PATCH 0/4] *** NOT A PATCH *** *** BLURB HERE *** F. Jason Park (4): Display error message on incomplete ERC DCC transfer Don't send reports in erc-dcc-get-filter when nested Allow matching against string values in erc-dcc-member Accept turbo param in erc-dcc-do-GET-command lisp/erc/erc-dcc.el | 90 ++++++++++++------- test/lisp/erc/erc-dcc-tests.el | 157 +++++++++++++++++++++++++++++++++ 2 files changed, 214 insertions(+), 33 deletions(-) create mode 100644 test/lisp/erc/erc-dcc-tests.el Interdiff: diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el index d8452f2661..cfa8422b1c 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 nick [file] - Accept DCC offer from nick +;; /dcc get [-t] nick [file] - Accept DCC offer from nick ;; /dcc list - List all DCC offers/connections ;; /dcc send nick file - Offer DCC SEND to nick @@ -105,7 +105,9 @@ erc-dcc-list :file - for outgoing sends, the full path to the file. For incoming sends, the suggested filename or vetted filename - :size - size of the file, may be nil on incoming DCCs") + :size - size of the file, may be nil on incoming DCCs + + :turbo - optional item indicating sender support for TSEND.") (defun erc-dcc-list-add (type nick peer parent &rest args) "Add a new entry of type TYPE to `erc-dcc-list' and return it." @@ -149,9 +151,9 @@ erc-dcc-open-network-stream (dcc-get-file-too-long . "DCC: %f: File longer than sender claimed; aborting transfer") (dcc-get-notfound . "DCC: %n hasn't offered %f for DCC transfer") - (dcc-list-head . "DCC: From Type Active Size Filename") - (dcc-list-line . "DCC: -------- ---- ------ -------------- --------") - (dcc-list-item . "DCC: %-8n %-4t %-6a %-14s %f") + (dcc-list-head . "DCC: From Type Active Size Filename") + (dcc-list-line . "DCC: -------- ---- ------ ----------------- --------") + (dcc-list-item . "DCC: %-8n %-4t %-6a %-17s %f%u") (dcc-list-end . "DCC: End of list.") (dcc-malformed . "DCC: error: %n (%u@%h) sent malformed request: %q") (dcc-privileged-port @@ -506,8 +508,13 @@ erc-dcc-do-GET-command FILE is the filename. If FILE is split into multiple arguments, re-join the arguments, separated by a space. PROC is the server process." - (setq file (and file (mapconcat #'identity file " "))) - (let* ((elt (erc-dcc-member :nick nick :type 'GET :file file)) + (let* ((turbo (prog1 (and (cond ((string= nick "-t") + (setq nick (pop file))) + ((member "-t" file) + (setq file (delete "-t" file)))) + t) + (setq file (and file (mapconcat #'identity file " "))))) + (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 @@ -527,13 +534,21 @@ erc-dcc-do-GET-command 'dcc-get-cmd-aborted ?n nick ?f filename))) (t - (erc-dcc-get-file elt file proc)))) + (erc-dcc-get-file elt file proc))) + (when turbo + (setq erc-dcc-list (cons (plist-put elt :turbo t) + (delq elt erc-dcc-list))))) (erc-display-message nil '(notice error) 'active 'dcc-get-notfound ?n nick ?f filename)))) (defvar-local erc-dcc-byte-count nil) +;; Experimental flag to indicate TGET-style report omissions +;; see https://www.visualirc.net/tech-tdcc.php +;; FIXME actually, we don't need this (drop after adding unit test) +(defvar erc-dcc--force-turbo nil) + (defun erc-dcc-do-LIST-command (_proc) "This is the handler for the /dcc list command. It lists the current state of `erc-dcc-list' in an easy to read manner." @@ -576,7 +591,8 @@ erc-dcc-do-LIST-command (format " (%d%%)" (floor (* 100.0 byte-count) (plist-get elt :size)))))) - ?f (or (and (plist-member elt :file) (plist-get elt :file)) ""))) + ?f (or (and (plist-member elt :file) (plist-get elt :file)) "") + ?u (if (or erc-dcc--force-turbo (plist-get elt :turbo)) " (T)" ""))) (erc-display-message nil 'notice 'active 'dcc-list-end) @@ -626,7 +642,7 @@ erc-dcc-ctcp-query-send-regexp ;; or filename enclosed in double quotes with any number ;; of escaped double quotes inside. "\"\\(\\(?:\\\\\"\\|[^\"\\]\\)+\\)\"\\|\\([^ ]+\\)" - "\\) \\([0-9]+\\) \\([0-9]+\\) *\\([0-9]*\\)")) + "\\) \\([0-9]+\\) \\([0-9]+\\) *\\([0-9]*\\) ?\\(T\\)?")) (define-inline erc-dcc-unquote-filename (filename) (inline-quote @@ -656,7 +672,8 @@ erc-dcc-handle-ctcp-send (erc-dcc-unquote-filename (match-string 1 query)))) (ip (erc-decimal-to-ip (match-string 3 query))) (port (match-string 4 query)) - (size (match-string 5 query))) + (size (match-string 5 query)) + (turbo (match-string 6 query))) ;; FIXME: a warning really should also be sent ;; if the ip address != the host the dcc sender is on. (erc-display-message @@ -673,7 +690,8 @@ erc-dcc-handle-ctcp-send 'GET (format "%s!%s@%s" nick login host) nil proc :ip ip :port port :file filename - :size (string-to-number size)) + :size (string-to-number size) + :turbo (and turbo t)) (if (and (eq erc-dcc-send-request 'auto) (erc-dcc-auto-mask-p (format "\"%s!%s@%s\"" nick login host))) (erc-dcc-get-file (car erc-dcc-list) filename proc)))) @@ -897,7 +915,10 @@ erc-dcc-receive-cache (defvar-local erc-dcc-file-name nil) -(defun erc-dcc--get-file (entry file parent-proc) +(defun erc-dcc-get-file (entry file parent-proc) + "Set up a transfer from the remote client to the local over a TCP connection. +This involves setting up a process filter and a process sentinel, +and making the connection." (let* ((buffer (generate-new-buffer (file-name-nondirectory file))) proc) (with-current-buffer buffer @@ -935,71 +956,6 @@ erc-dcc--get-file (setq erc-dcc-entry-data (plist-put (plist-put entry :peer proc) :start-time (erc-current-time)))))) -(defcustom erc-dcc-get-use-subprocess nil - "If non-nil, run GET (receive) operations in a subordinate Emacs." - :package-version '(ERC . "5.4.1") ; FIXME make this honest - :type 'boolean) - -(defun erc-dcc--get-display-messages (&rest args) - (pcase-let ((`(,_parsed ,_type ,_buffer ,msg . ,rest) args)) - (message (apply #'erc-format-message msg rest)))) - -(defun erc-dcc--get-file-subprocess-sentinel (proc _event) - (with-current-buffer (process-buffer proc) - (widen) - (goto-char (point-max)) - (while (and (not (looking-at (concat "DCC: " erc-dcc-file-name ":"))) - (zerop (forward-line -1)))) - (when (and (search-forward erc-dcc-file-name nil t) - (search-forward-regexp (rx (group (+ digit))) (point-at-eol) t)) - (setq erc-dcc-byte-count (string-to-number (match-string 0)))) - ;; FIXME factor this out (see other GET sentinel) - (let ((done (= erc-dcc-byte-count (plist-get erc-dcc-entry-data :size)))) - (erc-display-message - nil (if done 'notice '(notice error)) erc-server-process - (if done 'dcc-get-complete 'dcc-get-failed) - ?v (plist-get erc-dcc-entry-data :size) - ?f erc-dcc-file-name - ?s (number-to-string erc-dcc-byte-count) - ?t (format "%.0f" - (erc-time-diff (plist-get erc-dcc-entry-data :start-time) - nil)))) - (kill-buffer))) - -(defun erc-dcc--get-file-subprocess (entry file parent-proc) - (let* ((buf (generate-new-buffer (file-name-nondirectory file))) - (exe (concat invocation-directory invocation-name)) - (prog `(with-current-buffer (messages-buffer) - (setq erc-dcc-verbose t) ;global - (advice-add 'erc-display-message :override - #'erc-dcc--get-display-messages) - (let ((e ',entry) - p) - (erc-dcc--get-file e ,file nil) - (setq p (plist-get e :peer)) - (set-process-query-on-exit-flag p nil) - (message "Starting: %S" (list :entry e :file ,file)) - (while (accept-process-output p))))) - (proc (start-process file buf exe "-Q" "--batch" "-l" "erc-dcc" - "--eval" (prin1-to-string prog)))) - (with-current-buffer buf - (setq erc-dcc-file-name (plist-get entry :file) - erc-dcc-byte-count 0) - (set-process-sentinel proc #'erc-dcc--get-file-subprocess-sentinel) - (setq erc-server-process parent-proc - entry (plist-put entry :peer proc) - entry (plist-put entry :start-time (erc-current-time)) - erc-dcc-entry-data entry)))) - -(defun erc-dcc-get-file (entry file parent-proc) - "Set up a transfer from the remote client to the local over a TCP connection. -This involves setting up a process filter and a process sentinel, -and making the connection." - (if erc-dcc-get-use-subprocess - (erc-dcc--get-file-subprocess (plist-put entry :parent nil) - file parent-proc) - (erc-dcc--get-file entry file parent-proc))) - (defun erc-dcc-append-contents (buffer _file) "Append the contents of BUFFER to FILE. The contents of the BUFFER will then be erased." @@ -1048,7 +1004,9 @@ erc-dcc-get-filter 'dcc-get-file-too-long ?f (file-name-nondirectory (buffer-name))) (delete-process proc)) - ((not (process-get proc :reportingp)) + ((not (or erc-dcc--force-turbo + (plist-get erc-dcc-entry-data :turbo) + (process-get proc :reportingp))) (process-put proc :reportingp t) (process-send-string proc (erc-pack-int received-bytes)) (process-put proc :reportingp nil)))))) @@ -1057,6 +1015,7 @@ erc-dcc-get-sentinel "This is the process sentinel for CTCP DCC SEND connections. It shuts down the connection and notifies the user that the transfer is complete." + ;; FIXME, we should look at EVENT, and also check size. (unless (string= event "connection broken by remote peer\n") (lwarn 'erc :warning "Unexpected sentinel event %S for %s" (string-trim-right event) proc)) diff --git a/test/lisp/erc/erc-dcc-tests.el b/test/lisp/erc/erc-dcc-tests.el new file mode 100644 index 0000000000..64ca3363c7 --- /dev/null +++ b/test/lisp/erc/erc-dcc-tests.el @@ -0,0 +1,157 @@ +;;; erc-dcc-tests.el --- Tests for erc-dcc -*- lexical-binding:t -*- + +;; Copyright (C) 2020-2022 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: +;;; Code: +(require 'ert) +(require 'erc-dcc) + +(ert-deftest erc-dcc-ctcp-query-send-regexp () + (let ((s "DCC SEND \"file name\" 2130706433 9899 1405135128")) + (should (string-match erc-dcc-ctcp-query-send-regexp s)) + (should-not (match-string 2 s)) + (should (string= "file name" (match-string 1 s)))) + (let ((s "DCC SEND filename 2130706433 9899 1405135128")) + (should (string-match erc-dcc-ctcp-query-send-regexp s)) + (should (string= "filename" (match-string 2 s))) + (should (string= "2130706433" (match-string 3 s))) + (should (string= "9899" (match-string 4 s))) + (should (string= "1405135128" (match-string 5 s))) + (should-not (match-string 6 s))) + (let ((s "DCC SEND filename 2130706433 9899 1405135128 T")) + (should (string-match erc-dcc-ctcp-query-send-regexp s)) + (should (string= "T" (match-string 6 s))))) + +;; This also indirectly tests base functionality for +;; `erc-dcc-do-LIST-command' + +(defun erc-dcc-tests--dcc-handle-ctcp-send (turbo) + (with-current-buffer (get-buffer-create "fake-server") + (erc-mode) + (setq erc-server-process + (start-process "fake" (current-buffer) "sleep" "1") + erc-input-marker (make-marker) + erc-insert-marker (make-marker) + erc-server-current-nick "dummy") + (set-process-query-on-exit-flag erc-server-process nil) + (should-not erc-dcc-list) + (erc-ctcp-query-DCC erc-server-process + "tester" + "~tester" + "fake.irc" + "dummy" + (concat "DCC SEND foo 2130706433 9899 1405135128" + (and turbo " T"))) + (should-not (cdr erc-dcc-list)) + (should (equal (plist-put (car erc-dcc-list) :parent 'fake) + `(:nick "[email protected]" + :type GET + :peer nil + :parent fake + :ip "127.0.0.1" + :port "9899" + :file "foo" + :size 1405135128 + :turbo ,turbo))) + (goto-char (point-min)) + (should (search-forward "file foo offered by tester" nil t)) + (erc-dcc-do-LIST-command erc-server-process) + (should (search-forward-regexp (concat + "GET +no +1405135128 +foo" + (and turbo " +(T)") "$") + nil t)) + (when noninteractive + (let (erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook) + (kill-buffer)))) + ;; `erc-dcc-list' is global; must leave it empty + (should erc-dcc-list) + (setq erc-dcc-list nil)) + +(ert-deftest erc-dcc-handle-ctcp-send--base () + (erc-dcc-tests--dcc-handle-ctcp-send nil)) + +(ert-deftest erc-dcc-handle-ctcp-send--turbo () + (erc-dcc-tests--dcc-handle-ctcp-send t)) + +(ert-deftest erc-dcc-do-GET-command () + (with-temp-buffer + (let* ((proc (start-process "fake" (current-buffer) "sleep" "1")) + erc-accidental-paste-threshold-seconds + erc-send-completed-hook + erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook + (elt `(:nick "[email protected]" + :type GET + :peer nil + :parent ,proc + :ip "127.0.0.1" + :port "9899" + :file "foo.bin" + :size 1405135128)) + (erc-dcc-list (list elt)) + ;; + calls) + (erc-mode) + (setq erc-server-process proc + erc-input-marker (make-marker) + erc-insert-marker (make-marker) + erc-server-current-nick "dummy") + (set-process-query-on-exit-flag proc nil) + (cl-letf (((symbol-function 'read-file-name) + (lambda (&rest _) "foo.bin")) + ((symbol-function 'erc-dcc-get-file) + (lambda (&rest r) (push r calls)))) + (goto-char (point-max)) + (set-marker erc-insert-marker (point-max)) + (erc-display-prompt) + + (ert-info ("No turbo") + (should-not (plist-member elt :turbo)) + (goto-char erc-input-marker) + (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)))) + + (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") + (erc-send-current-line) + (should (eq t (plist-get (car erc-dcc-list) :turbo))) + (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") + (erc-send-current-line) + (should (eq t (plist-get (car erc-dcc-list) :turbo))) + (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") + (erc-send-current-line) + (should (eq t (plist-get (car erc-dcc-list) :turbo))) + (should (equal (pop calls) (list elt "foo.bin" proc)))))))) + +;;; erc-dcc-tests.el ends here -- 2.35.1
0001-Display-error-message-on-incomplete-ERC-DCC-transfer.patch
(text/x-patch, 3.8 KB)
From 45effb1ca3a7fc0f100dfb4a7f15836612982e8f Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> Date: Wed, 30 Mar 2022 17:16:11 -0700 Subject: [PATCH 1/4] Display error message on incomplete ERC DCC transfer * lisp/erc/erc-dcc.el (erc-dcc-get-sentinel): Display error when total byte count received is lower than expected. (erc-message-english-dcc-get-failed): Add `dcc-get-incomplete' to the English catalog. (erc-dcc-get-file): Tweak initialization of `erc-dcc-entry-data'. (Bug#54458) --- lisp/erc/erc-dcc.el | 35 +++++++++++++++++++---------------- 1 file changed, 19 insertions(+), 16 deletions(-) diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el index 59bfd24603..a37dc7caa3 100644 --- a/lisp/erc/erc-dcc.el +++ b/lisp/erc/erc-dcc.el @@ -144,6 +144,7 @@ erc-dcc-open-network-stream (dcc-get-bytes-received . "DCC: %f: %b bytes received") (dcc-get-complete . "DCC: file %f transfer complete (%s bytes in %t seconds)") + (dcc-get-failed . "DCC: file %f transfer failed at %s of %v in %t seconds") (dcc-get-cmd-aborted . "DCC: Aborted getting %f from %n") (dcc-get-file-too-long . "DCC: %f: File longer than sender claimed; aborting transfer") @@ -920,8 +921,7 @@ erc-dcc-get-file (inhibit-file-name-operation 'write-region)) (write-region (point) (point) erc-dcc-file-name nil 'nomessage)) - (setq erc-server-process parent-proc - erc-dcc-entry-data entry) + (setq erc-server-process parent-proc) (setq erc-dcc-byte-count 0) (setq proc (funcall erc-dcc-connect-function @@ -935,8 +935,8 @@ erc-dcc-get-file (set-process-filter proc #'erc-dcc-get-filter) (set-process-sentinel proc #'erc-dcc-get-sentinel) - (setq entry (plist-put entry :start-time (erc-current-time))) - (setq entry (plist-put entry :peer proc))))) + (setq erc-dcc-entry-data (plist-put (plist-put entry :peer proc) + :start-time (erc-current-time)))))) (defun erc-dcc-append-contents (buffer _file) "Append the contents of BUFFER to FILE. @@ -990,27 +990,30 @@ erc-dcc-get-filter (process-send-string proc (erc-pack-int received-bytes))))))) - -(defun erc-dcc-get-sentinel (proc _event) +(defun erc-dcc-get-sentinel (proc event) "This is the process sentinel for CTCP DCC SEND connections. It shuts down the connection and notifies the user that the transfer is complete." ;; FIXME, we should look at EVENT, and also check size. + (unless (string= event "connection broken by remote peer\n") + (lwarn 'erc :warning "Unexpected sentinel event %S for %s" + (string-trim-right event) proc)) (with-current-buffer (process-buffer proc) (delete-process proc) (setq erc-dcc-list (delete erc-dcc-entry-data erc-dcc-list)) (unless (= (point-min) (point-max)) (erc-dcc-append-contents (current-buffer) erc-dcc-file-name)) - (erc-display-message - nil 'notice erc-server-process - 'dcc-get-complete - ?f erc-dcc-file-name - ?s (number-to-string erc-dcc-byte-count) - ?t (format "%.0f" - (erc-time-diff (plist-get erc-dcc-entry-data :start-time) - nil)))) - (kill-buffer (process-buffer proc)) - (delete-process proc)) + (let ((done (= erc-dcc-byte-count (plist-get erc-dcc-entry-data :size)))) + (erc-display-message + nil (if done 'notice '(notice error)) erc-server-process + (if done 'dcc-get-complete 'dcc-get-failed) + ?v (plist-get erc-dcc-entry-data :size) + ?f erc-dcc-file-name + ?s (number-to-string erc-dcc-byte-count) + ?t (format "%.0f" + (erc-time-diff (plist-get erc-dcc-entry-data :start-time) + nil)))) + (kill-buffer))) ;;; CHAT handling -- 2.35.1
0002-Don-t-send-reports-in-erc-dcc-get-filter-when-nested.patch
(text/x-patch, 1.1 KB)
From 07a874a7c47822946aae1e46da11005525933e1f Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> Date: Mon, 28 Mar 2022 02:24:43 -0700 Subject: [PATCH 2/4] Don't send reports in erc-dcc-get-filter when nested * lisp/erc/erc-dcc.el (erc-dcc-get-filter): Don't bother sending a "received so far" receipt if another attempt is ongoing (Bug#54458) --- lisp/erc/erc-dcc.el | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el index a37dc7caa3..2a06efdaa4 100644 --- a/lisp/erc/erc-dcc.el +++ b/lisp/erc/erc-dcc.el @@ -986,9 +986,10 @@ erc-dcc-get-filter 'dcc-get-file-too-long ?f (file-name-nondirectory (buffer-name))) (delete-process proc)) - (t - (process-send-string - proc (erc-pack-int received-bytes))))))) + ((not (process-get proc :reportingp)) + (process-put proc :reportingp t) + (process-send-string proc (erc-pack-int received-bytes)) + (process-put proc :reportingp nil)))))) (defun erc-dcc-get-sentinel (proc event) "This is the process sentinel for CTCP DCC SEND connections. -- 2.35.1
0003-Allow-matching-against-string-values-in-erc-dcc-memb.patch
(text/x-patch, 1.4 KB)
From e09734fb4c8e0d08df26887515b180465bf151a4 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> Date: Sat, 9 Apr 2022 23:32:22 -0700 Subject: [PATCH 3/4] Allow matching against string values in erc-dcc-member * lisp/erc/erc-dcc.el (erc-dcc-member): Be more tolerant in the catch-all case by testing for equality instead of identity. (erc-dcc-do-GET-command): Pass filename when querying `erc-dcc-member'. (Bug#54458) --- lisp/erc/erc-dcc.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el index 2a06efdaa4..babd0f3046 100644 --- a/lisp/erc/erc-dcc.el +++ b/lisp/erc/erc-dcc.el @@ -196,7 +196,7 @@ erc-dcc-member (erc-extract-nick test) (erc-extract-nick val))) ;; not a nick - (eq test val) + (equal test val) (setq cont nil)))) (if cont (setq result elt) @@ -507,7 +507,7 @@ erc-dcc-do-GET-command re-join the arguments, separated by a space. PROC is the server process." (setq file (and file (mapconcat #'identity file " "))) - (let* ((elt (erc-dcc-member :nick nick :type 'GET)) + (let* ((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 -- 2.35.1
0004-Accept-turbo-param-in-erc-dcc-do-GET-command.patch
(text/x-patch, 13.7 KB)
From 36a9c136e23dabfb913ebf98a4a7fb4389604cf6 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> Date: Sat, 30 Apr 2022 02:16:46 -0700 Subject: [PATCH 4/4] Accept turbo param in erc-dcc-do-GET-command * lisp/erc/erc-dcc.el (erc-dcc-list): Document optional :turbo item. (erc-message-english-dcc-list-{head,line,item}): Adjust format strings to make room for "(T)" turbo indicator. (erc-dcc-do-GET-command): Optionally set :turbo in `erc-dcc-list' entry when passed -t argument in the /DCC GET slash-command. (erc-dcc--force-turbo): Add temporary internal var. (erc-dcc-do-LIST): Print message with new format specifier for turbo status. (erc-dcc-ctcp-query-send-regexp): Account for nonstandard terminating T. (erc-dcc-handle-ctcp-send): set :turbo item in `erc-dcc-list' member when new match-group nonempty. (erc-dcc-get-filter): Don't send when turbo active. * test/lisp/erc/erc-dcc-tests.el: Add new file. (Bug#54458) --- lisp/erc/erc-dcc.el | 46 +++++++--- test/lisp/erc/erc-dcc-tests.el | 157 +++++++++++++++++++++++++++++++++ 2 files changed, 190 insertions(+), 13 deletions(-) create mode 100644 test/lisp/erc/erc-dcc-tests.el diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el index babd0f3046..cfa8422b1c 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 nick [file] - Accept DCC offer from nick +;; /dcc get [-t] nick [file] - Accept DCC offer from nick ;; /dcc list - List all DCC offers/connections ;; /dcc send nick file - Offer DCC SEND to nick @@ -105,7 +105,9 @@ erc-dcc-list :file - for outgoing sends, the full path to the file. For incoming sends, the suggested filename or vetted filename - :size - size of the file, may be nil on incoming DCCs") + :size - size of the file, may be nil on incoming DCCs + + :turbo - optional item indicating sender support for TSEND.") (defun erc-dcc-list-add (type nick peer parent &rest args) "Add a new entry of type TYPE to `erc-dcc-list' and return it." @@ -149,9 +151,9 @@ erc-dcc-open-network-stream (dcc-get-file-too-long . "DCC: %f: File longer than sender claimed; aborting transfer") (dcc-get-notfound . "DCC: %n hasn't offered %f for DCC transfer") - (dcc-list-head . "DCC: From Type Active Size Filename") - (dcc-list-line . "DCC: -------- ---- ------ -------------- --------") - (dcc-list-item . "DCC: %-8n %-4t %-6a %-14s %f") + (dcc-list-head . "DCC: From Type Active Size Filename") + (dcc-list-line . "DCC: -------- ---- ------ ----------------- --------") + (dcc-list-item . "DCC: %-8n %-4t %-6a %-17s %f%u") (dcc-list-end . "DCC: End of list.") (dcc-malformed . "DCC: error: %n (%u@%h) sent malformed request: %q") (dcc-privileged-port @@ -506,8 +508,13 @@ erc-dcc-do-GET-command FILE is the filename. If FILE is split into multiple arguments, re-join the arguments, separated by a space. PROC is the server process." - (setq file (and file (mapconcat #'identity file " "))) - (let* ((elt (erc-dcc-member :nick nick :type 'GET :file file)) + (let* ((turbo (prog1 (and (cond ((string= nick "-t") + (setq nick (pop file))) + ((member "-t" file) + (setq file (delete "-t" file)))) + t) + (setq file (and file (mapconcat #'identity file " "))))) + (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 @@ -527,13 +534,21 @@ erc-dcc-do-GET-command 'dcc-get-cmd-aborted ?n nick ?f filename))) (t - (erc-dcc-get-file elt file proc)))) + (erc-dcc-get-file elt file proc))) + (when turbo + (setq erc-dcc-list (cons (plist-put elt :turbo t) + (delq elt erc-dcc-list))))) (erc-display-message nil '(notice error) 'active 'dcc-get-notfound ?n nick ?f filename)))) (defvar-local erc-dcc-byte-count nil) +;; Experimental flag to indicate TGET-style report omissions +;; see https://www.visualirc.net/tech-tdcc.php +;; FIXME actually, we don't need this (drop after adding unit test) +(defvar erc-dcc--force-turbo nil) + (defun erc-dcc-do-LIST-command (_proc) "This is the handler for the /dcc list command. It lists the current state of `erc-dcc-list' in an easy to read manner." @@ -576,7 +591,8 @@ erc-dcc-do-LIST-command (format " (%d%%)" (floor (* 100.0 byte-count) (plist-get elt :size)))))) - ?f (or (and (plist-member elt :file) (plist-get elt :file)) ""))) + ?f (or (and (plist-member elt :file) (plist-get elt :file)) "") + ?u (if (or erc-dcc--force-turbo (plist-get elt :turbo)) " (T)" ""))) (erc-display-message nil 'notice 'active 'dcc-list-end) @@ -626,7 +642,7 @@ erc-dcc-ctcp-query-send-regexp ;; or filename enclosed in double quotes with any number ;; of escaped double quotes inside. "\"\\(\\(?:\\\\\"\\|[^\"\\]\\)+\\)\"\\|\\([^ ]+\\)" - "\\) \\([0-9]+\\) \\([0-9]+\\) *\\([0-9]*\\)")) + "\\) \\([0-9]+\\) \\([0-9]+\\) *\\([0-9]*\\) ?\\(T\\)?")) (define-inline erc-dcc-unquote-filename (filename) (inline-quote @@ -656,7 +672,8 @@ erc-dcc-handle-ctcp-send (erc-dcc-unquote-filename (match-string 1 query)))) (ip (erc-decimal-to-ip (match-string 3 query))) (port (match-string 4 query)) - (size (match-string 5 query))) + (size (match-string 5 query)) + (turbo (match-string 6 query))) ;; FIXME: a warning really should also be sent ;; if the ip address != the host the dcc sender is on. (erc-display-message @@ -673,7 +690,8 @@ erc-dcc-handle-ctcp-send 'GET (format "%s!%s@%s" nick login host) nil proc :ip ip :port port :file filename - :size (string-to-number size)) + :size (string-to-number size) + :turbo (and turbo t)) (if (and (eq erc-dcc-send-request 'auto) (erc-dcc-auto-mask-p (format "\"%s!%s@%s\"" nick login host))) (erc-dcc-get-file (car erc-dcc-list) filename proc)))) @@ -986,7 +1004,9 @@ erc-dcc-get-filter 'dcc-get-file-too-long ?f (file-name-nondirectory (buffer-name))) (delete-process proc)) - ((not (process-get proc :reportingp)) + ((not (or erc-dcc--force-turbo + (plist-get erc-dcc-entry-data :turbo) + (process-get proc :reportingp))) (process-put proc :reportingp t) (process-send-string proc (erc-pack-int received-bytes)) (process-put proc :reportingp nil)))))) diff --git a/test/lisp/erc/erc-dcc-tests.el b/test/lisp/erc/erc-dcc-tests.el new file mode 100644 index 0000000000..64ca3363c7 --- /dev/null +++ b/test/lisp/erc/erc-dcc-tests.el @@ -0,0 +1,157 @@ +;;; erc-dcc-tests.el --- Tests for erc-dcc -*- lexical-binding:t -*- + +;; Copyright (C) 2020-2022 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: +;;; Code: +(require 'ert) +(require 'erc-dcc) + +(ert-deftest erc-dcc-ctcp-query-send-regexp () + (let ((s "DCC SEND \"file name\" 2130706433 9899 1405135128")) + (should (string-match erc-dcc-ctcp-query-send-regexp s)) + (should-not (match-string 2 s)) + (should (string= "file name" (match-string 1 s)))) + (let ((s "DCC SEND filename 2130706433 9899 1405135128")) + (should (string-match erc-dcc-ctcp-query-send-regexp s)) + (should (string= "filename" (match-string 2 s))) + (should (string= "2130706433" (match-string 3 s))) + (should (string= "9899" (match-string 4 s))) + (should (string= "1405135128" (match-string 5 s))) + (should-not (match-string 6 s))) + (let ((s "DCC SEND filename 2130706433 9899 1405135128 T")) + (should (string-match erc-dcc-ctcp-query-send-regexp s)) + (should (string= "T" (match-string 6 s))))) + +;; This also indirectly tests base functionality for +;; `erc-dcc-do-LIST-command' + +(defun erc-dcc-tests--dcc-handle-ctcp-send (turbo) + (with-current-buffer (get-buffer-create "fake-server") + (erc-mode) + (setq erc-server-process + (start-process "fake" (current-buffer) "sleep" "1") + erc-input-marker (make-marker) + erc-insert-marker (make-marker) + erc-server-current-nick "dummy") + (set-process-query-on-exit-flag erc-server-process nil) + (should-not erc-dcc-list) + (erc-ctcp-query-DCC erc-server-process + "tester" + "~tester" + "fake.irc" + "dummy" + (concat "DCC SEND foo 2130706433 9899 1405135128" + (and turbo " T"))) + (should-not (cdr erc-dcc-list)) + (should (equal (plist-put (car erc-dcc-list) :parent 'fake) + `(:nick "[email protected]" + :type GET + :peer nil + :parent fake + :ip "127.0.0.1" + :port "9899" + :file "foo" + :size 1405135128 + :turbo ,turbo))) + (goto-char (point-min)) + (should (search-forward "file foo offered by tester" nil t)) + (erc-dcc-do-LIST-command erc-server-process) + (should (search-forward-regexp (concat + "GET +no +1405135128 +foo" + (and turbo " +(T)") "$") + nil t)) + (when noninteractive + (let (erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook) + (kill-buffer)))) + ;; `erc-dcc-list' is global; must leave it empty + (should erc-dcc-list) + (setq erc-dcc-list nil)) + +(ert-deftest erc-dcc-handle-ctcp-send--base () + (erc-dcc-tests--dcc-handle-ctcp-send nil)) + +(ert-deftest erc-dcc-handle-ctcp-send--turbo () + (erc-dcc-tests--dcc-handle-ctcp-send t)) + +(ert-deftest erc-dcc-do-GET-command () + (with-temp-buffer + (let* ((proc (start-process "fake" (current-buffer) "sleep" "1")) + erc-accidental-paste-threshold-seconds + erc-send-completed-hook + erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook + (elt `(:nick "[email protected]" + :type GET + :peer nil + :parent ,proc + :ip "127.0.0.1" + :port "9899" + :file "foo.bin" + :size 1405135128)) + (erc-dcc-list (list elt)) + ;; + calls) + (erc-mode) + (setq erc-server-process proc + erc-input-marker (make-marker) + erc-insert-marker (make-marker) + erc-server-current-nick "dummy") + (set-process-query-on-exit-flag proc nil) + (cl-letf (((symbol-function 'read-file-name) + (lambda (&rest _) "foo.bin")) + ((symbol-function 'erc-dcc-get-file) + (lambda (&rest r) (push r calls)))) + (goto-char (point-max)) + (set-marker erc-insert-marker (point-max)) + (erc-display-prompt) + + (ert-info ("No turbo") + (should-not (plist-member elt :turbo)) + (goto-char erc-input-marker) + (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)))) + + (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") + (erc-send-current-line) + (should (eq t (plist-get (car erc-dcc-list) :turbo))) + (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") + (erc-send-current-line) + (should (eq t (plist-get (car erc-dcc-list) :turbo))) + (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") + (erc-send-current-line) + (should (eq t (plist-get (car erc-dcc-list) :turbo))) + (should (equal (pop calls) (list elt "foo.bin" proc)))))))) + +;;; erc-dcc-tests.el ends here -- 2.35.1