>From 32b268f03891c297b14bbaee45833d33fe051c17 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Fri, 6 May 2022 00:15:36 -0700 Subject: [PATCH 0/5] *** NOT A PATCH *** *** BLURB HERE *** F. Jason Park (5): 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 Support receiving from DCC SSEND in erc-dcc lisp/erc/erc-dcc.el | 135 ++++++++++++++++++--------- test/lisp/erc/erc-dcc-tests.el | 164 +++++++++++++++++++++++++++++++++ 2 files changed, 258 insertions(+), 41 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 cfa8422b1c..aa48be4dde 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] 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 @@ -107,7 +107,9 @@ erc-dcc-list :size - size of the file, may be nil on incoming DCCs - :turbo - optional item indicating sender support for TSEND.") + :secure - optional item indicating sender support for TLS + + :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." @@ -121,12 +123,13 @@ erc-dcc-list-add ;; more: the entry data from erc-dcc-list for this particular process. (defvar erc-dcc-connect-function 'erc-dcc-open-network-stream) -(defun erc-dcc-open-network-stream (procname buffer addr port _entry) +(defun erc-dcc-open-network-stream (procname buffer addr port entry) ;; FIXME: Time to try activating this again!? (if nil; (fboundp 'open-network-stream-nowait) ;; this currently crashes ;; cvs emacs (open-network-stream-nowait procname buffer addr port) - (open-network-stream procname buffer addr port))) + (open-network-stream procname buffer addr port + :type (and (plist-get entry :secure) 'tls)))) (erc-define-catalog 'english @@ -508,12 +511,11 @@ 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." - (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 " "))))) + (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 @@ -535,7 +537,10 @@ erc-dcc-do-GET-command ?n nick ?f filename))) (t (erc-dcc-get-file elt file proc))) - (when turbo + (when (member "-s" flags) + (setq erc-dcc-list (cons (plist-put elt :secure t) + (delq elt erc-dcc-list)))) + (when (member "-t" flags) (setq erc-dcc-list (cons (plist-put elt :turbo t) (delq elt erc-dcc-list))))) (erc-display-message @@ -544,11 +549,6 @@ erc-dcc-do-GET-command (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." @@ -580,6 +580,7 @@ erc-dcc-do-LIST-command (process-status (plist-get elt :peer)) "no") ?s (concat size + ;; FIXME consider uniquified names, e.g., foo.bin<2> (if (and (eq 'GET (plist-get elt :type)) (plist-member elt :file) (buffer-live-p (get-buffer (plist-get elt :file))) @@ -592,7 +593,11 @@ erc-dcc-do-LIST-command (floor (* 100.0 byte-count) (plist-get elt :size)))))) ?f (or (and (plist-member elt :file) (plist-get elt :file)) "") - ?u (if (or erc-dcc--force-turbo (plist-get elt :turbo)) " (T)" ""))) + ?u (if-let* ((flags (concat (and (plist-get elt :turbo) "t") + (and (plist-get elt :secure) "s"))) + ((not (string-empty-p flags)))) + (concat " (" flags ")") + ""))) (erc-display-message nil 'notice 'active 'dcc-list-end) @@ -619,6 +624,10 @@ erc-ctcp-query-DCC-hook (defvar erc-dcc-query-handler-alist '(("SEND" . erc-dcc-handle-ctcp-send) + ("TSEND" . erc-dcc-handle-ctcp-send) + ("SSEND" . erc-dcc-handle-ctcp-send) + ("TSSEND" . erc-dcc-handle-ctcp-send) + ("STSEND" . erc-dcc-handle-ctcp-send) ("CHAT" . erc-dcc-handle-ctcp-chat))) ;;;###autoload @@ -637,12 +646,16 @@ erc-ctcp-query-DCC ?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]*\\) ?\\(T\\)?")) + (: (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 @@ -667,13 +680,14 @@ erc-dcc-handle-ctcp-send '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)) - (turbo (match-string 6 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)) + (secure (seq-contains-p sub ?S #'eq)) + (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 @@ -691,7 +705,8 @@ erc-dcc-handle-ctcp-send nil proc :ip ip :port port :file filename :size (string-to-number size) - :turbo (and turbo t)) + :turbo (and turbo t) + :secure (and secure 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)))) @@ -970,6 +985,14 @@ erc-dcc-append-contents (setq erc-dcc-byte-count (+ (buffer-size) erc-dcc-byte-count)) (erase-buffer)))) +;; If people need this, we can convert it into an option. The only +;; known culprit is WeeChat, with its xfer.network.fast_send option +;; (on by default). Calling /DCC GET -t works just fine, but WeeChat +;; sees it as a failure even though the file arrives in its entirety. + +(defvar erc-dcc-send-final-turbo-ack nil + "Workaround for maverick turbo senders that only require a final ACK.") + (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 @@ -1004,8 +1027,13 @@ erc-dcc-get-filter 'dcc-get-file-too-long ?f (file-name-nondirectory (buffer-name))) (delete-process proc)) - ((not (or erc-dcc--force-turbo - (plist-get erc-dcc-entry-data :turbo) + ;; 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-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)) @@ -1016,7 +1044,8 @@ erc-dcc-get-sentinel 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 index 64ca3363c7..126a1b5287 100644 --- a/test/lisp/erc/erc-dcc-tests.el +++ b/test/lisp/erc/erc-dcc-tests.el @@ -26,17 +26,23 @@ 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= "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))) - (should-not (match-string 6 s))) - (let ((s "DCC SEND filename 2130706433 9899 1405135128 T")) + (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= "T" (match-string 6 s))))) + (should (string= "TSEND" (match-string 6 s))))) ;; This also indirectly tests base functionality for ;; `erc-dcc-do-LIST-command' @@ -56,8 +62,8 @@ erc-dcc-tests--dcc-handle-ctcp-send "~tester" "fake.irc" "dummy" - (concat "DCC SEND foo 2130706433 9899 1405135128" - (and turbo " T"))) + (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" @@ -68,7 +74,8 @@ erc-dcc-tests--dcc-handle-ctcp-send :port "9899" :file "foo" :size 1405135128 - :turbo ,turbo))) + :turbo ,(and turbo t) + :secure nil))) (goto-char (point-min)) (should (search-forward "file foo offered by tester" nil t)) (erc-dcc-do-LIST-command erc-server-process) -- 2.35.1