]> code.delx.au - gnu-emacs/blobdiff - lisp/net/nsm.el
Update copyright year to 2016
[gnu-emacs] / lisp / net / nsm.el
index 16e07ff088cd870811d1992ed33856ddcd40618d..31f2b32792fb385e9e476c1287a5e934a0d6888f 100644 (file)
@@ -1,6 +1,6 @@
 ;;; 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
@@ -76,6 +76,8 @@ stored in plain text."
   "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.
@@ -122,6 +124,9 @@ unencrypted."
        (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
@@ -164,7 +169,7 @@ unencrypted."
        (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" "")
@@ -181,7 +186,8 @@ unencrypted."
        (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)
@@ -190,7 +196,7 @@ unencrypted."
           (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)
@@ -200,7 +206,19 @@ unencrypted."
            (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))))
 
@@ -217,7 +235,7 @@ unencrypted."
              (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)))))
@@ -232,7 +250,7 @@ unencrypted."
 (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)))
 
@@ -246,7 +264,7 @@ unencrypted."
         (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)
@@ -285,11 +303,17 @@ unencrypted."
        (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
@@ -297,7 +321,7 @@ unencrypted."
               (assq (downcase
                      (read-char
                       (concat prefix
-                              "Continue connecting? (No, Session only, Always)")))
+                              "Continue connecting? (No, Session only, Always) ")))
                     responses)))
        (unless response
          (ding)
@@ -322,7 +346,6 @@ unencrypted."
     ;; 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))))
@@ -418,6 +441,15 @@ 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:"