/[emacs]/emacs/lisp/allout.el
ViewVC logotype

Diff of /emacs/lisp/allout.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.62 by eliz, Thu Oct 20 14:59:51 2005 UTC revision 1.63 by eliz, Sun Oct 23 08:23:25 2005 UTC
# Line 6  Line 6 
6  ;; Author: Ken Manheimer <ken dot manheimer at gmail dot com>  ;; Author: Ken Manheimer <ken dot manheimer at gmail dot com>
7  ;; Maintainer: Ken Manheimer <ken dot manheimer at gmail dot com>  ;; Maintainer: Ken Manheimer <ken dot manheimer at gmail dot com>
8  ;; Created: Dec 1991 - first release to usenet  ;; Created: Dec 1991 - first release to usenet
9    ;; Version: 2.1
10  ;; Keywords: outlines wp languages  ;; Keywords: outlines wp languages
11    
12  ;; This file is part of GNU Emacs.  ;; This file is part of GNU Emacs.
# Line 45  Line 46 
46  ;;    formatted as an outline - do ESC-x eval-current-buffer in allout.el  ;;    formatted as an outline - do ESC-x eval-current-buffer in allout.el
47  ;;    to try it out.)  ;;    to try it out.)
48  ;;  - configurable per-file initial exposure settings  ;;  - configurable per-file initial exposure settings
49  ;;  - symmetric-key and key-pair topic encryption, plus reliable key  ;;  - symmetric-key and key-pair topic encryption, plus symmetric passphrase
50  ;;    verification and user-supplied hint maintenance.  (see  ;;    mnemonic support, with verification against an established passphrase
51  ;;    allout-toggle-current-subtree-encryption docstring.)  ;;    (using a stashed encrypted dummy string) and user-supplied hint
52    ;;    maintenance.  (see allout-toggle-current-subtree-encryption docstring.)
53  ;;  - automatic topic-number maintenance  ;;  - automatic topic-number maintenance
54  ;;  - "hot-spot" operation, for single-keystroke maneuvering and  ;;  - "hot-spot" operation, for single-keystroke maneuvering and
55  ;;    exposure control (see the allout-mode docstring)  ;;    exposure control (see the allout-mode docstring)
# Line 79  Line 81 
81    
82  ;;;_* Dependency autoloads  ;;;_* Dependency autoloads
83  (eval-when-compile 'cl)                 ; otherwise, flet compilation fouls  (eval-when-compile 'cl)                 ; otherwise, flet compilation fouls
84  (autoload 'crypt-encrypt-buffer "crypt++")  (eval-when-compile (progn (require 'pgg)
85  (setq-default crypt-encryption-type 'gpg)                            (require 'pgg-gpg)))
86    (autoload 'pgg-gpg-symmetric-key-p "pgg-gpg"
87  (autoload 'mc-encrypt "mailcrypt"    "True if decoded armor MESSAGE-KEYS has symmetric encryption indicator.")
   "*Encrypt the current buffer")  
 (autoload 'mc-activate-passwd "mailcrypt"  
   "Activate the passphrase matching ID, using PROMPT for a prompt.  
 Return the passphrase.  If PROMPT is nil, only return value if cached.")  
 (autoload 'mc-gpg-process-region "mc-gpg")  
 (autoload 'mc-dectivate-passwd "mailcrypt"  
   "*Deactivate the passphrase cache.")  
88    
89  ;;;_* USER CUSTOMIZATION VARIABLES:  ;;;_* USER CUSTOMIZATION VARIABLES:
90  (defgroup allout nil  (defgroup allout nil
# Line 428  formatted copy." Line 423  formatted copy."
423    "*Bullet signifying encryption of the entry's body."    "*Bullet signifying encryption of the entry's body."
424    :type '(choice (const nil) string)    :type '(choice (const nil) string)
425    :group 'allout)    :group 'allout)
426  ;;;_  = allout-default-encryption-scheme  ;;;_  = allout-passphrase-verifier-handling
427  (defcustom allout-default-encryption-scheme 'mc-scheme-gpg  (defcustom allout-passphrase-verifier-handling t
428    "*Default allout outline topic encryption mode.    "*Enable use of symmetric encryption passphrase verifier if non-nil.
   
 See mailcrypt variable `mc-schemes' and mailcrypt docs for encryption schemes."  
   :type 'symbol  
   :group 'allout)  
 ;;;_  = allout-key-verifier-handling  
 (defcustom allout-key-verifier-handling 'situate  
   "*Dictate outline encryption key verifier handling.  
   
 The key verifier is string associated with a file that is encrypted with  
 the file's current symmetric encryption key.  It is used, if present, to  
 confirm that the key entered by the user is the same as the established  
 one, or explicitly presenting the user with the choice to go with a  
 new key when a difference is encountered.  
   
 The range of values are:  
   
  situate - include key verifier string as text in the file's local-vars  
            section  
  transient - establish the value as a variable in the file's buffer, but  
              don't preserve it as a file variable.  
  disabled - don't establish or do verification.  
429    
430  See the docstring for the `allout-enable-file-variable-adjustment'  See the docstring for the `allout-enable-file-variable-adjustment'
431  variable for details about allout ajustment of file variables."  variable for details about allout ajustment of file variables."
432    :type '(choice (const situate)    :type 'boolean
                  (const transient)  
                  (const disabled))  
433    :group 'allout)    :group 'allout)
434  (make-variable-buffer-local 'allout-key-verifier-handling)  (make-variable-buffer-local 'allout-passphrase-verifier-handling)
435  ;;;_  = allout-key-hint-handling  ;;;_  = allout-passphrase-hint-handling
436  (defcustom allout-key-hint-handling 'always  (defcustom allout-passphrase-hint-handling 'always
437    "*Dictate outline encryption key reminder handling:    "*Dictate outline encryption passphrase reminder handling:
438    
439   always - always show reminder when prompting   always - always show reminder when prompting
440   needed - show reminder on key entry failure   needed - show reminder on passphrase entry failure
441   manage - never present reminder, but still manage a file-var entry for it   disabled - never present or adjust reminder
  disabled - don't even manage the file variable entry  
442    
443  See the docstring for the `allout-enable-file-variable-adjustment'  See the docstring for the `allout-enable-file-variable-adjustment'
444  variable for details about allout ajustment of file variables."  variable for details about allout ajustment of file variables."
445    :type '(choice (const always)    :type '(choice (const always)
446                   (const needed)                   (const needed)
                  (const manage)  
447                   (const disabled))                   (const disabled))
448    :group 'allout)    :group 'allout)
449  (make-variable-buffer-local 'allout-key-hint-handling)  (make-variable-buffer-local 'allout-passphrase-hint-handling)
450  ;;;_  = allout-encrypt-unencrypted-on-saves  ;;;_  = allout-encrypt-unencrypted-on-saves
451  (defcustom allout-encrypt-unencrypted-on-saves 'except-current  (defcustom allout-encrypt-unencrypted-on-saves 'except-current
452    "*When saving, should topics pending encryption be encrypted?    "*When saving, should topics pending encryption be encrypted?
# Line 494  mostly covers both deliberate file write Line 464  mostly covers both deliberate file write
464   - All except current topic: skip the topic currently being edited, even if   - All except current topic: skip the topic currently being edited, even if
465         it's pending encryption.  This may expose the current topic on the         it's pending encryption.  This may expose the current topic on the
466         file sytem, but avoids the nuisance of prompts for the encryption         file sytem, but avoids the nuisance of prompts for the encryption
467         key in the middle of editing for, eg, autosaves.         passphrase in the middle of editing for, eg, autosaves.
468         This mode is used for auto-saves for both this option and \"Yes\".         This mode is used for auto-saves for both this option and \"Yes\".
469   - No: leave it to the user to encrypt any unencrypted topics.   - No: leave it to the user to encrypt any unencrypted topics.
470    
471  For practical reasons, auto-saves always use the 'except-current policy  For practical reasons, auto-saves always use the 'except-current policy
472  when auto-encryption is enabled.  \(Otherwise, spurious key prompts and  when auto-encryption is enabled.  \(Otherwise, spurious passphrase prompts
473  unavoidable timing collisions are too disruptive.)  If security for a file  and unavoidable timing collisions are too disruptive.)  If security for a
474  requires that even the current topic is never auto-saved in the clear,  file requires that even the current topic is never auto-saved in the clear,
475  disable auto-saves for that file."  disable auto-saves for that file."
476    
477    :type '(choice (const :tag "Yes" t)    :type '(choice (const :tag "Yes" t)
# Line 606  those that do not have the variable `com Line 576  those that do not have the variable `com
576    
577  ;;;_  = allout-enable-file-variable-adjustment  ;;;_  = allout-enable-file-variable-adjustment
578  (defcustom allout-enable-file-variable-adjustment t  (defcustom allout-enable-file-variable-adjustment t
579    "*If non-nil, some allout outline actions can edit Emacs file variables text.    "*If non-nil, some allout outline actions edit Emacs local file var text.
580    
581  This can range from changes to existing entries, addition of new ones,  This can range from changes to existing entries, addition of new ones,
582  and creation of a new local variables section when necessary.  and creation of a new local variables section when necessary.
# Line 626  details." Line 596  details."
596  ;;;_ #1 Internal Outline Formatting and Configuration  ;;;_ #1 Internal Outline Formatting and Configuration
597  ;;;_  : Version  ;;;_  : Version
598  ;;;_   = allout-version  ;;;_   = allout-version
599  (defvar allout-version  (defvar allout-version "2.1"
600    (let ((rcs-rev "$Revision$"))    "Version of currently loaded outline package.  \(allout.el)")
     (condition-case err  
         (save-match-data  
           (string-match "Revision: \\([0-9]+\\.[0-9]+\\)" rcs-rev)  
           (substring rcs-rev (match-beginning 1) (match-end 1)))  
       ('error rcs-rev)))  
   "Revision number of currently loaded outline package.  \(allout.el)")  
601  ;;;_   > allout-version  ;;;_   > allout-version
602  (defun allout-version (&optional here)  (defun allout-version (&optional here)
603    "Return string describing the loaded outline version."    "Return string describing the loaded outline version."
# Line 1027  the way that `before-change-functions' a Line 991  the way that `before-change-functions' a
991    "Horrible hack used to prevent invalid multiple triggering of outline    "Horrible hack used to prevent invalid multiple triggering of outline
992  mode from prop-line file-var activation.  Used by `allout-mode' function  mode from prop-line file-var activation.  Used by `allout-mode' function
993  to track repeats.")  to track repeats.")
994  ;;;_   = allout-file-key-verifier-string  ;;;_   = allout-file-passphrase-verifier-string
995  (defvar allout-file-key-verifier-string nil  (defvar allout-file-passphrase-verifier-string nil
996    "Name for use as a file variable for verifying encryption key across    "Name for use as a file variable for verifying encryption passphrase
997  sessions.")  across sessions.")
998  (make-variable-buffer-local 'allout-file-key-verifier-string)  (make-variable-buffer-local 'allout-file-passphrase-verifier-string)
999  ;;;_   = allout-encryption-scheme  ;;;_   = allout-passphrase-verifier-string
1000  (defvar allout-encryption-scheme nil  (defvar allout-passphrase-verifier-string nil
1001    "*Allout outline topic encryption scheme pending for the current buffer.    "Setting used to test solicited encryption passphrases against the one
1002    already associated with a file.
1003  Intended as a file-specific (buffer local) setting, it defaults to the  
1004  value of allout-default-encryption-scheme if nil.")  It consists of an encrypted random string useful only to verify that a
1005  (make-variable-buffer-local 'allout-encryption-scheme)  passphrase entered by the user is effective for decryption.  The passphrase
1006  ;;;_   = allout-key-verifier-string  itself is \*not* recorded in the file anywhere, and the encrypted contents
1007  (defvar allout-key-verifier-string nil  are random binary characters to avoid exposing greater susceptibility to
1008    "Setting used to test solicited encryption keys against that already  search attacks.
 associated with a file.  
   
 It consists of an encrypted random string useful only to verify that a key  
 entered by the user is effective for decryption.  The key itself is \*not*  
 recorded in the file anywhere, and the encrypted contents are random binary  
 characters to avoid exposing greater susceptibility to search attacks.  
1009    
1010  The verifier string is retained as an Emacs file variable, as well as in  The verifier string is retained as an Emacs file variable, as well as in
1011  the emacs buffer state, if file variable adjustments are enabled.  See  the emacs buffer state, if file variable adjustments are enabled.  See
1012  `allout-enable-file-variable-adjustment' for details about that.")  `allout-enable-file-variable-adjustment' for details about that.")
1013  (make-variable-buffer-local 'allout-key-verifier-string)  (make-variable-buffer-local 'allout-passphrase-verifier-string)
1014  (setq-default allout-key-verifier-string nil)  ;;;_   = allout-passphrase-hint-string
1015  ;;;_   = allout-key-hint-string  (defvar allout-passphrase-hint-string ""
1016  (defvar allout-key-hint-string ""    "Variable used to retain reminder string for file's encryption passphrase.
   "Variable used to retain a reminder string for a file's encryption key.  
1017    
1018  See the description of `allout-key-hint-handling' for details about how  See the description of `allout-passphrase-hint-handling' for details about how
1019  the reminder is deployed.  the reminder is deployed.
1020    
1021  The hint is retained as an Emacs file variable, as well as in the emacs buffer  The hint is retained as an Emacs file variable, as well as in the emacs buffer
1022  state, if file variable adjustments are enabled.  See  state, if file variable adjustments are enabled.  See
1023  `allout-enable-file-variable-adjustment' for details about that.")  `allout-enable-file-variable-adjustment' for details about that.")
1024  (make-variable-buffer-local 'allout-key-hint-string)  (make-variable-buffer-local 'allout-passphrase-hint-string)
1025  (setq-default allout-key-hint-string "")  (setq-default allout-passphrase-hint-string "")
1026  ;;;_   = allout-after-save-decrypt  ;;;_   = allout-after-save-decrypt
1027  (defvar allout-after-save-decrypt nil  (defvar allout-after-save-decrypt nil
1028    "Internal variable, is nil or has the value of two points:    "Internal variable, is nil or has the value of two points:
# Line 1080  was encrypted automatically as part of a Line 1037  was encrypted automatically as part of a
1037  (defun allout-write-file-hook-handler ()  (defun allout-write-file-hook-handler ()
1038    "Implement `allout-encrypt-unencrypted-on-saves' policy for file writes."    "Implement `allout-encrypt-unencrypted-on-saves' policy for file writes."
1039    
1040    (if (or (not (boundp 'allout-encrypt-unencrypted-on-saves))    (if (or (not (allout-mode-p))
1041              (not (boundp 'allout-encrypt-unencrypted-on-saves))
1042            (not allout-encrypt-unencrypted-on-saves))            (not allout-encrypt-unencrypted-on-saves))
1043        nil        nil
1044      (let ((except-mark (and (equal allout-encrypt-unencrypted-on-saves      (let ((except-mark (and (equal allout-encrypt-unencrypted-on-saves
# Line 1105  was encrypted automatically as part of a Line 1063  was encrypted automatically as part of a
1063  (defun allout-auto-save-hook-handler ()  (defun allout-auto-save-hook-handler ()
1064    "Implement `allout-encrypt-unencrypted-on-saves' policy for auto saves."    "Implement `allout-encrypt-unencrypted-on-saves' policy for auto saves."
1065    
1066    (if  allout-encrypt-unencrypted-on-saves    (if (and (allout-mode-p) allout-encrypt-unencrypted-on-saves)
1067        ;; Always implement 'except-current policy when enabled.        ;; Always implement 'except-current policy when enabled.
1068        (let ((allout-encrypt-unencrypted-on-saves 'except-current))        (let ((allout-encrypt-unencrypted-on-saves 'except-current))
1069          (allout-write-file-hook-handler))))          (allout-write-file-hook-handler))))
# Line 1190  the following two lines in your Emacs in Line 1148  the following two lines in your Emacs in
1148    (let    (let
1149        ;; convenience aliases, for consistent ref to respective vars:        ;; convenience aliases, for consistent ref to respective vars:
1150        ((hook 'allout-find-file-hook)        ((hook 'allout-find-file-hook)
1151           (find-file-hook-var-name (if (boundp 'find-file-hook)
1152                                        'find-file-hook
1153                                      'find-file-hooks))
1154         (curr-mode 'allout-auto-activation))         (curr-mode 'allout-auto-activation))
1155    
1156      (cond ((not mode)      (cond ((not mode)
1157             (setq find-file-hooks (delq hook find-file-hooks))             (set find-file-hook-var-name
1158                    (delq hook (symbol-value find-file-hook-var-name)))
1159             (if (interactive-p)             (if (interactive-p)
1160                 (message "Allout outline mode auto-activation inhibited.")))                 (message "Allout outline mode auto-activation inhibited.")))
1161            ((eq mode 'report)            ((eq mode 'report)
1162             (if (not (memq hook find-file-hooks))             (if (not (memq hook (symbol-value find-file-hook-var-name)))
1163                 (allout-init nil)                 (allout-init nil)
1164               ;; Just punt and use the reports from each of the modes:               ;; Just punt and use the reports from each of the modes:
1165               (allout-init (symbol-value curr-mode))))               (allout-init (symbol-value curr-mode))))
1166            (t (add-hook 'find-file-hooks hook)            (t (add-hook find-file-hook-var-name hook)
1167               (set curr-mode             ; `set', not `setq'!               (set curr-mode             ; `set', not `setq'!
1168                    (cond ((eq mode 'activate)                    (cond ((eq mode 'activate)
1169                           (message                           (message
# Line 1233  the following two lines in your Emacs in Line 1195  the following two lines in your Emacs in
1195        (easy-menu-add cur))))        (easy-menu-add cur))))
1196  ;;;_  > allout-mode (&optional toggle)  ;;;_  > allout-mode (&optional toggle)
1197  ;;;_   : Defun:  ;;;_   : Defun:
1198    ;;;###autoload
1199  (defun allout-mode (&optional toggle)  (defun allout-mode (&optional toggle)
1200  ;;;_    . Doc string:  ;;;_    . Doc string:
1201    "Toggle minor mode for controlling exposure and editing of text outlines.    "Toggle minor mode for controlling exposure and editing of text outlines.
# Line 1271  The bindings are dictated by the `allout Line 1234  The bindings are dictated by the `allout
1234    
1235          Navigation:                                Exposure Control:          Navigation:                                Exposure Control:
1236          ----------                                 ----------------          ----------                                 ----------------
1237  C-c C-n allout-next-visible-heading     | C-c C-h allout-hide-current-subtree  \\[allout-next-visible-heading] allout-next-visible-heading     | \\[allout-hide-current-subtree] allout-hide-current-subtree
1238  C-c C-p allout-previous-visible-heading | C-c C-i allout-show-children  \\[allout-previous-visible-heading] allout-previous-visible-heading | \\[allout-show-children] allout-show-children
1239  C-c C-u allout-up-current-level         | C-c C-s allout-show-current-subtree  \\[allout-up-current-level] allout-up-current-level         | \\[allout-show-current-subtree] allout-show-current-subtree
1240  C-c C-f allout-forward-current-level    | C-c C-o allout-show-current-entry  \\[allout-forward-current-level] allout-forward-current-level    | \\[allout-show-current-entry] allout-show-current-entry
1241  C-c C-b allout-backward-current-level   | ^U C-c C-s allout-show-all  \\[allout-backward-current-level] allout-backward-current-level   | \\[allout-show-all] allout-show-all
1242  C-c C-e allout-end-of-entry             |          allout-hide-current-leaves  \\[allout-end-of-entry] allout-end-of-entry
1243  C-c C-a allout-beginning-of-current-entry, alternately, goes to hot-spot  \\[allout-beginning-of-current-entry,] allout-beginning-of-current-entry, alternately, goes to hot-spot
1244    
1245          Topic Header Production:          Topic Header Production:
1246          -----------------------          -----------------------
1247  C-c<SP> allout-open-sibtopic    Create a new sibling after current topic.  \\[allout-open-sibtopic]  allout-open-sibtopic  Create a new sibling after current topic.
1248  C-c .   allout-open-subtopic    ... an offspring of current topic.  \\[allout-open-subtopic]  allout-open-subtopic  ... an offspring of current topic.
1249  C-c ,   allout-open-supertopic  ... a sibling of the current topic's parent.  \\[allout-open-supertopic]  allout-open-supertopic      ... a sibling of the current topic's parent.
1250    
1251          Topic Level and Prefix Adjustment:          Topic Level and Prefix Adjustment:
1252          ---------------------------------          ---------------------------------
1253  C-c >   allout-shift-in Shift current topic and all offspring deeper.  \\[allout-shift-in]  allout-shift-in    Shift current topic and all offspring deeper.
1254  C-c <   allout-shift-out        ... less deep.  \\[allout-shift-out]  allout-shift-out  ... less deep.
1255  C-c<CR> allout-rebullet-topic   Reconcile bullets of topic and its offspring  \\[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
1258                                  - distinctive bullets are not changed, others                                  - distinctive bullets are not changed, others
1259                                    alternated according to nesting depth.                                    alternated according to nesting depth.
1260  C-c b   allout-rebullet-current-heading Prompt for alternate bullet for  \\[allout-number-siblings]  allout-number-siblings      Number bullets of topic and siblings - the
                                          current topic.  
 C-c #   allout-number-siblings  Number bullets of topic and siblings - the  
1261                                  offspring are not affected.  With repeat                                  offspring are not affected.  With repeat
1262                                  count, revoke numbering.                                  count, revoke numbering.
1263    
1264          Topic-oriented Killing and Yanking:          Topic-oriented Killing and Yanking:
1265          ----------------------------------          ----------------------------------
1266  C-c C-k allout-kill-topic       Kill current topic, including offspring.  \\[allout-kill-topic]     allout-kill-topic     Kill current topic, including offspring.
1267  C-k     allout-kill-line        Like kill-line, but reconciles numbering, etc.  \\[allout-kill-line]     allout-kill-line       Like kill-line, but reconciles numbering, etc.
1268  C-y     allout-yank             Yank, adjusting depth of yanked topic to  \\[allout-yank]     allout-yank         Yank, adjusting depth of yanked topic to
1269                                  depth of heading if yanking into bare topic                                  depth of heading if yanking into bare topic
1270                                  heading (ie, prefix sans text).                                  heading (ie, prefix sans text).
1271  M-y     allout-yank-pop Is to allout-yank as yank-pop is to yank  \\[allout-yank-pop]     allout-yank-pop Is to allout-yank as yank-pop is to yank
1272    
1273          Misc commands:          Misc commands:
1274          -------------          -------------
1275  M-x outlineify-sticky           Activate outline mode for current buffer,  M-x outlineify-sticky           Activate outline mode for current buffer,
1276                                  and establish a default file-var setting                                  and establish a default file-var setting
1277                                  for `allout-layout'.                                  for `allout-layout'.
1278  C-c C-SPC allout-mark-topic  \\[allout-mark-topic]     allout-mark-topic
1279  C-c = c allout-copy-exposed-to-buffer  \\[allout-copy-exposed-to-buffer]     allout-copy-exposed-to-buffer
1280                                  Duplicate outline, sans concealed text, to                                  Duplicate outline, sans concealed text, to
1281                                  buffer with name derived from derived from that                                  buffer with name derived from derived from that
1282                                  of current buffer - \"*BUFFERNAME exposed*\".                                  of current buffer - \"*BUFFERNAME exposed*\".
1283  C-c = p allout-flatten-exposed-to-buffer  \\[allout-flatten-exposed-to-buffer]     allout-flatten-exposed-to-buffer
1284                                  Like above 'copy-exposed', but convert topic                                  Like above 'copy-exposed', but convert topic
1285                                  prefixes to section.subsection... numeric                                  prefixes to section.subsection... numeric
1286                                  format.                                  format.
# Line 1327  ESC ESC (allout-init t)        Setup Emacs sess Line 1290  ESC ESC (allout-init t)        Setup Emacs sess
1290                    Encrypted Entries                    Encrypted Entries
1291    
1292  Outline mode supports easily togglable gpg encryption of topics, with  Outline mode supports easily togglable gpg encryption of topics, with
1293  niceities like support for symmetric and key-pair modes, key timeout, key  niceties like support for symmetric and key-pair modes, passphrase timeout,
1294  consistency checking, user-provided hinting for symmetric key mode, and  passphrase consistency checking, user-provided hinting for symmetric key
1295  auto-encryption of topics pending encryption on save.  The aim is to enable  mode, and auto-encryption of topics pending encryption on save.  The aim is
1296  reliable topic privacy while preventing accidents like neglected  to enable reliable topic privacy while preventing accidents like neglected
1297  encryption, encryption with a mistaken key, forgetting which key was used,  encryption, encryption with a mistaken passphrase, forgetting which
1298  and other practical pitfalls.  passphrase was used, and other practical pitfalls.
1299    
1300  See the `allout-toggle-current-subtree-encryption' function and  See the `allout-toggle-current-subtree-encryption' function and
1301  `allout-encrypt-unencrypted-on-saves' customization variable for details.  `allout-encrypt-unencrypted-on-saves' customization variable for details.
# Line 1450  OPEN:  A topic that is not closed, though Line 1413  OPEN:  A topic that is not closed, though
1413           ;; allout-mode already called once during this complex command?           ;; allout-mode already called once during this complex command?
1414           (same-complex-command (eq allout-v18/19-file-var-hack           (same-complex-command (eq allout-v18/19-file-var-hack
1415                                    (car command-history)))                                    (car command-history)))
1416             (write-file-hook-var-name (if (boundp 'write-file-functions)
1417                                           'write-file-functions
1418                                         'local-write-file-hooks))
1419           do-layout           do-layout
1420           )           )
1421    
# Line 1500  OPEN:  A topic that is not closed, though Line 1466  OPEN:  A topic that is not closed, though
1466        (allout-resumptions 'selective-display)        (allout-resumptions 'selective-display)
1467        (if (and (boundp 'before-change-functions) before-change-functions)        (if (and (boundp 'before-change-functions) before-change-functions)
1468            (allout-resumptions 'before-change-functions))            (allout-resumptions 'before-change-functions))
1469        (setq local-write-file-hooks        (set write-file-hook-var-name
1470             (delq 'allout-write-file-hook-handler             (delq 'allout-write-file-hook-handler
1471                   local-write-file-hooks))                   (symbol-value write-file-hook-var-name)))
1472        (setq auto-save-hook        (setq auto-save-hook
1473             (delq 'allout-auto-save-hook-handler             (delq 'allout-auto-save-hook-handler
1474                   auto-save-hook))                   auto-save-hook))
# Line 1563  OPEN:  A topic that is not closed, though Line 1529  OPEN:  A topic that is not closed, though
1529        (allout-resumptions 'selective-display '(t))        (allout-resumptions 'selective-display '(t))
1530        (add-hook 'pre-command-hook 'allout-pre-command-business)        (add-hook 'pre-command-hook 'allout-pre-command-business)
1531        (add-hook 'post-command-hook 'allout-post-command-business)        (add-hook 'post-command-hook 'allout-post-command-business)
1532        (add-hook 'local-write-file-hooks 'allout-write-file-hook-handler)        (add-hook write-file-hook-var-name 'allout-write-file-hook-handler)
       (make-variable-buffer-local 'auto-save-hook)  
1533        (add-hook 'auto-save-hook 'allout-auto-save-hook-handler)        (add-hook 'auto-save-hook 'allout-auto-save-hook-handler)
1534                                         ; Custom auto-fill func, to support                                         ; Custom auto-fill func, to support
1535                                         ; respect for topic headline,                                         ; respect for topic headline,
# Line 2501  return to regular interpretation of self Line 2466  return to regular interpretation of self
2466                                 last-command-char)                                 last-command-char)
2467                                ;; Only xemacs has characterp.                                ;; Only xemacs has characterp.
2468                                ((and (fboundp 'characterp)                                ((and (fboundp 'characterp)
2469                                      (characterp last-command-char))                                      (apply 'characterp
2470                                 (char-to-int last-command-char))                                             (list last-command-char)))
2471                                   (apply 'char-to-int (list last-command-char)))
2472                                (t 0)))                                (t 0)))
2473                 mapped-binding)                 mapped-binding)
2474            (if (zerop this-key-num)            (if (zerop this-key-num)
# Line 3506  depth, however." Line 3472  depth, however."
3472         ;; ensure prior kill-ring leader is properly restored:         ;; ensure prior kill-ring leader is properly restored:
3473         (if (eq leading-kill-ring-entry (cadr kill-ring))         (if (eq leading-kill-ring-entry (cadr kill-ring))
3474             ;; Aborted kill got pushed on front - ditch it:             ;; Aborted kill got pushed on front - ditch it:
3475             (pop kill-ring)             (let ((got (car kill-ring)))
3476                 (setq kill-ring (cdr kill-ring))
3477                 got)
3478           ;; Aborted kill got appended to prior - resurrect prior:           ;; Aborted kill got appended to prior - resurrect prior:
3479           (setcar kill-ring leading-kill-ring-entry))           (setcar kill-ring leading-kill-ring-entry))
3480         ;; make last-command skip this failed command, so kill-appending         ;; make last-command skip this failed command, so kill-appending
# Line 4608  If `bullet-plus' is specified, it is ins Line 4576  If `bullet-plus' is specified, it is ins
4576      (while text      (while text
4577        (insert (car text))        (insert (car text))
4578        (if (setq text (cdr text))        (if (setq text (cdr text))
4579            (insert-string "\n")))            (insert "\n")))
4580      (insert "\n")))      (insert "\n")))
4581  ;;;_   > allout-copy-exposed-to-buffer (&optional arg tobuf format)  ;;;_   > allout-copy-exposed-to-buffer (&optional arg tobuf format)
4582  (defun allout-copy-exposed-to-buffer (&optional arg tobuf format)  (defun allout-copy-exposed-to-buffer (&optional arg tobuf format)
# Line 4881  With repeat count, copy the exposed port Line 4849  With repeat count, copy the exposed port
4849      (goto-char start-pt)))      (goto-char start-pt)))
4850    
4851  ;;;_ #8 Encryption  ;;;_ #8 Encryption
4852  ;;;_  > allout-toggle-current-subtree-encryption (&optional fetch-key)  ;;;_  > allout-toggle-current-subtree-encryption (&optional fetch-pass)
4853  (defun allout-toggle-current-subtree-encryption (&optional fetch-key)  (defun allout-toggle-current-subtree-encryption (&optional fetch-pass)
4854    "Encrypt clear text or decrypt encoded contents of a topic.    "Encrypt clear text or decrypt encoded topic contents \(body and subtopics.)
4855    
4856  Contents includes body and subtopics.  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.
4861    
4862  Currently only GnuPG encryption is supported.  Currently only GnuPG encryption is supported.
4863    
# Line 4897  the default, use a single \(x4) universa Line 4869  the default, use a single \(x4) universa
4869    
4870  Encrypted topic's bullet is set to a `~' to signal that the contents of the  Encrypted topic's bullet is set to a `~' to signal that the contents of the
4871  topic \(body and subtopics, but not heading) is pending encryption or  topic \(body and subtopics, but not heading) is pending encryption or
4872  encrypted.  An `*' asterisk immediately after the bullet signals that the  encrypted.  `*' asterisk immediately after the bullet signals that the body
4873  body is encrypted, its absence means it's meant to be encrypted but is not  is encrypted, its' absence means the topic is meant to be encrypted but is
4874  - it's \"disclosed\".  When a file with disclosed topics is saved, the user  not.  When a file with topics pending encryption is saved, topics pending
4875  prompted for an ok to \(symmetric-key) encrypt the disclosed topics.  NOTE  encryption are encrypted.  See allout-encrypt-unencrypted-on-saves for
4876  WELL that you must explicitly \(re)encrypt key-pair encrypted topics if you  auto-encryption specifics.
4877  want them to continue to be in key-pair mode.  
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.
4881    
4882  Level-1 topics, with prefix consisting solely of an `*' asterisk, cannot be  Level-1 topics, with prefix consisting solely of an `*' asterisk, cannot be
4883  encrypted.  If you want to encrypt the contents of a top-level topic, use  encrypted.  If you want to encrypt the contents of a top-level topic, use
4884  \\[allout-shift-in] to increase its depth.  \\[allout-shift-in] to increase its depth.
4885    
4886  Failed transformation does not change the an entry being encrypted -    Passphrase Caching
 instead, the key is re-solicited and the transformation is retried.  
 \\[keyboard-quit] to abort.  
   
 Decryption does symmetric or key-pair key mode depending on how the text  
 was encrypted.  The encryption key is solicited if not currently available  
 from the key cache from a recent prior encryption action.  
   
 Optional FETCH-KEY universal argument is used for two purposes - to provoke  
 key-pair instead of symmetric encryption, or to provoke clearing of the key  
 cache so keys are freshly fetched.  
   
  - Without any universal arguments, then the appropriate key for the is  
    obtained from the cache, if available, else from the user.  
   
  - If FETCH-KEY is the result of one universal argument - ie, equal to 4 -  
    then key-pair encryption is used.  
   
  - With repeated universal argument - equal to 16 - then the key cache is  
    cleared before any encryption transformations, to force prompting of the  
    user for the key.  
   
 The solicited key is retained for reuse in a buffer-specific cache for some  
 set period of time \(default, 60 seconds), after which the string is  
 nulled.  `mailcrypt' provides the key caching functionality.  You can  
 adjust the key cache timeout by ajdusting the setting of the elisp variable  
 `mc-passwd-timeout'.  
   
 If the file previously had no associated key, or had a different key than  
 specified, the user is prompted to repeat the new one for corroboration.  A  
 random string encrypted by the new key is set on the buffer-specific  
 variable `allout-key-verifier-string', for confirmation of the key when  
 next obtained, before encrypting or decrypting anything with it.  This  
 helps avoid mistakenly shifting between keys.  
   
 If allout customization var `allout-key-verifier-handling' is non-nil, an  
 entry for `allout-key-verifier-string' and its value is added to an Emacs  
 'local variables' section at the end of the file, which is created if  
 necessary.  That setting is for retention of the key verifier across emacs  
 sessions.  
   
 Similarly, `allout-key-hint-string' stores a user-provided reminder about  
 their key, and `allout-key-hint-handling' specifies when the hint is  
 presented, or if key hints are disabled.  If enabled \(see the  
 `allout-key-hint-handling' docstring for details), the hint string is  
 stored in the local-variables section of the file, and solicited whenever  
 the key is changed."  
4887    
4888  ;;; This routine handles allout-specific business, dispatching  The encryption passphrase is solicited if not currently available in the
4889  ;;; encryption-specific business to allout-encrypt-string.  passphrase cache from a recent encryption action.
4890    
4891    The solicited passphrase is retained for reuse in a buffer-specific cache
4892    for some set period of time \(default, 60 seconds), after which the string
4893    is nulled.  The passphrase cache timeout is customized by setting
4894    `pgg-passphrase-cache-expiry'.
4895    
4896      Symmetric Passphrase Hinting and Verification
4897    
4898    If the file previously had no associated passphrase, or had a different
4899    passphrase than specified, the user is prompted to repeat the new one for
4900    corroboration.  A random string encrypted by the new passphrase is set on
4901    the buffer-specific variable `allout-passphrase-verifier-string', for
4902    confirmation of the passphrase when next obtained, before encrypting or
4903    decrypting anything with it.  This helps avoid mistakenly shifting between
4904    keys.
4905    
4906    If allout customization var `allout-passphrase-verifier-handling' is
4907    non-nil, an entry for `allout-passphrase-verifier-string' and its value is
4908    added to an Emacs 'local variables' section at the end of the file, which
4909    is created if necessary.  That setting is for retention of the passphrase
4910    verifier across emacs sessions.
4911    
4912    Similarly, `allout-passphrase-hint-string' stores a user-provided reminder
4913    about their passphrase, and `allout-passphrase-hint-handling' specifies
4914    when the hint is presented, or if passphrase hints are disabled.  If
4915    enabled \(see the `allout-passphrase-hint-handling' docstring for details),
4916    the hint string is stored in the local-variables section of the file, and
4917    solicited whenever the passphrase is changed."
4918    
4919    (interactive "P")    (interactive "P")
4920    (save-excursion    (save-excursion
# Line 4967  the key is changed." Line 4924  the key is changed."
4924          (error (concat "Cannot encrypt or decrypt level 1 topics -"          (error (concat "Cannot encrypt or decrypt level 1 topics -"
4925                         " shift it in to make it encryptable")))                         " shift it in to make it encryptable")))
4926    
     (if (and fetch-key  
              (not (equal fetch-key '(4))))  
         (mc-deactivate-passwd))  
   
4927      (let* ((allout-buffer (current-buffer))      (let* ((allout-buffer (current-buffer))
4928             ;; Asses location:             ;; Asses location:
4929             (after-bullet-pos (point))             (after-bullet-pos (point))
4930             (was-encrypted             (was-encrypted
4931              (progn (if (= (point-max) after-bullet-pos)              (progn (if (= (point-max) after-bullet-pos)
4932                         (error "no body to encrypt"))                         (error "no body to encrypt"))
4933                     (looking-at "\\*")))                     (allout-encrypted-topic-p)))
4934             (was-collapsed (if (not (re-search-forward "[\n\r]" nil t))             (was-collapsed (if (not (re-search-forward "[\n\r]" nil t))
4935                                nil                                nil
4936                              (backward-char 1)                              (backward-char 1)
# Line 4993  the key is changed." Line 4946  the key is changed."
4946                               (error "No topic contents to %scrypt"                               (error "No topic contents to %scrypt"
4947                                      (if was-encrypted "de" "en"))))                                      (if was-encrypted "de" "en"))))
4948             ;; Assess key parameters:             ;; Assess key parameters:
4949             (key-type (or             (key-info (or
4950                        ;; detect the type by which it is already encrypted                        ;; detect the type by which it is already encrypted
4951                        (and was-encrypted                        (and was-encrypted
4952                             (allout-encrypted-text-type subject-text))                             (allout-encrypted-key-info subject-text))
4953                        (and (member fetch-key '(4 (4)))                        (and (member fetch-pass '(4 (4)))
4954                             (yes-or-no-p "Use key-pair encryption instead? ")                             '(keypair nil))
4955                             'keypair)                        '(symmetric nil)))
4956                        'symmetric))             (for-key-type (car key-info))
4957             (fetch-key (and fetch-key (not (member fetch-key '(16 (16))))))             (for-key-identity (cadr key-info))
4958               (fetch-pass (and fetch-pass (member fetch-pass '(16 (16)))))
4959             result-text)             result-text)
4960    
4961        (setq result-text        (setq result-text
4962              (allout-encrypt-string subject-text was-encrypted              (allout-encrypt-string subject-text was-encrypted
4963                                      (current-buffer) key-type fetch-key))                                      (current-buffer)
4964                                        for-key-type for-key-identity fetch-pass))
4965    
4966         ;; Replace the subtree with the processed product.         ;; Replace the subtree with the processed product.
4967        (allout-unprotected        (allout-unprotected
# Line 5040  the key is changed." Line 4995  the key is changed."
4995        )        )
4996      )      )
4997    )    )
4998  ;;;_  > allout-encrypt-string (text decrypt allout-buffer key-type rekey  ;;;_  > allout-encrypt-string (text decrypt allout-buffer key-type for-key
4999  ;;;                                  &optional retried verifying)  ;;;                                  fetch-pass &optional retried verifying
5000  (defun allout-encrypt-string (text decrypt allout-buffer key-type rekey  ;;;                                  passphrase)
5001                                      &optional retried verifying)  (defun allout-encrypt-string (text decrypt allout-buffer key-type for-key
5002    "Encrypt or decrypt a string TEXT using KEY.                                         fetch-pass &optional retried verifying
5003                                           passphrase)
5004  If optional DECRYPT is true (default false), then decrypt instead of    "Encrypt or decrypt message TEXT.
5005  encrypt.  
5006    If DECRYPT is true (default false), then decrypt instead of encrypt.
5007    
5008    FETCH-PASS (default false) forces fresh prompting for the passphrase.
5009    
5010  Optional REKEY (default false) provokes clearing of the key cache to force  KEY-TYPE indicates whether to use a 'symmetric or 'keypair cipher.
 fresh prompting for the key.  
5011    
5012  Optional RETRIED is for internal use - conveys the number of failed keys have  FOR-KEY is human readable identification of the first of the user's
5013  been solicited in sequence leading to this current call.  eligible secret keys a keypair decryption targets, or else nil.
5014    
5015  Optional VERIFYING is for internal use, signifying processing of text  Optional RETRIED is for internal use - conveys the number of failed keys
5016  solely for verification of the cached key.  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.
5020    
5021  Returns the resulting string, or nil if the transformation fails."  Returns the resulting string, or nil if the transformation fails."
5022    
5023    ;; Ensure that we have an alternate handle on the real mc-activate-passwd:    (require 'pgg)
   (if (not (fboundp 'real-mc-activate-passwd))  
       ;; Force loads of the primary mailcrypt packages, so flet below holds.  
       (progn (require 'mailcrypt)  
              (load "mc-toplev")  
              (fset 'real-mc-activate-passwd  
                    (symbol-function 'mc-activate-passwd))))  
5024    
5025    (if (and rekey (not verifying)) (mc-deactivate-passwd))    (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    (catch 'encryption-failed            (insert (subst-char-in-string ?\r ?\n text))
5067      (save-excursion  
5068              (cond
5069    
5070        (let* ((mc-default-scheme (or allout-encryption-scheme             ;; symmetric:
5071                                      allout-default-encryption-scheme))             ((equal key-type 'symmetric)
5072               (id (format "%s-%s" key-type              (setq status
5073                           (or (buffer-file-name allout-buffer)                    (if decrypt
5074                               (buffer-name allout-buffer))))  
5075               (cached (real-mc-activate-passwd id nil))                        (pgg-decrypt (point-min) (point-max) passphrase)
5076               (comment "Processed by allout driving mailcrypt")  
5077               key work-buffer result result-text encryption-process-status)                      (pgg-encrypt-symmetric (point-min) (point-max)
5078                                               passphrase)))
5079          (unwind-protect  
5080                (if status
5081              ;; Interject our mc-activate-passwd wrapper:                  (pgg-situate-output (point-min) (point-max))
5082              (flet ((mc-activate-passwd (id &optional prompt)                ;; failed - handle passphrase caching
5083                                         (allout-mc-activate-passwd id prompt)))                (if verifying
5084                      (throw 'encryption-failed nil)
5085                (setq work-buffer                  (pgg-remove-passphrase-from-cache target-cache-id t)
5086                      (set-buffer (allout-encryption-produce-work-buffer text)))                  (error "Symmetric-cipher encryption failed - %s"
5087                           "try again with different passphrase."))))
5088                (cond  
5089               ;; encrypt 'keypair:
5090                 ;; symmetric:             ((not decrypt)
5091                 ((equal key-type 'symmetric)  
5092                  (setq key (if verifying              (setq status
5093                                (real-mc-activate-passwd id nil)  
5094                              (allout-mc-activate-passwd id)))                    (pgg-encrypt for-key
5095                  (setq encryption-process-status                                 nil (point-min) (point-max) passphrase))
5096                        (crypt-encrypt-buffer key decrypt))  
5097                  (if (zerop encryption-process-status)              (if status
5098                      t                  (pgg-situate-output (point-min) (point-max))
5099                    (if verifying                (error (pgg-remove-passphrase-from-cache target-cache-id t)
5100                        (throw 'encryption-failed nil)                       (error "encryption failed"))))
5101                      (mc-deactivate-passwd)  
5102                      (error "Symmetric-key encryption failed (%s) - wrong key?"             ;; decrypt 'keypair:
5103                             encryption-process-status))))             (t
5104    
5105                 ;; encrypt 'keypair:              (setq status
5106                 ((not decrypt)                    (pgg-decrypt (point-min) (point-max) passphrase))
5107                  (condition-case result  
5108                      (mailcrypt-encrypt 1)              (if status
5109                    (error (mc-deactivate-passwd)                  (pgg-situate-output (point-min) (point-max))
5110                           (error "encryption failed: %s"                (error (pgg-remove-passphrase-from-cache target-cache-id t)
5111                                  (cadr result)))))                       (error "decryption failed"))))
5112               )
5113                 ;; decrypt 'keypair:  
5114                 (t (condition-case result            (setq result-text
5115                        (mc-decrypt)                  (buffer-substring 1 (- (point-max) (if decrypt 0 1))))
5116                      (error (mc-deactivate-passwd)  
5117                             (error "decryption failed: %s"            ;; validate result - non-empty
5118                                    (cadr result))))))            (cond ((not result-text)
5119                     (if verifying
5120                (setq result-text (if (or (equal key-type 'keypair)                       nil
5121                                          (not decrypt))                     ;; transform was fruitless, retry w/new passphrase.
5122                                      (buffer-substring 1 (1- (point-max)))                     (pgg-remove-passphrase-from-cache target-cache-id t)
5123                                    (buffer-string)))                     (allout-encrypt-string text allout-buffer decrypt nil
5124                ;; validate result - non-empty                                            (if retried (1+ retried) 1)
5125                (cond ((not result-text)                                            passphrase)))
5126                       (if verifying  
5127                           nil                  ;; Barf if encryption yields extraordinary control chars:
5128                         ;; Transformation was fruitless - retry with new key.                  ((and (not decrypt)
5129                         (mc-deactivate-passwd)                        (string-match "[\C-a\C-k\C-o-\C-z\C-@]"
5130                         (allout-encrypt-string text allout-buffer decrypt nil                                      result-text))
5131                                                 (if retried (1+ retried) 1)                   (error (concat "encryption produced unusable"
5132                                                 verifying)))                                  " non-armored text - reconfigure!")))
5133    
5134                      ;; Barf if encryption yields extraordinary control chars:                  ;; valid result and just verifying or non-symmetric:
5135                      ((and (not decrypt)                  ((or verifying (not (equal key-type 'symmetric)))
5136                            (string-match "[\C-a\C-k\C-o-\C-z\C-@]" result-text))                   (if (or verifying decrypt)
5137                       (error (concat "encryption produced unusable"                       (pgg-add-passphrase-to-cache target-cache-id
5138                                      " non-armored text - reconfigure!")))                                                    passphrase t))
5139                     result-text)
5140                      ;; valid result and just verifying or non-symmetric:  
5141                      ((or verifying (not (equal key-type 'symmetric)))                  ;; valid result and regular symmetric - "register"
5142                       result-text)                  ;; passphrase with mnemonic aids/cache.
5143                    (t
5144                      ;; valid result and regular symmetric - situate validator:                   (set-buffer allout-buffer)
5145                      (t                   (if passphrase
5146                       ;; valid result and verifier needs to be situated in                       (pgg-add-passphrase-to-cache target-cache-id
5147                       ;; allout-buffer:                                                    passphrase t))
5148                       (set-buffer allout-buffer)                   (allout-update-passphrase-mnemonic-aids for-key passphrase
5149                       (if (and (or rekey (not cached))                                                           allout-buffer)
5150                                (not (allout-verify-key key allout-buffer)))                   result-text)
5151                           (allout-situate-encryption-key-verifier key id))                  )
                      result-text)  
                     )  
               )  
   
           ;; unwind-protect emergence:  
           (if work-buffer  
               (kill-buffer work-buffer))  
5152            )            )
5153          )          )
       )  
5154      )      )
5155    )    )
5156  ;;;_  > allout-mc-activate-passwd (id &optional prompt)  ;;;_  > allout-obtain-passphrase (for-key cache-id prompt-id key-type
5157  (defun allout-mc-activate-passwd (id &optional prompt)  ;;;                                       allout-buffer retried fetch-pass)
5158    "Substituted for mc-activate-passwd during allout outline encryption.  (defun allout-obtain-passphrase (for-key cache-id prompt-id key-type
5159                                             allout-buffer retried fetch-pass)
5160  We add key-verification to vanilla mc-activate-passwd.    "Obtain passphrase for a key from the cache or else from the user.
5161    
5162  We depend in some cases on values of the following allout-encrypt-string  When obtaining from the user, symmetric-cipher passphrases are verified
5163  internal or prevailing variables:  against either, if available and enabled, a random string that was
5164    - key-type - 'symmetric or 'keypair  encrypted against the passphrase, or else against repeated entry by the
5165    - id - id associated with current key in key cache  user for corroboration.
5166    - allout-buffer - where subject text resides  
5167    - retried - number of current attempts to obtain this key  FOR-KEY is the key for which the passphrase is being obtained.
5168    - rekey - user asked to present a new key - needs to be confirmed"  
5169    CACHE-ID is the cache id of the key for the passphrase.
5170  ;;  - if we're doing non-symmetric key, just do normal mc-activate-passwd  
5171  ;;  - otherwise, if we are have a cached version of the key, then assume  PROMPT-ID is the id for use when prompting the user.
5172  ;;    it's verified and return it  
5173  ;;  - otherwise, prompt for a key, and:  KEY-TYPE is either 'symmetric or 'keypair.
5174  ;;    - if we have a key verifier \(a string value which should decrypt  
5175  ;;      against a symmetric key), validate against the verifier  ALLOUT-BUFFER is the buffer containing the entry being en/decrypted.
5176  ;;      - if successful, return the verified key  
5177  ;;      - if unsuccessful:  RETRIED is the number of this attempt to obtain this passphrase.
5178  ;;        - offer to use the new key  
5179  ;;          - if accepted, do confirm process  FETCH-PASS causes the passphrase to be solicited from the user, regardless
5180  ;;          - if refused, try again until we get a correctly spelled one or the  of the availability of a cached copy."
 ;;            user quits  
 ;;    - if no key verifier, resolicit the key to get corroboration and return  
 ;;      the corroborated key if spelled identically, or error if not.  
5181    
5182    (if (not (equal key-type 'symmetric))    (if (not (equal key-type 'symmetric))
5183        ;; do regular mc-activate-passwd on non-symmetric key        ;; do regular passphrase read on non-symmetric passphrase:
5184        (real-mc-activate-passwd id prompt)        (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)
5192    
5193      ;; Symmetric hereon:      ;; Symmetric hereon:
5194    
5195      (save-excursion      (save-excursion
5196        (set-buffer allout-buffer)        (set-buffer allout-buffer)
5197        (let* ((hint (if (and (not (string= allout-key-hint-string ""))        (let* ((hint (if (and (not (string= allout-passphrase-hint-string ""))
5198                              (or (equal allout-key-hint-handling 'always)                              (or (equal allout-passphrase-hint-handling 'always)
5199                                  (and (equal allout-key-hint-handling 'needed)                                  (and (equal allout-passphrase-hint-handling
5200                                                'needed)
5201                                       retried)))                                       retried)))
5202                         (format " [%s]" allout-key-hint-string)                         (format " [%s]" allout-passphrase-hint-string)
5203                       ""))                       ""))
5204               (retry-message (if retried (format " (%s retry)" retried) ""))               (retry-message (if retried (format " (%s retry)" retried) ""))
5205               (prompt-sans-hint (format "'%s' symmetric key%s: "               (prompt-sans-hint (format "'%s' symmetric passphrase%s: "
5206                                         (buffer-name allout-buffer)                                         prompt-id retry-message))
5207                                         retry-message))               (full-prompt (format "'%s' symmetric passphrase%s%s: "
5208               (full-prompt (format "'%s' symmetric key%s%s: "                                    prompt-id hint retry-message))
                                   (buffer-name allout-buffer)  
                                   hint retry-message))  
5209               (prompt full-prompt)               (prompt full-prompt)
5210               (verifier-string (allout-get-encryption-key-verifier))               (verifier-string (allout-get-encryption-passphrase-verifier))
5211               ;; force retention of cached passwords for five minutes while  
5212               ;; we're in this particular routine:               (cached (and (not fetch-pass)
5213               (mc-passwd-timeout 300)                            (pgg-read-passphrase-from-cache cache-id t)))
5214               (cached (real-mc-activate-passwd id nil))               (got-pass (or cached
5215               (got (or cached (real-mc-activate-passwd id full-prompt)))                             (pgg-read-passphrase full-prompt cache-id t)))
5216    
5217               confirmation)               confirmation)
5218    
5219          (if (not got)          (if (not got-pass)
5220              nil              nil
5221    
5222            ;; Duplicate our handle on the key so it's not clobbered by            ;; Duplicate our handle on the passphrase so it's not clobbered by
5223            ;; deactivate-passwd memory clearing:            ;; deactivate-passwd memory clearing:
5224            (setq got (format "%s" got))            (setq got-pass (format "%s" got-pass))
5225    
5226            (cond (verifier-string            (cond (verifier-string
5227                   (if (and (not (allout-encrypt-string                   (save-window-excursion
5228                                  verifier-string 'decrypt allout-buffer                     (if (allout-encrypt-string verifier-string 'decrypt
5229                                  'symmetric nil 0 'verifying))                                                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)
5235                            (if (yes-or-no-p                            (if (yes-or-no-p
5236                                 (concat "Key differs from established"                                 (concat "Passphrase differs from established"
5237                                         " - use new one instead? "))                                         " - use new one instead? "))
5238                                ;; deactivate password for subsequent                                ;; deactivate password for subsequent
5239                                ;; confirmation:                                ;; confirmation:
5240                                (progn (mc-deactivate-passwd)                                (progn
5241                                       (setq prompt prompt-sans-hint)                                  (pgg-remove-passphrase-from-cache cache-id t)
5242                                       nil)                                  (setq prompt prompt-sans-hint)
5243                                    nil)
5244                              t))                              t))
5245                       (progn (mc-deactivate-passwd)                       (progn (pgg-remove-passphrase-from-cache cache-id t)
5246                              (error "Wrong key."))))                              (error "Wrong passphrase."))))
5247                  ;; Force confirmation by repetition for new key:                  ;; No verifier string - force confirmation by repetition of
5248                  ((or rekey (not cached)) (mc-deactivate-passwd))))                  ;; (new) passphrase:
5249          ;; we have a key and it's either verified and cached.                  ((or fetch-pass (not cached))
5250          ;; confirmation vs new input - doing mc-activate-passwd will do the                   (pgg-remove-passphrase-from-cache cache-id t))))
5251            ;; confirmation vs new input - doing pgg-read-passphrase will do the
5252          ;; right thing, in either case:          ;; right thing, in either case:
5253          (setq confirmation          (if (not confirmation)
5254                (real-mc-activate-passwd id (concat prompt              (setq confirmation
5255                                                    " ... confirm spelling: ")))                    (pgg-read-passphrase (concat prompt
5256                                                   " ... confirm spelling: ")
5257                                           cache-id t)))
5258          (prog1          (prog1
5259              (if (equal got confirmation)              (if (equal got-pass confirmation)
5260                  confirmation                  confirmation
5261                (if (yes-or-no-p (concat "spelling of original and"                (if (yes-or-no-p (concat "spelling of original and"
5262                                         " confirmation differ - retry? "))                                         " confirmation differ - retry? "))
5263                    (progn (setq retried (if retried (1+ retried) 1))                    (progn (setq retried (if retried (1+ retried) 1))
5264                           (mc-deactivate-passwd)                           (pgg-remove-passphrase-from-cache cache-id t)
5265                           ;; recurse to this routine:                           ;; recurse to this routine:
5266                           (mc-activate-passwd id prompt-sans-hint))                           (pgg-read-passphrase prompt-sans-hint cache-id t))
5267                  (mc-deactivate-passwd)                  (pgg-remove-passphrase-from-cache cache-id t)
5268                  (error "Confirmation failed.")))                  (error "Confirmation failed.")))
5269            ;; reduce opportunity for memory cherry-picking by zeroing duplicate:            ;; reduce opportunity for memory cherry-picking by zeroing duplicate:
5270            (dotimes (i (length got))            (dotimes (i (length got-pass))
5271              (aset got i 0))              (aset got-pass i 0))
5272            )            )
5273          )          )
5274        )        )
5275      )      )
5276    )    )
 ;;;_  > allout-encryption-produce-work-buffer (text)  
 (defun allout-encryption-produce-work-buffer (text)  
   "Establish a new buffer filled with TEXT, for outline encrypion processing.  
   
 TEXT is massaged so outline collapsing, if any, is removed."  
   (let ((work-buffer (generate-new-buffer " *allout encryption*")))  
     (save-excursion  
       (set-buffer work-buffer)  
       (insert (subst-char-in-string ?\r ?\n text)))  
     work-buffer))  
5277  ;;;_  > allout-encrypted-topic-p ()  ;;;_  > allout-encrypted-topic-p ()
5278  (defun allout-encrypted-topic-p ()  (defun allout-encrypted-topic-p ()
5279    "True if the current topic is encryptable and encrypted."    "True if the current topic is encryptable and encrypted."
# Line 5295  TEXT is massaged so outline collapsing, Line 5284  TEXT is massaged so outline collapsing,
5284           (looking-at "\\*"))           (looking-at "\\*"))
5285      )      )
5286    )    )
5287  ;;;_  > allout-encrypted-text-type (text)  ;;;_  > allout-encrypted-key-info (text)
5288  ;;; XXX gpg-specific, not generic!  ;; XXX gpg-specific, alas
5289  (defun allout-encrypted-text-type (text)  (defun allout-encrypted-key-info (text)
5290    "For gpg encrypted text, return 'symmetric or 'keypair."    "Return a pair of the key type and identity of a recipient's secret key.
5291    
5292    ;; Ensure mc-gpg-path has a value:  The key type is one of 'symmetric or 'keypair.
5293    (if (not (boundp 'mc-gpg-path))  
5294        (load-library "mc-gpg"))  if 'keypair, and some of the user's secret keys are among those for which
5295    the message was encoded, return the identity of the first.  otherwise,
5296    return nil for the second item of the pair.
5297    
5298    An error is raised if the text is not encrypted."
5299      (require 'pgg-parse)
5300    (save-excursion    (save-excursion
5301      (let* ((work-buffer (set-buffer      (with-temp-buffer
5302                           (allout-encryption-produce-work-buffer text)))        (insert (subst-char-in-string ?\r ?\n text))
5303             (result (mc-gpg-process-region (point-min) (point-max)        (let* ((parsed-armor (pgg-parse-armor-region (point-min) (point-max)))
5304                                            nil mc-gpg-path               (type (if (pgg-gpg-symmetric-key-p parsed-armor)
5305                                            '("--batch" "--decrypt")                         'symmetric
5306                                            'mc-gpg-decrypt-parser                       'keypair))
5307                                            work-buffer nil)))               secret-keys first-secret-key for-key-owner)
5308        (cond ((equal (nth 0 result) 'symmetric)          (if (equal type 'keypair)
5309               'symmetric)              (setq secret-keys (pgg-gpg-lookup-all-secret-keys)
5310              ((equal (nth 0 result) t)                    first-secret-key (pgg-gpg-select-matching-key parsed-armor
5311               'keypair)                                                                  secret-keys)
5312              (t (error "Unrecognized/unsupported encryption type %S"                    for-key-owner (and first-secret-key
5313                        (nth 0 result))))                                       (pgg-gpg-lookup-key-owner
5314                                          first-secret-key))))
5315            (list type (pgg-gpg-key-id-from-key-owner for-key-owner))
5316            )
5317        )        )
5318      )      )
5319    )    )
5320  ;;;_  > allout-create-encryption-key-verifier (key id)  ;;;_  > allout-create-encryption-passphrase-verifier (passphrase)
5321  (defun allout-create-encryption-key-verifier (key id)  (defun allout-create-encryption-passphrase-verifier (passphrase)
5322    "Encrypt a random message for later validation of symmetric key."    "Encrypt random message for later validation of symmetric key's passphrase."
5323    ;; use 20 random ascii characters, across the entire ascii range.    ;; use 20 random ascii characters, across the entire ascii range.
5324    (random t)    (random t)
5325    (let ((spew (make-string 20 ?\0)))    (let ((spew (make-string 20 ?\0)))
5326      (dotimes (i (length spew))      (dotimes (i (length spew))
5327        (aset spew i (1+ (random 254))))        (aset spew i (1+ (random 254))))
5328      (allout-encrypt-string spew nil nil 'symmetric nil nil t))      (allout-encrypt-string spew nil (current-buffer) 'symmetric
5329                               nil nil 0 passphrase))
5330    )    )
5331  ;;;_  > allout-situate-encryption-key-verifier (key id)  ;;;_  > allout-update-passphrase-mnemonic-aids (for-key passphrase
5332  (defun allout-situate-encryption-key-verifier (key id)  ;;;                                                     outline-buffer)
5333    "Establish key verifier string on file variable.  (defun allout-update-passphrase-mnemonic-aids (for-key passphrase
5334                                                           outline-buffer)
5335  We also prompt for and situate a new reminder, if reminders are enabled.    "Update passphrase verifier and hint strings if necessary.
5336    
5337  We massage the string to simplify programmatic adjustment.  File variable  See `allout-passphrase-verifier-string' and `allout-passphrase-hint-string'
5338  is `allout-file-key-verifier-string'."  settings.
5339    (let ((verifier-string  
5340           ;; Collapse to a single line and enclose in string quotes:  PASSPHRASE is the passphrase being mnemonicized
5341           (subst-char-in-string ?\n ?\C-a  
5342                                 (allout-create-encryption-key-verifier  OUTLINE-BUFFER is the buffer of the outline being adjusted.
5343                                  key id)))  
5344          (reminder (if (not (equal allout-key-hint-handling 'disabled))  These are used to help the user keep track of the passphrase they use for
5345                        (read-from-minibuffer  symmetric encryption in the file.
5346                         "Key hint to jog your memory next time: "  
5347                         allout-key-hint-string))))  Behavior is governed by `allout-passphrase-verifier-handling',
5348      (setq allout-key-verifier-string verifier-string)  `allout-passphrase-hint-handling', and also, controlling whether the values
5349      (allout-adjust-file-variable "allout-key-verifier-string"  are preserved on Emacs local file variables,
5350                                    verifier-string)  `allout-enable-file-variable-adjustment'."
5351      (cond ((equal allout-key-hint-handling 'disabled)  
5352             nil)    ;; If passphrase doesn't agree with current verifier:
5353            ((not (string= reminder allout-key-hint-string))    ;;   - adjust the verifier
5354             (setq allout-key-hint-string reminder)    ;;   - if passphrase hint handling is enabled, adjust the passphrase hint
5355             (allout-adjust-file-variable "allout-key-hint-string"    ;;   - if file var settings are enabled, adjust the file vars
5356                                           reminder)))  
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          )
5382      )      )
5383    )    )
5384  ;;;_  > allout-get-encryption-key-verifier ()  ;;;_  > allout-get-encryption-passphrase-verifier ()
5385  (defun allout-get-encryption-key-verifier ()  (defun allout-get-encryption-passphrase-verifier ()
5386    "Return the text of the encrypt key verifier, unmassaged, or nil if none.    "Return text of the encrypt passphrase verifier, unmassaged, or nil if none.
5387    
5388  Derived from value of `allout-file-key-verifier-string'."  Derived from value of `allout-file-passphrase-verifier-string'."
5389    
5390    (let ((verifier-string (and (boundp 'allout-key-verifier-string)    (let ((verifier-string (and (boundp 'allout-passphrase-verifier-string)
5391                                allout-key-verifier-string)))                                allout-passphrase-verifier-string)))
5392      (if verifier-string      (if verifier-string
5393          ;; Return it uncollapsed          ;; Return it uncollapsed
5394          (subst-char-in-string ?\C-a ?\n verifier-string)          (subst-char-in-string ?\C-a ?\n verifier-string))
       nil)  
5395     )     )
5396    )    )
5397  ;;;_  > allout-verify-key (key)  ;;;_  > allout-verify-passphrase (key passphrase allout-buffer)
5398  (defun allout-verify-key (key allout-buffer)  (defun allout-verify-passphrase (key passphrase allout-buffer)
5399    "True if key successfully decrypts key verifier, nil otherwise.    "True if passphrase successfully decrypts verifier, nil otherwise.
5400    
5401  \"Otherwise\" includes absence of key verifier."  \"Otherwise\" includes absence of passphrase verifier."
5402    (save-excursion    (save-excursion
5403      (set-buffer allout-buffer)      (set-buffer allout-buffer)
5404      (and (boundp 'allout-key-verifier-string)      (and (boundp 'allout-passphrase-verifier-string)
5405           allout-key-verifier-string           allout-passphrase-verifier-string
5406           (allout-encrypt-string (allout-get-encryption-key-verifier)           (allout-encrypt-string (allout-get-encryption-passphrase-verifier)
5407                                   'decrypt allout-buffer 'symmetric                                   'decrypt allout-buffer 'symmetric
5408                                   nil nil 'verifying)                                   key nil 0 'verifying passphrase)
5409           t)))           t)))
5410  ;;;_  > allout-next-topic-pending-encryption (&optional except-mark)  ;;;_  > allout-next-topic-pending-encryption (&optional except-mark)
5411  (defun allout-next-topic-pending-encryption (&optional except-mark)  (defun allout-next-topic-pending-encryption (&optional except-mark)
# Line 5500  save.  See `allout-encrypt-unencrypted-o Line 5521  save.  See `allout-encrypt-unencrypted-o
5521    (exchange-point-and-mark))    (exchange-point-and-mark))
5522  ;;;_  > outlineify-sticky ()  ;;;_  > outlineify-sticky ()
5523  ;; outlinify-sticky is correct spelling; provide this alias for sticklers:  ;; outlinify-sticky is correct spelling; provide this alias for sticklers:
5524    ;;;###autoload
5525  (defalias 'outlinify-sticky 'outlineify-sticky)  (defalias 'outlinify-sticky 'outlineify-sticky)
5526    ;;;###autoload
5527  (defun outlineify-sticky (&optional arg)  (defun outlineify-sticky (&optional arg)
5528    "Activate outline mode and establish file var so it is started subsequently.    "Activate outline mode and establish file var so it is started subsequently.
5529    
# Line 5699  Unless optional argument INPLACE is non- Line 5722  Unless optional argument INPLACE is non-
5722            (if (eq (aref newstr i) fromchar)            (if (eq (aref newstr i) fromchar)
5723                (aset newstr i tochar)))                (aset newstr i tochar)))
5724          newstr)))          newstr)))
   
5725  ;;;_  : my-mark-marker to accommodate divergent emacsen:  ;;;_  : my-mark-marker to accommodate divergent emacsen:
5726  (defun my-mark-marker (&optional force buffer)  (defun my-mark-marker (&optional force buffer)
5727    "Accommodate the different signature for `mark-marker' across Emacsen.    "Accommodate the different signature for `mark-marker' across Emacsen.
5728    
5729  XEmacs takes two optional args, while mainline GNU Emacs does not,  XEmacs takes two optional args, while mainline GNU Emacs does not,
5730  so pass them along when appropriate."  so pass them along when appropriate."
5731    (if (string-match " XEmacs " emacs-version)    (if (featurep 'xemacs)
5732        (mark-marker force buffer)        (apply 'mark-marker force buffer)
5733      (mark-marker)))      (mark-marker)))
5734    
5735  ;;;_ #10 Under development  ;;;_ #10 Under development

Legend:
Removed from v.1.62  
changed lines
  Added in v.1.63

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26