X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/63ca64241c057695aa5d5a189b3de6d8ada310b8..8e07ea1a05e801e52061e880aa36b7cec5895f5a:/lisp/net/nsm.el diff --git a/lisp/net/nsm.el b/lisp/net/nsm.el index daf4bf5dc6..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 @@ -34,7 +34,7 @@ :version "25.1" :group 'comm) -(defcustom network-security-level 'low +(defcustom network-security-level 'medium "How secure the network should be. If a potential problem with the security of the network connection is found, the user is asked to give input into how the @@ -43,22 +43,13 @@ connection should be handled. The following values are possible: `low': Absolutely no checks are performed. +`medium': This is the default level, should be reasonable for most usage. +`high': This warns about additional things that many people would +not find useful. +`paranoid': On this level, the user is queried for most new connections. -`medium': This is the default level, and the following things will -be prompted for. - -* invalid, self-signed or otherwise unverifiable certificates -* whether a previously accepted unverifiable certificate has changed -* when a connection that was previously protected by STARTTLS is - now unencrypted - -`high': In addition to the above. - -* any certificate that changes its public key - -`paranoid': In addition to the above. - -* any new certificate that you haven't seen before" +See the Emacs manual for a description of all things that are +checked and warned against." :version "25.1" :group 'nsm :type '(choice (const :tag "Low" low) @@ -124,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 @@ -165,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" "") @@ -177,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)) @@ -190,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))))) @@ -204,8 +244,8 @@ unencrypted." (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 status 'fingerprint + "The fingerprint for the connection to %s:%s is new: %s" host port (nsm-fingerprint status))) @@ -219,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) @@ -258,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))) @@ -293,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) @@ -342,9 +395,12 @@ unencrypted." result)) (defun nsm-warnings-ok-p (status settings) - (null (cl-intersection - (plist-get settings :conditions) - (plist-get status :warnings)))) + (let ((ok t) + (conditions (plist-get settings :conditions))) + (dolist (warning (plist-get status :warnings)) + (unless (memq warning conditions) + (setq ok nil))) + ok)) (defun nsm-remove-permanent-setting (id) (setq nsm-permanent-host-settings @@ -379,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:"