From 6584bc6720fce6a830ab18538f89acc80da597f1 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sun, 24 Jun 2018 15:36:50 +0200 Subject: [PATCH] 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 24586eb2813..177cc8fa469 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}. + +@item network-security-protocol-checks +@vindex 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 +@code{nsm-protocol-check--rc4} being called like thus: +@code{(nsm-protocol-check--rc4 host port status optional-parameter)}. +The function should return non-@code{nil} if the connection should +proceed and @code{nil} otherwise. + @end table diff --git a/etc/NEWS b/etc/NEWS index 12757f61d20..8ee4831b6ed 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -130,6 +130,11 @@ obsolete, and the new utility function 'xml-remove-comments' can be 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 diff --git a/lisp/net/nsm.el b/lisp/net/nsm.el index d6fe967fc70..8f09e8dfa91 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)) -- 2.39.5