From 6587993f682544fa2314a0d41101274a1c004ab5 Mon Sep 17 00:00:00 2001
From: Robert Pluim <rpluim@gmail.com>
Date: Thu, 13 Jul 2017 15:06:07 +0200
Subject: [PATCH] Check for SSL, TLS1.0 and TLS1.1 and warn user

* lisp/net/nsm.el (nsm-check-tls-connection): Check protocol
 parameters at the default `medium' security level
 (nsm-check-for-deprecated-protocols): New function. Abstract
 protocol version checks out of nsm-check-protocols and check for
 TLS1.0 and TLS1.1
 (nsm-check-protocol): Use it
* etc/NEWS (libraries): Document the change in tls connection
  behaviour
---
 etc/NEWS        |  7 +++++++
 lisp/net/nsm.el | 40 +++++++++++++++++++++++++++-------------
 2 files changed, 34 insertions(+), 13 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index a00760c2f8..1880847048 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -459,6 +459,13 @@ Linum mode and all similar packages are henceforth becoming obsolete.
 Users and developers are encouraged to switch to this new feature
 instead.
 
+** Network connections which use ssl, tls1.0 or tls1.1 will now be
+warned about by the network security manager. The user will be
+prompted to allow/disallow the connection on a per-connection/per-host
+basis.  These 3 protocols have myriad proven exploits against them and
+should be avoided whenever possible.  Set network-security-level to
+'low' to disable these new checks.
+
 
 * Editing Changes in Emacs 26.1
 
diff --git a/lisp/net/nsm.el b/lisp/net/nsm.el
index 8d3463ef0a..03670957a5 100644
--- a/lisp/net/nsm.el
+++ b/lisp/net/nsm.el
@@ -120,8 +120,8 @@ nsm-verify-connection
 (defun nsm-check-tls-connection (process host port status settings)
   (let ((process (nsm-check-certificate process host port status settings)))
     (if (and process
-	     (>= (nsm-level network-security-level) (nsm-level 'high)))
-	;; Do further protocol-level checks if the security is high.
+	     (>= (nsm-level network-security-level) (nsm-level 'medium)))
+	;; Do further protocol-level checks if the security is medium.
 	(nsm-check-protocol process host port status settings)
       process)))
 
@@ -199,7 +199,7 @@ nsm-check-protocol
 	   (not
 	    (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)."
+	     "The Diffie-Hellman prime bits (%s) used for this connection to %s:%s is less than what is considered safe (%s). Accept at your own risk."
 	     prime-bits host port 1024)))
       (delete-process process)
       nil)
@@ -208,7 +208,7 @@ nsm-check-protocol
 	   (not
 	    (nsm-query
 	     host port status :rc4
-	     "The connection to %s:%s uses the RC4 algorithm (%s), which is believed to be unsafe."
+	     "The connection to %s:%s uses the RC4 algorithm (%s), which is unsafe. Accept at your own risk."
 	     host port encryption)))
       (delete-process process)
       nil)
@@ -217,23 +217,37 @@ nsm-check-protocol
 	   (not
 	    (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."
+	     "The certificate used to verify the connection to %s:%s uses the SHA1 algorithm (%s), which is unsafe. Accept at your own risk."
 	     host port signature-algorithm)))
       (delete-process process)
       nil)
-     ((and protocol
-	   (string-match "SSL" protocol)
-	   (not (memq :ssl (plist-get settings :conditions)))
-	   (not
-	    (nsm-query
-	     host port status :ssl
-	     "The connection to %s:%s uses the %s protocol, which is believed to be unsafe."
-	     host port protocol)))
+     ((let ((what (nsm-check-for-deprecated-protocols protocol settings)))
+        (and protocol
+             what
+	     (not
+	      (nsm-query
+	       host port status what
+	       "The connection to %s:%s uses the %s protocol, which is unsafe. Accept at your own risk."
+	       host port protocol))))
       (delete-process process)
       nil)
      (t
       process))))
 
+(defun nsm-check-for-deprecated-protocols (protocol settings)
+  (cond
+   ((and (string-match "SSL" protocol)
+         (not (memq :ssl (plist-get settings :conditions))))
+    :ssl)
+   ((and (string-equal "TLS1.0" protocol)
+         (not (memq :tls1.0 (plist-get settings :conditions))))
+    :tls1.0)
+   ((and (string-equal "TLS1.1" protocol)
+         (not (memq :tls1.1 (plist-get settings :conditions))))
+    :tls1.1)
+   (t
+    nil)))
+
 (defun nsm-fingerprint (status)
   (plist-get (plist-get status :certificate) :public-key-id))
 
-- 
2.13.0.rc0