From 1e9870e13a752dd8e61b0ec9ae37d1a598c36987 Mon Sep 17 00:00:00 2001 From: Henrik Lissner Date: Mon, 17 May 2021 22:29:50 -0400 Subject: [PATCH] Refactor bin/doom So innocuous CLI command return values don't break the post-script written to /tmp/doom.sh. --- bin/doom | 217 ++++++++++++++++++++++------------------ core/autoload/output.el | 2 +- core/core-cli.el | 36 +++---- 3 files changed, 141 insertions(+), 114 deletions(-) diff --git a/bin/doom b/bin/doom index 3a88c6d8835..9f0662cdbb2 100755 --- a/bin/doom +++ b/bin/doom @@ -23,6 +23,54 @@ (expand-file-name "../" (file-name-directory (file-truename load-file-name))))) + +;; +;;; Sanity checks + +(when (version< emacs-version "26.3") + (error + (concat "Detected Emacs " emacs-version " (at " (car command-line-args) ").\n\n" + "Doom only supports Emacs 26.3 and newer. 27.1 is highly recommended. A guide\n" + "to install a newer version of Emacs can be found at:\n\n " + (format "https://doomemacs.org/docs/getting_started.org#%s" + (cond ((eq system-type 'darwin) "on-macos") + ((memq system-type '(cygwin windows-nt ms-dos)) "on-windows") + ("on-linux"))) + "Aborting..."))) + +(unless (file-readable-p (expand-file-name "core/core.el" user-emacs-directory)) + (error + (concat + "Couldn't find or read '" + (abbreviate-file-name + (expand-file-name "core/core.el" user-emacs-directory)) + "'.\n\n" + "Are you sure Doom Emacs is correctly installed?\n\n" + (when (file-symlink-p load-file-name) + (concat "This error can occur if you've symlinked the 'doom' script, which Doom does not\n" + "support. Consider symlinking its parent directory instead or explicitly set the\n" + "EMACSDIR environment variable, e.g.\n\n " + (if (string-match-p "/fish$" (getenv "SHELL")) + "env EMACSDIR=~/.emacs.d doom" + "EMACSDIR=~/.emacs.d doom sync")) + "\n\n") + "Aborting..."))) + +(when (equal (user-real-uid) 0) + ;; If ~/.emacs.d is owned by root, assume the user genuinely wants root to be + ;; their primary user. + (unless (= 0 (file-attribute-user-id (file-attributes user-emacs-directory))) + (error + (concat + "Do not run this script as root. It will cause file permissions errors later.\n\n" + "To carry on anyway, change the owner of your Emacs config to root:\n\n" + " chown root:root -R " (abbreviate-file-name user-emacs-directory) "\n\n" + "Aborting...")))) + + +;; +;;; Let 'er rip! + ;; HACK Load `cl' and site files manually to prevent polluting logs and stdout ;; with deprecation and/or file load messages. (let ((inhibit-message t)) @@ -43,100 +91,77 @@ (setq tail (cdr tail))) (load site-run-file t (not verbose))))) +;; Load the heart of the beast and its CLI processing library +(load (expand-file-name "core/core.el" user-emacs-directory) nil t) +(require 'core-cli) + (kill-emacs - (pcase - (catch 'exit - ;; Catch some potential issues early - (cond - ((version< emacs-version "26.3") - (princ (concat "Detected Emacs " emacs-version " (at " (car command-line-args) ").\n\n")) - (princ "Doom only supports Emacs 26.3 and newer. 27.1 is highly recommended. A guide\n") - (princ "to install a newer version of Emacs can be found at:\n\n ") - (princ (format "https://doomemacs.org/docs/getting_started.org#%s" - (cond ((eq system-type 'darwin) "on-macos") - ((memq system-type '(cygwin windows-nt ms-dos)) "on-windows") - ("on-linux")))) - (princ "Aborting...") - 1) - - ((not (file-readable-p (expand-file-name "core/core.el" user-emacs-directory))) - (princ (concat "Couldn't find or read '" - (abbreviate-file-name - (expand-file-name "core/core.el" user-emacs-directory)) - "'.\n\n")) - (princ "Are you sure Doom Emacs is correctly installed?\n\n") - (when (file-symlink-p load-file-name) - (princ "This error can occur if you've symlinked the 'doom' script, which Doom does not\n") - (princ "support. Consider symlinking its parent directory instead or explicitly set the\n") - (princ "EMACSDIR environment variable, e.g.\n\n ") - (princ (if (string-match-p "/fish$" (getenv "SHELL")) - "env EMACSDIR=~/.emacs.d doom" - "EMACSDIR=~/.emacs.d doom sync")) - (princ "\n\n") - (princ "Aborting...")) - 2) - - ((and (equal (user-real-uid) 0) - (/= 0 (file-attribute-user-id (file-attributes user-emacs-directory)))) - (princ "Do not run this script as root. It will cause file permissions errors later.\n\n") - (princ "To carry on anyway, change the owner of your Emacs config to root:\n\n") - (princ (concat " chown root:root -R " (abbreviate-file-name user-emacs-directory) "\n\n")) - (princ "Aborting...") - 3) - - ;; Load the heart of the beast and its CLI processing library - ((load (expand-file-name "core/core.el" user-emacs-directory) nil t) - (require 'core-cli) - - ;; Process the arguments passed to this script. `doom-cli-execute' - ;; should return a boolean, integer (error code) or throw an 'exit - ;; event, which is handled specially. - (apply #'doom-cli-execute :doom (cdr (member "--" argv)))))) - - ;; Any non-zero integer is treated as an explicit exit code. - ((and (pred integerp) code) - code) - - ;; If, instead, we were given a string or list of strings, copy these as - ;; shell script commands to a temporary script file which this script will - ;; execute after this session finishes. Also accepts special keywords, like - ;; `:restart', to rerun the current command with the same arguments. - ((and (or (pred consp) - (pred stringp) - (pred keywordp)) - command) - (let ((script (expand-file-name "doom.sh" temporary-file-directory)) - (coding-system-for-write 'utf-8-unix) - (coding-system-for-read 'utf-8-unix)) - (with-temp-file script - (insert "#!/usr/bin/env sh\n" - "_postscript() {\n" - " rm -f " (shell-quote-argument script) "\n " - (cond ((eq command :restart) "$@") - ((stringp command) command) - ((string-join - (if (listp (car-safe command)) - (cl-loop for line in (doom-enlist command) - collect (mapconcat #'shell-quote-argument (remq nil line) " ")) - (list (mapconcat #'shell-quote-argument (remq nil command) " "))) - "\n "))) - "\n}\n" - (save-match-data - (cl-loop for env - in (cl-set-difference process-environment - (get 'process-environment 'initial-value) - :test #'equal) - if (string-match "^\\([a-zA-Z0-9_]+\\)=\\(.+\\)$" env) - concat (format "%s=%s \\\n" - (match-string 1 env) - (shell-quote-argument (match-string 2 env))))) - (format "PATH=\"%s%s$PATH\" \\\n" (concat doom-emacs-dir "bin/") path-separator) - "_postscript $@\n")) - (set-file-modes script #o600)) - ;; Error code 128 is special: it means run the post-script after this - ;; session ends. - 128) - - ;; Anything else (e.g. booleans) is treated as a successful run. Yes, a `nil' - ;; indicates a successful run too! - (_ 0))) + ;; Process the arguments passed to this script. `doom-cli-execute' should + ;; return one of two things: a cons cell whose CAR is t, and CDR is the + ;; command's return value OR one of: a keyword, command string, or command + ;; list. + (pcase (apply #'doom-cli-execute :doom (cdr (member "--" argv))) + + ;; If a CLI command returns an integer, treat it as an exit code. + ((and (app car-safe `t) code) + (if (integerp (cdr code)) + (cdr code))) + + ;; CLI commands can do (throw 'exit SHELL-COMMAND) to run something after + ;; this session ends. e.g. + ;; + ;; (throw 'exit "$@") or (throw 'exit :restart) + ;; This reruns the current command with the same arguments. + ;; (throw 'exit "$@ -h -c") + ;; This reruns the current command with two new switches. + ;; (throw 'exit "emacs -nw FILE") + ;; Opens Emacs on FILE + ;; (throw 'exit t) or (throw 'exit nil) + ;; A safe way to simply abort back to the shell with exit code 0 + ;; (throw 'exit 42) + ;; Abort to shell with an explicit exit code (as a more abrupt + ;; alternative to having the CLI command return 42). + ;; + ;; How this works: the command is written to a temporary shell script which + ;; is executed after this session ends (see the shebang lines of this file). + ;; It's done this way because Emacs' batch library lacks an implementation of + ;; the exec system call. + (command + (cond + ((integerp command) + command) + ((booleanp command) + 0) + ((let ((script (expand-file-name "doom.sh" temporary-file-directory)) + (coding-system-for-write 'utf-8-unix) + (coding-system-for-read 'utf-8-unix)) + (with-temp-file script + (insert "#!/usr/bin/env sh\n" + "_postscript() {\n" + " rm -f " (shell-quote-argument script) "\n " + (cond ((eq command :restart) "$@") + ((stringp command) command) + ((string-join + (if (listp (car-safe command)) + (cl-loop for line in (doom-enlist command) + collect (mapconcat #'shell-quote-argument (remq nil line) " ")) + (list (mapconcat #'shell-quote-argument (remq nil command) " "))) + "\n "))) + "\n}\n" + (save-match-data + (cl-loop for env + in (cl-set-difference process-environment + (get 'process-environment 'initial-value) + :test #'equal) + if (string-match "^\\([a-zA-Z0-9_]+\\)=\\(.+\\)$" env) + concat (format "%s=%s \\\n" + (match-string 1 env) + (shell-quote-argument (match-string 2 env))))) + (format "PATH=\"%s%s$PATH\" \\\n" (concat doom-emacs-dir "bin/") path-separator) + "_postscript $@\n")) + (set-file-modes script #o600)))) + + ;; Error code 128 is special: it means run the post-script after this + ;; session ends. + 128) + )) diff --git a/core/autoload/output.el b/core/autoload/output.el index 1dd3617a919..760c7318ab1 100644 --- a/core/autoload/output.el +++ b/core/autoload/output.el @@ -108,7 +108,7 @@ Accepts 'ansi and 'text-properties. nil means don't render colors.") (unless (string-empty-p output) (princ output) (terpri) - t)) + output)) ;;;###autoload (defun doom--output-indent (width text &optional prefix) diff --git a/core/core-cli.el b/core/core-cli.el index 0bf6a24243e..c6bc0749d22 100644 --- a/core/core-cli.el +++ b/core/core-cli.el @@ -127,23 +127,25 @@ Environment variables: (when command (push command args)) (setq command "help")) - (if (null command) - (doom-cli-execute "help") - (let ((start-time (current-time))) - (run-hooks 'doom-cli-pre-hook) - (when (apply #'doom-cli-execute command args) - (run-hooks 'doom-cli-post-hook) - (print! (success "Finished in %s") - (let* ((duration (float-time (time-subtract (current-time) before-init-time))) - (hours (/ (truncate duration) 60 60)) - (minutes (- (/ (truncate duration) 60) (* hours 60))) - (seconds (- duration (* hours 60 60) (* minutes 60)))) - (string-join - (delq - nil (list (unless (zerop hours) (format "%dh" hours)) - (unless (zerop minutes) (format "%dm" minutes)) - (format (if (> duration 60) "%ds" "%.4fs") - seconds))))))))))) + (cons + t (if (null command) + (doom-cli-execute "help") + (let ((start-time (current-time))) + (run-hooks 'doom-cli-pre-hook) + (when-let (result (apply #'doom-cli-execute command args)) + (run-hooks 'doom-cli-post-hook) + (print! (success "Finished in %s") + (let* ((duration (float-time (time-subtract (current-time) before-init-time))) + (hours (/ (truncate duration) 60 60)) + (minutes (- (/ (truncate duration) 60) (* hours 60))) + (seconds (- duration (* hours 60 60) (* minutes 60)))) + (string-join + (delq + nil (list (unless (zerop hours) (format "%dh" hours)) + (unless (zerop minutes) (format "%dm" minutes)) + (format (if (> duration 60) "%ds" "%.4fs") + seconds)))))) + result)))))) ;; TODO Not implemented yet (doom-cli-command-not-found-error (print! (error "Command 'doom %s' not recognized") (string-join (cdr e) " "))