1 ;;; plstore.el --- secure plist store -*- lexical-binding: t -*-
2 ;; Copyright (C) 2011-2016 Free Software Foundation, Inc.
4 ;; Author: Daiki Ueno <ueno@unixuser.org>
5 ;; Keywords: PGP, GnuPG
7 ;; This file is part of GNU Emacs.
9 ;; GNU Emacs is free software: you can redistribute it and/or modify
10 ;; it under the terms of the GNU General Public License as published by
11 ;; the Free Software Foundation, either version 3 of the License, or
12 ;; (at your option) any later version.
14 ;; GNU Emacs is distributed in the hope that it will be useful,
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 ;; GNU General Public License for more details.
19 ;; You should have received a copy of the GNU General Public License
20 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
24 ;; Plist based data store providing search and partial encryption.
28 ;; ;; Open a new store associated with ~/.emacs.d/auth.plist.
29 ;; (setq store (plstore-open (expand-file-name "~/.emacs.d/auth.plist")))
30 ;; ;; Both `:host' and `:port' are public property.
31 ;; (plstore-put store "foo" '(:host "foo.example.org" :port 80) nil)
32 ;; ;; No encryption will be needed.
33 ;; (plstore-save store)
35 ;; ;; `:user' is marked as secret.
36 ;; (plstore-put store "bar" '(:host "bar.example.org") '(:user "test"))
37 ;; ;; `:password' is marked as secret.
38 ;; (plstore-put store "baz" '(:host "baz.example.org") '(:password "test"))
39 ;; ;; Those secret properties are encrypted together.
40 ;; (plstore-save store)
42 ;; ;; Kill the buffer visiting ~/.emacs.d/auth.plist.
43 ;; (plstore-close store)
47 ;; (setq store (plstore-open (expand-file-name "~/.emacs.d/auth.plist")))
49 ;; ;; As the entry "foo" associated with "foo.example.org" has no
50 ;; ;; secret properties, no need to decryption.
51 ;; (plstore-find store '(:host ("foo.example.org")))
53 ;; ;; As the entry "bar" associated with "bar.example.org" has a
54 ;; ;; secret property `:user', Emacs tries to decrypt the secret (and
55 ;; ;; thus you will need to input passphrase).
56 ;; (plstore-find store '(:host ("bar.example.org")))
58 ;; ;; While the entry "baz" associated with "baz.example.org" has also
59 ;; ;; a secret property `:password', it is encrypted together with
60 ;; ;; `:user' of "bar", so no need to decrypt the secret.
61 ;; (plstore-find store '(:host ("bar.example.org")))
63 ;; (plstore-close store)
67 ;; This file also provides `plstore-mode', a major mode for editing
68 ;; the PLSTORE format file. Visit a non-existing file and put the
71 ;; (("foo" :host "foo.example.org" :secret-user "user"))
73 ;; where the prefixing `:secret-' means the property (without
74 ;; `:secret-' prefix) is marked as secret. Thus, when you save the
75 ;; buffer, the `:secret-user' property is encrypted as `:user'.
77 ;; You can toggle the view between encrypted form and the decrypted
85 "Searchable, partially encrypted, persistent plist store"
89 (defcustom plstore-select-keys 'silent
90 "Control whether or not to pop up the key selection dialog.
92 If t, always asks user to select recipients.
93 If nil, query user only when a file's default recipients are not
94 known (i.e. `plstore-encrypt-to' is not locally set in the buffer
95 visiting a plstore file).
96 If neither t nor nil, doesn't ask user."
97 :type '(choice (const :tag "Ask always" t)
98 (const :tag "Ask when recipients are not set" nil)
99 (const :tag "Don't ask" silent))
102 (defcustom plstore-encrypt-to nil
103 "Recipient(s) used for encrypting secret entries.
104 May either be a string or a list of strings. If it is nil,
105 symmetric encryption will be used."
106 :type '(choice (const nil) (repeat :tag "Recipient(s)" string))
109 (put 'plstore-encrypt-to 'safe-local-variable
115 (unless (stringp elt)
120 (put 'plstore-encrypt-to 'permanent-local t)
122 (defvar plstore-encoded nil)
124 (put 'plstore-encoded 'permanent-local t)
126 (defvar plstore-cache-passphrase-for-symmetric-encryption nil)
127 (defvar plstore-passphrase-alist nil)
129 (defun plstore-passphrase-callback-function (_context _key-id plstore)
130 (if plstore-cache-passphrase-for-symmetric-encryption
131 (let* ((file (file-truename (plstore-get-file plstore)))
132 (entry (assoc file plstore-passphrase-alist))
134 (or (copy-sequence (cdr entry))
137 (setq entry (list file)
138 plstore-passphrase-alist
140 plstore-passphrase-alist)))
142 (read-passwd (format "Passphrase for PLSTORE %s: "
143 (plstore--get-buffer plstore))))
144 (setcdr entry (copy-sequence passphrase))
146 (read-passwd (format "Passphrase for PLSTORE %s: "
147 (plstore--get-buffer plstore)))))
149 (defun plstore-progress-callback-function (_context _what _char current total
151 (if (= current total)
152 (message "%s...done" handback)
153 (message "%s...%d%%" handback
154 (if (> total 0) (floor (* (/ current (float total)) 100)) 0))))
156 (defun plstore--get-buffer (arg)
159 (defun plstore--get-alist (arg)
162 (defun plstore--get-encrypted-data (arg)
165 (defun plstore--get-secret-alist (arg)
168 (defun plstore--get-merged-alist (arg)
171 (defun plstore--set-buffer (arg buffer)
174 (defun plstore--set-alist (arg plist)
177 (defun plstore--set-encrypted-data (arg encrypted-data)
178 (aset arg 2 encrypted-data))
180 (defun plstore--set-secret-alist (arg secret-alist)
181 (aset arg 3 secret-alist))
183 (defun plstore--set-merged-alist (arg merged-alist)
184 (aset arg 4 merged-alist))
186 (defun plstore-get-file (arg)
187 (buffer-file-name (plstore--get-buffer arg)))
189 (defun plstore--make (&optional buffer alist encrypted-data secret-alist
191 (vector buffer alist encrypted-data secret-alist merged-alist))
193 (defun plstore--init-from-buffer (plstore)
194 (goto-char (point-min))
195 (when (looking-at ";;; public entries")
197 (plstore--set-alist plstore (read (point-marker)))
200 (when (looking-at ";;; secret entries")
202 (plstore--set-encrypted-data plstore (read (point-marker))))
203 (plstore--merge-secret plstore)))
206 (defun plstore-open (file)
207 "Create a plstore instance associated with FILE."
208 (let* ((filename (file-truename file))
209 (buffer (or (find-buffer-visiting filename)
210 (generate-new-buffer (format " plstore %s" filename))))
211 (store (plstore--make buffer)))
212 (with-current-buffer buffer
215 (insert-file-contents-literally file)
217 (setq buffer-file-name (file-truename file))
218 (set-buffer-modified-p nil)
219 (plstore--init-from-buffer store)
222 (defun plstore-revert (plstore)
223 "Replace current data in PLSTORE with the file on disk."
224 (with-current-buffer (plstore--get-buffer plstore)
226 (plstore--init-from-buffer plstore)))
228 (defun plstore-close (plstore)
229 "Destroy a plstore instance PLSTORE."
230 (kill-buffer (plstore--get-buffer plstore)))
232 (defun plstore--merge-secret (plstore)
233 (let ((alist (plstore--get-secret-alist plstore))
240 (plstore--set-merged-alist
242 (copy-tree (plstore--get-alist plstore)))
243 (setq modified-alist (plstore--get-merged-alist plstore))
245 (setq entry (car alist)
248 modified-entry (assoc (car entry) modified-alist)
249 modified-plist (cdr modified-entry))
254 (intern (concat ":secret-"
255 (substring (symbol-name (car plist)) 1)))))
257 (setcar placeholder (car plist)))
259 (plist-put modified-plist (car plist) (car (cdr plist))))
260 (setq plist (nthcdr 2 plist)))
261 (setcdr modified-entry modified-plist))))
263 (defun plstore--decrypt (plstore)
264 (if (plstore--get-encrypted-data plstore)
265 (let ((context (epg-make-context 'OpenPGP))
267 (epg-context-set-passphrase-callback
269 (cons #'plstore-passphrase-callback-function
271 (epg-context-set-progress-callback
273 (cons #'plstore-progress-callback-function
274 (format "Decrypting %s" (plstore-get-file plstore))))
275 (condition-case error
277 (epg-decrypt-string context
278 (plstore--get-encrypted-data plstore)))
280 (let ((entry (assoc (plstore-get-file plstore)
281 plstore-passphrase-alist)))
284 (signal (car error) (cdr error))))
285 (plstore--set-secret-alist plstore (car (read-from-string plain)))
286 (plstore--merge-secret plstore)
287 (plstore--set-encrypted-data plstore nil))))
289 (defun plstore--match (entry keys skip-if-secret-found)
290 (let ((result t) key-name key-value prop-value secret-name)
292 (setq key-name (car keys)
293 key-value (car (cdr keys))
294 prop-value (plist-get (cdr entry) key-name))
295 (unless (member prop-value key-value)
296 (if skip-if-secret-found
299 (intern (concat ":secret-"
300 (substring (symbol-name key-name) 1))))
301 (if (plist-member (cdr entry) secret-name)
302 (setq result 'secret)
307 (setq keys (nthcdr 2 keys)))
310 (defun plstore-find (plstore keys)
311 "Perform search on PLSTORE with KEYS.
313 (let (entries alist entry match decrypt plist)
314 ;; First, go through the merged plist alist and collect entries
315 ;; matched with keys.
316 (setq alist (plstore--get-merged-alist plstore))
318 (setq entry (car alist)
320 match (plstore--match entry keys t))
321 (if (eq match 'secret)
324 (setq plist (cdr entry))
326 (if (string-match "\\`:secret-" (symbol-name (car plist)))
329 (setq plist (nthcdr 2 plist)))
330 (setq entries (cons entry entries)))))
331 ;; Second, decrypt the encrypted plist and try again.
334 (plstore--decrypt plstore)
335 (setq alist (plstore--get-merged-alist plstore))
337 (setq entry (car alist)
339 match (plstore--match entry keys nil))
341 (setq entries (cons entry entries)))))
344 (defun plstore-get (plstore name)
345 "Get an entry with NAME in PLSTORE."
346 (let ((entry (assoc name (plstore--get-merged-alist plstore)))
348 (setq plist (cdr entry))
350 (if (string-match "\\`:secret-" (symbol-name (car plist)))
352 (plstore--decrypt plstore)
353 (setq entry (assoc name (plstore--get-merged-alist plstore))
355 (setq plist (nthcdr 2 plist))))
358 (defun plstore-put (plstore name keys secret-keys)
359 "Put an entry with NAME in PLSTORE.
360 KEYS is a plist containing non-secret data.
361 SECRET-KEYS is a plist containing secret data."
367 (plstore--decrypt plstore))
370 (intern (concat ":secret-"
371 (substring (symbol-name (car secret-keys)) 1))))
372 (setq plist (plist-put plist symbol t)
373 secret-plist (plist-put secret-plist
374 (car secret-keys) (car (cdr secret-keys)))
375 secret-keys (nthcdr 2 secret-keys)))
378 (intern (concat ":secret-"
379 (substring (symbol-name (car keys)) 1))))
380 (setq plist (plist-put plist (car keys) (car (cdr keys)))
381 keys (nthcdr 2 keys)))
382 (setq entry (assoc name (plstore--get-alist plstore)))
387 (cons (cons name plist) (plstore--get-alist plstore))))
389 (setq entry (assoc name (plstore--get-secret-alist plstore)))
391 (setcdr entry secret-plist)
392 (plstore--set-secret-alist
394 (cons (cons name secret-plist) (plstore--get-secret-alist plstore)))))
395 (plstore--merge-secret plstore)))
397 (defun plstore-delete (plstore name)
398 "Delete an entry with NAME from PLSTORE."
399 (let ((entry (assoc name (plstore--get-alist plstore))))
403 (delq entry (plstore--get-alist plstore))))
404 (setq entry (assoc name (plstore--get-secret-alist plstore)))
406 (plstore--set-secret-alist
408 (delq entry (plstore--get-secret-alist plstore))))
409 (setq entry (assoc name (plstore--get-merged-alist plstore)))
411 (plstore--set-merged-alist
413 (delq entry (plstore--get-merged-alist plstore))))))
415 (defvar pp-escape-newlines)
416 (defun plstore--insert-buffer (plstore)
417 (insert ";;; public entries -*- mode: plstore -*- \n"
418 (pp-to-string (plstore--get-alist plstore)))
419 (if (plstore--get-secret-alist plstore)
420 (let ((context (epg-make-context 'OpenPGP))
421 (pp-escape-newlines nil)
424 ((listp plstore-encrypt-to) plstore-encrypt-to)
425 ((stringp plstore-encrypt-to) (list plstore-encrypt-to))))
427 (setf (epg-context-armor context) t)
428 (epg-context-set-passphrase-callback
430 (cons #'plstore-passphrase-callback-function
432 (setq cipher (epg-encrypt-string
435 (plstore--get-secret-alist plstore))
436 (if (or (eq plstore-select-keys t)
437 (and (null plstore-select-keys)
438 (not (local-variable-p 'plstore-encrypt-to
442 "Select recipients for encryption.
443 If no one is selected, symmetric encryption will be performed. "
445 (if plstore-encrypt-to
446 (epg-list-keys context recipients)))))
447 (goto-char (point-max))
448 (insert ";;; secret entries\n" (pp-to-string cipher)))))
450 (defun plstore-save (plstore)
451 "Save the contents of PLSTORE associated with a FILE."
452 (with-current-buffer (plstore--get-buffer plstore)
454 (plstore--insert-buffer plstore)
457 (defun plstore--encode (plstore)
458 (plstore--decrypt plstore)
459 (let ((merged-alist (plstore--get-merged-alist plstore)))
463 (setq entry (copy-sequence entry))
464 (let ((merged-plist (cdr (assoc (car entry) merged-alist)))
467 (if (string-match "\\`:secret-" (symbol-name (car plist)))
472 (substring (symbol-name
475 (setq plist (nthcdr 2 plist)))
476 (prin1-to-string entry)))
477 (plstore--get-alist plstore)
481 (defun plstore--decode (string)
482 (let* ((alist (car (read-from-string string)))
488 (unless (stringp (car (car pointer)))
489 (error "Invalid PLSTORE format %s" string))
490 (setq plist (cdr (car pointer)))
492 (when (string-match "\\`:secret-" (symbol-name (car plist)))
493 (setq entry (assoc (car (car pointer)) secret-alist))
495 (setq entry (list (car (car pointer)))
496 secret-alist (cons entry secret-alist)))
497 (setcdr entry (plist-put (cdr entry)
499 (substring (symbol-name
503 (setcar (cdr plist) t))
504 (setq plist (nthcdr 2 plist)))
505 (setq pointer (cdr pointer)))
506 (plstore--make nil alist nil secret-alist)))
508 (defun plstore--write-contents-functions ()
509 (when plstore-encoded
510 (let ((store (plstore--decode (buffer-string)))
511 (file (buffer-file-name)))
514 (set-visited-file-name nil)
516 (plstore--insert-buffer store)
517 (write-region (buffer-string) nil file)))
518 (set-visited-file-name file)
519 (set-buffer-modified-p nil))
522 (defun plstore-mode-original ()
523 "Show the original form of the this buffer."
525 (when plstore-encoded
526 (if (and (buffer-modified-p)
527 (y-or-n-p "Save buffer before reading the original form? "))
530 (insert-file-contents-literally (buffer-file-name))
531 (set-buffer-modified-p nil)
532 (setq plstore-encoded nil)))
534 (defun plstore-mode-decoded ()
535 "Show the decoded form of the this buffer."
537 (unless plstore-encoded
538 (if (and (buffer-modified-p)
539 (y-or-n-p "Save buffer before decoding? "))
541 (let ((store (plstore--make (current-buffer))))
542 (plstore--init-from-buffer store)
545 (substitute-command-keys "\
546 ;;; You are looking at the decoded form of the PLSTORE file.\n\
547 ;;; To see the original form content, do \\[plstore-mode-toggle-display]\n\n"))
548 (insert (plstore--encode store))
549 (set-buffer-modified-p nil)
550 (setq plstore-encoded t))))
552 (defun plstore-mode-toggle-display ()
553 "Toggle the display mode of PLSTORE between the original and decoded forms."
556 (plstore-mode-original)
557 (plstore-mode-decoded)))
560 (define-derived-mode plstore-mode emacs-lisp-mode "PLSTORE"
561 "Major mode for editing PLSTORE files."
562 (make-local-variable 'plstore-encoded)
563 (add-hook 'write-contents-functions #'plstore--write-contents-functions)
564 (define-key plstore-mode-map "\C-c\C-c" #'plstore-mode-toggle-display)
565 ;; to create a new file with plstore-mode, mark it as already decoded
566 (if (called-interactively-p 'any)
567 (setq plstore-encoded t)
568 (plstore-mode-decoded)))
572 ;;; plstore.el ends here