[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master df1e553688 4/5: Accommodate nonstandard turbo file senders in erc
|
From: |
F. Jason Park |
|
Subject: |
master df1e553688 4/5: Accommodate nonstandard turbo file senders in erc-dcc |
|
Date: |
Sun, 22 May 2022 21:08:01 -0400 (EDT) |
branch: master
commit df1e553688be6e97198e293a1042a1bbbce98271
Author: F. Jason Park <jp@neverwas.me>
Commit: F. Jason Park <jp@neverwas.me>
Accommodate nonstandard turbo file senders in erc-dcc
* 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" in the "/DCC GET" slash command. Also add
switch to command line in front-matter Commentary, but refrain from
publicizing further because our implementation is only defensive and
only for receiving.
(erc-dcc-do-LIST): Print message with new format specifier for turbo
status.
(erc-dcc-ctcp-query-send-regexp): Account for T- and S-prefixed
commands. Receiving from an SSEND-capable sender will be added in a
subsequent commit.
(erc-dcc-handle-ctcp-send): Set :turbo item in `erc-dcc-list' member
when new match group is nonempty.
(erc-dcc--X-send-final-turbo-ack): New internal variable and potential
future option for extreme corner cases involving maverick turbo
senders, like WeeChat, who don't use the TSEND command variant.
(erc-dcc-get-filter): Don't send when turbo is active.
* test/lisp/erc/erc-dcc-tests.el: Add new file.
(Bug#54458)
---
lisp/erc/erc-dcc.el | 81 ++++++++++++++------
test/lisp/erc/erc-dcc-tests.el | 164 +++++++++++++++++++++++++++++++++++++++++
2 files changed, 224 insertions(+), 21 deletions(-)
diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el
index babd0f3046..918ae9dc97 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 @@ Looks like:
: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 @@ Looks like:
(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,12 @@ At least one of TYPE and NICK must be provided."
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* ((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")))
(if elt
(let* ((file (read-file-name
@@ -527,7 +533,10 @@ PROC is the server process."
'dcc-get-cmd-aborted
?n nick ?f filename)))
(t
- (erc-dcc-get-file elt file proc))))
+ (erc-dcc-get-file elt file proc)))
+ (when (member "-t" flags)
+ (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))))
@@ -576,7 +585,12 @@ It lists the current state of `erc-dcc-list' in an easy to
read manner."
(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-let* ((flags (concat (and (plist-get elt :turbo) "t")
+ (and (plist-get elt :placeholder) "p")))
+ ((not (string-empty-p flags))))
+ (concat " (" flags ")")
+ "")))
(erc-display-message
nil 'notice 'active
'dcc-list-end)
@@ -603,6 +617,7 @@ separated by a space."
(defvar erc-dcc-query-handler-alist
'(("SEND" . erc-dcc-handle-ctcp-send)
+ ("TSEND" . erc-dcc-handle-ctcp-send)
("CHAT" . erc-dcc-handle-ctcp-chat)))
;;;###autoload
@@ -621,12 +636,16 @@ that subcommand."
?q query ?n nick ?u login ?h host))))
(defconst erc-dcc-ctcp-query-send-regexp
- (concat "^DCC SEND \\(?:"
+ (rx bot "DCC " (group-n 6 (: (** 0 2 (any "TS")) "SEND")) " "
;; Following part matches either filename without spaces
;; or filename enclosed in double quotes with any number
;; of escaped double quotes inside.
- "\"\\(\\(?:\\\\\"\\|[^\"\\]\\)+\\)\"\\|\\([^ ]+\\)"
- "\\) \\([0-9]+\\) \\([0-9]+\\) *\\([0-9]*\\)"))
+ (: (or (: ?\" (group-n 1 (+ (or (: ?\\ ?\") (not (any ?\" ?\\))))) ?\")
+ (group-n 2 (+ (not " ")))))
+ (: " " (group-n 3 (+ digit))
+ " " (group-n 4 (+ digit))
+ (* " ") (group-n 5 (* digit)))
+ eot))
(define-inline erc-dcc-unquote-filename (filename)
(inline-quote
@@ -651,12 +670,13 @@ It extracts the information about the dcc request and
adds it to
'dcc-request-bogus
?r "SEND" ?n nick ?u login ?h host))
((string-match erc-dcc-ctcp-query-send-regexp query)
- (let ((filename
- (or (match-string 2 query)
- (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)))
+ (let* ((filename (or (match-string 2 query)
+ (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))
+ (sub (substring (match-string 6 query) 0 -4))
+ (turbo (seq-contains-p sub ?T #'eq)))
;; FIXME: a warning really should also be sent
;; if the ip address != the host the dcc sender is on.
(erc-display-message
@@ -673,7 +693,8 @@ It extracts the information about the dcc request and adds
it to
'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))))
@@ -952,6 +973,16 @@ The contents of the BUFFER will then be erased."
(setq erc-dcc-byte-count (+ (buffer-size) erc-dcc-byte-count))
(erase-buffer))))
+;; If people really need this, we can convert it into a proper option.
+
+(defvar erc-dcc--X-send-final-turbo-ack nil
+ "Workaround for maverick turbo senders that only require a final ACK.
+The only known culprit is WeeChat, with its xfer.network.fast_send
+option, which is on by default. Leaving this set to nil and calling
+/DCC GET -t works just fine, but WeeChat sees it as a failure even
+though the file arrives in its entirety. Setting this to t may
+alleviate such problems.")
+
(defun erc-dcc-get-filter (proc str)
"This is the process filter for transfers from other clients to this one.
It reads incoming bytes from the network and stores them in the DCC
@@ -986,7 +1017,14 @@ rather than every 1024 byte block, but nobody seems to
care."
'dcc-get-file-too-long
?f (file-name-nondirectory (buffer-name)))
(delete-process proc))
- ((not (process-get proc :reportingp))
+ ;; Some senders want us to hang up. Only observed w. TSEND.
+ ((and (plist-get erc-dcc-entry-data :turbo)
+ (= received-bytes (plist-get erc-dcc-entry-data :size)))
+ (when erc-dcc--X-send-final-turbo-ack
+ (process-send-string proc (erc-pack-int received-bytes)))
+ (delete-process proc))
+ ((not (or (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))))))
@@ -996,7 +1034,8 @@ rather than every 1024 byte block, but nobody seems to
care."
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")
+ (unless (member event '("connection broken by remote peer\n"
+ "deleted\n"))
(lwarn 'erc :warning "Unexpected sentinel event %S for %s"
(string-trim-right event) proc))
(with-current-buffer (process-buffer 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..58011201cd
--- /dev/null
+++ b/test/lisp/erc/erc-dcc-tests.el
@@ -0,0 +1,164 @@
+;;; erc-dcc-tests.el --- Tests for erc-dcc -*- lexical-binding:t -*-
+
+;; Copyright (C) 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)))
+ (should (string= "SEND" (match-string 6 s))))
+ (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= "SEND" (match-string 6 s)))
+ (should (string= "file \" name"
+ (erc-dcc-unquote-filename (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))))
+ (let ((s "DCC TSEND filename 2130706433 9899 1405135128"))
+ (should (string-match erc-dcc-ctcp-query-send-regexp s))
+ (should (string= "TSEND" (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" "10")
+ 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 " (if turbo "TSEND" "SEND")
+ " foo 2130706433 9899 1405135128"))
+ (should-not (cdr erc-dcc-list))
+ (should (equal (plist-put (car erc-dcc-list) :parent 'fake)
+ `(:nick "tester!~tester@fake.irc"
+ :type GET
+ :peer nil
+ :parent fake
+ :ip "127.0.0.1"
+ :port "9899"
+ :file "foo"
+ :size 1405135128
+ :turbo ,(and turbo t))))
+ (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" "10"))
+ (elt (list :nick "tester!~tester@fake.irc"
+ :type 'GET
+ :peer nil
+ :parent proc
+ :ip "127.0.0.1"
+ :port "9899"
+ :file "foo.bin"
+ :size 1405135128))
+ (erc-dcc-list (list elt))
+ ;;
+ erc-accidental-paste-threshold-seconds
+ erc-insert-modify-hook erc-send-completed-hook
+ erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook
+ 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