;;; nsm.el --- Network Security Manager
-;; Copyright (C) 2014 Free Software Foundation, Inc.
+;; Copyright (C) 2014-2016 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: encryption, security, network
"If non-nil, the connection is opened in a non-interactive context.
This means that no queries should be performed.")
+(declare-function gnutls-peer-status "gnutls.c" (proc))
+
(defun nsm-verify-connection (process host port &optional
save-fingerprint warn-unencrypted)
"Verify the security status of PROCESS that's connected to HOST:PORT.
(nsm-check-protocol process host port status settings)
process)))
+(declare-function gnutls-peer-status-warning-describe "gnutls.c"
+ (status-symbol))
+
(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" "")
(encryption (format "%s-%s-%s"
(plist-get status :key-exchange)
(plist-get status :cipher)
- (plist-get status :mac))))
+ (plist-get status :mac)))
+ (protocol (plist-get status :protocol)))
(cond
((and prime-bits
(< prime-bits 1024)
(not
(nsm-query
host port status :diffie-hellman-prime-bits
- "The Diffie-Hellman prime bits (%s) used for this connection to\n%s:%s\nis less than what is considered safe (%s)."
+ "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)
(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))))
+ 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))))
(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 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)))
(prefix "")
+ (cursor-in-echo-area t)
response)
(while (not response)
(setq response
(assq (downcase
(read-char
(concat prefix
- "Continue connecting? (No, Session only, Always)")))
+ "Continue connecting? (No, Session only, Always) ")))
responses)))
(unless response
(ding)
;; of the certificate/unencrypted connection.
(cond
((eq what 'conditions)
- (nconc saved (list :host (format "%s:%s" host port)))
(cond
((not status)
(nconc saved '(:conditions (: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:"