refactor(lib): doom-info & remove unused commands
- Simplify doom-info and doom/info. - Remove doom/copy-buffer-contents (may be moved later, but atm not very useful). - Remove doom/am-i-secure (this will later be replaced with CLI commands)
This commit is contained in:
Henrik Lissner
parent
8455bcf6b4
commit
dcae7187b4
2 changed files with 85 additions and 119 deletions
|
|
@ -275,116 +275,25 @@ ready to be pasted in a bug report on github."
|
||||||
"n/a"))))
|
"n/a"))))
|
||||||
|
|
||||||
;;;###autoload
|
;;;###autoload
|
||||||
(defun doom/info (&optional raw)
|
(defun doom/info ()
|
||||||
"Collects some debug information about your Emacs session, formats it and
|
"Collects some debug information about your Emacs session, formats it and
|
||||||
copies it to your clipboard, ready to be pasted into bug reports!"
|
copies it to your clipboard, ready to be pasted into bug reports!"
|
||||||
(interactive "P")
|
(interactive "P")
|
||||||
(let ((buffer (get-buffer-create "*doom info*"))
|
(with-current-buffer (pop-to-buffer "*doom info*")
|
||||||
(info (doom-info)))
|
(setq buffer-read-only t)
|
||||||
(with-current-buffer buffer
|
(with-silent-modifications
|
||||||
(erase-buffer)
|
(erase-buffer)
|
||||||
(if raw
|
(save-excursion
|
||||||
(progn
|
(dolist (spec (cl-remove-if-not #'cdr (doom-info)))
|
||||||
(save-excursion
|
(insert! "%-11s %s\n"
|
||||||
(pp info (current-buffer)))
|
((car spec)
|
||||||
(dolist (sym '(modules packages))
|
(if (listp (cdr spec))
|
||||||
(when (re-search-forward (format "^ *\\((%s\\)" sym) nil t)
|
(mapconcat (lambda (x) (format "%s" x))
|
||||||
(goto-char (match-beginning 1))
|
(cdr spec) " ")
|
||||||
(cl-destructuring-bind (beg . end)
|
(cdr spec)))))))
|
||||||
(bounds-of-thing-at-point 'sexp)
|
(kill-new (buffer-string))
|
||||||
(let ((sexp (prin1-to-string (sexp-at-point))))
|
(when (y-or-n-p "Your doom-info was copied to the clipboard.\n\nOpen pastebin.com?")
|
||||||
(delete-region beg end)
|
(browse-url "https://pastebin.com"))))
|
||||||
(insert sexp))))))
|
|
||||||
(dolist (spec info)
|
|
||||||
(when (cdr spec)
|
|
||||||
(insert! "%-11s %s\n"
|
|
||||||
((car spec)
|
|
||||||
(if (listp (cdr spec))
|
|
||||||
(mapconcat (lambda (x) (format "%s" x))
|
|
||||||
(cdr spec) " ")
|
|
||||||
(cdr spec)))))))
|
|
||||||
(if (not doom-interactive-p)
|
|
||||||
(print! (buffer-string))
|
|
||||||
(with-current-buffer (pop-to-buffer buffer)
|
|
||||||
(setq buffer-read-only t)
|
|
||||||
(goto-char (point-min))
|
|
||||||
(kill-new (buffer-string))
|
|
||||||
(when (y-or-n-p "Your doom-info was copied to the clipboard.\n\nOpen pastebin.com?")
|
|
||||||
(browse-url "https://pastebin.com")))))))
|
|
||||||
|
|
||||||
|
|
||||||
;;;###autoload
|
|
||||||
(defun doom/am-i-secure ()
|
|
||||||
"Test to see if your root certificates are securely configured in emacs.
|
|
||||||
Some items are not supported by the `nsm.el' module."
|
|
||||||
(declare (interactive-only t))
|
|
||||||
(interactive)
|
|
||||||
(unless (string-match-p "\\_<GNUTLS\\_>" system-configuration-features)
|
|
||||||
(warn "gnutls support isn't built into Emacs, there may be problems"))
|
|
||||||
(if-let* ((bad-hosts
|
|
||||||
(cl-loop for bad
|
|
||||||
in '("https://expired.badssl.com/"
|
|
||||||
"https://wrong.host.badssl.com/"
|
|
||||||
"https://self-signed.badssl.com/"
|
|
||||||
"https://untrusted-root.badssl.com/"
|
|
||||||
;; "https://revoked.badssl.com/"
|
|
||||||
;; "https://pinning-test.badssl.com/"
|
|
||||||
"https://sha1-intermediate.badssl.com/"
|
|
||||||
"https://rc4-md5.badssl.com/"
|
|
||||||
"https://rc4.badssl.com/"
|
|
||||||
"https://3des.badssl.com/"
|
|
||||||
"https://null.badssl.com/"
|
|
||||||
"https://sha1-intermediate.badssl.com/"
|
|
||||||
;; "https://client-cert-missing.badssl.com/"
|
|
||||||
"https://dh480.badssl.com/"
|
|
||||||
"https://dh512.badssl.com/"
|
|
||||||
"https://dh-small-subgroup.badssl.com/"
|
|
||||||
"https://dh-composite.badssl.com/"
|
|
||||||
"https://invalid-expected-sct.badssl.com/"
|
|
||||||
;; "https://no-sct.badssl.com/"
|
|
||||||
;; "https://mixed-script.badssl.com/"
|
|
||||||
;; "https://very.badssl.com/"
|
|
||||||
"https://subdomain.preloaded-hsts.badssl.com/"
|
|
||||||
"https://superfish.badssl.com/"
|
|
||||||
"https://edellroot.badssl.com/"
|
|
||||||
"https://dsdtestprovider.badssl.com/"
|
|
||||||
"https://preact-cli.badssl.com/"
|
|
||||||
"https://webpack-dev-server.badssl.com/"
|
|
||||||
"https://captive-portal.badssl.com/"
|
|
||||||
"https://mitm-software.badssl.com/"
|
|
||||||
"https://sha1-2016.badssl.com/"
|
|
||||||
"https://sha1-2017.badssl.com/")
|
|
||||||
if (condition-case _e
|
|
||||||
(url-retrieve-synchronously bad)
|
|
||||||
(error nil))
|
|
||||||
collect bad)))
|
|
||||||
(error "tls seems to be misconfigured (it got %s)."
|
|
||||||
bad-hosts)
|
|
||||||
(url-retrieve "https://badssl.com"
|
|
||||||
(lambda (status)
|
|
||||||
(if (or (not status) (plist-member status :error))
|
|
||||||
(warn "Something went wrong.\n\n%s" (pp-to-string status))
|
|
||||||
(message "Your trust roots are set up properly.\n\n%s" (pp-to-string status))
|
|
||||||
t)))))
|
|
||||||
|
|
||||||
|
|
||||||
;;
|
|
||||||
;;; Reporting bugs
|
|
||||||
|
|
||||||
;;;###autoload
|
|
||||||
(defun doom/copy-buffer-contents (buffer-name)
|
|
||||||
"Copy the contents of BUFFER-NAME to your clipboard."
|
|
||||||
(interactive
|
|
||||||
(list (if current-prefix-arg
|
|
||||||
(completing-read "Select buffer: " (mapcar #'buffer-name (buffer-list)))
|
|
||||||
(buffer-name (current-buffer)))))
|
|
||||||
(let ((buffer (get-buffer buffer-name)))
|
|
||||||
(unless (buffer-live-p buffer)
|
|
||||||
(user-error "Buffer isn't live"))
|
|
||||||
(kill-new
|
|
||||||
(with-current-buffer buffer
|
|
||||||
(substring-no-properties (buffer-string))))
|
|
||||||
(message "Contents of %S were copied to the clipboard" buffer-name)))
|
|
||||||
|
|
||||||
|
|
||||||
;;
|
;;
|
||||||
|
|
|
||||||
|
|
@ -8,23 +8,80 @@
|
||||||
(defcli! info
|
(defcli! info
|
||||||
((format ["--json" "--md" "--lisp"] "What format to dump info into"))
|
((format ["--json" "--md" "--lisp"] "What format to dump info into"))
|
||||||
"Output system info in markdown for bug reports."
|
"Output system info in markdown for bug reports."
|
||||||
(pcase format
|
(with-temp-buffer
|
||||||
("--json"
|
(pcase format
|
||||||
(require 'json)
|
("--json"
|
||||||
(with-temp-buffer
|
(require 'json)
|
||||||
(insert (json-encode (doom-info)))
|
(insert (json-encode (doom-info)))
|
||||||
(json-pretty-print-buffer)
|
(json-pretty-print-buffer))
|
||||||
(print! (buffer-string))))
|
("--lisp"
|
||||||
("--lisp"
|
(pp (doom-info)))
|
||||||
(doom/info 'raw))
|
(`nil
|
||||||
(`nil
|
(dolist (spec (cl-remove-if-not #'cdr (doom-info)))
|
||||||
(doom/info))
|
(insert! "%-11s %s\n"
|
||||||
(_
|
((car spec)
|
||||||
(user-error "I don't understand %S. Did you mean --json, --md/--markdown or --lisp?"
|
(if (listp (cdr spec))
|
||||||
format)))
|
(mapconcat (lambda (x) (format "%s" x))
|
||||||
|
(cdr spec) " ")
|
||||||
|
(cdr spec))))))
|
||||||
|
(_
|
||||||
|
(user-error "I don't understand %S. Did you mean --json, --md/--markdown or --lisp?"
|
||||||
|
format)))
|
||||||
|
(print! (buffer-string)))
|
||||||
nil)
|
nil)
|
||||||
|
|
||||||
(defcli! (version v) ()
|
(defcli! (version v) ()
|
||||||
"Show version information for Doom & Emacs."
|
"Show version information for Doom & Emacs."
|
||||||
|
(error "Test")
|
||||||
(doom/version)
|
(doom/version)
|
||||||
nil)
|
nil)
|
||||||
|
|
||||||
|
(defcli! amisecure ()
|
||||||
|
"TODO"
|
||||||
|
(unless (string-match-p "\\_<GNUTLS\\_>" system-configuration-features)
|
||||||
|
(warn "gnutls support isn't built into Emacs, there may be problems"))
|
||||||
|
(if-let* ((bad-hosts
|
||||||
|
(cl-loop for bad
|
||||||
|
in '("https://expired.badssl.com/"
|
||||||
|
"https://wrong.host.badssl.com/"
|
||||||
|
"https://self-signed.badssl.com/"
|
||||||
|
"https://untrusted-root.badssl.com/"
|
||||||
|
;; "https://revoked.badssl.com/"
|
||||||
|
;; "https://pinning-test.badssl.com/"
|
||||||
|
"https://sha1-intermediate.badssl.com/"
|
||||||
|
"https://rc4-md5.badssl.com/"
|
||||||
|
"https://rc4.badssl.com/"
|
||||||
|
"https://3des.badssl.com/"
|
||||||
|
"https://null.badssl.com/"
|
||||||
|
"https://sha1-intermediate.badssl.com/"
|
||||||
|
;; "https://client-cert-missing.badssl.com/"
|
||||||
|
"https://dh480.badssl.com/"
|
||||||
|
"https://dh512.badssl.com/"
|
||||||
|
"https://dh-small-subgroup.badssl.com/"
|
||||||
|
"https://dh-composite.badssl.com/"
|
||||||
|
"https://invalid-expected-sct.badssl.com/"
|
||||||
|
;; "https://no-sct.badssl.com/"
|
||||||
|
;; "https://mixed-script.badssl.com/"
|
||||||
|
;; "https://very.badssl.com/"
|
||||||
|
"https://subdomain.preloaded-hsts.badssl.com/"
|
||||||
|
"https://superfish.badssl.com/"
|
||||||
|
"https://edellroot.badssl.com/"
|
||||||
|
"https://dsdtestprovider.badssl.com/"
|
||||||
|
"https://preact-cli.badssl.com/"
|
||||||
|
"https://webpack-dev-server.badssl.com/"
|
||||||
|
"https://captive-portal.badssl.com/"
|
||||||
|
"https://mitm-software.badssl.com/"
|
||||||
|
"https://sha1-2016.badssl.com/"
|
||||||
|
"https://sha1-2017.badssl.com/")
|
||||||
|
if (condition-case _e
|
||||||
|
(url-retrieve-synchronously bad)
|
||||||
|
(error nil))
|
||||||
|
collect bad)))
|
||||||
|
(print! (error "tls seems to be misconfigured (it got %s).")
|
||||||
|
bad-hosts)
|
||||||
|
(url-retrieve "https://badssl.com"
|
||||||
|
(lambda (status)
|
||||||
|
(if (or (not status) (plist-member status :error))
|
||||||
|
(print! (warn "Something went wrong.\n\n%s") (pp-to-string status))
|
||||||
|
(print! (success "Your trust roots are set up properly.\n\n%s") (pp-to-string status))
|
||||||
|
t)))))
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue