bug#54458: 27.2; erc-dcc-get: Re-entering top level after C stack overflow

["J.P." <jp@neverwas.me>]

[-- Attachment #1: Type: text/plain, Size: 476 bytes --]

Hi Fernando,

Another possibility I've been kicking around is (optionally) running DCC
GET operations in a subprocess. Attached is a POC (patch #4), which I'm
hoping you'll try. Unfortunately, like patch #2, I believe it'll only
apply cleanly on newer Emacs versions. (You'll also be needing to set
the option `erc-dcc-get-use-subprocess' to t.) Depending on the outcome
of your pcap experiment, this (or some improved version) may be our only
practical way forward. Thanks.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0000-v2-v3.diff --]
[-- Type: text/x-patch, Size: 4733 bytes --]

From 0c98e87ba18493857f4d0d63f0e00bbefc152c93 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Sun, 10 Apr 2022 19:50:55 -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
  Allow running erc-dcc GET operations in a subprocess

 lisp/erc/erc-dcc.el | 117 ++++++++++++++++++++++++++++++++++----------
 1 file changed, 91 insertions(+), 26 deletions(-)

Interdiff:
diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el
index c6871aefd3..d8452f2661 100644
--- a/lisp/erc/erc-dcc.el
+++ b/lisp/erc/erc-dcc.el
@@ -897,10 +897,7 @@ erc-dcc-receive-cache
 
 (defvar-local erc-dcc-file-name nil)
 
-(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."
+(defun erc-dcc--get-file (entry file parent-proc)
   (let* ((buffer (generate-new-buffer (file-name-nondirectory file)))
          proc)
     (with-current-buffer buffer
@@ -938,6 +935,71 @@ 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."
-- 
2.35.1


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0001-Display-error-message-on-incomplete-ERC-DCC-transfer.patch --]
[-- Type: text/x-patch, Size: 3859 bytes --]

From f3b16d507ec119f81702afa32fc868af635d3530 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
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'.
---
 lisp/erc/erc-dcc.el | 36 +++++++++++++++++++-----------------
 1 file changed, 19 insertions(+), 17 deletions(-)

diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el
index 59bfd24603..66a5be4ad0 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,29 @@ 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


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0002-Don-t-send-reports-in-erc-dcc-get-filter-when-nested.patch --]
[-- Type: text/x-patch, Size: 1161 bytes --]

From e74322f61e02819c1d1f50d23a03f6353dd45f37 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
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 66a5be4ad0..636e5b20b1 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


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #5: 0003-Allow-matching-against-string-values-in-erc-dcc-memb.patch --]
[-- Type: text/x-patch, Size: 1383 bytes --]

From f54f32465ed3d7a3206a98987943de13c39aa479 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
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'.
---
 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 636e5b20b1..c6871aefd3 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


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #6: 0004-Allow-running-erc-dcc-GET-operations-in-a-subprocess.patch --]
[-- Type: text/x-patch, Size: 4887 bytes --]

From 0c98e87ba18493857f4d0d63f0e00bbefc152c93 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Sun, 10 Apr 2022 19:43:00 -0700
Subject: [PATCH 4/4] Allow running erc-dcc GET operations in a subprocess

* lisp/erc/erc-dcc.el (erc-dcc-get-use-subprocess): Add new option
to spawn an inferior Emacs instance with each /DCC GET invocation.
(erc-dcc--get-file): Move bulk of `erc-dcc-get-file' to an internal
variant to accommodate subprocess functionality.
(erc-dcc--get-display-messages, erc-dcc--get-file-subprocess-sentinel,
erc-dcc--get-file-subprocess): Add helpers for subprocess wrangling.
---
 lisp/erc/erc-dcc.el | 70 ++++++++++++++++++++++++++++++++++++++++++---
 1 file changed, 66 insertions(+), 4 deletions(-)

diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el
index c6871aefd3..d8452f2661 100644
--- a/lisp/erc/erc-dcc.el
+++ b/lisp/erc/erc-dcc.el
@@ -897,10 +897,7 @@ erc-dcc-receive-cache
 
 (defvar-local erc-dcc-file-name nil)
 
-(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."
+(defun erc-dcc--get-file (entry file parent-proc)
   (let* ((buffer (generate-new-buffer (file-name-nondirectory file)))
          proc)
     (with-current-buffer buffer
@@ -938,6 +935,71 @@ 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."
-- 
2.35.1