;;; emacs-process-sentinel-ecm.el ---                               -*- lexical-binding: t; -*-

;; This file provides an ECM for a possible bug in Emacs's process
;; handling.  The rub is whether a process sentinel may be called with
;; a STATUS string of "finished\n" while the process's
;; `process-status' is `open': If that is expected, then this may not
;; indicate a bug (but perhaps an issue that needs to be more
;; prominently documented).  But if it's not supposed to happen, then
;; this may provide a means to reproduce the behavior and troubleshoot
;; the bug.

;; This ECM works by making 10 (by default) curl `pipe' processes that
;; send requests to httpbin.org.  When each process is finished, the
;; process sentinel should conclude by killing the process's buffer.

;; This appears to work most of the time, especially with low numbers
;; of processes (like 1-3).  But as the number of processes is
;; increased, sometimes one or more of the attempts to kill a
;; process's buffer result in the user's being prompted to kill the
;; buffer due to the process still running (an obvious problem when
;; happening in library code that the user should not be concerned
;; with).  As the number of processes increases, the number of process
;; buffers that prompt seems to increase (e.g. with 15 processes, 1-2
;; prompts seems common).

;; A possible workaround would be to check the process's status before
;; attempting to kill the buffer, however that would seem to raise a
;; problem: according to the Elisp manual, calls to the sentinel may
;; be coalesced when a process's status changes quickly, so if the
;; sentinel simply did not kill the buffer if the process were still
;; alive, it's unclear whether the sentinel will be called a final
;; time, after the process's status is `closed'; if not, the buffer
;; would never be killed.  Alternatively, the sentinel could loop
;; while checking `process-status', but that would obviously be
;; undesirable, and would seem like working around a bug (and it might
;; be the wrong thing to do in general, depending on the process's and
;; sentinel's purposes).

;; To test this ECM:

;; 1.  Evaluate this file (with lexical-binding).

;; 2.  Eval (argh).

;; 3.  The messages buffer should show the first line of the HTTP
;; response body for requests 1-10, as well as a "killing buffer..."
;; line for each curl process's buffer.  There should be NO "Buffer
;; has a running process; kill it?" prompts.

;; 4.  But, usually, there will be one or two of those prompts.  When
;; there are, you can see that the buffer's process has a
;; (process-status) value of "open" rather than "closed", even though
;; the process's sentinel was called with "finished\n" as the status
;; argument.

;; So far, this has been reproduced on Emacs 26.3, 27.2, and 28.0.50
;; (built on 2021-07-05), on GNU/Linux.

(require 'cl-lib)
(require 'rx)

(defvar-local argh-callback nil)

(defun argh ()
  (let* ((i 0))
    (while (< i 10)
      (setq i (1+ i))
      (let ((prefix (format "%s" i)))
        (message "%S"
                 (argh-curl i (lambda (data)
                                (message "%s: %S" prefix data))))))))

(defun argh-curl (num callback)
  (let* ((process-buffer (generate-new-buffer (format "argh-curl-%02d" num)))
         (process (make-process :name "argh-curl"
                                :buffer process-buffer
                                :coding 'binary
                                :command '("curl"
                                           "--silent"
                                           "--compressed"
                                           "--location"
                                           "--dump-header" "-"
                                           "--config" "-")
                                :connection-type 'pipe
                                :sentinel #'argh--sentinel
                                :stderr process-buffer))
         (curl-config "--url https://httpbin.org/get\n"))
    (with-current-buffer process-buffer
      (setf argh-callback callback))
    (process-send-string process curl-config)
    (process-send-eof process)
    process))

(defun argh--sentinel (process-or-buffer status)
  (let ((buffer (cl-typecase process-or-buffer
                  (buffer process-or-buffer)
                  (process (process-buffer process-or-buffer)))))
    (unwind-protect
        (with-current-buffer buffer
          (pcase-exhaustive status
            ("finished\n"
             ;; Curl exited normally.
             (goto-char (point-min))
             (re-search-forward "^\r\n" nil)
             (forward-line 1)
             (funcall argh-callback (buffer-substring (point-at-bol) (point-at-eol))))

            ((or (and (pred numberp) code)
                 (rx "exited abnormally with code " (let code (group (1+ digit)))))
             ;; Curl error.
             nil)

            ("killed\n"
             ;; Curl process killed.
             nil)))
      (pcase status
        ((or "finished\n"
             "killed\n"
             (pred numberp)
             (rx "exited abnormally with code " (1+ digit)))
         (message "killing buffer %S of process.  PROCESS-STATUS:%S  SENTINEL-STATUS-ARG:%S"
                  buffer (process-status (get-buffer-process buffer)) status)
         (kill-buffer buffer))))))