[nongnu] elpa/hyperdrive 8185dca65c 2/4: Add: Optionally run gateway as a subprocess

[ELPA Syncer]

branch: elpa/hyperdrive
commit 8185dca65cecbbb9291f5ef2feac8468a5aad60a
Author: Adam Porter <adam@alphapapa.net>
Commit: Adam Porter <adam@alphapapa.net>

    Add: Optionally run gateway as a subprocess
    
    We also define generic methods for starting, stopping, and checking
    the gateway.
    
    Resolves <https://todo.sr.ht/~ushin/ushin/160>.
---
 .dir-locals.el     |   2 +-
 hyperdrive-lib.el  | 136 +++++++++++++++++++++++++++++++++++++++++++++++++++++
 hyperdrive-vars.el |   4 ++
 hyperdrive.el      |  19 +-------
 4 files changed, 143 insertions(+), 18 deletions(-)

diff --git a/.dir-locals.el b/.dir-locals.el
index 6dafb9b28d..53b48a9ec2 100644
--- a/.dir-locals.el
+++ b/.dir-locals.el
@@ -1,6 +1,6 @@
 ;;; Directory Local Variables            -*- no-byte-compile: t -*-
 ;;; For more information see (info "(emacs) Directory Variables")
 
-((nil . ((ispell-buffer-session-localwords . ("dir" "hypercore" "hyperdrive" 
"hyperdrives" "hyperdrive's" "args" "systemd" "minibuffer" "petname" "petnames" 
"org" "plist" "plists" "alist" "alists" "existsp" "ETag" "streamable" "DNSLink" 
"ewoc" "struct" "ENTRY's" "localhost" "imenu" "mtime" "accessor" "http" 
"prepended" "prepend" "hostname" "whitespace" "namespace" "filesystem" 
"hostnames" "subdirectories" "unsets" "finalizer"))))
+((nil . ((ispell-buffer-session-localwords . ("dir" "hypercore" "hyperdrive" 
"hyperdrives" "hyperdrive's" "args" "systemd" "minibuffer" "petname" "petnames" 
"org" "plist" "plists" "alist" "alists" "existsp" "ETag" "streamable" "DNSLink" 
"ewoc" "struct" "ENTRY's" "localhost" "imenu" "mtime" "accessor" "http" 
"prepended" "prepend" "hostname" "whitespace" "namespace" "filesystem" 
"hostnames" "subdirectories" "unsets" "finalizer" "subprocess"))))
  (emacs-lisp-mode . ((eval . (display-fill-column-indicator-mode))
                      (fill-column . 80))))
diff --git a/hyperdrive-lib.el b/hyperdrive-lib.el
index 7e739eb769..90f9cbf5e0 100644
--- a/hyperdrive-lib.el
+++ b/hyperdrive-lib.el
@@ -1326,6 +1326,142 @@ Then calls THEN if given."
                 (when then
                   (funcall then)))))
 
+;;;; Gateway process
+
+;; NOTE: The below involves some slightly hacky workarounds due to using a
+;; setter for the `h/gateway-process-type' option.  The setter gets called
+;; unexpectedly early in the compilation and/or load process, which causes
+;; errors if the functions/methods and variables involved are not yet defined.
+;; So we define the variable first, giving it a nil value, and define a default
+;; for the running-p method (because the setter gets called before the option 
is
+;; given its default value), and then the variable is redefined as an option 
and
+;; given its default value.
+
+(defvar h/gateway-process-type nil)
+
+(cl-defmethod h//gateway-running-p ()
+  "Return non-nil if the gateway process is running.")
+
+(cl-defmethod h//gateway-running-p (&context (h/gateway-process-type (eql 
'systemd)))
+  "Return non-nil if the gateway process is running.
+This does not mean that the gateway is responsive, only that the
+process is running.  Used when HYPERDRIVE-GATEWAY-PROCESS-TYPE
+is the symbol `systemd'."
+  (zerop (call-process "systemctl" nil nil nil
+                       "--user" "is-active" "hyper-gateway.service")))
+
+(cl-defmethod h//gateway-running-p (&context (h/gateway-process-type (eql 
'subprocess)))
+  "Return non-nil if the gateway process is running.
+This does not mean that the gateway is responsive, only that the
+process is running.  Used when HYPERDRIVE-GATEWAY-PROCESS-TYPE
+is the symbol `subprocess'."
+  (process-live-p h/gateway-process))
+
+(defcustom h/gateway-process-type nil
+  "How to run the gateway process."
+  ;; TODO: Can or should we use the :initialize function here?
+  :set (lambda (option value)
+         "Stop the gateway process before changing the type."
+         (let ((value-changing-p (not (equal h/gateway-process-type value))))
+           (unless value
+             ;; Try to autodetect whether the gateway is already installed as a
+             ;; systemd service.  (If systemd is not installed, it will 
default to
+             ;; `subprocess'.)
+             (setf value
+                   (if (ignore-errors
+                         (zerop (call-process "systemctl" nil nil nil
+                                              "--user" "is-enabled" 
"hyper-gateway.service")))
+                       'systemd
+                     'subprocess)))
+           (let ((runningp (h//gateway-running-p)))
+             (when (and runningp value-changing-p)
+               (h//gateway-stop))
+             (set-default option value)
+             (when (and runningp value-changing-p)
+               (h//gateway-start)))))
+  :type '(choice (const :tag "systemd service" systemd)
+                 (const :tag "Emacs subprocess"
+                        :description "When Emacs exits, the gateway will be 
terminated."
+                        subprocess)
+                 (const :tag "Autodetect" nil))
+  :group 'hyperdrive)
+
+(defcustom h/gateway-command "hyper-gateway --writable true --silent true run"
+  ;; TODO: File Emacs bug report because the customization formatter handles 
the
+  ;; "symbol `subprocess'" part differently than `describe-variable' does.
+  "Command used to run the hyper-gateway.
+Only used when `hyperdrive-gateway-process-type' is the symbol `subprocess'."
+  :type 'string
+  :group 'hyperdrive)
+
+(cl-defmethod h//gateway-start (&context (h/gateway-process-type (eql 
'systemd)))
+  "Start the gateway as a systemd service.
+Used when HYPERDRIVE-GATEWAY-PROCESS-TYPE is the symbol
+`systemd'."
+  (when (h//gateway-running-p)
+    (user-error "Gateway already running"))
+  (let ((buffer (get-buffer-create " *hyperdrive-start*")))
+    (unwind-protect
+        (unless (zerop (call-process "systemctl" nil (list buffer t) nil
+                                     "--user" "start" "hyper-gateway.service"))
+          (h/error "Unable to start hyper-gateway: %S"
+                   (with-current-buffer buffer
+                     (string-trim-right (buffer-string)))))
+      (kill-buffer buffer))))
+
+(cl-defmethod h//gateway-start (&context (h/gateway-process-type (eql 
'subprocess)))
+  "Start the gateway as an Emacs subprocess.
+Used when HYPERDRIVE-GATEWAY-PROCESS-TYPE is the symbol
+`subprocess'."
+  (when (h//gateway-running-p)
+    (user-error "Gateway already running"))
+  (setf h/gateway-process
+        (make-process :name "hyper-gateway"
+                      :buffer " *hyperdrive-start*"
+                      :command (split-string-and-unquote h/gateway-command)
+                      :connection-type 'pipe))
+  (sleep-for 0.5)
+  (unless (process-live-p h/gateway-process)
+    (if (h/status)
+        (user-error "Gateway is already running outside of Emacs (see option 
`hyperdrive-gateway-process-type')")
+      (pop-to-buffer " *hyperdrive-start*")
+      (h/error "Gateway failed to start (see process buffer for errors)"))))
+
+(cl-defmethod h//gateway-stop (&context (h/gateway-process-type (eql 
'systemd)))
+  "Stop the gateway service.
+Used when HYPERDRIVE-GATEWAY-PROCESS-TYPE is the symbol
+`systemd'."
+  (unless (h//gateway-running-p)
+    (user-error "Gateway not running"))
+  (let ((buffer (get-buffer-create " *hyperdrive-stop*")))
+    (unwind-protect
+        (unless (zerop (call-process "systemctl" nil (list buffer t) nil
+                                     "--user" "stop" "hyper-gateway.service"))
+          (h/error "Unable to stop hyper-gateway: %S"
+                   (with-current-buffer buffer
+                     (string-trim-right (buffer-string)))))
+      (cl-loop for i below 40
+               do (sleep-for 0.1)
+               while (h//gateway-running-p))
+      (when (h//gateway-running-p)
+        (h/error "Gateway still running"))
+      (kill-buffer buffer))))
+
+(cl-defmethod h//gateway-stop (&context (h/gateway-process-type (eql 
'subprocess)))
+  "Stop the gateway subprocess.
+Used when HYPERDRIVE-GATEWAY-PROCESS-TYPE is the symbol
+`subprocess'."
+  (unless (h//gateway-running-p)
+    (user-error "Gateway not running"))
+  (interrupt-process h/gateway-process)
+  (cl-loop for i below 40
+           do (sleep-for 0.1)
+           while (h//gateway-running-p))
+  (when (h//gateway-running-p)
+    (h/error "Gateway still running"))
+  (kill-buffer (process-buffer h/gateway-process))
+  (setf h/gateway-process nil))
+
 ;;;; Misc.
 
 (defun h//get-buffer-create (entry)
diff --git a/hyperdrive-vars.el b/hyperdrive-vars.el
index 7a72b1ae57..b3f7ea9453 100644
--- a/hyperdrive-vars.el
+++ b/hyperdrive-vars.el
@@ -370,6 +370,10 @@ values are alists mapping version range starts to plists 
with
 
 ;;;;; Internals
 
+(defvar h/gateway-process nil
+  "Hyper-gateway process.
+Only used when `hyperdrive-gateway-process-type' is `subprocess'.")
+
 (defvar-local h/current-entry nil
   "Entry for current buffer.")
 (put 'h/current-entry 'permanent-local t)
diff --git a/hyperdrive.el b/hyperdrive.el
index c07d4e47d0..6036ecab6f 100644
--- a/hyperdrive.el
+++ b/hyperdrive.el
@@ -98,28 +98,13 @@
   "Start `hyper-gateway' systemd service if not already running."
   (interactive)
   ;; TODO: Verify that the latest version is installed.  See: 
<https://github.com/RangerMauve/hyper-gateway/issues/9>.
-  (let ((buffer (get-buffer-create " *hyperdrive-start*")))
-    (unwind-protect
-        (unless (zerop (call-process "systemctl" nil (list buffer t) nil 
"--user" "start" "hyper-gateway.service"))
-          (h/error "Unable to start hyper-gateway: %S"
-                   (with-current-buffer buffer
-                     (string-trim-right (buffer-string)))))
-      (kill-buffer buffer))))
-
-;; TODO: Add user option to start the gateway without systemd (run as
-;; Emacs subprocess, or other script)
+  (h//gateway-start))
 
 ;;;###autoload
 (defun hyperdrive-stop ()
   "Stop `hyper-gateway' systemd service."
   (interactive)
-  (let ((buffer (get-buffer-create " *hyperdrive-stop*")))
-    (unwind-protect
-        (unless (zerop (call-process "systemctl" nil (list buffer t) nil 
"--user" "stop" "hyper-gateway.service"))
-          (h/error "Unable to stop hyper-gateway: %S"
-                   (with-current-buffer buffer
-                     (string-trim-right (buffer-string)))))
-      (kill-buffer buffer))))
+  (h//gateway-stop))
 
 ;;;###autoload
 (defun hyperdrive-hyper-gateway-version ()