[Emacs-diffs] /srv/bzr/emacs/trunk r104602: Merge changes made in Gnus trunk.

[Katsumi Yamaoka]

------------------------------------------------------------
revno: 104602
author: Teodor Zlatanov <address@hidden>
committer: Katsumi Yamaoka <address@hidden>
branch nick: trunk
timestamp: Thu 2011-06-16 06:18:18 +0000
message:
  Merge changes made in Gnus trunk.
  
  auth-source.el (auth-source-save-secrets): New variable to control if secret 
tokens should be saved encrypted.
   (auth-source-netrc-parse, auth-source-netrc-search): Pass the file name to 
`auth-source-netrc-normalize'.
   (with-auth-source-epa-overrides): Add convenience macro.  Don't depend on 
the EPA variables being defined.
   (auth-source-epa-make-gpg-token): Convert text to a "gpg:" token.
   (auth-source-netrc-normalize): Convert "gpg:" tokens back to text in the 
lexical-let closure.
   (auth-source-netrc-create): Create "gpg:" tokens according to 
`auth-source-save-secrets'.
modified:
  lisp/gnus/ChangeLog
  lisp/gnus/auth-source.el

=== modified file 'lisp/gnus/ChangeLog'
--- a/lisp/gnus/ChangeLog       2011-06-10 00:10:24 +0000
+++ b/lisp/gnus/ChangeLog       2011-06-16 06:18:18 +0000
@@ -1,3 +1,17 @@
+2011-06-16  Teodor Zlatanov  <address@hidden>
+
+       * auth-source.el (auth-source-save-secrets): New variable to control if
+       secret tokens should be saved encrypted.
+       (auth-source-netrc-parse, auth-source-netrc-search): Pass the file name
+       to `auth-source-netrc-normalize'.
+       (with-auth-source-epa-overrides): Add convenience macro.  Don't depend
+       on the EPA variables being defined.
+       (auth-source-epa-make-gpg-token): Convert text to a "gpg:" token.
+       (auth-source-netrc-normalize): Convert "gpg:" tokens back to text in
+       the lexical-let closure.
+       (auth-source-netrc-create): Create "gpg:" tokens according to
+       `auth-source-save-secrets'.
+
 2011-06-10  Katsumi Yamaoka  <address@hidden>
 
        * gnus-group.el (gnus-group-update-group): Add new argument

=== modified file 'lisp/gnus/auth-source.el'
--- a/lisp/gnus/auth-source.el  2011-03-15 17:39:56 +0000
+++ b/lisp/gnus/auth-source.el  2011-06-16 06:18:18 +0000
@@ -154,6 +154,16 @@
           (const :tag "Never save" nil)
           (const :tag "Ask" ask)))
 
+(defcustom auth-source-save-secrets nil
+  "If set, auth-source will respect it for password tokens behavior."
+  :group 'auth-source
+  :version "23.2" ;; No Gnus
+  :type `(choice
+          :tag "auth-source new password token behavior"
+          (const :tag "Use GPG tokens" gpg)
+          (const :tag "Save unencrypted" nil)
+          (const :tag "Ask" ask)))
+
 (defvar auth-source-magic "auth-source-magic ")
 
 (defcustom auth-source-do-cache t
@@ -898,7 +908,7 @@
                         (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)
@@ -934,7 +944,54 @@
 
           (nreverse result))))))
 
-(defun auth-source-netrc-normalize (alist)
+(defmacro with-auth-source-epa-overrides (&rest body)
+  `(let ((file-name-handler-alist
+          ',(if (boundp 'epa-file-handler)
+                (remove (symbol-value 'epa-file-handler)
+                        file-name-handler-alist)
+              file-name-handler-alist))
+         (find-file-hook
+          ',(remove 'epa-file-find-file-hook find-file-hook))
+         (auto-mode-alist
+          ',(if (boundp 'epa-file-auto-mode-alist-entry)
+                (remove (symbol-value 'epa-file-auto-mode-alist-entry)
+                        auto-mode-alist)
+              auto-mode-alist)))
+     ,@body))
+
+(defun auth-source-epa-make-gpg-token (secret file)
+  (require 'epa nil t)
+  (unless (featurep 'epa)
+    (error "EPA could not be loaded."))
+  (let* ((base (file-name-sans-extension file))
+         (passkey (format "gpg:-%s" base))
+         (stash (concat base ".gpg"))
+         ;; 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? "
+                  file)
+                 passkey)))))
+    (write-region secret nil stashfile)
+    ;; temporarily disable EPA
+    (unwind-protect
+        (with-auth-source-epa-overrides
+         (with-temp-buffer
+           (insert-file-contents stashfile)
+           (base64-encode-region (point-min) (point-max) t)
+           (concat "gpg:"
+                   (buffer-substring-no-properties
+                    (point-min)
+                    (point-max)))))
+      (delete-file stashfile))))
+
+(defun auth-source-netrc-normalize (alist filename)
   (mapcar (lambda (entry)
             (let (ret item)
               (while (setq item (pop entry))
@@ -950,15 +1007,65 @@
 
                   ;; send back the secret in a function (lexical binding)
                   (when (equal k "secret")
-                    (setq v (lexical-let ((v v))
-                              (lambda () v))))
-
-                  (setq ret (plist-put ret
-                                       (intern (concat ":" k))
-                                       v))
-                  ))
-              ret))
-          alist))
+                    (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)))))
+                                     (unwind-protect
+                                         (progn
+                                           ;; 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)))))
+                                       (delete-file stashfile)))
+                                   ;; 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))))
+            ret))
+  alist))
 
 ;;; (setq secret (plist-get (nth 0 (auth-source-search :host t :type 'netrc :K 
1 :max 1)) :secret))
 ;;; (funcall secret)
@@ -982,7 +1089,8 @@
                    :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
@@ -1098,7 +1206,21 @@
               (cond
                ((and (null data) (eq r 'secret))
                 ;; Special case prompt for passwords.
-                (read-passwd prompt))
+                ;; Respect `auth-source-save-secrets'
+                (let* ((ep (format "Do you want GPG password tokens? (%s)"
+                                   "see `auth-source-save-secrets'"))
+                       (gpg-encrypt
+;;; FIXME: this relies on .gpg files being handled by EPA/EPG
+                        ;; don't put GPG tokens in GPG-encrypted files
+                        (and (not (equal "gpg" (file-name-extension file)))
+                             (or (eq auth-source-save-secrets 'gpg)
+                                 (and (eq auth-source-save-secrets 'ask)
+                                      (setq auth-source-save-secrets
+                                            (and (y-or-n-p ep) 'gpg))))))
+                        (plain (read-passwd prompt)))
+                  (if (eq auth-source-save-secrets 'gpg)
+                      (auth-source-epa-make-gpg-token plain file)
+                    plain)))
                ((null data)
                 (when default
                   (setq prompt