cgit.sxemacs.org Git - gnus/blob - lisp/plstore.el

   1 ;;; plstore.el --- secure plist store -*- lexical-binding: t -*-
   2 ;; Copyright (C) 2011-2014 Free Software Foundation, Inc.
   3
   4 ;; Author: Daiki Ueno <ueno@unixuser.org>
   5 ;; Keywords: PGP, GnuPG
   6
   7 ;; This file is part of GNU Emacs.
   8
   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.
  13
  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.
  18
  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/>.
  21
  22 ;;; Commentary
  23
  24 ;; Plist based data store providing search and partial encryption.
  25 ;;
  26 ;; Creating:
  27 ;;
  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)
  34 ;;
  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)
  41 ;;
  42 ;; ;; Kill the buffer visiting ~/.emacs.d/auth.plist.
  43 ;; (plstore-close store)
  44 ;;
  45 ;; Searching:
  46 ;;
  47 ;; (setq store (plstore-open (expand-file-name "~/.emacs.d/auth.plist")))
  48 ;;
  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")))
  52 ;;
  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")))
  57 ;;
  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")))
  62 ;;
  63 ;; (plstore-close store)
  64 ;;
  65 ;; Editing:
  66 ;;
  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
  69 ;; following line:
  70 ;;
  71 ;; (("foo" :host "foo.example.org" :secret-user "user"))
  72 ;;
  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'.
  76 ;;
  77 ;; You can toggle the view between encrypted form and the decrypted
  78 ;; form with C-c C-c.
  79
  80 ;;; Code:
  81
  82 (require 'epg)
  83
  84 (defgroup plstore nil
  85   "Searchable, partially encrypted, persistent plist store"
  86   :version "24.1"
  87   :group 'files)
  88
  89 (defcustom plstore-select-keys 'silent
  90   "Control whether or not to pop up the key selection dialog.
  91
  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))
 100   :group 'plstore)
 101
 102 (defvar 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
 107 (put 'plstore-encrypt-to 'safe-local-variable
 108      (lambda (val)
 109        (or (stringp val)
 110            (and (listp val)
 111                 (catch 'safe
 112                   (mapc (lambda (elt)
 113                           (unless (stringp elt)
 114                             (throw 'safe nil)))
 115                         val)
 116                   t)))))
 117
 118 (put 'plstore-encrypt-to 'permanent-local t)
 119
 120 (defvar plstore-encoded nil)
 121
 122 (put 'plstore-encoded 'permanent-local t)
 123
 124 (defvar plstore-cache-passphrase-for-symmetric-encryption nil)
 125 (defvar plstore-passphrase-alist nil)
 126
 127 (defun plstore-passphrase-callback-function (_context _key-id plstore)
 128   (if plstore-cache-passphrase-for-symmetric-encryption
 129       (let* ((file (file-truename (plstore-get-file plstore)))
 130              (entry (assoc file plstore-passphrase-alist))
 131              passphrase)
 132         (or (copy-sequence (cdr entry))
 133             (progn
 134               (unless entry
 135                 (setq entry (list file)
 136                       plstore-passphrase-alist
 137                       (cons entry
 138                             plstore-passphrase-alist)))
 139               (setq passphrase
 140                     (read-passwd (format "Passphrase for PLSTORE %s: "
 141                                          (plstore--get-buffer plstore))))
 142               (setcdr entry (copy-sequence passphrase))
 143               passphrase)))
 144     (read-passwd (format "Passphrase for PLSTORE %s: "
 145                          (plstore--get-buffer plstore)))))
 146
 147 (defun plstore-progress-callback-function (_context _what _char current total
 148                                                     handback)
 149   (if (= current total)
 150       (message "%s...done" handback)
 151     (message "%s...%d%%" handback
 152              (if (> total 0) (floor (* (/ current (float total)) 100)) 0))))
 153
 154 (defun plstore--get-buffer (arg)
 155   (aref arg 0))
 156
 157 (defun plstore--get-alist (arg)
 158   (aref arg 1))
 159
 160 (defun plstore--get-encrypted-data (arg)
 161   (aref arg 2))
 162
 163 (defun plstore--get-secret-alist (arg)
 164   (aref arg 3))
 165
 166 (defun plstore--get-merged-alist (arg)
 167   (aref arg 4))
 168
 169 (defun plstore--set-buffer (arg buffer)
 170   (aset arg 0 buffer))
 171
 172 (defun plstore--set-alist (arg plist)
 173   (aset arg 1 plist))
 174
 175 (defun plstore--set-encrypted-data (arg encrypted-data)
 176   (aset arg 2 encrypted-data))
 177
 178 (defun plstore--set-secret-alist (arg secret-alist)
 179   (aset arg 3 secret-alist))
 180
 181 (defun plstore--set-merged-alist (arg merged-alist)
 182   (aset arg 4 merged-alist))
 183
 184 (defun plstore-get-file (arg)
 185   (buffer-file-name (plstore--get-buffer arg)))
 186
 187 (defun plstore--make (&optional buffer alist encrypted-data secret-alist
 188                                 merged-alist)
 189   (vector buffer alist encrypted-data secret-alist merged-alist))
 190
 191 (defun plstore--init-from-buffer (plstore)
 192   (goto-char (point-min))
 193   (when (looking-at ";;; public entries")
 194     (forward-line)
 195     (plstore--set-alist plstore (read (point-marker)))
 196     (forward-sexp)
 197     (forward-char)
 198     (when (looking-at ";;; secret entries")
 199       (forward-line)
 200       (plstore--set-encrypted-data plstore (read (point-marker))))
 201     (plstore--merge-secret plstore)))
 202
 203 ;;;###autoload
 204 (defun plstore-open (file)
 205   "Create a plstore instance associated with FILE."
 206   (let* ((filename (file-truename file))
 207          (buffer (or (find-buffer-visiting filename)
 208                      (generate-new-buffer (format " plstore %s" filename))))
 209          (store (plstore--make buffer)))
 210     (with-current-buffer buffer
 211       (erase-buffer)
 212       (condition-case nil
 213           (insert-file-contents-literally file)