secure plist store

[Daiki Ueno]

Daiki Ueno <address@hidden> writes:

> If your statement in <address@hidden>:
>
>   The decoding will happen late, probably in the funcall to obtain the
>   secret (and it will set some scoped variables to cache the data)
>
> is true, epg-encrypt-string is not necessarily to be optimized in that
> way, I think.  How about implementing your side first and profiling
> before the optimization?

I didn't notice that the field encryption code is already checked in.
However, it does not work for me at all and looks too complicated - also
it apparently does not benefit from GPG2 passphrase caching (see "(auth)
GnuPG and EasyPG Assistant Configuration").

I don't want to see that the Gnus password-caching feature becomes
harder and harder to use daily... Is it not feasible to stop reusing
netrc pieces and employ a new format, which is more GPG friendly?  Yeah,
I'm reluctant to repeat the same discussion - here is a
proof-of-concept implementation of searchable, partially encrypted,
persistent plist store, called plstore.el.

Creation:

(setq store (plstore-open (expand-file-name "~/.emacs.d/auth")))
(plstore-put store "foo" '(:host "foo.example.org" :user "test") nil)
(plstore-save store)

;; mark :user property as secret
(plstore-put store "bar" '(:host "bar.example.org") '(:user "test"))
(plstore-put store "baz" '(:host "baz.example.org") '(:user "test"))
(plstore-save store) ;<= will ask passphrase via GPG

Search:

(setq store (plstore-open (expand-file-name "auth.el" user-emacs-directory)))
(plstore-find store '(:host "foo.example.org"))
(plstore-find store '(:host "bar.example.org")) ;<= will ask passphrase via GPG

The file format of ~/.emacs.d/auth:

--8<---------------cut here---------------start------------->8---
(("baz" :secret-user t :host "baz.example.org")
 ("bar" :secret-user t :host "bar.example.org")
 ("foo" :host "foo.example.org" :port 80))
"-----BEGIN PGP MESSAGE-----
Version: GnuPG v2.0.17 (GNU/Linux)

jA0EAwMCXQZhP/0Se0DUyTQcC17GCo0CdT+RfFFskWp4aNYW/aOT/qbv24M1vPfx
TFi9AR7iVc6qlg+9cA3f3buYBGvp
=UEHH
-----END PGP MESSAGE-----
"
--8<---------------cut here---------------end--------------->8---

;;; plstore.el --- searchable, partially encrypted, persistent plist store
;; Copyright (C) 2011 Free Software Foundation, Inc.

;; Author: Daiki Ueno <address@hidden>
;; Keywords: PGP, GnuPG

;; This file is part of GNU Emacs.

;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary

;; Creating:
;;
;; (setq store (plstore-open (expand-file-name "auth" user-emacs-directory)))
;; (plstore-put store "foo" '(:host "foo.example.org" :port 80) nil)
;; (plstore-save store)
;; ;; :user property is secret
;; (plstore-put store "bar" '(:host "bar.example.org") '(:user "test"))
;; (plstore-put store "baz" '(:host "baz.example.org") '(:user "test"))
;; (plstore-save store) ;<= will ask passphrase via GPG
;;
;; Searching:
;;
;; (setq store (plstore-open (expand-file-name "auth.el" user-emacs-directory)))
;; (plstore-find store '(:host "foo.example.org"))
;; (plstore-find store '(:host "bar.example.org")) ;<= will ask passphrase via 
GPG
;; 

;;; Code:

(require 'epg)
(require 'epa)                          ;epa-passphrase-callback-function

(defvar plstore-cache-passphrase-for-symmetric-encryption nil)
(defvar plstore-passphrase-alist nil)

(defun plstore-passphrase-callback-function (context key-id plstore)
  (if (and plstore-cache-passphrase-for-symmetric-encryption
           (eq key-id 'SYM))
      (progn
        (let* ((file (file-truename (plstore-get-file plstore)))
               (entry (assoc file plstore-passphrase-alist))
              passphrase)
          (or (copy-sequence (cdr entry))
              (progn
                (unless entry
                  (setq entry (list file)
                        plstore-passphrase-alist
                        (cons entry
                              plstore-passphrase-alist)))
                (setq passphrase (epa-passphrase-callback-function context
                                                                   key-id
                                                                   file))
                (setcdr entry (copy-sequence passphrase))
                passphrase))))
    (epa-passphrase-callback-function context key-id
                                      (plstore-get-file plstore))))

(defun plstore-get-file (this)
  (aref this 0))

(defun plstore-get-alist (this)
  (aref this 1))

(defun plstore-get-encrypted-data (this)
  (aref this 2))

(defun plstore-get-secret-alist (this)
  (aref this 3))

(defun plstore-get-merged-alist (this)
  (aref this 4))

(defun plstore-get-decrypted (this)
  (aref this 5))

(defun plstore-set-file (this file)
  (aset this 0 file))

(defun plstore-set-alist (this plist)
  (aset this 1 plist))

(defun plstore-set-encrypted-data (this encrypted-data)
  (aset this 2 encrypted-data))

(defun plstore-set-secret-alist (this secret-alist)
  (aset this 3 secret-alist))

(defun plstore-set-merged-alist (this merged-alist)
  (aset this 4 merged-alist))

(defun plstore-set-decrypted (this decrypted)
  (aset this 5 decrypted))

;;;###autoload
(defun plstore-open (file)
  "Create a plstore instance associated with FILE."
  (let ((store (vector
                file
                nil                  ;plist (plist)
                nil                  ;encrypted data (string)
                nil                  ;secret plist (plist)
                nil                  ;merged plist (plist)
                nil                  ;decrypted (bool)
                )))
    (condition-case nil
        (with-temp-buffer
          (insert-file-contents (plstore-get-file store))
          (goto-char (point-min))
          (plstore-set-alist store (read (point-marker)))
          (forward-sexp)
          (plstore-set-encrypted-data store (read (point-marker)))
          ;; merged plist initially contains only unencrypted plist
          (plstore-set-merged-alist store (plstore-get-alist store)))
      (error))
    store))

(defun plstore--merge-secret (plstore)
  (let ((alist (plstore-get-secret-alist plstore))
        (modified-alist (plstore-get-merged-alist plstore))
        modified-plist
        modified-entry
        entry
        plist
        placeholder)
    (while alist
      (setq entry (car alist)
            alist (cdr alist)
            plist (cdr entry)
            modified-entry (assoc (car entry) modified-alist)
            modified-plist (cdr modified-entry))
      (while plist
        (setq placeholder
              (plist-member
               modified-plist
               (intern (concat ":secret-"
                               (substring (symbol-name (car plist)) 1)))))
        (if placeholder
            (setcar placeholder (car plist)))
        (setq modified-plist
              (plist-put modified-plist (car plist) (car (cdr plist))))
        (setq plist (nthcdr 2 plist)))
      (setcdr modified-entry modified-plist))))

(defun plstore--decrypt (plstore)
  (if (and (not (plstore-get-decrypted plstore))
           (plstore-get-encrypted-data plstore))
      (let ((context (epg-make-context 'OpenPGP))
            plain)
        (epg-context-set-passphrase-callback
         context
         (cons #'plstore-passphrase-callback-function
               plstore))
        (setq plain
              (epg-decrypt-string context
                                  (plstore-get-encrypted-data plstore)))
        (plstore-set-secret-alist plstore (car (read-from-string plain)))
        (plstore--merge-secret plstore)
        (plstore-set-decrypted plstore t))))

(defun plstore--match (entry keys skip-if-secret-found)
  (let ((result t) key-name key-value prop-value secret-name)
    (while keys
      (setq key-name (car keys)
            key-value (car (cdr keys))
            prop-value (plist-get (cdr entry) key-name))
        (unless (equal prop-value key-value)
          (if skip-if-secret-found
              (progn
                (setq secret-name
                      (intern (concat ":secret-"
                                      (substring (symbol-name key-name) 1))))
                (if (plist-member (cdr entry) secret-name)
                    (setq result 'secret)
                  (setq result nil
                        keys nil)))
            (setq result nil
                  keys nil)))
        (setq keys (nthcdr 2 keys)))
    result))

(defun plstore-find (plstore keys)
  "Perform search on PLSTORE with KEYS.
KEYS is a plist."
  (let (entries alist entry match decrypt plist)
    ;; First, go through the merged plist alist and collect entries
    ;; matched with keys.
    (setq alist (plstore-get-merged-alist plstore))
    (while alist
      (setq entry (car alist)
            alist (cdr alist)
            match (plstore--match entry keys t))
      (if (eq match 'secret)
          (setq decrypt t)
        (when match
          (setq plist (cdr entry))
          (while plist
            (if (string-match "\\`:secret-" (symbol-name (car plist)))
                (setq decrypt t
                      plist nil))
            (setq plist (nthcdr 2 plist)))
          (setq entries (cons entry entries)))))
    ;; Second, decrypt the encrypted plist and try again.
    (when decrypt
      (setq entries nil)
      (plstore--decrypt plstore)
      (setq alist (plstore-get-merged-alist plstore))
      (while alist
        (setq entry (car alist)
              alist (cdr alist)
              match (plstore--match entry keys nil))
        (if match
            (setq entries (cons entry entries)))))
    (nreverse entries)))

(defun plstore-put (plstore name keys secret-keys)
  "Put an entry with NAME in PLSTORE.
KEYS is a plist containing non-secret data.
SECRET-KEYS is a plist containing secret data."
  (let (entry
        plist
        secret-plist
        merged-plist
        symbol)
    (while secret-keys
      (setq symbol
            (intern (concat ":secret-"
                            (substring (symbol-name (car secret-keys)) 1))))
      (setq plist (plist-put plist symbol t)
            secret-plist (plist-put secret-plist
                                    (car secret-keys) (car (cdr secret-keys)))
            merged-plist (plist-put merged-plist
                                    (car secret-keys) (car (cdr secret-keys)))
            secret-keys (nthcdr 2 secret-keys)))
    (while keys
      (setq symbol
            (intern (concat ":secret-"
                            (substring (symbol-name (car keys)) 1))))
      (setq plist (plist-put plist (car keys) (car (cdr keys)))
            merged-plist (plist-put merged-plist (car keys) (car (cdr keys)))
            keys (nthcdr 2 keys)))
    (setq entry (assoc name (plstore-get-alist plstore)))
    (if entry
        (setcdr entry plist)
      (plstore-set-alist
       plstore
       (cons (cons name plist) (plstore-get-alist plstore))))
    (when secret-plist
      (setq entry (assoc name (plstore-get-secret-alist plstore)))
      (if entry
          (setcdr entry secret-plist)
        (plstore-set-secret-alist
         plstore
         (cons (cons name secret-plist) (plstore-get-secret-alist plstore)))))
    (setq entry (assoc name (plstore-get-merged-alist plstore)))
    (if entry
        (setcdr entry merged-plist)
      (plstore-set-merged-alist
       plstore
       (cons (cons name merged-plist) (plstore-get-merged-alist plstore))))))

(defun plstore-save (plstore)
  "Save the contents of PLSTORE associated with a FILE."
  (with-temp-buffer
    (insert (pp-to-string (plstore-get-alist plstore)))
    (if (plstore-get-secret-alist plstore)
        (let ((context (epg-make-context 'OpenPGP))
              (pp-escape-newlines nil)
              cipher)
          (epg-context-set-armor context t)
          (epg-context-set-passphrase-callback
           context
           (cons #'plstore-passphrase-callback-function
                 plstore))
          (setq cipher (epg-encrypt-string context
                                           (pp-to-string
                                            (plstore-get-secret-alist plstore))
                                           nil))
          (insert (pp-to-string cipher))))
    (write-region (point-min) (point-max) (plstore-get-file plstore))))

(provide 'plstore)

;;; plstore.el ends here

As you see, secret properties are prefixed with ":secret-" and the value
is hidden, and the real properties are encrypted together in the GPG
data at the end.  If you decrypt the GPG data, you will see:

(("baz" :user "test")
 ("bar" :user "test"))

Regards,
-- 
Daiki Ueno