branch: externals/futur
commit d2f87084d0b4a17a62109fbc3e29e7ed362d2953
Author: Stefan Monnier <[email protected]>
Commit: Stefan Monnier <[email protected]>
Reap inactive server
* futur-client.el (futur--elisp-servers-delay)
(futur--elisp-servers-timer): New vars.
(futur--elisp-reap-idle-servers): New function.
(futur--elisp-launch): Use it.
(futur--sandbox-bwrap-args): Rename from `futur--bwrap-args`.
* futur-server.el (futur-server): Move to structure the code a bit better.
---
futur-client.el | 31 ++++++++++++++++++--
futur-server.el | 89 +++++++++++++++++++++++++++++----------------------------
2 files changed, 74 insertions(+), 46 deletions(-)
diff --git a/futur-client.el b/futur-client.el
index a34ac39de7..a0a2792618 100644
--- a/futur-client.el
+++ b/futur-client.el
@@ -38,6 +38,11 @@ This has to be the same used by `futur-server'.")
"Alist mapping server kinds to lists of processes.
A server kind is a symbol.")
+(defvar futur--elisp-servers-delay (* 60 10)
+ "Number of seconds after which an inactive server is killed.")
+
+(defvar futur--elisp-servers-timer nil)
+
(defun futur--elisp-process-filter (proc string)
(cl-assert (process-get proc 'futur--kind))
(cl-assert (memq proc (assq (process-get proc 'futur--kind)
@@ -167,8 +172,30 @@ A server kind is a symbol.")
(process-put proc 'futur--rid 0)
(process-put proc 'futur--last-time (float-time))
(push proc (alist-get kind futur--elisp-servers))
+ (unless futur--elisp-servers-timer
+ (setq futur--elisp-servers-timer
+ (run-with-timer futur--elisp-servers-delay
+ futur--elisp-servers-delay
+ #'futur--elisp-reap-idle-servers)))
proc))
+(defun futur--elisp-reap-idle-servers ()
+ (let ((time (float-time))
+ (left nil))
+ (pcase-dolist (`(,_kind . ,procs) futur--elisp-servers)
+ (dolist (proc procs)
+ (if (> (- time (process-get proc 'futur--last-time))
+ futur--elisp-servers-delay)
+ ;; No activity in during more than `futur--elisp-servers-delay'.
+ ;; FIXME: Maybe we should use different delays for the case
+ ;; where the server is really idle, or the case where we're
+ ;; waiting for an answer?
+ (delete-process proc)
+ (setq left t))))
+ (unless left
+ (cancel-timer futur--elisp-servers-timer)
+ (setq futur--elisp-servers-timer nil))))
+
(defun futur--elisp-process-answer (proc sexp-string)
(pcase-let* ((`(,sexp . ,end)
(condition-case err
@@ -282,7 +309,7 @@ A server kind is a symbol.")
;; Inspired by the code in `elpa-admin.el'.
-(defconst futur--bwrap-args
+(defconst futur--sandbox-bwrap-args
'("--unshare-all"
"--dev" "/dev"
"--proc" "/proc"
@@ -298,7 +325,7 @@ A server kind is a symbol.")
,@process-environment)))
(futur--elisp-launch
kind `("bwrap"
- ,@futur--bwrap-args
+ ,@futur--sandbox-bwrap-args
,@(mapcan (lambda (dir)
(when (file-directory-p dir)
(let ((dir (expand-file-name dir)))
diff --git a/futur-server.el b/futur-server.el
index 2f884b97af..d7ec9aebb9 100644
--- a/futur-server.el
+++ b/futur-server.el
@@ -62,6 +62,51 @@
(princ futur--elisp-impossible-string t)
(terpri t)))
+;; (defun futur-server-call-in-context (ctxname ctx func &rest args)
+;; (futur--obarray ctxname ctx)
+;; (apply func args))
+
+(defun futur-server ()
+ ;; We don't need a cryptographically secure ID, but just something that's
+ ;; *very* unlikely to occur by accident elsewhere and which `read' wouldn't
+ ;; process without signaling an error.
+ (let* ((sid (format " fes:%s "
+ (secure-hash 'sha1
+ (format "%S:%S:%S"
+ (random t) (current-time)
+ (emacs-pid)))))
+ (sid-sym (intern (string-trim sid))))
+ ;; Initialize the cache of obarray snapshots.
+ (futur-reset-context 'futur--server-internal nil)
+ (futur--print-stdout :ready sid)
+ (while t
+ (let ((input (condition-case err (cons :read-success (futur--read-stdin))
+ (t err))))
+ (pcase input
+ ;; Check `sid-sym' for every request, since we may have just read
+ ;; "successfully" the garbage that follows a failed read.
+ (`(:read-success ,(pred (eq sid-sym)) ,rid ,func . ,args)
+ ;; Confirm we read successfully so the client can
+ ;; distinguish where problems come from.
+ (futur--print-stdout `(:read-success ,rid) sid)
+ (let ((result
+ (condition-case err
+ `(:funcall-success ,rid . ,(apply func args))
+ (t `(:funcall-error ,rid . ,err)))))
+ (futur--print-stdout result sid)))
+ (`(:read-success . ,rest)
+ (futur--print-stdout `(:unrecognized-request . ,rest) sid))
+ (_
+ ;; FIXME: We can get an `end-of-file' error if the input line
+ ;; is not a complete sexp but also if stdin was closed.
+ ;; To distinguish the two it seems we have to look at
+ ;; the actual error string :-(.
+ (if (equal input '(end-of-file "Error reading from stdin"))
+ (kill-emacs)
+ (futur--print-stdout `(:read-error . ,input) sid))))))))
+
+;;;; Manage execution contexts
+
(defun futur--obarray-snapshot ()
"Return a snapshot of `obarray'.
Does not pay attention to buffer-local values of variables."
@@ -170,49 +215,5 @@ the cache."
(setf (alist-get name snapshots)
(list target (futur--obarray-snapshot))))))))))))
-;; (defun futur-server-call-in-context (ctxname ctx func &rest args)
-;; (futur--obarray ctxname ctx)
-;; (apply func args))
-
-(defun futur-server ()
- ;; We don't need a cryptographically secure ID, but just something that's
- ;; *very* unlikely to occur by accident elsewhere and which `read' wouldn't
- ;; process without signaling an error.
- (let* ((sid (format " fes:%s "
- (secure-hash 'sha1
- (format "%S:%S:%S"
- (random t) (current-time)
- (emacs-pid)))))
- (sid-sym (intern (string-trim sid))))
- ;; Initialize the cache of obarray snapshots.
- (futur-reset-context 'futur--server-internal nil)
- (futur--print-stdout :ready sid)
- (while t
- (let ((input (condition-case err (cons :read-success (futur--read-stdin))
- (t err))))
- (pcase input
- ;; Check `sid-sym' for every request, since we may have just read
- ;; "successfully" the garbage that follows a failed read.
- (`(:read-success ,(pred (eq sid-sym)) ,rid ,func . ,args)
- ;; Confirm we read successfully so the client can
- ;; distinguish where problems come from.
- (futur--print-stdout `(:read-success ,rid) sid)
- (let ((result
- (condition-case err
- `(:funcall-success ,rid . ,(apply func args))
- (t `(:funcall-error ,rid . ,err)))))
- (futur--print-stdout result sid)))
- (`(:read-success . ,rest)
- (futur--print-stdout `(:unrecognized-request . ,rest) sid))
- (_
- ;; FIXME: We can get an `end-of-file' error if the input line
- ;; is not a complete sexp but also if stdin was closed.
- ;; To distinguish the two it seems we have to look at
- ;; the actual error string :-(.
- (if (equal input '(end-of-file "Error reading from stdin"))
- (kill-emacs)
- (futur--print-stdout `(:read-error . ,input) sid))))))))
-
-
(provide 'futur-server)
;;; futur-server.el ends here
