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

* 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.
parent 682578fc
......@@ -298,9 +298,15 @@ See also: `nsm-tls-checks' and `nsm-noninteractive'"
"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
(map-values results)
"\n* ")))))
(delete-process process)
(setq process nil)))
(run-hook-with-args 'nsm-tls-post-check-functions
......@@ -805,6 +811,8 @@ protocol."
'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."
(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))
(setq answer (read-multiple-choice "Viewing certificate:" details-choices))
((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
"Continue connecting?"
((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)
(setq cert-index (mod (1+ cert-index) (length pems)))
(insert (nth cert-index pems))
(goto-char (point-min))
((char-equal (car answer) ?p)
(with-current-buffer cert-buffer
(read-only-mode -1)
(setq cert-index (mod (1- cert-index) (length pems)))
(insert (nth cert-index pems))
(goto-char (point-min))
(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
"Certificate information\n"
"Issued by:"
(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))
" 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)
"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))
"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)
"Security level:"
" Security level:"
(propertize (plist-get cert :certificate-security-level)
'face 'bold)
"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)) ? )))
(defun nsm-certificate-part (string part &optional full)
......@@ -152,6 +152,8 @@ DEF_DLL_FN (int, gnutls_x509_crt_check_hostname,
DEF_DLL_FN (int, gnutls_x509_crt_check_issuer,
(gnutls_x509_crt_t, gnutls_x509_crt_t));
DEF_DLL_FN (void, gnutls_x509_crt_deinit, (gnutls_x509_crt_t));
DEF_DLL_DN (int, gnutls_x509_crt_export,
(gnutls_x509_crt_t, gnutls_x509_crt_fmt_t, void *, size_t *));
DEF_DLL_FN (int, gnutls_x509_crt_import,
(gnutls_x509_crt_t, const gnutls_datum_t *,
......@@ -173,6 +175,9 @@ DEF_DLL_FN (int, gnutls_x509_crt_get_dn,
(gnutls_x509_crt_t, char *, size_t *));
DEF_DLL_FN (int, gnutls_x509_crt_get_pk_algorithm,
(gnutls_x509_crt_t, unsigned int *));
DEF_DLL_FN (int, gnutls_x509_crt_print,
(gnutls_x509_crt_t, gnutls_certificate_print_formats_t,
gnutls_datum_t *));
DEF_DLL_FN (const char *, gnutls_pk_algorithm_get_name,
DEF_DLL_FN (int, gnutls_pk_bits_to_sec_param,
......@@ -317,6 +322,7 @@ init_gnutls_functions (void)
LOAD_DLL_FN (library, gnutls_x509_crt_check_hostname);
LOAD_DLL_FN (library, gnutls_x509_crt_check_issuer);
LOAD_DLL_FN (library, gnutls_x509_crt_deinit);
LOAD_DLL_FN (library, gnutls_x509_crt_export);
LOAD_DLL_FN (library, gnutls_x509_crt_import);
LOAD_DLL_FN (library, gnutls_x509_crt_init);
LOAD_DLL_FN (library, gnutls_x509_crt_get_fingerprint);
......@@ -327,6 +333,7 @@ init_gnutls_functions (void)
LOAD_DLL_FN (library, gnutls_x509_crt_get_expiration_time);
LOAD_DLL_FN (library, gnutls_x509_crt_get_dn);
LOAD_DLL_FN (library, gnutls_x509_crt_get_pk_algorithm);
LOAD_DLL_FN (library, gnutls_x509_crt_print)
LOAD_DLL_FN (library, gnutls_pk_algorithm_get_name);
LOAD_DLL_FN (library, gnutls_pk_bits_to_sec_param);
LOAD_DLL_FN (library, gnutls_x509_crt_get_issuer_unique_id);
......@@ -455,6 +462,7 @@ init_gnutls_functions (void)
# define gnutls_x509_crt_check_hostname fn_gnutls_x509_crt_check_hostname
# define gnutls_x509_crt_check_issuer fn_gnutls_x509_crt_check_issuer
# define gnutls_x509_crt_deinit fn_gnutls_x509_crt_deinit
# define gnutls_x509_crt_export fn_gnutls_x509_crt_export
# define gnutls_x509_crt_get_activation_time fn_gnutls_x509_crt_get_activation_time
# define gnutls_x509_crt_get_dn fn_gnutls_x509_crt_get_dn
# define gnutls_x509_crt_get_expiration_time fn_gnutls_x509_crt_get_expiration_time
......@@ -463,6 +471,7 @@ init_gnutls_functions (void)
# define gnutls_x509_crt_get_issuer_unique_id fn_gnutls_x509_crt_get_issuer_unique_id
# define gnutls_x509_crt_get_key_id fn_gnutls_x509_crt_get_key_id
# define gnutls_x509_crt_get_pk_algorithm fn_gnutls_x509_crt_get_pk_algorithm
# define gnutls_x509_crt_print fn_gnutls_x509_crt_print
# define gnutls_x509_crt_get_serial fn_gnutls_x509_crt_get_serial
# define gnutls_x509_crt_get_signature_algorithm fn_gnutls_x509_crt_get_signature_algorithm
# define gnutls_x509_crt_get_subject_unique_id fn_gnutls_x509_crt_get_subject_unique_id
......@@ -1024,7 +1033,34 @@ gnutls_hex_string (unsigned char *buf, ptrdiff_t buf_size, const char *prefix)
static Lisp_Object
gnutls_certificate_details (gnutls_x509_crt_t cert)
emacs_gnutls_certificate_export_pem (gnutls_x509_crt_t cert)
size_t size = 0;
int err = gnutls_x509_crt_export (cert, GNUTLS_X509_FMT_PEM, NULL, &size);
check_memory_full (err);
unsigned char *buf = xmalloc(size * sizeof (unsigned char));
err = gnutls_x509_crt_export (cert, GNUTLS_X509_FMT_PEM, buf, &size);
check_memory_full (err);
xfree (buf);
error ("GnuTLS certificate export error: %s", emacs_gnutls_strerror (err));
return build_string(buf);
else if (err < GNUTLS_E_SUCCESS)
error ("GnuTLS certificate export error: %s", emacs_gnutls_strerror (err));
return Qnil;
static Lisp_Object
emacs_gnutls_certificate_details (gnutls_x509_crt_t cert)
Lisp_Object res = Qnil;
int err;
......@@ -1192,6 +1228,10 @@ gnutls_certificate_details (gnutls_x509_crt_t cert)
xfree (buf);
/* PEM */
res = nconc2 (res, list2 (intern (":pem"),
return res;
......@@ -1354,7 +1394,7 @@ returned as the :certificate entry. */)
/* Return all the certificates in a list. */
for (int i = 0; i < XPROCESS (proc)->gnutls_certificates_length; i++)
certs = nconc2 (certs, list1 (gnutls_certificate_details
certs = nconc2 (certs, list1 (emacs_gnutls_certificate_details
(XPROCESS (proc)->gnutls_certificates[i])));
result = nconc2 (result, list2 (intern (":certificates"), certs));
......@@ -1480,6 +1520,55 @@ boot_error (struct Lisp_Process *p, const char *m, ...)
va_end (ap);
DEFUN ("gnutls-format-certificate", Fgnutls_format_certificate, Sgnutls_format_certificate, 1, 1, 0,
doc: /* Format a X.509 certificate to a string.
Given a PEM-encoded X.509 certificate CERT, returns a human-readable
string representation. */)
(Lisp_Object cert)
int err;
gnutls_x509_crt_t crt;
err = gnutls_x509_crt_init (&crt);
check_memory_full (err);
error ("gnutls-format-certificate error: %s", emacs_gnutls_strerror (err));
unsigned char *crt_buf = SDATA (cert);
gnutls_datum_t crt_data = { crt_buf, strlen (crt_buf) };
err = gnutls_x509_crt_import (crt, &crt_data, GNUTLS_X509_FMT_PEM);
check_memory_full (err);
gnutls_x509_crt_deinit (crt);
error ("gnutls-format-certificate error: %s", emacs_gnutls_strerror (err));
gnutls_datum_t out;
err = gnutls_x509_crt_print (crt, GNUTLS_CRT_PRINT_FULL, &out);
check_memory_full (err);
gnutls_x509_crt_deinit (crt);
error ("gnutls-format-certificate error: %s", emacs_gnutls_strerror (err));
char *out_buf = xmalloc ((out.size + 1) * sizeof (char));
memset (out_buf, 0, (out.size + 1) * sizeof (char));
memcpy (out_buf, out.data, out.size);
xfree (out.data);
gnutls_x509_crt_deinit (crt);
Lisp_Object result = build_string (out_buf);
xfree (out_buf);
return result;
gnutls_verify_boot (Lisp_Object proc, Lisp_Object proplist)
......@@ -2713,6 +2802,7 @@ syms_of_gnutls (void)
defsubr (&Sgnutls_bye);
defsubr (&Sgnutls_peer_status);
defsubr (&Sgnutls_peer_status_warning_describe);
defsubr (&Sgnutls_format_certificate);
defsubr (&Sgnutls_ciphers);
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