[Emacs-diffs] nsm 01/01: Make IMAP and POP3 warn unless encrypted, and SMTP warn if passwords

[Lars Ingebrigtsen]

branch: nsm
commit 2f38a08861c04b7f71f83aff812e4521e2f5f2f6
Author: Lars Magne Ingebrigtsen <address@hidden>
Date:   Tue Nov 18 16:36:02 2014 +0100

    Make IMAP and POP3 warn unless encrypted, and SMTP warn if passwords
    
    * net/network-stream.el (network-stream-open-starttls): Use the
    network security manager.
    (network-stream-open-tls): Ditto.
    
    * mail/smtpmail.el (smtpmail-via-smtp): Warn unless encrypted if
    we're sending a password.
---
 lisp/ChangeLog             |    3 +++
 lisp/gnus/ChangeLog        |    6 ++++++
 lisp/gnus/nnimap.el        |    1 +
 lisp/gnus/pop3.el          |    1 +
 lisp/mail/smtpmail.el      |    1 +
 lisp/net/network-stream.el |   13 ++++++++++---
 lisp/net/nsm.el            |   44 +++++++++++++++++++++++++++++---------------
 7 files changed, 51 insertions(+), 18 deletions(-)

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 293ffae..e02a64e 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,8 @@
 2014-11-18  Lars Magne Ingebrigtsen  <address@hidden>
 
+       * mail/smtpmail.el (smtpmail-via-smtp): Warn unless encrypted if
+       we're sending a password.
+
        * net/network-stream.el (network-stream-open-starttls): Use the
        network security manager.
        (network-stream-open-tls): Ditto.
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index 6713df8..6154688 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,9 @@
+2014-11-18  Lars Magne Ingebrigtsen  <address@hidden>
+
+       * nnimap.el (nnimap-open-connection-1): Warn unless encrypted.
+
+       * pop3.el (pop3-open-server): Warn unless encrypted.
+
 2014-11-10  Adam Sjøgren  <address@hidden>
 
        * mml2015.el (mml2015-display-key-image): New variable.
diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el
index 6a6ad4f..e8e2bc9 100644
--- a/lisp/gnus/nnimap.el
+++ b/lisp/gnus/nnimap.el
@@ -409,6 +409,7 @@ textual parts.")
               "*nnimap*" (current-buffer) nnimap-address
               (nnimap-map-port (car ports))
               :type nnimap-stream
+              :warn-unless-encrypted t
               :return-list t
               :shell-command nnimap-shell-program
               :capability-command "1 CAPABILITY\r\n"
diff --git a/lisp/gnus/pop3.el b/lisp/gnus/pop3.el
index dfc646b..64a704f 100644
--- a/lisp/gnus/pop3.el
+++ b/lisp/gnus/pop3.el
@@ -561,6 +561,7 @@ Returns the process associated with the connection."
                     'tls)
                    (t
                     (or pop3-stream-type 'network)))
+            :warn-unless-encrypted t
             :capability-command "CAPA\r\n"
             :end-of-command "^\\(-ERR\\|+OK\\).*\n"
             :end-of-capability "^\\.\r?\n\\|^-ERR"
diff --git a/lisp/mail/smtpmail.el b/lisp/mail/smtpmail.el
index 54f4664..7bca543 100644
--- a/lisp/mail/smtpmail.el
+++ b/lisp/mail/smtpmail.el
@@ -687,6 +687,7 @@ Returns an error if the server cannot be contacted."
                   "smtpmail" process-buffer host port
                   :type smtpmail-stream-type
                   :return-list t
+                  :warn-unless-encrypted ask-for-password
                   :capability-command (format "EHLO %s\r\n" (smtpmail-fqdn))
                   :end-of-command "^[0-9]+ .*\r\n"
                   :success "^2.*\n"
diff --git a/lisp/net/network-stream.el b/lisp/net/network-stream.el
index 0310b22..56c2058 100644
--- a/lisp/net/network-stream.el
+++ b/lisp/net/network-stream.el
@@ -129,11 +129,14 @@ values:
 :use-starttls-if-possible is a boolean that says to do opportunistic
 STARTTLS upgrades even if Emacs doesn't have built-in TLS functionality.
 
+:warn-unless-encrypted is a boolean whic, if :return-list is
+non-nil, is used warn the user if the connection isn't encrypted.
+
 :nogreeting is a boolean that can be used to inhibit waiting for
 a greeting from the server.
 
 :nowait is a boolean that says the connection should be made
-  asynchronously, if possible."
+asynchronously, if possible."
   (unless (featurep 'make-network-process)
     (error "Emacs was compiled without networking support"))
   (let ((type (plist-get parameters :type))
@@ -197,6 +200,8 @@ a greeting from the server.
        (stream (make-network-process :name name :buffer buffer
                                      :host host :service service
                                      :nowait (plist-get parameters :nowait))))
+    (when (plist-get parameters :warn-unless-encrypted)
+      (setq stream (nsm-verify-connection stream host service nil t)))
     (list stream
          (network-stream-get-response stream start
                                       (plist-get parameters :end-of-command))
@@ -322,8 +327,10 @@ a greeting from the server.
       (setq stream nil))
     ;; Check certificate validity etc.
     (when builtin-starttls
-      (setq stream (nsm-verify-connection stream host service
-                                         (eq resulting-type 'tls))))
+      (setq stream (nsm-verify-connection
+                   stream host service
+                   (eq resulting-type 'tls)
+                   (plist-get parameters :warn-unless-encrypted))))
     ;; Return value:
     (list stream greeting capabilities resulting-type error)))
 
diff --git a/lisp/net/nsm.el b/lisp/net/nsm.el
index ae7eefc..76354b8 100644
--- a/lisp/net/nsm.el
+++ b/lisp/net/nsm.el
@@ -50,7 +50,8 @@
   :group 'nsm
   :type 'file)
 
-(defun nsm-verify-connection (process host port &optional save-fingerprint)
+(defun nsm-verify-connection (process host port &optional
+                                     save-fingerprint warn-unencrypted)
   "Verify the security status of PROCESS that's connected to HOST:PORT.
 If PROCESS is a gnutls connection, the certificate validity will
 be examined.  If it's a non-TLS connection, it may be compared
@@ -63,7 +64,10 @@ process will be deleted and nil is returned.
 
 If SAVE-FINGERPRINT, always save the fingerprint of the
 server (if the connection is a TLS connection).  This is useful
-to keep track of the TLS status of STARTTLS servers."
+to keep track of the TLS status of STARTTLS servers.
+
+If WARN-UNENCRYPTED, query the user if the connection is
+unencrypted."
   (if (eq nsm-security-level 'low)
       process
     (let* ((status (gnutls-peer-status process))
@@ -74,7 +78,8 @@ to keep track of the TLS status of STARTTLS servers."
        nil)
        ((not status)
        ;; This is a non-TLS connection.
-       (nsm-check-plain-connection process host port settings))
+       (nsm-check-plain-connection process host port settings
+                                   warn-unencrypted))
        (t
        (let ((process
               (nsm-check-tls-connection process host port status settings)))
@@ -135,21 +140,30 @@ to keep track of the TLS status of STARTTLS servers."
       nil
     t))
 
-(defun nsm-check-plain-connection (process host port settings)
+(defun nsm-check-plain-connection (process host port settings warn-unencrypted)
   ;; If this connection used to be TLS, but is now plain, then it's
   ;; possible that we're being Man-In-The-Middled by a proxy that's
   ;; stripping out STARTTLS announcements.
-  (if (and (plist-get settings :fingerprint)
-          (not (eq (plist-get settings :fingerprint) :none))
-          (not
-           (nsm-query
-            (nsm-id 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."
-            host port)))
-      (progn
-       (delete-process process)
-       nil)
-    process))
+  (cond
+   ((and (plist-get settings :fingerprint)
+        (not (eq (plist-get settings :fingerprint) :none))
+        (not
+         (nsm-query
+          (nsm-id 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."
+          host port)))
+    (delete-process process)
+    nil)
+   ((and warn-unencrypted
+        (not (memq :unencrypted (plist-get settings :conditions)))
+        (not (nsm-query
+              (nsm-id host port) nil 'conditions
+              "The connection to %s:%s is unencrypted."
+              host port)))
+    (delete-process process)
+    nil)
+   (t
+    process)))
 
 (defun nsm-query (id status what message &rest args)
   (let ((response