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

bin/doctor: add SSL/TLS tests

Browse source
This commit is contained in:
Henrik Lissner 2017-05-23 22:54:02 +02:00
parent f2c2550549
commit af286043a4
1 changed files with 65 additions and 30 deletions
Download patch file Download diff file Expand all files Collapse all files

95
bin/doctor
View file

@ -98,40 +98,75 @@
;; --- 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)
(mapcar (lambda (row) (mapcar (lambda (row)
(add-to-list 'protos (cadr (split-string row " " t)))) (add-to-list 'protos (cadr (split-string row " " t))))
(split-string (shell-command-to-string "openssl ciphers -v") "\n")) (split-string (shell-command-to-string "openssl ciphers -v") "\n"))
(delq nil protos)))) (delq nil protos))))
(check! (not (or (member "TLSv1.1" protocols) (check! (not (or (member "TLSv1.1" protocols)
(member "TLSv1.2" protocols))) (member "TLSv1.2" protocols)))
(let ((version (cadr (split-string (shell-command-to-string "openssl version") " " t)))) (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) (warn! "Warning: couldn't find gnutls-cli, and OpenSSL is out-of-date (v%s)" version)
(explain! (explain!
"This may not affect your Emacs experience, but there are security " "This may not affect your Emacs experience, but there are security "
"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 "
"reason you can't, you can bypass this verification with the INSECURE flag:\n\n" "reason you can't, you can bypass this verification with the INSECURE flag:\n\n"
" INSECURE=1 make install\n\n" " INSECURE=1 make install\n\n"
"Or change `package-archives' to use non-https sources.\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 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!")))
"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!")))))
;; git ;; git
(check! (not (executable-find "git")) (check! (not (executable-find "git"))