bin/doctor: add SSL/TLS tests
This commit is contained in:
parent
f2c2550549
commit
af286043a4
1 changed files with 65 additions and 30 deletions
45
bin/doctor
45
bin/doctor
|
@ -98,8 +98,8 @@
|
||||||
;; --- is the environment set up properly? --------------------
|
;; --- is the environment set up properly? --------------------
|
||||||
|
|
||||||
;; gnutls-cli & openssl
|
;; gnutls-cli & openssl
|
||||||
(unless (executable-find "gnutls-cli")
|
(cond ((executable-find "gnutls-cli"))
|
||||||
(cond ((executable-find "openssl")
|
((executable-find "openssl")
|
||||||
(let* ((output (shell-command-to-string "openssl ciphers -v"))
|
(let* ((output (shell-command-to-string "openssl ciphers -v"))
|
||||||
(protocols
|
(protocols
|
||||||
(let (protos)
|
(let (protos)
|
||||||
|
@ -116,10 +116,10 @@
|
||||||
"vulnerabilities in the SSL2/3 & TLS1.0 protocols. You should use "
|
"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"
|
"TLS 1.1+, which wasn't introduced until OpenSSL v1.0.1.\n\n"
|
||||||
|
|
||||||
"Please considering updating (or installing gnutls-cli, which is preferred).")))))
|
"Please consider updating (or install gnutls-cli, which is preferred).")))))
|
||||||
(t
|
(t
|
||||||
(check! t
|
(check! t
|
||||||
(error! "Important: couldn't find either gnutls-cli or openssl")
|
(error! "Important: couldn't find either gnutls-cli nor openssl")
|
||||||
(explain!
|
(explain!
|
||||||
"You won't be able to install/update packages because Emacs won't be able to "
|
"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 "
|
"verify HTTPS ELPA sources. Install gnutls-cli or openssl v1.0.0+. If for some "
|
||||||
|
@ -131,7 +131,42 @@
|
||||||
|
|
||||||
"But remember that you're leaving your security in the hands of your "
|
"But remember that you're leaving your security in the hands of your "
|
||||||
"network, provider, government, neckbearded mother-in-laws, geeky roommates, "
|
"network, provider, government, neckbearded mother-in-laws, geeky roommates, "
|
||||||
"or just about anyone who knows more about computers than you do!")))))
|
"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 ex
|
||||||
|
(let (result)
|
||||||
|
(let ((inhibit-message t))
|
||||||
|
(url-retrieve url (lambda (status &rest _) (setq result status))))
|
||||||
|
(while (not result) (sleep-for 1))
|
||||||
|
(when (getenv "DEBUG")
|
||||||
|
(success! "Verified %s" (nth 2 (split-string url "/")))))
|
||||||
|
('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 ex
|
||||||
|
(let (result)
|
||||||
|
(let ((inhibit-message t))
|
||||||
|
(url-retrieve url (lambda (status &rest _) (setq result status))))
|
||||||
|
(while (not result) (sleep-for 1))
|
||||||
|
(check! t
|
||||||
|
(warn! "Verified %s (this shouldn't happen!)" (nth 2 (split-string url "/")))
|
||||||
|
(explain! (pp-to-string result))))
|
||||||
|
('error
|
||||||
|
(when (getenv "DEBUG")
|
||||||
|
(success! "Rejected %s (a good thing!)" url)
|
||||||
|
(explain! (pp-to-string ex))))))))
|
||||||
|
(t
|
||||||
|
(error! "Nope!")))
|
||||||
|
|
||||||
|
|
||||||
;; git
|
;; git
|
||||||
(check! (not (executable-find "git"))
|
(check! (not (executable-find "git"))
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue