aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKen Manheimer2010-12-10 17:09:57 -0500
committerKen Manheimer2010-12-10 17:09:57 -0500
commit29fac3fec1f6d4821b3d1a9e15057fed8cc9d140 (patch)
tree1b5d2b3721fd6b135a8b137fd8f558da47aaa8f1
parentff3e8c8e20fab5078b4e3a8a4eacc026eea71b6d (diff)
downloademacs-29fac3fec1f6d4821b3d1a9e15057fed8cc9d140.tar.gz
emacs-29fac3fec1f6d4821b3d1a9e15057fed8cc9d140.zip
- replace pgg with epg/epa - working version, with no calls to pgg.
- remove passphrase verifier and hinting. (allout-passphrase-verifier-handling), (allout-passphrase-hint-handling): No longer used, delete. (allout-epg-protocol): Never used and unnecessary, delete. (allout-mode): Adjust docstring to describe changed encryption provisions. (allout-toggle-current-subtree-encryption): Adjust docstring to describe changed encryption provisions. Change fetch-pass to keymode-cue, for simpler universal argument interpretation. (allout-toggle-subtree-encryption): Adjust docstring to describe changed encryption provisions. Change fetch-pass to keymode-cue, for simpler universal argument interpretation. Remove provisions for handling key type and identity - they'll all be within allout-encrypt-string or epg/epg or even contained all the way in gpg. (allout-encrypt-string): Include keypair-mode argument, for requesting keypair encryption. Require epa, for recipients handling. Change how regexp filtering elements are named. (allout-obtain-passphrase), (allout-epg-passphrase-callback-function), (allout-make-passphrase-state), (allout-passphrase-state-passphrase): Remove, we're not providing passphrase verification and hinting because: - gpg v1 is required for epg passphrase callback operation, on which verification and hinting depends - doing that handling exposes the passphrase to emacs code, which is much much less secure than leaving all passphrase handling in gpg - leaving all passphrase handling to gpg removes a lot of complexity from allout code - gpg v2 connection to gpg-agent requires no user provisions, so is simpler and provides some convenience that makes up for the lack of hinting and verification (allout-encrypted-key-info), (allout-update-passphrase-mnemonic-aids), (allout-get-encryption-passphrase-verifier), (allout-verify-passphrase): Obsolete.
-rw-r--r--lisp/allout.el633
1 files changed, 103 insertions, 530 deletions
diff --git a/lisp/allout.el b/lisp/allout.el
index 7f600eef899..53f12095d47 100644
--- a/lisp/allout.el
+++ b/lisp/allout.el
@@ -85,6 +85,7 @@
85(eval-when-compile 85(eval-when-compile
86 ;; Most of the requires here are for stuff covered by autoloads, which 86 ;; Most of the requires here are for stuff covered by autoloads, which
87 ;; byte-compiling doesn't trigger. 87 ;; byte-compiling doesn't trigger.
88 (require 'epg)
88 (require 'epa) 89 (require 'epa)
89 (require 'overlay) 90 (require 'overlay)
90 ;; `cl' is required for `assert'. `assert' is not covered by a standard 91 ;; `cl' is required for `assert'. `assert' is not covered by a standard
@@ -812,32 +813,6 @@ formatted copy."
812 :type '(choice (const nil) string) 813 :type '(choice (const nil) string)
813 :version "22.1" 814 :version "22.1"
814 :group 'allout-encryption) 815 :group 'allout-encryption)
815;;;_ = allout-passphrase-verifier-handling
816(defcustom allout-passphrase-verifier-handling t
817 "Enable use of symmetric encryption passphrase verifier if non-nil.
818
819See the docstring for the `allout-enable-file-variable-adjustment'
820variable for details about allout ajustment of file variables."
821 :type 'boolean
822 :version "22.1"
823 :group 'allout-encryption)
824(make-variable-buffer-local 'allout-passphrase-verifier-handling)
825;;;_ = allout-passphrase-hint-handling
826(defcustom allout-passphrase-hint-handling 'always
827 "Dictate outline encryption passphrase reminder handling:
828
829 always -- always show reminder when prompting
830 needed -- show reminder on passphrase entry failure
831 disabled -- never present or adjust reminder
832
833See the docstring for the `allout-enable-file-variable-adjustment'
834variable for details about allout ajustment of file variables."
835 :type '(choice (const always)
836 (const needed)
837 (const disabled))
838 :version "22.1"
839 :group 'allout-encryption)
840(make-variable-buffer-local 'allout-passphrase-hint-handling)
841;;;_ = allout-encrypt-unencrypted-on-saves 816;;;_ = allout-encrypt-unencrypted-on-saves
842(defcustom allout-encrypt-unencrypted-on-saves t 817(defcustom allout-encrypt-unencrypted-on-saves t
843 "When saving, should topics pending encryption be encrypted? 818 "When saving, should topics pending encryption be encrypted?
@@ -1533,12 +1508,6 @@ wrapped within allout's automatic fill-prefix setting.")
1533 "Horrible hack used to prevent invalid multiple triggering of outline 1508 "Horrible hack used to prevent invalid multiple triggering of outline
1534mode from prop-line file-var activation. Used by `allout-mode' function 1509mode from prop-line file-var activation. Used by `allout-mode' function
1535to track repeats.") 1510to track repeats.")
1536;;;_ = allout-epg-protocol
1537(defvar allout-epg-protocol 'OpenPGP
1538 "*The default protocol.
1539The value can be either 'OpenPGP or 'CMS.
1540
1541You should bind this variable with `let', but do not set it globally.")
1542;;;_ = allout-passphrase-verifier-string 1511;;;_ = allout-passphrase-verifier-string
1543(defvar allout-passphrase-verifier-string nil 1512(defvar allout-passphrase-verifier-string nil
1544 "Setting used to test solicited encryption passphrases against the one 1513 "Setting used to test solicited encryption passphrases against the one
@@ -1554,6 +1523,8 @@ The verifier string is retained as an Emacs file variable, as well as in
1554the Emacs buffer state, if file variable adjustments are enabled. See 1523the Emacs buffer state, if file variable adjustments are enabled. See
1555`allout-enable-file-variable-adjustment' for details about that.") 1524`allout-enable-file-variable-adjustment' for details about that.")
1556(make-variable-buffer-local 'allout-passphrase-verifier-string) 1525(make-variable-buffer-local 'allout-passphrase-verifier-string)
1526(make-obsolete 'allout-passphrase-verifier-string
1527 'allout-passphrase-verifier-string "23.3")
1557;;;###autoload 1528;;;###autoload
1558(put 'allout-passphrase-verifier-string 'safe-local-variable 'stringp) 1529(put 'allout-passphrase-verifier-string 'safe-local-variable 'stringp)
1559;;;_ = allout-passphrase-hint-string 1530;;;_ = allout-passphrase-hint-string
@@ -1568,6 +1539,8 @@ state, if file variable adjustments are enabled. See
1568`allout-enable-file-variable-adjustment' for details about that.") 1539`allout-enable-file-variable-adjustment' for details about that.")
1569(make-variable-buffer-local 'allout-passphrase-hint-string) 1540(make-variable-buffer-local 'allout-passphrase-hint-string)
1570(setq-default allout-passphrase-hint-string "") 1541(setq-default allout-passphrase-hint-string "")
1542(make-obsolete 'allout-passphrase-hint-string
1543 'allout-passphrase-hint-string "23.3")
1571;;;###autoload 1544;;;###autoload
1572(put 'allout-passphrase-hint-string 'safe-local-variable 'stringp) 1545(put 'allout-passphrase-hint-string 'safe-local-variable 'stringp)
1573;;;_ = allout-after-save-decrypt 1546;;;_ = allout-after-save-decrypt
@@ -1937,19 +1910,14 @@ M-x outlineify-sticky Activate outline mode for current buffer,
1937 Topic Encryption 1910 Topic Encryption
1938 1911
1939Outline mode supports gpg encryption of topics, with support for 1912Outline mode supports gpg encryption of topics, with support for
1940symmetric and key-pair modes, passphrase timeout, passphrase 1913symmetric and key-pair modes, and auto-encryption of topics
1941consistency checking, user-provided hinting for symmetric key 1914pending encryption on save.
1942mode, and auto-encryption of topics pending encryption on save.
1943 1915
1944Topics pending encryption are, by default, automatically 1916Topics pending encryption are, by default, automatically
1945encrypted during file saves. If the contents of the topic 1917encrypted during file saves, including checkpoint saves, to avoid
1946containing the cursor was encrypted for a save, it is 1918exposing the plain text of encrypted topics in the file system.
1947automatically decrypted for continued editing. 1919If the content of the topic containing the cursor was encrypted
1948 1920for a save, it is automatically decrypted for continued editing.
1949The aim of these measures is reliable topic privacy while
1950preventing accidents like neglected encryption before saves,
1951forgetting which passphrase was used, and other practical
1952pitfalls.
1953 1921
1954See `allout-toggle-current-subtree-encryption' function docstring 1922See `allout-toggle-current-subtree-encryption' function docstring
1955and `allout-encrypt-unencrypted-on-saves' customization variable 1923and `allout-encrypt-unencrypted-on-saves' customization variable
@@ -5999,29 +5967,27 @@ With repeat count, copy the exposed portions of entire buffer."
5999 (goto-char start-pt))) 5967 (goto-char start-pt)))
6000 5968
6001;;;_ #8 Encryption 5969;;;_ #8 Encryption
6002;;;_ > allout-toggle-current-subtree-encryption (&optional fetch-pass) 5970;;;_ > allout-toggle-current-subtree-encryption (&optional keymode-cue)
6003(defun allout-toggle-current-subtree-encryption (&optional fetch-pass) 5971(defun allout-toggle-current-subtree-encryption (&optional keymode-cue)
6004 "Encrypt clear or decrypt encoded text of visibly-containing topic's contents. 5972 "Encrypt clear or decrypt encoded topic text.
6005 5973
6006Optional FETCH-PASS universal argument provokes key-pair encryption with 5974Allout uses emacs 'epg' libary to perform encryption. Symmetric
6007single universal argument. With doubled universal argument (value = 16), 5975and keypair encryption are supported. All encryption is ascii
6008it forces prompting for the passphrase regardless of availability from the 5976armored.
6009passphrase cache. With no universal argument, the appropriate passphrase 5977
6010is obtained from the cache, if available, else from the user. 5978When encrypting, optional KEYMODE-CUE universal argument greater
6011 5979than 1 causes prompting for recipients for public-key keypair
6012Allout uses emacs 'epg' libary to perform encryption. Allout 5980encryption. Otherwise a symmetric mode is assumed for
6013encrypts with ascii armoring. 5981encryption.
6014 5982
6015Both symmetric-key and key-pair encryption is implemented. Symmetric is 5983Encrypted topic's bullets are set to a `~' to signal that the
6016the default, use a single (x4) universal argument for keypair mode. 5984contents of the topic (body and subtopics, but not heading) is
6017 5985pending encryption or encrypted. `*' asterisk immediately after
6018Encrypted topic's bullet is set to a `~' to signal that the contents of the 5986the bullet signals that the body is encrypted, its absence means
6019topic (body and subtopics, but not heading) is pending encryption or 5987the topic is meant to be encrypted but is not currently. When a
6020encrypted. `*' asterisk immediately after the bullet signals that the body 5988file with topics pending encryption is saved, topics pending
6021is encrypted, its' absence means the topic is meant to be encrypted but is 5989encryption are encrypted. See allout-encrypt-unencrypted-on-saves
6022not. When a file with topics pending encryption is saved, topics pending 5990for auto-encryption specifics.
6023encryption are encrypted. See allout-encrypt-unencrypted-on-saves for
6024auto-encryption specifics.
6025 5991
6026\*NOTE WELL* that automatic encryption that happens during saves will 5992\*NOTE WELL* that automatic encryption that happens during saves will
6027default to symmetric encryption -- you must deliberately (re)encrypt key-pair 5993default to symmetric encryption -- you must deliberately (re)encrypt key-pair
@@ -6029,55 +5995,22 @@ encrypted topics if you want them to continue to use the key-pair cipher.
6029 5995
6030Level-one topics, with prefix consisting solely of an `*' asterisk, cannot be 5996Level-one topics, with prefix consisting solely of an `*' asterisk, cannot be
6031encrypted. If you want to encrypt the contents of a top-level topic, use 5997encrypted. If you want to encrypt the contents of a top-level topic, use
6032\\[allout-shift-in] to increase its depth. 5998\\[allout-shift-in] to increase its depth."
6033
6034 Passphrase Caching
6035
6036The encryption passphrase is solicited if not currently available in the
6037passphrase cache from a recent encryption action.
6038
6039 Symmetric Passphrase Hinting and Verification
6040
6041If the file previously had no associated passphrase, or had a different
6042passphrase than specified, the user is prompted to repeat the new one for
6043corroboration. A random string encrypted by the new passphrase is set on
6044the buffer-specific variable `allout-passphrase-verifier-string', for
6045confirmation of the passphrase when next obtained, before encrypting or
6046decrypting anything with it. This helps avoid mistakenly shifting between
6047keys.
6048
6049If allout customization var `allout-passphrase-verifier-handling' is
6050non-nil, an entry for `allout-passphrase-verifier-string' and its value is
6051added to an Emacs 'local variables' section at the end of the file, which
6052is created if necessary. That setting is for retention of the passphrase
6053verifier across Emacs sessions.
6054
6055Similarly, `allout-passphrase-hint-string' stores a user-provided reminder
6056about their passphrase, and `allout-passphrase-hint-handling' specifies
6057when the hint is presented, or if passphrase hints are disabled. If
6058enabled (see the `allout-passphrase-hint-handling' docstring for details),
6059the hint string is stored in the local-variables section of the file, and
6060solicited whenever the passphrase is changed."
6061 (interactive "P") 5999 (interactive "P")
6062 (save-excursion 6000 (save-excursion
6063 (allout-back-to-current-heading) 6001 (allout-back-to-current-heading)
6064 (allout-toggle-subtree-encryption fetch-pass) 6002 (allout-toggle-subtree-encryption keymode-cue)))
6065 ) 6003;;;_ > allout-toggle-subtree-encryption (&optional keymode-cue)
6066 ) 6004(defun allout-toggle-subtree-encryption (&optional keymode-cue)
6067;;;_ > allout-toggle-subtree-encryption (&optional fetch-pass)
6068(defun allout-toggle-subtree-encryption (&optional fetch-pass)
6069 "Encrypt clear text or decrypt encoded topic contents (body and subtopics.) 6005 "Encrypt clear text or decrypt encoded topic contents (body and subtopics.)
6070 6006
6071Optional FETCH-PASS universal argument provokes key-pair encryption with 6007When encrypting, optional KEYMODE-CUE universal argument greater than
6072single universal argument. With doubled universal argument (value = 16), 60081 provokes prompting for recipients for public-key keypair
6073it forces prompting for the passphrase regardless of availability from the 6009encryption, otherwise a symmetric-mode passphrase is solicited.
6074passphrase cache. With no universal argument, the appropriate passphrase
6075is obtained from the cache, if available, else from the user.
6076 6010
6077Currently only GnuPG encryption is supported, and integration 6011Encryption depends on the emacs epg library.
6078with gpg-agent is not yet implemented.
6079 6012
6080NOTE that the encrypted text will be ascii-armored. 6013Encrypted text will be ascii-armored.
6081 6014
6082See `allout-toggle-current-subtree-encryption' for more details." 6015See `allout-toggle-current-subtree-encryption' for more details."
6083 6016
@@ -6097,6 +6030,7 @@ See `allout-toggle-current-subtree-encryption' for more details."
6097 (progn (if (= (point-max) after-bullet-pos) 6030 (progn (if (= (point-max) after-bullet-pos)
6098 (error "no body to encrypt")) 6031 (error "no body to encrypt"))
6099 (allout-encrypted-topic-p))) 6032 (allout-encrypted-topic-p)))
6033 (keypair-mode (> (prefix-numeric-value keymode-cue) 1))
6100 (was-collapsed (if (not (search-forward "\n" nil t)) 6034 (was-collapsed (if (not (search-forward "\n" nil t))
6101 nil 6035 nil
6102 (backward-char 1) 6036 (backward-char 1)
@@ -6115,17 +6049,6 @@ See `allout-toggle-current-subtree-encryption' for more details."
6115 (if was-encrypted "de" "en")) 6049 (if was-encrypted "de" "en"))
6116 nil)) 6050 nil))
6117 ;; Assess key parameters: 6051 ;; Assess key parameters:
6118 ;;PGG rework key-info!
6119 (key-info (or
6120 ;; detect the type by which it is already encrypted
6121 (and was-encrypted
6122 (allout-encrypted-key-info subject-text))
6123 (and (member fetch-pass '(4 (4)))
6124 '(keypair nil))
6125 '(symmetric nil)))
6126 (for-key-type (car key-info))
6127 (for-key-identity (cadr key-info))
6128 (fetch-pass (and fetch-pass (member fetch-pass '(16 (16)))))
6129 (was-coding-system buffer-file-coding-system)) 6052 (was-coding-system buffer-file-coding-system))
6130 6053
6131 (when (not was-encrypted) 6054 (when (not was-encrypted)
@@ -6151,9 +6074,7 @@ See `allout-toggle-current-subtree-encryption' for more details."
6151 6074
6152 (setq result-text 6075 (setq result-text
6153 (allout-encrypt-string subject-text was-encrypted 6076 (allout-encrypt-string subject-text was-encrypted
6154 (current-buffer) 6077 (current-buffer) keypair-mode))
6155 for-key-type for-key-identity
6156 ))
6157 6078
6158 ;; Replace the subtree with the processed product. 6079 ;; Replace the subtree with the processed product.
6159 (allout-unprotected 6080 (allout-unprotected
@@ -6184,8 +6105,10 @@ See `allout-toggle-current-subtree-encryption' for more details."
6184 (insert "*")))) 6105 (insert "*"))))
6185 (run-hook-with-args 'allout-structure-added-hook 6106 (run-hook-with-args 'allout-structure-added-hook
6186 bullet-pos subtree-end)))) 6107 bullet-pos subtree-end))))
6187;;;_ > allout-encrypt-string (text decrypt allout-buffer) 6108;;;_ > allout-encrypt-string (text decrypt allout-buffer keypair-mode
6188(defun allout-encrypt-string (text decrypt allout-buffer &optional rejected) 6109;;; &optional rejected)
6110(defun allout-encrypt-string (text decrypt allout-buffer keypair-mode
6111 &optional rejected)
6189 "Encrypt or decrypt message TEXT. 6112 "Encrypt or decrypt message TEXT.
6190 6113
6191Returns the resulting string, or nil if the transformation fails. 6114Returns the resulting string, or nil if the transformation fails.
@@ -6194,31 +6117,40 @@ If DECRYPT is true (default false), then decrypt instead of encrypt.
6194 6117
6195ALLOUT-BUFFER identifies the buffer containing the text. 6118ALLOUT-BUFFER identifies the buffer containing the text.
6196 6119
6197Optional REJECTED is for internal use -- conveys the number of 6120If KEYPAIR-MODE is non-nil, encryption involves prompting for
6121keypair recipients.
6122
6123Optional REJECTED is for internal use, to convey the number of
6198rejections due to matches against 6124rejections due to matches against
6199`allout-encryption-ciphertext-rejection-regexps', as limited by 6125`allout-encryption-ciphertext-rejection-regexps', as limited by
6200`allout-encryption-ciphertext-rejection-ceiling'. 6126`allout-encryption-ciphertext-rejection-ceiling'."
6201"
6202 6127
6203 (require 'epg) 6128 (require 'epg)
6129 (require 'epa)
6204 6130
6205 (let* ((epg-context (epg-make-context epa-protocol t)) 6131 (let* ((epg-context (epg-make-context nil t))
6206 (encoding (with-current-buffer allout-buffer 6132 (encoding (with-current-buffer allout-buffer
6207 buffer-file-coding-system)) 6133 buffer-file-coding-system))
6208 (multibyte (with-current-buffer allout-buffer 6134 (multibyte (with-current-buffer allout-buffer
6209 enable-multibyte-characters)) 6135 enable-multibyte-characters))
6210 (strip-plaintext-regexps 6136 ;; "sanitization" avoids encryption results that are outline structure.
6211 (if (not decrypt) 6137 (sani-regexps 'allout-encryption-plaintext-sanitization-regexps)
6212 (allout-get-configvar-values 6138 (strip-plaintext-regexps (if (not decrypt)
6213 'allout-encryption-plaintext-sanitization-regexps))) 6139 (allout-get-configvar-values
6214 (reject-ciphertext-regexps 6140 sani-regexps)))
6215 (if (not decrypt) 6141 (rejection-regexps 'allout-encryption-ciphertext-rejection-regexps)
6216 (allout-get-configvar-values 6142 (reject-ciphertext-regexps (if (not decrypt)
6217 'allout-encryption-ciphertext-rejection-regexps))) 6143 (allout-get-configvar-values
6144 rejection-regexps)))
6218 (rejected (or rejected 0)) 6145 (rejected (or rejected 0))
6219 (rejections-left (- allout-encryption-ciphertext-rejection-ceiling 6146 (rejections-left (- allout-encryption-ciphertext-rejection-ceiling
6220 rejected)) 6147 rejected))
6221 massaged-text result-text 6148 (keypair-message (concat "Select encryption recipients.\n Not"
6149 " selecting any causes"
6150 " symmetric encryption. "))
6151 recipients
6152 massaged-text
6153 result-text
6222 ) 6154 )
6223 6155
6224 ;; Massage the subject text for encoding and filtering. 6156 ;; Massage the subject text for encoding and filtering.
@@ -6243,284 +6175,49 @@ rejections due to matches against
6243 (setq massaged-text (buffer-substring-no-properties (point-min) 6175 (setq massaged-text (buffer-substring-no-properties (point-min)
6244 (point-max)))) 6176 (point-max))))
6245 (setq result-text 6177 (setq result-text
6246
6247 (if decrypt 6178 (if decrypt
6248
6249 (epg-decrypt-string epg-context 6179 (epg-decrypt-string epg-context
6250 (encode-coding-string massaged-text 6180 (encode-coding-string massaged-text
6251 (or encoding 'utf-8))) 6181 (or encoding 'utf-8)))
6252
6253 (if (equal key-type 'symmetric)
6254 ;; establish the passphrase callback. it will only be used
6255 ;; with gpgv1, but then it will handle hinting and verification.
6256 (allout-set-epg-passphrase-callback epg-context allout-buffer))
6257
6258 (epg-encrypt-string epg-context 6182 (epg-encrypt-string epg-context
6259 (encode-coding-string massaged-text 6183 (encode-coding-string massaged-text
6260 (or encoding 'utf-8)) 6184 (or encoding 'utf-8))
6261 nil))) 6185 (and keypair-mode
6186 (epa-select-keys epg-context
6187 keypair-message)))))
6262 6188
6263 ;; validate result -- non-empty 6189 ;; validate result -- non-empty
6264 (if (not result-text) 6190 (cond
6265 (error "%scryption failed." (if decrypt "De" "En")) 6191 ((not result-text)
6266 6192 (error "%scryption failed." (if decrypt "De" "En")))
6267 ;; Retry (within limit) if ciphertext contains rejections: 6193
6268 ((and (not decrypt) 6194 ;; Retry (within limit) if ciphertext contains rejections:
6269 ;; Check for disqualification of this ciphertext: 6195 ((and (not decrypt)
6270 (let ((regexps reject-ciphertext-regexps) 6196 ;; Check for disqualification of this ciphertext:
6271 reject-it) 6197 (let ((regexps reject-ciphertext-regexps)
6272 (while (and regexps (not reject-it)) 6198 reject-it)
6273 (setq reject-it (string-match (car regexps) result-text)) 6199 (while (and regexps (not reject-it))
6274 (pop regexps)) 6200 (setq reject-it (string-match (car regexps) result-text))
6275 reject-it)) 6201 (pop regexps))
6276 (setq rejections-left (1- rejections-left)) 6202 reject-it))
6277 (if (<= rejections-left 0) 6203 (setq rejections-left (1- rejections-left))
6278 (error (concat "Ciphertext rejected too many times" 6204 (if (<= rejections-left 0)
6279 " (%s), per `%s'") 6205 (error (concat "Ciphertext rejected too many times"
6280 allout-encryption-ciphertext-rejection-ceiling 6206 " (%s), per `%s'")
6281 'allout-encryption-ciphertext-rejection-regexps) 6207 allout-encryption-ciphertext-rejection-ceiling
6282 ;; try again: 6208 'allout-encryption-ciphertext-rejection-regexps)
6283 ;; XXX alas, we depend on external caching for the passphrase. 6209 ;; try again (gpg-agent may have the key cached):
6284 (allout-encrypt-string text decrypt allout-buffer 6210 (allout-encrypt-string text decrypt allout-buffer keypair-mode
6285 (1+ rejected)))) 6211 (1+ rejected))))
6286 6212
6287 ;; Barf if encryption yields extraordinary control chars: 6213 ;; Barf if encryption yields extraordinary control chars:
6288 ((and (not decrypt) 6214 ((and (not decrypt)
6289 (string-match "[\C-a\C-k\C-o-\C-z\C-@]" 6215 (string-match "[\C-a\C-k\C-o-\C-z\C-@]"
6290 result-text)) 6216 result-text))
6291 (error (concat "Encryption produced non-armored text, which" 6217 (error (concat "Encryption produced non-armored text, which"
6292 "conflicts with allout mode -- reconfigure!"))) 6218 "conflicts with allout mode -- reconfigure!")))
6293 6219
6294 (t result-text) 6220 (t result-text))))
6295 )
6296 )
6297 )
6298;;;_ . epg passphrase callback handling (epg uses only for GnuPG v1)
6299;;;_ > allout-epg-passphrase-callback-function (context key-id state)
6300(defun allout-epg-passphrase-callback-function (context key-id state)
6301 "Handle allout passphrase prompting when used with the emacs epg library.
6302
6303Note that epg's passphrase callback provision only works when
6304operating with GnuPG v1. Check your GnuPG version using 'gpg
6305--version' from the command line.
6306
6307CONTEXT is an epg context object, per 'epg-make-context'.
6308
6309KEY-ID is apparently either 'SYM, for symmetric passphrase, or
6310something else for a key pair, per 'epg-passphrase-callback-function'.
6311
6312STATE is an allout passphrase state construct, per
6313'allout-make-passphrase-state'."
6314 (message "allout-passphrase-callback-function: in")(sit-for 1)
6315 (let* ((allout-buffer (allout-passphrase-state-buffer state))
6316 (provided (allout-passphrase-state-buffer state)))
6317 (if (eq key-id 'SYM)
6318 (if provided
6319 provided
6320 (let*
6321 ((hint-string
6322 (with-current-buffer allout-buffer
6323 (if (and (not (string= allout-passphrase-hint-string
6324 ""))
6325 (or (equal allout-passphrase-hint-handling 'always)
6326 (and (equal allout-passphrase-hint-handling
6327 'needed)
6328 retried)))
6329 (format " [%s]" allout-passphrase-hint-string)
6330 "")))
6331 (verifier-string (allout-get-encryption-passphrase-verifier))
6332 (passphrase (read-passwd
6333 (format "Passphrase for %s symmetric encryption%s: "
6334 (buffer-name allout-buffer) hint-string))))
6335 (if allout-passphrase-verifier-handling
6336 (if verifier-string
6337 ;; try verifying against existing verifier.
6338 ;; - successful: return the passphrase.
6339 ;; - unsuccessful: offer to change the verifier
6340 ;; - if change accepted, change verifier and continue
6341 ;; - if change refused, raise an encryption error.
6342 (if (condition-case err
6343 (epg-decrypt-string
6344 (allout-context-epg-passphrase-callback
6345 epg-context allout-buffer passphrase)
6346 verifier-string)
6347 (error nil))
6348 ;;(allout-update-passphrase-mnemonic-aids for-key passphrase
6349 ;; allout-buffer)
6350
6351 )
6352 (read-passwd
6353 (if (eq key-id 'PIN)
6354 "Passphrase for PIN: "
6355 (let ((entry (assoc key-id epg-user-id-alist)))
6356 (if entry
6357 (format "Passphrase for %s %s: " key-id (cdr entry))
6358 (format "Passphrase for %s: " key-id)))))))
6359;;;_ > allout-context-epg-passphrase-callback (epg-context buffer
6360;;; &optional passphrase)
6361(defun allout-context-epg-passphrase-callback (epg-context buffer
6362 &optional passphrase)
6363 "Return an epg-context which uses allout's passphrase callback with state.
6364
6365NOTE that epg's passphrase callback provision only works when
6366operating with GnuPG v1. Check your GnuPG version using 'gpg
6367--version' from the command line.
6368
6369A deep copy of the specified EPG-CONTEXT, per 'epg-make-context',
6370is used as a template.
6371
6372BUFFER is the allout outline buffer containing the target text.
6373
6374Optional PASSPHRASE is an already obtained passphrase to be used for
6375multiple decryptions, eg when verifying symmetric passphrases."
6376 (let ((new-epg-context (copy-tree epg-context)))
6377 (epg-context-set-passphrase-callback
6378 new-epg-context
6379 (cons #'allout-epg-passphrase-callback-function
6380 (allout-make-passphrase-state buffer passphrase)))
6381 new-epg-context))
6382;;;_ > allout-make-passphrase-state (buffer &optional passphrase)
6383(defun allout-make-passphrase-state (buffer &optional passphrase)
6384 "Return an allout passphrase state construct.
6385
6386BUFFER is the allout outline buffer.
6387
6388Optional PASSPHRASE is used when decrypting to convey an already
6389obtained passphrase for doing multiple decryptions, eg when doing
6390verification as part of symmetric passphrse decryption."
6391 (cons buffer passphrase))
6392;;;_ > allout-passphrase-state-buffer (state)
6393(defun allout-passphrase-state-buffer (state)
6394 "Given an allout passphrase STATE construct, return the buffer."
6395 (car state))
6396;;;_ > allout-passphrase-state-passphrase (state)
6397(defun allout-passphrase-state-passphrase (state)
6398 "Given an allout passphrase STATE construct, return the passphrase or nil."
6399 (cdr state))
6400;;;_ > ;;PGG allout-obtain-passphrase (for-key ;;PGG cache-id
6401;;; prompt-id key-type allout-buffer retried
6402;;; ;;PGG fetch-pass)
6403(defun allout-obtain-passphrase (for-key ;;PGG cache-id
6404 prompt-id key-type allout-buffer retried
6405 ;;fetch-pass
6406 )
6407 "Obtain passphrase for a key from the user.
6408
6409When obtaining from the user, symmetric-cipher passphrases are verified
6410against either, if available and enabled, a random string that was
6411encrypted against the passphrase, or else against repeated entry by the
6412user for corroboration.
6413
6414FOR-KEY is the key for which the passphrase is being obtained.
6415
6416;;PGG CACHE-ID is the cache id of the key for the passphrase.
6417
6418PROMPT-ID is the id for use when prompting the user.
6419
6420KEY-TYPE is either `symmetric' or `keypair'.
6421
6422ALLOUT-BUFFER is the buffer containing the entry being en/decrypted.
6423
6424RETRIED is the number of this attempt to obtain this passphrase.
6425
6426;;PGG FETCH-PASS causes the passphrase to be solicited from the user, regardless
6427;;PGG of the availability of a cached copy.
6428"
6429
6430 (if (not (equal key-type 'symmetric))
6431 ;; do regular passphrase read on non-symmetric passphrase:
6432 (pgg-read-passphrase (format "%s passphrase%s: "
6433 (upcase (format "%s" (or pgg-scheme
6434 pgg-default-scheme
6435 "GPG")))
6436 (if prompt-id
6437 (format " for %s" prompt-id)
6438 ""))
6439 for-key ;;PGG cache-id
6440 t)
6441
6442 ;; Symmetric hereon:
6443
6444 (with-current-buffer allout-buffer
6445 (let* ((hint (if (and (not (string= allout-passphrase-hint-string ""))
6446 (or (equal allout-passphrase-hint-handling 'always)
6447 (and (equal allout-passphrase-hint-handling
6448 'needed)
6449 retried)))
6450 (format " [%s]" allout-passphrase-hint-string)
6451 ""))
6452 (retry-message (if retried (format " (%s retry)" retried) ""))
6453 (prompt-sans-hint (format "'%s' symmetric passphrase%s: "
6454 prompt-id retry-message))
6455 (full-prompt (format "'%s' symmetric passphrase%s%s: "
6456 prompt-id hint retry-message))
6457 (prompt full-prompt)
6458 (verifier-string (allout-get-encryption-passphrase-verifier))
6459
6460 ;;PGG (cached (and (not fetch-pass)
6461 ;;PGG (pgg-read-passphrase-from-cache cache-id t)))
6462 (got-pass ;;PGG (or cached
6463 (pgg-read-passphrase full-prompt ;;PGG cache-id
6464 for-key t))
6465 ;;PGG )
6466 confirmation)
6467
6468 (if (not got-pass)
6469 nil
6470
6471 ;; Duplicate our handle on the passphrase so it's not clobbered by
6472 ;; deactivate-passwd memory clearing:
6473 (setq got-pass (copy-sequence got-pass))
6474
6475 (cond (verifier-string
6476 (save-window-excursion
6477 (if (allout-encrypt-string verifier-string 'decrypt
6478 allout-buffer 'symmetric for-key
6479 ;;PGG nil
6480 0 0 'verifying
6481 (copy-sequence got-pass))
6482 (setq confirmation (format "%s" got-pass))))
6483
6484 (if (and (not confirmation)
6485 (if (yes-or-no-p
6486 (concat "Passphrase differs from established"
6487 " -- use new one instead? "))
6488 ;; deactivate password for subsequent
6489 ;; confirmation:
6490 (progn
6491 ;;PGG (pgg-remove-passphrase-from-cache cache-id t)
6492 (setq prompt prompt-sans-hint)
6493 nil)
6494 t))
6495 ;;PGG (progn (pgg-remove-passphrase-from-cache cache-id t)
6496 (error "Wrong passphrase")))
6497 ;;PGG)
6498 ;; No verifier string -- force confirmation by repetition of
6499 ;; (new) passphrase:
6500 ;;PGG ((or fetch-pass (not cached))
6501 ;;PGG (pgg-remove-passphrase-from-cache cache-id t)))
6502 )
6503 ;; confirmation vs new input -- doing pgg-read-passphrase will do the
6504 ;; right thing, in either case:
6505 (if (not confirmation)
6506 (setq confirmation
6507 (pgg-read-passphrase (concat prompt
6508 " ... confirm spelling: ")
6509 ;;PGG cache-id
6510 for-key t)))
6511 (prog1
6512 (if (equal got-pass confirmation)
6513 confirmation
6514 (if (yes-or-no-p (concat "spelling of original and"
6515 " confirmation differ -- retry? "))
6516 (progn (setq retried (if retried (1+ retried) 1))
6517 ;;PGG (pgg-remove-passphrase-from-cache cache-id
6518 for-key t)
6519 ;; recurse to this routine:
6520 (pgg-read-passphrase prompt-sans-hint ;;PGG cache-id
6521 for-key t))
6522 ;;PGG (pgg-remove-passphrase-from-cache cache-id t)
6523 (error "Confirmation failed"))))))))
6524;;;_ > allout-encrypted-topic-p () 6221;;;_ > allout-encrypted-topic-p ()
6525(defun allout-encrypted-topic-p () 6222(defun allout-encrypted-topic-p ()
6526 "True if the current topic is encryptable and encrypted." 6223 "True if the current topic is encryptable and encrypted."
@@ -6531,130 +6228,6 @@ RETRIED is the number of this attempt to obtain this passphrase.
6531 (save-match-data (looking-at "\\*"))) 6228 (save-match-data (looking-at "\\*")))
6532 ) 6229 )
6533 ) 6230 )
6534;;;_ > ;;PGG allout-encrypted-key-info (text)
6535;; XXX gpg-specific, alas
6536(defun allout-encrypted-key-info (text)
6537 "Return a pair of the key type and identity of a recipient's secret key.
6538
6539The key type is one of `symmetric' or `keypair'.
6540
6541If `keypair', and some of the user's secret keys are among those for which
6542the message was encoded, return the identity of the first. Otherwise,
6543return nil for the second item of the pair.
6544
6545An error is raised if the text is not encrypted."
6546 (require 'pgg-parse)
6547 (save-excursion
6548 (with-temp-buffer
6549 (insert text)
6550 (let* ((parsed-armor (pgg-parse-armor-region (point-min) (point-max)))
6551 (type (if (assq 'symmetric-key-algorithm (car (cdr parsed-armor)))
6552 'symmetric
6553 'keypair))
6554 secret-keys first-secret-key for-key-owner)
6555 (if (equal type 'keypair)
6556 (setq secret-keys (pgg-gpg-lookup-all-secret-keys)
6557 first-secret-key (pgg-gpg-select-matching-key parsed-armor
6558 secret-keys)
6559 for-key-owner (and first-secret-key
6560 (pgg-gpg-lookup-key-owner
6561 first-secret-key))))
6562 (list type (pgg-gpg-key-id-from-key-owner for-key-owner))
6563 )
6564 )
6565 )
6566 )
6567;;;_ > allout-create-encryption-passphrase-verifier (passphrase)
6568(defun allout-create-encryption-passphrase-verifier (passphrase)
6569 "Encrypt random message for later validation of symmetric key's passphrase."
6570 ;; use 20 random ascii characters, across the entire ascii range.
6571 (random t)
6572 (let ((spew (make-string 20 ?\0)))
6573 (dotimes (i (length spew))
6574 (aset spew i (1+ (random 254))))
6575 (allout-encrypt-string spew nil (current-buffer) 'symmetric nil
6576 ;;PGG nil
6577 nil 0 0 passphrase))
6578 )
6579;;;_ > allout-update-passphrase-mnemonic-aids (for-key passphrase
6580;;; outline-buffer)
6581(defun allout-update-passphrase-mnemonic-aids (for-key passphrase
6582 outline-buffer)
6583 "Update passphrase verifier and hint strings if necessary.
6584
6585See `allout-passphrase-verifier-string' and `allout-passphrase-hint-string'
6586settings.
6587
6588PASSPHRASE is the passphrase being mnemonicized.
6589
6590OUTLINE-BUFFER is the buffer of the outline being adjusted.
6591
6592These are used to help the user keep track of the passphrase they use for
6593symmetric encryption in the file.
6594
6595Behavior is governed by `allout-passphrase-verifier-handling',
6596`allout-passphrase-hint-handling', and also, controlling whether the values
6597are preserved on Emacs local file variables,
6598`allout-enable-file-variable-adjustment'."
6599
6600 ;; If passphrase doesn't agree with current verifier:
6601 ;; - adjust the verifier
6602 ;; - if passphrase hint handling is enabled, adjust the passphrase hint
6603 ;; - if file var settings are enabled, adjust the file vars
6604
6605 (let* ((new-verifier-needed (not (allout-verify-passphrase
6606 for-key passphrase outline-buffer)))
6607 (new-verifier-string
6608 (if new-verifier-needed
6609 ;; Collapse to a single line and enclose in string quotes:
6610 (subst-char-in-string
6611 ?\n ?\C-a (allout-create-encryption-passphrase-verifier
6612 passphrase))))
6613 new-hint)
6614 (when new-verifier-string
6615 ;; do the passphrase hint first, since it's interactive
6616 (when (and allout-passphrase-hint-handling
6617 (not (equal allout-passphrase-hint-handling 'disabled)))
6618 (setq new-hint
6619 (read-from-minibuffer "Passphrase hint to jog your memory: "
6620 allout-passphrase-hint-string))
6621 (when (not (string= new-hint allout-passphrase-hint-string))
6622 (setq allout-passphrase-hint-string new-hint)
6623 (allout-adjust-file-variable "allout-passphrase-hint-string"
6624 allout-passphrase-hint-string)))
6625 (when allout-passphrase-verifier-handling
6626 (setq allout-passphrase-verifier-string new-verifier-string)
6627 (allout-adjust-file-variable "allout-passphrase-verifier-string"
6628 allout-passphrase-verifier-string))
6629 )
6630 )
6631 )
6632;;;_ > allout-get-encryption-passphrase-verifier ()
6633(defun allout-get-encryption-passphrase-verifier ()
6634 "Return text of the encrypt passphrase verifier, unmassaged, or nil if none.
6635
6636Derived from value of `allout-passphrase-verifier-string'."
6637
6638 (let ((verifier-string (and (boundp 'allout-passphrase-verifier-string)
6639 allout-passphrase-verifier-string)))
6640 (if verifier-string
6641 ;; Return it uncollapsed
6642 (subst-char-in-string ?\C-a ?\n verifier-string))
6643 )
6644 )
6645;;;_ > allout-verify-passphrase (key passphrase allout-buffer)
6646(defun allout-verify-passphrase (key passphrase allout-buffer)
6647 "True if passphrase successfully decrypts verifier, nil otherwise.
6648
6649\"Otherwise\" includes absence of passphrase verifier."
6650 (with-current-buffer allout-buffer
6651 (and (boundp 'allout-passphrase-verifier-string)
6652 allout-passphrase-verifier-string
6653 (allout-encrypt-string (allout-get-encryption-passphrase-verifier)
6654 'decrypt allout-buffer 'symmetric key
6655 ;;PGG nil
6656 0 0 'verifying passphrase)
6657 t)))
6658;;;_ > allout-next-topic-pending-encryption (&optional except-mark) 6231;;;_ > allout-next-topic-pending-encryption (&optional except-mark)
6659(defun allout-next-topic-pending-encryption (&optional except-mark) 6232(defun allout-next-topic-pending-encryption (&optional except-mark)
6660 "Return the point of the next topic pending encryption, or nil if none. 6233 "Return the point of the next topic pending encryption, or nil if none.