(nsm-check-protocol): Check for weak Diffie-Hellman prime bits.

Fixes: debbugs:19153

2 files changed, 39 insertions, 3 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index d40b56f71e0..b9903ac2fd4 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -3,6 +3,8 @@
         * net/nsm.el (network-security-level): Remove the detailed
         description, which was already outdated, and refer the users to
         the manual.
+        (nsm-check-protocol): Check for weak Diffie-Hellman prime bits
+        (bug#19153).
 
 2014-12-06  Andrey Kotlarski  <m00naticus@gmail.com>
 
diff --git a/lisp/net/nsm.el b/lisp/net/nsm.el
index 5bc32b4f081..659f96922c5 100644
--- a/lisp/net/nsm.el
+++ b/lisp/net/nsm.el
@@ -115,6 +115,14 @@ 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)))
+
+(defun nsm-check-certificate (process host port status settings)
   (let ((warnings (plist-get status :warnings)))
     (cond
 
@@ -168,6 +176,23 @@ unencrypted."
               nil)
           process))))))
 
+(defun nsm-check-protocol (process host port status settings)
+  (let ((prime-bits (plist-get status :diffie-hellman-prime-bits)))
+    (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\n%s:%s\nis less than what is considerer safe (%s)."
+             prime-bits host port 1024)))
+      (delete-process process)
+      nil)
+     (t
+      process))))
+
 (defun nsm-fingerprint (status)
   (plist-get (plist-get status :certificate) :public-key-id))
 
@@ -284,14 +309,23 @@ unencrypted."
       (nconc saved (list :host (format "%s:%s" host port))))
     ;; We either want to save/update the fingerprint or the conditions
     ;; of the certificate/unencrypted connection.
-    (when (eq what 'conditions)
+    (cond
+     ((eq what 'conditions)
       (nconc saved (list :host (format "%s:%s" host port)))
       (cond
        ((not status)
-        (nconc saved `(:conditions (:unencrypted))))
+        (nconc saved '(:conditions (:unencrypted))))
        ((plist-get status :warnings)
         (nconc saved
-               `(:conditions ,(plist-get status :warnings))))))
+               (list :conditions (plist-get status :warnings))))))
+     ((not (eq what 'fingerprint))
+      ;; Store additional protocol settings.
+      (let ((settings (nsm-host-settings id)))
+        (when settings
+          (setq saved settings))
+        (if (plist-get saved :conditions)
+            (nconc (plist-get saved :conditions) (list what))
+          (nconc saved (list :conditions (list what)))))))
     (if (eq permanency 'always)
         (progn
           (nsm-remove-temporary-setting id)