Merge remote-tracking branch 'origin/netsec'

1 files changed, 827 insertions, 303 deletions

diff --git a/lisp/net/nsm.el b/lisp/net/nsm.el
index dbfa2101f0c..da1fbf930a1 100644
--- a/lisp/net/nsm.el
+++ b/lisp/net/nsm.el
@@ -26,7 +26,9 @@
 
 (require 'cl-lib)
 (require 'rmc)                       ; read-multiple-choice
-(eval-when-compile (require 'subr-x))
+(require 'subr-x)
+(require 'seq)
+(require 'map)
 
 (defvar nsm-permanent-host-settings nil)
 (defvar nsm-temporary-host-settings nil)
@@ -44,20 +46,42 @@ connection should be handled.
 
 The following values are possible:
 
-`low': Absolutely no checks are performed.
-`medium': This is the default level, should be reasonable for most usage.
-`high': This warns about additional things that many people would
-not find useful.
-`paranoid': On this level, the user is queried for most new connections.
+`low': Check for problems known before Edward Snowden.
+`medium': Default.  Suitable for most circumstances.
+`high': Warns about additional issues not enabled in `medium' due to
+compatibility concerns.
 
 See the Emacs manual for a description of all things that are
 checked and warned against."
   :version "25.1"
   :group 'nsm
   :type '(choice (const :tag "Low" low)
-		 (const :tag "Medium" medium)
-		 (const :tag "High" high)
-		 (const :tag "Paranoid" paranoid)))
+                 (const :tag "Medium" medium)
+                 (const :tag "High" high)))
+
+;; Backward compatibility
+(when (eq network-security-level 'paranoid)
+  (setq network-security-level 'high))
+
+(defcustom nsm-trust-local-network nil
+  "Disable warnings when visiting trusted hosts on local networks.
+
+The default suite of TLS checks in NSM is designed to follow the
+most current security best practices.  Under some situations,
+such as attempting to connect to an email server that do not
+follow these practices inside a school or corporate network, NSM
+may produce warnings for such occasions.  Setting this option to
+a non-nil value, or a zero-argument function that returns non-nil
+tells NSM to skip checking for potential TLS vulnerabilities when
+connecting to hosts on a local network.
+
+Make sure you know what you are doing before enabling this
+option."
+  :version "27.1"
+  :group 'nsm
+  :type '(choice (const :tag "On" t)
+                 (const :tag "Off" nil)
+                 (function :tag "Custom function")))
 
 (defcustom nsm-settings-file (expand-file-name "network-security.data"
 						 user-emacs-directory)
@@ -98,241 +122,666 @@ to keep track of the TLS status of STARTTLS servers.
 
 If WARN-UNENCRYPTED, query the user if the connection is
 unencrypted."
-  (if (eq network-security-level 'low)
-      process
-    (let* ((status (gnutls-peer-status process))
-	   (id (nsm-id host port))
-	   (settings (nsm-host-settings id)))
-      (cond
-       ((not (process-live-p process))
-	nil)
-       ((not status)
-	;; This is a non-TLS connection.
-	(nsm-check-plain-connection process host port settings
-				    warn-unencrypted))
-       (t
-	(let ((process
-	       (nsm-check-tls-connection process host port status settings)))
-	  (when (and process save-fingerprint
-		     (null (nsm-host-settings id)))
-	    (nsm-save-host host port status 'fingerprint 'always))
-	  process))))))
+  (let* ((status (gnutls-peer-status process))
+         (id (nsm-id host port))
+         (settings (nsm-host-settings id)))
+    (cond
+     ((not (process-live-p process))
+      nil)
+     ((not status)
+      ;; This is a non-TLS connection.
+      (nsm-check-plain-connection process host port settings
+                                  warn-unencrypted))
+     (t
+      (let ((process
+             (nsm-check-tls-connection process host port status settings)))
+        (when (and process save-fingerprint
+                   (null (nsm-host-settings id)))
+          (nsm-save-host host port status 'fingerprint nil 'always))
+        process)))))
+
+(defcustom nsm-tls-checks
+  '(;; Pre-Snowden Known Weaknesses
+    (nsm-tls-check-version                . low)
+    (nsm-tls-check-compression            . low)
+    (nsm-tls-check-renegotiation-info-ext . low)
+    (nsm-tls-check-verify-cert            . low)
+    (nsm-tls-check-same-cert              . low)
+    (nsm-tls-check-null-suite             . low)
+    (nsm-tls-check-export-kx              . low)
+    (nsm-tls-check-anon-kx                . low)
+    (nsm-tls-check-md5-sig                . low)
+    (nsm-tls-check-rc4-cipher             . low)
+    ;; Post-Snowden Apocalypse
+    (nsm-tls-check-dhe-prime-kx           . medium)
+    (nsm-tls-check-sha1-sig               . medium)
+    (nsm-tls-check-ecdsa-cbc-cipher       . medium)
+    ;; Towards TLS 1.3
+    (nsm-tls-check-dhe-kx                 . high)
+    (nsm-tls-check-rsa-kx                 . high)
+    (nsm-tls-check-3des-cipher            . high)
+    (nsm-tls-check-cbc-cipher             . high))
+  "This variable specifies what TLS connection checks to perform.
+It's an alist where the key is the name of the check, and the
+value is the minimum security level the check should begin.
+
+Each check function is called with the parameters HOST PORT
+STATUS SETTINGS.  HOST is the host domain, PORT is a TCP port
+number, STATUS is the peer status returned by
+`gnutls-peer-status', and SETTINGS is the persistent and session
+settings for the host HOST.  Please refer to the contents of
+`nsm-setting-file' for details.  If a problem is found, the check
+function is required to return an error message, and nil
+otherwise.
+
+See also: `nsm-check-tls-connection', `nsm-save-host-names',
+`nsm-settings-file'"
+  :version "27.1"
+  :group 'nsm
+  :type '(repeat (cons (function :tag "Check function")
+                       (choice :tag "Level"
+                               :value medium
+                               (const :tag "Low" low)
+                               (const :tag "Medium" medium)
+                               (const :tag "High" high)))))
+
+(defun nsm-save-fingerprint-maybe (host port status &rest _)
+  "Saves the certificate's fingerprint.
+
+In order to detect man-in-the-middle attacks, when
+`network-security-level' is `high', this function will save the
+fingerprint of the certificate for check functions to check."
+  (when (>= (nsm-level network-security-level) (nsm-level 'high))
+    ;; Save the host fingerprint so that we can check it the
+    ;; next time we connect.
+    (nsm-save-host host port status 'fingerprint nil 'always)))
+
+(defvar nsm-tls-post-check-functions '(nsm-save-fingerprint-maybe)
+  "Functions to run after checking a TLS session.
+
+Each function will be run with the parameters HOST PORT STATUS
+SETTINGS and RESULTS.  The parameters HOST PORT STATUS and
+SETTINGS are the same as those supplied to each check function.
+RESULTS is an alist where the keys are the checks run and the
+values the results of the checks.")
+
+(defun nsm-network-same-subnet (local-ip mask ip)
+  "Returns t if IP is in the same subnet as LOCAL-IP/MASK.
+LOCAL-IP, MASK, and IP are specified as vectors of integers, and
+are expected to have the same length.  Works for both IPv4 and
+IPv6 addresses."
+  (let ((matches t)
+        (length (length local-ip)))
+    (unless (memq length '(4 5 8 9))
+      (error "Unexpected length of IP address %S" local-ip))
+    (dotimes (i length)
+      (setq matches (and matches
+                         (=
+                          (logand (aref local-ip i)
+                                  (aref mask i))
+                          (logand (aref ip i)
+                                  (aref mask i))))))
+    matches))
+
+(defun nsm-should-check (host)
+  "Determines whether NSM should check for TLS problems for HOST.
+
+If `nsm-trust-local-network' is or returns non-nil, and if the
+host address is a localhost address, or in the same subnet as one
+of the local interfaces, this function returns nil.  Non-nil
+otherwise."
+  (let ((addresses (network-lookup-address-info host))
+        (network-interface-list (network-interface-list))
+        (off-net t))
+    (when
+     (or (and (functionp nsm-trust-local-network)
+              (funcall nsm-trust-local-network))
+         nsm-trust-local-network)
+     (mapc
+      (lambda (address)
+        (mapc
+         (lambda (iface)
+           (let ((info (network-interface-info (car iface))))
+             (when
+                 (nsm-network-same-subnet (substring (car info) 0 -1)
+                                          (substring (car (cddr info)) 0 -1)
+                                          address)
+               (setq off-net nil))))
+         network-interface-list))
+      addresses))
+     off-net))
 
 (defun nsm-check-tls-connection (process host port status settings)
-  (when-let ((process
-              (nsm-check-certificate process host port status settings)))
-    ;; Do further protocol-level checks.
-    (nsm-check-protocol process host port status settings)))
+  "Check TLS connection against potential security problems.
+
+This function runs each test defined in `nsm-tls-checks' in the
+order specified against the TLS connection's peer status STATUS
+for the host HOST and port PORT.
+
+If one or more problems are found, this function will collect all
+the error messages returned by the check functions, and confirm
+with the user in interactive mode whether to continue with the
+TLS session.
+
+If the user declines to continue, or problem(s) are found under
+non-interactive mode, the process PROCESS will be deleted, thus
+terminating the connection.
+
+This function returns the process PROCESS if no problems are
+found, and nil otherwise.
+
+See also: `nsm-tls-checks' and `nsm-noninteractive'"
+  (when (nsm-should-check host)
+    (let* ((results
+            (cl-loop for check in nsm-tls-checks
+                     for type = (intern (format ":%s"
+                                                (string-remove-prefix
+                                                 "nsm-tls-check-"
+                                                 (symbol-name (car check))))
+                                        obarray)
+                     ;; Skip the check if the user has already said that this
+                     ;; host is OK for this type of "error".
+                     for result = (and (not (memq type (plist-get settings :conditions)))
+                                       (>= (nsm-level network-security-level)
+                                           (nsm-level (cdr check)))
+                                       (funcall (car check) host port status settings))
+                     when result
+                     collect (cons type result)))
+           (problems (nconc (plist-get status :warnings) (map-keys results))))
+      (when (and results
+                 (not (seq-set-equal-p (plist-get settings :conditions) problems))
+                 (not (nsm-query host port status
+                                 'conditions
+                                 problems
+                                 (format-message
+		                  "The TLS connection to %s:%s is insecure\nfor the following reason%s:\n\n%s"
+		                  host port
+		                  (if (> (length problems) 1)
+			              "s" "")
+		                  (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
+                          host port status settings results)))
+  process)
+
+
+
+;; Certificate checks
 
 (declare-function gnutls-peer-status-warning-describe "gnutls.c"
-		  (status-symbol))
+                  (status-symbol))
+
+(defun nsm-tls-check-verify-cert (host port status settings)
+  "Check for warnings from the certificate verification status.
 
-(defun nsm-check-certificate (process host port status settings)
+This is the most basic security check for a TLS connection.  If
+ certificate verification fails, it means the server's identity
+ cannot be verified by the credentials received.
+
+Think very carefully before removing this check from
+`nsm-tls-checks'."
   (let ((warnings (plist-get status :warnings)))
-    (cond
+    (and warnings
+         (not (nsm-warnings-ok-p status settings))
+         (mapconcat #'gnutls-peer-status-warning-describe warnings "\n"))))
 
-     ;; The certificate validated, but perhaps we want to do
-     ;; certificate pinning.
-     ((null warnings)
-      (cond
-       ((< (nsm-level network-security-level) (nsm-level 'high))
-	process)
-       ;; The certificate is fine, but if we're paranoid, we might
-       ;; want to check whether it's changed anyway.
-       ((and (>= (nsm-level network-security-level) (nsm-level 'high))
-	     (not (nsm-fingerprint-ok-p host port status settings)))
-	(delete-process process)
-	nil)
-       ;; We haven't seen this before, and we're paranoid.
-       ((and (eq network-security-level 'paranoid)
-	     (null settings)
-	     (not (nsm-new-fingerprint-ok-p host port status)))
-	(delete-process process)
-	nil)
-       (t
-	process)))
-
-     ;; The certificate did not validate.
-     ((not (equal network-security-level 'low))
-      ;; We always want to pin the certificate of invalid connections
-      ;; to track man-in-the-middle or the like.
-      (if (not (nsm-fingerprint-ok-p host port status settings))
-	  (progn
-	    (delete-process process)
-	    nil)
-	;; We have a warning, so query the user.
-	(if (and (not (nsm-warnings-ok-p status settings))
-		 (not (nsm-query
-		       host port status 'conditions
-		       "The TLS connection to %s:%s is insecure for the following reason%s:\n\n%s"
-		       host port
-		       (if (> (length warnings) 1)
-			   "s" "")
-		       (mapconcat #'gnutls-peer-status-warning-describe
-                                  warnings
-                                  "\n"))))
-	    (progn
-	      (delete-process process)
-	      nil)
-	  process))))))
-
-(defvar network-security-protocol-checks
-  '((diffie-hellman-prime-bits medium 1024)
-    (rc4 medium)
-    (signature-sha1 medium)
-    (intermediate-sha1 medium)
-    (3des high)
-    (ssl medium))
-  "This variable specifies what TLS connection checks to perform.
-It's an alist where the first element is the name of the check,
-the second is the security level where the check kicks in, and the
-optional third element is a parameter supplied to the check.
-
-An element like `(rc4 medium)' will result in the function
-`nsm-protocol-check--rc4' being called with the parameters
-HOST PORT STATUS OPTIONAL-PARAMETER.")
-
-(defun nsm-check-protocol (process host port status settings)
-  (cl-loop for check in network-security-protocol-checks
-           for type = (intern (format ":%s" (car check)) obarray)
-           while process
-           ;; Skip the check if the user has already said that this
-           ;; host is OK for this type of "error".
-           when (and (not (memq type (plist-get settings :conditions)))
-                     (>= (nsm-level network-security-level)
-                         (nsm-level (cadr check))))
-           do (let ((result
-                     (funcall (intern (format "nsm-protocol-check--%s"
-                                              (car check))
-                                      obarray)
-                              host port status (nth 2 check))))
-                (unless result
-                  (delete-process process)
-                  (setq process nil))))
-  ;; If a test failed we return nil, otherwise the process object.
-  process)
+(defun nsm-tls-check-same-cert (host port status settings)
+  "Check for certificate fingerprint mismatch.
 
-(defun nsm--encryption (status)
-  (format "%s-%s-%s"
-          (plist-get status :key-exchange)
-	  (plist-get status :cipher)
-	  (plist-get status :mac)))
+If the fingerprints saved do not match the fingerprint of the
+certificate presented, the TLS session may be under a
+man-in-the-middle attack."
+  (and (not (nsm-fingerprint-ok-p status settings))
+       (format-message
+        "fingerprint has changed")))
+
+;; Key exchange checks
+
+(defun nsm-tls-check-rsa-kx (host port status &optional settings)
+  "Check for static RSA key exchange.
 
-(defun nsm-protocol-check--diffie-hellman-prime-bits (host port status bits)
+Static RSA key exchange methods do not offer perfect forward
+secrecy, therefore, the security of a TLS session is only as
+secure as the server's private key.  Due to TLS' use of RSA key
+exchange to create a session key (the key negotiated between the
+client and the server to encrypt traffic), if the server's
+private key had been compromised, the attacker will be able to
+decrypt any past TLS session recorded, as opposed to just one TLS
+session if the key exchange was conducted via a key exchange
+method that offers perfect forward secrecy, such as ephemeral
+Diffie-Hellman key exchange.
+
+By default, this check is only enabled when
+`network-security-level' is set to `high' for compatibility
+reasons.
+
+Reference:
+
+Sheffer, Holz, Saint-Andre (May 2015).  \"Recommendations for Secure
+Use of Transport Layer Security (TLS) and Datagram Transport Layer
+Security (DTLS)\", \"(4.1.  General Guidelines)\"
+`https://tools.ietf.org/html/rfc7525\#section-4.1'"
+  (let ((kx (plist-get status :key-exchange)))
+    (and (string-match "^\\bRSA\\b" kx)
+         (format-message
+          "RSA key exchange method (%s) does not offer perfect forward secrecy"
+          kx))))
+
+(defun nsm-tls-check-dhe-prime-kx (host port status &optional settings)
+  "Check for the key strength of DH key exchange based on integer factorization.
+
+This check is a response to Logjam[1].  Logjam is an attack that
+allows an attacker with sufficient resource, and positioned
+between the user and the server, to downgrade vulnerable TLS
+connections to insecure 512-bit export grade crypotography.
+
+The Logjam paper suggests using 1024-bit prime on the client to
+mitigate some effects of this attack, and upgrade to 2048-bit as
+soon as server configurations allow.  According to SSLLabs' SSL
+Pulse tracker, only about 75% of server support 2048-bit key
+exchange in June 2018[2].  To provide a balance between
+compatibility and security, this function only checks for a
+minimum key strength of 1024-bit.
+
+See also: `nsm-tls-check-dhe-kx'
+
+Reference:
+
+[1]: Adrian et al (2014).  \"Imperfect Forward Secrecy: How
+Diffie-Hellman Fails in Practice\", `https://weakdh.org/'
+[2]: SSL Pulse (June 03, 2018).  \"Key Exchange Strength\",
+`https://www.ssllabs.com/ssl-pulse/'"
   (let ((prime-bits (plist-get status :diffie-hellman-prime-bits)))
-    (or (not prime-bits)
-        (>= prime-bits bits)
-	(nsm-query
-	 host port status :diffie-hellman-prime-bits
-	 "The Diffie-Hellman prime bits (%s) used for this connection to %s:%s is less than what is considered safe (%s)."
-	 prime-bits host port bits))))
-
-(defun nsm-protocol-check--3des (host port status _)
-  (or (not (string-match "\\b3DES\\b" (plist-get status :cipher)))
-      (nsm-query
-       host port status :rc4
-       "The connection to %s:%s uses the 3DES cipher (%s), which is believed to be unsafe."
-       host port (plist-get status :cipher))))
-
-(defun nsm-protocol-check--rc4 (host port status _)
-  (or (not (string-match "\\bRC4\\b" (nsm--encryption status)))
-      (nsm-query
-       host port status :rc4
-       "The connection to %s:%s uses the RC4 algorithm (%s), which is believed to be unsafe."
-       host port (nsm--encryption status))))
-
-(defun nsm-protocol-check--signature-sha1 (host port status _)
-  (let ((signature-algorithm
-         (plist-get (plist-get status :certificate) :signature-algorithm)))
-    (or (not (string-match "\\bSHA1\\b" signature-algorithm))
-        (nsm-query
-         host port status :signature-sha1
-         "The certificate used to verify the connection to %s:%s uses the SHA1 algorithm (%s), which is believed to be unsafe."
-         host port signature-algorithm))))
-
-(defun nsm-protocol-check--intermediate-sha1 (host port status _)
-  ;; Skip the first certificate, because that's the host certificate.
-  (cl-loop for certificate in (cdr (plist-get status :certificates))
+    (if (and (string-match "^\\bDHE\\b" (plist-get status :key-exchange))
+             (< prime-bits 1024))
+        (format-message
+         "Diffie-Hellman key strength (%s bits) too weak (%s bits)"
+         prime-bits 1024))))
+
+(defun nsm-tls-check-dhe-kx (host port status &optional settings)
+  "Check for existence of DH key exchange based on integer factorization.
+
+In the years since the discovery of Logjam, it was discovered
+that there were rampant use of small subgroup prime or composite
+number for DHE by many servers, and thus allowed themselves to be
+vulnerable to backdoors[1].  Given the difficulty in validating
+Diffie-Hellman parameters, major browser vendors had started to
+remove DHE since 2016[2].  Emacs stops short of banning DHE and
+terminating connection, but prompts the user instead.
+
+References:
+
+[1]: Dorey, Fong, and Essex (2016).  \"Indiscreet Logs: Persistent
+Diffie-Hellman Backdoors in TLS.\",
+`https://eprint.iacr.org/2016/999.pdf'
+[2]: Chrome Platform Status (2017).  \"Remove DHE-based ciphers\",
+`https://www.chromestatus.com/feature/5128908798164992'"
+  (let ((kx (plist-get status :key-exchange)))
+    (when (string-match "^\\bDHE\\b" kx)
+      (format-message
+       "unable to verify Diffie-Hellman key exchange method (%s) parameters"
+       kx))))
+
+(defun nsm-tls-check-export-kx (host port status &optional settings)
+  "Check for RSA-EXPORT key exchange.
+
+EXPORT cipher suites are a family of 40-bit and 56-bit effective
+security algorithms legally exportable by the United States in
+the early 90s[1].  They can be broken in seconds on 2018 hardware.
+
+Prior to 3.2.0, GnuTLS had only supported RSA-EXPORT key
+exchange.  Since 3.2.0, RSA-EXPORT had been removed, therefore,
+this check has no effect on GnuTLS >= 3.2.0.
+
+Reference:
+
+[1]: Schneier, Bruce (1996). Applied Cryptography (Second ed.). John
+Wiley & Sons. ISBN 0-471-11709-9.
+[2]: N. Mavrogiannopoulos, FSF (Apr 2015).  \"GnuTLS NEWS -- History
+of user-visible changes.\" Version 3.4.0,
+`https://gitlab.com/gnutls/gnutls/blob/master/NEWS'"
+  (when (< libgnutls-version 30200)
+    (let ((kx (plist-get status :key-exchange)))
+      (and (string-match "\\bEXPORT\\b" kx)
+           (format-message
+            "EXPORT level key exchange (%s) is insecure"
+            kx)))))
+
+(defun nsm-tls-check-anon-kx (host port status &optional settings)
+  "Check for anonymous key exchange.
+
+Anonymous key exchange exposes the connection to
+man-in-the-middle attacks.
+
+Reference:
+
+GnuTLS authors (2018). \"GnuTLS Manual 4.3.3 Anonymous
+authentication\",
+`https://www.gnutls.org/manual/gnutls.html\#Anonymous-authentication'"
+  (let ((kx (plist-get status :key-exchange)))
+    (and (string-match "\\bANON\\b" kx)
+         (format-message
+          "anonymous key exchange method (%s) can be unsafe"
+          kx))))
+
+;; Cipher checks
+
+(defun nsm-tls-check-cbc-cipher (host port status &optional settings)
+  "Check for CBC mode ciphers.
+
+CBC mode cipher in TLS versions earlier than 1.3 are problematic
+because of MAC-then-encrypt.  This construction is vulnerable to
+padding oracle attacks[1].
+
+Since GnuTLS 3.4.0, the TLS encrypt-then-MAC extension[2] has
+been enabled by default[3]. If encrypt-then-MAC is negotiated,
+this check has no effect.
+
+Reference:
+
+[1]: Sullivan (Feb 2016).  \"Padding oracles and the decline of
+CBC-mode cipher suites\",
+`https://blog.cloudflare.com/padding-oracles-and-the-decline-of-cbc-mode-ciphersuites/'
+[2]: P. Gutmann (Sept 2014).  \"Encrypt-then-MAC for Transport Layer
+Security (TLS) and Datagram Transport Layer Security (DTLS)\",
+`https://tools.ietf.org/html/rfc7366'
+[3]: N. Mavrogiannopoulos (Nov 2015).  \"An overview of GnuTLS
+3.4.x\",
+`https://nikmav.blogspot.com/2015/11/an-overview-of-gnutls-34x.html'"
+  (when (not (plist-get status :encrypt-then-mac))
+    (let ((cipher (plist-get status :cipher)))
+      (and (string-match "\\bCBC\\b" cipher)
+           (format-message
+            "CBC mode cipher (%s) can be insecure"
+            cipher)))))
+
+(defun nsm-tls-check-ecdsa-cbc-cipher (host port status &optional settings)
+  "Check for CBC mode cipher usage under ECDSA key exchange.
+
+CBC mode cipher in TLS versions earlier than 1.3 are problematic
+because of MAC-then-encrypt.  This construction is vulnerable to
+padding oracle attacks[1].
+
+Due to current widespread use of CBC mode ciphers by servers,
+this function only checks for CBC mode cipher usage in
+combination with ECDSA key exchange, which is virtually
+non-existent[2].
+
+Since GnuTLS 3.4.0, the TLS encrypt-then-MAC extension[3] has
+been enabled by default[4]. If encrypt-then-MAC is negotiated,
+this check has no effect.
+
+References:
+
+[1]: Sullivan (Feb 2016).  \"Padding oracles and the decline of
+CBC-mode cipher suites\",
+`https://blog.cloudflare.com/padding-oracles-and-the-decline-of-cbc-mode-ciphersuites/'
+[2]: Chrome Platform Status (2017). \"Remove CBC-mode ECDSA ciphers in
+TLS\", `https://www.chromestatus.com/feature/5740978103123968'
+[3]: P. Gutmann (Sept 2014).  \"Encrypt-then-MAC for Transport Layer
+Security (TLS) and Datagram Transport Layer Security (DTLS)\",
+`https://tools.ietf.org/html/rfc7366'
+[4]: N. Mavrogiannopoulos (Nov 2015).  \"An overview of GnuTLS
+3.4.x\",
+`https://nikmav.blogspot.com/2015/11/an-overview-of-gnutls-34x.html'"
+  (when (not (plist-get status :encrypt-then-mac))
+    (let ((kx (plist-get status :key-exchange))
+          (cipher (plist-get status :cipher)))
+      (and (string-match "\\bECDSA\\b" kx)
+           (string-match "\\bCBC\\b" cipher)
+           (format-message
+            "CBC mode cipher (%s) can be insecure"
+            cipher)))))
+
+(defun nsm-tls-check-3des-cipher (host port status &optional settings)
+  "Check for 3DES ciphers.
+
+Due to its use of 64-bit block size, it is known that a
+ciphertext collision is highly likely when 2^32 blocks are
+encrypted with the same key bundle under 3-key 3DES.  Practical
+birthday attacks of this kind have been demostrated by Sweet32[1].
+As such, NIST is in the process of disallowing its use in TLS[2].
+
+[1]: Bhargavan, Leurent (2016).  \"On the Practical (In-)Security of
+64-bit Block Ciphers — Collision Attacks on HTTP over TLS and
+OpenVPN\", `https://sweet32.info/'
+[2]: NIST Information Technology Laboratory (Jul 2017).  \"Update to
+Current Use and Deprecation of TDEA\",
+`https://csrc.nist.gov/News/2017/Update-to-Current-Use-and-Deprecation-of-TDEA'"
+  (let ((cipher (plist-get status :cipher)))
+    (and (string-match "\\b3DES\\b" cipher)
+         (format-message
+          "3DES cipher (%s) is weak"
+          cipher))))
+
+(defun nsm-tls-check-rc4-cipher (host port status &optional settings)
+  "Check for RC4 ciphers.
+
+RC4 cipher has been prohibited by RFC 7465[1].
+
+Since GnuTLS 3.4.0, RC4 is not enabled by default[2], but can be
+enabled if requested.  This check is mainly provided to secure
+Emacs built with older version of GnuTLS.
+
+Reference:
+
+[1]: Popov A (Feb 2015).  \"Prohibiting RC4 Cipher Suites\",
+`https://tools.ietf.org/html/rfc7465'
+[2]: N. Mavrogiannopoulos (Nov 2015).  \"An overview of GnuTLS
+3.4.x\",
+`https://nikmav.blogspot.com/2015/11/an-overview-of-gnutls-34x.html'"
+  (let ((cipher (plist-get status :cipher)))
+    (and (string-match "\\bARCFOUR\\b" cipher)
+         (format-message
+          "RC4 cipher (%s) is insecure"
+          cipher))))
+
+;; Signature checks
+
+(defun nsm-tls-check-sha1-sig (host port status &optional settings)
+  "Check for SHA1 signatures on certificates.
+
+The first SHA1 collision was found in 2017[1], as a precaution
+against the events following the discovery of cheap collisions in
+MD5, major browsers[2][3][4][5] have removed the use of SHA1
+signatures in certificates.
+
+References:
+
+[1]: Stevens M, Karpman P et al (2017).  \"The first collision for
+full SHA-1\", `https://shattered.io/static/shattered.pdf'
+[2]: Chromium Security Education TLS/SSL.  \"Deprecated and Removed
+Features (SHA-1 Certificate Signatures)\",
+`https://www.chromium.org/Home/chromium-security/education/tls\#TOC-SHA-1-Certificate-Signatures'
+[3]: Jones J.C (2017).  \"The end of SHA-1 on the Public Web\",
+`https://blog.mozilla.org/security/2017/02/23/the-end-of-sha-1-on-the-public-web/'
+[4]: Apple Support (2017).  \"Move to SHA-256 signed certificates to
+avoid connection failures\",
+`https://support.apple.com/en-gb/HT207459'
+[5]: Microsoft Security Advisory 4010323 (2017).  \"Deprecation of
+SHA-1 for SSL/TLS Certificates in Microsoft Edge and Internet Explorer
+11\",
+`https://docs.microsoft.com/en-us/security-updates/securityadvisories/2017/4010323'"
+  (cl-loop for certificate in (plist-get status :certificates)
+           for algo = (plist-get certificate :signature-algorithm)
+           ;; Don't check root certificates -- root is always trusted.
+           if (and (not (equal (plist-get certificate :issuer)
+                               (plist-get certificate :subject)))
+                   (string-match "\\bSHA1\\b" algo))
+           return (format-message
+                   "SHA1 signature (%s) is prone to collisions"
+                   algo)
+           end))
+
+(defun nsm-tls-check-md5-sig (host port status &optional settings)
+  "Check for MD5 signatures on certificates.
+
+In 2008, a group of researchers were able to forge an
+intermediate CA certificate that appeared to be legitimate when
+checked by MD5[1].  RFC 6151[2] has recommended against the usage
+of MD5 for digital signatures, which includes TLS certificate
+signatures.
+
+Since GnuTLS 3.3.0, MD5 has been disabled by default, but can be
+enabled if requested.
+
+References:
+
+[1]: Sotirov A, Stevens M et al (2008).  \"MD5 considered harmful today
+- Creating a rogue CA certificate\",
+`http://www.win.tue.nl/hashclash/rogue-ca/'
+[2]: Turner S, Chen L (2011).  \"Updated Security Considerations for
+the MD5 Message-Digest and the HMAC-MD5 Algorithms\",
+`https://tools.ietf.org/html/rfc6151'"
+  (cl-loop for certificate in (plist-get status :certificates)
            for algo = (plist-get certificate :signature-algorithm)
-           ;; Don't check root certificates -- SHA1 isn't dangerous
-           ;; there.
-           when (and (not (equal (plist-get certificate :issuer)
-                                 (plist-get certificate :subject)))
-                     (string-match "\\bSHA1\\b" algo)
-                     (not (nsm-query
-                           host port status :intermediate-sha1
-                           "An intermediate certificate used to verify the connection to %s:%s uses the SHA1 algorithm (%s), which is believed to be unsafe."
-                           host port algo)))
-           do (cl-return nil)
-           finally (cl-return t)))
-
-(defun nsm-protocol-check--ssl (host port status _)
+           ;; Don't check root certificates -- root is always trusted.
+           if (and (not (equal (plist-get certificate :issuer)
+                               (plist-get certificate :subject)))
+                   (string-match "\\bMD5\\b" algo))
+           return (format-message
+                   "MD5 signature (%s) is very prone to collisions"
+                   algo)
+           end))
+
+;; Extension checks
+
+(defun nsm-tls-check-renegotiation-info-ext (host port status &optional settings)
+  "Check for renegotiation_info TLS extension status.
+
+If this TLS extension is not used, the connection established is
+vulnerable to an attack in which an impersonator can extract
+sensitive information such as HTTP session ID cookies or login
+passwords.
+
+Reference:
+
+E. Rescorla, M. Ray, S. Dispensa, N. Oskov (Feb 2010).  \"Transport
+Layer Security (TLS) Renegotiation Indication Extension\",
+`https://tools.ietf.org/html/rfc5746'"
+  (let ((unsafe-renegotiation (not (plist-get status :safe-renegotiation))))
+    (and unsafe-renegotiation
+         (format-message
+          "safe renegotiation is not supported, connection not protected from impersonators"))))
+
+;; Compression checks
+
+(defun nsm-tls-check-compression (host port status &optional settings)
+  "Check for TLS compression.
+
+TLS compression attacks such as CRIME would allow an attacker to
+decrypt ciphertext.  As a result, RFC 7525 has recommended its
+disablement.
+
+Reference:
+
+Sheffer, Holz, Saint-Andre (May 2015).  \"Recommendations for Secure
+Use of Transport Layer Security (TLS) and Datagram Transport Layer
+Security (DTLS)\", `https://tools.ietf.org/html/rfc7525'"
+  (let ((compression (plist-get status :compression)))
+    (and (string-match "^\\bDEFLATE\\b" compression)
+         (format-message
+          "compression method (%s) may lead to leakage of sensitive information"
+          compression))))
+
+;; Protocol version checks
+
+(defun nsm-tls-check-version (host port status &optional settings)
+  "Check for SSL/TLS protocol version.
+
+This function guards against the usage of SSL3.0, which has been
+deprecated by RFC7568[1], and TLS 1.0, which has been deprecated
+by PCI DSS[2].
+
+References:
+
+[1]: Barnes, Thomson, Pironti, Langley (2015).  \"Deprecating Secure
+Sockets Layer Version 3.0\", `https://tools.ietf.org/html/rfc7568'
+[2]: PCI Security Standards Council (2016).  \"Migrating from SSL and
+Early TLS\"
+`https://www.pcisecuritystandards.org/documents/Migrating-from-SSL-Early-TLS-Info-Supp-v1_1.pdf'"
   (let ((protocol (plist-get status :protocol)))
-    (or (not protocol)
-	(not (string-match "SSL" protocol))
-	(nsm-query
-	 host port status :ssl
-	 "The connection to %s:%s uses the %s protocol, which is believed to be unsafe."
-	 host port protocol))))
+    (and protocol
+         (or (string-match "SSL" protocol)
+             (and (string-match "TLS1.\\([0-9]+\\)" protocol)
+                  (< (string-to-number (match-string 1 protocol)) 1)))
+         (format-message
+          "%s protocol is deprecated by standard bodies"
+          protocol))))
+
+;; Full suite checks
+
+(defun nsm-tls-check-null-suite (host port status &optional settings)
+  "Check for NULL cipher suites.
+
+This function checks for NULL key exchange, cipher and message
+authentication code key derivation function.  As the name
+suggests, a NULL assigned for any of the above disables an
+integral part of the security properties that makes up the TLS
+protocol."
+  (let ((suite (nsm-cipher-suite status)))
+    (and (string-match "\\bNULL\\b" suite)
+         (format-message
+          "NULL cipher suite (%s) violates authenticity, integrity, or confidentiality guarantees"
+          suite))))
+
+
 
 (defun nsm-fingerprint (status)
   (plist-get (plist-get status :certificate) :public-key-id))
 
-(defun nsm-fingerprint-ok-p (host port status settings)
-  (let ((did-query nil))
-    (if (and settings
-	     (not (eq (plist-get settings :fingerprint) :none))
-	     (not (equal (nsm-fingerprint status)
-			 (plist-get settings :fingerprint)))
-	     (not
-	      (setq did-query
-		    (nsm-query
-		     host port status 'fingerprint
-		     "The fingerprint for the connection to %s:%s has changed from %s to %s"
-		     host port
-		     (plist-get settings :fingerprint)
-		     (nsm-fingerprint status)))))
-	;; Not OK.
-	nil
-      (when did-query
-	;; Remove any exceptions that have been set on the previous
-	;; certificate.
-	(plist-put settings :conditions nil))
-      t)))
-
-(defun nsm-new-fingerprint-ok-p (host port status)
-  (nsm-query
-   host port status 'fingerprint
-   "The fingerprint for the connection to %s:%s is new: %s"
-   host port
-   (nsm-fingerprint status)))
+(defun nsm-fingerprint-ok-p (status settings)
+  (let ((saved-fingerprints (plist-get settings :fingerprints)))
+    ;; Haven't seen this host before or not pinning cert
+    (or (null saved-fingerprints)
+        ;; Plain connection allowed
+        (memq :none saved-fingerprints)
+        ;; We are pinning certs, and we have seen this host
+        ;; before, but the credientials for this host differs
+        ;; from the last times we saw it
+        (member (nsm-fingerprint status) saved-fingerprints))))
+
+(set-advertised-calling-convention
+ 'nsm-fingerprint-ok-p '(status settings) "27.1")
 
 (defun nsm-check-plain-connection (process host port settings warn-unencrypted)
-  ;; If this connection used to be TLS, but is now plain, then it's
-  ;; possible that we're being Man-In-The-Middled by a proxy that's
-  ;; stripping out STARTTLS announcements.
-  (cond
-   ((and (plist-get settings :fingerprint)
-	 (not (eq (plist-get settings :fingerprint) :none))
-	 (not
-	  (nsm-query
-	   host port nil 'conditions
-	   "The connection to %s:%s used to be an encrypted connection, but is now unencrypted.  This might mean that there's a man-in-the-middle tapping this connection."
-	   host port)))
-    (delete-process process)
-    nil)
-   ((and warn-unencrypted
-	 (not (memq :unencrypted (plist-get settings :conditions)))
-	 (not (nsm-query
-	       host port nil 'conditions
-	       "The connection to %s:%s is unencrypted."
-	       host port)))
-    (delete-process process)
-    nil)
-   (t
-    process)))
-
-(defun nsm-query (host port status what message &rest args)
+  (if (nsm-should-check host)
+      ;; If this connection used to be TLS, but is now plain, then it's
+      ;; possible that we're being Man-In-The-Middled by a proxy that's
+      ;; stripping out STARTTLS announcements.
+      (let ((fingerprints (plist-get settings :fingerprints)))
+        (cond
+         ((and fingerprints
+	       (not (memq :none fingerprints))
+	       (not
+	        (nsm-query
+	         host port nil 'conditions '(:unencrypted)
+                 (format-message
+	          "The connection to %s:%s used to be an encrypted connection, but is now unencrypted.  This might mean that there's a man-in-the-middle tapping this connection."
+	          host port))))
+          (delete-process process)
+          nil)
+         ((and warn-unencrypted
+	       (not (memq :unencrypted (plist-get settings :conditions)))
+	       (not (nsm-query
+	             host port nil 'conditions '(:unencrypted)
+                     (format-message
+	              "The connection to %s:%s is unencrypted."
+	              host port))))
+          (delete-process process)
+          nil)
+         (t
+          process)))
+    process))
+
+(defun nsm-query (host port status what problems message)
   ;; If there is no user to answer queries, then say `no' to everything.
   (if (or noninteractive
 	  nsm-noninteractive)
@@ -340,9 +789,7 @@ HOST PORT STATUS OPTIONAL-PARAMETER.")
     (let ((response
 	   (condition-case nil
                (intern
-                (car (split-string
-                      (nsm-query-user message args
-                                      (nsm-format-certificate status))))
+                (car (split-string (nsm-query-user message status)))
                 obarray)
 	     ;; Make sure we manage to close the process if the user hits
 	     ;; `C-g'.
@@ -356,46 +803,111 @@ HOST PORT STATUS OPTIONAL-PARAMETER.")
                      "Accepting certificate for %s:%s this session only"
                    "Permanently accepting certificate for %s:%s")
                  host port)
-	(nsm-save-host host port status what response)
-	t))))
-
-(defun nsm-query-user (message args cert)
-  (catch 'return
-    (while t
-      (let ((buffer (get-buffer-create "*Network Security Manager*")))
-        (save-window-excursion
-          ;; First format the certificate and warnings.
-          (with-help-window buffer
-            (with-current-buffer buffer
-              (erase-buffer)
-              (when (> (length cert) 0)
-                (insert cert "\n"))
-              (let ((start (point)))
-                (insert (apply #'format-message message args))
-                (goto-char start)
-                ;; Fill the first line of the message, which usually
-                ;; contains lots of explanatory text.
-                (fill-region (point) (line-end-position)))))
-          ;; Then ask the user what to do about it.
-          (pcase (unwind-protect
-                     (cadr
-                      (read-multiple-choice
-                       "Continue connecting?"
-                       '((?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.")
-                         (?r "reshow" "Reshow certificate information."))))
-                   (kill-buffer buffer))
-            ("reshow")
-            (val (throw 'return val))))))))
-
-(defun nsm-save-host (host port status what permanency)
+        (nsm-save-host host port status what problems response)
+        t))))
+
+(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*"))
+        (certs (plist-get status :certificates)))
+    (save-window-excursion
+      ;; First format the certificate and warnings.
+      (with-current-buffer-window
+       buffer nil nil
+       (insert (nsm-format-certificate status))
+       (insert message)
+       (goto-char (point-min))
+       ;; Fill the first line of the message, which usually
+       ;; contains lots of explanatory text.
+       (fill-region (point) (line-end-position)))
+      ;; Then ask the user what to do about it.
+      (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.")
+                                   (?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")
+
+(defun nsm-save-host (host port status what problems permanency)
   (let* ((id (nsm-id host port))
-	 (saved
-	  (list :id id
-		:fingerprint (or (nsm-fingerprint status)
-				 ;; Plain connection.
-				 :none))))
+         (saved-fingerprints (plist-get (nsm-host-settings id) :fingerprints))
+         (fingerprints (cl-delete-duplicates
+                        (append saved-fingerprints
+                                (list (or (nsm-fingerprint status)
+                                          ;; Plain connection.
+                                          :none)))
+                        :test #'string=))
+         (saved (list :id id :fingerprints fingerprints)))
     (when (or (eq what 'conditions)
 	      nsm-save-host-names)
       (nconc saved (list :host (format "%s:%s" host port))))
@@ -403,20 +915,19 @@ HOST PORT STATUS OPTIONAL-PARAMETER.")
     ;; of the certificate/unencrypted connection.
     (cond
      ((eq what 'conditions)
-      (cond
-       ((not status)
-	(nconc saved '(:conditions (:unencrypted))))
-       ((plist-get status :warnings)
-	(nconc saved
-	       (list :conditions (plist-get status :warnings))))))
-     ((not (eq what 'fingerprint))
+      (plist-put saved :conditions problems))
+     ;; Make sure the conditions are not erased when we save a
+     ;; fingerprint
+     ((eq what 'fingerprint)
       ;; Store additional protocol settings.
       (let ((settings (nsm-host-settings id)))
-	(when settings
-	  (setq saved settings))
-	(if (plist-get saved :conditions)
-	    (nconc (plist-get saved :conditions) (list what))
-	  (nconc saved (list :conditions (list what)))))))
+        (when settings
+          (setq saved settings))
+        (if (plist-get saved :conditions)
+            (plist-put saved :conditions
+                       (cl-delete-duplicates
+                        (nconc (plist-get saved :conditions) problems)))
+          (plist-put saved :conditions problems)))))
     (if (eq permanency 'always)
 	(progn
 	  (nsm-remove-temporary-setting id)
@@ -426,6 +937,11 @@ HOST PORT STATUS OPTIONAL-PARAMETER.")
       (nsm-remove-temporary-setting id)
       (push saved nsm-temporary-host-settings))))
 
+(set-advertised-calling-convention
+ 'nsm-save-host
+ '(host port status what problems permanency)
+ "27.1")
+
 (defun nsm-write-settings ()
   (with-temp-file nsm-settings-file
     (insert "(\n")
@@ -483,44 +999,58 @@ HOST PORT STATUS OPTIONAL-PARAMETER.")
   (let ((cert (plist-get status :certificate)))
     (when cert
       (with-temp-buffer
-	(insert
-	 "Certificate information\n"
-	 "Issued by:"
-	 (nsm-certificate-part (plist-get cert :issuer) "CN" t) "\n"
-	 "Issued to:"
+        (insert
+	 (propertize "Certificate information" 'face 'underline) "\n"
+	 "  Issued by:"
+         (nsm-certificate-part (plist-get cert :issuer) "CN" t) "\n"
+	 "  Issued to:"
 	 (or (nsm-certificate-part (plist-get cert :subject) "O")
 	     (nsm-certificate-part (plist-get cert :subject) "OU" t))
-	 "\n"
-	 "Hostname:"
+         "\n"
+	 "  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)
+	   "  Public key:" (plist-get cert :public-key-algorithm)
 	   ", signature: " (plist-get cert :signature-algorithm) "\n"))
-	(when (and (plist-get status :key-exchange)
+        (when (and (plist-get status :key-exchange)
 		   (plist-get status :cipher)
 		   (plist-get status :mac)
 		   (plist-get status :protocol))
 	  (insert
-	   "Protocol:" (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
-	   "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")
+        (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-level (symbol)
+  "Return a numerical level for SYMBOL for easier comparison."
+  (cond
+   ((eq symbol 'low) 0)
+   ((eq symbol 'medium) 1)
+   (t 2)))
+
+(defun nsm-cipher-suite (status)
+  (format "%s-%s-%s"
+          (plist-get status :key-exchange)
+          (plist-get status :cipher)
+          (plist-get status :mac)))
+
 (defun nsm-certificate-part (string part &optional full)
   (let ((part (cadr (assoc part (nsm-parse-subject string)))))
     (cond
@@ -552,13 +1082,7 @@ HOST PORT STATUS OPTIONAL-PARAMETER.")
 	     elem)))
        (nreverse result)))))
 
-(defun nsm-level (symbol)
-  "Return a numerical level for SYMBOL for easier comparison."
-  (cond
-   ((eq symbol 'low) 0)
-   ((eq symbol 'medium) 1)
-   ((eq symbol 'high) 2)
-   (t 3)))
+(define-obsolete-function-alias 'nsm--encryption #'nsm-cipher-suite "27.1")
 
 (provide 'nsm)