X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/6b1ab80ef9b65c08e53edc7fa8ec4418da296ca7..7e09ef09a479731d01b1ca46e94ddadd73ac98e3:/lisp/net/nsm.el diff --git a/lisp/net/nsm.el b/lisp/net/nsm.el index 5bc32b4f08..2312e22d96 100644 --- a/lisp/net/nsm.el +++ b/lisp/net/nsm.el @@ -1,6 +1,6 @@ ;;; nsm.el --- Network Security Manager -;; Copyright (C) 2014 Free Software Foundation, Inc. +;; Copyright (C) 2014-2015 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: encryption, security, network @@ -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 @@ -156,7 +164,7 @@ unencrypted." (if (and (not (nsm-warnings-ok-p status settings)) (not (nsm-query host port status 'conditions - "The TLS connection to %s:%s is insecure\nfor the following reason%s:\n\n%s" + "The TLS connection to %s:%s is insecure for the following reason%s:\n\n%s" host port (if (> (length warnings) 1) "s" "") @@ -168,6 +176,47 @@ unencrypted." nil) process)))))) +(defun nsm-check-protocol (process host port status settings) + (let ((prime-bits (plist-get status :diffie-hellman-prime-bits)) + (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 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)))) + (defun nsm-fingerprint (status) (plist-get (plist-get status :certificate) :public-key-id)) @@ -181,7 +230,7 @@ unencrypted." (setq did-query (nsm-query host port status 'fingerprint - "The fingerprint for the connection to %s:%s has changed from\n%s to\n%s" + "The fingerprint for the connection to %s:%s has changed from %s to %s" host port (plist-get settings :fingerprint) (nsm-fingerprint status))))) @@ -196,7 +245,7 @@ unencrypted." (defun nsm-new-fingerprint-ok-p (host port status) (nsm-query host port status 'fingerprint - "The fingerprint for the connection to %s:%s is new:\n%s" + "The fingerprint for the connection to %s:%s is new: %s" host port (nsm-fingerprint status))) @@ -210,7 +259,7 @@ unencrypted." (not (nsm-query host port nil 'conditions - "The connection to %s:%s used to be an encrypted\nconnection, but is now unencrypted. This might mean that there's a\nman-in-the-middle tapping this connection." + "The connection to %s:%s used to be an encrypted connection, but is now unencrypted. This might mean that there's a man-in-the-middle tapping this connection." host port))) (delete-process process) nil) @@ -249,7 +298,12 @@ unencrypted." (erase-buffer) (when (> (length cert) 0) (insert cert "\n")) - (insert (apply 'format message args)))) + (let ((start (point))) + (insert (apply 'format message args)) + (goto-char start) + ;; Fill the first line of the message, which usually + ;; contains lots of explanatory text. + (fill-region (point) (line-end-position))))) (let ((responses '((?n . no) (?s . session) (?a . always))) @@ -284,14 +338,22 @@ 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) - (nconc saved (list :host (format "%s:%s" host port))) + (cond + ((eq what 'conditions) (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) @@ -373,6 +435,15 @@ unencrypted." (insert "Public key:" (plist-get cert :public-key-algorithm) ", signature: " (plist-get cert :signature-algorithm) "\n")) + (when (and (plist-get status :key-exchange) + (plist-get status :cipher) + (plist-get status :mac) + (plist-get status :protocol)) + (insert + "Protocol:" (plist-get status :protocol) + ", key: " (plist-get status :key-exchange) + ", cipher: " (plist-get status :cipher) + ", mac: " (plist-get status :mac) "\n")) (when (plist-get cert :certificate-security-level) (insert "Security level:"