branch: externals/plz
commit 85473ed857824a125d85f3dde95b47ab57c8c39d
Merge: 5a9706c1c4 be1d63c7d8
Author: Adam Porter <a...@alphapapa.net>
Commit: Adam Porter <a...@alphapapa.net>
Merge: Improve process sentinel workaround, add plz-debug
---
README.org | 4 ++
plz.el | 167 ++++++++++++++++++++++++++++++++++++++++++++++++-------------
2 files changed, 135 insertions(+), 36 deletions(-)
diff --git a/README.org b/README.org
index b313110d27..6e33a904b9 100644
--- a/README.org
+++ b/README.org
@@ -194,6 +194,10 @@ You may also clear a queue with ~plz-clear~, which cancels
any active or queued
+ The minimum supported Emacs version is now 27.1. (It is no longer practical
to test ~plz~ with Emacs versions older than 27.1. For Emacs 26.3, an earlier
version of ~plz~ may be used, or this version might be compatible, with or
without minor changes, which the maintainer cannot offer support for.)
+*Fixes*
+
++ Improve workaround for Emacs's process sentinel-related issues. (Don't try
to process response a second time if Emacs calls the sentinel after ~plz~ has
returned for a synchronous request. See
[[https://github.com/alphapapa/plz.el/issues/53][#53]]. Thanks to
[[https://github.com/josephmturner][Joseph Turner]] for extensive help
debugging, and to [[https://ushin.org/][USHIN]] for sponsoring some of this
work.)
+
** 0.8
*Additions*
diff --git a/plz.el b/plz.el
index f75168c935..72b8beac9e 100644
--- a/plz.el
+++ b/plz.el
@@ -250,6 +250,70 @@ connection phase and waiting to receive the response (the
\"--max-time\" argument to curl)."
:type 'number)
+;;;; Macros
+
+(require 'warnings)
+
+(cl-defmacro plz-debug (&rest args)
+ ;; Copied from `ement-debug' in Ement.el, which see.
+ "Display a debug warning showing the run-time value of ARGS.
+The warning automatically includes the name of the containing
+function, and it is only displayed if `warning-minimum-log-level'
+is `:debug' at expansion time (otherwise the macro expands to a
+call to `ignore' with ARGS and is eliminated by the
+byte-compiler). When debugging, the form also returns nil so,
+e.g. it may be used in a conditional in place of nil.
+
+Each of ARGS may be a string, which is displayed as-is, or a
+symbol, the value of which is displayed prefixed by its name, or
+a Lisp form, which is displayed prefixed by its first symbol.
+
+Before the actual ARGS arguments, you can write keyword
+arguments, i.e. alternating keywords and values. The following
+keywords are supported:
+
+ :buffer BUFFER Name of buffer to pass to `display-warning'.
+ :level LEVEL Level passed to `display-warning', which see.
+ Default is :debug."
+ ;; TODO: Can we use a compiler macro to handle this more elegantly?
+ (pcase-let* ((fn-name (when byte-compile-current-buffer
+ (with-current-buffer byte-compile-current-buffer
+ ;; This is a hack, but a nifty one.
+ (save-excursion
+ (beginning-of-defun)
+ (cl-second (read (current-buffer)))))))
+ (plist-args (cl-loop while (keywordp (car args))
+ collect (pop args)
+ collect (pop args)))
+ ((map (:buffer buffer) (:level level)) plist-args)
+ (level (or level :debug))
+ (string (cl-loop for arg in args
+ concat (pcase arg
+ ((pred stringp) "%S ")
+ ((pred symbolp)
+ (concat (upcase (symbol-name arg))
":%S "))
+ ((pred listp)
+ (concat "(" (upcase (symbol-name
(car arg)))
+ (pcase (length arg)
+ (1 ")")
+ (_ "...)"))
+ ":%S "))))))
+ (if (eq :debug warning-minimum-log-level)
+ `(let ((fn-name ,(if fn-name
+ `',fn-name
+ ;; In an interpreted function: use
`backtrace-frame' to get the
+ ;; function name (we have to use a little hackery
to figure out
+ ;; how far up the frame to look, but this seems to
work).
+ `(cl-loop for frame in (backtrace-frames)
+ for fn = (cl-second frame)
+ when (not (or (subrp fn)
+ (special-form-p fn)
+ (eq 'backtrace-frames fn)))
+ return (make-symbol (format "%s
[interpreted]" fn))))))
+ (display-warning fn-name (format ,string ,@args) ,level ,buffer)
+ nil)
+ `(ignore ,@args))))
+
;;;; Functions
;;;;; Public
@@ -518,15 +582,19 @@ into the process buffer.
(error "Process unexpectedly nil"))
(while (accept-process-output process))
(while (accept-process-output stderr-process))
+ (plz-debug (float-time) "BEFORE HACK" (process-buffer process))
(when (eq :plz-result (process-get process :plz-result))
+ (plz-debug (float-time) "INSIDE HACK" (process-buffer process))
;; HACK: Sentinel seems to not have been called: call it
again. (Although
;; this is a hack, it seems to be a necessary one due to
Emacs's process
;; handling.) See
<https://github.com/alphapapa/plz.el/issues/3> and
;; <https://debbugs.gnu.org/cgi/bugreport.cgi?bug=50166>.
- (plz--sentinel process "finished\n")
+ (plz--sentinel process "workaround")
+ (plz-debug (float-time) "INSIDE HACK, AFTER CALLING SENTINEL"
(process-buffer process))
(when (eq :plz-result (process-get process :plz-result))
(error "Plz: NO RESULT FROM PROCESS:%S ARGS:%S"
process rest)))
+ (plz-debug (float-time) "AFTER HACK" (process-buffer process))
;; Sentinel seems to have been called: check the result.
(pcase (process-get process :plz-result)
((and (pred plz-error-p) data)
@@ -740,14 +808,31 @@ STATUS should be the process's event string (see info
node `(elisp) Sentinels'). Calls `plz--respond' to process the
HTTP response (directly for synchronous requests, or from a timer
for asynchronous ones)."
- (pcase status
- ((or "finished\n" "killed\n" "interrupt\n"
- (pred numberp)
- (rx "exited abnormally with code " (group (1+ digit))))
- (let ((buffer (process-buffer process)))
- (if (process-get process :plz-sync)
- (plz--respond process buffer status)
- (run-at-time 0 nil #'plz--respond process buffer status))))))
+ (plz-debug (float-time) "BEFORE CONDITION"
+ process status (process-get process :plz-result))
+ (if (eq :plz-result (process-get process :plz-result))
+ ;; Result not yet set: check process status (we call
+ ;; `process-status' because the STATUS argument might not be
+ ;; accurate--see "hack" in `plz').
+ (if (member (process-status process) '(run stop))
+ ;; Process still alive: do nothing.
+ (plz-debug "Doing nothing because:" (process-status process))
+ ;; Process appears to be dead: check STATUS argument.
+ (pcase status
+ ((or "finished\n" "killed\n" "interrupt\n" "workaround"
+ (pred numberp)
+ (rx "exited abnormally with code " (group (1+ digit))))
+ ;; STATUS seems okay: call `plz--respond'.
+ (let ((buffer (process-buffer process)))
+ (if (process-get process :plz-sync)
+ (plz--respond process buffer status)
+ (run-at-time 0 nil #'plz--respond process buffer status))))))
+ ;; Result already set (likely indicating that Emacs did not call
+ ;; the sentinel when `accept-process-output' was called, so we are
+ ;; either being called from our "hack", or being called a second
+ ;; time, after `plz' returned): do nothing.
+ (plz-debug (float-time) ":PLZ-RESULT ALREADY CHANGED"
+ process status (process-get process :plz-result))))
(defun plz--respond (process buffer status)
"Respond to HTTP response from PROCESS in BUFFER.
@@ -760,11 +845,14 @@ argument passed to `plz--sentinel', which see."
;; "Respond" also means "to react to something," which is what this
;; does--react to receiving the HTTP response--and it's an internal
;; name, so why not.
+ (plz-debug (float-time) process status (process-status process) buffer)
(unwind-protect
- (with-current-buffer buffer
- (pcase-exhaustive status
- ((or 0 "finished\n")
- ;; Curl exited normally: check HTTP status code.
+ (pcase-exhaustive (process-exit-status process)
+ (0
+ ;; Curl exited normally: check HTTP status code.
+ (with-current-buffer buffer
+ ;; NOTE: We only switch to the process's buffer if curl
+ ;; exited successfully.
(goto-char (point-min))
(plz--skip-proxy-headers)
(while (plz--skip-redirect-headers))
@@ -784,29 +872,36 @@ argument passed to `plz--sentinel', which see."
(let ((err (make-plz-error :response (plz--response))))
(pcase-exhaustive (process-get process :plz-else)
(`nil (process-put process :plz-result err))
- ((and (pred functionp) fn) (funcall fn err)))))))
-
- ((or (and (pred numberp) code)
- (rx "exited abnormally with code " (let code (group (1+
digit)))))
- ;; Curl error.
- (let* ((curl-exit-code (cl-typecase code
- (string (string-to-number code))
- (number code)))
- (curl-error-message (alist-get curl-exit-code
plz-curl-errors))
- (err (make-plz-error :curl-error (cons curl-exit-code
curl-error-message))))
- (pcase-exhaustive (process-get process :plz-else)
- (`nil (process-put process :plz-result err))
- ((and (pred functionp) fn) (funcall fn err)))))
-
- ((and (or "killed\n" "interrupt\n") status)
- ;; Curl process killed or interrupted.
- (let* ((message (pcase status
- ("killed\n" "curl process killed")
- ("interrupt\n" "curl process interrupted")))
- (err (make-plz-error :message message)))
- (pcase-exhaustive (process-get process :plz-else)
- (`nil (process-put process :plz-result err))
- ((and (pred functionp) fn) (funcall fn err)))))))
+ ((and (pred functionp) fn) (funcall fn err))))))))
+ ((and code (guard (<= 1 code 90)))
+ ;; Curl exited non-zero.
+ (let* ((curl-exit-code (cl-typecase code
+ (string (string-to-number code))
+ (number code)))
+ (curl-error-message (alist-get curl-exit-code plz-curl-errors))
+ (err (make-plz-error :curl-error (cons curl-exit-code
curl-error-message))))
+ (pcase-exhaustive (process-get process :plz-else)
+ (`nil (process-put process :plz-result err))
+ ((and (pred functionp) fn) (funcall fn err)))))
+ ((and code (guard (not (<= 1 code 90))))
+ ;; If we are here, it should mean that the curl process was
+ ;; killed or interrupted, and the code should be something
+ ;; not (<= 1 code 90).
+ (let* ((message (pcase status
+ ("killed\n" "curl process killed")
+ ("interrupt\n" "curl process interrupted")
+ (_ (format "Unexpected curl process status:%S
code:%S. Please report this bug to the `plz' maintainer." status code))))
+ (err (make-plz-error :message message)))
+ (pcase-exhaustive (process-get process :plz-else)
+ (`nil (process-put process :plz-result err))
+ ((and (pred functionp) fn) (funcall fn err)))))
+ (code
+ ;; If we are here, something is really wrong.
+ (let* ((message (format "Unexpected curl process status:%S code:%S.
Please report this bug to the `plz' maintainer." status code))
+ (err (make-plz-error :message message)))
+ (pcase-exhaustive (process-get process :plz-else)
+ (`nil (process-put process :plz-result err))
+ ((and (pred functionp) fn) (funcall fn err))))))
(when-let ((finally (process-get process :plz-finally)))
(funcall finally))
(unless (or (process-get process :plz-sync)
