diff options
| author | Teodor Zlatanov | 2011-06-16 06:18:18 +0000 |
|---|---|---|
| committer | Katsumi Yamaoka | 2011-06-16 06:18:18 +0000 |
| commit | 2b8c5660b71d1111d65eaa4af3ade8528bc35ead (patch) | |
| tree | b4fa2386cb2a6eab2a8970bd205d2a58e488e256 | |
| parent | 8aeb5be96aa28c4770299a54758a8fb339993a97 (diff) | |
| download | emacs-2b8c5660b71d1111d65eaa4af3ade8528bc35ead.tar.gz emacs-2b8c5660b71d1111d65eaa4af3ade8528bc35ead.zip | |
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'.
| -rw-r--r-- | lisp/gnus/ChangeLog | 14 | ||||
| -rw-r--r-- | lisp/gnus/auth-source.el | 148 |
2 files changed, 149 insertions, 13 deletions
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 2bfaf32f958..a160581d861 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog | |||
| @@ -1,3 +1,17 @@ | |||
| 1 | 2011-06-16 Teodor Zlatanov <tzz@lifelogs.com> | ||
| 2 | |||
| 3 | * auth-source.el (auth-source-save-secrets): New variable to control if | ||
| 4 | secret tokens should be saved encrypted. | ||
| 5 | (auth-source-netrc-parse, auth-source-netrc-search): Pass the file name | ||
| 6 | to `auth-source-netrc-normalize'. | ||
| 7 | (with-auth-source-epa-overrides): Add convenience macro. Don't depend | ||
| 8 | on the EPA variables being defined. | ||
| 9 | (auth-source-epa-make-gpg-token): Convert text to a "gpg:" token. | ||
| 10 | (auth-source-netrc-normalize): Convert "gpg:" tokens back to text in | ||
| 11 | the lexical-let closure. | ||
| 12 | (auth-source-netrc-create): Create "gpg:" tokens according to | ||
| 13 | `auth-source-save-secrets'. | ||
| 14 | |||
| 1 | 2011-06-10 Katsumi Yamaoka <yamaoka@jpl.org> | 15 | 2011-06-10 Katsumi Yamaoka <yamaoka@jpl.org> |
| 2 | 16 | ||
| 3 | * gnus-group.el (gnus-group-update-group): Add new argument | 17 | * gnus-group.el (gnus-group-update-group): Add new argument |
diff --git a/lisp/gnus/auth-source.el b/lisp/gnus/auth-source.el index e0bea324a25..40389bb7f72 100644 --- a/lisp/gnus/auth-source.el +++ b/lisp/gnus/auth-source.el | |||
| @@ -154,6 +154,16 @@ let-binding." | |||
| 154 | (const :tag "Never save" nil) | 154 | (const :tag "Never save" nil) |
| 155 | (const :tag "Ask" ask))) | 155 | (const :tag "Ask" ask))) |
| 156 | 156 | ||
| 157 | (defcustom auth-source-save-secrets nil | ||
| 158 | "If set, auth-source will respect it for password tokens behavior." | ||
| 159 | :group 'auth-source | ||
| 160 | :version "23.2" ;; No Gnus | ||
| 161 | :type `(choice | ||
| 162 | :tag "auth-source new password token behavior" | ||
| 163 | (const :tag "Use GPG tokens" gpg) | ||
| 164 | (const :tag "Save unencrypted" nil) | ||
| 165 | (const :tag "Ask" ask))) | ||
| 166 | |||
| 157 | (defvar auth-source-magic "auth-source-magic ") | 167 | (defvar auth-source-magic "auth-source-magic ") |
| 158 | 168 | ||
| 159 | (defcustom auth-source-do-cache t | 169 | (defcustom auth-source-do-cache t |
| @@ -898,7 +908,7 @@ Note that the MAX parameter is used so we can exit the parse early." | |||
| 898 | (null require) | 908 | (null require) |
| 899 | ;; every element of require is in the normalized list | 909 | ;; every element of require is in the normalized list |
| 900 | (let ((normalized (nth 0 (auth-source-netrc-normalize | 910 | (let ((normalized (nth 0 (auth-source-netrc-normalize |
| 901 | (list alist))))) | 911 | (list alist) file)))) |
| 902 | (loop for req in require | 912 | (loop for req in require |
| 903 | always (plist-get normalized req))))) | 913 | always (plist-get normalized req))))) |
| 904 | (decf max) | 914 | (decf max) |
| @@ -934,7 +944,54 @@ Note that the MAX parameter is used so we can exit the parse early." | |||
| 934 | 944 | ||
| 935 | (nreverse result)))))) | 945 | (nreverse result)))))) |
| 936 | 946 | ||
| 937 | (defun auth-source-netrc-normalize (alist) | 947 | (defmacro with-auth-source-epa-overrides (&rest body) |
| 948 | `(let ((file-name-handler-alist | ||
| 949 | ',(if (boundp 'epa-file-handler) | ||
| 950 | (remove (symbol-value 'epa-file-handler) | ||
| 951 | file-name-handler-alist) | ||
| 952 | file-name-handler-alist)) | ||
| 953 | (find-file-hook | ||
| 954 | ',(remove 'epa-file-find-file-hook find-file-hook)) | ||
| 955 | (auto-mode-alist | ||
| 956 | ',(if (boundp 'epa-file-auto-mode-alist-entry) | ||
| 957 | (remove (symbol-value 'epa-file-auto-mode-alist-entry) | ||
| 958 | auto-mode-alist) | ||
| 959 | auto-mode-alist))) | ||
| 960 | ,@body)) | ||
| 961 | |||
| 962 | (defun auth-source-epa-make-gpg-token (secret file) | ||
| 963 | (require 'epa nil t) | ||
| 964 | (unless (featurep 'epa) | ||
| 965 | (error "EPA could not be loaded.")) | ||
| 966 | (let* ((base (file-name-sans-extension file)) | ||
| 967 | (passkey (format "gpg:-%s" base)) | ||
| 968 | (stash (concat base ".gpg")) | ||
| 969 | ;; temporarily disable EPA | ||
| 970 | (stashfile | ||
| 971 | (with-auth-source-epa-overrides | ||
| 972 | (make-temp-file "gpg-token" nil | ||
| 973 | stash))) | ||
| 974 | (epa-file-passphrase-alist | ||
| 975 | `((,stashfile | ||
| 976 | . ,(password-read | ||
| 977 | (format | ||
| 978 | "token pass for %s? " | ||
| 979 | file) | ||
| 980 | passkey))))) | ||
| 981 | (write-region secret nil stashfile) | ||
| 982 | ;; temporarily disable EPA | ||
| 983 | (unwind-protect | ||
| 984 | (with-auth-source-epa-overrides | ||
| 985 | (with-temp-buffer | ||
| 986 | (insert-file-contents stashfile) | ||
| 987 | (base64-encode-region (point-min) (point-max) t) | ||
| 988 | (concat "gpg:" | ||
| 989 | (buffer-substring-no-properties | ||
| 990 | (point-min) | ||
| 991 | (point-max))))) | ||
| 992 | (delete-file stashfile)))) | ||
| 993 | |||
| 994 | (defun auth-source-netrc-normalize (alist filename) | ||
| 938 | (mapcar (lambda (entry) | 995 | (mapcar (lambda (entry) |
| 939 | (let (ret item) | 996 | (let (ret item) |
| 940 | (while (setq item (pop entry)) | 997 | (while (setq item (pop entry)) |
| @@ -950,15 +1007,65 @@ Note that the MAX parameter is used so we can exit the parse early." | |||
| 950 | 1007 | ||
| 951 | ;; send back the secret in a function (lexical binding) | 1008 | ;; send back the secret in a function (lexical binding) |
| 952 | (when (equal k "secret") | 1009 | (when (equal k "secret") |
| 953 | (setq v (lexical-let ((v v)) | 1010 | (setq v (lexical-let ((v v) |
| 954 | (lambda () v)))) | 1011 | (filename filename) |
| 955 | 1012 | (base (file-name-nondirectory | |
| 956 | (setq ret (plist-put ret | 1013 | filename)) |
| 957 | (intern (concat ":" k)) | 1014 | (token-decoder nil) |
| 958 | v)) | 1015 | (gpgdata nil) |
| 959 | )) | 1016 | (stash nil)) |
| 960 | ret)) | 1017 | (setq stash (concat base ".gpg")) |
| 961 | alist)) | 1018 | (when (string-match "gpg:\\(.+\\)" v) |
| 1019 | (require 'epa nil t) | ||
| 1020 | (unless (featurep 'epa) | ||
| 1021 | (error "EPA could not be loaded.")) | ||
| 1022 | (setq gpgdata (base64-decode-string | ||
| 1023 | (match-string 1 v))) | ||
| 1024 | ;; it's a GPG token | ||
| 1025 | (setq | ||
| 1026 | token-decoder | ||
| 1027 | (lambda (gpgdata) | ||
| 1028 | ;;; FIXME: this relies on .gpg files being handled by EPA/EPG | ||
| 1029 | (let* ((passkey (format "gpg:-%s" base)) | ||
| 1030 | ;; temporarily disable EPA | ||
| 1031 | (stashfile | ||
| 1032 | (with-auth-source-epa-overrides | ||
| 1033 | (make-temp-file "gpg-token" nil | ||
| 1034 | stash))) | ||
| 1035 | (epa-file-passphrase-alist | ||
| 1036 | `((,stashfile | ||
| 1037 | . ,(password-read | ||
| 1038 | (format | ||
| 1039 | "token pass for %s? " | ||
| 1040 | filename) | ||
| 1041 | passkey))))) | ||
| 1042 | (unwind-protect | ||
| 1043 | (progn | ||
| 1044 | ;; temporarily disable EPA | ||
| 1045 | (with-auth-source-epa-overrides | ||
| 1046 | (write-region gpgdata | ||
| 1047 | nil | ||
| 1048 | stashfile)) | ||
| 1049 | (setq | ||
| 1050 | v | ||
| 1051 | (with-temp-buffer | ||
| 1052 | (insert-file-contents stashfile) | ||
| 1053 | (buffer-substring-no-properties | ||
| 1054 | (point-min) | ||
| 1055 | (point-max))))) | ||
| 1056 | (delete-file stashfile))) | ||
| 1057 | ;; clear out the decoder at end | ||
| 1058 | (setq token-decoder nil | ||
| 1059 | gpgdata nil)))) | ||
| 1060 | (lambda () | ||
| 1061 | (when token-decoder | ||
| 1062 | (funcall token-decoder gpgdata)) | ||
| 1063 | v)))) | ||
| 1064 | (setq ret (plist-put ret | ||
| 1065 | (intern (concat ":" k)) | ||
| 1066 | v)))) | ||
| 1067 | ret)) | ||
| 1068 | alist)) | ||
| 962 | 1069 | ||
| 963 | ;;; (setq secret (plist-get (nth 0 (auth-source-search :host t :type 'netrc :K 1 :max 1)) :secret)) | 1070 | ;;; (setq secret (plist-get (nth 0 (auth-source-search :host t :type 'netrc :K 1 :max 1)) :secret)) |
| 964 | ;;; (funcall secret) | 1071 | ;;; (funcall secret) |
| @@ -982,7 +1089,8 @@ See `auth-source-search' for details on SPEC." | |||
| 982 | :file (oref backend source) | 1089 | :file (oref backend source) |
| 983 | :host (or host t) | 1090 | :host (or host t) |
| 984 | :user (or user t) | 1091 | :user (or user t) |
| 985 | :port (or port t))))) | 1092 | :port (or port t)) |
| 1093 | (oref backend source)))) | ||
| 986 | 1094 | ||
| 987 | ;; if we need to create an entry AND none were found to match | 1095 | ;; if we need to create an entry AND none were found to match |
| 988 | (when (and create | 1096 | (when (and create |
| @@ -1098,7 +1206,21 @@ See `auth-source-search' for details on SPEC." | |||
| 1098 | (cond | 1206 | (cond |
| 1099 | ((and (null data) (eq r 'secret)) | 1207 | ((and (null data) (eq r 'secret)) |
| 1100 | ;; Special case prompt for passwords. | 1208 | ;; Special case prompt for passwords. |
| 1101 | (read-passwd prompt)) | 1209 | ;; Respect `auth-source-save-secrets' |
| 1210 | (let* ((ep (format "Do you want GPG password tokens? (%s)" | ||
| 1211 | "see `auth-source-save-secrets'")) | ||
| 1212 | (gpg-encrypt | ||
| 1213 | ;;; FIXME: this relies on .gpg files being handled by EPA/EPG | ||
| 1214 | ;; don't put GPG tokens in GPG-encrypted files | ||
| 1215 | (and (not (equal "gpg" (file-name-extension file))) | ||
| 1216 | (or (eq auth-source-save-secrets 'gpg) | ||
| 1217 | (and (eq auth-source-save-secrets 'ask) | ||
| 1218 | (setq auth-source-save-secrets | ||
| 1219 | (and (y-or-n-p ep) 'gpg)))))) | ||
| 1220 | (plain (read-passwd prompt))) | ||
| 1221 | (if (eq auth-source-save-secrets 'gpg) | ||
| 1222 | (auth-source-epa-make-gpg-token plain file) | ||
| 1223 | plain))) | ||
| 1102 | ((null data) | 1224 | ((null data) |
| 1103 | (when default | 1225 | (when default |
| 1104 | (setq prompt | 1226 | (setq prompt |