;;; nsm.el --- Network Security Manager
-;; Copyright (C) 2014 Free Software Foundation, Inc.
+;; Copyright (C) 2014-2015 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: encryption, security, network
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
(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" "")
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))
(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)))))
(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)))
(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)
(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)))
(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)
(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:"