Full certificate chain details for NSM

* lisp/net/nsm.el (nsm-check-tls-connection): Fix issue with plural
  problems in message.  Prefix every problem with a bullet.
  (nsm-query-user): Add new view the full certificate chain by
  pressing d.
  (nsm-format-certificate): Improve basic certificate and session info
  formatting.

* src/gnutls.c (emacs_gnutls_certificate_export_pem): New function.
  (gnutls_certificate_details): Rename to
  emacs_gnutls_certificate_details.  Add :pem to result list.
  (Fgnutls_format_certificate):  New function for formatting a PEM to
  human-readable text.

1 files changed, 95 insertions, 34 deletions

diff --git a/lisp/net/nsm.el b/lisp/net/nsm.el
index e4c52bc9c1c..a1798a89956 100644
--- a/lisp/net/nsm.el
+++ b/lisp/net/nsm.el
@@ -298,9 +298,15 @@ See also: `nsm-tls-checks' and `nsm-noninteractive'"
                                  (format-message
 		                  "The TLS connection to %s:%s is insecure for the following reason%s:\n\n%s"
 		                  host port
-		                  (if (> (length results) 1)
+		                  (if (> (length problems) 1)
 			              "s" "")
-		                  (string-join (map-values results) "\n"))))
+		                  (concat "* " (string-join
+                                                (split-string
+                                                 (string-join
+                                                  (map-values results)
+                                                  "\n")
+                                                 "\n")
+                                                "\n* ")))))
                  (delete-process process)
                  (setq process nil)))
       (run-hook-with-args 'nsm-tls-post-check-functions
@@ -805,6 +811,8 @@ protocol."
 (set-advertised-calling-convention
  'nsm-query '(host port status what problems message) "27.1")
 
+(declare-function gnutls-format-certificate "gnutls.c" (cert))
+
 (defun nsm-query-user (message status)
   (let ((buffer (get-buffer-create "*Network Security Manager*"))
         (cert-buffer (get-buffer-create "*Certificate Details*"))
@@ -823,9 +831,69 @@ protocol."
       (unwind-protect
           (let* ((accept-choices '((?a "always" "Accept this certificate this session and for all future sessions.")
                                    (?s "session only" "Accept this certificate this session only.")
-                                   (?n "no" "Refuse to use this certificate, and close the connection.")))
-                 (answer (read-multiple-choice "Continue connecting?" accept-choices)))
+                                   (?n "no" "Refuse to use this certificate, and close the connection.")
+                                   (?d "details" "See certificate details")))
+                 (details-choices '((?b "backward page" "See previous page")
+                                    (?f "forward page" "See next page")
+                                    (?n "next" "Next certificate")
+                                    (?p "previous" "Previous certificate")
+                                    (?q "quit" "Quit details view")))
+                 (answer (read-multiple-choice "Continue connecting?" accept-choices))
+                 (show-details (char-equal (car answer) ?d))
+                 (pems (cl-loop for cert in certs
+                                collect (gnutls-format-certificate (plist-get cert :pem))))
+                 (cert-index 0))
+            (while show-details
+              (unless (get-buffer-window cert-buffer)
+                (set-window-buffer (get-buffer-window buffer) cert-buffer)
+                (with-current-buffer cert-buffer
+                  (read-only-mode -1)
+                  (insert (nth cert-index pems))
+                  (goto-char (point-min))
+                  (read-only-mode)))
+
+              (setq answer (read-multiple-choice "Viewing certificate:" details-choices))
+
+              (cond
+               ((char-equal (car answer) ?q)
+                (setq show-details (not show-details))
+                (set-window-buffer (get-buffer-window cert-buffer) buffer)
+                (setq show-details (char-equal
+                                    (car (setq answer
+                                               (read-multiple-choice
+                                                "Continue connecting?"
+                                                accept-choices)))
+                                    ?d)))
+
+               ((char-equal (car answer) ?b)
+                (with-selected-window (get-buffer-window cert-buffer)
+                  (with-current-buffer cert-buffer
+                    (ignore-errors (scroll-down)))))
+
+               ((char-equal (car answer) ?f)
+                (with-selected-window (get-buffer-window cert-buffer)
+                  (with-current-buffer cert-buffer
+                    (ignore-errors (scroll-up)))))
+
+               ((char-equal (car answer) ?n)
+                (with-current-buffer cert-buffer
+                  (read-only-mode -1)
+                  (erase-buffer)
+                  (setq cert-index (mod (1+ cert-index) (length pems)))
+                  (insert (nth cert-index pems))
+                  (goto-char (point-min))
+                  (read-only-mode)))
+
+               ((char-equal (car answer) ?p)
+                (with-current-buffer cert-buffer
+                  (read-only-mode -1)
+                  (erase-buffer)
+                  (setq cert-index (mod (1- cert-index) (length pems)))
+                  (insert (nth cert-index pems))
+                  (goto-char (point-min))
+                  (read-only-mode)))))
             (cadr answer))
+        (kill-buffer cert-buffer)
         (kill-buffer buffer)))))
 
 (set-advertised-calling-convention 'nsm-query-user '(message status) "27.1")
@@ -931,49 +999,42 @@ protocol."
   (let ((cert (plist-get status :certificate)))
     (when cert
       (with-temp-buffer
-	(insert
-	 "Certificate information\n"
-	 "Issued by:"
+        (insert
+	 (propertize "Certificate information" 'face 'underline) "\n"
+	 "  Issued by:"
 	 (nsm-certificate-part (plist-get cert :issuer) "CN" t) "\n"
-	 "Issued to:"
+	 "  Issued to:"
 	 (or (nsm-certificate-part (plist-get cert :subject) "O")
 	     (nsm-certificate-part (plist-get cert :subject) "OU" t))
 	 "\n"
-	 "Hostname:"
+	 "  Hostname:"
 	 (nsm-certificate-part (plist-get cert :subject) "CN" t) "\n")
 	(when (and (plist-get cert :public-key-algorithm)
 		   (plist-get cert :signature-algorithm))
+	  (insert "  Public key:" (plist-get cert :public-key-algorithm) "\n")
+          (insert "  Signature:" (plist-get cert :signature-algorithm) "\n"))
+        (when (plist-get cert :certificate-security-level)
 	  (insert
-	   "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)
-                   (plist-get status :compression))
-	  (insert
-	   "Protocol:" (plist-get status :protocol)
-           ", safe renegotiation: " (if (plist-get status :safe-renegotiation) "YES" "NO")
-	   ", compression: " (plist-get status :compression)
-	   ", encrypt-then-MAC: " (if (plist-get status :encrypt-then-mac) "YES" "NO")
-	   ", key: " (plist-get status :key-exchange)
-           (if (string-match "^\\bDHE\\b" (plist-get status :key-exchange))
-               (concat ", prime bits: " (format "%s" (plist-get status :diffie-hellman-prime-bits)))
-             "")
-	   ", cipher: " (plist-get status :cipher)
-	   ", mac: " (plist-get status :mac) "\n"))
-	(when (plist-get cert :certificate-security-level)
-	  (insert
-	   "Security level:"
+	   "  Security level:"
 	   (propertize (plist-get cert :certificate-security-level)
 		       'face 'bold)
 	   "\n"))
 	(insert
-	 "Valid:From " (plist-get cert :valid-from)
-	 " to " (plist-get cert :valid-to) "\n\n")
-	(goto-char (point-min))
+	 "  Valid:From " (plist-get cert :valid-from)
+	 " to " (plist-get cert :valid-to) "\n")
+        ;; Handshake parameters
+        (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))
 	(while (re-search-forward "^[^:]+:" nil t)
-	  (insert (make-string (- 20 (current-column)) ? )))
+	  (insert (make-string (- 22 (current-column)) ? )))
 	(buffer-string)))))
 
 (defun nsm-certificate-part (string part &optional full)