bug#31946: 27.0.50; The NSM should warn about more TLS problems

[Jimmy Yuen Ho Wong <wyuenho@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 5307 bytes --]

Here's the patch promised.

Summary of changes:

* 9 new checks added, some for securing Emacs builts with older GnuTLS
versions, some for bringing NSM checks to 2018.
* Individual checks are now suffixe'd by their cipher suite part. E.g.
dhe-kx for DHE key exchange, des-cipher for DES cipher, sha1-sig for
SHA1 signature.
* Protocal checks now return an error message instead of querying the
user directly.
* All protocol checks under the same network-security-level are
performed. All of the messages are then merged if any, and the user is
only prompt once after the protocol check for all problems found.
* nsm-query and nsm-query-user no longer takes extra args to format
messages. Formatted messages are now provided directly by the
individual checks.
* Fix RC4 check where it was previously checking for non-existent RC4
cipher from GnuTLS. GnuTLS actually calls RC4 ARCFOUR.
* Removed sha1 check as it is already covered by the intermediate SHA1 checks.
* DHE check now checks for < 1024 bit prime for 'medium and usage of
DHE for 'high and above, in addition to prime bit length.

Possible improvements:

* Check for TLS compression. I haven't looked into how to do this with
GnuTLS' API yet, but we should probably do this because CRIME and
BREACH.
* Check for TLS 1.0 usage and protocol downgrades? Today happens to be
the deadline to migrate to TLS 1.1+ for PCI DSS compliance, but the
reason seems to be POODLE, BEAST, CRIME, BREACH and Heartbleed and
downgrade to SSL. Mitigations for some of these are already in
existing checks, others may be covered by a compression check. Maybe
we should be paranoid about this? Also, I'm not sure how to check for
protocol downgrades with GnuTLS' API.
* Write some unit tests....

I've manually tested this patch a bit, but please give this patch a
look and see if I've missed anything. I need all the feedbacks I can
get for this.

Jimmy

On Fri, Jun 29, 2018 at 6:25 AM, Jimmy Yuen Ho Wong <wyuenho@gmail.com> wrote:
> Correction:
>
> This is the actualy cipher string I used
> "DHE-RSA-AES128-GCM-SHA256:DHE-RSA-AES128-SHA256:DHE-RSA-AES256-SHA384:DHE-RSA-AES256-SHA256".
>
> All 3 browsers fail to connect.
>
> On Fri, Jun 29, 2018 at 6:21 AM, Jimmy Yuen Ho Wong <wyuenho@gmail.com> wrote:
>> Update:
>>
>> I just tried with this node.js script:
>>
>> #! /usr/bin/env node
>>
>> const https = require('https');
>> const fs = require('fs');
>>
>> const options = {
>>   key: fs.readFileSync('ryans-key.pem'),
>>   cert: fs.readFileSync('ryans-cert.pem'),
>>   ciphers: "DHE-RSA-AES128-GCM-SHA256"
>> };
>>
>> https.createServer(options, (req, res) => {
>>   res.writeHead(200);
>>   res.end('hello world\n');
>> }).listen(8000);
>>
>> Chrome gave me a ERR_SSL_VERSION_OR_CIPHER_MISMATCH, Firefox gave me a
>> SSL_ERROR_NO_CYPHER_OVERLAP, Safari just told me it can't establish a
>> connection.
>>
>> Conversely, changing DHE to ECDHE will at least show me the warning
>> screen for a self-signed cert, so I'm fairly certain now that these 3
>> browsers have removed DHE KX.
>>
>>
>> Heads up:
>>
>> I'm adding about 10 new checks into NSM ATM. Will send a early preview
>> patch here later today for feedback.
>>
>>
>> On Thu, Jun 28, 2018 at 7:15 PM, Jimmy Yuen Ho Wong <wyuenho@gmail.com> wrote:
>>> The Telemetry data[1] from Mozilla in bug report 1227519[2] suggests
>>> DHE usage is very low for HTTP. No data for any other protocol.
>>>
>>> I just used Wireshark on Chrome and Firefox on macOS, they all seem to
>>> advertise DH and DHE cipher suites in Client Hello for TLS 1.2, they
>>> even advertise CBC mode ciphers too. While I'm not sure about Firefox,
>>> surely Chrome has removed DHE_SHA KX and CBC modes according to
>>> ChromeStatus[3]?
>>>
>>>
>>> [1]: https://tlscanary.mozilla.org/runs/2018-01-25-01-21-44/
>>> [2]: https://bugzilla.mozilla.org/show_bug.cgi?id=1227519
>>> [3]: https://www.chromestatus.com/features#tls
>>>
>>> On Thu, Jun 28, 2018 at 6:01 PM, Lars Ingebrigtsen <larsi@gnus.org> wrote:
>>>> Jimmy Yuen Ho Wong <wyuenho@gmail.com> writes:
>>>>
>>>>>> I can't see that that web page mentions Diffie-Hellman at all?
>>>>>>
>>>>>
>>>>> Click on the individual browsers.
>>>>
>>>> I see.
>>>>
>>>>> SSLLabs only reports that Firefox 59 / Win 7 has dropped support for
>>>>> DHE_RSA in the UA capabilities page[1], but client test[2] still shows
>>>>> it is supported, so does Chrome and Safari. I don't understand what's
>>>>> going on there. Could that list in in client test be static? Or that
>>>>> browsers still advertise their support for DHE_RSA when in fact they
>>>>> don't? Might have to get on a server and log out the TLS handshake to
>>>>> see what's actually going on...
>>>>>
>>>>> [1]: https://www.ssllabs.com/ssltest/clients.html
>>>>> [2]: https://www.ssllabs.com/ssltest/viewMyClient.html
>>>>
>>>> My
>>>>
>>>> Chromium        66.0.3359.117 (Developer Build) built on Debian 9.4,
>>>> running on Debian 9.4 (64-bit)
>>>>
>>>> on the viewMyClient reports not supporting DHE-RSA.
>>>>
>>>> Confusing.  :-)
>>>>
>>>> I tried finding a web site that says how many sites do not support ECDHE
>>>> as key exchange, and only found something from 2014 that says that was
>>>> 60%...
>>>>
>>>> --
>>>> (domestic pets only, the antidote for overdose, milk.)
>>>>    bloggy blog: http://lars.ingebrigtsen.no

[-- Attachment #2: 0001-Modern-protocol-checks-for-NSM.patch --]
[-- Type: application/octet-stream, Size: 26086 bytes --]

From 09ddb4892879e93025b0d6f92979b9f8be350c62 Mon Sep 17 00:00:00 2001
From: Jimmy Yuen Ho Wong <wyuenho@gmail.com>
Date: Sat, 30 Jun 2018 17:28:47 +0100
Subject: [PATCH] Modern protocol checks for NSM

* lisp/net/nsm.el
(nsm-check-certificate, nsm-fingerprint-ok-p,
nsm-check-plain-connection): Pre-format query messages before passing
to nsm-query.
(nsm-query): No longer takes extra arguments for formatting
messages.
(nsm-query-user): No longer take extra arguments for formatting
messages. 'what' parameter can now be a list of conditions.
(nsm-check-protocol): Prompts user for all problems
found instead of just the first one.
(network-security-protocol-checks): Add rsx-kx, anon-kx,
export-kx, cbc-cipher, ecdsa-cbc-cipher, des-cipher, rc2-cipher,
null-cipher, md5-sig checks.
(nsm-protocol-check--diffie-hellman-prime-bits): Rename to
nsm-protocol-check--dhe-kx. Checks for prime bits < 1024 for 'medium
network-security-level and usage of DHE KX for 'high in addition to
prime bits. Shorten error messages.
(nsm-protocol-check--rc4): Rename to
nsm-protocol-check--rc4-cipher. Fix bug where it was previously
checking for non-existent cipher name RC4 in GnuTLS instead of
ARCFOUR. Shorten error message.
(nsm-protocol-check--signature-sha1): Removed.
(nsm-protocol-check--intermediate-sha1): Rename to
nsm-protocol-check--sha1-sig. Shorten error message.

(Bug#31946)
---
 lisp/net/nsm.el | 511 ++++++++++++++++++++++++++++++++++++++----------
 1 file changed, 404 insertions(+), 107 deletions(-)

diff --git a/lisp/net/nsm.el b/lisp/net/nsm.el
index 0653cfbb1a..df67fe9cf6 100644
--- a/lisp/net/nsm.el
+++ b/lisp/net/nsm.el
@@ -169,24 +169,33 @@ nsm-check-certificate
 	(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"))))
+                       (format-message
+		        "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)
+  '((rsa-kx high)
+    (dhe-kx medium)
+    (anon-kx medium)
+    (export-kx medium)
+    (cbc-cipher high)
+    (ecdsa-cbc-cipher medium)
+    (3des-cipher medium)
+    (des-cipher medium)
+    (rc4-cipher medium)
+    (rc2-cipher medium)
+    (null-cipher medium)
+    (sha1-sig medium)
+    (md5-sig medium)
     (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,
@@ -198,87 +207,370 @@ network-security-protocol-checks
 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))))
+  (let ((results
+         (cl-remove-if-not
+          #'cdr
+          (cl-loop for check in network-security-protocol-checks
+                   for type = (intern (format ":%s" (car check)) obarray)
+                   ;; 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))))
+                   collect (cons
+                            type
+                            (funcall (intern (format "nsm-protocol-check--%s"
+                                                     (car check))
+                                             obarray)
+                                     host port status))))))
+    (when (and results
+               (not (nsm-query host port status
+                               (sort (map-keys results) #'string<)
+                               (format-message
+		                "The TLS connection to %s:%s is insecure for the following reason%s:\n\n%s"
+		                host port
+		                (if (> (length results) 1)
+			            "s" "")
+		                (string-join (map-values results) "\n")))))
+      (delete-process process)
+      (setq process nil)))
   ;; If a test failed we return nil, otherwise the process object.
   process)
 
-(defun nsm--encryption (status)
-  (format "%s-%s-%s"
-          (plist-get status :key-exchange)
-	  (plist-get status :cipher)
-	  (plist-get status :mac)))
-
-(defun nsm-protocol-check--diffie-hellman-prime-bits (host port status bits)
-  (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))
+\f
+
+;; Key exchange checks
+
+(defun nsm-protocol-check--rsa-kx (host port status)
+  "Check for static RSA key exchange.
+
+Static RSA key exchange methods do not offer perfect forward
+secrecy.
+
+Reference:
+
+IETF TLSWG (2014). \"[TLS] Confirming Consensus on removing RSA key
+Transport from TLS 1.3\",
+`https://www.ietf.org/mail-archive/web/tls/current/msg11621.html'"
+  (let ((kx (plist-get status :key-exchange)))
+    (and (string-match "^\\bRSA\\b" kx)
+         (format-message
+          "RSA key exchange method (%s) that does not offer perfect forward secrecy"
+          kx))))
+
+(defun nsm-protocol-check--dhe-kx (host port status)
+  "Check for finite field ephemeral Diffie-Hellman key exchange.
+
+If `network-security-level' is 'medium, and a DHE key exchange
+method was used, this function queries the user if the prime bit
+length is < 1024.
+
+If `network-security-level' is 'high or above, and a DHE key
+exchange method was used, this function queries the user even if
+the prime bit length is >= 1024.
+
+In 2014, the discovery of Logjam[1] had proven non-elliptic-curve
+Diffie-Hellman key exchange with < 1024 prime bit length to be
+unsafe. In subsequent years, 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[2]. Given the difficulty in validating DHE parameters,
+major browser vendors had started to remove DHE since
+2016[3]. Emacs stops short of banning DHE and terminating
+connection, but prompts the user instead.
+
+References:
+
+[1]: Adrian et al (2014). \"Imperfect Forward Secrecy: How
+Diffie-Hellman Fails in Practice\", `https://weakdh.org/'
+
+[2]: Dorey, Fong, and Essex (2016). \"Indiscreet Logs: Persistent
+Diffie-Hellman Backdoors in TLS.\",
+`https://eprint.iacr.org/2016/999.pdf'
+
+[3]: Chrome Platform Status (2017). \"Remove DHE-based ciphers\",
+`https://www.chromestatus.com/feature/5128908798164992'"
+  (let* ((kx (plist-get status :key-exchange))
+         (dhe-p (string-match "^\\bDHE\\b" kx))
+         (prime-bits (plist-get status :diffie-hellman-prime-bits))
+         msg)
+    (when dhe-p
+      (if (and (>= (nsm-level network-security-level) (nsm-level 'medium))
+               (< prime-bits 1024))
+          (setq msg (format-message
+                     "Diffie-Hellman prime bits (%s) too low (%s)"
+                     prime-bits gnutls-min-prime-bits)))
+      (if (>= (nsm-level network-security-level) (nsm-level 'high))
+          (setq msg (concat
+                     msg
+                     (format-message
+                      "non-elliptic-curve ephemeral Diffie-Hellman key exchange method (%s) maybe using an unsafe prime"
+                      kx))))
+      msg)))
+
+(defun nsm-protocol-check--anon-kx (host port status)
+  "Check for anonymous key exchange.
+
+Anonymouse key exchange exposes the connection to MITM 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))))
+
+(defun nsm-protocol-check--export-kx (host port status)
+  "Check for EXPORT key exchange.
+
+EXPORT cipher suites are a family of 40-bit effective security
+algorithms legally exportable by the United States in the early 90s.
+They can be broken in seconds on 2018 hardware.
+
+Recent version of GnuTLS does not enable this key exchange by default,
+but can be enabled if requested.  This check is mainly provided to
+secure Emacs built with older version of GnuTLS.
+
+Reference:
+
+Schneier, Bruce (1996). Applied Cryptography (Second ed.). John Wiley
+& Sons. ISBN 0-471-11709-9."
+  (let ((kx (plist-get status :key-exchange)))
+    (and (string-match "\\bEXPORT\\b" kx)
+         (format-message
+          "EXPORT level key exchange method (%s) is insecure"
+          kx))))
+
+;; Cipher checks
+
+(defun nsm-protocol-check--cbc-cipher (host port status)
+  "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].
+
+Reference:
+
+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/'"
+  (let ((cipher (plist-get status :cipher)))
+    (and (string-match "\\bCBC\\b" cipher)
+         (format-message
+          "CBC mode cipher (%s) can be insecure"
+          cipher))))
+
+(defun nsm-protocol-check--ecdsa-cbc-cipher (host port status)
+  "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 still 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].
+
+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'"
+  (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-protocol-check--3des-cipher (host port status)
+  "Check for 3DES ciphers.
+
+3DES is considered a weak cipher by NIST as it only has 80 bits
+of security.
+
+Reference:
+
+Barker, Elaine (Jan 2016). \"NIST Special Publication 800-57:
+Recommendation for Key Management Part 1: General\" (4 ed.),
+`https://nvlpubs.nist.gov/nistpubs/SpecialPublications/NIST.SP.800-57pt1r4.pdf'
+"
+  (let ((cipher (plist-get status :cipher)))
+    (and (string-match "\\b3DES\\b" cipher)
+         (format-message
+          "3DES cipher (%s) is insecure"
+          cipher))))
+
+(defun nsm-protocol-check--des-cipher (host port status)
+  "Check for DES ciphers.
+
+Using dedicated hardware costing less than $10k, a DES key used to
+encrypt a message can be brute-forced in a matter of days.  RFC
+5469[1] suggests TLS libraries should not enable this algorithm.
+
+Recent version of GnuTLS does not enable this cipher by default, but
+can be enabled if requested.  This check is mainly provided to secure
+Emacs built with older version of GnuTLS.
+
+Reference:
+
+[1]: P. Eronen, Ed (2009). \"DES and IDEA Cipher Suites for Transport
+Layer Security (TLS)\", `https://tools.ietf.org/html/rfc5469'"
+  (let ((cipher (plist-get status :cipher)))
+    (and (string-match "\\bDES\\b" cipher)
+         (format-message
+          "DES cipher (%s) is insecure"
+          cipher))))
+
+(defun nsm-protocol-check--rc4-cipher (host port status)
+  "Check for RC4 ciphers.
+
+RC4 cipher has been prohibited by RFC 7465.
+
+Recent version of GnuTLS does not enable this cipher by default, but
+can be enabled if requested.  This check is mainly provided to secure
+Emacs built with older version of GnuTLS.
+
+Reference:
+
+Popov A (Feb 2015). \"Prohibiting RC4 Cipher Suites\",
+`https://tools.ietf.org/html/rfc7465'"
+  (let ((cipher (plist-get status :cipher)))
+    (and (string-match "\\bARCFOUR\\b" cipher)
+         (format-message
+          "RC4 cipher (%s) is insecure"
+          cipher))))
+
+(defun nsm-protocol-check--rc2-cipher (host port status)
+  "Check for RC2 ciphers.
+
+\"RC2 can be broken with one related-key query and about 2^34 chosen
+plaintexts\", which is a matter of seconds on 2018 hardware.
+
+Recent version of GnuTLS does not enable this cipher by default, but
+can be enabled if requested.  This check is mainly provided to secure
+Emacs built with older version of GnuTLS.
+
+Reference:
+
+Kelsey, Schneier, Wagner (1997). \"Related-Key Cryptanalysis of 3-WAY,
+Biham-DES,CAST, DES-X, NewDES, RC2, and TEA\",
+`https://www.schneier.com/academic/paperfiles/paper-relatedkey.pdf'"
+  (let ((cipher (plist-get status :cipher)))
+    (and (string-match "\\bRC2\\b" cipher)
+         (format-message
+          "RC2 cipher (%s) is insecure"
+          cipher))))
+
+(defun nsm-protocol-check--null-cipher (host port status)
+  "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 make up the TLS protocol."
+  (let ((suite (format "%s-%s-%s"
+                       (plist-get status :key-exchange)
+	               (plist-get status :cipher)
+	               (plist-get status :mac))))
+    (and (string-match "\\bNULL\\b" suite)
+         (format-message
+          "NULL cipher suite (%s) violates authenticity, integrity, or confidentiality guarantees"
+          suite))))
+
+;; Signature checks
+
+(defun nsm-protocol-check--sha1-sig (host port status)
+  "Check for SHA1 signatures on certificates.
+
+The first SHA1 collision was found in 2017[1], as a precaution against
+events followed the discovery of cheap collisions in MD5, major
+browsers[2][3][4] have sunsetted 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 -- SHA1 isn't dangerous
-           ;; there.
-           when (and (not (equal (plist-get certificate :issuer)
+           ;; 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)
-                     (not (nsm-query
-                           host port status :signature-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 _)
+                     (string-match "\\bSHA1\\b" algo))
+           return (format-message
+                   "SHA1 signature (%s) is prone to collisions"
+                   algo)
+           end))
+
+(defun nsm-protocol-check--md5-sig (host port status)
+  "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 has recommended against the usage of MD5 for digital
+signatures, which includes TLS certificate signatures.
+
+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 -- root is always trusted.
+           if (and (not (equal (plist-get certificate :issuer)
+                               (plist-get certificate :subject)))
+                   (string-match "\\bMD51\\b" algo))
+           return (format-message
+                   "MD5 signature (%s) is very prone to collisions"
+                   algo)
+           end))
+
+;; Protocol level checks
+
+(defun nsm-protocol-check--ssl (host port status)
+  "Check for SSL protocol version.
+
+This function guard against usage of SSL3.0, which has been deprecated
+by RFC7568.
+
+Reference:
+
+IETF (2015). \"Deprecating Secure Sockets Layer Version 3.0\",
+`https://tools.ietf.org/html/rfc7568'"
   (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
+         (string-match "SSL" protocol)
+         (format-message
+	  " %s protocol is deprecated"
+	  protocol))))
+
+\f
 
 (defun nsm-fingerprint (status)
   (plist-get (plist-get status :certificate) :public-key-id))
@@ -293,10 +585,11 @@ nsm-fingerprint-ok-p
 	      (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)))))
+                     (format-message
+		      "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
@@ -308,9 +601,10 @@ nsm-fingerprint-ok-p
 (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)))
+   (format-message
+    "The fingerprint for the connection to %s:%s is new: %s"
+    host port
+    (nsm-fingerprint status))))
 
 (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
@@ -322,22 +616,24 @@ nsm-check-plain-connection
 	 (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)))
+           (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
-	       "The connection to %s:%s is unencrypted."
-	       host port)))
+               (format-message
+	        "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)
+(defun nsm-query (host port status what message)
   ;; If there is no user to answer queries, then say `no' to everything.
   (if (or noninteractive
 	  nsm-noninteractive)
@@ -346,7 +642,7 @@ nsm-query
 	   (condition-case nil
                (intern
                 (car (split-string
-                      (nsm-query-user message args
+                      (nsm-query-user message
                                       (nsm-format-certificate status))))
                 obarray)
 	     ;; Make sure we manage to close the process if the user hits
@@ -364,7 +660,7 @@ nsm-query
 	(nsm-save-host host port status what response)
 	t))))
 
-(defun nsm-query-user (message args cert)
+(defun nsm-query-user (message cert)
   (let ((buffer (get-buffer-create "*Network Security Manager*")))
     (save-window-excursion
       ;; First format the certificate and warnings.
@@ -374,7 +670,7 @@ nsm-query-user
           (when (> (length cert) 0)
             (insert cert "\n"))
           (let ((start (point)))
-            (insert (apply #'format-message message args))
+            (insert message)
             (goto-char start)
             ;; Fill the first line of the message, which usually
             ;; contains lots of explanatory text.
@@ -391,32 +687,33 @@ nsm-query-user
 
 (defun nsm-save-host (host port status what permanency)
   (let* ((id (nsm-id host port))
+         (what (if (listp what) what (list what)))
 	 (saved
 	  (list :id id
 		:fingerprint (or (nsm-fingerprint status)
 				 ;; Plain connection.
 				 :none))))
-    (when (or (eq what 'conditions)
+    (when (or (memq 'conditions what)
 	      nsm-save-host-names)
       (nconc saved (list :host (format "%s:%s" host port))))
     ;; We either want to save/update the fingerprint or the conditions
     ;; of the certificate/unencrypted connection.
     (cond
-     ((eq what 'conditions)
+     ((memq 'conditions what)
       (cond
        ((not status)
 	(nconc saved '(:conditions (:unencrypted))))
        ((plist-get status :warnings)
 	(nconc saved
 	       (list :conditions (plist-get status :warnings))))))
-     ((not (eq what 'fingerprint))
+     ((not (memq 'fingerprint what))
       ;; 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)))))))
+	    (nconc (plist-get saved :conditions) what)
+	  (nconc saved (list :conditions what))))))
     (if (eq permanency 'always)
 	(progn
 	  (nsm-remove-temporary-setting id)
-- 
2.18.0