1 ;;; nsm.el --- Network Security Manager
3 ;; Copyright (C) 2014-2016 Free Software Foundation, Inc.
5 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
6 ;; Keywords: encryption, security, network
8 ;; This file is part of GNU Emacs.
10 ;; GNU Emacs is free software: you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation, either version 3 of the License, or
13 ;; (at your option) any later version.
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
30 (defvar nsm-permanent-host-settings nil
)
31 (defvar nsm-temporary-host-settings nil
)
34 "Network Security Manager"
38 (defcustom network-security-level
'medium
39 "How secure the network should be.
40 If a potential problem with the security of the network
41 connection is found, the user is asked to give input into how the
42 connection should be handled.
44 The following values are possible:
46 `low': Absolutely no checks are performed.
47 `medium': This is the default level, should be reasonable for most usage.
48 `high': This warns about additional things that many people would
50 `paranoid': On this level, the user is queried for most new connections.
52 See the Emacs manual for a description of all things that are
53 checked and warned against."
56 :type
'(choice (const :tag
"Low" low
)
57 (const :tag
"Medium" medium
)
58 (const :tag
"High" high
)
59 (const :tag
"Paranoid" paranoid
)))
61 (defcustom nsm-settings-file
(expand-file-name "network-security.data"
63 "The file the security manager settings will be stored in."
68 (defcustom nsm-save-host-names nil
69 "If non-nil, always save host names in the structures in `nsm-settings-file'.
70 By default, only hosts that have exceptions have their names
71 stored in plain text."
76 (defvar nsm-noninteractive nil
77 "If non-nil, the connection is opened in a non-interactive context.
78 This means that no queries should be performed.")
80 (declare-function gnutls-peer-status
"gnutls.c" (proc))
82 (defun nsm-verify-connection (process host port
&optional
83 save-fingerprint warn-unencrypted
)
84 "Verify the security status of PROCESS that's connected to HOST:PORT.
85 If PROCESS is a gnutls connection, the certificate validity will
86 be examined. If it's a non-TLS connection, it may be compared
87 against previous connections. If the function determines that
88 there is something odd about the connection, the user will be
89 queried about what to do about it.
91 The process is returned if everything is OK, and otherwise, the
92 process will be deleted and nil is returned.
94 If SAVE-FINGERPRINT, always save the fingerprint of the
95 server (if the connection is a TLS connection). This is useful
96 to keep track of the TLS status of STARTTLS servers.
98 If WARN-UNENCRYPTED, query the user if the connection is
100 (if (eq network-security-level
'low
)
102 (let* ((status (gnutls-peer-status process
))
103 (id (nsm-id host port
))
104 (settings (nsm-host-settings id
)))
106 ((not (process-live-p process
))
109 ;; This is a non-TLS connection.
110 (nsm-check-plain-connection process host port settings
114 (nsm-check-tls-connection process host port status settings
)))
115 (when (and process save-fingerprint
116 (null (nsm-host-settings id
)))
117 (nsm-save-host host port status
'fingerprint
'always
))
120 (defun nsm-check-tls-connection (process host port status settings
)
121 (let ((process (nsm-check-certificate process host port status settings
)))
123 (>= (nsm-level network-security-level
) (nsm-level 'high
)))
124 ;; Do further protocol-level checks if the security is high.
125 (nsm-check-protocol process host port status settings
)
128 (declare-function gnutls-peer-status-warning-describe
"gnutls.c"
131 (defun nsm-check-certificate (process host port status settings
)
132 (let ((warnings (plist-get status
:warnings
)))
135 ;; The certificate validated, but perhaps we want to do
136 ;; certificate pinning.
139 ((< (nsm-level network-security-level
) (nsm-level 'high
))
141 ;; The certificate is fine, but if we're paranoid, we might
142 ;; want to check whether it's changed anyway.
143 ((and (>= (nsm-level network-security-level
) (nsm-level 'high
))
144 (not (nsm-fingerprint-ok-p host port status settings
)))
145 (delete-process process
)
147 ;; We haven't seen this before, and we're paranoid.
148 ((and (eq network-security-level
'paranoid
)
150 (not (nsm-new-fingerprint-ok-p host port status
)))
151 (delete-process process
)
153 ((>= (nsm-level network-security-level
) (nsm-level 'high
))
154 ;; Save the host fingerprint so that we can check it the
155 ;; next time we connect.
156 (nsm-save-host host port status
'fingerprint
'always
)
161 ;; The certificate did not validate.
162 ((not (equal network-security-level
'low
))
163 ;; We always want to pin the certificate of invalid connections
164 ;; to track man-in-the-middle or the like.
165 (if (not (nsm-fingerprint-ok-p host port status settings
))
167 (delete-process process
)
169 ;; We have a warning, so query the user.
170 (if (and (not (nsm-warnings-ok-p status settings
))
172 host port status
'conditions
173 "The TLS connection to %s:%s is insecure for the following reason%s:\n\n%s"
175 (if (> (length warnings
) 1)
177 (mapconcat #'gnutls-peer-status-warning-describe
181 (delete-process process
)
185 (defun nsm-check-protocol (process host port status settings
)
186 (let ((prime-bits (plist-get status
:diffie-hellman-prime-bits
))
188 (plist-get (plist-get status
:certificate
) :signature-algorithm
))
189 (encryption (format "%s-%s-%s"
190 (plist-get status
:key-exchange
)
191 (plist-get status
:cipher
)
192 (plist-get status
:mac
)))
193 (protocol (plist-get status
:protocol
)))
197 (not (memq :diffie-hellman-prime-bits
198 (plist-get settings
:conditions
)))
201 host port status
:diffie-hellman-prime-bits
202 "The Diffie-Hellman prime bits (%s) used for this connection to %s:%s is less than what is considered safe (%s)."
203 prime-bits host port
1024)))
204 (delete-process process
)
206 ((and (string-match "\\bRC4\\b" encryption
)
207 (not (memq :rc4
(plist-get settings
:conditions
)))
210 host port status
:rc4
211 "The connection to %s:%s uses the RC4 algorithm (%s), which is believed to be unsafe."
212 host port encryption
)))
213 (delete-process process
)
215 ((and (string-match "\\bSHA1\\b" signature-algorithm
)
216 (not (memq :signature-sha1
(plist-get settings
:conditions
)))
219 host port status
:signature-sha1
220 "The certificate used to verify the connection to %s:%s uses the SHA1 algorithm (%s), which is believed to be unsafe."
221 host port signature-algorithm
)))
222 (delete-process process
)
225 (string-match "SSL" protocol
)
226 (not (memq :ssl
(plist-get settings
:conditions
)))
229 host port status
:ssl
230 "The connection to %s:%s uses the %s protocol, which is believed to be unsafe."
231 host port protocol
)))
232 (delete-process process
)
237 (defun nsm-fingerprint (status)
238 (plist-get (plist-get status
:certificate
) :public-key-id
))
240 (defun nsm-fingerprint-ok-p (host port status settings
)
241 (let ((did-query nil
))
243 (not (eq (plist-get settings
:fingerprint
) :none
))
244 (not (equal (nsm-fingerprint status
)
245 (plist-get settings
:fingerprint
)))
249 host port status
'fingerprint
250 "The fingerprint for the connection to %s:%s has changed from %s to %s"
252 (plist-get settings
:fingerprint
)
253 (nsm-fingerprint status
)))))
257 ;; Remove any exceptions that have been set on the previous
259 (plist-put settings
:conditions nil
))
262 (defun nsm-new-fingerprint-ok-p (host port status
)
264 host port status
'fingerprint
265 "The fingerprint for the connection to %s:%s is new: %s"
267 (nsm-fingerprint status
)))
269 (defun nsm-check-plain-connection (process host port settings warn-unencrypted
)
270 ;; If this connection used to be TLS, but is now plain, then it's
271 ;; possible that we're being Man-In-The-Middled by a proxy that's
272 ;; stripping out STARTTLS announcements.
274 ((and (plist-get settings
:fingerprint
)
275 (not (eq (plist-get settings
:fingerprint
) :none
))
278 host port nil
'conditions
279 "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."
281 (delete-process process
)
283 ((and warn-unencrypted
284 (not (memq :unencrypted
(plist-get settings
:conditions
)))
286 host port nil
'conditions
287 "The connection to %s:%s is unencrypted."
289 (delete-process process
)
294 (defun nsm-query (host port status what message
&rest args
)
295 ;; If there is no user to answer queries, then say `no' to everything.
296 (if (or noninteractive
303 (nsm-query-user message args
304 (nsm-format-certificate status
))))
306 ;; Make sure we manage to close the process if the user hits
310 (if (eq response
'no
)
312 (message "Aborting connection to %s:%s" host port
)
314 (message (if (eq response
'session
)
315 "Accepting certificate for %s:%s this session only"
316 "Permanently accepting certificate for %s:%s")
318 (nsm-save-host host port status what response
)
321 (defun nsm-query-user (message args cert
)
322 (let ((buffer (get-buffer-create "*Network Security Manager*")))
323 (save-window-excursion
324 ;; First format the certificate and warnings.
325 (with-help-window buffer
326 (with-current-buffer buffer
328 (when (> (length cert
) 0)
330 (let ((start (point)))
331 (insert (apply #'format-message message args
))
333 ;; Fill the first line of the message, which usually
334 ;; contains lots of explanatory text.
335 (fill-region (point) (line-end-position)))))
336 ;; Then ask the user what to do about it.
339 (read-multiple-choice
340 "Continue connecting?"
341 '((?a
"always" "Accept this certificate this session and for all future sessions.")
342 (?s
"session only" "Accept this certificate this session only.")
343 (?n
"no" "Refuse to use this certificate, and close the connection."))))
344 (kill-buffer buffer
)))))
346 (defun nsm-save-host (host port status what permanency
)
347 (let* ((id (nsm-id host port
))
350 :fingerprint
(or (nsm-fingerprint status
)
353 (when (or (eq what
'conditions
)
355 (nconc saved
(list :host
(format "%s:%s" host port
))))
356 ;; We either want to save/update the fingerprint or the conditions
357 ;; of the certificate/unencrypted connection.
359 ((eq what
'conditions
)
362 (nconc saved
'(:conditions
(:unencrypted
))))
363 ((plist-get status
:warnings
)
365 (list :conditions
(plist-get status
:warnings
))))))
366 ((not (eq what
'fingerprint
))
367 ;; Store additional protocol settings.
368 (let ((settings (nsm-host-settings id
)))
370 (setq saved settings
))
371 (if (plist-get saved
:conditions
)
372 (nconc (plist-get saved
:conditions
) (list what
))
373 (nconc saved
(list :conditions
(list what
)))))))
374 (if (eq permanency
'always
)
376 (nsm-remove-temporary-setting id
)
377 (nsm-remove-permanent-setting id
)
378 (push saved nsm-permanent-host-settings
)
379 (nsm-write-settings))
380 (nsm-remove-temporary-setting id
)
381 (push saved nsm-temporary-host-settings
))))
383 (defun nsm-write-settings ()
384 (with-temp-file nsm-settings-file
386 (dolist (setting nsm-permanent-host-settings
)
388 (prin1 setting
(current-buffer))
392 (defun nsm-read-settings ()
393 (setq nsm-permanent-host-settings
395 (insert-file-contents nsm-settings-file
)
396 (goto-char (point-min))
397 (ignore-errors (read (current-buffer))))))
399 (defun nsm-id (host port
)
400 (concat "sha1:" (sha1 (format "%s:%s" host port
))))
402 (defun nsm-host-settings (id)
403 (when (and (not nsm-permanent-host-settings
)
404 (file-exists-p nsm-settings-file
))
407 (dolist (elem (append nsm-temporary-host-settings
408 nsm-permanent-host-settings
))
409 (when (and (not result
)
410 (equal (plist-get elem
:id
) id
))
414 (defun nsm-warnings-ok-p (status settings
)
416 (conditions (plist-get settings
:conditions
)))
417 (dolist (warning (plist-get status
:warnings
))
418 (unless (memq warning conditions
)
422 (defun nsm-remove-permanent-setting (id)
423 (setq nsm-permanent-host-settings
426 (equal (plist-get elem
:id
) id
))
427 nsm-permanent-host-settings
)))
429 (defun nsm-remove-temporary-setting (id)
430 (setq nsm-temporary-host-settings
433 (equal (plist-get elem
:id
) id
))
434 nsm-temporary-host-settings
)))
436 (defun nsm-format-certificate (status)
437 (let ((cert (plist-get status
:certificate
)))
441 "Certificate information\n"
443 (nsm-certificate-part (plist-get cert
:issuer
) "CN" t
) "\n"
445 (or (nsm-certificate-part (plist-get cert
:subject
) "O")
446 (nsm-certificate-part (plist-get cert
:subject
) "OU" t
))
449 (nsm-certificate-part (plist-get cert
:subject
) "CN" t
) "\n")
450 (when (and (plist-get cert
:public-key-algorithm
)
451 (plist-get cert
:signature-algorithm
))
453 "Public key:" (plist-get cert
:public-key-algorithm
)
454 ", signature: " (plist-get cert
:signature-algorithm
) "\n"))
455 (when (and (plist-get status
:key-exchange
)
456 (plist-get status
:cipher
)
457 (plist-get status
:mac
)
458 (plist-get status
:protocol
))
460 "Protocol:" (plist-get status
:protocol
)
461 ", key: " (plist-get status
:key-exchange
)
462 ", cipher: " (plist-get status
:cipher
)
463 ", mac: " (plist-get status
:mac
) "\n"))
464 (when (plist-get cert
:certificate-security-level
)
467 (propertize (plist-get cert
:certificate-security-level
)
471 "Valid:From " (plist-get cert
:valid-from
)
472 " to " (plist-get cert
:valid-to
) "\n\n")
473 (goto-char (point-min))
474 (while (re-search-forward "^[^:]+:" nil t
)
475 (insert (make-string (- 20 (current-column)) ?
)))
478 (defun nsm-certificate-part (string part
&optional full
)
479 (let ((part (cadr (assoc part
(nsm-parse-subject string
)))))
485 (defun nsm-parse-subject (string)
488 (goto-char (point-min))
489 (let ((start (point))
492 (push (replace-regexp-in-string
494 (buffer-substring start
495 (if (re-search-forward "[^\\]," nil
'move
)
499 (setq start
(point)))
502 (let ((pos (cl-position ?
= elem
)))
504 (list (substring elem
0 pos
)
505 (substring elem
(1+ pos
)))
507 (nreverse result
)))))
509 (defun nsm-level (symbol)
510 "Return a numerical level for SYMBOL for easier comparison."
513 ((eq symbol
'medium
) 1)
514 ((eq symbol
'high
) 2)