[Emacs-diffs] master 6584bc6: Refactor the protocol NSM checks for flexibility

[Lars Ingebrigtsen]

branch: master
commit 6584bc6720fce6a830ab18538f89acc80da597f1
Author: Lars Ingebrigtsen <address@hidden>
Commit: Lars Ingebrigtsen <address@hidden>

    Refactor the protocol NSM checks for flexibility
    
    * doc/emacs/misc.texi (Network Security): Mention
    network-security-protocol-checks.
    
    * lisp/net/nsm.el (network-security-protocol-checks): New variable.
    (nsm-check-protocol): Refactor the checks into separate functions
    for greater flexibility.
    (nsm-protocol-check--diffie-hellman-prime-bits)
    (nsm-protocol-check--rc4, nsm-protocol-check--ssl)
    (nsm-protocol-check--signature-sha1): Refactored out of the big
    function.
---
 doc/emacs/misc.texi |  16 +++++++
 etc/NEWS            |   5 ++
 lisp/net/nsm.el     | 133 ++++++++++++++++++++++++++++++----------------------
 3 files changed, 98 insertions(+), 56 deletions(-)

diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi
index 24586eb..177cc8f 100644
--- a/doc/emacs/misc.texi
+++ b/doc/emacs/misc.texi
@@ -402,6 +402,22 @@ This means that one can't casually read the settings file 
to see what
 servers the user has connected to.  If this variable is @code{t},
 @acronym{NSM} will also save host names in the
 @code{nsm-settings-file}.
+
address@hidden network-security-protocol-checks
address@hidden network-security-protocol-checks
+The protocol network checks (mostly for @acronym{TLS} weaknesses) is
+controlled via the @code{network-security-protocol-checks} variable.
+
+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 @code{(rc4 medium)} will result in the function
address@hidden being called like thus:
address@hidden(nsm-protocol-check--rc4 host port status optional-parameter)}.
+The function should return address@hidden if the connection should
+proceed and @code{nil} otherwise.
+
 @end table
 
 
diff --git a/etc/NEWS b/etc/NEWS
index 12757f6..8ee4831 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -131,6 +131,11 @@ used to remove comments before calling the libxml 
functions to parse
 the data.
 
 +++
+** The Network Security Manager now allows more fine-grained control
+of what checks to run via the `network-security-protocol-checks'
+variable.
+
++++
 ** New function 'fill-polish-nobreak-p', to be used in 
'fill-nobreak-predicate'.
 It blocks line breaking after a one-letter word, also in the case when
 this word is preceded by a non-space, but non-alphanumeric character.
diff --git a/lisp/net/nsm.el b/lisp/net/nsm.el
index d6fe967..8f09e8d 100644
--- a/lisp/net/nsm.el
+++ b/lisp/net/nsm.el
@@ -26,6 +26,7 @@
 
 (require 'cl-lib)
 (require 'rmc)                       ; read-multiple-choice
+(require 'subr-x)
 
 (defvar nsm-permanent-host-settings nil)
 (defvar nsm-temporary-host-settings nil)
@@ -118,12 +119,10 @@ unencrypted."
          process))))))
 
 (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-check-protocol process host port status settings)
-      process)))
+  (when-let ((process
+              (nsm-check-certificate process host port status settings)))
+    ;; Do further protocol-level checks.
+    (nsm-check-protocol process host port status settings)))
 
 (declare-function gnutls-peer-status-warning-describe "gnutls.c"
                  (status-symbol))
@@ -182,57 +181,79 @@ unencrypted."
              nil)
          process))))))
 
+(defvar network-security-protocol-checks
+  '((diffie-hellman-prime-bits high 1024)
+    (rc4 high)
+    (signature-sha1 high)
+    (ssl high))
+  "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)
-  (let ((prime-bits (plist-get status :diffie-hellman-prime-bits))
-        (signature-algorithm
-         (plist-get (plist-get status :certificate) :signature-algorithm))
-        (encryption (format "%s-%s-%s"
-                           (plist-get status :key-exchange)
-                           (plist-get status :cipher)
-                           (plist-get status :mac)))
-       (protocol (plist-get status :protocol)))
-    (cond
-     ((and prime-bits
-          (< prime-bits 1024)
-          (not (memq :diffie-hellman-prime-bits
-                     (plist-get settings :conditions)))
-          (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)."
-            prime-bits host port 1024)))
-      (delete-process process)
-      nil)
-     ((and (string-match "\\bRC4\\b" encryption)
-          (not (memq :rc4 (plist-get settings :conditions)))
-          (not
-           (nsm-query
-            host port status :rc4
-            "The connection to %s:%s uses the RC4 algorithm (%s), which is 
believed to be unsafe."
-            host port encryption)))
-      (delete-process process)
-      nil)
-     ((and (string-match "\\bSHA1\\b" signature-algorithm)
-          (not (memq :signature-sha1 (plist-get settings :conditions)))
-          (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."
-            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)))
-      (delete-process process)
-      nil)
-     (t
-      process))))
+  (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--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--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--ssl (host port status _)
+  (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))))
 
 (defun nsm-fingerprint (status)
   (plist-get (plist-get status :certificate) :public-key-id))