emenel/doomemacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

doctor: rewrite TLS heuristics

Browse source 
Fixes "peculiar error" in #175, #285, #288
This commit is contained in:
Henrik Lissner 2017-12-20 19:52:06 -05:00
parent bd1a4e31f6
commit c3c5de93c7
No known key found for this signature in database
GPG key ID: 5F6C0EA160557395
1 changed files with 32 additions and 45 deletions
Download patch file Download diff file Expand all files Collapse all files

77
bin/doom-doctor
View file

@ -20,9 +20,10 @@
(defvar doom-errors 0) (defvar doom-errors 0)
(defmacro check! (cond &rest body) (defmacro check! (cond &rest body)
(declare (indent defun)) (declare (indent defun))
`(when ,cond `(let ((it ,cond))
,@body (when it
(setq doom-errors (1+ doom-errors)))) ,@body
(setq doom-errors (1+ doom-errors)))))
(defun indented (spc msg) (defun indented (spc msg)
(declare (indent defun)) (declare (indent defun))
@ -57,17 +58,6 @@
"\n"))) "\n")))
(buffer-string))) (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) (defun color (code msg &rest args)
(format "\e[%dm%s\e[%dm" code (apply #'format msg args) 0)) (format "\e[%dm%s\e[%dm" code (apply #'format msg args) 0))
@ -211,43 +201,40 @@
" brew tap d12frosted/emacs-plus" " brew tap d12frosted/emacs-plus"
" brew install emacs-plus")))) " brew install emacs-plus"))))
((not (fboundp 'url-retrieve-synchronously))
(error! "Can't find url-retrieve-synchronously function. Are you running Emacs 24+?"))
((or (executable-find "gnutls-cli") ((or (executable-find "gnutls-cli")
(executable-find "openssl")) (executable-find "openssl"))
(let ((tls-checktrust t) (let ((tls-checktrust t)
(gnutls-verify-error t)) (gnutls-verify-error t))
(dolist (url '("https://elpa.gnu.org" (dolist (url '("https://elpa.gnu.org" "https://melpa.org"))
"https://melpa.org")) (check! (condition-case-unless-debug e
(condition-case-unless-debug ex (if (let ((inhibit-message t)) (url-retrieve-synchronously url))
(let (result) (ignore (success! "Validated %s" url))
(let ((inhibit-message t)) 'empty)
(url-retrieve url (lambda (status &rest _) (setq result status)))) ('timed-out 'timeout)
(wait-for! result ('error e))
(when (getenv "DEBUG") (pcase it
(success! "Verified %s" (nth 2 (split-string url "/")))) (`empty (error! "Couldn't reach %s" url))
(signal 'timed-out url))) (`timeout (error! "Timed out trying to contact %s" ex))
('timed-out (_
(error! "Timed out trying to contact %s" ex)) (error! "Failed to validate %s" url)
('error (when (getenv "DEBUG")
(check! t (explain! (pp-to-string it)))))))
(error! "Rejected %s" url)
(explain! (pp-to-string ex))))))
(dolist (url '("https://self-signed.badssl.com" (dolist (url '("https://self-signed.badssl.com"
"https://wrong.host.badssl.com/")) "https://wrong.host.badssl.com/"))
(condition-case-unless-debug ex (check! (condition-case-unless-debug e
(let (result) (if (let ((inhibit-message t)) (url-retrieve-synchronously url))
(let ((inhibit-message t)) t
(url-retrieve url (lambda (status &rest _) (setq result status)))) 'empty)
(wait-for! result ('timed-out 'timeout)
(check! t ('error (ignore (success! "Successfully rejected %s" url))))
(warn! "Verified %s (this shouldn't happen!)" (nth 2 (split-string url "/"))) (pcase it
(explain! (pp-to-string result))) (`empty (error! "Couldn't reach %s" url))
(signal 'timed-out url))) (`timeout (error! "Timed out trying to contact %s" ex))
('timed-out (_
(error! "Timed out trying to contact %s" ex)) (error! "Validated %s (this shouldn't happen!)" url)))))))
('error
(when (getenv "DEBUG")
(success! "Rejected %s (a good thing!)" url)
(explain! (pp-to-string ex))))))))
(t (t
(error! "Nope!"))) (error! "Nope!")))