Add option to bypass NSM TLS checks on local networks

* lisp/net/net-utils.el (nslookup-host-ipv4, nslookup-host-ipv6,
  ipv6-expand): New functions to lookup IPv4 and IPv6 addresses from
  DNS.

* lisp/net/nsm.el (nsm-trust-local-network, nsm-should-check,
  nsm-check-tls-connection, nsm-check-plain-connection): New defcustom
  `nsm-trust-local-network' lets users customize whether NSM should
  check for TLS problems when connecting to the hosts on their local
  networks.  `nsm-should-check' determines whether
  `nsm-check-tls-connection' and `nsm-check-plain-connection' should
  perform checks.  localhost is implicitly trusted, thus checks are
  never performed there.

2 files changed, 148 insertions, 3 deletions

diff --git a/lisp/net/net-utils.el b/lisp/net/net-utils.el
index c9e80804bd3..0ba4aae0ae0 100644
--- a/lisp/net/net-utils.el
+++ b/lisp/net/net-utils.el
@@ -43,6 +43,10 @@
 ;; still use them for queries).  Actually the trend these
 ;; days is for /sbin to be a symlink to /usr/sbin, but we still need to
 ;; search both for older systems.
+
+(require 'subr-x)
+(require 'cl-lib)
+
 (defun net-utils--executable-find-sbin (command)
   "Return absolute name of COMMAND if found in an sbin directory."
   (let ((exec-path '("/sbin" "/usr/sbin" "/usr/local/sbin")))
@@ -514,7 +518,11 @@ Optional argument NAME-SERVER says which server to use for
 DNS resolution.
 Interactively, prompt for NAME-SERVER if invoked with prefix argument.
 
-This command uses `nslookup-program' for looking up the DNS information."
+This command uses `nslookup-program' for looking up the DNS information.
+
+See also: `nslookup-host-ipv4', `nslookup-host-ipv6' for
+non-interactive versions of this function more suitable for use
+in Lisp code."
   (interactive
    (list (read-from-minibuffer "Lookup host: " (net-utils-machine-at-point))
          (if current-prefix-arg (read-from-minibuffer "Name server: "))))
@@ -531,6 +539,71 @@ This command uses `nslookup-program' for looking up the DNS information."
      options)))
 
 ;;;###autoload
+(defun nslookup-host-ipv4 (host &optional name-server format)
+  "Return the IPv4 address for HOST (name or IP address).
+Optional argument NAME-SERVER says which server to use for DNS
+resolution.
+
+If FORMAT is `string', returns the IP address as a
+string (default).  If FORMAT is `vector', returns a 4-integer
+vector of octets.
+
+This command uses `nslookup-program' to look up DNS records."
+  (let* ((args `(,nslookup-program "-type=A" ,host ,name-server))
+         (output (shell-command-to-string
+                  (string-join (cl-remove nil args) " ")))
+         (ip (or (and (string-match
+                       "Name:.*\nAddress: *\\(\\([0-9]\\{1,3\\}\\.?\\)\\{4\\}\\)"
+                       output)
+                      (match-string 1 output))
+                 host)))
+    (cond ((memq format '(string nil))
+           ip)
+          ((eq format 'vector)
+           (apply #'vector (mapcar #'string-to-number (split-string ip "\\."))))
+          (t (error "Invalid format: %s" format)))))
+
+(defun ipv6-expand (ipv6-vector)
+  (let ((len (length ipv6-vector)))
+    (if (< len 8)
+        (let* ((pivot (cl-position 0 ipv6-vector))
+               (head (cl-subseq ipv6-vector 0 pivot))
+               (tail (cl-subseq ipv6-vector (1+ pivot) len)))
+          (vconcat head (make-vector (- 8 (1- len)) 0) tail))
+      ipv6-vector)))
+
+;;;###autoload
+(defun nslookup-host-ipv6 (host &optional name-server format)
+  "Return the IPv6 address for HOST (name or IP address).
+Optional argument NAME-SERVER says which server to use for DNS
+resolution.
+
+If FORMAT is `string', returns the IP address as a
+string (default).  If FORMAT is `vector', returns a 8-integer
+vector of hextets.
+
+This command uses `nslookup-program' to look up DNS records."
+  (let* ((args `(,nslookup-program "-type=AAAA" ,host ,name-server))
+         (output (shell-command-to-string
+                  (string-join (cl-remove nil args) " ")))
+         (hextet "[0-9a-fA-F]\\{1,4\\}")
+         (ip-regex (concat "\\(\\(" hextet "[:]\\)\\{1,6\\}\\([:]?\\(" hextet "\\)\\{1,6\\}\\)\\)"))
+         (ip (or (and (string-match
+                       (if (eq system-type 'windows-nt)
+                           (concat "Name:.*\nAddress: *" ip-regex)
+                         (concat "has AAAA address " ip-regex))
+                       output)
+                      (match-string 1 output))
+                 host)))
+    (cond ((memq format '(string nil))
+           ip)
+          ((eq format 'vector)
+           (ipv6-expand (apply #'vector
+                               (cl-loop for hextet in (split-string ip "[:]")
+                                        collect (string-to-number hextet 16)))))
+          (t (error "Invalid format: %s" format)))))
+
+;;;###autoload
 (defun nslookup ()
   "Run `nslookup-program'."
   (interactive)
diff --git a/lisp/net/nsm.el b/lisp/net/nsm.el
index 50895bc0ad9..e4c52bc9c1c 100644
--- a/lisp/net/nsm.el
+++ b/lisp/net/nsm.el
@@ -62,6 +62,26 @@ checked and warned against."
 (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)
   "The file the security manager settings will be stored in."
@@ -184,6 +204,55 @@ 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-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, a machine address, a direct
+link or a private network address, this function returns
+nil.  Non-nil otherwise."
+  (let* ((address (or (nslookup-host-ipv4 host nil 'vector)
+                      (nslookup-host-ipv6 host nil 'vector)))
+         (ipv4? (eq (length address) 4)))
+    (not
+     (or (if ipv4?
+             (or
+              ;; (0.x.x.x) this machine
+              (eq (aref address 0) 0)
+              ;; (127.x.x.x) localhost
+              (eq (aref address 0) 0))
+           (or
+            ;; (::) IPv6 this machine
+            (not (cl-mismatch address [0 0 0 0 0 0 0 0]))
+            ;; (::1) IPv6 localhost
+            (not (cl-mismatch address [0 0 0 0 0 0 0 1]))))
+         (and (or (and (functionp nsm-trust-local-network)
+                       (funcall nsm-trust-local-network))
+                  nsm-trust-local-network)
+              (if ipv4?
+                  (or
+                   ;; (10.x.x.x) private
+                   (eq (aref address 0) 10)
+                   ;; (172.16.x.x) private
+                   (and (eq (aref address 0) 172)
+                        (eq (aref address 0) 16))
+                   ;; (192.168.x.x) private
+                   (and (eq (aref address 0) 192)
+                        (eq (aref address 0) 168))
+                   ;; (198.18.x.x) private
+                   (and (eq (aref address 0) 198)
+                        (eq (aref address 0) 18))
+                   ;; (169.254.x.x) link-local
+                   (and (eq (aref address 0) 169)
+                        (eq (aref address 0) 254)))
+                (memq (aref address 0)
+                      '(
+                        64512  ;; (fc00::) IPv6 unique local address
+                        64768  ;; (fd00::) IPv6 unique local address
+                        65152  ;; (fe80::) IPv6 link-local
+                        )
+                      )))))))
+
 (defun nsm-check-tls-connection (process host port status settings)
   "Check TLS connection against potential security problems.
 
@@ -204,6 +273,7 @@ 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"
@@ -234,7 +304,7 @@ See also: `nsm-tls-checks' and `nsm-noninteractive'"
                  (delete-process process)
                  (setq process nil)))
       (run-hook-with-args 'nsm-tls-post-check-functions
-                          host port status settings results))
+                          host port status settings results)))
   process)
 
 
@@ -678,6 +748,7 @@ protocol."
  'nsm-fingerprint-ok-p '(status settings) "27.1")
 
 (defun nsm-check-plain-connection (process host port settings warn-unencrypted)
+  (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.
@@ -703,7 +774,8 @@ protocol."
           (delete-process process)
           nil)
          (t
-          process))))
+          process)))
+    process))
 
 (defun nsm-query (host port status what problems message)
   ;; If there is no user to answer queries, then say `no' to everything.