diff options
| author | Ken Manheimer | 2010-12-16 18:30:57 -0500 |
|---|---|---|
| committer | Ken Manheimer | 2010-12-16 18:30:57 -0500 |
| commit | 9efd720d16c6a8adba600cfb303b4bd75d7c6cdf (patch) | |
| tree | f1f63b2202c149a1ef30beeb450792319f303213 | |
| parent | 59a7e27dd4cd063cc3e227ad044acfa4b231f9fa (diff) | |
| parent | 0281bf138807e04b44b5891ec8d5a365dad8e3c1 (diff) | |
| download | emacs-9efd720d16c6a8adba600cfb303b4bd75d7c6cdf.tar.gz emacs-9efd720d16c6a8adba600cfb303b4bd75d7c6cdf.zip | |
Synopsis: Migrate allout encryption provisions from pgg library, which is
obsolete, to epg library, which replaces pgg.
Due to the underlying GnuPG V2 restrictions on external handling of
passphrases (or epg's restrictions when working with GnuPG v2), we are
dropping allout's symmetric encryption passphrase hinting and verification.
This has the advantage that no emacs code has access to the passphrase,
leaving all passphrase handling in GnuPG, which is much more secure. This,
together with the reduction in allout code complexity and logistical
complications the user would have in arranging to use GnuPG v1, requires
dropping these features.
Keypair encryption gains features, with adoption of respect for epa-file's
'epa-file-encrypt-to'. This means that allout outlines can be associated
with recipients, and encryptions by default will be targeted to those
recipients.
The default encryption mode (whether to epa-file-encrypt-to recipients, if
any, or symmetric mode) is overridden by providing a universal argument
greater than 1 to the outline entry encryption command,
'allout-toggle-current-subtree-encryption'. The user is then prompted to
select keypair identities from their list of known GnuPG keypairs. If they
don't select any, then symmetric encryption is done. Otherwise, the
selected keypair identities are targeted. If the universal argument is
greater than 4 then the selected recipients (or none, if none were
selected) are associated with the outline using a file local variable, as
default recipients for subsequent encryptions.
This is a big merge from a private branch.
Code details:
(allout-toggle-current-subtree-encryption,
allout-toggle-subtree-encryption): Adjust docstrings to reflect defaulting
policy and other changes.
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 keymode-cue, for optionally prompting for
keypair recipients (universal argument > 1) and, in addition, associating the
specified recipients with the outline (universal argument > 4) using a file
local variable setting for 'epa-file-encrypt-to'.
Require epa, for recipients handling.
Change how regexp filtering elements are named.
Describe the problem with caching of incorrect symmetric-decryption keys.
Use the epa-passphrase-callback-function, in case the user is using GnuPG
v1.
Support saving of the selected keypair recipients when invoked with a
keymode-cue > 4.
Remove obsolete arguments 'fetch-pass', 'target-cache-id', 'retried'.
Require 'epa.
Establish epg-context with armoring and default epg-protocol.
Remove all passphrase cache, verification, and hinting code.
(allout-passphrase-verifier-handling, allout-passphrase-hint-handling):
No longer used, delete.
(allout-mode): Adjust docstring to describe changed encryption provisions.
Describe the problem with caching of incorrect symmetric-decryption keys.
(allout-obtain-passphrase, allout-epg-passphrase-callback-function,
allout-make-passphrase-state, allout-passphrase-state-passphrase,
allout-encrypted-key-info, allout-update-passphrase-mnemonic-aids,
allout-get-encryption-passphrase-verifier, allout-verify-passphrase):
Obsolete, remove.
| -rw-r--r-- | lisp/allout.el | 796 |
1 files changed, 231 insertions, 565 deletions
diff --git a/lisp/allout.el b/lisp/allout.el index 93d6544b18e..3a506482d4f 100644 --- a/lisp/allout.el +++ b/lisp/allout.el | |||
| @@ -43,9 +43,8 @@ | |||
| 43 | ;; - Symmetric-key and key-pair topic encryption, plus symmetric passphrase | 43 | ;; - Symmetric-key and key-pair topic encryption, plus symmetric passphrase |
| 44 | ;; mnemonic support, with verification against an established passphrase | 44 | ;; mnemonic support, with verification against an established passphrase |
| 45 | ;; (using a stashed encrypted dummy string) and user-supplied hint | 45 | ;; (using a stashed encrypted dummy string) and user-supplied hint |
| 46 | ;; maintenance. (See allout-toggle-current-subtree-encryption docstring. | 46 | ;; maintenance. Encryption is via the Emacs 'epg' library. See |
| 47 | ;; Currently only GnuPG encryption is supported, and integration | 47 | ;; allout-toggle-current-subtree-encryption docstring. |
| 48 | ;; with gpg-agent is not yet implemented.) | ||
| 49 | ;; - Automatic topic-number maintenance | 48 | ;; - Automatic topic-number maintenance |
| 50 | ;; - "Hot-spot" operation, for single-keystroke maneuvering and | 49 | ;; - "Hot-spot" operation, for single-keystroke maneuvering and |
| 51 | ;; exposure control (see the allout-mode docstring) | 50 | ;; exposure control (see the allout-mode docstring) |
| @@ -84,11 +83,10 @@ | |||
| 84 | ;;;_* Dependency autoloads | 83 | ;;;_* Dependency autoloads |
| 85 | (require 'overlay) | 84 | (require 'overlay) |
| 86 | (eval-when-compile | 85 | (eval-when-compile |
| 87 | ;; Most of the requires here are for stuff covered by autoloads. | 86 | ;; Most of the requires here are for stuff covered by autoloads, which |
| 88 | ;; Since just byte-compiling doesn't trigger autoloads, so that | 87 | ;; byte-compiling doesn't trigger. |
| 89 | ;; "function not found" warnings would occur without these requires. | 88 | (require 'epg) |
| 90 | (require 'pgg) | 89 | (require 'epa) |
| 91 | (require 'pgg-gpg) | ||
| 92 | (require 'overlay) | 90 | (require 'overlay) |
| 93 | ;; `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 |
| 94 | ;; autoload, but it is a macro, so that eval-when-compile is sufficient | 92 | ;; autoload, but it is a macro, so that eval-when-compile is sufficient |
| @@ -818,32 +816,6 @@ formatted copy." | |||
| 818 | :type '(choice (const nil) string) | 816 | :type '(choice (const nil) string) |
| 819 | :version "22.1" | 817 | :version "22.1" |
| 820 | :group 'allout-encryption) | 818 | :group 'allout-encryption) |
| 821 | ;;;_ = allout-passphrase-verifier-handling | ||
| 822 | (defcustom allout-passphrase-verifier-handling t | ||
| 823 | "Enable use of symmetric encryption passphrase verifier if non-nil. | ||
| 824 | |||
| 825 | See the docstring for the `allout-enable-file-variable-adjustment' | ||
| 826 | variable for details about allout ajustment of file variables." | ||
| 827 | :type 'boolean | ||
| 828 | :version "22.1" | ||
| 829 | :group 'allout-encryption) | ||
| 830 | (make-variable-buffer-local 'allout-passphrase-verifier-handling) | ||
| 831 | ;;;_ = allout-passphrase-hint-handling | ||
| 832 | (defcustom allout-passphrase-hint-handling 'always | ||
| 833 | "Dictate outline encryption passphrase reminder handling: | ||
| 834 | |||
| 835 | always -- always show reminder when prompting | ||
| 836 | needed -- show reminder on passphrase entry failure | ||
| 837 | disabled -- never present or adjust reminder | ||
| 838 | |||
| 839 | See the docstring for the `allout-enable-file-variable-adjustment' | ||
| 840 | variable for details about allout ajustment of file variables." | ||
| 841 | :type '(choice (const always) | ||
| 842 | (const needed) | ||
| 843 | (const disabled)) | ||
| 844 | :version "22.1" | ||
| 845 | :group 'allout-encryption) | ||
| 846 | (make-variable-buffer-local 'allout-passphrase-hint-handling) | ||
| 847 | ;;;_ = allout-encrypt-unencrypted-on-saves | 819 | ;;;_ = allout-encrypt-unencrypted-on-saves |
| 848 | (defcustom allout-encrypt-unencrypted-on-saves t | 820 | (defcustom allout-encrypt-unencrypted-on-saves t |
| 849 | "When saving, should topics pending encryption be encrypted? | 821 | "When saving, should topics pending encryption be encrypted? |
| @@ -1554,6 +1526,8 @@ The verifier string is retained as an Emacs file variable, as well as in | |||
| 1554 | the Emacs buffer state, if file variable adjustments are enabled. See | 1526 | the Emacs buffer state, if file variable adjustments are enabled. See |
| 1555 | `allout-enable-file-variable-adjustment' for details about that.") | 1527 | `allout-enable-file-variable-adjustment' for details about that.") |
| 1556 | (make-variable-buffer-local 'allout-passphrase-verifier-string) | 1528 | (make-variable-buffer-local 'allout-passphrase-verifier-string) |
| 1529 | (make-obsolete 'allout-passphrase-verifier-string | ||
| 1530 | 'allout-passphrase-verifier-string "23.3") | ||
| 1557 | ;;;###autoload | 1531 | ;;;###autoload |
| 1558 | (put 'allout-passphrase-verifier-string 'safe-local-variable 'stringp) | 1532 | (put 'allout-passphrase-verifier-string 'safe-local-variable 'stringp) |
| 1559 | ;;;_ = allout-passphrase-hint-string | 1533 | ;;;_ = allout-passphrase-hint-string |
| @@ -1568,6 +1542,8 @@ state, if file variable adjustments are enabled. See | |||
| 1568 | `allout-enable-file-variable-adjustment' for details about that.") | 1542 | `allout-enable-file-variable-adjustment' for details about that.") |
| 1569 | (make-variable-buffer-local 'allout-passphrase-hint-string) | 1543 | (make-variable-buffer-local 'allout-passphrase-hint-string) |
| 1570 | (setq-default allout-passphrase-hint-string "") | 1544 | (setq-default allout-passphrase-hint-string "") |
| 1545 | (make-obsolete 'allout-passphrase-hint-string | ||
| 1546 | 'allout-passphrase-hint-string "23.3") | ||
| 1571 | ;;;###autoload | 1547 | ;;;###autoload |
| 1572 | (put 'allout-passphrase-hint-string 'safe-local-variable 'stringp) | 1548 | (put 'allout-passphrase-hint-string 'safe-local-variable 'stringp) |
| 1573 | ;;;_ = allout-after-save-decrypt | 1549 | ;;;_ = allout-after-save-decrypt |
| @@ -1599,15 +1575,15 @@ substition is used against the regexp matches, a la `replace-match'.") | |||
| 1599 | (defvar allout-encryption-ciphertext-rejection-regexps nil | 1575 | (defvar allout-encryption-ciphertext-rejection-regexps nil |
| 1600 | "Variable for regexps matching plaintext to remove before encryption. | 1576 | "Variable for regexps matching plaintext to remove before encryption. |
| 1601 | 1577 | ||
| 1602 | This is for the sake of redoing encryption in cases where the ciphertext | 1578 | This is used to detect strings in encryption results that would |
| 1603 | incidentally contains strings that would disrupt mode operation -- | 1579 | register as allout mode structural elements, for exmple, as a |
| 1604 | for example, a line that happens to look like an allout-mode topic prefix. | 1580 | topic prefix. |
| 1605 | 1581 | ||
| 1606 | Entries must be symbols that are bound to the desired regexp values. | 1582 | Entries must be symbols that are bound to the desired regexp values. |
| 1607 | 1583 | ||
| 1608 | The encryption will be retried up to | 1584 | Encryptions that result in matches will be retried, up to |
| 1609 | `allout-encryption-ciphertext-rejection-limit' times, after which an error | 1585 | `allout-encryption-ciphertext-rejection-limit' times, after which |
| 1610 | is raised.") | 1586 | an error is raised.") |
| 1611 | 1587 | ||
| 1612 | (make-variable-buffer-local 'allout-encryption-ciphertext-rejection-regexps) | 1588 | (make-variable-buffer-local 'allout-encryption-ciphertext-rejection-regexps) |
| 1613 | ;;;_ = allout-encryption-ciphertext-rejection-ceiling | 1589 | ;;;_ = allout-encryption-ciphertext-rejection-ceiling |
| @@ -1937,19 +1913,22 @@ M-x outlineify-sticky Activate outline mode for current buffer, | |||
| 1937 | Topic Encryption | 1913 | Topic Encryption |
| 1938 | 1914 | ||
| 1939 | Outline mode supports gpg encryption of topics, with support for | 1915 | Outline mode supports gpg encryption of topics, with support for |
| 1940 | symmetric and key-pair modes, passphrase timeout, passphrase | 1916 | symmetric and key-pair modes, and auto-encryption of topics |
| 1941 | consistency checking, user-provided hinting for symmetric key | 1917 | pending encryption on save. |
| 1942 | mode, and auto-encryption of topics pending encryption on save. | ||
| 1943 | 1918 | ||
| 1944 | Topics pending encryption are, by default, automatically | 1919 | Topics pending encryption are, by default, automatically |
| 1945 | encrypted during file saves. If the contents of the topic | 1920 | encrypted during file saves, including checkpoint saves, to avoid |
| 1946 | containing the cursor was encrypted for a save, it is | 1921 | exposing the plain text of encrypted topics in the file system. |
| 1947 | automatically decrypted for continued editing. | 1922 | If the content of the topic containing the cursor was encrypted |
| 1948 | 1923 | for a save, it is automatically decrypted for continued editing. | |
| 1949 | The aim of these measures is reliable topic privacy while | 1924 | |
| 1950 | preventing accidents like neglected encryption before saves, | 1925 | PROBLEM: Attempting symmetric decryption with an incorrect key |
| 1951 | forgetting which passphrase was used, and other practical | 1926 | not only fails, but for some GnuPG v2 versions the incorrect key |
| 1952 | pitfalls. | 1927 | is apparently retained in the gpg cache and reused, preventing |
| 1928 | decryption, until the cache finally times out. That can take | ||
| 1929 | several minutes. \(Decryption of other entries is not affected.) | ||
| 1930 | To clear this problem before the cache times out, deliberately | ||
| 1931 | clear your gpg-agent's cache by sending it a '-HUP' signal. | ||
| 1953 | 1932 | ||
| 1954 | See `allout-toggle-current-subtree-encryption' function docstring | 1933 | See `allout-toggle-current-subtree-encryption' function docstring |
| 1955 | and `allout-encrypt-unencrypted-on-saves' customization variable | 1934 | and `allout-encrypt-unencrypted-on-saves' customization variable |
| @@ -5999,31 +5978,39 @@ With repeat count, copy the exposed portions of entire buffer." | |||
| 5999 | (goto-char start-pt))) | 5978 | (goto-char start-pt))) |
| 6000 | 5979 | ||
| 6001 | ;;;_ #8 Encryption | 5980 | ;;;_ #8 Encryption |
| 6002 | ;;;_ > allout-toggle-current-subtree-encryption (&optional fetch-pass) | 5981 | ;;;_ > allout-toggle-current-subtree-encryption (&optional keymode-cue) |
| 6003 | (defun allout-toggle-current-subtree-encryption (&optional fetch-pass) | 5982 | (defun allout-toggle-current-subtree-encryption (&optional keymode-cue) |
| 6004 | "Encrypt clear or decrypt encoded text of visibly-containing topic's contents. | 5983 | "Encrypt clear or decrypt encoded topic text. |
| 6005 | 5984 | ||
| 6006 | Optional FETCH-PASS universal argument provokes key-pair encryption with | 5985 | Allout uses emacs 'epg' libary to perform encryption. Symmetric |
| 6007 | single universal argument. With doubled universal argument (value = 16), | 5986 | and keypair encryption are supported. All encryption is ascii |
| 6008 | it forces prompting for the passphrase regardless of availability from the | 5987 | armored. |
| 6009 | passphrase cache. With no universal argument, the appropriate passphrase | 5988 | |
| 6010 | is obtained from the cache, if available, else from the user. | 5989 | Entry encryption defaults to symmetric key mode unless keypair |
| 6011 | 5990 | recipients are associated with the file \(see | |
| 6012 | Only GnuPG encryption is supported. | 5991 | `epa-file-encrypt-to') or the function is invoked with a |
| 6013 | 5992 | \(KEYMODE-CUE) universal argument greater than 1. | |
| 6014 | \*NOTE WELL* that the encrypted text must be ascii-armored. For gnupg | 5993 | |
| 6015 | encryption, include the option ``armor'' in your ~/.gnupg/gpg.conf file. | 5994 | When encrypting, KEYMODE-CUE universal argument greater than 1 |
| 6016 | 5995 | causes prompting for recipients for public-key keypair | |
| 6017 | Both symmetric-key and key-pair encryption is implemented. Symmetric is | 5996 | encryption. Selecting no recipients results in symmetric key |
| 6018 | the default, use a single (x4) universal argument for keypair mode. | 5997 | encryption. |
| 6019 | 5998 | ||
| 6020 | Encrypted topic's bullet is set to a `~' to signal that the contents of the | 5999 | Further, encrypting with a KEYMODE-CUE universal argument greater |
| 6021 | topic (body and subtopics, but not heading) is pending encryption or | 6000 | than 4 - eg, preceded by a doubled Ctrl-U - causes association of |
| 6022 | encrypted. `*' asterisk immediately after the bullet signals that the body | 6001 | the specified recipients with the file, replacing those currently |
| 6023 | is encrypted, its' absence means the topic is meant to be encrypted but is | 6002 | associated with it. This can be used to deassociate any |
| 6024 | not. When a file with topics pending encryption is saved, topics pending | 6003 | recipients with the file, by selecting no recipients in the |
| 6025 | encryption are encrypted. See allout-encrypt-unencrypted-on-saves for | 6004 | dialog. |
| 6026 | auto-encryption specifics. | 6005 | |
| 6006 | Encrypted topic's bullets are set to a `~' to signal that the | ||
| 6007 | contents of the topic (body and subtopics, but not heading) is | ||
| 6008 | pending encryption or encrypted. `*' asterisk immediately after | ||
| 6009 | the bullet signals that the body is encrypted, its absence means | ||
| 6010 | the topic is meant to be encrypted but is not currently. When a | ||
| 6011 | file with topics pending encryption is saved, topics pending | ||
| 6012 | encryption are encrypted. See allout-encrypt-unencrypted-on-saves | ||
| 6013 | for auto-encryption specifics. | ||
| 6027 | 6014 | ||
| 6028 | \*NOTE WELL* that automatic encryption that happens during saves will | 6015 | \*NOTE WELL* that automatic encryption that happens during saves will |
| 6029 | default to symmetric encryption -- you must deliberately (re)encrypt key-pair | 6016 | default to symmetric encryption -- you must deliberately (re)encrypt key-pair |
| @@ -6031,59 +6018,35 @@ encrypted topics if you want them to continue to use the key-pair cipher. | |||
| 6031 | 6018 | ||
| 6032 | Level-one topics, with prefix consisting solely of an `*' asterisk, cannot be | 6019 | Level-one topics, with prefix consisting solely of an `*' asterisk, cannot be |
| 6033 | encrypted. If you want to encrypt the contents of a top-level topic, use | 6020 | encrypted. If you want to encrypt the contents of a top-level topic, use |
| 6034 | \\[allout-shift-in] to increase its depth. | 6021 | \\[allout-shift-in] to increase its depth." |
| 6035 | |||
| 6036 | Passphrase Caching | ||
| 6037 | |||
| 6038 | The encryption passphrase is solicited if not currently available in the | ||
| 6039 | passphrase cache from a recent encryption action. | ||
| 6040 | |||
| 6041 | The solicited passphrase is retained for reuse in a cache, if enabled. See | ||
| 6042 | `pgg-cache-passphrase' and `pgg-passphrase-cache-expiry' for details. | ||
| 6043 | |||
| 6044 | Symmetric Passphrase Hinting and Verification | ||
| 6045 | |||
| 6046 | If the file previously had no associated passphrase, or had a different | ||
| 6047 | passphrase than specified, the user is prompted to repeat the new one for | ||
| 6048 | corroboration. A random string encrypted by the new passphrase is set on | ||
| 6049 | the buffer-specific variable `allout-passphrase-verifier-string', for | ||
| 6050 | confirmation of the passphrase when next obtained, before encrypting or | ||
| 6051 | decrypting anything with it. This helps avoid mistakenly shifting between | ||
| 6052 | keys. | ||
| 6053 | |||
| 6054 | If allout customization var `allout-passphrase-verifier-handling' is | ||
| 6055 | non-nil, an entry for `allout-passphrase-verifier-string' and its value is | ||
| 6056 | added to an Emacs 'local variables' section at the end of the file, which | ||
| 6057 | is created if necessary. That setting is for retention of the passphrase | ||
| 6058 | verifier across Emacs sessions. | ||
| 6059 | |||
| 6060 | Similarly, `allout-passphrase-hint-string' stores a user-provided reminder | ||
| 6061 | about their passphrase, and `allout-passphrase-hint-handling' specifies | ||
| 6062 | when the hint is presented, or if passphrase hints are disabled. If | ||
| 6063 | enabled (see the `allout-passphrase-hint-handling' docstring for details), | ||
| 6064 | the hint string is stored in the local-variables section of the file, and | ||
| 6065 | solicited whenever the passphrase is changed." | ||
| 6066 | (interactive "P") | 6022 | (interactive "P") |
| 6067 | (save-excursion | 6023 | (save-excursion |
| 6068 | (allout-back-to-current-heading) | 6024 | (allout-back-to-current-heading) |
| 6069 | (allout-toggle-subtree-encryption fetch-pass) | 6025 | (allout-toggle-subtree-encryption keymode-cue))) |
| 6070 | ) | 6026 | ;;;_ > allout-toggle-subtree-encryption (&optional keymode-cue) |
| 6071 | ) | 6027 | (defun allout-toggle-subtree-encryption (&optional keymode-cue) |
| 6072 | ;;;_ > allout-toggle-subtree-encryption (&optional fetch-pass) | ||
| 6073 | (defun allout-toggle-subtree-encryption (&optional fetch-pass) | ||
| 6074 | "Encrypt clear text or decrypt encoded topic contents (body and subtopics.) | 6028 | "Encrypt clear text or decrypt encoded topic contents (body and subtopics.) |
| 6075 | 6029 | ||
| 6076 | Optional FETCH-PASS universal argument provokes key-pair encryption with | 6030 | Entry encryption defaults to symmetric key mode unless keypair |
| 6077 | single universal argument. With doubled universal argument (value = 16), | 6031 | recipients are associated with the file \(see |
| 6078 | it forces prompting for the passphrase regardless of availability from the | 6032 | `epa-file-encrypt-to') or the function is invoked with a |
| 6079 | passphrase cache. With no universal argument, the appropriate passphrase | 6033 | \(KEYMODE-CUE) universal argument greater than 1. |
| 6080 | is obtained from the cache, if available, else from the user. | 6034 | |
| 6035 | When encrypting, KEYMODE-CUE universal argument greater than 1 | ||
| 6036 | causes prompting for recipients for public-key keypair | ||
| 6037 | encryption. Selecting no recipients results in symmetric key | ||
| 6038 | encryption. | ||
| 6081 | 6039 | ||
| 6082 | Currently only GnuPG encryption is supported, and integration | 6040 | Further, encrypting with a KEYMODE-CUE universal argument greater |
| 6083 | with gpg-agent is not yet implemented. | 6041 | than 4 - eg, preceded by a doubled Ctrl-U - causes association of |
| 6042 | the specified recipients with the file, replacing those currently | ||
| 6043 | associated with it. This can be used to deassociate any | ||
| 6044 | recipients with the file, by selecting no recipients in the | ||
| 6045 | dialog. | ||
| 6084 | 6046 | ||
| 6085 | \**NOTE WELL** that the encrypted text must be ascii-armored. For gnupg | 6047 | Encryption and decryption uses the emacs epg library. |
| 6086 | encryption, include the option ``armor'' in your ~/.gnupg/gpg.conf file. | 6048 | |
| 6049 | Encrypted text will be ascii-armored. | ||
| 6087 | 6050 | ||
| 6088 | See `allout-toggle-current-subtree-encryption' for more details." | 6051 | See `allout-toggle-current-subtree-encryption' for more details." |
| 6089 | 6052 | ||
| @@ -6121,16 +6084,6 @@ See `allout-toggle-current-subtree-encryption' for more details." | |||
| 6121 | (if was-encrypted "de" "en")) | 6084 | (if was-encrypted "de" "en")) |
| 6122 | nil)) | 6085 | nil)) |
| 6123 | ;; Assess key parameters: | 6086 | ;; Assess key parameters: |
| 6124 | (key-info (or | ||
| 6125 | ;; detect the type by which it is already encrypted | ||
| 6126 | (and was-encrypted | ||
| 6127 | (allout-encrypted-key-info subject-text)) | ||
| 6128 | (and (member fetch-pass '(4 (4))) | ||
| 6129 | '(keypair nil)) | ||
| 6130 | '(symmetric nil))) | ||
| 6131 | (for-key-type (car key-info)) | ||
| 6132 | (for-key-identity (cadr key-info)) | ||
| 6133 | (fetch-pass (and fetch-pass (member fetch-pass '(16 (16))))) | ||
| 6134 | (was-coding-system buffer-file-coding-system)) | 6087 | (was-coding-system buffer-file-coding-system)) |
| 6135 | 6088 | ||
| 6136 | (when (not was-encrypted) | 6089 | (when (not was-encrypted) |
| @@ -6156,8 +6109,7 @@ See `allout-toggle-current-subtree-encryption' for more details." | |||
| 6156 | 6109 | ||
| 6157 | (setq result-text | 6110 | (setq result-text |
| 6158 | (allout-encrypt-string subject-text was-encrypted | 6111 | (allout-encrypt-string subject-text was-encrypted |
| 6159 | (current-buffer) | 6112 | (current-buffer) keymode-cue)) |
| 6160 | for-key-type for-key-identity fetch-pass)) | ||
| 6161 | 6113 | ||
| 6162 | ;; Replace the subtree with the processed product. | 6114 | ;; Replace the subtree with the processed product. |
| 6163 | (allout-unprotected | 6115 | (allout-unprotected |
| @@ -6188,335 +6140,172 @@ See `allout-toggle-current-subtree-encryption' for more details." | |||
| 6188 | (insert "*")))) | 6140 | (insert "*")))) |
| 6189 | (run-hook-with-args 'allout-structure-added-hook | 6141 | (run-hook-with-args 'allout-structure-added-hook |
| 6190 | bullet-pos subtree-end)))) | 6142 | bullet-pos subtree-end)))) |
| 6191 | ;;;_ > allout-encrypt-string (text decrypt allout-buffer key-type for-key | 6143 | ;;;_ > allout-encrypt-string (text decrypt allout-buffer keymode-cue |
| 6192 | ;;; fetch-pass &optional retried verifying | 6144 | ;;; &optional rejected) |
| 6193 | ;;; passphrase) | 6145 | (defun allout-encrypt-string (text decrypt allout-buffer keymode-cue |
| 6194 | (defun allout-encrypt-string (text decrypt allout-buffer key-type for-key | 6146 | &optional rejected) |
| 6195 | fetch-pass &optional retried rejected | ||
| 6196 | verifying passphrase) | ||
| 6197 | "Encrypt or decrypt message TEXT. | 6147 | "Encrypt or decrypt message TEXT. |
| 6198 | 6148 | ||
| 6199 | If DECRYPT is true (default false), then decrypt instead of encrypt. | 6149 | Returns the resulting string, or nil if the transformation fails. |
| 6200 | 6150 | ||
| 6201 | FETCH-PASS (default false) forces fresh prompting for the passphrase. | 6151 | If DECRYPT is true (default false), then decrypt instead of encrypt. |
| 6202 | 6152 | ||
| 6203 | KEY-TYPE, either `symmetric' or `keypair', specifies which type | 6153 | ALLOUT-BUFFER identifies the buffer containing the text. |
| 6204 | of cypher to use. | ||
| 6205 | 6154 | ||
| 6206 | FOR-KEY is human readable identification of the first of the user's | 6155 | Entry encryption defaults to symmetric key mode unless keypair |
| 6207 | eligible secret keys a keypair decryption targets, or else nil. | 6156 | recipients are associated with the file \(see |
| 6157 | `epa-file-encrypt-to') or the function is invoked with a | ||
| 6158 | \(KEYMODE-CUE) universal argument greater than 1. | ||
| 6208 | 6159 | ||
| 6209 | Optional RETRIED is for internal use -- conveys the number of failed keys | 6160 | When encrypting, KEYMODE-CUE universal argument greater than 1 |
| 6210 | that have been solicited in sequence leading to this current call. | 6161 | causes prompting for recipients for public-key keypair |
| 6162 | encryption. Selecting no recipients results in symmetric key | ||
| 6163 | encryption. | ||
| 6211 | 6164 | ||
| 6212 | Optional PASSPHRASE enables explicit delivery of the decryption passphrase, | 6165 | Further, encrypting with a KEYMODE-CUE universal argument greater |
| 6213 | for verification purposes. | 6166 | than 4 - eg, preceded by a doubled Ctrl-U - causes association of |
| 6167 | the specified recipients with the file, replacing those currently | ||
| 6168 | associated with it. This can be used to deassociate any | ||
| 6169 | recipients with the file, by selecting no recipients in the | ||
| 6170 | dialog. | ||
| 6214 | 6171 | ||
| 6215 | Optional REJECTED is for internal use -- conveys the number of | 6172 | Optional REJECTED is for internal use, to convey the number of |
| 6216 | rejections due to matches against | 6173 | rejections due to matches against |
| 6217 | `allout-encryption-ciphertext-rejection-regexps', as limited by | 6174 | `allout-encryption-ciphertext-rejection-regexps', as limited by |
| 6218 | `allout-encryption-ciphertext-rejection-ceiling'. | 6175 | `allout-encryption-ciphertext-rejection-ceiling'. |
| 6219 | 6176 | ||
| 6220 | Returns the resulting string, or nil if the transformation fails." | 6177 | PROBLEM: Attempting symmetric decryption with an incorrect key |
| 6221 | 6178 | not only fails, but for some GnuPG v2 versions the incorrect key | |
| 6222 | (require 'pgg) | 6179 | is apparently retained in the gpg cache and reused, preventing |
| 6223 | 6180 | decryption, until the cache finally times out. That can take | |
| 6224 | (if (not (fboundp 'pgg-encrypt-symmetric)) | 6181 | several minutes. \(Decryption of other entries is not affected.) |
| 6225 | (error "Allout encryption depends on a newer version of pgg")) | 6182 | To clear this problem before the cache times out, deliberately |
| 6226 | 6183 | clear your gpg-agent's cache by sending it a '-HUP' signal." | |
| 6227 | (let* ((scheme (upcase | 6184 | |
| 6228 | (format "%s" (or pgg-scheme pgg-default-scheme "GPG")))) | 6185 | (require 'epg) |
| 6229 | (for-key (and (equal key-type 'keypair) | 6186 | (require 'epa) |
| 6230 | (or for-key | 6187 | |
| 6231 | (split-string (read-string | 6188 | (let* ((epg-context (let* ((context (epg-make-context nil t))) |
| 6232 | (format "%s message recipients: " | 6189 | (epg-context-set-passphrase-callback |
| 6233 | scheme)) | 6190 | context #'epa-passphrase-callback-function) |
| 6234 | "[ \t,]+")))) | 6191 | context)) |
| 6235 | (target-prompt-id (if (equal key-type 'keypair) | ||
| 6236 | (if (= (length for-key) 1) | ||
| 6237 | (car for-key) for-key) | ||
| 6238 | (buffer-name allout-buffer))) | ||
| 6239 | (target-cache-id (format "%s-%s" | ||
| 6240 | key-type | ||
| 6241 | (if (equal key-type 'keypair) | ||
| 6242 | target-prompt-id | ||
| 6243 | (or (buffer-file-name allout-buffer) | ||
| 6244 | target-prompt-id)))) | ||
| 6245 | (encoding (with-current-buffer allout-buffer | 6192 | (encoding (with-current-buffer allout-buffer |
| 6246 | buffer-file-coding-system)) | 6193 | buffer-file-coding-system)) |
| 6247 | (multibyte (with-current-buffer allout-buffer | 6194 | (multibyte (with-current-buffer allout-buffer |
| 6248 | enable-multibyte-characters)) | 6195 | enable-multibyte-characters)) |
| 6249 | (strip-plaintext-regexps | 6196 | ;; "sanitization" avoids encryption results that are outline structure. |
| 6250 | (if (not decrypt) | 6197 | (sani-regexps 'allout-encryption-plaintext-sanitization-regexps) |
| 6251 | (allout-get-configvar-values | 6198 | (strip-plaintext-regexps (if (not decrypt) |
| 6252 | 'allout-encryption-plaintext-sanitization-regexps))) | 6199 | (allout-get-configvar-values |
| 6253 | (reject-ciphertext-regexps | 6200 | sani-regexps))) |
| 6254 | (if (not decrypt) | 6201 | (rejection-regexps 'allout-encryption-ciphertext-rejection-regexps) |
| 6255 | (allout-get-configvar-values | 6202 | (reject-ciphertext-regexps (if (not decrypt) |
| 6256 | 'allout-encryption-ciphertext-rejection-regexps))) | 6203 | (allout-get-configvar-values |
| 6204 | rejection-regexps))) | ||
| 6257 | (rejected (or rejected 0)) | 6205 | (rejected (or rejected 0)) |
| 6258 | (rejections-left (- allout-encryption-ciphertext-rejection-ceiling | 6206 | (rejections-left (- allout-encryption-ciphertext-rejection-ceiling |
| 6259 | rejected)) | 6207 | rejected)) |
| 6260 | result-text status | 6208 | (keypair-mode (cond (decrypt 'decrypting) |
| 6209 | ((<= (prefix-numeric-value keymode-cue) 1) | ||
| 6210 | 'default) | ||
| 6211 | ((<= (prefix-numeric-value keymode-cue) 4) | ||
| 6212 | 'prompt) | ||
| 6213 | ((> (prefix-numeric-value keymode-cue) 4) | ||
| 6214 | 'prompt-save))) | ||
| 6215 | (keypair-message (concat "Select encryption recipients.\n" | ||
| 6216 | "Symmetric encryption is done if no" | ||
| 6217 | " recipients are selected. ")) | ||
| 6218 | (encrypt-to (and (boundp 'epa-file-encrypt-to) epa-file-encrypt-to)) | ||
| 6219 | recipients | ||
| 6220 | massaged-text | ||
| 6221 | result-text | ||
| 6261 | ) | 6222 | ) |
| 6262 | 6223 | ||
| 6263 | (if (and fetch-pass (not passphrase)) | 6224 | ;; Massage the subject text for encoding and filtering. |
| 6264 | ;; Force later fetch by evicting passphrase from the cache. | 6225 | (with-temp-buffer |
| 6265 | (pgg-remove-passphrase-from-cache target-cache-id t)) | 6226 | (insert text) |
| 6266 | 6227 | ;; convey the text characteristics of the original buffer: | |
| 6267 | (catch 'encryption-failed | 6228 | (allout-set-buffer-multibyte multibyte) |
| 6268 | 6229 | (when encoding | |
| 6269 | ;; We handle only symmetric-key passphrase caching. | 6230 | (set-buffer-file-coding-system encoding) |
| 6270 | (if (and (not passphrase) | 6231 | (if (not decrypt) |
| 6271 | (not (equal key-type 'keypair))) | 6232 | (encode-coding-region (point-min) (point-max) encoding))) |
| 6272 | (setq passphrase (allout-obtain-passphrase for-key | 6233 | |
| 6273 | target-cache-id | 6234 | ;; remove sanitization regexps matches before encrypting: |
| 6274 | target-prompt-id | 6235 | (when (and strip-plaintext-regexps (not decrypt)) |
| 6275 | key-type | 6236 | (dolist (re strip-plaintext-regexps) |
| 6276 | allout-buffer | 6237 | (let ((re (if (listp re) (car re) re)) |
| 6277 | retried fetch-pass))) | 6238 | (replacement (if (listp re) (cadr re) ""))) |
| 6278 | 6239 | (goto-char (point-min)) | |
| 6279 | (with-temp-buffer | 6240 | (save-match-data |
| 6280 | 6241 | (while (re-search-forward re nil t) | |
| 6281 | (insert text) | 6242 | (replace-match replacement nil nil)))))) |
| 6282 | 6243 | (setq massaged-text (buffer-substring-no-properties (point-min) | |
| 6283 | ;; convey the text characteristics of the original buffer: | 6244 | (point-max)))) |
| 6284 | (allout-set-buffer-multibyte multibyte) | 6245 | ;; determine key mode and, if keypair, recipients: |
| 6285 | (when encoding | 6246 | (setq recipients |
| 6286 | (set-buffer-file-coding-system encoding) | 6247 | (case keypair-mode |
| 6287 | (if (not decrypt) | 6248 | |
| 6288 | (encode-coding-region (point-min) (point-max) encoding))) | 6249 | (decrypting nil) |
| 6289 | 6250 | ||
| 6290 | (when (and strip-plaintext-regexps (not decrypt)) | 6251 | (default (if encrypt-to (epg-list-keys epg-context encrypt-to))) |
| 6291 | (dolist (re strip-plaintext-regexps) | 6252 | |
| 6292 | (let ((re (if (listp re) (car re) re)) | 6253 | ((prompt prompt-save) |
| 6293 | (replacement (if (listp re) (cadr re) ""))) | 6254 | (save-window-excursion |
| 6294 | (goto-char (point-min)) | 6255 | (epa-select-keys epg-context keypair-message))))) |
| 6295 | (save-match-data | 6256 | |
| 6296 | (while (re-search-forward re nil t) | 6257 | (setq result-text |
| 6297 | (replace-match replacement nil nil)))))) | 6258 | (if decrypt |
| 6298 | 6259 | (epg-decrypt-string epg-context | |
| 6299 | (cond | 6260 | (encode-coding-string massaged-text |
| 6300 | 6261 | (or encoding 'utf-8))) | |
| 6301 | ;; symmetric: | 6262 | (epg-encrypt-string epg-context |
| 6302 | ((equal key-type 'symmetric) | 6263 | (encode-coding-string massaged-text |
| 6303 | (setq status | 6264 | (or encoding 'utf-8)) |
| 6304 | (if decrypt | 6265 | recipients))) |
| 6305 | 6266 | ||
| 6306 | (pgg-decrypt (point-min) (point-max) passphrase) | 6267 | ;; validate result -- non-empty |
| 6307 | 6268 | (if (not result-text) | |
| 6308 | (pgg-encrypt-symmetric (point-min) (point-max) | 6269 | (error "%scryption failed." (if decrypt "De" "En"))) |
| 6309 | passphrase))) | 6270 | |
| 6310 | 6271 | ||
| 6311 | (if status | 6272 | (when (eq keypair-mode 'prompt-save) |
| 6312 | (pgg-situate-output (point-min) (point-max)) | 6273 | ;; set epa-file-encrypt-to in the buffer: |
| 6313 | ;; failed -- handle passphrase caching | 6274 | (setq epa-file-encrypt-to (mapcar (lambda (key) |
| 6314 | (if verifying | 6275 | (epg-user-id-string |
| 6315 | (throw 'encryption-failed nil) | 6276 | (car (epg-key-user-id-list key)))) |
| 6316 | (pgg-remove-passphrase-from-cache target-cache-id t) | 6277 | recipients)) |
| 6317 | (error "Symmetric-cipher %scryption failed -- %s" | 6278 | ;; change the file variable: |
| 6318 | (if decrypt "de" "en") | 6279 | (allout-adjust-file-variable "epa-file-encrypt-to" epa-file-encrypt-to)) |
| 6319 | "try again with different passphrase")))) | ||
| 6320 | |||
| 6321 | ;; encrypt `keypair': | ||
| 6322 | ((not decrypt) | ||
| 6323 | |||
| 6324 | (setq status | ||
| 6325 | |||
| 6326 | (pgg-encrypt for-key | ||
| 6327 | nil (point-min) (point-max) passphrase)) | ||
| 6328 | |||
| 6329 | (if status | ||
| 6330 | (pgg-situate-output (point-min) (point-max)) | ||
| 6331 | (error (pgg-remove-passphrase-from-cache target-cache-id t) | ||
| 6332 | (error "encryption failed")))) | ||
| 6333 | |||
| 6334 | ;; decrypt `keypair': | ||
| 6335 | (t | ||
| 6336 | |||
| 6337 | (setq status | ||
| 6338 | (pgg-decrypt (point-min) (point-max) passphrase)) | ||
| 6339 | |||
| 6340 | (if status | ||
| 6341 | (pgg-situate-output (point-min) (point-max)) | ||
| 6342 | (error (pgg-remove-passphrase-from-cache target-cache-id t) | ||
| 6343 | (error "decryption failed"))))) | ||
| 6344 | |||
| 6345 | (setq result-text | ||
| 6346 | (buffer-substring-no-properties | ||
| 6347 | 1 (- (point-max) (if decrypt 0 1)))) | ||
| 6348 | ) | ||
| 6349 | |||
| 6350 | ;; validate result -- non-empty | ||
| 6351 | (cond ((not result-text) | ||
| 6352 | (if verifying | ||
| 6353 | nil | ||
| 6354 | ;; transform was fruitless, retry w/new passphrase. | ||
| 6355 | (pgg-remove-passphrase-from-cache target-cache-id t) | ||
| 6356 | (allout-encrypt-string text decrypt allout-buffer | ||
| 6357 | key-type for-key nil | ||
| 6358 | (if retried (1+ retried) 1) | ||
| 6359 | rejected verifying nil))) | ||
| 6360 | |||
| 6361 | ;; Retry (within limit) if ciphertext contains rejections: | ||
| 6362 | ((and (not decrypt) | ||
| 6363 | ;; Check for disqualification of this ciphertext: | ||
| 6364 | (let ((regexps reject-ciphertext-regexps) | ||
| 6365 | reject-it) | ||
| 6366 | (while (and regexps (not reject-it)) | ||
| 6367 | (setq reject-it (string-match (car regexps) | ||
| 6368 | result-text)) | ||
| 6369 | (pop regexps)) | ||
| 6370 | reject-it)) | ||
| 6371 | (setq rejections-left (1- rejections-left)) | ||
| 6372 | (if (<= rejections-left 0) | ||
| 6373 | (error (concat "Ciphertext rejected too many times" | ||
| 6374 | " (%s), per `%s'") | ||
| 6375 | allout-encryption-ciphertext-rejection-ceiling | ||
| 6376 | 'allout-encryption-ciphertext-rejection-regexps) | ||
| 6377 | (allout-encrypt-string text decrypt allout-buffer | ||
| 6378 | key-type for-key nil | ||
| 6379 | retried (1+ rejected) | ||
| 6380 | verifying passphrase))) | ||
| 6381 | ;; Barf if encryption yields extraordinary control chars: | ||
| 6382 | ((and (not decrypt) | ||
| 6383 | (string-match "[\C-a\C-k\C-o-\C-z\C-@]" | ||
| 6384 | result-text)) | ||
| 6385 | (error (concat "Encryption produced non-armored text, which" | ||
| 6386 | "conflicts with allout mode -- reconfigure!"))) | ||
| 6387 | |||
| 6388 | ;; valid result and just verifying or non-symmetric: | ||
| 6389 | ((or verifying (not (equal key-type 'symmetric))) | ||
| 6390 | (if (or verifying decrypt) | ||
| 6391 | (pgg-add-passphrase-to-cache target-cache-id | ||
| 6392 | passphrase t)) | ||
| 6393 | result-text) | ||
| 6394 | |||
| 6395 | ;; valid result and regular symmetric -- "register" | ||
| 6396 | ;; passphrase with mnemonic aids/cache. | ||
| 6397 | (t | ||
| 6398 | (set-buffer allout-buffer) | ||
| 6399 | (if passphrase | ||
| 6400 | (pgg-add-passphrase-to-cache target-cache-id | ||
| 6401 | passphrase t)) | ||
| 6402 | (allout-update-passphrase-mnemonic-aids for-key passphrase | ||
| 6403 | allout-buffer) | ||
| 6404 | result-text) | ||
| 6405 | ) | ||
| 6406 | ) | ||
| 6407 | ) | ||
| 6408 | ) | ||
| 6409 | ;;;_ > allout-obtain-passphrase (for-key cache-id prompt-id key-type | ||
| 6410 | ;;; allout-buffer retried fetch-pass) | ||
| 6411 | (defun allout-obtain-passphrase (for-key cache-id prompt-id key-type | ||
| 6412 | allout-buffer retried fetch-pass) | ||
| 6413 | "Obtain passphrase for a key from the cache or else from the user. | ||
| 6414 | |||
| 6415 | When obtaining from the user, symmetric-cipher passphrases are verified | ||
| 6416 | against either, if available and enabled, a random string that was | ||
| 6417 | encrypted against the passphrase, or else against repeated entry by the | ||
| 6418 | user for corroboration. | ||
| 6419 | |||
| 6420 | FOR-KEY is the key for which the passphrase is being obtained. | ||
| 6421 | |||
| 6422 | CACHE-ID is the cache id of the key for the passphrase. | ||
| 6423 | |||
| 6424 | PROMPT-ID is the id for use when prompting the user. | ||
| 6425 | |||
| 6426 | KEY-TYPE is either `symmetric' or `keypair'. | ||
| 6427 | |||
| 6428 | ALLOUT-BUFFER is the buffer containing the entry being en/decrypted. | ||
| 6429 | |||
| 6430 | RETRIED is the number of this attempt to obtain this passphrase. | ||
| 6431 | |||
| 6432 | FETCH-PASS causes the passphrase to be solicited from the user, regardless | ||
| 6433 | of the availability of a cached copy." | ||
| 6434 | |||
| 6435 | (if (not (equal key-type 'symmetric)) | ||
| 6436 | ;; do regular passphrase read on non-symmetric passphrase: | ||
| 6437 | (pgg-read-passphrase (format "%s passphrase%s: " | ||
| 6438 | (upcase (format "%s" (or pgg-scheme | ||
| 6439 | pgg-default-scheme | ||
| 6440 | "GPG"))) | ||
| 6441 | (if prompt-id | ||
| 6442 | (format " for %s" prompt-id) | ||
| 6443 | "")) | ||
| 6444 | cache-id t) | ||
| 6445 | |||
| 6446 | ;; Symmetric hereon: | ||
| 6447 | |||
| 6448 | (with-current-buffer allout-buffer | ||
| 6449 | (let* ((hint (if (and (not (string= allout-passphrase-hint-string "")) | ||
| 6450 | (or (equal allout-passphrase-hint-handling 'always) | ||
| 6451 | (and (equal allout-passphrase-hint-handling | ||
| 6452 | 'needed) | ||
| 6453 | retried))) | ||
| 6454 | (format " [%s]" allout-passphrase-hint-string) | ||
| 6455 | "")) | ||
| 6456 | (retry-message (if retried (format " (%s retry)" retried) "")) | ||
| 6457 | (prompt-sans-hint (format "'%s' symmetric passphrase%s: " | ||
| 6458 | prompt-id retry-message)) | ||
| 6459 | (full-prompt (format "'%s' symmetric passphrase%s%s: " | ||
| 6460 | prompt-id hint retry-message)) | ||
| 6461 | (prompt full-prompt) | ||
| 6462 | (verifier-string (allout-get-encryption-passphrase-verifier)) | ||
| 6463 | |||
| 6464 | (cached (and (not fetch-pass) | ||
| 6465 | (pgg-read-passphrase-from-cache cache-id t))) | ||
| 6466 | (got-pass (or cached | ||
| 6467 | (pgg-read-passphrase full-prompt cache-id t))) | ||
| 6468 | confirmation) | ||
| 6469 | |||
| 6470 | (if (not got-pass) | ||
| 6471 | nil | ||
| 6472 | 6280 | ||
| 6473 | ;; Duplicate our handle on the passphrase so it's not clobbered by | 6281 | (cond |
| 6474 | ;; deactivate-passwd memory clearing: | 6282 | ;; Retry (within limit) if ciphertext contains rejections: |
| 6475 | (setq got-pass (copy-sequence got-pass)) | 6283 | ((and (not decrypt) |
| 6476 | 6284 | ;; Check for disqualification of this ciphertext: | |
| 6477 | (cond (verifier-string | 6285 | (let ((regexps reject-ciphertext-regexps) |
| 6478 | (save-window-excursion | 6286 | reject-it) |
| 6479 | (if (allout-encrypt-string verifier-string 'decrypt | 6287 | (while (and regexps (not reject-it)) |
| 6480 | allout-buffer 'symmetric | 6288 | (setq reject-it (string-match (car regexps) result-text)) |
| 6481 | for-key nil 0 0 'verifying | 6289 | (pop regexps)) |
| 6482 | (copy-sequence got-pass)) | 6290 | reject-it)) |
| 6483 | (setq confirmation (format "%s" got-pass)))) | 6291 | (setq rejections-left (1- rejections-left)) |
| 6484 | 6292 | (if (<= rejections-left 0) | |
| 6485 | (if (and (not confirmation) | 6293 | (error (concat "Ciphertext rejected too many times" |
| 6486 | (if (yes-or-no-p | 6294 | " (%s), per `%s'") |
| 6487 | (concat "Passphrase differs from established" | 6295 | allout-encryption-ciphertext-rejection-ceiling |
| 6488 | " -- use new one instead? ")) | 6296 | 'allout-encryption-ciphertext-rejection-regexps) |
| 6489 | ;; deactivate password for subsequent | 6297 | ;; try again (gpg-agent may have the key cached): |
| 6490 | ;; confirmation: | 6298 | (allout-encrypt-string text decrypt allout-buffer keypair-mode |
| 6491 | (progn | 6299 | (1+ rejected)))) |
| 6492 | (pgg-remove-passphrase-from-cache cache-id t) | 6300 | |
| 6493 | (setq prompt prompt-sans-hint) | 6301 | ;; Barf if encryption yields extraordinary control chars: |
| 6494 | nil) | 6302 | ((and (not decrypt) |
| 6495 | t)) | 6303 | (string-match "[\C-a\C-k\C-o-\C-z\C-@]" |
| 6496 | (progn (pgg-remove-passphrase-from-cache cache-id t) | 6304 | result-text)) |
| 6497 | (error "Wrong passphrase")))) | 6305 | (error (concat "Encryption produced non-armored text, which" |
| 6498 | ;; No verifier string -- force confirmation by repetition of | 6306 | "conflicts with allout mode -- reconfigure!"))) |
| 6499 | ;; (new) passphrase: | 6307 | |
| 6500 | ((or fetch-pass (not cached)) | 6308 | (t result-text)))) |
| 6501 | (pgg-remove-passphrase-from-cache cache-id t)))) | ||
| 6502 | ;; confirmation vs new input -- doing pgg-read-passphrase will do the | ||
| 6503 | ;; right thing, in either case: | ||
| 6504 | (if (not confirmation) | ||
| 6505 | (setq confirmation | ||
| 6506 | (pgg-read-passphrase (concat prompt | ||
| 6507 | " ... confirm spelling: ") | ||
| 6508 | cache-id t))) | ||
| 6509 | (prog1 | ||
| 6510 | (if (equal got-pass confirmation) | ||
| 6511 | confirmation | ||
| 6512 | (if (yes-or-no-p (concat "spelling of original and" | ||
| 6513 | " confirmation differ -- retry? ")) | ||
| 6514 | (progn (setq retried (if retried (1+ retried) 1)) | ||
| 6515 | (pgg-remove-passphrase-from-cache cache-id t) | ||
| 6516 | ;; recurse to this routine: | ||
| 6517 | (pgg-read-passphrase prompt-sans-hint cache-id t)) | ||
| 6518 | (pgg-remove-passphrase-from-cache cache-id t) | ||
| 6519 | (error "Confirmation failed")))))))) | ||
| 6520 | ;;;_ > allout-encrypted-topic-p () | 6309 | ;;;_ > allout-encrypted-topic-p () |
| 6521 | (defun allout-encrypted-topic-p () | 6310 | (defun allout-encrypted-topic-p () |
| 6522 | "True if the current topic is encryptable and encrypted." | 6311 | "True if the current topic is encryptable and encrypted." |
| @@ -6527,129 +6316,6 @@ of the availability of a cached copy." | |||
| 6527 | (save-match-data (looking-at "\\*"))) | 6316 | (save-match-data (looking-at "\\*"))) |
| 6528 | ) | 6317 | ) |
| 6529 | ) | 6318 | ) |
| 6530 | ;;;_ > allout-encrypted-key-info (text) | ||
| 6531 | ;; XXX gpg-specific, alas | ||
| 6532 | (defun allout-encrypted-key-info (text) | ||
| 6533 | "Return a pair of the key type and identity of a recipient's secret key. | ||
| 6534 | |||
| 6535 | The key type is one of `symmetric' or `keypair'. | ||
| 6536 | |||
| 6537 | If `keypair', and some of the user's secret keys are among those for which | ||
| 6538 | the message was encoded, return the identity of the first. Otherwise, | ||
| 6539 | return nil for the second item of the pair. | ||
| 6540 | |||
| 6541 | An error is raised if the text is not encrypted." | ||
| 6542 | (require 'pgg-parse) | ||
| 6543 | (save-excursion | ||
| 6544 | (with-temp-buffer | ||
| 6545 | (insert text) | ||
| 6546 | (let* ((parsed-armor (pgg-parse-armor-region (point-min) (point-max))) | ||
| 6547 | ;; pgg-gpg-symmetric-key-p has lost track. | ||
| 6548 | (type (if (assq 'symmetric-key-algorithm (car (cdr parsed-armor))) | ||
| 6549 | 'symmetric | ||
| 6550 | 'keypair)) | ||
| 6551 | secret-keys first-secret-key for-key-owner) | ||
| 6552 | (if (equal type 'keypair) | ||
| 6553 | (setq secret-keys (pgg-gpg-lookup-all-secret-keys) | ||
| 6554 | first-secret-key (pgg-gpg-select-matching-key parsed-armor | ||
| 6555 | secret-keys) | ||
| 6556 | for-key-owner (and first-secret-key | ||
| 6557 | (pgg-gpg-lookup-key-owner | ||
| 6558 | first-secret-key)))) | ||
| 6559 | (list type (pgg-gpg-key-id-from-key-owner for-key-owner)) | ||
| 6560 | ) | ||
| 6561 | ) | ||
| 6562 | ) | ||
| 6563 | ) | ||
| 6564 | ;;;_ > allout-create-encryption-passphrase-verifier (passphrase) | ||
| 6565 | (defun allout-create-encryption-passphrase-verifier (passphrase) | ||
| 6566 | "Encrypt random message for later validation of symmetric key's passphrase." | ||
| 6567 | ;; use 20 random ascii characters, across the entire ascii range. | ||
| 6568 | (random t) | ||
| 6569 | (let ((spew (make-string 20 ?\0))) | ||
| 6570 | (dotimes (i (length spew)) | ||
| 6571 | (aset spew i (1+ (random 254)))) | ||
| 6572 | (allout-encrypt-string spew nil (current-buffer) 'symmetric | ||
| 6573 | nil nil 0 0 passphrase)) | ||
| 6574 | ) | ||
| 6575 | ;;;_ > allout-update-passphrase-mnemonic-aids (for-key passphrase | ||
| 6576 | ;;; outline-buffer) | ||
| 6577 | (defun allout-update-passphrase-mnemonic-aids (for-key passphrase | ||
| 6578 | outline-buffer) | ||
| 6579 | "Update passphrase verifier and hint strings if necessary. | ||
| 6580 | |||
| 6581 | See `allout-passphrase-verifier-string' and `allout-passphrase-hint-string' | ||
| 6582 | settings. | ||
| 6583 | |||
| 6584 | PASSPHRASE is the passphrase being mnemonicized. | ||
| 6585 | |||
| 6586 | OUTLINE-BUFFER is the buffer of the outline being adjusted. | ||
| 6587 | |||
| 6588 | These are used to help the user keep track of the passphrase they use for | ||
| 6589 | symmetric encryption in the file. | ||
| 6590 | |||
| 6591 | Behavior is governed by `allout-passphrase-verifier-handling', | ||
| 6592 | `allout-passphrase-hint-handling', and also, controlling whether the values | ||
| 6593 | are preserved on Emacs local file variables, | ||
| 6594 | `allout-enable-file-variable-adjustment'." | ||
| 6595 | |||
| 6596 | ;; If passphrase doesn't agree with current verifier: | ||
| 6597 | ;; - adjust the verifier | ||
| 6598 | ;; - if passphrase hint handling is enabled, adjust the passphrase hint | ||
| 6599 | ;; - if file var settings are enabled, adjust the file vars | ||
| 6600 | |||
| 6601 | (let* ((new-verifier-needed (not (allout-verify-passphrase | ||
| 6602 | for-key passphrase outline-buffer))) | ||
| 6603 | (new-verifier-string | ||
| 6604 | (if new-verifier-needed | ||
| 6605 | ;; Collapse to a single line and enclose in string quotes: | ||
| 6606 | (subst-char-in-string | ||
| 6607 | ?\n ?\C-a (allout-create-encryption-passphrase-verifier | ||
| 6608 | passphrase)))) | ||
| 6609 | new-hint) | ||
| 6610 | (when new-verifier-string | ||
| 6611 | ;; do the passphrase hint first, since it's interactive | ||
| 6612 | (when (and allout-passphrase-hint-handling | ||
| 6613 | (not (equal allout-passphrase-hint-handling 'disabled))) | ||
| 6614 | (setq new-hint | ||
| 6615 | (read-from-minibuffer "Passphrase hint to jog your memory: " | ||
| 6616 | allout-passphrase-hint-string)) | ||
| 6617 | (when (not (string= new-hint allout-passphrase-hint-string)) | ||
| 6618 | (setq allout-passphrase-hint-string new-hint) | ||
| 6619 | (allout-adjust-file-variable "allout-passphrase-hint-string" | ||
| 6620 | allout-passphrase-hint-string))) | ||
| 6621 | (when allout-passphrase-verifier-handling | ||
| 6622 | (setq allout-passphrase-verifier-string new-verifier-string) | ||
| 6623 | (allout-adjust-file-variable "allout-passphrase-verifier-string" | ||
| 6624 | allout-passphrase-verifier-string)) | ||
| 6625 | ) | ||
| 6626 | ) | ||
| 6627 | ) | ||
| 6628 | ;;;_ > allout-get-encryption-passphrase-verifier () | ||
| 6629 | (defun allout-get-encryption-passphrase-verifier () | ||
| 6630 | "Return text of the encrypt passphrase verifier, unmassaged, or nil if none. | ||
| 6631 | |||
| 6632 | Derived from value of `allout-passphrase-verifier-string'." | ||
| 6633 | |||
| 6634 | (let ((verifier-string (and (boundp 'allout-passphrase-verifier-string) | ||
| 6635 | allout-passphrase-verifier-string))) | ||
| 6636 | (if verifier-string | ||
| 6637 | ;; Return it uncollapsed | ||
| 6638 | (subst-char-in-string ?\C-a ?\n verifier-string)) | ||
| 6639 | ) | ||
| 6640 | ) | ||
| 6641 | ;;;_ > allout-verify-passphrase (key passphrase allout-buffer) | ||
| 6642 | (defun allout-verify-passphrase (key passphrase allout-buffer) | ||
| 6643 | "True if passphrase successfully decrypts verifier, nil otherwise. | ||
| 6644 | |||
| 6645 | \"Otherwise\" includes absence of passphrase verifier." | ||
| 6646 | (with-current-buffer allout-buffer | ||
| 6647 | (and (boundp 'allout-passphrase-verifier-string) | ||
| 6648 | allout-passphrase-verifier-string | ||
| 6649 | (allout-encrypt-string (allout-get-encryption-passphrase-verifier) | ||
| 6650 | 'decrypt allout-buffer 'symmetric | ||
| 6651 | key nil 0 0 'verifying passphrase) | ||
| 6652 | t))) | ||
| 6653 | ;;;_ > allout-next-topic-pending-encryption (&optional except-mark) | 6319 | ;;;_ > allout-next-topic-pending-encryption (&optional except-mark) |
| 6654 | (defun allout-next-topic-pending-encryption (&optional except-mark) | 6320 | (defun allout-next-topic-pending-encryption (&optional except-mark) |
| 6655 | "Return the point of the next topic pending encryption, or nil if none. | 6321 | "Return the point of the next topic pending encryption, or nil if none. |