Commit 29d485fb authored by Lars Ingebrigtsen's avatar Lars Ingebrigtsen

Tweak the warning display to be less like a TLS decoding page

* lisp/net/nsm.el (nsm-parse-subject, nsm-certificate-part):
Restore functions for parsing subjects.
(nsm-format-certificate): Use them to display more user-friendly
data.  Also change the display to have fewer lines again so that
the data of interest isn't pushed off the screen.
parent bc1cf28d
Pipeline #2938 failed with stage
in 28 minutes and 10 seconds
...@@ -28,6 +28,7 @@ ...@@ -28,6 +28,7 @@
(require 'rmc) ; read-multiple-choice (require 'rmc) ; read-multiple-choice
(require 'subr-x) (require 'subr-x)
(require 'seq) (require 'seq)
(require 'map)
(defvar nsm-permanent-host-settings nil) (defvar nsm-permanent-host-settings nil)
(defvar nsm-temporary-host-settings nil) (defvar nsm-temporary-host-settings nil)
...@@ -293,7 +294,7 @@ See also: `nsm-tls-checks' and `nsm-noninteractive'" ...@@ -293,7 +294,7 @@ See also: `nsm-tls-checks' and `nsm-noninteractive'"
'conditions 'conditions
problems problems
(format-message (format-message
"The TLS connection to %s:%s is insecure for the following reason%s:\n\n%s" "The TLS connection to %s:%s is insecure\nfor the following reason%s:\n\n%s"
host port host port
(if (> (length problems) 1) (if (> (length problems) 1)
"s" "") "s" "")
...@@ -835,10 +836,12 @@ protocol." ...@@ -835,10 +836,12 @@ protocol."
(?n "next" "Next certificate") (?n "next" "Next certificate")
(?p "previous" "Previous certificate") (?p "previous" "Previous certificate")
(?q "quit" "Quit details view"))) (?q "quit" "Quit details view")))
(answer (read-multiple-choice "Continue connecting?" accept-choices)) (answer (read-multiple-choice "Continue connecting?"
(show-details (char-equal (car answer) ?d)) (show-details (char-equal (car answer) ?d))
(pems (cl-loop for cert in certs (pems (cl-loop for cert in certs
collect (gnutls-format-certificate (plist-get cert :pem)))) collect (gnutls-format-certificate
(plist-get cert :pem))))
(cert-index 0)) (cert-index 0))
(while show-details (while show-details
(unless (get-buffer-window cert-buffer) (unless (get-buffer-window cert-buffer)
...@@ -999,13 +1002,27 @@ protocol." ...@@ -999,13 +1002,27 @@ protocol."
(insert (insert
(propertize "Certificate information" 'face 'underline) "\n" (propertize "Certificate information" 'face 'underline) "\n"
" Issued by:" " Issued by:"
(plist-get cert :issuer) "\n" (nsm-certificate-part (plist-get cert :issuer) "CN" t) "\n"
" Issued to:" " Issued to:"
(plist-get cert :subject) "\n") (or (nsm-certificate-part (plist-get cert :subject) "O")
(nsm-certificate-part (plist-get cert :subject) "OU" t))
" Hostname:"
(nsm-certificate-part (plist-get cert :subject) "CN" t) "\n")
(when (and (plist-get cert :public-key-algorithm) (when (and (plist-get cert :public-key-algorithm)
(plist-get cert :signature-algorithm)) (plist-get cert :signature-algorithm))
(insert " Public key:" (plist-get cert :public-key-algorithm) "\n") (insert
(insert " Signature:" (plist-get cert :signature-algorithm) "\n")) " Public key:" (plist-get cert :public-key-algorithm)
", signature: " (plist-get cert :signature-algorithm) "\n"))
(when (and (plist-get status :key-exchange)
(plist-get status :cipher)
(plist-get status :mac)
(plist-get status :protocol))
" Session:" (plist-get status :protocol)
", key: " (plist-get status :key-exchange)
", cipher: " (plist-get status :cipher)
", mac: " (plist-get status :mac) "\n"))
(when (plist-get cert :certificate-security-level) (when (plist-get cert :certificate-security-level)
(insert (insert
" Security level:" " Security level:"
...@@ -1015,16 +1032,7 @@ protocol." ...@@ -1015,16 +1032,7 @@ protocol."
(insert (insert
" Valid:From " (plist-get cert :valid-from) " Valid:From " (plist-get cert :valid-from)
" to " (plist-get cert :valid-to) "\n") " to " (plist-get cert :valid-to) "\n")
;; Handshake parameters (insert "\n")
(insert (propertize "Session information" 'face 'underline) "\n")
(insert " Version:" (plist-get status :protocol) "\n")
(insert " Safe renegotiation:" (if (plist-get status :safe-renegotiation) "Yes" "No") "\n")
(insert " Compression:" (plist-get status :compression) "\n")
(insert " Encrypt-then-MAC:" (if (plist-get status :encrypt-then-mac) "Yes" "No") "\n")
(insert " Cipher suite:" (nsm-cipher-suite status) "\n")
(if (string-match "^\\bDHE\\b" (plist-get status :key-exchange))
(insert " DH prime bits:" (format "%d" (plist-get status :diffie-hellman-prime-bits)) "\n")
(insert "\n"))
(goto-char (point-min)) (goto-char (point-min))
(while (re-search-forward "^[^:]+:" nil t) (while (re-search-forward "^[^:]+:" nil t)
(insert (make-string (- 22 (current-column)) ? ))) (insert (make-string (- 22 (current-column)) ? )))
...@@ -1043,6 +1051,37 @@ protocol." ...@@ -1043,6 +1051,37 @@ protocol."
(plist-get status :cipher) (plist-get status :cipher)
(plist-get status :mac))) (plist-get status :mac)))
(defun nsm-certificate-part (string part &optional full)
(let ((part (cadr (assoc part (nsm-parse-subject string)))))
(part part)
(full string)
(t nil))))
(defun nsm-parse-subject (string)
(insert string)
(goto-char (point-min))
(let ((start (point))
(result nil))
(while (not (eobp))
(push (replace-regexp-in-string
"[\\]\\(.\\)" "\\1"
(buffer-substring start
(if (re-search-forward "[^\\]," nil 'move)
(1- (point))
(setq start (point)))
(lambda (elem)
(let ((pos (cl-position ?= elem)))
(if pos
(list (substring elem 0 pos)
(substring elem (1+ pos)))
(nreverse result)))))
(define-obsolete-function-alias 'nsm--encryption #'nsm-cipher-suite "27.1") (define-obsolete-function-alias 'nsm--encryption #'nsm-cipher-suite "27.1")
(provide 'nsm) (provide 'nsm)
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment