;;; 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.
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
+The process is 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
(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
(defun nsm-check-protocol (process host port status settings)
(let ((prime-bits (plist-get status :diffie-hellman-prime-bits))
- (encryption (format "%s-%s-%s"
+ (signature-algorithm
+ (plist-get (plist-get status :certificate) :signature-algorithm))
+ (encryption (format "%s-%s-%s"
(plist-get status :key-exchange)
(plist-get status :cipher)
(plist-get status :mac)))
host port encryption)))
(delete-process process)
nil)
+ ((and (string-match "\\bSHA1\\b" signature-algorithm)
+ (not (memq :signature-sha1 (plist-get settings :conditions)))
+ (not
+ (nsm-query
+ host port status :signature-sha1
+ "The certificate used to verify the connection to %s:%s uses the SHA1 algorithm (%s), which is believed to be unsafe."
+ host port signature-algorithm)))
+ (delete-process process)
+ nil)
((and protocol
(string-match "SSL" protocol)
(not (memq :ssl (plist-get settings :conditions)))
(when (> (length cert) 0)
(insert cert "\n"))
(let ((start (point)))
- (insert (apply 'format message args))
+ (insert (apply #'format-message message args))
(goto-char start)
;; Fill the first line of the message, which usually
;; contains lots of explanatory text.
(?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)