branch: elpa/hyperdrive
commit f7cc31105c8d117aae7dfbb77e6928d33ab8670b
Author: Adam Porter <[email protected]>
Commit: Joseph Turner <[email protected]>
Add: (h/install) etc.
Co-authored-by: Joseph Turner <[email protected]>
---
hyperdrive-lib.el | 54 ++++++++++++++++++++++++++++++++++--------------------
hyperdrive-vars.el | 7 +++++++
hyperdrive.el | 45 +++++++++++++++++++++++++++++++++++++++++++++
3 files changed, 86 insertions(+), 20 deletions(-)
diff --git a/hyperdrive-lib.el b/hyperdrive-lib.el
index ddac1e80f2..85a467c76d 100644
--- a/hyperdrive-lib.el
+++ b/hyperdrive-lib.el
@@ -1463,11 +1463,10 @@ To customize the command run as a subprocess, see
(const :tag "Autodetect" nil))
:group 'hyperdrive)
-(defcustom h/gateway-command
- "hyper-gateway-ushin run --writable true --silent true"
+(defcustom h/gateway-command-args "run --writable true --silent true"
;; TODO: File Emacs bug report because the customization formatter handles
the
;; "symbol `subprocess'" part differently than `describe-variable' does.
- "Command used to run hyper-gateway-ushin.
+ "Arguments passed to hyper-gateway-ushin.
Only used when `hyperdrive-gateway-process-type' is the symbol `subprocess'."
:type 'string
:group 'hyperdrive)
@@ -1488,28 +1487,43 @@ Used when HYPERDRIVE-GATEWAY-PROCESS-TYPE is the symbol
(string-trim-right (buffer-string)))))
(kill-buffer buffer))))
-(cl-defmethod h//gateway-start (&context (h/gateway-process-type (eql
'subprocess)))
+(defun h//hyper-gateway-ushin-path ()
+ "Return path to hyper-gateway-ushin executable, or nil if not found."
+ (cond ((file-exists-p
+ (expand-file-name "hyper-gateway-ushin"
hyperdrive-gateway-directory))
+ (expand-file-name "hyper-gateway-ushin" hyperdrive-gateway-directory))
+ ((executable-find "hyper-gateway-ushin"))))
+
+(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"))
- (condition-case nil
- (setf h/gateway-process
- (make-process :name "hyper-gateway-ushin"
- :buffer " *hyperdrive-start*"
- :command (split-string-and-unquote h/gateway-command)
- :connection-type 'pipe))
- (file-missing
- (info "(hyperdrive) hyper-gateway-ushin")
- (user-error
- "hyper-gateway-ushin not found; Please see installation instructions")))
- (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)"))))
+ (let ((hyper-gateway-ushin-path
+ (or (h//hyper-gateway-ushin-path)
+ (user-error (substitute-command-keys
+ "Executable \"hyper-gateway-ushin\" not found.\
+ Try \\[hyperdrive-install]")))))
+ (condition-case nil
+ (setf h/gateway-process
+ (make-process
+ :name "hyper-gateway-ushin"
+ :buffer " *hyperdrive-start*"
+ :command (cons hyper-gateway-ushin-path
+ (split-string-and-unquote
h/gateway-command-args))
+ :connection-type 'pipe))
+ (file-missing
+ (info "(hyperdrive) hyper-gateway-ushin")
+ (user-error
+ "hyper-gateway-ushin not found; Please see installation
instructions")))
+ (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.
diff --git a/hyperdrive-vars.el b/hyperdrive-vars.el
index 672e3106ba..8a850b8ef5 100644
--- a/hyperdrive-vars.el
+++ b/hyperdrive-vars.el
@@ -255,6 +255,13 @@ value (and should only be present once in the string).
Used in
(cons :tag "Hyperdrive domains" (const domains)
(string :tag "Format string"))))
+(defcustom h/gateway-directory (expand-file-name "~/.local/lib/hyperdrive.el")
+ "Where the hyper-gateway executable is found.
+If not found here, the \"PATH\" environment variable is checked
+with `executable-find'. Command `hyperdrive-install' installs to
+this directory."
+ :type 'directory)
+
;;;;; Faces
(defgroup hyperdrive-faces nil
diff --git a/hyperdrive.el b/hyperdrive.el
index 196d041681..14e016c964 100644
--- a/hyperdrive.el
+++ b/hyperdrive.el
@@ -1261,6 +1261,51 @@ Intended for relative (i.e. non-full) URLs."
(add-to-list 'embark-keymap-alist '(hyperdrive . h/embark-hyperdrive-map)))
+;;;;; Installation
+
+(defvar h/gateway-url-alist
+ '((gnu/linux :url
"https://git.sr.ht/~ushin/hyper-gateway-ushin/refs/download/v3.7.0/hyper-gateway-linux";
+ :sha256
"eca52cfd2b8ce1a77fbe3c46fc78155b59cb2d705d4ae5f6867de027b4acc320")
+ (darwin :url
"https://git.sr.ht/~ushin/hyper-gateway-ushin/refs/download/v3.7.0/hyper-gateway-linux";
+ :sha256
"5387faa8960a7f7b0401dab9dc34868317c0b24050160cfba9bcdf5f49c0dd91")
+ (windows-nt :url
"https://git.sr.ht/~ushin/hyper-gateway-ushin/refs/download/v3.7.0/hyper-gateway-windows.exe";
+ :sha256
"71a8f30b27f41e61e5c7ffedeff783698c30ac3562d81a364a42b92d9a148fe7"))
+ "Alist mapping `system-type' to URLs where hyper-gateway-ushin can be
downloaded.")
+
+;;;###autoload
+(defun h/install ()
+ "Install hyper-gateway-ushin.
+Sets `hyperdrive-gateway-process-type' to \\+`subprocess'."
+ (interactive)
+ (when (h//hyper-gateway-ushin-path)
+ (user-error "Program \"hyper-gateway-ushin\" already installed"))
+ (pcase-let* (((map :url :sha256) (alist-get system-type h/gateway-url-alist))
+ (local-file-name
+ (expand-file-name "hyper-gateway-ushin" h/gateway-directory))
+ ;; TODO: Uncomment when SourceHut adds Content-Length header.
+ ;; (file-size
+ ;; (file-size-human-readable
+ ;; (cl-parse-integer (alist-get 'content-length
+ ;; (plz-response-headers
+ ;; (plz 'head url :as
'response))))))
+ (temp-file-name))
+ (unless (file-directory-p h/gateway-directory)
+ (mkdir h/gateway-directory t))
+ (h/message "Downloading hyper-gateway-ushin..."
+ ;; (format "Downloading hyper-gateway-ushin (%s)..." file-size)
+ )
+ (let ((inhibit-message t))
+ (setf temp-file-name (url-file-local-copy url)))
+ (unless (equal sha256 (with-temp-buffer
+ (insert-file-contents-literally temp-file-name)
+ (secure-hash 'sha256 (current-buffer))))
+ (h/error "Downloaded hyper-gateway-ushin file hash doesn't match"))
+ (rename-file temp-file-name local-file-name)
+ (chmod local-file-name #o755)
+ (funcall (get 'h/gateway-process-type 'custom-set)
+ 'h/gateway-process-type 'subprocess)
+ (h/message "hyper-gateway-ushin installed.")))
+
;;;; Footer
(provide 'hyperdrive)
