[Emacs-diffs] nsm 02/02: (nsm-check-tls-connection): Make `high' do certificate pinning

[Lars Ingebrigtsen]

branch: nsm
commit a62ad1e2b878ed887022a48e532348f53363b7bc
Author: Lars Magne Ingebrigtsen <address@hidden>
Date:   Tue Nov 18 23:52:46 2014 +0100

    (nsm-check-tls-connection): Make `high' do certificate pinning
    
    (nsm-check-tls-connection): Make `high' do certificate pinning,
    and `paranoid' query for every new host.
    (nsm-level): New function.
---
 lisp/ChangeLog  |    3 ++
 lisp/net/nsm.el |   57 +++++++++++++++++++++++++++++++++++++++++-------------
 2 files changed, 46 insertions(+), 14 deletions(-)

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 48400fb..5e761f6 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -8,6 +8,9 @@
        database.
        (nsm-format-certificate): Format certificate prettier.  Format
        suggested by Toke Høiland-Jørgensen <address@hidden>.
+       (nsm-check-tls-connection): Make `high' do certificate pinning,
+       and `paranoid' query for every new host.
+       (nsm-level): New function.
 
        * mail/smtpmail.el (smtpmail-via-smtp): Warn unless encrypted if
        we're sending a password.
diff --git a/lisp/net/nsm.el b/lisp/net/nsm.el
index 9ac15fd..4086f3f 100644
--- a/lisp/net/nsm.el
+++ b/lisp/net/nsm.el
@@ -99,19 +99,34 @@ unencrypted."
 (defun nsm-check-tls-connection (process host port status settings)
   (let ((warnings (plist-get status :warnings)))
     (cond
+
+     ;; The certificate validated, but perhaps we want to do
+     ;; certificate pinning.
      ((null warnings)
-      ;; The certificate is fine, but if we're paranoid, we might
-      ;; want to check whether it's changed anyway.
-      (if (not (equal nsm-security-level 'paranoid))
-         process
-       (if (not (nsm-fingerprint-ok-p host port status settings))
-           (progn
-             (delete-process process)
-             nil)
-         ;; Save the host fingerprint so that we can check it the
-         ;; next time we connect.
-         (nsm-save-host host port status 'fingerprint 'always)
-         process)))
+      (cond
+       ((< (nsm-level nsm-security-level) (nsm-level 'high))
+       process)
+       ;; The certificate is fine, but if we're paranoid, we might
+       ;; want to check whether it's changed anyway.
+       ((and (>= (nsm-level nsm-security-level) (nsm-level 'high))
+            (not (nsm-fingerprint-ok-p host port status settings)))
+       (delete-process process)
+       nil)
+       ;; We haven't seen this before, and we're paranoid.
+       ((and (eq nsm-security-level 'paranoid)
+            (null settings)
+            (not (nsm-new-fingerprint-ok-p host port status)))
+       (delete-process process)
+       nil)
+       ((>= (nsm-level nsm-security-level) (nsm-level 'high))
+       ;; Save the host fingerprint so that we can check it the
+       ;; next time we connect.
+       (nsm-save-host host port status 'fingerprint 'always)
+       process)
+       (t
+       process)))
+
+     ;; The certificate did not validate.
      ((not (equal nsm-security-level 'low))
       ;; We always want to pin the certificate of invalid connections
       ;; to track man-in-the-middle or the like.
@@ -148,6 +163,13 @@ unencrypted."
       nil
     t))
 
+(defun nsm-new-fingerprint-ok-p (host port status)
+  (nsm-query
+   host port nil 'fingerprint
+   "The fingerprint for the connection to %s:%s is new:\n%s"
+   host port
+   (plist-get status :fingerprint)))
+
 (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
   ;; possible that we're being Man-In-The-Middled by a proxy that's
@@ -175,8 +197,7 @@ unencrypted."
 
 (defun nsm-query (host port status what message &rest args)
   ;; If there is no user to answer queries, then say `no' to everything.
-  (if (or noninteractive
-         running-asynch-code)
+  (if noninteractive
       nil
     (let ((response
           (condition-case nil
@@ -354,6 +375,14 @@ unencrypted."
             elem)))
        (nreverse result)))))
 
+(defun nsm-level (symbol)
+  "Return a numerical level for SYMBOL for easier comparison."
+  (cond
+   ((eq symbol 'low) 0)
+   ((eq symbol 'medium) 1)
+   ((eq symbol 'high) 2)
+   (t 3)))
+
 (provide 'nsm)
 
 ;;; nsm.el ends here