From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Ted Zlatanov Newsgroups: gmane.emacs.devel Subject: Re: secure plist store Date: Wed, 29 Jun 2011 09:37:40 -0500 Organization: =?utf-8?B?0KLQtdC+0LTQvtGAINCX0LvQsNGC0LDQvdC+0LI=?= @ Cienfuegos Message-ID: <877h84r9e3.fsf@lifelogs.com> References: <87pqmxvfoh.fsf@lifelogs.com> <87sjrttwh8.fsf@lifelogs.com> <87wrh4b9h9.fsf@lifelogs.com> <87aae05l8p.fsf-ueno@unixuser.org> <87k4d4b66p.fsf@lifelogs.com> <87wrh0fh4g.fsf_-_@lifelogs.com> <87y60ncma8.fsf_-_@lifelogs.com> <87vcvrne02.fsf-ueno@unixuser.org> <87r56ep3sm.fsf@lifelogs.com> <874o39n171.fsf-ueno@unixuser.org> <87mxh0sy9o.fsf@lifelogs.com> <87pqlwkfw1.fsf-ueno@unixuser.org> Reply-To: emacs-devel@gnu.org NNTP-Posting-Host: lo.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: dough.gmane.org 1309364395 30527 80.91.229.12 (29 Jun 2011 16:19:55 GMT) X-Complaints-To: usenet@dough.gmane.org NNTP-Posting-Date: Wed, 29 Jun 2011 16:19:55 +0000 (UTC) To: emacs-devel@gnu.org Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Wed Jun 29 18:19:51 2011 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([140.186.70.17]) by lo.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1QbxUT-0007Eb-UU for ged-emacs-devel@m.gmane.org; Wed, 29 Jun 2011 18:19:50 +0200 Original-Received: from localhost ([::1]:41073 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1QbxUS-0000nL-LU for ged-emacs-devel@m.gmane.org; Wed, 29 Jun 2011 12:19:48 -0400 Original-Received: from eggs.gnu.org ([140.186.70.92]:50786) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1QbvwA-0006KJ-8s for emacs-devel@gnu.org; Wed, 29 Jun 2011 10:40:23 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1Qbvw6-0008H8-UT for emacs-devel@gnu.org; Wed, 29 Jun 2011 10:40:18 -0400 Original-Received: from lo.gmane.org ([80.91.229.12]:40810) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Qbvw6-0008GD-5P for emacs-devel@gnu.org; Wed, 29 Jun 2011 10:40:14 -0400 Original-Received: from list by lo.gmane.org with local (Exim 4.69) (envelope-from ) id 1Qbvw0-00031G-J4 for emacs-devel@gnu.org; Wed, 29 Jun 2011 16:40:08 +0200 Original-Received: from 38.98.147.133 ([38.98.147.133]) by main.gmane.org with esmtp (Gmexim 0.1 (Debian)) id 1AlnuQ-0007hv-00 for ; Wed, 29 Jun 2011 16:40:08 +0200 Original-Received: from tzz by 38.98.147.133 with local (Gmexim 0.1 (Debian)) id 1AlnuQ-0007hv-00 for ; Wed, 29 Jun 2011 16:40:08 +0200 X-Injected-Via-Gmane: http://gmane.org/ Mail-Followup-To: emacs-devel@gnu.org Original-Lines: 239 Original-X-Complaints-To: usenet@dough.gmane.org X-Gmane-NNTP-Posting-Host: 38.98.147.133 X-Face: bd.DQ~'29fIs`T_%O%C\g%6jW)yi[zuz6; d4V0`@y-~$#3P_Ng{@m+e4o<4P'#(_GJQ%TT= D}[Ep*b!\e,fBZ'j_+#"Ps?s2!4H2-Y"sx" Mail-Copies-To: never User-Agent: Gnus/5.110018 (No Gnus v0.18) Emacs/24.0.50 (gnu/linux) Cancel-Lock: sha1:leQPz+m+Ea9s898IT1qCdDwOSO4= X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.6 (newer, 3) X-Received-From: 80.91.229.12 X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.14 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.devel:141179 Archived-At: --=-=-= Content-Type: text/plain Of course, I forgot to attach the patch. Sorry! --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=auth-source-epg-direct-calls.patch 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)))) --=-=-=--