[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] master 02/05: Implement a Network Security Manager
|
From: |
Lars Ingebrigtsen |
|
Subject: |
[Emacs-diffs] master 02/05: Implement a Network Security Manager |
|
Date: |
Sun, 23 Nov 2014 14:14:36 +0000 |
branch: master
commit 4c298b2a73bda5ad99c1a7c2428b0db91e950820
Author: Lars Magne Ingebrigtsen <address@hidden>
Date: Sun Nov 23 14:56:43 2014 +0100
Implement a Network Security Manager
* processes.texi (Network): Mention the new :warn-unless-encrypted
parameter to `open-network-stream'.
(Network): Mention the Network Security Manager.
* net/nsm.el: New file that implements a Network Security Manager.
* net/network-stream.el (open-network-stream): Add a new
:warn-unless-encrypted parameter.
(network-stream-open-plain): Allow warning unless encrypted.
(network-stream-open-starttls): Call the Network Security Manager.
(network-stream-open-tls): Ditto.
---
doc/lispref/ChangeLog | 6 +
doc/lispref/processes.texi | 27 +++
lisp/ChangeLog | 10 +
lisp/net/network-stream.el | 17 ++-
lisp/net/nsm.el | 409 ++++++++++++++++++++++++++++++++++++++++++++
5 files changed, 468 insertions(+), 1 deletions(-)
diff --git a/doc/lispref/ChangeLog b/doc/lispref/ChangeLog
index 0c8792a..5cc85aa 100644
--- a/doc/lispref/ChangeLog
+++ b/doc/lispref/ChangeLog
@@ -1,3 +1,9 @@
+2014-11-23 Lars Magne Ingebrigtsen <address@hidden>
+
+ * processes.texi (Network): Mention the new :warn-unless-encrypted
+ parameter to `open-network-stream'.
+ (Network): Mention the Network Security Manager.
+
2014-11-21 Ulf Jasper <address@hidden>
* text.texi (Parsing HTML/XML): Document new optional parameter
diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi
index db80f05..48429e6 100644
--- a/doc/lispref/processes.texi
+++ b/doc/lispref/processes.texi
@@ -2041,6 +2041,12 @@ Regular expression matching a successful
@acronym{STARTTLS} negotiation.
If address@hidden, do opportunistic @acronym{STARTTLS} upgrades even if Emacs
doesn't have built-in @acronym{TLS} support.
address@hidden :warn-unless-encrypted @var{boolean}
+If address@hidden, and @code{:return-value} is also address@hidden,
+Emacs will warn if the connection isn't encrypted. This is useful for
+protocols like @acronym{IMAP} and the like, where most users would
+expect the network traffic to be encrypted.
+
@item :client-certificate @var{list-or-t}
Either a list of the form @code{(@var{key-file} @var{cert-file})},
naming the certificate key file and certificate file itself, or
@@ -2066,6 +2072,27 @@ The connection type: @samp{plain} or @samp{tls}.
@end defun
address@hidden Network Security Manager
+After establishing the connection, the connection is then passed on to
+the Network Security Manager (@acronym{NSM}). If the connection is a
address@hidden or @acronym{STARTTLS} connection, the @acronym{NSM} will
+check whether the certificate used to establish the identity of the
+server we're connecting to can be verified. If this can't be done,
+the @acronym{NSM} will query the user whether to proceed with the
+connection.
+
+The user is given the choice of registering a permanent security
+exception, a temporary one, or whether to refuse the connection
+entirely.
+
+If the connection is unencrypted, but it was encrypted in previous
+sessions, the user will also be notified about this.
+
address@hidden nsm-security-level
+The @code{nsm-security-level} variable determines the security level.
+If this is @code{low}, no security checks are performed.
+
+
@node Network Servers
@section Network Servers
@cindex network servers
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 43b3f9a..e503a6e 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,13 @@
+2014-11-23 Lars Magne Ingebrigtsen <address@hidden>
+
+ * net/nsm.el: New file that implements a Network Security Manager.
+
+ * net/network-stream.el (open-network-stream): Add a new
+ :warn-unless-encrypted parameter.
+ (network-stream-open-plain): Allow warning unless encrypted.
+ (network-stream-open-starttls): Call the Network Security Manager.
+ (network-stream-open-tls): Ditto.
+
2014-11-23 Leo Liu <address@hidden>
* calendar/cal-china.el (calendar-chinese-from-absolute-for-diary)
diff --git a/lisp/net/network-stream.el b/lisp/net/network-stream.el
index 28e9d0c..a1e9729 100644
--- a/lisp/net/network-stream.el
+++ b/lisp/net/network-stream.el
@@ -45,6 +45,7 @@
(require 'tls)
(require 'starttls)
(require 'auth-source)
+(require 'nsm)
(autoload 'gnutls-negotiate "gnutls")
(autoload 'open-gnutls-stream "gnutls")
@@ -128,11 +129,14 @@ values:
:use-starttls-if-possible is a boolean that says to do opportunistic
STARTTLS upgrades even if Emacs doesn't have built-in TLS functionality.
+:warn-unless-encrypted is a boolean which, if :return-list is
+non-nil, is used warn the user if the connection isn't encrypted.
+
:nogreeting is a boolean that can be used to inhibit waiting for
a greeting from the server.
:nowait is a boolean that says the connection should be made
- asynchronously, if possible."
+asynchronously, if possible."
(unless (featurep 'make-network-process)
(error "Emacs was compiled without networking support"))
(let ((type (plist-get parameters :type))
@@ -196,6 +200,8 @@ a greeting from the server.
(stream (make-network-process :name name :buffer buffer
:host host :service service
:nowait (plist-get parameters :nowait))))
+ (when (plist-get parameters :warn-unless-encrypted)
+ (setq stream (nsm-verify-connection stream host service nil t)))
(list stream
(network-stream-get-response stream start
(plist-get parameters :end-of-command))
@@ -319,6 +325,12 @@ a greeting from the server.
"' program was found"))))
(delete-process stream)
(setq stream nil))
+ ;; Check certificate validity etc.
+ (when builtin-starttls
+ (setq stream (nsm-verify-connection
+ stream host service
+ (eq resulting-type 'tls)
+ (plist-get parameters :warn-unless-encrypted))))
;; Return value:
(list stream greeting capabilities resulting-type error)))
@@ -352,6 +364,9 @@ a greeting from the server.
'open-tls-stream)
name buffer host service))
(eoc (plist-get parameters :end-of-command)))
+ ;; Check certificate validity etc.
+ (when (and use-builtin-gnutls stream)
+ (setq stream (nsm-verify-connection stream host service)))
(if (null stream)
(list nil nil nil 'plain)
;; If we're using tls.el, we have to delete the output from
diff --git a/lisp/net/nsm.el b/lisp/net/nsm.el
new file mode 100644
index 0000000..f51201a
--- /dev/null
+++ b/lisp/net/nsm.el
@@ -0,0 +1,409 @@
+;;; nsm.el --- Network Security Manager
+
+;; Copyright (C) 2014 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <address@hidden>
+;; Keywords: encryption, security, network
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'cl-lib)
+
+(defvar nsm-permanent-host-settings nil)
+(defvar nsm-temporary-host-settings nil)
+
+(defgroup nsm nil
+ "Network Security Manager"
+ :version "25.1"
+ :group 'comm)
+
+(defcustom nsm-security-level 'medium
+ "How secure the network should be."
+ :version "25.1"
+ :group 'nsm
+ :type '(choice (const :tag "Low" low)
+ (const :tag "Medium" medium)
+ (const :tag "High" high)
+ (const :tag "Paranoid" paranoid)))
+
+(defcustom nsm-settings-file (expand-file-name "network-security.data"
+ user-emacs-directory)
+ "The file the security manager settings will be stored in."
+ :version "25.1"
+ :group 'nsm
+ :type 'file)
+
+(defcustom nsm-save-host-names nil
+ "If non-nil, always save host names in the structures in `nsm-settings-file'.
+By default, only hosts that have exceptions have their names
+stored in plain text."
+ :version "25.1"
+ :group 'nsm
+ :type 'boolean)
+
+(defvar nsm-noninteractive nil
+ "If non-nil, the connection is opened in a non-interactive context.
+This means that no queries should be performed.")
+
+(defun nsm-verify-connection (process host port &optional
+ save-fingerprint warn-unencrypted)
+ "Verify the security status of PROCESS that's connected to HOST:PORT.
+If PROCESS is a gnutls connection, the certificate validity will
+be examined. If it's a non-TLS connection, it may be compared
+against previous connections. If the function determines that
+there is something odd about the connection, the user will be
+queried about what to do about it.
+
+The process it returned if everything is OK, and otherwise, the
+process will be deleted and nil is returned.
+
+If SAVE-FINGERPRINT, always save the fingerprint of the
+server (if the connection is a TLS connection). This is useful
+to keep track of the TLS status of STARTTLS servers.
+
+If WARN-UNENCRYPTED, query the user if the connection is
+unencrypted."
+ (if (eq nsm-security-level 'low)
+ process
+ (let* ((status (gnutls-peer-status process))
+ (id (nsm-id host port))
+ (settings (nsm-host-settings id)))
+ (cond
+ ((not (process-live-p process))
+ nil)
+ ((not status)
+ ;; This is a non-TLS connection.
+ (nsm-check-plain-connection process host port settings
+ warn-unencrypted))
+ (t
+ (let ((process
+ (nsm-check-tls-connection process host port status settings)))
+ (when (and process save-fingerprint
+ (null (nsm-host-settings id)))
+ (nsm-save-host host port status 'fingerprint 'always))
+ process))))))
+
+(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)
+ (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.
+ (if (not (nsm-fingerprint-ok-p host port status settings))
+ (progn
+ (delete-process process)
+ nil)
+ ;; We have a warning, so query the user.
+ (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"
+ host port
+ (if (> (length warnings) 1)
+ "s" "")
+ (mapconcat 'cadr warnings "\n"))))
+ (progn
+ (delete-process process)
+ nil)
+ process))))))
+
+(defun nsm-fingerprint (status)
+ (plist-get (plist-get status :certificate) :public-key-id))
+
+(defun nsm-fingerprint-ok-p (host port status settings)
+ (let ((did-query nil))
+ (if (and settings
+ (not (eq (plist-get settings :fingerprint) :none))
+ (not (equal (nsm-fingerprint status)
+ (plist-get settings :fingerprint)))
+ (not
+ (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"
+ host port
+ (plist-get settings :fingerprint)
+ (nsm-fingerprint status)))))
+ ;; Not OK.
+ nil
+ (when did-query
+ ;; Remove any exceptions that have been set on the previous
+ ;; certificate.
+ (plist-put settings :conditions 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
+ (nsm-fingerprint status)))
+
+(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
+ ;; stripping out STARTTLS announcements.
+ (cond
+ ((and (plist-get settings :fingerprint)
+ (not (eq (plist-get settings :fingerprint) :none))
+ (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."
+ host port)))
+ (delete-process process)
+ nil)
+ ((and warn-unencrypted
+ (not (memq :unencrypted (plist-get settings :conditions)))
+ (not (nsm-query
+ host port nil 'conditions
+ "The connection to %s:%s is unencrypted."
+ host port)))
+ (delete-process process)
+ nil)
+ (t
+ process)))
+
+(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
+ nsm-noninteractive)
+ nil
+ (let ((response
+ (condition-case nil
+ (nsm-query-user message args (nsm-format-certificate status))
+ ;; Make sure we manage to close the process if the user hits
+ ;; `C-g'.
+ (quit 'no)
+ (error 'no))))
+ (if (eq response 'no)
+ nil
+ (nsm-save-host host port status what response)
+ t))))
+
+(defun nsm-query-user (message args cert)
+ (let ((buffer (get-buffer-create "*Network Security Manager*")))
+ (with-help-window buffer
+ (with-current-buffer buffer
+ (erase-buffer)
+ (when (> (length cert) 0)
+ (insert cert "\n"))
+ (insert (apply 'format message args))))
+ (let ((responses '((?n . no)
+ (?s . session)
+ (?a . always)))
+ (prefix "")
+ response)
+ (while (not response)
+ (setq response
+ (cdr
+ (assq (downcase
+ (read-char
+ (concat prefix
+ "Continue connecting? (No, Session only,
Always)")))
+ responses)))
+ (unless response
+ (ding)
+ (setq prefix "Invalid choice. ")))
+ (kill-buffer buffer)
+ ;; If called from a callback, `read-char' will insert things
+ ;; into the pending input. Clear that.
+ (clear-this-command-keys)
+ response)))
+
+(defun nsm-save-host (host port status what permanency)
+ (let* ((id (nsm-id host port))
+ (saved
+ (list :id id
+ :fingerprint (or (nsm-fingerprint status)
+ ;; Plain connection.
+ :none))))
+ (when (or (eq what 'conditions)
+ nsm-save-host-names)
+ (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
+ ((not status)
+ (nconc saved `(:conditions (:unencrypted))))
+ ((plist-get status :warnings)
+ (nconc saved
+ `(:conditions ,(mapcar 'car (plist-get status :warnings)))))))
+ (if (eq permanency 'always)
+ (progn
+ (nsm-remove-temporary-setting id)
+ (nsm-remove-permanent-setting id)
+ (push saved nsm-permanent-host-settings)
+ (nsm-write-settings))
+ (nsm-remove-temporary-setting id)
+ (push saved nsm-temporary-host-settings))))
+
+(defun nsm-write-settings ()
+ (with-temp-file nsm-settings-file
+ (insert "(\n")
+ (dolist (setting nsm-permanent-host-settings)
+ (insert " ")
+ (prin1 setting (current-buffer))
+ (insert "\n"))
+ (insert ")\n")))
+
+(defun nsm-read-settings ()
+ (setq nsm-permanent-host-settings
+ (with-temp-buffer
+ (insert-file-contents nsm-settings-file)
+ (goto-char (point-min))
+ (ignore-errors (read (current-buffer))))))
+
+(defun nsm-id (host port)
+ (concat "sha1:" (sha1 (format "%s:%s" host port))))
+
+(defun nsm-host-settings (id)
+ (when (and (not nsm-permanent-host-settings)
+ (file-exists-p nsm-settings-file))
+ (nsm-read-settings))
+ (let ((result nil))
+ (dolist (elem (append nsm-temporary-host-settings
+ nsm-permanent-host-settings))
+ (when (and (not result)
+ (equal (plist-get elem :id) id))
+ (setq result elem)))
+ result))
+
+(defun nsm-warnings-ok-p (status settings)
+ (let ((not-ok nil)
+ (conditions (plist-get settings :conditions)))
+ (dolist (warning (plist-get status :warnings))
+ (when (memq (car warning) conditions)
+ (setq not-ok t)))
+ not-ok))
+
+(defun nsm-remove-permanent-setting (id)
+ (setq nsm-permanent-host-settings
+ (cl-delete-if
+ (lambda (elem)
+ (equal (plist-get elem :id) id))
+ nsm-permanent-host-settings)))
+
+(defun nsm-remove-temporary-setting (id)
+ (setq nsm-temporary-host-settings
+ (cl-delete-if
+ (lambda (elem)
+ (equal (plist-get elem :id) id))
+ nsm-temporary-host-settings)))
+
+(defun nsm-format-certificate (status)
+ (let ((cert (plist-get status :certificate)))
+ (when cert
+ (with-temp-buffer
+ (insert
+ "Certificate information\n"
+ "Issued by:"
+ (nsm-certificate-part (plist-get cert :issuer) "CN" t) "\n"
+ "Issued to:"
+ (or (nsm-certificate-part (plist-get cert :subject) "O")
+ (nsm-certificate-part (plist-get cert :subject) "OU" t))
+ "\n"
+ "Hostname:"
+ (nsm-certificate-part (plist-get cert :subject) "CN" t) "\n"
+ "Public key:" (plist-get cert :public-key-algorithm)
+ ", signature: " (plist-get cert :signature-algorithm) "\n"
+ "Security level:"
+ (propertize (plist-get cert :certificate-security-level)
+ 'face 'bold)
+ "\n"
+ "Valid:From " (plist-get cert :valid-from)
+ " to " (plist-get cert :valid-to) "\n\n")
+ (goto-char (point-min))
+ (while (re-search-forward "^[^:]+:" nil t)
+ (insert (make-string (- 20 (current-column)) ? )))
+ (buffer-string)))))
+
+(defun nsm-certificate-part (string part &optional full)
+ (let ((part (cadr (assoc part (nsm-parse-subject string)))))
+ (cond
+ (part part)
+ (full string)
+ (t nil))))
+
+(defun nsm-parse-subject (string)
+ (with-temp-buffer
+ (insert string)
+ (goto-char (point-min))
+ (let ((start (point))
+ (result nil))
+ (while (not (eobp))
+ (push (replace-regexp-in-string
+ "[\\]\\(.\\)" "\\1"
+ (buffer-substring start
+ (if (re-search-forward "[^\\]," nil 'move)
+ (1- (point))
+ (point))))
+ result)
+ (setq start (point)))
+ (mapcar
+ (lambda (elem)
+ (let ((pos (cl-position ?= elem)))
+ (if pos
+ (list (substring elem 0 pos)
+ (substring elem (1+ pos)))
+ 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