From: Ted Zlatanov <tzz@lifelogs.com>
To: emacs-devel@gnu.org
Subject: Re: secure plist store
Date: Wed, 29 Jun 2011 09:37:40 -0500 [thread overview]
Message-ID: <877h84r9e3.fsf@lifelogs.com> (raw)
In-Reply-To: 87pqlwkfw1.fsf-ueno@unixuser.org
[-- Attachment #1: Type: text/plain, Size: 50 bytes --]
Of course, I forgot to attach the patch. Sorry!
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: auth-source-epg-direct-calls.patch --]
[-- Type: text/x-diff, Size: 10661 bytes --]
diff --git a/lisp/auth-source.el b/lisp/auth-source.el
index 146db11..4087675 100644
--- a/lisp/auth-source.el
+++ b/lisp/auth-source.el
@@ -43,6 +43,9 @@
(require 'mm-util)
(require 'gnus-util)
(require 'assoc)
+(require 'epa)
+(require 'epg)
+
(eval-when-compile (require 'cl))
(eval-and-compile
(or (ignore-errors (require 'eieio))
@@ -972,56 +975,86 @@ Note that the MAX parameter is used so we can exit the parse early."
(nreverse result))))))
-(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))
- (,(if (boundp 'find-file-hook) 'find-file-hook 'find-file-hooks)
- ',(remove
- 'epa-file-find-file-hook
- (if (boundp 'find-file-hook)
- (symbol-value 'find-file-hook)
- (symbol-value 'find-file-hooks))))
- (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))
-
+(defvar auth-source-passphrase-alist nil)
+
+(defun auth-source-passphrase-callback-function (context key-id handback
+ &optional sym-detail)
+"Exactly like `epa-passphrase-callback-function' but takes an
+extra SYM-DETAIL parameter which will be printed at the end of
+the symmetric passphrase prompt."
+ (if (eq key-id 'SYM)
+ (read-passwd
+ (format "Passphrase for symmetric encryption%s%s: "
+ ;; Add the file name to the prompt, if any.
+ (if (stringp handback)
+ (format " for %s" handback)
+ "")
+ (if (stringp sym-detail)
+ sym-detail
+ ""))
+ (eq (epg-context-operation context) 'encrypt))
+ (read-passwd
+ (if (eq key-id 'PIN)
+ "Passphrase for PIN: "
+ (let ((entry (assoc key-id epg-user-id-alist)))
+ (if entry
+ (format "Passphrase for %s %s: " key-id (cdr entry))
+ (format "Passphrase for %s: " key-id)))))))
+
+(defun auth-source-token-passphrase-callback-function (context key-id file)
+ (if (eq key-id 'SYM)
+ (let* ((file (file-truename file))
+ (entry (assoc file auth-source-passphrase-alist))
+ passphrase)
+ ;; return the saved passphrase, calling a function if needed
+ (or (copy-sequence (if (functionp (cdr entry))
+ (funcall (cdr entry))
+ (cdr entry)))
+ (progn
+ (unless entry
+ (setq entry (list file))
+ (push entry auth-source-passphrase-alist))
+ (setq passphrase (auth-source-passphrase-callback-function context
+ key-id
+ file
+ " tokens"))
+ (setcdr entry (lexical-let ((p (copy-sequence passphrase)))
+ (lambda () p)))
+ passphrase)))
+ (auth-source-passphrase-callback-function context key-id file " tokens")))
+
+
+;; (auth-source-epa-extract-gpg-token "gpg:LS0tLS1CRUdJTiBQR1AgTUVTU0FHRS0tLS0tClZlcnNpb246IEdudVBHIHYxLjQuMTEgKEdOVS9MaW51eCkKCmpBMEVBd01DT25qMjB1ak9rZnRneVI3K21iNm9aZWhuLzRad3cySkdlbnVaKzRpeEswWDY5di9icDI1U1dsQT0KPS9yc2wKLS0tLS1FTkQgUEdQIE1FU1NBR0UtLS0tLQo=" "~/.netrc")
+(defun auth-source-epa-extract-gpg-token (secret file)
+ "Pass either the decoded SECRET or the gpg:BASE64DATA version.
+FILE is the file from which we obtained this token."
+ (when (string-match "^gpg:\\(.+\\)" secret)
+ (setq secret (base64-decode-string (match-string 1 secret))))
+ (let ((context (epg-make-context 'OpenPGP))
+ plain)
+ (epg-context-set-passphrase-callback
+ context
+ (cons #'auth-source-token-passphrase-callback-function
+ file))
+ (epg-decrypt-string context secret)))
+
+;; (insert (auth-source-epa-make-gpg-token "mysecret" "~/.netrc"))
(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))))
+ (let ((context (epg-make-context 'OpenPGP))
+ (pp-escape-newlines nil)
+ cipher)
+ (epg-context-set-armor context t)
+ (epg-context-set-passphrase-callback
+ context
+ (cons #'auth-source-token-passphrase-callback-function
+ file))
+ (setq cipher (epg-encrypt-string context secret nil))
+ (with-temp-buffer
+ (insert cipher)
+ (base64-encode-region (point-min) (point-max) t)
+ (concat "gpg:" (buffer-substring-no-properties
+ (point-min)
+ (point-max))))))
(defun auth-source-netrc-normalize (alist filename)
(mapcar (lambda (entry)
@@ -1039,60 +1072,22 @@ 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)
- (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 v (lexical-let ((lexv v)
+ (token-decoder nil))
+ (when (string-match "^gpg:" lexv)
+ ;; it's a GPG token: create a token decoder
+ ;; which unsets itself once
+ (setq token-decoder
+ (lambda (val)
+ (prog1
+ (auth-source-epa-extract-gpg-token
+ val
+ filename)
+ (setq token-decoder nil)))))
+ (lambda ()
+ (when token-decoder
+ (setq lexv (funcall token-decoder lexv)))
+ lexv))))
(setq ret (plist-put ret
(intern (concat ":" k))
v))))
next prev parent reply other threads:[~2011-06-29 14:37 UTC|newest]
Thread overview: 203+ messages / expand[flat|nested] mbox.gz Atom feed top
2011-04-23 18:54 Emacs RPC Lars Magne Ingebrigtsen
2011-04-24 3:21 ` T.V. Raman
2011-04-24 20:04 ` Richard Stallman
2011-04-24 20:24 ` Lars Magne Ingebrigtsen
2011-04-25 17:55 ` Richard Stallman
2011-05-01 18:53 ` Lars Magne Ingebrigtsen
2011-05-02 2:13 ` Lars Magne Ingebrigtsen
2011-05-02 21:25 ` Chong Yidong
2011-05-02 22:54 ` Lars Magne Ingebrigtsen
2011-04-24 20:26 ` Daniel Colascione
2011-04-25 17:56 ` Richard Stallman
2011-04-24 17:40 ` Chong Yidong
2011-04-24 18:00 ` Lars Magne Ingebrigtsen
2011-04-24 19:56 ` Chong Yidong
2011-04-25 1:21 ` Ted Zlatanov
2011-04-25 1:26 ` Lars Magne Ingebrigtsen
2011-04-25 2:05 ` Ted Zlatanov
2011-04-25 12:57 ` Stefan Monnier
2011-04-25 12:59 ` Stefan Monnier
2011-04-25 17:00 ` Emacs RPC security (was: Emacs RPC) Ted Zlatanov
2011-04-25 17:35 ` Emacs RPC security Stefan Monnier
2011-04-25 18:02 ` Ted Zlatanov
2011-04-25 18:17 ` Daniel Colascione
2011-04-25 19:43 ` Ted Zlatanov
2011-04-25 18:38 ` Stefan Monnier
2011-04-25 18:57 ` Ted Zlatanov
2011-05-01 18:55 ` Lars Magne Ingebrigtsen
2011-05-01 22:02 ` Lars Magne Ingebrigtsen
2011-05-01 22:19 ` Opportunistic STARTTLS in smtpmail.el (was: Emacs RPC security) Lars Magne Ingebrigtsen
2011-05-02 15:20 ` Opportunistic STARTTLS in smtpmail.el James Cloos
2011-05-02 18:52 ` Ted Zlatanov
2011-05-02 18:59 ` Lars Magne Ingebrigtsen
2011-05-02 19:21 ` Ted Zlatanov
2011-05-02 23:36 ` Lars Magne Ingebrigtsen
2011-05-03 0:29 ` Ted Zlatanov
2011-05-03 1:01 ` Lars Magne Ingebrigtsen
2011-05-03 1:22 ` Ted Zlatanov
2011-05-03 22:04 ` Lars Magne Ingebrigtsen
2011-05-04 1:37 ` Ted Zlatanov
2011-05-30 17:45 ` Lars Magne Ingebrigtsen
2011-05-30 18:07 ` Robert Pluim
2011-05-30 18:14 ` Lars Magne Ingebrigtsen
2011-05-30 18:54 ` Robert Pluim
2011-05-30 19:13 ` Stefan Monnier
2011-05-30 19:43 ` Lars Magne Ingebrigtsen
2011-05-30 23:10 ` Lars Magne Ingebrigtsen
2011-05-31 7:11 ` Robert Pluim
2011-05-31 10:13 ` Ted Zlatanov
2011-05-31 18:19 ` Lars Magne Ingebrigtsen
2011-05-31 19:39 ` Ted Zlatanov
2011-05-31 20:32 ` Lars Magne Ingebrigtsen
2011-06-01 0:37 ` Ted Zlatanov
2011-06-01 1:29 ` Stefan Monnier
2011-06-01 2:04 ` Ted Zlatanov
2011-06-01 12:37 ` Stefan Monnier
2011-06-01 13:34 ` Ted Zlatanov
2011-06-01 14:39 ` Stefan Monnier
2011-06-01 15:14 ` Ted Zlatanov
2011-06-02 4:09 ` Stefan Monnier
2011-06-02 8:57 ` Robert Pluim
2011-06-02 11:45 ` Daiki Ueno
2011-06-02 12:24 ` Stefan Monnier
2011-06-02 14:20 ` Ted Zlatanov
2011-06-02 15:03 ` Daiki Ueno
2011-06-02 15:31 ` Ted Zlatanov
2011-06-03 21:54 ` Lars Magne Ingebrigtsen
2011-06-05 15:11 ` netrc field encryption in auth-source (was: Opportunistic STARTTLS in smtpmail.el) Ted Zlatanov
2011-06-26 10:09 ` netrc field encryption in auth-source Lars Magne Ingebrigtsen
2011-06-27 15:43 ` GPGME (was: netrc field encryption in auth-source) Ted Zlatanov
2011-06-27 21:47 ` GPGME Daiki Ueno
2011-06-28 11:56 ` GPGME Ted Zlatanov
2011-06-28 20:36 ` GPGME Daiki Ueno
2011-06-29 8:07 ` secure plist store Daiki Ueno
2011-06-29 8:25 ` Lars Magne Ingebrigtsen
2011-06-29 9:05 ` Daiki Ueno
2011-06-29 10:46 ` Ted Zlatanov
2011-06-29 11:30 ` Daiki Ueno
2011-06-29 12:38 ` Ted Zlatanov
2011-06-29 13:39 ` Daiki Ueno
2011-06-29 10:54 ` Ted Zlatanov
2011-06-29 11:59 ` Daiki Ueno
2011-06-29 12:58 ` Ted Zlatanov
2011-06-29 14:34 ` Ted Zlatanov
2011-06-29 18:31 ` Daiki Ueno
2011-06-30 12:23 ` Ted Zlatanov
2011-06-30 23:10 ` Daiki Ueno
2011-07-01 13:36 ` Ted Zlatanov
2011-06-29 14:37 ` Ted Zlatanov [this message]
2011-06-29 14:36 ` Ted Zlatanov
2011-06-30 7:43 ` Daiki Ueno
2011-06-30 12:19 ` Ted Zlatanov
2011-06-30 13:42 ` Daiki Ueno
2011-06-30 14:54 ` Ted Zlatanov
2011-06-30 22:18 ` Daiki Ueno
2011-06-30 22:34 ` Ted Zlatanov
2011-07-01 2:28 ` Daiki Ueno
2011-07-01 13:18 ` Ted Zlatanov
2011-07-03 2:13 ` Daiki Ueno
2011-06-29 11:09 ` GPGME Ted Zlatanov
2011-06-29 13:15 ` GPGME Daiki Ueno
2011-06-29 17:21 ` GPGME Ted Zlatanov
2011-06-29 18:41 ` GPGME Daiki Ueno
2011-06-30 12:46 ` GPGME Ted Zlatanov
2011-06-02 13:09 ` Opportunistic STARTTLS in smtpmail.el Ted Zlatanov
2011-06-02 13:44 ` Daiki Ueno
2011-06-03 21:50 ` Lars Magne Ingebrigtsen
2011-05-31 1:25 ` Stefan Monnier
2011-05-31 18:21 ` Lars Magne Ingebrigtsen
2011-05-31 21:18 ` Stefan Monnier
2011-06-03 21:48 ` Lars Magne Ingebrigtsen
2011-06-05 14:55 ` Ted Zlatanov
2011-06-09 18:02 ` Lars Magne Ingebrigtsen
2011-06-09 21:06 ` Ted Zlatanov
2011-06-10 16:05 ` netrc field encryption in auth-source (was: Opportunistic STARTTLS in smtpmail.el) Ted Zlatanov
2011-06-13 21:47 ` netrc field encryption in auth-source Ted Zlatanov
2011-06-13 22:21 ` Lars Magne Ingebrigtsen
2011-06-15 16:20 ` Lars Magne Ingebrigtsen
2011-06-15 21:21 ` Lars Magne Ingebrigtsen
2011-06-16 3:49 ` Ted Zlatanov
2011-06-16 8:32 ` Robert Pluim
2011-06-16 13:35 ` Ted Zlatanov
2011-06-16 20:28 ` Reiner Steib
2011-06-16 21:05 ` Lars Magne Ingebrigtsen
2011-06-17 1:03 ` should docstrings include all defcustom options? (was: netrc field encryption in auth-source) Ted Zlatanov
2011-06-17 7:17 ` netrc field encryption in auth-source Robert Pluim
2011-06-17 9:32 ` Ted Zlatanov
2011-06-17 9:53 ` Robert Pluim
2011-06-17 10:21 ` Ted Zlatanov
2011-06-21 19:32 ` Lars Magne Ingebrigtsen
2011-06-21 19:51 ` Ted Zlatanov
2011-06-21 20:19 ` Committing new smtpmail.el later tonight (was: netrc field encryption in auth-source) Lars Magne Ingebrigtsen
2011-06-21 21:01 ` Committing new smtpmail.el later tonight Lars Magne Ingebrigtsen
2011-06-21 22:07 ` Antoine Levitt
2011-06-21 22:17 ` Lars Magne Ingebrigtsen
2011-06-21 22:25 ` Antoine Levitt
2011-06-21 22:36 ` Lars Magne Ingebrigtsen
2011-06-21 22:46 ` Lars Magne Ingebrigtsen
2011-06-21 22:57 ` Lars Magne Ingebrigtsen
2011-06-22 9:01 ` Antoine Levitt
2011-06-22 8:27 ` Robert Pluim
2011-06-22 8:30 ` Lars Magne Ingebrigtsen
2011-06-22 8:52 ` Robert Pluim
2011-06-22 9:11 ` Lars Magne Ingebrigtsen
2011-06-22 9:17 ` Lars Magne Ingebrigtsen
2011-06-22 9:34 ` Robert Pluim
2011-06-22 9:41 ` Lars Magne Ingebrigtsen
2011-06-22 14:25 ` Lars Magne Ingebrigtsen
2011-06-22 14:49 ` Lars Magne Ingebrigtsen
2011-06-22 17:45 ` Robert Pluim
2011-06-22 18:48 ` Lars Magne Ingebrigtsen
2011-06-23 8:01 ` Robert Pluim
2011-06-22 15:51 ` Ted Zlatanov
2011-06-22 19:24 ` Lars Magne Ingebrigtsen
2011-06-22 20:27 ` Ted Zlatanov
2011-06-22 20:43 ` Lars Magne Ingebrigtsen
2011-06-22 21:36 ` Ted Zlatanov
2011-06-22 2:52 ` Eli Zaretskii
2011-06-22 14:53 ` Lars Magne Ingebrigtsen
2011-06-22 15:50 ` Robert Pluim
2011-06-22 16:19 ` Eli Zaretskii
2011-06-22 17:16 ` Ted Zlatanov
2011-06-22 19:50 ` Eli Zaretskii
2011-06-22 19:56 ` Lars Magne Ingebrigtsen
2011-06-22 21:32 ` Ted Zlatanov
2011-06-22 20:27 ` Stefan Monnier
2011-06-22 20:38 ` Lars Magne Ingebrigtsen
2011-06-22 20:53 ` Lars Magne Ingebrigtsen
2011-06-22 15:55 ` Ted Zlatanov
2011-06-22 16:51 ` Eli Zaretskii
2011-06-22 15:56 ` Ted Zlatanov
2011-06-30 13:16 ` netrc field encryption in auth-source Ted Zlatanov
2011-06-06 15:06 ` Opportunistic STARTTLS in smtpmail.el Stefan Monnier
2011-06-09 17:56 ` Lars Magne Ingebrigtsen
2011-06-10 20:44 ` Stefan Monnier
2011-05-03 15:20 ` client certs and CRL lists for GnuTLS (was: Opportunistic STARTTLS in smtpmail.el) Ted Zlatanov
2011-05-03 15:25 ` client certs and CRL lists for GnuTLS Lars Magne Ingebrigtsen
2011-05-03 15:47 ` Ted Zlatanov
2011-05-03 21:54 ` Lars Magne Ingebrigtsen
2011-05-04 1:39 ` Ted Zlatanov
2011-05-08 20:59 ` Chong Yidong
2011-05-09 10:52 ` Ted Zlatanov
2011-05-09 15:00 ` Chong Yidong
2011-05-09 15:30 ` Gnus ERT tests inside Emacs (was: client certs and CRL lists for GnuTLS) Ted Zlatanov
2011-05-09 15:46 ` Gnus ERT tests inside Emacs David Engster
2011-05-09 15:58 ` Ted Zlatanov
2011-05-11 21:36 ` Ted Zlatanov
2011-05-02 9:37 ` Emacs RPC security Julien Danjou
2011-05-02 18:57 ` Ted Zlatanov
2011-05-02 19:48 ` Stefan Monnier
2011-05-02 19:56 ` Ted Zlatanov
2011-05-02 22:56 ` Lars Magne Ingebrigtsen
2011-05-03 0:25 ` Ted Zlatanov
2011-05-03 0:51 ` Lars Magne Ingebrigtsen
2011-05-03 1:12 ` Ted Zlatanov
2011-05-03 1:16 ` Lars Magne Ingebrigtsen
2011-05-03 1:27 ` Ted Zlatanov
2011-05-03 1:34 ` Lars Magne Ingebrigtsen
2011-05-03 2:35 ` Stefan Monnier
2011-05-03 6:24 ` Harald Hanche-Olsen
2011-05-03 13:47 ` Stefan Monnier
2011-05-03 0:35 ` Stefan Monnier
2011-04-26 12:13 ` Emacs RPC Sebastian Rose
2011-04-26 13:18 ` Stefan Monnier
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=877h84r9e3.fsf@lifelogs.com \
--to=tzz@lifelogs.com \
--cc=emacs-devel@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).