netrc field encryption in auth-source (was: Opportunistic STARTTLS in smtpmail.el)

[Ted Zlatanov]

On Thu, 09 Jun 2011 20:02:02 +0200 Lars Magne Ingebrigtsen <address@hidden> 
wrote: 

LMI> I'll do my best to implement the new smtpmail.el stuff on Wednesday,
LMI> which looks like it's going to be free.  Is there any possibility of
LMI> getting the gpg: tokens done before that?  :-)  

See the attached patch.  I really hope the nasty code in there will
inspire you or Daiki Ueno to tell me how to do it better.  It depends on
the EPA being active and tries to load it opportunistically.  It also
depends on symmetric encryption to be enabled.

The GPG token decoder is activated if the secret matches
"gpg:base64data=="; otherwise the secret lambda just returns the
secret.  So the token decoder does the following, given a filename and
the decoded GPG token data:

1) make a .gpg temp stashfile associated with the original netrc
filename

2) set the symmetric passphrase for that stashfile to something we
`password-read' from the user, again associating the password with the
original netrc filename.  This is done with a nasty dynamic scope
override of `epa-file-passphrase-alist'.

3) write the decoded GPG token into the stashfile outside of EPA

4) read the decrypted secret from the stashfile using EPA and set the
secret lambda to return it from then on

5) clear out the token decoder lambda so there's no chance it will get
called again

Test it: put this in a netrc file

machine supertest password 
gpg:jA0EAwMCdmeQLC3gFEpgyR3UxXKPoS5Yzzjl4+v/iaGPAVzwrIGOYVC+XCKcnA==

and then do

(let ((auth-sources '("your-netrc-file")))
  (auth-source-forget-all-cached) 
  (funcall (plist-get (nth 0 (auth-source-search :host "supertest")) :secret)))

Let me know what you think.

Ted

diff --git a/lisp/auth-source.el b/lisp/auth-source.el
index ce483e4..18eeb35 100644
--- a/lisp/auth-source.el
+++ b/lisp/auth-source.el
@@ -908,7 +908,7 @@ Note that the MAX parameter is used so we can exit the 
parse early."
                         (null require)
                         ;; every element of require is in the normalized list
                         (let ((normalized (nth 0 (auth-source-netrc-normalize
-                                                 (list alist)))))
+                                                 (list alist) file))))
                           (loop for req in require
                                 always (plist-get normalized req)))))
               (decf max)
@@ -944,7 +944,16 @@ Note that the MAX parameter is used so we can exit the 
parse early."
 
           (nreverse result))))))
 
-(defun auth-source-netrc-normalize (alist)
+(defmacro with-auth-source-epa-overrides (&rest body)
+  `(let ((file-name-handler-alist
+          ',(remove epa-file-handler file-name-handler-alist))
+         (find-file-hook
+          ',(remove 'epa-file-find-file-hook find-file-hook))
+         (auto-mode-alist
+          ',(remove epa-file-auto-mode-alist-entry auto-mode-alist)))
+     ,@body))
+
+(defun auth-source-netrc-normalize (alist filename)
   (mapcar (lambda (entry)
             (let (ret item)
               (while (setq item (pop entry))
@@ -960,13 +969,59 @@ Note that the MAX parameter is used so we can exit the 
parse early."
 
                   ;; send back the secret in a function (lexical binding)
                   (when (equal k "secret")
-                    (setq v (lexical-let ((v v))
-                              (lambda () v))))
-
+                    (setq v (lexical-let ((v v)
+                                          (filename filename)
+                                          (base (file-name-nondirectory
+                                                 filename))
+                                          (token-decoder nil)
+                                          (gpgdata nil)
+                                          (stash nil))
+                              (setq stash (concat base ".gpg"))
+                              (when (string-match "gpg:\\(.+==\\)" v)
+                                (require 'epa nil t)
+                                (unless (featurep 'epa)
+                                  (error "EPA could not be loaded."))
+                                (setq gpgdata (base64-decode-string
+                                               (match-string 1 v)))
+                                ;; it's a GPG token
+                                (setq token-decoder
+                                      (lambda (gpgdata)
+;;; FIXME: this relies on .gpg files being handled by EPA/EPG
+                                        (let* ((passkey (format "gpg:-%s" 
base))
+                                               ;; temporarily disable EPA
+                                               (stashfile
+                                                (with-auth-source-epa-overrides
+                                                 (make-temp-file "gpg-token" 
nil
+                                                                 stash)))
+                                               (epa-file-passphrase-alist
+                                                `((,stashfile
+                                                   . ,(password-read
+                                                       (format
+                                                       "token pass for %s? "
+                                                       filename)
+                                                      passkey)))))
+                                          ;; temporarily disable EPA
+                                          (with-auth-source-epa-overrides
+                                           (write-region gpgdata
+                                                         nil
+                                                         stashfile))
+                                          (setq
+                                           v
+                                           (with-temp-buffer
+                                             (insert-file-contents stashfile)
+                                             (buffer-substring-no-properties
+                                              (point-min)
+                                              (point-max))))
+                                        ;; clear out the decoder at end
+                                        (setq token-decoder nil
+                                              gpgdata nil)))))
+                              (lambda ()
+                                (when token-decoder
+                                  (funcall token-decoder gpgdata))
+                                v))))
                   (setq ret (plist-put ret
                                        (intern (concat ":" k))
-                                       v))
-                  ))
+                                       v))))
               ret))
           alist))
 
@@ -992,7 +1047,8 @@ See `auth-source-search' for details on SPEC."
                    :file (oref backend source)
                    :host (or host t)
                    :user (or user t)
-                   :port (or port t)))))
+                   :port (or port t))
+                  (oref backend source))))
 
     ;; if we need to create an entry AND none were found to match
     (when (and create