awesome-emacs/doomemacs
1
0
Fork 0
mirror of https://github.com/doomemacs/doomemacs synced 2025-08-01 12:17:25 -05:00
Code Issues Packages Projects Releases Wiki Activity

bin/doctor: add timeout for TLS test

Browse Source
This commit is contained in:
Henrik Lissner
2017-05-25 17:10:49 +02:00
parent 85751c519b
commit 9d1af37dee
1 changed files with 24 additions and 7 deletions
Download Patch File Download Diff File Expand all files Collapse all files

31
bin/doctor
View File

@ -56,6 +56,17 @@
"\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))
@ -143,9 +154,12 @@
(let (result) (let (result)
(let ((inhibit-message t)) (let ((inhibit-message t))
(url-retrieve url (lambda (status &rest _) (setq result status)))) (url-retrieve url (lambda (status &rest _) (setq result status))))
(while (not result) (sleep-for 1)) (wait-for! result
(when (getenv "DEBUG") (when (getenv "DEBUG")
(success! "Verified %s" (nth 2 (split-string url "/"))))) (success! "Verified %s" (nth 2 (split-string url "/"))))
(signal 'timed-out url)))
('timed-out
(error! "Timed out trying to contact %s" ex))
('error ('error
(check! t (check! t
(error! "Rejected %s" url) (error! "Rejected %s" url)
@ -156,10 +170,13 @@
(let (result) (let (result)
(let ((inhibit-message t)) (let ((inhibit-message t))
(url-retrieve url (lambda (status &rest _) (setq result status)))) (url-retrieve url (lambda (status &rest _) (setq result status))))
(while (not result) (sleep-for 1)) (wait-for! result
(check! t (check! t
(warn! "Verified %s (this shouldn't happen!)" (nth 2 (split-string url "/"))) (warn! "Verified %s (this shouldn't happen!)" (nth 2 (split-string url "/")))
(explain! (pp-to-string result)))) (explain! (pp-to-string result)))
(signal 'timed-out url)))
('timed-out
(error! "Timed out trying to contact %s" ex))
('error ('error
(when (getenv "DEBUG") (when (getenv "DEBUG")
(success! "Rejected %s (a good thing!)" url) (success! "Rejected %s (a good thing!)" url)