diff options
| -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. |