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#54458: 27.2; erc-dcc-get: Re-entering top level after C stack overflow Date: Fri, 06 May 2022 06:06:15 -0700 Message-ID: <874k22zu7s.fsf__15427.6849397988$1651842659$gmane$org@neverwas.me> References: <78459EAB-314B-4122-8E3B-7F82685D0DBA@acm.org> <83a6da9vm8.fsf@gnu.org> <87r16m46uf.fsf@neverwas.me> <4DA2DB05-D902-42DF-860D-87617FBB74C8@acm.org> <83k0cc907r.fsf@gnu.org> <5A8EE4CF-6F5E-4119-8765-8E301E2BE935@acm.org> <87czi435nh.fsf@neverwas.me> <87mth8rst7.fsf@neverwas.me> <98F3182F-80A4-4131-8E9C-E1576908DF96@acm.org> <87sfqygccz.fsf@neverwas.me> <87h77aozgw.fsf@gmail.com> <87wng67xxd.fsf@neverwas.me> <875yng39sa.fsf@neverwas.me> <87sfqkz4ts.fsf@neverwas.me> <87ilqyrn9s.fsf@gmail.com> <878rrtz7or.fsf@neverwas.me> <87r15guen2.fsf@gmail.com> <87ilqqy9km.fsf@neverwas.me> <87pmkth2lr.fsf@gmail.com> 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="14404"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/29.0.50 (gnu/linux) Cc: Mattias =?UTF-8?Q?Engdeg=C3=A5rd?= , Eli Zaretskii , emacs-erc@gnu.org, bandali@gnu.org, 54458@debbugs.gnu.org To: Fernando de Morais Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Fri May 06 15:10:51 2022 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 1nmxjO-0003Zb-VL for geb-bug-gnu-emacs@m.gmane-mx.org; Fri, 06 May 2022 15:10:51 +0200 Original-Received: from localhost ([::1]:40422 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1nmxjN-0006Qr-Iq for geb-bug-gnu-emacs@m.gmane-mx.org; Fri, 06 May 2022 09:10:49 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:53246) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1nmxfj-0003b1-4X for bug-gnu-emacs@gnu.org; Fri, 06 May 2022 09:07:03 -0400 Original-Received: from debbugs.gnu.org ([209.51.188.43]:53553) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1nmxfi-0006V4-R1 for bug-gnu-emacs@gnu.org; Fri, 06 May 2022 09:07:02 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1nmxfi-0004OO-HW for bug-gnu-emacs@gnu.org; Fri, 06 May 2022 09:07:02 -0400 X-Loop: help-debbugs@gnu.org Resent-From: "J.P." Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Fri, 06 May 2022 13:07:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 54458 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: moreinfo Original-Received: via spool by 54458-submit@debbugs.gnu.org id=B54458.165184239716849 (code B ref 54458); Fri, 06 May 2022 13:07:02 +0000 Original-Received: (at 54458) by debbugs.gnu.org; 6 May 2022 13:06:37 +0000 Original-Received: from localhost ([127.0.0.1]:47450 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1nmxfH-0004Ne-L5 for submit@debbugs.gnu.org; Fri, 06 May 2022 09:06:37 -0400 Original-Received: from mail-108-mta189.mxroute.com ([136.175.108.189]:39937) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1nmxfD-0004NQ-RX for 54458@debbugs.gnu.org; Fri, 06 May 2022 09:06:33 -0400 Original-Received: from filter006.mxroute.com ([140.82.40.27] 140.82.40.27.vultrusercontent.com) (Authenticated sender: mN4UYu2MZsgR) by mail-108-mta189.mxroute.com (ZoneMTA) with ESMTPSA id 180997a87f4000926a.002 for <54458@debbugs.gnu.org> (version=TLSv1/SSLv3 cipher=ECDHE-RSA-AES128-GCM-SHA256); Fri, 06 May 2022 13:06:25 +0000 X-Zone-Loop: 0582a646ae9014ceb178050f88b1f51962e10f2fb02c X-Originating-IP: [140.82.40.27] 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:In-Reply-To:Date:References: 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=H8BV0iGVWqXLlJX+6GZM7psVawGMAk7Ow5VsoSfFEWM=; b=eYdp7aS3faMhkr7NfQY6L0xaN5 ALuutOnmhyo5YEcCEofW+TxWUV/kXhReVHu8k7Vh6sDLhaO8tXgd/qvPeonKWJo9SBBQHh5cX4xve O4+8T2TxogBtV6AQSgQ9vo/zjF1OC7PBtfhDxfXON+tYzwu7Mst0icaffiHDskwEKnLEDtuKlK3U3 dcqD4UZOba2magWOb7kpDGLK+WHr7Gk1CiulrtFa/YR5bZDoYKIlWa+r5Ugdq4m3M9w30yNMXVnjJ nKy6gdQKVGYGks6jitde8++RVS1k6gKKaEFU3TugERjVkBClSNnFKQGQdLCrXAeCFaUJ5naNg5hGh cFP6k4Mg==; In-Reply-To: <87pmkth2lr.fsf@gmail.com> (Fernando de Morais's message of "Wed, 04 May 2022 10:03:12 -0300") X-AuthUser: 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" Xref: news.gmane.io gmane.emacs.bugs:231509 Archived-At: --=-=-= Content-Type: text/plain Hi Fernando, Fernando de Morais writes: > It worked great! I was able to download four packages simultaneously, > making use of the `-t' flag, without losing control of Emacs. > > In fact, the loss of control still happened a few times, even using the > flag, but for a short time and much more rarely Hm. I'm not sure what all we can do about the stuttering. The flag inhibits all sending, so the filter is merely appending arriving bytes to the work buffer and flushing it whenever its size crosses some threshold. IOW, the EAGAIN loop discussed up thread can't occur. So, whatever's causing the intermittent loss must be related to normal, interleaved reading by those filters. And without more insight into what's going on precisely with your inputs, I don't think there's a whole lot we can do beyond speculate. So, in the end, I guess I'm just asking you to suffer the status quo on this one. > [...] compared to the transfer without the flag (whose loss of control > happens in, practically, every transfer). Right. The sans-flag thing was another dumb idea you should have been spared. In truth, it never stood a chance (I've come to learn) because no one has ever implemented that form of TSEND. However, I've added detection for one form that does exist and is very much in use, at least by KVirc folk. I've also added a slight tweak for improved interop with WeeChat, which has its own form of turbo (called "fast mode" or something) that only requires a final ACK. If you're able to try these, great. If not, no worries. I'll leave them for a bit anyhow to focus on our main initiatives. Thanks for bearing with me all these weeks (and with ERC all these years)! J.P. P.S (unrelated) I've also added SSEND detection (and an -s flag) for senders that support it (it's just TLS, really). --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0000-v4-v5.diff >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 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0001-Display-error-message-on-incomplete-ERC-DCC-transfer.patch >From 494f37ca515cfa0c09d5d0a698d0899e5d9e759e Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Wed, 30 Mar 2022 17:16:11 -0700 Subject: [PATCH 1/5] 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 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0002-Don-t-send-reports-in-erc-dcc-get-filter-when-nested.patch >From af28665f92db12e59d2e3a6faeede6b3c2a96dce Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Mon, 28 Mar 2022 02:24:43 -0700 Subject: [PATCH 2/5] 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 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0003-Allow-matching-against-string-values-in-erc-dcc-memb.patch >From 9c1ea280ec6bd016a9d4e3b0515835c283a038ad Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Sat, 9 Apr 2022 23:32:22 -0700 Subject: [PATCH 3/5] 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 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0004-Accept-turbo-param-in-erc-dcc-do-GET-command.patch >From 36356e9ddbc4a304442bbd16fec0e41d261552cb Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Sat, 30 Apr 2022 02:16:46 -0700 Subject: [PATCH 4/5] 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-send-final-turbo-ack): New internal variable and possible future option for extreme corner-cases involving maverick quasi-turbo senders. (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 | 79 +++++++++++----- test/lisp/erc/erc-dcc-tests.el | 163 +++++++++++++++++++++++++++++++++ 2 files changed, 221 insertions(+), 21 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..591930c74e 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,12 @@ 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* ((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 @@ 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 (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 @@ 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-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 @@ erc-ctcp-query-DCC-hook (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 @@ 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]*\\)")) + (: (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 @@ 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))) + (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 @@ 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)))) @@ -952,6 +973,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 @@ -986,7 +1015,14 @@ erc-dcc-get-filter '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-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 +1032,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 new file mode 100644 index 0000000000..2f66d89072 --- /dev/null +++ b/test/lisp/erc/erc-dcc-tests.el @@ -0,0 +1,163 @@ +;;; 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 . + +;;; 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" "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 " (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" "1")) + erc-accidental-paste-threshold-seconds + erc-send-completed-hook + erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook + (elt `(: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)) + ;; + 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 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0005-Support-receiving-from-DCC-SSEND-in-erc-dcc.patch >From 32b268f03891c297b14bbaee45833d33fe051c17 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Thu, 5 May 2022 21:13:47 -0700 Subject: [PATCH 5/5] Support receiving from DCC SSEND in erc-dcc * lips/erc/erc-dcc.el (erc-dcc-open-network-stream): Use TLS for new connections when :secure flag is set. (erc-dcc-do-GET-command): Set secure flag when user explicitly passes an "-s" option. (erc-dcc-do-LIST-command): Show an "s" to indicate a secure connection when applicable. (erc-dcc-query-handler-alist): Add extra items for "SSEND", etc. (erc-dcc-handle-ctcp-send): Set secure flag when based on the presenceof a leading "S" in the command type. --- lisp/erc/erc-dcc.el | 22 +++++++++++++++++----- test/lisp/erc/erc-dcc-tests.el | 3 ++- 2 files changed, 19 insertions(+), 6 deletions(-) diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el index 591930c74e..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,6 +107,8 @@ erc-dcc-list :size - size of the file, may be nil on incoming DCCs + :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) @@ -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 @@ -534,6 +537,9 @@ erc-dcc-do-GET-command ?n nick ?f filename))) (t (erc-dcc-get-file elt file proc))) + (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))))) @@ -574,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))) @@ -587,7 +594,7 @@ erc-dcc-do-LIST-command (plist-get elt :size)))))) ?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"))) + (and (plist-get elt :secure) "s"))) ((not (string-empty-p flags)))) (concat " (" flags ")") ""))) @@ -618,6 +625,9 @@ 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 @@ -676,6 +686,7 @@ erc-dcc-handle-ctcp-send (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. @@ -694,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)))) diff --git a/test/lisp/erc/erc-dcc-tests.el b/test/lisp/erc/erc-dcc-tests.el index 2f66d89072..126a1b5287 100644 --- a/test/lisp/erc/erc-dcc-tests.el +++ b/test/lisp/erc/erc-dcc-tests.el @@ -74,7 +74,8 @@ erc-dcc-tests--dcc-handle-ctcp-send :port "9899" :file "foo" :size 1405135128 - :turbo ,(and turbo t)))) + :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 --=-=-=--