diff options
| author | Eli Zaretskii | 2005-10-23 08:24:15 +0000 |
|---|---|---|
| committer | Eli Zaretskii | 2005-10-23 08:24:15 +0000 |
| commit | 0949617b0153d5121c8ccfd5197f397819dad0c9 (patch) | |
| tree | 9b5ada34a0e86421785b98bd81a9ae53f688fef4 | |
| parent | 4ec5239cc90673a066fa12caffb1ac9461f2dd2f (diff) | |
| download | emacs-0949617b0153d5121c8ccfd5197f397819dad0c9.tar.gz emacs-0949617b0153d5121c8ccfd5197f397819dad0c9.zip | |
Increment version number to 2.1, and use a literal
rather than RCS $Id$. Remove autoloads for mailcrypt and crypt++.
Require pgg, pgg-gpg during compilation.
(allout-version): Increment version number to 2.1, and use a literal
rather than RCS $Id$.
(allout-default-encryption-scheme): Removed.
(allout-passphrase-verifier-handling): Renamed from
allout-key-verifier-handling.
(allout-passphrase-verifier-string): Renamed from allout-key-verifier-string.
(allout-file-passphrase-verifier-string): Renamed from
allout-file-key-verifier-string.
(allout-enable-file-variable-adjustment): Simplified.
(allout-passphrase-hint-handling): Renamed from
allout-key-hint-handling and simplified.
(allout-passphrase-hint-string): Renamed from allout-key-hint-string.
(allout-init): Use `find-file-hook' if available, otherwise `find-file-hooks'.
(allout-mode): Use `write-file-functions' if available, otherwise
`local-write-file-hooks' and, instead of making auto-save-hook
buffer local, make the write-file-hook activity contingent to allout-mode.
(allout-mode): Use key-binding substitution placeholders in the docstring.
(allout-kill-line): Spell-out kill ring data structure mutation
instead of using byte-compiler-complaint-provoking `pop'.
(allout-insert-listified): Use `insert' rather than `insert-string'
(allout-toggle-current-subtree-encryption): Updated docstring,
adjust to new gpp-based encryption, use new `allout-encrypted-topic-p'.
(allout-encrypt-string): Totally revamped vis new underlying encryption
facilities.
(allout-mc-activate-passwd): Removed.
(allout-obtain-passphrase): New, more or less replaces
allout-mc-activate-passwd.
(allout-encrypted-key-info): More or less replaces allout-encrypted-text-type.
(outlineify-sticky, outlinify-sticky): Add autoload cookie.
(my-mark-marker): Use `(featurep 'xemacs)' to distinguish between Emacs and
XEmacs.
| -rw-r--r-- | lisp/ChangeLog | 45 | ||||
| -rw-r--r-- | lisp/allout.el | 964 |
2 files changed, 538 insertions, 471 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index c35bcb40eba..0054789f55c 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,4 +1,49 @@ | |||
| 1 | 2005-10-23 Ken Manheimer <ken.manheimer@gmail.com> | ||
| 2 | |||
| 3 | * allout.el: Increment version number to 2.1, and use a literal | ||
| 4 | rather than RCS $Id$. Remove autoloads for mailcrypt and crypt++. | ||
| 5 | Require pgg, pgg-gpg during compilation. | ||
| 6 | (allout-version): Increment version number to 2.1, and use a literal | ||
| 7 | rather than RCS $Id$. | ||
| 8 | (allout-default-encryption-scheme): Removed. | ||
| 9 | (allout-passphrase-verifier-handling): Renamed from | ||
| 10 | allout-key-verifier-handling. | ||
| 11 | (allout-passphrase-verifier-string): Renamed from | ||
| 12 | allout-key-verifier-string. | ||
| 13 | (allout-file-passphrase-verifier-string): Renamed from | ||
| 14 | allout-file-key-verifier-string. | ||
| 15 | (allout-enable-file-variable-adjustment): Simplified. | ||
| 16 | (allout-passphrase-hint-handling): Renamed from | ||
| 17 | allout-key-hint-handling and simplified. | ||
| 18 | (allout-passphrase-hint-string): Renamed from | ||
| 19 | allout-key-hint-string. | ||
| 20 | (allout-init): Use `find-file-hook' if available, otherwise | ||
| 21 | `find-file-hooks'. | ||
| 22 | (allout-mode): Use `write-file-functions' if available, otherwise | ||
| 23 | `local-write-file-hooks' and, instead of making auto-save-hook | ||
| 24 | buffer local, make the write-file-hook activity contingent to | ||
| 25 | allout-mode. | ||
| 26 | (allout-mode): Use key-binding substitution placeholders in the | ||
| 27 | docstring. | ||
| 28 | (allout-kill-line): Spell-out kill ring data structure mutation | ||
| 29 | instead of using byte-compiler-complaint-provoking `pop'. | ||
| 30 | (allout-insert-listified): Use `insert' rather than `insert-string' | ||
| 31 | (allout-toggle-current-subtree-encryption): Updated docstring, | ||
| 32 | adjust to new gpp-based encryption, use new | ||
| 33 | `allout-encrypted-topic-p'. | ||
| 34 | (allout-encrypt-string): Totally revamped vis new underlying | ||
| 35 | encryption facilities. | ||
| 36 | (allout-mc-activate-passwd): Removed. | ||
| 37 | (allout-obtain-passphrase): New, more or less replaces | ||
| 38 | allout-mc-activate-passwd. | ||
| 39 | (allout-encrypted-key-info): More or less replaces | ||
| 40 | allout-encrypted-text-type. | ||
| 41 | (outlineify-sticky, outlinify-sticky): Add autoload cookie. | ||
| 42 | (my-mark-marker): Use `(featurep 'xemacs)' to distinguish between | ||
| 43 | Emacs and XEmacs. | ||
| 44 | |||
| 1 | 2005-10-23 Lars Hansen <larsh@soem.dk> | 45 | 2005-10-23 Lars Hansen <larsh@soem.dk> |
| 46 | |||
| 2 | * emacs-lisp/bytecomp.el (byte-compile-lambda): Add parameter | 47 | * emacs-lisp/bytecomp.el (byte-compile-lambda): Add parameter |
| 3 | add-lambda. | 48 | add-lambda. |
| 4 | (byte-compile-file-form-defmumble, byte-compile-defun) | 49 | (byte-compile-file-form-defmumble, byte-compile-defun) |
diff --git a/lisp/allout.el b/lisp/allout.el index b6c4fa21d2b..805b3cc288c 100644 --- a/lisp/allout.el +++ b/lisp/allout.el | |||
| @@ -6,6 +6,7 @@ | |||
| 6 | ;; Author: Ken Manheimer <ken dot manheimer at gmail dot com> | 6 | ;; Author: Ken Manheimer <ken dot manheimer at gmail dot com> |
| 7 | ;; Maintainer: Ken Manheimer <ken dot manheimer at gmail dot com> | 7 | ;; Maintainer: Ken Manheimer <ken dot manheimer at gmail dot com> |
| 8 | ;; Created: Dec 1991 - first release to usenet | 8 | ;; Created: Dec 1991 - first release to usenet |
| 9 | ;; Version: 2.1 | ||
| 9 | ;; Keywords: outlines wp languages | 10 | ;; Keywords: outlines wp languages |
| 10 | 11 | ||
| 11 | ;; This file is part of GNU Emacs. | 12 | ;; This file is part of GNU Emacs. |
| @@ -45,9 +46,10 @@ | |||
| 45 | ;; formatted as an outline - do ESC-x eval-current-buffer in allout.el | 46 | ;; formatted as an outline - do ESC-x eval-current-buffer in allout.el |
| 46 | ;; to try it out.) | 47 | ;; to try it out.) |
| 47 | ;; - configurable per-file initial exposure settings | 48 | ;; - configurable per-file initial exposure settings |
| 48 | ;; - symmetric-key and key-pair topic encryption, plus reliable key | 49 | ;; - symmetric-key and key-pair topic encryption, plus symmetric passphrase |
| 49 | ;; verification and user-supplied hint maintenance. (see | 50 | ;; mnemonic support, with verification against an established passphrase |
| 50 | ;; allout-toggle-current-subtree-encryption docstring.) | 51 | ;; (using a stashed encrypted dummy string) and user-supplied hint |
| 52 | ;; maintenance. (see allout-toggle-current-subtree-encryption docstring.) | ||
| 51 | ;; - automatic topic-number maintenance | 53 | ;; - automatic topic-number maintenance |
| 52 | ;; - "hot-spot" operation, for single-keystroke maneuvering and | 54 | ;; - "hot-spot" operation, for single-keystroke maneuvering and |
| 53 | ;; exposure control (see the allout-mode docstring) | 55 | ;; exposure control (see the allout-mode docstring) |
| @@ -79,17 +81,10 @@ | |||
| 79 | 81 | ||
| 80 | ;;;_* Dependency autoloads | 82 | ;;;_* Dependency autoloads |
| 81 | (eval-when-compile 'cl) ; otherwise, flet compilation fouls | 83 | (eval-when-compile 'cl) ; otherwise, flet compilation fouls |
| 82 | (autoload 'crypt-encrypt-buffer "crypt++") | 84 | (eval-when-compile (progn (require 'pgg) |
| 83 | (setq-default crypt-encryption-type 'gpg) | 85 | (require 'pgg-gpg))) |
| 84 | 86 | (autoload 'pgg-gpg-symmetric-key-p "pgg-gpg" | |
| 85 | (autoload 'mc-encrypt "mailcrypt" | 87 | "True if decoded armor MESSAGE-KEYS has symmetric encryption indicator.") |
| 86 | "*Encrypt the current buffer") | ||
| 87 | (autoload 'mc-activate-passwd "mailcrypt" | ||
| 88 | "Activate the passphrase matching ID, using PROMPT for a prompt. | ||
| 89 | Return the passphrase. If PROMPT is nil, only return value if cached.") | ||
| 90 | (autoload 'mc-gpg-process-region "mc-gpg") | ||
| 91 | (autoload 'mc-dectivate-passwd "mailcrypt" | ||
| 92 | "*Deactivate the passphrase cache.") | ||
| 93 | 88 | ||
| 94 | ;;;_* USER CUSTOMIZATION VARIABLES: | 89 | ;;;_* USER CUSTOMIZATION VARIABLES: |
| 95 | (defgroup allout nil | 90 | (defgroup allout nil |
| @@ -428,55 +423,30 @@ formatted copy." | |||
| 428 | "*Bullet signifying encryption of the entry's body." | 423 | "*Bullet signifying encryption of the entry's body." |
| 429 | :type '(choice (const nil) string) | 424 | :type '(choice (const nil) string) |
| 430 | :group 'allout) | 425 | :group 'allout) |
| 431 | ;;;_ = allout-default-encryption-scheme | 426 | ;;;_ = allout-passphrase-verifier-handling |
| 432 | (defcustom allout-default-encryption-scheme 'mc-scheme-gpg | 427 | (defcustom allout-passphrase-verifier-handling t |
| 433 | "*Default allout outline topic encryption mode. | 428 | "*Enable use of symmetric encryption passphrase verifier if non-nil. |
| 434 | |||
| 435 | See mailcrypt variable `mc-schemes' and mailcrypt docs for encryption schemes." | ||
| 436 | :type 'symbol | ||
| 437 | :group 'allout) | ||
| 438 | ;;;_ = allout-key-verifier-handling | ||
| 439 | (defcustom allout-key-verifier-handling 'situate | ||
| 440 | "*Dictate outline encryption key verifier handling. | ||
| 441 | |||
| 442 | The key verifier is string associated with a file that is encrypted with | ||
| 443 | the file's current symmetric encryption key. It is used, if present, to | ||
| 444 | confirm that the key entered by the user is the same as the established | ||
| 445 | one, or explicitly presenting the user with the choice to go with a | ||
| 446 | new key when a difference is encountered. | ||
| 447 | |||
| 448 | The range of values are: | ||
| 449 | |||
| 450 | situate - include key verifier string as text in the file's local-vars | ||
| 451 | section | ||
| 452 | transient - establish the value as a variable in the file's buffer, but | ||
| 453 | don't preserve it as a file variable. | ||
| 454 | disabled - don't establish or do verification. | ||
| 455 | 429 | ||
| 456 | See the docstring for the `allout-enable-file-variable-adjustment' | 430 | See the docstring for the `allout-enable-file-variable-adjustment' |
| 457 | variable for details about allout ajustment of file variables." | 431 | variable for details about allout ajustment of file variables." |
| 458 | :type '(choice (const situate) | 432 | :type 'boolean |
| 459 | (const transient) | ||
| 460 | (const disabled)) | ||
| 461 | :group 'allout) | 433 | :group 'allout) |
| 462 | (make-variable-buffer-local 'allout-key-verifier-handling) | 434 | (make-variable-buffer-local 'allout-passphrase-verifier-handling) |
| 463 | ;;;_ = allout-key-hint-handling | 435 | ;;;_ = allout-passphrase-hint-handling |
| 464 | (defcustom allout-key-hint-handling 'always | 436 | (defcustom allout-passphrase-hint-handling 'always |
| 465 | "*Dictate outline encryption key reminder handling: | 437 | "*Dictate outline encryption passphrase reminder handling: |
| 466 | 438 | ||
| 467 | always - always show reminder when prompting | 439 | always - always show reminder when prompting |
| 468 | needed - show reminder on key entry failure | 440 | needed - show reminder on passphrase entry failure |
| 469 | manage - never present reminder, but still manage a file-var entry for it | 441 | disabled - never present or adjust reminder |
| 470 | disabled - don't even manage the file variable entry | ||
| 471 | 442 | ||
| 472 | See the docstring for the `allout-enable-file-variable-adjustment' | 443 | See the docstring for the `allout-enable-file-variable-adjustment' |
| 473 | variable for details about allout ajustment of file variables." | 444 | variable for details about allout ajustment of file variables." |
| 474 | :type '(choice (const always) | 445 | :type '(choice (const always) |
| 475 | (const needed) | 446 | (const needed) |
| 476 | (const manage) | ||
| 477 | (const disabled)) | 447 | (const disabled)) |
| 478 | :group 'allout) | 448 | :group 'allout) |
| 479 | (make-variable-buffer-local 'allout-key-hint-handling) | 449 | (make-variable-buffer-local 'allout-passphrase-hint-handling) |
| 480 | ;;;_ = allout-encrypt-unencrypted-on-saves | 450 | ;;;_ = allout-encrypt-unencrypted-on-saves |
| 481 | (defcustom allout-encrypt-unencrypted-on-saves 'except-current | 451 | (defcustom allout-encrypt-unencrypted-on-saves 'except-current |
| 482 | "*When saving, should topics pending encryption be encrypted? | 452 | "*When saving, should topics pending encryption be encrypted? |
| @@ -494,14 +464,14 @@ mostly covers both deliberate file writes and auto-saves. | |||
| 494 | - All except current topic: skip the topic currently being edited, even if | 464 | - All except current topic: skip the topic currently being edited, even if |
| 495 | it's pending encryption. This may expose the current topic on the | 465 | it's pending encryption. This may expose the current topic on the |
| 496 | file sytem, but avoids the nuisance of prompts for the encryption | 466 | file sytem, but avoids the nuisance of prompts for the encryption |
| 497 | key in the middle of editing for, eg, autosaves. | 467 | passphrase in the middle of editing for, eg, autosaves. |
| 498 | This mode is used for auto-saves for both this option and \"Yes\". | 468 | This mode is used for auto-saves for both this option and \"Yes\". |
| 499 | - No: leave it to the user to encrypt any unencrypted topics. | 469 | - No: leave it to the user to encrypt any unencrypted topics. |
| 500 | 470 | ||
| 501 | For practical reasons, auto-saves always use the 'except-current policy | 471 | For practical reasons, auto-saves always use the 'except-current policy |
| 502 | when auto-encryption is enabled. \(Otherwise, spurious key prompts and | 472 | when auto-encryption is enabled. \(Otherwise, spurious passphrase prompts |
| 503 | unavoidable timing collisions are too disruptive.) If security for a file | 473 | and unavoidable timing collisions are too disruptive.) If security for a |
| 504 | requires that even the current topic is never auto-saved in the clear, | 474 | file requires that even the current topic is never auto-saved in the clear, |
| 505 | disable auto-saves for that file." | 475 | disable auto-saves for that file." |
| 506 | 476 | ||
| 507 | :type '(choice (const :tag "Yes" t) | 477 | :type '(choice (const :tag "Yes" t) |
| @@ -606,7 +576,7 @@ those that do not have the variable `comment-start' set. A value of | |||
| 606 | 576 | ||
| 607 | ;;;_ = allout-enable-file-variable-adjustment | 577 | ;;;_ = allout-enable-file-variable-adjustment |
| 608 | (defcustom allout-enable-file-variable-adjustment t | 578 | (defcustom allout-enable-file-variable-adjustment t |
| 609 | "*If non-nil, some allout outline actions can edit Emacs file variables text. | 579 | "*If non-nil, some allout outline actions edit Emacs local file var text. |
| 610 | 580 | ||
| 611 | This can range from changes to existing entries, addition of new ones, | 581 | This can range from changes to existing entries, addition of new ones, |
| 612 | and creation of a new local variables section when necessary. | 582 | and creation of a new local variables section when necessary. |
| @@ -626,14 +596,8 @@ details." | |||
| 626 | ;;;_ #1 Internal Outline Formatting and Configuration | 596 | ;;;_ #1 Internal Outline Formatting and Configuration |
| 627 | ;;;_ : Version | 597 | ;;;_ : Version |
| 628 | ;;;_ = allout-version | 598 | ;;;_ = allout-version |
| 629 | (defvar allout-version | 599 | (defvar allout-version "2.1" |
| 630 | (let ((rcs-rev "$Revision: 1.68 $")) | 600 | "Version of currently loaded outline package. \(allout.el)") |
| 631 | (condition-case err | ||
| 632 | (save-match-data | ||
| 633 | (string-match "Revision: \\([0-9]+\\.[0-9]+\\)" rcs-rev) | ||
| 634 | (substring rcs-rev (match-beginning 1) (match-end 1))) | ||
| 635 | ('error rcs-rev))) | ||
| 636 | "Revision number of currently loaded outline package. \(allout.el)") | ||
| 637 | ;;;_ > allout-version | 601 | ;;;_ > allout-version |
| 638 | (defun allout-version (&optional here) | 602 | (defun allout-version (&optional here) |
| 639 | "Return string describing the loaded outline version." | 603 | "Return string describing the loaded outline version." |
| @@ -1027,45 +991,38 @@ the way that `before-change-functions' and undo interact.") | |||
| 1027 | "Horrible hack used to prevent invalid multiple triggering of outline | 991 | "Horrible hack used to prevent invalid multiple triggering of outline |
| 1028 | mode from prop-line file-var activation. Used by `allout-mode' function | 992 | mode from prop-line file-var activation. Used by `allout-mode' function |
| 1029 | to track repeats.") | 993 | to track repeats.") |
| 1030 | ;;;_ = allout-file-key-verifier-string | 994 | ;;;_ = allout-file-passphrase-verifier-string |
| 1031 | (defvar allout-file-key-verifier-string nil | 995 | (defvar allout-file-passphrase-verifier-string nil |
| 1032 | "Name for use as a file variable for verifying encryption key across | 996 | "Name for use as a file variable for verifying encryption passphrase |
| 1033 | sessions.") | 997 | across sessions.") |
| 1034 | (make-variable-buffer-local 'allout-file-key-verifier-string) | 998 | (make-variable-buffer-local 'allout-file-passphrase-verifier-string) |
| 1035 | ;;;_ = allout-encryption-scheme | 999 | ;;;_ = allout-passphrase-verifier-string |
| 1036 | (defvar allout-encryption-scheme nil | 1000 | (defvar allout-passphrase-verifier-string nil |
| 1037 | "*Allout outline topic encryption scheme pending for the current buffer. | 1001 | "Setting used to test solicited encryption passphrases against the one |
| 1038 | 1002 | already associated with a file. | |
| 1039 | Intended as a file-specific (buffer local) setting, it defaults to the | 1003 | |
| 1040 | value of allout-default-encryption-scheme if nil.") | 1004 | It consists of an encrypted random string useful only to verify that a |
| 1041 | (make-variable-buffer-local 'allout-encryption-scheme) | 1005 | passphrase entered by the user is effective for decryption. The passphrase |
| 1042 | ;;;_ = allout-key-verifier-string | 1006 | itself is \*not* recorded in the file anywhere, and the encrypted contents |
| 1043 | (defvar allout-key-verifier-string nil | 1007 | are random binary characters to avoid exposing greater susceptibility to |
| 1044 | "Setting used to test solicited encryption keys against that already | 1008 | search attacks. |
| 1045 | associated with a file. | ||
| 1046 | |||
| 1047 | It consists of an encrypted random string useful only to verify that a key | ||
| 1048 | entered by the user is effective for decryption. The key itself is \*not* | ||
| 1049 | recorded in the file anywhere, and the encrypted contents are random binary | ||
| 1050 | characters to avoid exposing greater susceptibility to search attacks. | ||
| 1051 | 1009 | ||
| 1052 | The verifier string is retained as an Emacs file variable, as well as in | 1010 | The verifier string is retained as an Emacs file variable, as well as in |
| 1053 | the emacs buffer state, if file variable adjustments are enabled. See | 1011 | the emacs buffer state, if file variable adjustments are enabled. See |
| 1054 | `allout-enable-file-variable-adjustment' for details about that.") | 1012 | `allout-enable-file-variable-adjustment' for details about that.") |
| 1055 | (make-variable-buffer-local 'allout-key-verifier-string) | 1013 | (make-variable-buffer-local 'allout-passphrase-verifier-string) |
| 1056 | (setq-default allout-key-verifier-string nil) | 1014 | ;;;_ = allout-passphrase-hint-string |
| 1057 | ;;;_ = allout-key-hint-string | 1015 | (defvar allout-passphrase-hint-string "" |
| 1058 | (defvar allout-key-hint-string "" | 1016 | "Variable used to retain reminder string for file's encryption passphrase. |
| 1059 | "Variable used to retain a reminder string for a file's encryption key. | ||
| 1060 | 1017 | ||
| 1061 | See the description of `allout-key-hint-handling' for details about how | 1018 | See the description of `allout-passphrase-hint-handling' for details about how |
| 1062 | the reminder is deployed. | 1019 | the reminder is deployed. |
| 1063 | 1020 | ||
| 1064 | The hint is retained as an Emacs file variable, as well as in the emacs buffer | 1021 | The hint is retained as an Emacs file variable, as well as in the emacs buffer |
| 1065 | state, if file variable adjustments are enabled. See | 1022 | state, if file variable adjustments are enabled. See |
| 1066 | `allout-enable-file-variable-adjustment' for details about that.") | 1023 | `allout-enable-file-variable-adjustment' for details about that.") |
| 1067 | (make-variable-buffer-local 'allout-key-hint-string) | 1024 | (make-variable-buffer-local 'allout-passphrase-hint-string) |
| 1068 | (setq-default allout-key-hint-string "") | 1025 | (setq-default allout-passphrase-hint-string "") |
| 1069 | ;;;_ = allout-after-save-decrypt | 1026 | ;;;_ = allout-after-save-decrypt |
| 1070 | (defvar allout-after-save-decrypt nil | 1027 | (defvar allout-after-save-decrypt nil |
| 1071 | "Internal variable, is nil or has the value of two points: | 1028 | "Internal variable, is nil or has the value of two points: |
| @@ -1080,7 +1037,8 @@ was encrypted automatically as part of a file write or autosave.") | |||
| 1080 | (defun allout-write-file-hook-handler () | 1037 | (defun allout-write-file-hook-handler () |
| 1081 | "Implement `allout-encrypt-unencrypted-on-saves' policy for file writes." | 1038 | "Implement `allout-encrypt-unencrypted-on-saves' policy for file writes." |
| 1082 | 1039 | ||
| 1083 | (if (or (not (boundp 'allout-encrypt-unencrypted-on-saves)) | 1040 | (if (or (not (allout-mode-p)) |
| 1041 | (not (boundp 'allout-encrypt-unencrypted-on-saves)) | ||
| 1084 | (not allout-encrypt-unencrypted-on-saves)) | 1042 | (not allout-encrypt-unencrypted-on-saves)) |
| 1085 | nil | 1043 | nil |
| 1086 | (let ((except-mark (and (equal allout-encrypt-unencrypted-on-saves | 1044 | (let ((except-mark (and (equal allout-encrypt-unencrypted-on-saves |
| @@ -1105,7 +1063,7 @@ was encrypted automatically as part of a file write or autosave.") | |||
| 1105 | (defun allout-auto-save-hook-handler () | 1063 | (defun allout-auto-save-hook-handler () |
| 1106 | "Implement `allout-encrypt-unencrypted-on-saves' policy for auto saves." | 1064 | "Implement `allout-encrypt-unencrypted-on-saves' policy for auto saves." |
| 1107 | 1065 | ||
| 1108 | (if allout-encrypt-unencrypted-on-saves | 1066 | (if (and (allout-mode-p) allout-encrypt-unencrypted-on-saves) |
| 1109 | ;; Always implement 'except-current policy when enabled. | 1067 | ;; Always implement 'except-current policy when enabled. |
| 1110 | (let ((allout-encrypt-unencrypted-on-saves 'except-current)) | 1068 | (let ((allout-encrypt-unencrypted-on-saves 'except-current)) |
| 1111 | (allout-write-file-hook-handler)))) | 1069 | (allout-write-file-hook-handler)))) |
| @@ -1190,18 +1148,22 @@ the following two lines in your Emacs init file: | |||
| 1190 | (let | 1148 | (let |
| 1191 | ;; convenience aliases, for consistent ref to respective vars: | 1149 | ;; convenience aliases, for consistent ref to respective vars: |
| 1192 | ((hook 'allout-find-file-hook) | 1150 | ((hook 'allout-find-file-hook) |
| 1151 | (find-file-hook-var-name (if (boundp 'find-file-hook) | ||
| 1152 | 'find-file-hook | ||
| 1153 | 'find-file-hooks)) | ||
| 1193 | (curr-mode 'allout-auto-activation)) | 1154 | (curr-mode 'allout-auto-activation)) |
| 1194 | 1155 | ||
| 1195 | (cond ((not mode) | 1156 | (cond ((not mode) |
| 1196 | (setq find-file-hooks (delq hook find-file-hooks)) | 1157 | (set find-file-hook-var-name |
| 1158 | (delq hook (symbol-value find-file-hook-var-name))) | ||
| 1197 | (if (interactive-p) | 1159 | (if (interactive-p) |
| 1198 | (message "Allout outline mode auto-activation inhibited."))) | 1160 | (message "Allout outline mode auto-activation inhibited."))) |
| 1199 | ((eq mode 'report) | 1161 | ((eq mode 'report) |
| 1200 | (if (not (memq hook find-file-hooks)) | 1162 | (if (not (memq hook (symbol-value find-file-hook-var-name))) |
| 1201 | (allout-init nil) | 1163 | (allout-init nil) |
| 1202 | ;; Just punt and use the reports from each of the modes: | 1164 | ;; Just punt and use the reports from each of the modes: |
| 1203 | (allout-init (symbol-value curr-mode)))) | 1165 | (allout-init (symbol-value curr-mode)))) |
| 1204 | (t (add-hook 'find-file-hooks hook) | 1166 | (t (add-hook find-file-hook-var-name hook) |
| 1205 | (set curr-mode ; `set', not `setq'! | 1167 | (set curr-mode ; `set', not `setq'! |
| 1206 | (cond ((eq mode 'activate) | 1168 | (cond ((eq mode 'activate) |
| 1207 | (message | 1169 | (message |
| @@ -1233,6 +1195,7 @@ the following two lines in your Emacs init file: | |||
| 1233 | (easy-menu-add cur)))) | 1195 | (easy-menu-add cur)))) |
| 1234 | ;;;_ > allout-mode (&optional toggle) | 1196 | ;;;_ > allout-mode (&optional toggle) |
| 1235 | ;;;_ : Defun: | 1197 | ;;;_ : Defun: |
| 1198 | ;;;###autoload | ||
| 1236 | (defun allout-mode (&optional toggle) | 1199 | (defun allout-mode (&optional toggle) |
| 1237 | ;;;_ . Doc string: | 1200 | ;;;_ . Doc string: |
| 1238 | "Toggle minor mode for controlling exposure and editing of text outlines. | 1201 | "Toggle minor mode for controlling exposure and editing of text outlines. |
| @@ -1271,53 +1234,53 @@ The bindings are dictated by the `allout-keybindings-list' and | |||
| 1271 | 1234 | ||
| 1272 | Navigation: Exposure Control: | 1235 | Navigation: Exposure Control: |
| 1273 | ---------- ---------------- | 1236 | ---------- ---------------- |
| 1274 | C-c C-n allout-next-visible-heading | C-c C-h allout-hide-current-subtree | 1237 | \\[allout-next-visible-heading] allout-next-visible-heading | \\[allout-hide-current-subtree] allout-hide-current-subtree |
| 1275 | C-c C-p allout-previous-visible-heading | C-c C-i allout-show-children | 1238 | \\[allout-previous-visible-heading] allout-previous-visible-heading | \\[allout-show-children] allout-show-children |
| 1276 | C-c C-u allout-up-current-level | C-c C-s allout-show-current-subtree | 1239 | \\[allout-up-current-level] allout-up-current-level | \\[allout-show-current-subtree] allout-show-current-subtree |
| 1277 | C-c C-f allout-forward-current-level | C-c C-o allout-show-current-entry | 1240 | \\[allout-forward-current-level] allout-forward-current-level | \\[allout-show-current-entry] allout-show-current-entry |
| 1278 | C-c C-b allout-backward-current-level | ^U C-c C-s allout-show-all | 1241 | \\[allout-backward-current-level] allout-backward-current-level | \\[allout-show-all] allout-show-all |
| 1279 | C-c C-e allout-end-of-entry | allout-hide-current-leaves | 1242 | \\[allout-end-of-entry] allout-end-of-entry |
| 1280 | C-c C-a allout-beginning-of-current-entry, alternately, goes to hot-spot | 1243 | \\[allout-beginning-of-current-entry,] allout-beginning-of-current-entry, alternately, goes to hot-spot |
| 1281 | 1244 | ||
| 1282 | Topic Header Production: | 1245 | Topic Header Production: |
| 1283 | ----------------------- | 1246 | ----------------------- |
| 1284 | C-c<SP> allout-open-sibtopic Create a new sibling after current topic. | 1247 | \\[allout-open-sibtopic] allout-open-sibtopic Create a new sibling after current topic. |
| 1285 | C-c . allout-open-subtopic ... an offspring of current topic. | 1248 | \\[allout-open-subtopic] allout-open-subtopic ... an offspring of current topic. |
| 1286 | C-c , allout-open-supertopic ... a sibling of the current topic's parent. | 1249 | \\[allout-open-supertopic] allout-open-supertopic ... a sibling of the current topic's parent. |
| 1287 | 1250 | ||
| 1288 | Topic Level and Prefix Adjustment: | 1251 | Topic Level and Prefix Adjustment: |
| 1289 | --------------------------------- | 1252 | --------------------------------- |
| 1290 | C-c > allout-shift-in Shift current topic and all offspring deeper. | 1253 | \\[allout-shift-in] allout-shift-in Shift current topic and all offspring deeper. |
| 1291 | C-c < allout-shift-out ... less deep. | 1254 | \\[allout-shift-out] allout-shift-out ... less deep. |
| 1292 | C-c<CR> allout-rebullet-topic Reconcile bullets of topic and its offspring | 1255 | \\[allout-rebullet-current-heading] allout-rebullet-current-heading Prompt for alternate bullet for |
| 1256 | current topic. | ||
| 1257 | \\[allout-rebullet-topic] allout-rebullet-topic Reconcile bullets of topic and its offspring | ||
| 1293 | - distinctive bullets are not changed, others | 1258 | - distinctive bullets are not changed, others |
| 1294 | alternated according to nesting depth. | 1259 | alternated according to nesting depth. |
| 1295 | C-c b allout-rebullet-current-heading Prompt for alternate bullet for | 1260 | \\[allout-number-siblings] allout-number-siblings Number bullets of topic and siblings - the |
| 1296 | current topic. | ||
| 1297 | C-c # allout-number-siblings Number bullets of topic and siblings - the | ||
| 1298 | offspring are not affected. With repeat | 1261 | offspring are not affected. With repeat |
| 1299 | count, revoke numbering. | 1262 | count, revoke numbering. |
| 1300 | 1263 | ||
| 1301 | Topic-oriented Killing and Yanking: | 1264 | Topic-oriented Killing and Yanking: |
| 1302 | ---------------------------------- | 1265 | ---------------------------------- |
| 1303 | C-c C-k allout-kill-topic Kill current topic, including offspring. | 1266 | \\[allout-kill-topic] allout-kill-topic Kill current topic, including offspring. |
| 1304 | C-k allout-kill-line Like kill-line, but reconciles numbering, etc. | 1267 | \\[allout-kill-line] allout-kill-line Like kill-line, but reconciles numbering, etc. |
| 1305 | C-y allout-yank Yank, adjusting depth of yanked topic to | 1268 | \\[allout-yank] allout-yank Yank, adjusting depth of yanked topic to |
| 1306 | depth of heading if yanking into bare topic | 1269 | depth of heading if yanking into bare topic |
| 1307 | heading (ie, prefix sans text). | 1270 | heading (ie, prefix sans text). |
| 1308 | M-y allout-yank-pop Is to allout-yank as yank-pop is to yank | 1271 | \\[allout-yank-pop] allout-yank-pop Is to allout-yank as yank-pop is to yank |
| 1309 | 1272 | ||
| 1310 | Misc commands: | 1273 | Misc commands: |
| 1311 | ------------- | 1274 | ------------- |
| 1312 | M-x outlineify-sticky Activate outline mode for current buffer, | 1275 | M-x outlineify-sticky Activate outline mode for current buffer, |
| 1313 | and establish a default file-var setting | 1276 | and establish a default file-var setting |
| 1314 | for `allout-layout'. | 1277 | for `allout-layout'. |
| 1315 | C-c C-SPC allout-mark-topic | 1278 | \\[allout-mark-topic] allout-mark-topic |
| 1316 | C-c = c allout-copy-exposed-to-buffer | 1279 | \\[allout-copy-exposed-to-buffer] allout-copy-exposed-to-buffer |
| 1317 | Duplicate outline, sans concealed text, to | 1280 | Duplicate outline, sans concealed text, to |
| 1318 | buffer with name derived from derived from that | 1281 | buffer with name derived from derived from that |
| 1319 | of current buffer - \"*BUFFERNAME exposed*\". | 1282 | of current buffer - \"*BUFFERNAME exposed*\". |
| 1320 | C-c = p allout-flatten-exposed-to-buffer | 1283 | \\[allout-flatten-exposed-to-buffer] allout-flatten-exposed-to-buffer |
| 1321 | Like above 'copy-exposed', but convert topic | 1284 | Like above 'copy-exposed', but convert topic |
| 1322 | prefixes to section.subsection... numeric | 1285 | prefixes to section.subsection... numeric |
| 1323 | format. | 1286 | format. |
| @@ -1327,12 +1290,12 @@ ESC ESC (allout-init t) Setup Emacs session for outline mode | |||
| 1327 | Encrypted Entries | 1290 | Encrypted Entries |
| 1328 | 1291 | ||
| 1329 | Outline mode supports easily togglable gpg encryption of topics, with | 1292 | Outline mode supports easily togglable gpg encryption of topics, with |
| 1330 | niceities like support for symmetric and key-pair modes, key timeout, key | 1293 | niceties like support for symmetric and key-pair modes, passphrase timeout, |
| 1331 | consistency checking, user-provided hinting for symmetric key mode, and | 1294 | passphrase consistency checking, user-provided hinting for symmetric key |
| 1332 | auto-encryption of topics pending encryption on save. The aim is to enable | 1295 | mode, and auto-encryption of topics pending encryption on save. The aim is |
| 1333 | reliable topic privacy while preventing accidents like neglected | 1296 | to enable reliable topic privacy while preventing accidents like neglected |
| 1334 | encryption, encryption with a mistaken key, forgetting which key was used, | 1297 | encryption, encryption with a mistaken passphrase, forgetting which |
| 1335 | and other practical pitfalls. | 1298 | passphrase was used, and other practical pitfalls. |
| 1336 | 1299 | ||
| 1337 | See the `allout-toggle-current-subtree-encryption' function and | 1300 | See the `allout-toggle-current-subtree-encryption' function and |
| 1338 | `allout-encrypt-unencrypted-on-saves' customization variable for details. | 1301 | `allout-encrypt-unencrypted-on-saves' customization variable for details. |
| @@ -1450,6 +1413,9 @@ OPEN: A topic that is not closed, though its offspring or body may be." | |||
| 1450 | ;; allout-mode already called once during this complex command? | 1413 | ;; allout-mode already called once during this complex command? |
| 1451 | (same-complex-command (eq allout-v18/19-file-var-hack | 1414 | (same-complex-command (eq allout-v18/19-file-var-hack |
| 1452 | (car command-history))) | 1415 | (car command-history))) |
| 1416 | (write-file-hook-var-name (if (boundp 'write-file-functions) | ||
| 1417 | 'write-file-functions | ||
| 1418 | 'local-write-file-hooks)) | ||
| 1453 | do-layout | 1419 | do-layout |
| 1454 | ) | 1420 | ) |
| 1455 | 1421 | ||
| @@ -1500,9 +1466,9 @@ OPEN: A topic that is not closed, though its offspring or body may be." | |||
| 1500 | (allout-resumptions 'selective-display) | 1466 | (allout-resumptions 'selective-display) |
| 1501 | (if (and (boundp 'before-change-functions) before-change-functions) | 1467 | (if (and (boundp 'before-change-functions) before-change-functions) |
| 1502 | (allout-resumptions 'before-change-functions)) | 1468 | (allout-resumptions 'before-change-functions)) |
| 1503 | (setq local-write-file-hooks | 1469 | (set write-file-hook-var-name |
| 1504 | (delq 'allout-write-file-hook-handler | 1470 | (delq 'allout-write-file-hook-handler |
| 1505 | local-write-file-hooks)) | 1471 | (symbol-value write-file-hook-var-name))) |
| 1506 | (setq auto-save-hook | 1472 | (setq auto-save-hook |
| 1507 | (delq 'allout-auto-save-hook-handler | 1473 | (delq 'allout-auto-save-hook-handler |
| 1508 | auto-save-hook)) | 1474 | auto-save-hook)) |
| @@ -1563,8 +1529,7 @@ OPEN: A topic that is not closed, though its offspring or body may be." | |||
| 1563 | (allout-resumptions 'selective-display '(t)) | 1529 | (allout-resumptions 'selective-display '(t)) |
| 1564 | (add-hook 'pre-command-hook 'allout-pre-command-business) | 1530 | (add-hook 'pre-command-hook 'allout-pre-command-business) |
| 1565 | (add-hook 'post-command-hook 'allout-post-command-business) | 1531 | (add-hook 'post-command-hook 'allout-post-command-business) |
| 1566 | (add-hook 'local-write-file-hooks 'allout-write-file-hook-handler) | 1532 | (add-hook write-file-hook-var-name 'allout-write-file-hook-handler) |
| 1567 | (make-variable-buffer-local 'auto-save-hook) | ||
| 1568 | (add-hook 'auto-save-hook 'allout-auto-save-hook-handler) | 1533 | (add-hook 'auto-save-hook 'allout-auto-save-hook-handler) |
| 1569 | ; Custom auto-fill func, to support | 1534 | ; Custom auto-fill func, to support |
| 1570 | ; respect for topic headline, | 1535 | ; respect for topic headline, |
| @@ -2501,8 +2466,9 @@ return to regular interpretation of self-insert characters." | |||
| 2501 | last-command-char) | 2466 | last-command-char) |
| 2502 | ;; Only xemacs has characterp. | 2467 | ;; Only xemacs has characterp. |
| 2503 | ((and (fboundp 'characterp) | 2468 | ((and (fboundp 'characterp) |
| 2504 | (characterp last-command-char)) | 2469 | (apply 'characterp |
| 2505 | (char-to-int last-command-char)) | 2470 | (list last-command-char))) |
| 2471 | (apply 'char-to-int (list last-command-char))) | ||
| 2506 | (t 0))) | 2472 | (t 0))) |
| 2507 | mapped-binding) | 2473 | mapped-binding) |
| 2508 | (if (zerop this-key-num) | 2474 | (if (zerop this-key-num) |
| @@ -3506,7 +3472,9 @@ depth, however." | |||
| 3506 | ;; ensure prior kill-ring leader is properly restored: | 3472 | ;; ensure prior kill-ring leader is properly restored: |
| 3507 | (if (eq leading-kill-ring-entry (cadr kill-ring)) | 3473 | (if (eq leading-kill-ring-entry (cadr kill-ring)) |
| 3508 | ;; Aborted kill got pushed on front - ditch it: | 3474 | ;; Aborted kill got pushed on front - ditch it: |
| 3509 | (pop kill-ring) | 3475 | (let ((got (car kill-ring))) |
| 3476 | (setq kill-ring (cdr kill-ring)) | ||
| 3477 | got) | ||
| 3510 | ;; Aborted kill got appended to prior - resurrect prior: | 3478 | ;; Aborted kill got appended to prior - resurrect prior: |
| 3511 | (setcar kill-ring leading-kill-ring-entry)) | 3479 | (setcar kill-ring leading-kill-ring-entry)) |
| 3512 | ;; make last-command skip this failed command, so kill-appending | 3480 | ;; make last-command skip this failed command, so kill-appending |
| @@ -4608,7 +4576,7 @@ If `bullet-plus' is specified, it is inserted just after the entire prefix." | |||
| 4608 | (while text | 4576 | (while text |
| 4609 | (insert (car text)) | 4577 | (insert (car text)) |
| 4610 | (if (setq text (cdr text)) | 4578 | (if (setq text (cdr text)) |
| 4611 | (insert-string "\n"))) | 4579 | (insert "\n"))) |
| 4612 | (insert "\n"))) | 4580 | (insert "\n"))) |
| 4613 | ;;;_ > allout-copy-exposed-to-buffer (&optional arg tobuf format) | 4581 | ;;;_ > allout-copy-exposed-to-buffer (&optional arg tobuf format) |
| 4614 | (defun allout-copy-exposed-to-buffer (&optional arg tobuf format) | 4582 | (defun allout-copy-exposed-to-buffer (&optional arg tobuf format) |
| @@ -4881,11 +4849,15 @@ With repeat count, copy the exposed portions of entire buffer." | |||
| 4881 | (goto-char start-pt))) | 4849 | (goto-char start-pt))) |
| 4882 | 4850 | ||
| 4883 | ;;;_ #8 Encryption | 4851 | ;;;_ #8 Encryption |
| 4884 | ;;;_ > allout-toggle-current-subtree-encryption (&optional fetch-key) | 4852 | ;;;_ > allout-toggle-current-subtree-encryption (&optional fetch-pass) |
| 4885 | (defun allout-toggle-current-subtree-encryption (&optional fetch-key) | 4853 | (defun allout-toggle-current-subtree-encryption (&optional fetch-pass) |
| 4886 | "Encrypt clear text or decrypt encoded contents of a topic. | 4854 | "Encrypt clear text or decrypt encoded topic contents \(body and subtopics.) |
| 4887 | 4855 | ||
| 4888 | Contents includes body and subtopics. | 4856 | Optional FETCH-PASS universal argument provokes key-pair encryption with |
| 4857 | single universal argument. With doubled universal argument \(value = 16), | ||
| 4858 | it forces prompting for the passphrase regardless of availability from the | ||
| 4859 | passphrase cache. With no universal argument, the appropriate passphrase | ||
| 4860 | for the is obtained from the cache, if available, else from the user. | ||
| 4889 | 4861 | ||
| 4890 | Currently only GnuPG encryption is supported. | 4862 | Currently only GnuPG encryption is supported. |
| 4891 | 4863 | ||
| @@ -4897,67 +4869,52 @@ the default, use a single \(x4) universal argument for keypair mode. | |||
| 4897 | 4869 | ||
| 4898 | Encrypted topic's bullet is set to a `~' to signal that the contents of the | 4870 | Encrypted topic's bullet is set to a `~' to signal that the contents of the |
| 4899 | topic \(body and subtopics, but not heading) is pending encryption or | 4871 | topic \(body and subtopics, but not heading) is pending encryption or |
| 4900 | encrypted. An `*' asterisk immediately after the bullet signals that the | 4872 | encrypted. `*' asterisk immediately after the bullet signals that the body |
| 4901 | body is encrypted, its absence means it's meant to be encrypted but is not | 4873 | is encrypted, its' absence means the topic is meant to be encrypted but is |
| 4902 | - it's \"disclosed\". When a file with disclosed topics is saved, the user | 4874 | not. When a file with topics pending encryption is saved, topics pending |
| 4903 | prompted for an ok to \(symmetric-key) encrypt the disclosed topics. NOTE | 4875 | encryption are encrypted. See allout-encrypt-unencrypted-on-saves for |
| 4904 | WELL that you must explicitly \(re)encrypt key-pair encrypted topics if you | 4876 | auto-encryption specifics. |
| 4905 | want them to continue to be in key-pair mode. | 4877 | |
| 4878 | \**NOTE WELL** that automatic encryption that happens during saves will | ||
| 4879 | default to symmetric encryption - you must manually \(re)encrypt key-pair | ||
| 4880 | encrypted topics if you want them to continue to use the key-pair cipher. | ||
| 4906 | 4881 | ||
| 4907 | Level-1 topics, with prefix consisting solely of an `*' asterisk, cannot be | 4882 | Level-1 topics, with prefix consisting solely of an `*' asterisk, cannot be |
| 4908 | encrypted. If you want to encrypt the contents of a top-level topic, use | 4883 | encrypted. If you want to encrypt the contents of a top-level topic, use |
| 4909 | \\[allout-shift-in] to increase its depth. | 4884 | \\[allout-shift-in] to increase its depth. |
| 4910 | 4885 | ||
| 4911 | Failed transformation does not change the an entry being encrypted - | 4886 | Passphrase Caching |
| 4912 | instead, the key is re-solicited and the transformation is retried. | 4887 | |
| 4913 | \\[keyboard-quit] to abort. | 4888 | The encryption passphrase is solicited if not currently available in the |
| 4914 | 4889 | passphrase cache from a recent encryption action. | |
| 4915 | Decryption does symmetric or key-pair key mode depending on how the text | 4890 | |
| 4916 | was encrypted. The encryption key is solicited if not currently available | 4891 | The solicited passphrase is retained for reuse in a buffer-specific cache |
| 4917 | from the key cache from a recent prior encryption action. | 4892 | for some set period of time \(default, 60 seconds), after which the string |
| 4918 | 4893 | is nulled. The passphrase cache timeout is customized by setting | |
| 4919 | Optional FETCH-KEY universal argument is used for two purposes - to provoke | 4894 | `pgg-passphrase-cache-expiry'. |
| 4920 | key-pair instead of symmetric encryption, or to provoke clearing of the key | 4895 | |
| 4921 | cache so keys are freshly fetched. | 4896 | Symmetric Passphrase Hinting and Verification |
| 4922 | 4897 | ||
| 4923 | - Without any universal arguments, then the appropriate key for the is | 4898 | If the file previously had no associated passphrase, or had a different |
| 4924 | obtained from the cache, if available, else from the user. | 4899 | passphrase than specified, the user is prompted to repeat the new one for |
| 4925 | 4900 | corroboration. A random string encrypted by the new passphrase is set on | |
| 4926 | - If FETCH-KEY is the result of one universal argument - ie, equal to 4 - | 4901 | the buffer-specific variable `allout-passphrase-verifier-string', for |
| 4927 | then key-pair encryption is used. | 4902 | confirmation of the passphrase when next obtained, before encrypting or |
| 4928 | 4903 | decrypting anything with it. This helps avoid mistakenly shifting between | |
| 4929 | - With repeated universal argument - equal to 16 - then the key cache is | 4904 | keys. |
| 4930 | cleared before any encryption transformations, to force prompting of the | 4905 | |
| 4931 | user for the key. | 4906 | If allout customization var `allout-passphrase-verifier-handling' is |
| 4932 | 4907 | non-nil, an entry for `allout-passphrase-verifier-string' and its value is | |
| 4933 | The solicited key is retained for reuse in a buffer-specific cache for some | 4908 | added to an Emacs 'local variables' section at the end of the file, which |
| 4934 | set period of time \(default, 60 seconds), after which the string is | 4909 | is created if necessary. That setting is for retention of the passphrase |
| 4935 | nulled. `mailcrypt' provides the key caching functionality. You can | 4910 | verifier across emacs sessions. |
| 4936 | adjust the key cache timeout by ajdusting the setting of the elisp variable | 4911 | |
| 4937 | `mc-passwd-timeout'. | 4912 | Similarly, `allout-passphrase-hint-string' stores a user-provided reminder |
| 4938 | 4913 | about their passphrase, and `allout-passphrase-hint-handling' specifies | |
| 4939 | If the file previously had no associated key, or had a different key than | 4914 | when the hint is presented, or if passphrase hints are disabled. If |
| 4940 | specified, the user is prompted to repeat the new one for corroboration. A | 4915 | enabled \(see the `allout-passphrase-hint-handling' docstring for details), |
| 4941 | random string encrypted by the new key is set on the buffer-specific | 4916 | the hint string is stored in the local-variables section of the file, and |
| 4942 | variable `allout-key-verifier-string', for confirmation of the key when | 4917 | solicited whenever the passphrase is changed." |
| 4943 | next obtained, before encrypting or decrypting anything with it. This | ||
| 4944 | helps avoid mistakenly shifting between keys. | ||
| 4945 | |||
| 4946 | If allout customization var `allout-key-verifier-handling' is non-nil, an | ||
| 4947 | entry for `allout-key-verifier-string' and its value is added to an Emacs | ||
| 4948 | 'local variables' section at the end of the file, which is created if | ||
| 4949 | necessary. That setting is for retention of the key verifier across emacs | ||
| 4950 | sessions. | ||
| 4951 | |||
| 4952 | Similarly, `allout-key-hint-string' stores a user-provided reminder about | ||
| 4953 | their key, and `allout-key-hint-handling' specifies when the hint is | ||
| 4954 | presented, or if key hints are disabled. If enabled \(see the | ||
| 4955 | `allout-key-hint-handling' docstring for details), the hint string is | ||
| 4956 | stored in the local-variables section of the file, and solicited whenever | ||
| 4957 | the key is changed." | ||
| 4958 | |||
| 4959 | ;;; This routine handles allout-specific business, dispatching | ||
| 4960 | ;;; encryption-specific business to allout-encrypt-string. | ||
| 4961 | 4918 | ||
| 4962 | (interactive "P") | 4919 | (interactive "P") |
| 4963 | (save-excursion | 4920 | (save-excursion |
| @@ -4967,17 +4924,13 @@ the key is changed." | |||
| 4967 | (error (concat "Cannot encrypt or decrypt level 1 topics -" | 4924 | (error (concat "Cannot encrypt or decrypt level 1 topics -" |
| 4968 | " shift it in to make it encryptable"))) | 4925 | " shift it in to make it encryptable"))) |
| 4969 | 4926 | ||
| 4970 | (if (and fetch-key | ||
| 4971 | (not (equal fetch-key '(4)))) | ||
| 4972 | (mc-deactivate-passwd)) | ||
| 4973 | |||
| 4974 | (let* ((allout-buffer (current-buffer)) | 4927 | (let* ((allout-buffer (current-buffer)) |
| 4975 | ;; Asses location: | 4928 | ;; Asses location: |
| 4976 | (after-bullet-pos (point)) | 4929 | (after-bullet-pos (point)) |
| 4977 | (was-encrypted | 4930 | (was-encrypted |
| 4978 | (progn (if (= (point-max) after-bullet-pos) | 4931 | (progn (if (= (point-max) after-bullet-pos) |
| 4979 | (error "no body to encrypt")) | 4932 | (error "no body to encrypt")) |
| 4980 | (looking-at "\\*"))) | 4933 | (allout-encrypted-topic-p))) |
| 4981 | (was-collapsed (if (not (re-search-forward "[\n\r]" nil t)) | 4934 | (was-collapsed (if (not (re-search-forward "[\n\r]" nil t)) |
| 4982 | nil | 4935 | nil |
| 4983 | (backward-char 1) | 4936 | (backward-char 1) |
| @@ -4993,20 +4946,22 @@ the key is changed." | |||
| 4993 | (error "No topic contents to %scrypt" | 4946 | (error "No topic contents to %scrypt" |
| 4994 | (if was-encrypted "de" "en")))) | 4947 | (if was-encrypted "de" "en")))) |
| 4995 | ;; Assess key parameters: | 4948 | ;; Assess key parameters: |
| 4996 | (key-type (or | 4949 | (key-info (or |
| 4997 | ;; detect the type by which it is already encrypted | 4950 | ;; detect the type by which it is already encrypted |
| 4998 | (and was-encrypted | 4951 | (and was-encrypted |
| 4999 | (allout-encrypted-text-type subject-text)) | 4952 | (allout-encrypted-key-info subject-text)) |
| 5000 | (and (member fetch-key '(4 (4))) | 4953 | (and (member fetch-pass '(4 (4))) |
| 5001 | (yes-or-no-p "Use key-pair encryption instead? ") | 4954 | '(keypair nil)) |
| 5002 | 'keypair) | 4955 | '(symmetric nil))) |
| 5003 | 'symmetric)) | 4956 | (for-key-type (car key-info)) |
| 5004 | (fetch-key (and fetch-key (not (member fetch-key '(16 (16)))))) | 4957 | (for-key-identity (cadr key-info)) |
| 4958 | (fetch-pass (and fetch-pass (member fetch-pass '(16 (16))))) | ||
| 5005 | result-text) | 4959 | result-text) |
| 5006 | 4960 | ||
| 5007 | (setq result-text | 4961 | (setq result-text |
| 5008 | (allout-encrypt-string subject-text was-encrypted | 4962 | (allout-encrypt-string subject-text was-encrypted |
| 5009 | (current-buffer) key-type fetch-key)) | 4963 | (current-buffer) |
| 4964 | for-key-type for-key-identity fetch-pass)) | ||
| 5010 | 4965 | ||
| 5011 | ;; Replace the subtree with the processed product. | 4966 | ;; Replace the subtree with the processed product. |
| 5012 | (allout-unprotected | 4967 | (allout-unprotected |
| @@ -5040,251 +4995,285 @@ the key is changed." | |||
| 5040 | ) | 4995 | ) |
| 5041 | ) | 4996 | ) |
| 5042 | ) | 4997 | ) |
| 5043 | ;;;_ > allout-encrypt-string (text decrypt allout-buffer key-type rekey | 4998 | ;;;_ > allout-encrypt-string (text decrypt allout-buffer key-type for-key |
| 5044 | ;;; &optional retried verifying) | 4999 | ;;; fetch-pass &optional retried verifying |
| 5045 | (defun allout-encrypt-string (text decrypt allout-buffer key-type rekey | 5000 | ;;; passphrase) |
| 5046 | &optional retried verifying) | 5001 | (defun allout-encrypt-string (text decrypt allout-buffer key-type for-key |
| 5047 | "Encrypt or decrypt a string TEXT using KEY. | 5002 | fetch-pass &optional retried verifying |
| 5003 | passphrase) | ||
| 5004 | "Encrypt or decrypt message TEXT. | ||
| 5048 | 5005 | ||
| 5049 | If optional DECRYPT is true (default false), then decrypt instead of | 5006 | If DECRYPT is true (default false), then decrypt instead of encrypt. |
| 5050 | encrypt. | ||
| 5051 | 5007 | ||
| 5052 | Optional REKEY (default false) provokes clearing of the key cache to force | 5008 | FETCH-PASS (default false) forces fresh prompting for the passphrase. |
| 5053 | fresh prompting for the key. | ||
| 5054 | 5009 | ||
| 5055 | Optional RETRIED is for internal use - conveys the number of failed keys have | 5010 | KEY-TYPE indicates whether to use a 'symmetric or 'keypair cipher. |
| 5056 | been solicited in sequence leading to this current call. | ||
| 5057 | 5011 | ||
| 5058 | Optional VERIFYING is for internal use, signifying processing of text | 5012 | FOR-KEY is human readable identification of the first of the user's |
| 5059 | solely for verification of the cached key. | 5013 | eligible secret keys a keypair decryption targets, or else nil. |
| 5060 | 5014 | ||
| 5061 | Returns the resulting string, or nil if the transformation fails." | 5015 | Optional RETRIED is for internal use - conveys the number of failed keys |
| 5016 | that have been solicited in sequence leading to this current call. | ||
| 5017 | |||
| 5018 | Optional PASSPHRASE enables explicit delivery of the decryption passphrase, | ||
| 5019 | for verification purposes. | ||
| 5062 | 5020 | ||
| 5063 | ;; Ensure that we have an alternate handle on the real mc-activate-passwd: | 5021 | Returns the resulting string, or nil if the transformation fails." |
| 5064 | (if (not (fboundp 'real-mc-activate-passwd)) | ||
| 5065 | ;; Force loads of the primary mailcrypt packages, so flet below holds. | ||
| 5066 | (progn (require 'mailcrypt) | ||
| 5067 | (load "mc-toplev") | ||
| 5068 | (fset 'real-mc-activate-passwd | ||
| 5069 | (symbol-function 'mc-activate-passwd)))) | ||
| 5070 | 5022 | ||
| 5071 | (if (and rekey (not verifying)) (mc-deactivate-passwd)) | 5023 | (require 'pgg) |
| 5024 | |||
| 5025 | (let* ((scheme (upcase | ||
| 5026 | (format "%s" (or pgg-scheme pgg-default-scheme "GPG")))) | ||
| 5027 | (for-key (and (equal key-type 'keypair) | ||
| 5028 | (or for-key | ||
| 5029 | (split-string (read-string | ||
| 5030 | (format "%s message recipients: " | ||
| 5031 | scheme)) | ||
| 5032 | "[ \t,]+")))) | ||
| 5033 | (target-prompt-id (if (equal key-type 'keypair) | ||
| 5034 | (if (= (length for-key) 1) | ||
| 5035 | (car for-key) for-key) | ||
| 5036 | (buffer-name allout-buffer))) | ||
| 5037 | (target-cache-id (format "%s-%s" | ||
| 5038 | key-type | ||
| 5039 | (if (equal key-type 'keypair) | ||
| 5040 | target-prompt-id | ||
| 5041 | (or (buffer-file-name allout-buffer) | ||
| 5042 | target-prompt-id)))) | ||
| 5043 | (comment "Processed by allout driving pgg") | ||
| 5044 | work-buffer result result-text status) | ||
| 5045 | |||
| 5046 | (if (and fetch-pass (not passphrase)) | ||
| 5047 | ;; Force later fetch by evicting passphrase from the cache. | ||
| 5048 | (pgg-remove-passphrase-from-cache target-cache-id t)) | ||
| 5049 | |||
| 5050 | (catch 'encryption-failed | ||
| 5051 | |||
| 5052 | ;; Obtain the passphrase if we don't already have one and we're not | ||
| 5053 | ;; doing a keypair encryption: | ||
| 5054 | (if (not (or passphrase | ||
| 5055 | (and (equal key-type 'keypair) | ||
| 5056 | (not decrypt)))) | ||
| 5057 | |||
| 5058 | (setq passphrase (allout-obtain-passphrase for-key | ||
| 5059 | target-cache-id | ||
| 5060 | target-prompt-id | ||
| 5061 | key-type | ||
| 5062 | allout-buffer | ||
| 5063 | retried fetch-pass))) | ||
| 5064 | (with-temp-buffer | ||
| 5065 | |||
| 5066 | (insert (subst-char-in-string ?\r ?\n text)) | ||
| 5072 | 5067 | ||
| 5073 | (catch 'encryption-failed | 5068 | (cond |
| 5074 | (save-excursion | ||
| 5075 | 5069 | ||
| 5076 | (let* ((mc-default-scheme (or allout-encryption-scheme | 5070 | ;; symmetric: |
| 5077 | allout-default-encryption-scheme)) | 5071 | ((equal key-type 'symmetric) |
| 5078 | (id (format "%s-%s" key-type | 5072 | (setq status |
| 5079 | (or (buffer-file-name allout-buffer) | 5073 | (if decrypt |
| 5080 | (buffer-name allout-buffer)))) | 5074 | |
| 5081 | (cached (real-mc-activate-passwd id nil)) | 5075 | (pgg-decrypt (point-min) (point-max) passphrase) |
| 5082 | (comment "Processed by allout driving mailcrypt") | 5076 | |
| 5083 | key work-buffer result result-text encryption-process-status) | 5077 | (pgg-encrypt-symmetric (point-min) (point-max) |
| 5084 | 5078 | passphrase))) | |
| 5085 | (unwind-protect | 5079 | |
| 5086 | 5080 | (if status | |
| 5087 | ;; Interject our mc-activate-passwd wrapper: | 5081 | (pgg-situate-output (point-min) (point-max)) |
| 5088 | (flet ((mc-activate-passwd (id &optional prompt) | 5082 | ;; failed - handle passphrase caching |
| 5089 | (allout-mc-activate-passwd id prompt))) | 5083 | (if verifying |
| 5090 | 5084 | (throw 'encryption-failed nil) | |
| 5091 | (setq work-buffer | 5085 | (pgg-remove-passphrase-from-cache target-cache-id t) |
| 5092 | (set-buffer (allout-encryption-produce-work-buffer text))) | 5086 | (error "Symmetric-cipher encryption failed - %s" |
| 5093 | 5087 | "try again with different passphrase.")))) | |
| 5094 | (cond | 5088 | |
| 5095 | 5089 | ;; encrypt 'keypair: | |
| 5096 | ;; symmetric: | 5090 | ((not decrypt) |
| 5097 | ((equal key-type 'symmetric) | 5091 | |
| 5098 | (setq key (if verifying | 5092 | (setq status |
| 5099 | (real-mc-activate-passwd id nil) | 5093 | |
| 5100 | (allout-mc-activate-passwd id))) | 5094 | (pgg-encrypt for-key |
| 5101 | (setq encryption-process-status | 5095 | nil (point-min) (point-max) passphrase)) |
| 5102 | (crypt-encrypt-buffer key decrypt)) | 5096 | |
| 5103 | (if (zerop encryption-process-status) | 5097 | (if status |
| 5104 | t | 5098 | (pgg-situate-output (point-min) (point-max)) |
| 5105 | (if verifying | 5099 | (error (pgg-remove-passphrase-from-cache target-cache-id t) |
| 5106 | (throw 'encryption-failed nil) | 5100 | (error "encryption failed")))) |
| 5107 | (mc-deactivate-passwd) | 5101 | |
| 5108 | (error "Symmetric-key encryption failed (%s) - wrong key?" | 5102 | ;; decrypt 'keypair: |
| 5109 | encryption-process-status)))) | 5103 | (t |
| 5110 | 5104 | ||
| 5111 | ;; encrypt 'keypair: | 5105 | (setq status |
| 5112 | ((not decrypt) | 5106 | (pgg-decrypt (point-min) (point-max) passphrase)) |
| 5113 | (condition-case result | 5107 | |
| 5114 | (mailcrypt-encrypt 1) | 5108 | (if status |
| 5115 | (error (mc-deactivate-passwd) | 5109 | (pgg-situate-output (point-min) (point-max)) |
| 5116 | (error "encryption failed: %s" | 5110 | (error (pgg-remove-passphrase-from-cache target-cache-id t) |
| 5117 | (cadr result))))) | 5111 | (error "decryption failed")))) |
| 5118 | 5112 | ) | |
| 5119 | ;; decrypt 'keypair: | 5113 | |
| 5120 | (t (condition-case result | 5114 | (setq result-text |
| 5121 | (mc-decrypt) | 5115 | (buffer-substring 1 (- (point-max) (if decrypt 0 1)))) |
| 5122 | (error (mc-deactivate-passwd) | 5116 | |
| 5123 | (error "decryption failed: %s" | 5117 | ;; validate result - non-empty |
| 5124 | (cadr result)))))) | 5118 | (cond ((not result-text) |
| 5125 | 5119 | (if verifying | |
| 5126 | (setq result-text (if (or (equal key-type 'keypair) | 5120 | nil |
| 5127 | (not decrypt)) | 5121 | ;; transform was fruitless, retry w/new passphrase. |
| 5128 | (buffer-substring 1 (1- (point-max))) | 5122 | (pgg-remove-passphrase-from-cache target-cache-id t) |
| 5129 | (buffer-string))) | 5123 | (allout-encrypt-string text allout-buffer decrypt nil |
| 5130 | ;; validate result - non-empty | 5124 | (if retried (1+ retried) 1) |
| 5131 | (cond ((not result-text) | 5125 | passphrase))) |
| 5132 | (if verifying | 5126 | |
| 5133 | nil | 5127 | ;; Barf if encryption yields extraordinary control chars: |
| 5134 | ;; Transformation was fruitless - retry with new key. | 5128 | ((and (not decrypt) |
| 5135 | (mc-deactivate-passwd) | 5129 | (string-match "[\C-a\C-k\C-o-\C-z\C-@]" |
| 5136 | (allout-encrypt-string text allout-buffer decrypt nil | 5130 | result-text)) |
| 5137 | (if retried (1+ retried) 1) | 5131 | (error (concat "encryption produced unusable" |
| 5138 | verifying))) | 5132 | " non-armored text - reconfigure!"))) |
| 5139 | 5133 | ||
| 5140 | ;; Barf if encryption yields extraordinary control chars: | 5134 | ;; valid result and just verifying or non-symmetric: |
| 5141 | ((and (not decrypt) | 5135 | ((or verifying (not (equal key-type 'symmetric))) |
| 5142 | (string-match "[\C-a\C-k\C-o-\C-z\C-@]" result-text)) | 5136 | (if (or verifying decrypt) |
| 5143 | (error (concat "encryption produced unusable" | 5137 | (pgg-add-passphrase-to-cache target-cache-id |
| 5144 | " non-armored text - reconfigure!"))) | 5138 | passphrase t)) |
| 5145 | 5139 | result-text) | |
| 5146 | ;; valid result and just verifying or non-symmetric: | 5140 | |
| 5147 | ((or verifying (not (equal key-type 'symmetric))) | 5141 | ;; valid result and regular symmetric - "register" |
| 5148 | result-text) | 5142 | ;; passphrase with mnemonic aids/cache. |
| 5149 | 5143 | (t | |
| 5150 | ;; valid result and regular symmetric - situate validator: | 5144 | (set-buffer allout-buffer) |
| 5151 | (t | 5145 | (if passphrase |
| 5152 | ;; valid result and verifier needs to be situated in | 5146 | (pgg-add-passphrase-to-cache target-cache-id |
| 5153 | ;; allout-buffer: | 5147 | passphrase t)) |
| 5154 | (set-buffer allout-buffer) | 5148 | (allout-update-passphrase-mnemonic-aids for-key passphrase |
| 5155 | (if (and (or rekey (not cached)) | 5149 | allout-buffer) |
| 5156 | (not (allout-verify-key key allout-buffer))) | 5150 | result-text) |
| 5157 | (allout-situate-encryption-key-verifier key id)) | 5151 | ) |
| 5158 | result-text) | ||
| 5159 | ) | ||
| 5160 | ) | ||
| 5161 | |||
| 5162 | ;; unwind-protect emergence: | ||
| 5163 | (if work-buffer | ||
| 5164 | (kill-buffer work-buffer)) | ||
| 5165 | ) | 5152 | ) |
| 5166 | ) | 5153 | ) |
| 5167 | ) | ||
| 5168 | ) | 5154 | ) |
| 5169 | ) | 5155 | ) |
| 5170 | ;;;_ > allout-mc-activate-passwd (id &optional prompt) | 5156 | ;;;_ > allout-obtain-passphrase (for-key cache-id prompt-id key-type |
| 5171 | (defun allout-mc-activate-passwd (id &optional prompt) | 5157 | ;;; allout-buffer retried fetch-pass) |
| 5172 | "Substituted for mc-activate-passwd during allout outline encryption. | 5158 | (defun allout-obtain-passphrase (for-key cache-id prompt-id key-type |
| 5173 | 5159 | allout-buffer retried fetch-pass) | |
| 5174 | We add key-verification to vanilla mc-activate-passwd. | 5160 | "Obtain passphrase for a key from the cache or else from the user. |
| 5175 | 5161 | ||
| 5176 | We depend in some cases on values of the following allout-encrypt-string | 5162 | When obtaining from the user, symmetric-cipher passphrases are verified |
| 5177 | internal or prevailing variables: | 5163 | against either, if available and enabled, a random string that was |
| 5178 | - key-type - 'symmetric or 'keypair | 5164 | encrypted against the passphrase, or else against repeated entry by the |
| 5179 | - id - id associated with current key in key cache | 5165 | user for corroboration. |
| 5180 | - allout-buffer - where subject text resides | 5166 | |
| 5181 | - retried - number of current attempts to obtain this key | 5167 | FOR-KEY is the key for which the passphrase is being obtained. |
| 5182 | - rekey - user asked to present a new key - needs to be confirmed" | 5168 | |
| 5183 | 5169 | CACHE-ID is the cache id of the key for the passphrase. | |
| 5184 | ;; - if we're doing non-symmetric key, just do normal mc-activate-passwd | 5170 | |
| 5185 | ;; - otherwise, if we are have a cached version of the key, then assume | 5171 | PROMPT-ID is the id for use when prompting the user. |
| 5186 | ;; it's verified and return it | 5172 | |
| 5187 | ;; - otherwise, prompt for a key, and: | 5173 | KEY-TYPE is either 'symmetric or 'keypair. |
| 5188 | ;; - if we have a key verifier \(a string value which should decrypt | 5174 | |
| 5189 | ;; against a symmetric key), validate against the verifier | 5175 | ALLOUT-BUFFER is the buffer containing the entry being en/decrypted. |
| 5190 | ;; - if successful, return the verified key | 5176 | |
| 5191 | ;; - if unsuccessful: | 5177 | RETRIED is the number of this attempt to obtain this passphrase. |
| 5192 | ;; - offer to use the new key | 5178 | |
| 5193 | ;; - if accepted, do confirm process | 5179 | FETCH-PASS causes the passphrase to be solicited from the user, regardless |
| 5194 | ;; - if refused, try again until we get a correctly spelled one or the | 5180 | of the availability of a cached copy." |
| 5195 | ;; user quits | ||
| 5196 | ;; - if no key verifier, resolicit the key to get corroboration and return | ||
| 5197 | ;; the corroborated key if spelled identically, or error if not. | ||
| 5198 | 5181 | ||
| 5199 | (if (not (equal key-type 'symmetric)) | 5182 | (if (not (equal key-type 'symmetric)) |
| 5200 | ;; do regular mc-activate-passwd on non-symmetric key | 5183 | ;; do regular passphrase read on non-symmetric passphrase: |
| 5201 | (real-mc-activate-passwd id prompt) | 5184 | (pgg-read-passphrase (format "%s passphrase%s: " |
| 5185 | (upcase (format "%s" (or pgg-scheme | ||
| 5186 | pgg-default-scheme | ||
| 5187 | "GPG"))) | ||
| 5188 | (if prompt-id | ||
| 5189 | (format " for %s" prompt-id) | ||
| 5190 | "")) | ||
| 5191 | cache-id t) | ||
| 5202 | 5192 | ||
| 5203 | ;; Symmetric hereon: | 5193 | ;; Symmetric hereon: |
| 5204 | 5194 | ||
| 5205 | (save-excursion | 5195 | (save-excursion |
| 5206 | (set-buffer allout-buffer) | 5196 | (set-buffer allout-buffer) |
| 5207 | (let* ((hint (if (and (not (string= allout-key-hint-string "")) | 5197 | (let* ((hint (if (and (not (string= allout-passphrase-hint-string "")) |
| 5208 | (or (equal allout-key-hint-handling 'always) | 5198 | (or (equal allout-passphrase-hint-handling 'always) |
| 5209 | (and (equal allout-key-hint-handling 'needed) | 5199 | (and (equal allout-passphrase-hint-handling |
| 5200 | 'needed) | ||
| 5210 | retried))) | 5201 | retried))) |
| 5211 | (format " [%s]" allout-key-hint-string) | 5202 | (format " [%s]" allout-passphrase-hint-string) |
| 5212 | "")) | 5203 | "")) |
| 5213 | (retry-message (if retried (format " (%s retry)" retried) "")) | 5204 | (retry-message (if retried (format " (%s retry)" retried) "")) |
| 5214 | (prompt-sans-hint (format "'%s' symmetric key%s: " | 5205 | (prompt-sans-hint (format "'%s' symmetric passphrase%s: " |
| 5215 | (buffer-name allout-buffer) | 5206 | prompt-id retry-message)) |
| 5216 | retry-message)) | 5207 | (full-prompt (format "'%s' symmetric passphrase%s%s: " |
| 5217 | (full-prompt (format "'%s' symmetric key%s%s: " | 5208 | prompt-id hint retry-message)) |
| 5218 | (buffer-name allout-buffer) | ||
| 5219 | hint retry-message)) | ||
| 5220 | (prompt full-prompt) | 5209 | (prompt full-prompt) |
| 5221 | (verifier-string (allout-get-encryption-key-verifier)) | 5210 | (verifier-string (allout-get-encryption-passphrase-verifier)) |
| 5222 | ;; force retention of cached passwords for five minutes while | 5211 | |
| 5223 | ;; we're in this particular routine: | 5212 | (cached (and (not fetch-pass) |
| 5224 | (mc-passwd-timeout 300) | 5213 | (pgg-read-passphrase-from-cache cache-id t))) |
| 5225 | (cached (real-mc-activate-passwd id nil)) | 5214 | (got-pass (or cached |
| 5226 | (got (or cached (real-mc-activate-passwd id full-prompt))) | 5215 | (pgg-read-passphrase full-prompt cache-id t))) |
| 5216 | |||
| 5227 | confirmation) | 5217 | confirmation) |
| 5228 | 5218 | ||
| 5229 | (if (not got) | 5219 | (if (not got-pass) |
| 5230 | nil | 5220 | nil |
| 5231 | 5221 | ||
| 5232 | ;; Duplicate our handle on the key so it's not clobbered by | 5222 | ;; Duplicate our handle on the passphrase so it's not clobbered by |
| 5233 | ;; deactivate-passwd memory clearing: | 5223 | ;; deactivate-passwd memory clearing: |
| 5234 | (setq got (format "%s" got)) | 5224 | (setq got-pass (format "%s" got-pass)) |
| 5235 | 5225 | ||
| 5236 | (cond (verifier-string | 5226 | (cond (verifier-string |
| 5237 | (if (and (not (allout-encrypt-string | 5227 | (save-window-excursion |
| 5238 | verifier-string 'decrypt allout-buffer | 5228 | (if (allout-encrypt-string verifier-string 'decrypt |
| 5239 | 'symmetric nil 0 'verifying)) | 5229 | allout-buffer 'symmetric |
| 5230 | for-key nil 0 'verifying | ||
| 5231 | got-pass) | ||
| 5232 | (setq confirmation (format "%s" got-pass)))) | ||
| 5233 | |||
| 5234 | (if (and (not confirmation) | ||
| 5240 | (if (yes-or-no-p | 5235 | (if (yes-or-no-p |
| 5241 | (concat "Key differs from established" | 5236 | (concat "Passphrase differs from established" |
| 5242 | " - use new one instead? ")) | 5237 | " - use new one instead? ")) |
| 5243 | ;; deactivate password for subsequent | 5238 | ;; deactivate password for subsequent |
| 5244 | ;; confirmation: | 5239 | ;; confirmation: |
| 5245 | (progn (mc-deactivate-passwd) | 5240 | (progn |
| 5246 | (setq prompt prompt-sans-hint) | 5241 | (pgg-remove-passphrase-from-cache cache-id t) |
| 5247 | nil) | 5242 | (setq prompt prompt-sans-hint) |
| 5243 | nil) | ||
| 5248 | t)) | 5244 | t)) |
| 5249 | (progn (mc-deactivate-passwd) | 5245 | (progn (pgg-remove-passphrase-from-cache cache-id t) |
| 5250 | (error "Wrong key.")))) | 5246 | (error "Wrong passphrase.")))) |
| 5251 | ;; Force confirmation by repetition for new key: | 5247 | ;; No verifier string - force confirmation by repetition of |
| 5252 | ((or rekey (not cached)) (mc-deactivate-passwd)))) | 5248 | ;; (new) passphrase: |
| 5253 | ;; we have a key and it's either verified and cached. | 5249 | ((or fetch-pass (not cached)) |
| 5254 | ;; confirmation vs new input - doing mc-activate-passwd will do the | 5250 | (pgg-remove-passphrase-from-cache cache-id t)))) |
| 5251 | ;; confirmation vs new input - doing pgg-read-passphrase will do the | ||
| 5255 | ;; right thing, in either case: | 5252 | ;; right thing, in either case: |
| 5256 | (setq confirmation | 5253 | (if (not confirmation) |
| 5257 | (real-mc-activate-passwd id (concat prompt | 5254 | (setq confirmation |
| 5258 | " ... confirm spelling: "))) | 5255 | (pgg-read-passphrase (concat prompt |
| 5256 | " ... confirm spelling: ") | ||
| 5257 | cache-id t))) | ||
| 5259 | (prog1 | 5258 | (prog1 |
| 5260 | (if (equal got confirmation) | 5259 | (if (equal got-pass confirmation) |
| 5261 | confirmation | 5260 | confirmation |
| 5262 | (if (yes-or-no-p (concat "spelling of original and" | 5261 | (if (yes-or-no-p (concat "spelling of original and" |
| 5263 | " confirmation differ - retry? ")) | 5262 | " confirmation differ - retry? ")) |
| 5264 | (progn (setq retried (if retried (1+ retried) 1)) | 5263 | (progn (setq retried (if retried (1+ retried) 1)) |
| 5265 | (mc-deactivate-passwd) | 5264 | (pgg-remove-passphrase-from-cache cache-id t) |
| 5266 | ;; recurse to this routine: | 5265 | ;; recurse to this routine: |
| 5267 | (mc-activate-passwd id prompt-sans-hint)) | 5266 | (pgg-read-passphrase prompt-sans-hint cache-id t)) |
| 5268 | (mc-deactivate-passwd) | 5267 | (pgg-remove-passphrase-from-cache cache-id t) |
| 5269 | (error "Confirmation failed."))) | 5268 | (error "Confirmation failed."))) |
| 5270 | ;; reduce opportunity for memory cherry-picking by zeroing duplicate: | 5269 | ;; reduce opportunity for memory cherry-picking by zeroing duplicate: |
| 5271 | (dotimes (i (length got)) | 5270 | (dotimes (i (length got-pass)) |
| 5272 | (aset got i 0)) | 5271 | (aset got-pass i 0)) |
| 5273 | ) | 5272 | ) |
| 5274 | ) | 5273 | ) |
| 5275 | ) | 5274 | ) |
| 5276 | ) | 5275 | ) |
| 5277 | ) | 5276 | ) |
| 5278 | ;;;_ > allout-encryption-produce-work-buffer (text) | ||
| 5279 | (defun allout-encryption-produce-work-buffer (text) | ||
| 5280 | "Establish a new buffer filled with TEXT, for outline encrypion processing. | ||
| 5281 | |||
| 5282 | TEXT is massaged so outline collapsing, if any, is removed." | ||
| 5283 | (let ((work-buffer (generate-new-buffer " *allout encryption*"))) | ||
| 5284 | (save-excursion | ||
| 5285 | (set-buffer work-buffer) | ||
| 5286 | (insert (subst-char-in-string ?\r ?\n text))) | ||
| 5287 | work-buffer)) | ||
| 5288 | ;;;_ > allout-encrypted-topic-p () | 5277 | ;;;_ > allout-encrypted-topic-p () |
| 5289 | (defun allout-encrypted-topic-p () | 5278 | (defun allout-encrypted-topic-p () |
| 5290 | "True if the current topic is encryptable and encrypted." | 5279 | "True if the current topic is encryptable and encrypted." |
| @@ -5295,96 +5284,128 @@ TEXT is massaged so outline collapsing, if any, is removed." | |||
| 5295 | (looking-at "\\*")) | 5284 | (looking-at "\\*")) |
| 5296 | ) | 5285 | ) |
| 5297 | ) | 5286 | ) |
| 5298 | ;;;_ > allout-encrypted-text-type (text) | 5287 | ;;;_ > allout-encrypted-key-info (text) |
| 5299 | ;;; XXX gpg-specific, not generic! | 5288 | ;; XXX gpg-specific, alas |
| 5300 | (defun allout-encrypted-text-type (text) | 5289 | (defun allout-encrypted-key-info (text) |
| 5301 | "For gpg encrypted text, return 'symmetric or 'keypair." | 5290 | "Return a pair of the key type and identity of a recipient's secret key. |
| 5291 | |||
| 5292 | The key type is one of 'symmetric or 'keypair. | ||
| 5302 | 5293 | ||
| 5303 | ;; Ensure mc-gpg-path has a value: | 5294 | if 'keypair, and some of the user's secret keys are among those for which |
| 5304 | (if (not (boundp 'mc-gpg-path)) | 5295 | the message was encoded, return the identity of the first. otherwise, |
| 5305 | (load-library "mc-gpg")) | 5296 | return nil for the second item of the pair. |
| 5306 | 5297 | ||
| 5298 | An error is raised if the text is not encrypted." | ||
| 5299 | (require 'pgg-parse) | ||
| 5307 | (save-excursion | 5300 | (save-excursion |
| 5308 | (let* ((work-buffer (set-buffer | 5301 | (with-temp-buffer |
| 5309 | (allout-encryption-produce-work-buffer text))) | 5302 | (insert (subst-char-in-string ?\r ?\n text)) |
| 5310 | (result (mc-gpg-process-region (point-min) (point-max) | 5303 | (let* ((parsed-armor (pgg-parse-armor-region (point-min) (point-max))) |
| 5311 | nil mc-gpg-path | 5304 | (type (if (pgg-gpg-symmetric-key-p parsed-armor) |
| 5312 | '("--batch" "--decrypt") | 5305 | 'symmetric |
| 5313 | 'mc-gpg-decrypt-parser | 5306 | 'keypair)) |
| 5314 | work-buffer nil))) | 5307 | secret-keys first-secret-key for-key-owner) |
| 5315 | (cond ((equal (nth 0 result) 'symmetric) | 5308 | (if (equal type 'keypair) |
| 5316 | 'symmetric) | 5309 | (setq secret-keys (pgg-gpg-lookup-all-secret-keys) |
| 5317 | ((equal (nth 0 result) t) | 5310 | first-secret-key (pgg-gpg-select-matching-key parsed-armor |
| 5318 | 'keypair) | 5311 | secret-keys) |
| 5319 | (t (error "Unrecognized/unsupported encryption type %S" | 5312 | for-key-owner (and first-secret-key |
| 5320 | (nth 0 result)))) | 5313 | (pgg-gpg-lookup-key-owner |
| 5314 | first-secret-key)))) | ||
| 5315 | (list type (pgg-gpg-key-id-from-key-owner for-key-owner)) | ||
| 5316 | ) | ||
| 5321 | ) | 5317 | ) |
| 5322 | ) | 5318 | ) |
| 5323 | ) | 5319 | ) |
| 5324 | ;;;_ > allout-create-encryption-key-verifier (key id) | 5320 | ;;;_ > allout-create-encryption-passphrase-verifier (passphrase) |
| 5325 | (defun allout-create-encryption-key-verifier (key id) | 5321 | (defun allout-create-encryption-passphrase-verifier (passphrase) |
| 5326 | "Encrypt a random message for later validation of symmetric key." | 5322 | "Encrypt random message for later validation of symmetric key's passphrase." |
| 5327 | ;; use 20 random ascii characters, across the entire ascii range. | 5323 | ;; use 20 random ascii characters, across the entire ascii range. |
| 5328 | (random t) | 5324 | (random t) |
| 5329 | (let ((spew (make-string 20 ?\0))) | 5325 | (let ((spew (make-string 20 ?\0))) |
| 5330 | (dotimes (i (length spew)) | 5326 | (dotimes (i (length spew)) |
| 5331 | (aset spew i (1+ (random 254)))) | 5327 | (aset spew i (1+ (random 254)))) |
| 5332 | (allout-encrypt-string spew nil nil 'symmetric nil nil t)) | 5328 | (allout-encrypt-string spew nil (current-buffer) 'symmetric |
| 5329 | nil nil 0 passphrase)) | ||
| 5333 | ) | 5330 | ) |
| 5334 | ;;;_ > allout-situate-encryption-key-verifier (key id) | 5331 | ;;;_ > allout-update-passphrase-mnemonic-aids (for-key passphrase |
| 5335 | (defun allout-situate-encryption-key-verifier (key id) | 5332 | ;;; outline-buffer) |
| 5336 | "Establish key verifier string on file variable. | 5333 | (defun allout-update-passphrase-mnemonic-aids (for-key passphrase |
| 5337 | 5334 | outline-buffer) | |
| 5338 | We also prompt for and situate a new reminder, if reminders are enabled. | 5335 | "Update passphrase verifier and hint strings if necessary. |
| 5339 | 5336 | ||
| 5340 | We massage the string to simplify programmatic adjustment. File variable | 5337 | See `allout-passphrase-verifier-string' and `allout-passphrase-hint-string' |
| 5341 | is `allout-file-key-verifier-string'." | 5338 | settings. |
| 5342 | (let ((verifier-string | 5339 | |
| 5343 | ;; Collapse to a single line and enclose in string quotes: | 5340 | PASSPHRASE is the passphrase being mnemonicized |
| 5344 | (subst-char-in-string ?\n ?\C-a | 5341 | |
| 5345 | (allout-create-encryption-key-verifier | 5342 | OUTLINE-BUFFER is the buffer of the outline being adjusted. |
| 5346 | key id))) | 5343 | |
| 5347 | (reminder (if (not (equal allout-key-hint-handling 'disabled)) | 5344 | These are used to help the user keep track of the passphrase they use for |
| 5348 | (read-from-minibuffer | 5345 | symmetric encryption in the file. |
| 5349 | "Key hint to jog your memory next time: " | 5346 | |
| 5350 | allout-key-hint-string)))) | 5347 | Behavior is governed by `allout-passphrase-verifier-handling', |
| 5351 | (setq allout-key-verifier-string verifier-string) | 5348 | `allout-passphrase-hint-handling', and also, controlling whether the values |
| 5352 | (allout-adjust-file-variable "allout-key-verifier-string" | 5349 | are preserved on Emacs local file variables, |
| 5353 | verifier-string) | 5350 | `allout-enable-file-variable-adjustment'." |
| 5354 | (cond ((equal allout-key-hint-handling 'disabled) | 5351 | |
| 5355 | nil) | 5352 | ;; If passphrase doesn't agree with current verifier: |
| 5356 | ((not (string= reminder allout-key-hint-string)) | 5353 | ;; - adjust the verifier |
| 5357 | (setq allout-key-hint-string reminder) | 5354 | ;; - if passphrase hint handling is enabled, adjust the passphrase hint |
| 5358 | (allout-adjust-file-variable "allout-key-hint-string" | 5355 | ;; - if file var settings are enabled, adjust the file vars |
| 5359 | reminder))) | 5356 | |
| 5357 | (let* ((new-verifier-needed (not (allout-verify-passphrase | ||
| 5358 | for-key passphrase outline-buffer))) | ||
| 5359 | (new-verifier-string | ||
| 5360 | (if new-verifier-needed | ||
| 5361 | ;; Collapse to a single line and enclose in string quotes: | ||
| 5362 | (subst-char-in-string | ||
| 5363 | ?\n ?\C-a (allout-create-encryption-passphrase-verifier | ||
| 5364 | passphrase)))) | ||
| 5365 | new-hint) | ||
| 5366 | (when new-verifier-string | ||
| 5367 | ;; do the passphrase hint first, since it's interactive | ||
| 5368 | (when (and allout-passphrase-hint-handling | ||
| 5369 | (not (equal allout-passphrase-hint-handling 'disabled))) | ||
| 5370 | (setq new-hint | ||
| 5371 | (read-from-minibuffer "Passphrase hint to jog your memory: " | ||
| 5372 | allout-passphrase-hint-string)) | ||
| 5373 | (when (not (string= new-hint allout-passphrase-hint-string)) | ||
| 5374 | (setq allout-passphrase-hint-string new-hint) | ||
| 5375 | (allout-adjust-file-variable "allout-passphrase-hint-string" | ||
| 5376 | allout-passphrase-hint-string))) | ||
| 5377 | (when allout-passphrase-verifier-handling | ||
| 5378 | (setq allout-passphrase-verifier-string new-verifier-string) | ||
| 5379 | (allout-adjust-file-variable "allout-passphrase-verifier-string" | ||
| 5380 | allout-passphrase-verifier-string)) | ||
| 5381 | ) | ||
| 5360 | ) | 5382 | ) |
| 5361 | ) | 5383 | ) |
| 5362 | ;;;_ > allout-get-encryption-key-verifier () | 5384 | ;;;_ > allout-get-encryption-passphrase-verifier () |
| 5363 | (defun allout-get-encryption-key-verifier () | 5385 | (defun allout-get-encryption-passphrase-verifier () |
| 5364 | "Return the text of the encrypt key verifier, unmassaged, or nil if none. | 5386 | "Return text of the encrypt passphrase verifier, unmassaged, or nil if none. |
| 5365 | 5387 | ||
| 5366 | Derived from value of `allout-file-key-verifier-string'." | 5388 | Derived from value of `allout-file-passphrase-verifier-string'." |
| 5367 | 5389 | ||
| 5368 | (let ((verifier-string (and (boundp 'allout-key-verifier-string) | 5390 | (let ((verifier-string (and (boundp 'allout-passphrase-verifier-string) |
| 5369 | allout-key-verifier-string))) | 5391 | allout-passphrase-verifier-string))) |
| 5370 | (if verifier-string | 5392 | (if verifier-string |
| 5371 | ;; Return it uncollapsed | 5393 | ;; Return it uncollapsed |
| 5372 | (subst-char-in-string ?\C-a ?\n verifier-string) | 5394 | (subst-char-in-string ?\C-a ?\n verifier-string)) |
| 5373 | nil) | ||
| 5374 | ) | 5395 | ) |
| 5375 | ) | 5396 | ) |
| 5376 | ;;;_ > allout-verify-key (key) | 5397 | ;;;_ > allout-verify-passphrase (key passphrase allout-buffer) |
| 5377 | (defun allout-verify-key (key allout-buffer) | 5398 | (defun allout-verify-passphrase (key passphrase allout-buffer) |
| 5378 | "True if key successfully decrypts key verifier, nil otherwise. | 5399 | "True if passphrase successfully decrypts verifier, nil otherwise. |
| 5379 | 5400 | ||
| 5380 | \"Otherwise\" includes absence of key verifier." | 5401 | \"Otherwise\" includes absence of passphrase verifier." |
| 5381 | (save-excursion | 5402 | (save-excursion |
| 5382 | (set-buffer allout-buffer) | 5403 | (set-buffer allout-buffer) |
| 5383 | (and (boundp 'allout-key-verifier-string) | 5404 | (and (boundp 'allout-passphrase-verifier-string) |
| 5384 | allout-key-verifier-string | 5405 | allout-passphrase-verifier-string |
| 5385 | (allout-encrypt-string (allout-get-encryption-key-verifier) | 5406 | (allout-encrypt-string (allout-get-encryption-passphrase-verifier) |
| 5386 | 'decrypt allout-buffer 'symmetric | 5407 | 'decrypt allout-buffer 'symmetric |
| 5387 | nil nil 'verifying) | 5408 | key nil 0 'verifying passphrase) |
| 5388 | t))) | 5409 | t))) |
| 5389 | ;;;_ > allout-next-topic-pending-encryption (&optional except-mark) | 5410 | ;;;_ > allout-next-topic-pending-encryption (&optional except-mark) |
| 5390 | (defun allout-next-topic-pending-encryption (&optional except-mark) | 5411 | (defun allout-next-topic-pending-encryption (&optional except-mark) |
| @@ -5500,7 +5521,9 @@ save. See `allout-encrypt-unencrypted-on-saves' for more info." | |||
| 5500 | (exchange-point-and-mark)) | 5521 | (exchange-point-and-mark)) |
| 5501 | ;;;_ > outlineify-sticky () | 5522 | ;;;_ > outlineify-sticky () |
| 5502 | ;; outlinify-sticky is correct spelling; provide this alias for sticklers: | 5523 | ;; outlinify-sticky is correct spelling; provide this alias for sticklers: |
| 5524 | ;;;###autoload | ||
| 5503 | (defalias 'outlinify-sticky 'outlineify-sticky) | 5525 | (defalias 'outlinify-sticky 'outlineify-sticky) |
| 5526 | ;;;###autoload | ||
| 5504 | (defun outlineify-sticky (&optional arg) | 5527 | (defun outlineify-sticky (&optional arg) |
| 5505 | "Activate outline mode and establish file var so it is started subsequently. | 5528 | "Activate outline mode and establish file var so it is started subsequently. |
| 5506 | 5529 | ||
| @@ -5699,15 +5722,14 @@ Unless optional argument INPLACE is non-nil, return a new string." | |||
| 5699 | (if (eq (aref newstr i) fromchar) | 5722 | (if (eq (aref newstr i) fromchar) |
| 5700 | (aset newstr i tochar))) | 5723 | (aset newstr i tochar))) |
| 5701 | newstr))) | 5724 | newstr))) |
| 5702 | |||
| 5703 | ;;;_ : my-mark-marker to accommodate divergent emacsen: | 5725 | ;;;_ : my-mark-marker to accommodate divergent emacsen: |
| 5704 | (defun my-mark-marker (&optional force buffer) | 5726 | (defun my-mark-marker (&optional force buffer) |
| 5705 | "Accommodate the different signature for `mark-marker' across Emacsen. | 5727 | "Accommodate the different signature for `mark-marker' across Emacsen. |
| 5706 | 5728 | ||
| 5707 | XEmacs takes two optional args, while mainline GNU Emacs does not, | 5729 | XEmacs takes two optional args, while mainline GNU Emacs does not, |
| 5708 | so pass them along when appropriate." | 5730 | so pass them along when appropriate." |
| 5709 | (if (string-match " XEmacs " emacs-version) | 5731 | (if (featurep 'xemacs) |
| 5710 | (mark-marker force buffer) | 5732 | (apply 'mark-marker force buffer) |
| 5711 | (mark-marker))) | 5733 | (mark-marker))) |
| 5712 | 5734 | ||
| 5713 | ;;;_ #10 Under development | 5735 | ;;;_ #10 Under development |