From: Jimmy Yuen Ho Wong Date: Tue, 10 Jul 2018 17:38:11 +0000 (+0100) Subject: Full certificate chain details for NSM X-Git-Tag: emacs-27.0.90~1328^2~123^2~9 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=87484dc27ec7a6e708c7e0ceaf96bff1ee064174;p=emacs.git 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. --- 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) diff --git a/src/gnutls.c b/src/gnutls.c index 448f6732e6b..117278df35b 100644 --- a/src/gnutls.c +++ b/src/gnutls.c @@ -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 *, gnutls_x509_crt_fmt_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, (gnutls_pk_algorithm_t)); 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); + + if (err == GNUTLS_E_SHORT_MEMORY_BUFFER) + { + unsigned char *buf = xmalloc(size * sizeof (unsigned char)); + err = gnutls_x509_crt_export (cert, GNUTLS_X509_FMT_PEM, buf, &size); + check_memory_full (err); + + if (err < GNUTLS_E_SUCCESS) + { + 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"), + emacs_gnutls_certificate_export_pem(cert))); + 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) +{ + CHECK_STRING (cert); + + int err; + gnutls_x509_crt_t crt; + + err = gnutls_x509_crt_init (&crt); + check_memory_full (err); + if (err < GNUTLS_E_SUCCESS) + 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); + if (err < GNUTLS_E_SUCCESS) + { + 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); + if (err < GNUTLS_E_SUCCESS) + { + 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; +} + Lisp_Object 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); #ifdef HAVE_GNUTLS3 defsubr (&Sgnutls_ciphers);