(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
(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*"))
(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")
(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)
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));
(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,
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);
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);
# 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
# 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
}
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;
xfree (buf);
}
+ /* PEM */
+ res = nconc2 (res, list2 (intern (":pem"),
+ emacs_gnutls_certificate_export_pem(cert)));
+
return res;
}
/* 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));
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)
{
defsubr (&Sgnutls_bye);
defsubr (&Sgnutls_peer_status);
defsubr (&Sgnutls_peer_status_warning_describe);
+ defsubr (&Sgnutls_format_certificate);
#ifdef HAVE_GNUTLS3
defsubr (&Sgnutls_ciphers);
projects / emacs.git / commitdiff