diff --git a/emacs/flan-dev.el b/emacs/flan-dev.el index 1586a26..3f39b38 100644 --- a/emacs/flan-dev.el +++ b/emacs/flan-dev.el @@ -177,16 +177,46 @@ original left a comment about. See `flan-watch--tick'." (defun flan-dev--extract-reply (body-start n) "Read the N bytes at BODY-START as a reply and delete the frame. -Point is in the process buffer, and the frame is known to be complete." +Point is in the process buffer, and the frame is known to be complete. + +The frame is deleted *before* it is read, which is the whole of the ordering +and the only reason this is worth a comment. A payload that will not read is +a bug at the other end, and the client's job is to report it once: reading +first would leave those bytes at the head of the buffer, so the next request +would read the same unreadable frame again, and every request after that — +one bad reply and the connection is wedged until Emacs is restarted. +Consuming it first costs the reply, which was lost anyway, and leaves the +stream in step for the request that follows." (let* ((end (byte-to-position (+ (position-bytes body-start) n))) (text (decode-coding-string (encode-coding-string (buffer-substring-no-properties body-start end) 'utf-8 t) - 'utf-8)) - (form (car (read-from-string text)))) + 'utf-8))) (delete-region (point-min) end) - form)) + (car (read-from-string text)))) + +(defun flan-dev--no-reply (proc) + "Signal that PROC has not answered, saying which of the two silences it is. + +Deliberately not retried, in either case. If the daemon took the request and +died before replying, the evaluation may well have happened — sending it again +would install it twice, or run a side-effecting expression twice. +Reconnecting happens before a send, never after one." + (if (process-live-p proc) + ;; What a person does next, not just what failed. A live daemon that + ;; has not answered is nearly always still working — a first compile of + ;; a large program on a cold object cache is the case that runs long — + ;; and the daemon's own log says which step it is on, so the message + ;; names the buffer to look in and the setting to raise rather than + ;; leaving both to be discovered. + (error "flan dev: no reply in %ss from %s; the daemon may still be building — see %s for its log, and raise `flan-dev-reply-timeout' if this build is simply long" + flan-dev-reply-timeout + (abbreviate-file-name (or flan-dev--socket "the daemon")) + flan-dev-daemon-buffer) + (error + "flan dev: the daemon on %s closed the connection; not resent, because it may already have run" + (abbreviate-file-name (or flan-dev--socket "?"))))) (defun flan-dev--read-reply (proc) "Block until PROC sends one complete framed message, and read it." @@ -198,31 +228,32 @@ Point is in the process buffer, and the frame is known to be complete." (< (float-time) deadline)) (accept-process-output proc 0.05)) (goto-char (point-min)) + ;; Nothing is erased here, and that is the difference between the two + ;; deadlines. A header that has not arrived in full is a valid prefix + ;; of a reply still on its way — throwing it away would turn a daemon + ;; that is merely slow into a stream out of step by however much of the + ;; count had landed. (unless (re-search-forward "\\`\\([0-9]+\\)\n" nil t) - ;; Deliberately not retried. If the daemon took the request and died - ;; before replying, the evaluation may well have happened — sending it - ;; again would install it twice, or run a side-effecting expression - ;; twice. Reconnecting happens before a send, never after one. - ;; What a person does next, not just what failed. A live daemon that - ;; has not answered is nearly always still working — a first compile - ;; of a large program on a cold object cache is the case that runs - ;; long — and the daemon's own log says which step it is on, so the - ;; message names the buffer to look in and the setting to raise - ;; rather than leaving both to be discovered. - (if (process-live-p proc) - (error "flan dev: no reply in %ss from %s; the daemon may still be building — see %s for its log, and raise `flan-dev-reply-timeout' if this build is simply long" - flan-dev-reply-timeout - (abbreviate-file-name (or flan-dev--socket "the daemon")) - flan-dev-daemon-buffer) - (error - "flan dev: the daemon on %s closed the connection; not resent, because it may already have run" - (abbreviate-file-name (or flan-dev--socket "?"))))) + (flan-dev--no-reply proc)) (let* ((n (string-to-number (match-string 1))) (body-start (point))) (while (and (< (- (position-bytes (point-max)) (position-bytes body-start)) n) (< (float-time) deadline)) (accept-process-output proc 0.05)) - (flan-dev--extract-reply body-start n))))) + (if (>= (- (position-bytes (point-max)) (position-bytes body-start)) n) + (flan-dev--extract-reply body-start n) + ;; The body never came, so the count at the head of the buffer is a + ;; promise about bytes that will never be made good: reading on from + ;; here would take the *next* reply's header as this one's payload + ;; and every request after it would be answered by the one before. + ;; The frame is dead — drop it, and the connection is in step again + ;; for whatever a person does next. Testing the condition again + ;; rather than trusting the loop is the whole fix: falling through + ;; to `flan-dev--extract-reply' with a short buffer signals a + ;; wrong-type error from `byte-to-position', which says nothing + ;; about a timeout to whoever reads it. + (erase-buffer) + (flan-dev--no-reply proc)))))) (defun flan-dev--append-output (text) "Append TEXT, the running program's own output, to its buffer." diff --git a/emacs/flan-watch.el b/emacs/flan-watch.el index f0f6e0f..bc245ba 100644 --- a/emacs/flan-watch.el +++ b/emacs/flan-watch.el @@ -401,7 +401,15 @@ sends the next question, leaving at most one request in flight — the invariant (flan-dev--busy nil) (t (when flan-watch--pending - (when-let* ((reply (flan-dev--take-reply flan-dev--connection))) + ;; Taken off the connection either way. `flan-dev--extract-reply' + ;; deletes a frame before it reads it, so a payload that will not read + ;; has still been consumed — and a pending flag left standing after it + ;; would wait for ever for a reply that is no longer in the buffer, + ;; which stops the timer sending anything again. One bad reply costs + ;; one tick, not the session. + (when-let* ((reply (condition-case nil + (flan-dev--take-reply flan-dev--connection) + (error (setq flan-watch--pending nil) nil)))) (setq flan-watch--pending nil) (flan-watch--absorb reply))) (unless flan-watch--pending diff --git a/emacs/test-flan-dev.el b/emacs/test-flan-dev.el index 3419615..5860e23 100644 --- a/emacs/test-flan-dev.el +++ b/emacs/test-flan-dev.el @@ -101,6 +101,56 @@ is written instead — the real `message' call the real command makes." (string-match-p "flan-dev-not-here.sock" raised) (string-match-p "nothing is listening" raised)))) + ;; ── The two frames a real daemon does not send ──────────────────────── + ;; + ;; Both of these are what the client does when the other end is wrong, and + ;; neither can be asked of a daemon that is working: a stand-in process + ;; stands where one would be, with its frames written into its buffer by + ;; hand. A live process rather than a dead one on purpose — which of the + ;; two silences the reader reports depends on whether the far end is still + ;; there, and this is the branch a person actually meets. + ;; + ;; What is under test is the state the connection is left in. A truncated + ;; frame used to raise `wrong-type-argument' out of `byte-to-position' and + ;; leave its header in the buffer, so every later request read the frame + ;; before its own, for ever; an unreadable payload used to be read before it + ;; was deleted, so it was never consumed and the *same* bytes signalled + ;; again on every request after it. Both were permanent, and both are meant + ;; to cost one request now. + (let* ((buf (generate-new-buffer " *flan-stand-in*")) + ;; `cat' with nothing on its input: a process that is alive, has a + ;; buffer, and will never say anything of its own. + (stand-in (start-process "flan-stand-in" buf "cat"))) + (set-process-query-on-exit-flag stand-in nil) + ;; Unibyte, as `flan-dev--open' makes it: the framing counts bytes, and + ;; `position-bytes' on a multibyte buffer counts something else. + (with-current-buffer buf (set-buffer-multibyte nil)) + (unwind-protect + (let ((flan-dev-reply-timeout 0.3)) + ;; Announced 40 bytes, wrote 12, went quiet. + (with-current-buffer buf (insert "40\n(:status \"o")) + (let ((raised nil)) + (condition-case err (flan-dev--read-reply stand-in) + (error (setq raised (error-message-string err)))) + (test-flan--check "a body that stalls is a timeout, said in words" + (and raised (string-match-p "no reply in" raised))) + (test-flan--check "and the half-frame is dropped rather than left to be read as the next reply" + (zerop (buffer-size buf)))) + ;; A payload that will not read, with a good frame behind it: the + ;; claim is that the second one arrives, which is the whole of + ;; self-healing and stronger than an empty buffer. + (with-current-buffer buf (insert "3\n(:a14\n(:status \"ok\")")) + (let ((raised nil)) + (condition-case err (flan-dev--take-reply stand-in) + (error (setq raised (error-message-string err)))) + (test-flan--check "a payload that will not read signals" + raised) + (test-flan--check "and is consumed, so the reply behind it arrives" + (equal (flan-dev--take-reply stand-in) + '(:status "ok"))))) + (delete-process stand-in) + (kill-buffer buf))) + (let ((r (flan-dev--request '(:op "describe")))) (test-flan--check "describe lists the program's functions" (member "step" (plist-get r :fns)))