doomemacs/bin/doctor
Henrik Lissner 732dee608a
Stability/error-handling refactor (part 1)
This refactor is about improving how Emacs deals with errors.

A large net is now cast at startup to catch possible errors, produce
more helpful error messages, and localize the damage. Significantly
reducing the risk of later modules not loading (and leaving you
stranded in a half-broken Emacs session).

The DOOM core files are an exception. If something messes up in there,
it *should* choke.

+ use-package will now report missing packages or slow-loading/broken
  def-package! configurations.
+ Persp-mode no longer (inadvertantly) hides buffers that pop up at
  startup, like the *Warnings*, *Backtrace* or debugger buffers.
+ `make autoloads` (or doom/reload-autoloads) now produces a slightly
  more informative error message if an error occurs while building the
  autoloads file.
+ Error handling for package management is *slightly* better now; error
  messages now include the type of error; this needs work.
2017-06-14 21:15:19 +02:00

278 lines
11 KiB
Bash
Executable file

#!/usr/bin/env bash
":"; command -v emacs >/dev/null || { >&2 echo "Emacs isn't installed"; exit 1; } # -*-emacs-lisp-*-
":"; [[ $(emacs --version | head -n1) == *\ 2[0-2].[0-1].[0-9] ]] && { echo "You're running $(emacs --version | head -n1)"; echo "That version is too old to run the doctor. Check your PATH"; echo; exit 2; } || exec emacs --no-site-file --batch -l "$0"
;; Uses a couple simple heuristics to locate issues with your environment that
;; could interfere with running or setting up DOOM Emacs.
;; In case it isn't defined (in really old versions of Emacs, like the one that
;; ships with MacOS).
(defvar user-emacs-directory (expand-file-name "~/.emacs.d/"))
(unless (equal (expand-file-name user-emacs-directory)
(expand-file-name "~/.emacs.d/"))
(error "Couldn't find ~/.emacs.d"))
(require 'pp)
;;
(defvar doom-errors 0)
(defmacro check! (cond &rest body)
(declare (indent defun))
`(when ,cond
,@body
(setq doom-errors (1+ doom-errors))))
(defun indented (spc msg)
(declare (indent defun))
(with-temp-buffer
(insert msg)
(indent-rigidly (point-min) (point-max) spc)
(buffer-string)))
(defun autofill (&rest msgs)
(declare (indent defun))
(let ((fill-column 70))
(with-temp-buffer
(dolist (line msgs)
(when line
(insert line)))
(fill-region (point-min) (point-max))
(buffer-string))))
(defun columns (cols length strings)
(declare (indent defun))
(with-temp-buffer
(let ((sub-format (format "%%-%ds " (1- length)))
col-format)
(dotimes (i (1- cols))
(setq col-format (concat col-format sub-format)))
(setq col-format (concat col-format "%s"))
(while strings
(insert (apply #'format col-format
(let (args)
(dotimes (i cols (nreverse args))
(push (if strings (pop strings) "") args))))
"\n")))
(buffer-string)))
(defmacro wait-for! (var if-body &optional else-body)
(declare (indent defun))
`(let ((i 0))
(while (and (not ,var)
(< i 5))
(sleep-for 1)
(setq i (1+ i)))
(if ,var
,if-body
,else-body)))
(defun color (code msg &rest args)
(format "\e[%dm%s\e[%dm" code (apply #'format msg args) 0))
(defalias 'msg! #'message)
(defmacro error! (&rest args) `(message (color 1 (color 31 ,@args))))
(defmacro warn! (&rest args) `(message (color 1 (color 33 ,@args))))
(defmacro success! (&rest args) `(message (color 1 (color 32 ,@args))))
(defmacro explain! (&rest args) `(message (indented 2 (autofill ,@args))))
;;; Polyfills
;; early versions of emacs won't have this
(unless (fboundp 'string-match-p)
(defun string-match-p (regexp string &optional start)
(save-match-data
(string-match regexp string &optional start))))
;; --- start a'doctorin' --------------------------------------
(msg! "%s\nRunning Emacs v%s, commit %s"
(color 1 "DOOM Doctor")
(color 1 emacs-version)
(if (executable-find "git")
(shell-command-to-string "git rev-parse HEAD")
"n/a"))
(when (boundp 'system-configuration-features)
(msg! "Compiled with:\n%s" (indented 2 (autofill system-configuration-features))))
(msg! "uname -a:\n%s" (indented 2 (autofill (shell-command-to-string "uname -a"))))
(msg! "----\n")
;; --- is emacs set up properly? ------------------------------
(check! (version< emacs-version "25.1")
(error! "Important: Emacs %s detected [%s]" emacs-version (executable-find "emacs"))
(explain!
"DOOM only supports >= 25.1. Perhaps your PATH wasn't set up properly."
(when (eq system-type 'darwin)
(concat "\nMacOS users should use homebrew (https://brew.sh) to install Emacs\n"
" brew install emacs --with-modules --with-imagemagick --with-cocoa"))))
;; --- is the environment set up properly? --------------------
;; gnutls-cli & openssl
(cond ((executable-find "gnutls-cli"))
((executable-find "openssl")
(let* ((output (shell-command-to-string "openssl ciphers -v"))
(protocols
(let (protos)
(mapcar (lambda (row)
(add-to-list 'protos (cadr (split-string row " " t))))
(split-string (shell-command-to-string "openssl ciphers -v") "\n"))
(delq nil protos))))
(check! (not (or (member "TLSv1.1" protocols)
(member "TLSv1.2" protocols)))
(let ((version (cadr (split-string (shell-command-to-string "openssl version") " " t))))
(warn! "Warning: couldn't find gnutls-cli, and OpenSSL is out-of-date (v%s)" version)
(explain!
"This may not affect your Emacs experience, but there are security "
"vulnerabilities in the SSL2/3 & TLS1.0 protocols. You should use "
"TLS 1.1+, which wasn't introduced until OpenSSL v1.0.1.\n\n"
"Please consider updating (or install gnutls-cli, which is preferred).")))))
(t
(check! t
(error! "Important: couldn't find either gnutls-cli nor openssl")
(explain!
"You won't be able to install/update packages because Emacs won't be able to "
"verify HTTPS ELPA sources. Install gnutls-cli or openssl v1.0.0+. If for some "
"reason you can't, you can bypass this verification with the INSECURE flag:\n\n"
" INSECURE=1 make install\n\n"
"Or change `package-archives' to use non-https sources.\n\n"
"But remember that you're leaving your security in the hands of your "
"network, provider, government, neckbearded mother-in-laws, geeky roommates, "
"or just about anyone who knows more about computers than you do!"))))
(cond ((or (executable-find "gnutls-cli")
(executable-find "openssl"))
(let ((tls-checktrust t)
(gnutls-verify-error t))
(dolist (url '("https://elpa.gnu.org/packages/archive-contents"
"https://melpa.org/packages/archive-contents"))
(condition-case-unless-debug ex
(let (result)
(let ((inhibit-message t))
(url-retrieve url (lambda (status &rest _) (setq result status))))
(wait-for! result
(when (getenv "DEBUG")
(success! "Verified %s" (nth 2 (split-string url "/"))))
(signal 'timed-out url)))
('timed-out
(error! "Timed out trying to contact %s" ex))
('error
(check! t
(error! "Rejected %s" url)
(explain! (pp-to-string ex))))))
(dolist (url '("https://self-signed.badssl.com"
"https://wrong.host.badssl.com/"))
(condition-case-unless-debug ex
(let (result)
(let ((inhibit-message t))
(url-retrieve url (lambda (status &rest _) (setq result status))))
(wait-for! result
(check! t
(warn! "Verified %s (this shouldn't happen!)" (nth 2 (split-string url "/")))
(explain! (pp-to-string result)))
(signal 'timed-out url)))
('timed-out
(error! "Timed out trying to contact %s" ex))
('error
(when (getenv "DEBUG")
(success! "Rejected %s (a good thing!)" url)
(explain! (pp-to-string ex))))))))
(t
(error! "Nope!")))
;; windows? windows
(check! (memq system-type '(windows-nt ms-dos cygwin))
(warn! "Warning: Windows detected")
(explain! "DOOM was designed for MacOS and Linux. Expect a bumpy ride!"))
;; bsd vs gnu tar
(let ((tar-bin (or (executable-find "gtar")
(executable-find "tar"))))
(if tar-bin
(check! (not (string-match-p "(GNU tar)" (shell-command-to-string (format "%s --version" tar-bin))))
(warn! "Warning: BSD tar detected")
(explain!
"QUELPA (through package-build) uses the system tar to build plugins, but it "
"expects GNU tar. BSD tar *could* cause errors during package installation or "
"updating from non-ELPA sources."
(when (eq system-type 'darwin)
(concat "\nMacOS users can install gnu-tar via homebrew:\n"
" brew install gnu-tar"))))
(check! t ; very unlikely
(error! "Important: Couldn't find tar")
(explain!
"This is required by package.el and QUELPA to build packages and will "
"prevent you from installing & updating packages."))))
;; --- report! ------------------------------------------------
(when (getenv "DEBUG")
(msg! "\n====\nHave some debug information:\n")
(let (doom-core-packages doom-debug-mode)
(condition-case ex
(progn
(let ((inhibit-message t))
(load "~/.emacs.d/core/core.el" nil t))
(doom-initialize-packages)
(success! " + Attempt to load DOOM: success! Loaded v%s" doom-version)
(when (executable-find "git")
(msg! " Revision %s"
(or (ignore-errors
(let ((default-directory user-emacs-directory))
(shell-command-to-string "git rev-parse HEAD")))
"\n"))))
('error (warn! " + Attempt to load DOOM: failed\n %s\n" (or (cdr-safe ex) (car ex))))))
(when (bound-and-true-p doom-modules)
(msg! " + enabled modules:\n%s"
(indented 4
(columns 3 23
(mapcar (lambda (x) (format "+%s" x))
(mapcar #'cdr (doom--module-pairs)))))))
(when (and (bound-and-true-p doom-packages)
(require 'package nil t))
(msg! " + enabled packages:\n%s"
(indented 4
(columns 2 35
(mapcar (lambda (pkg)
(let ((desc (cadr (assq pkg package-alist))))
(when desc
(package-desc-full-name desc))))
(sort (mapcar #'car doom-packages) #'string-lessp))))))
(msg! " + byte-compiled files:\n%s"
(indented 4
(columns 2 39
(let ((files (append (directory-files-recursively doom-core-dir ".elc$")
(directory-files-recursively doom-modules-dir ".elc$"))))
(or (and files (mapcar (lambda (file) (file-relative-name file doom-emacs-dir))
(nreverse files)))
(list "n/a"))))))
(msg! " + exec-path:\n%s"
(indented 4
(columns 1 79 exec-path)))
(msg! " + PATH:\n%s"
(indented 4
(columns 1 79 (split-string (getenv "PATH") ":")))))
;;
(if (= doom-errors 0)
(success! "Everything seems fine, happy Emacs'ing!")
(message "\n----")
(warn! "There were issues!")
(unless (getenv "DEBUG")
(msg! "\nHopefully these can help you find problems. If not, run this doctor again with DEBUG=1:")
(msg! "\n DEBUG=1 make doctor\n")
(msg! "And file a bug report with its output at https://github.com/hlissner/.emacs.d/issues")))