emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Emacs-diffs] /srv/bzr/emacs/trunk r102680: Synopsis: Migrate allout enc


From: Ken Manheimer
Subject: [Emacs-diffs] /srv/bzr/emacs/trunk r102680: Synopsis: Migrate allout encryption provisions from pgg library, which is
Date: Thu, 16 Dec 2010 18:30:57 -0500
User-agent: Bazaar (2.0.3)

------------------------------------------------------------
revno: 102680 [merge]
committer: Ken Manheimer <address@hidden>
branch nick: trunk
timestamp: Thu 2010-12-16 18:30:57 -0500
message:
  Synopsis: Migrate allout encryption provisions from pgg library, which is
  obsolete, to epg library, which replaces pgg.
  
  Due to the underlying GnuPG V2 restrictions on external handling of
  passphrases (or epg's restrictions when working with GnuPG v2), we are
  dropping allout's symmetric encryption passphrase hinting and verification.
  This has the advantage that no emacs code has access to the passphrase,
  leaving all passphrase handling in GnuPG, which is much more secure.  This,
  together with the reduction in allout code complexity and logistical
  complications the user would have in arranging to use GnuPG v1, requires
  dropping these features.
  
  Keypair encryption gains features, with adoption of respect for epa-file's
  'epa-file-encrypt-to'.  This means that allout outlines can be associated
  with recipients, and encryptions by default will be targeted to those
  recipients.
  
  The default encryption mode (whether to epa-file-encrypt-to recipients, if
  any, or symmetric mode) is overridden by providing a universal argument
  greater than 1 to the outline entry encryption command,
  'allout-toggle-current-subtree-encryption'.  The user is then prompted to
  select keypair identities from their list of known GnuPG keypairs.  If they
  don't select any, then symmetric encryption is done.  Otherwise, the
  selected keypair identities are targeted.  If the universal argument is
  greater than 4 then the selected recipients (or none, if none were
  selected) are associated with the outline using a file local variable, as
  default recipients for subsequent encryptions.
  
  This is a big merge from a private branch.
  
  Code details:
  
  (allout-toggle-current-subtree-encryption,
  allout-toggle-subtree-encryption): Adjust docstrings to reflect defaulting
  policy and other changes.
  Change fetch-pass to keymode-cue, for simpler universal argument
  interpretation.
  (allout-toggle-subtree-encryption):  Adjust docstring to describe
  changed encryption provisions.
  Change fetch-pass to keymode-cue, for simpler universal argument
  interpretation.
  Remove provisions for handling key type and identity - they'll all be
  within allout-encrypt-string or epg/epg or even contained all the way in
  gpg.
  (allout-encrypt-string): Include keymode-cue, for optionally prompting for
  keypair recipients (universal argument > 1) and, in addition, associating the
  specified recipients with the outline (universal argument > 4) using a file
  local variable setting for 'epa-file-encrypt-to'.
  Require epa, for recipients handling.
  Change how regexp filtering elements are named.
  Describe the problem with caching of incorrect symmetric-decryption keys.
  Use the epa-passphrase-callback-function, in case the user is using GnuPG
  v1.
  Support saving of the selected keypair recipients when invoked with a
  keymode-cue > 4.
  Remove obsolete arguments 'fetch-pass', 'target-cache-id', 'retried'.
  Require 'epa.
  Establish epg-context with armoring and default epg-protocol.
  Remove all passphrase cache, verification, and hinting code.
  (allout-passphrase-verifier-handling, allout-passphrase-hint-handling):
  No longer used, delete.
  (allout-mode): Adjust docstring to describe changed encryption provisions.
  Describe the problem with caching of incorrect symmetric-decryption keys.
  (allout-obtain-passphrase, allout-epg-passphrase-callback-function,
  allout-make-passphrase-state, allout-passphrase-state-passphrase,
  allout-encrypted-key-info, allout-update-passphrase-mnemonic-aids,
  allout-get-encryption-passphrase-verifier, allout-verify-passphrase):
  Obsolete, remove.
modified:
  lisp/allout.el
=== modified file 'lisp/allout.el'
--- a/lisp/allout.el    2010-12-16 22:33:13 +0000
+++ b/lisp/allout.el    2010-12-16 23:30:57 +0000
@@ -43,9 +43,8 @@
 ;;  - Symmetric-key and key-pair topic encryption, plus symmetric passphrase
 ;;    mnemonic support, with verification against an established passphrase
 ;;    (using a stashed encrypted dummy string) and user-supplied hint
-;;    maintenance.  (See allout-toggle-current-subtree-encryption docstring.
-;;    Currently only GnuPG encryption is supported, and integration
-;;    with gpg-agent is not yet implemented.)
+;;    maintenance.  Encryption is via the Emacs 'epg' library.  See
+;;    allout-toggle-current-subtree-encryption docstring.
 ;;  - Automatic topic-number maintenance
 ;;  - "Hot-spot" operation, for single-keystroke maneuvering and
 ;;    exposure control (see the allout-mode docstring)
@@ -84,11 +83,10 @@
 ;;;_* Dependency autoloads
 (require 'overlay)
 (eval-when-compile
-  ;; Most of the requires here are for stuff covered by autoloads.
-  ;; Since just byte-compiling doesn't trigger autoloads, so that
-  ;; "function not found" warnings would occur without these requires.
-  (require 'pgg)
-  (require 'pgg-gpg)
+  ;; Most of the requires here are for stuff covered by autoloads, which
+  ;; byte-compiling doesn't trigger.
+  (require 'epg)
+  (require 'epa)
   (require 'overlay)
   ;; `cl' is required for `assert'.  `assert' is not covered by a standard
   ;; autoload, but it is a macro, so that eval-when-compile is sufficient
@@ -818,32 +816,6 @@
   :type '(choice (const nil) string)
   :version "22.1"
   :group 'allout-encryption)
-;;;_  = allout-passphrase-verifier-handling
-(defcustom allout-passphrase-verifier-handling t
-  "Enable use of symmetric encryption passphrase verifier if non-nil.
-
-See the docstring for the `allout-enable-file-variable-adjustment'
-variable for details about allout ajustment of file variables."
-  :type 'boolean
-  :version "22.1"
-  :group 'allout-encryption)
-(make-variable-buffer-local 'allout-passphrase-verifier-handling)
-;;;_  = allout-passphrase-hint-handling
-(defcustom allout-passphrase-hint-handling 'always
-  "Dictate outline encryption passphrase reminder handling:
-
- always -- always show reminder when prompting
- needed -- show reminder on passphrase entry failure
- disabled -- never present or adjust reminder
-
-See the docstring for the `allout-enable-file-variable-adjustment'
-variable for details about allout ajustment of file variables."
-  :type '(choice (const always)
-                 (const needed)
-                 (const disabled))
-  :version "22.1"
-  :group 'allout-encryption)
-(make-variable-buffer-local 'allout-passphrase-hint-handling)
 ;;;_  = allout-encrypt-unencrypted-on-saves
 (defcustom allout-encrypt-unencrypted-on-saves t
   "When saving, should topics pending encryption be encrypted?
@@ -1554,6 +1526,8 @@
 the Emacs buffer state, if file variable adjustments are enabled.  See
 `allout-enable-file-variable-adjustment' for details about that.")
 (make-variable-buffer-local 'allout-passphrase-verifier-string)
+(make-obsolete 'allout-passphrase-verifier-string
+               'allout-passphrase-verifier-string "23.3")
 ;;;###autoload
 (put 'allout-passphrase-verifier-string 'safe-local-variable 'stringp)
 ;;;_   = allout-passphrase-hint-string
@@ -1568,6 +1542,8 @@
 `allout-enable-file-variable-adjustment' for details about that.")
 (make-variable-buffer-local 'allout-passphrase-hint-string)
 (setq-default allout-passphrase-hint-string "")
+(make-obsolete 'allout-passphrase-hint-string
+               'allout-passphrase-hint-string "23.3")
 ;;;###autoload
 (put 'allout-passphrase-hint-string 'safe-local-variable 'stringp)
 ;;;_   = allout-after-save-decrypt
@@ -1599,15 +1575,15 @@
 (defvar allout-encryption-ciphertext-rejection-regexps nil
   "Variable for regexps matching plaintext to remove before encryption.
 
-This is for the sake of redoing encryption in cases where the ciphertext
-incidentally contains strings that would disrupt mode operation --
-for example, a line that happens to look like an allout-mode topic prefix.
+This is used to detect strings in encryption results that would
+register as allout mode structural elements, for exmple, as a
+topic prefix.
 
 Entries must be symbols that are bound to the desired regexp values.
 
-The encryption will be retried up to
-`allout-encryption-ciphertext-rejection-limit' times, after which an error
-is raised.")
+Encryptions that result in matches will be retried, up to
+`allout-encryption-ciphertext-rejection-limit' times, after which
+an error is raised.")
 
 (make-variable-buffer-local 'allout-encryption-ciphertext-rejection-regexps)
 ;;;_   = allout-encryption-ciphertext-rejection-ceiling
@@ -1937,19 +1913,22 @@
                   Topic Encryption
 
 Outline mode supports gpg encryption of topics, with support for
-symmetric and key-pair modes, passphrase timeout, passphrase
-consistency checking, user-provided hinting for symmetric key
-mode, and auto-encryption of topics pending encryption on save.
+symmetric and key-pair modes, and auto-encryption of topics
+pending encryption on save.
 
 Topics pending encryption are, by default, automatically
-encrypted during file saves.  If the contents of the topic
-containing the cursor was encrypted for a save, it is
-automatically decrypted for continued editing.
+encrypted during file saves, including checkpoint saves, to avoid
+exposing the plain text of encrypted topics in the file system.
+If the content of the topic containing the cursor was encrypted
+for a save, it is automatically decrypted for continued editing.
 
-The aim of these measures is reliable topic privacy while
-preventing accidents like neglected encryption before saves,
-forgetting which passphrase was used, and other practical
-pitfalls.
+PROBLEM: Attempting symmetric decryption with an incorrect key
+not only fails, but for some GnuPG v2 versions the incorrect key
+is apparently retained in the gpg cache and reused, preventing
+decryption, until the cache finally times out.  That can take
+several minutes.  \(Decryption of other entries is not affected.)
+To clear this problem before the cache times out, deliberately
+clear your gpg-agent's cache by sending it a '-HUP' signal.
 
 See `allout-toggle-current-subtree-encryption' function docstring
 and `allout-encrypt-unencrypted-on-saves' customization variable
@@ -5999,31 +5978,39 @@
     (goto-char start-pt)))
 
 ;;;_ #8 Encryption
-;;;_  > allout-toggle-current-subtree-encryption (&optional fetch-pass)
-(defun allout-toggle-current-subtree-encryption (&optional fetch-pass)
-  "Encrypt clear or decrypt encoded text of visibly-containing topic's 
contents.
-
-Optional FETCH-PASS universal argument provokes key-pair encryption with
-single universal argument.  With doubled universal argument (value = 16),
-it forces prompting for the passphrase regardless of availability from the
-passphrase cache.  With no universal argument, the appropriate passphrase
-is obtained from the cache, if available, else from the user.
-
-Only GnuPG encryption is supported.
-
-\*NOTE WELL* that the encrypted text must be ascii-armored.  For gnupg
-encryption, include the option ``armor'' in your ~/.gnupg/gpg.conf file.
-
-Both symmetric-key and key-pair encryption is implemented.  Symmetric is
-the default, use a single (x4) universal argument for keypair mode.
-
-Encrypted topic's bullet is set to a `~' to signal that the contents of the
-topic (body and subtopics, but not heading) is pending encryption or
-encrypted.  `*' asterisk immediately after the bullet signals that the body
-is encrypted, its' absence means the topic is meant to be encrypted but is
-not.  When a file with topics pending encryption is saved, topics pending
-encryption are encrypted.  See allout-encrypt-unencrypted-on-saves for
-auto-encryption specifics.
+;;;_  > allout-toggle-current-subtree-encryption (&optional keymode-cue)
+(defun allout-toggle-current-subtree-encryption (&optional keymode-cue)
+  "Encrypt clear or decrypt encoded topic text.
+
+Allout uses emacs 'epg' libary to perform encryption.  Symmetric
+and keypair encryption are supported.  All encryption is ascii
+armored.
+
+Entry encryption defaults to symmetric key mode unless keypair
+recipients are associated with the file \(see
+`epa-file-encrypt-to') or the function is invoked with a
+\(KEYMODE-CUE) universal argument greater than 1.
+
+When encrypting, KEYMODE-CUE universal argument greater than 1
+causes prompting for recipients for public-key keypair
+encryption.  Selecting no recipients results in symmetric key
+encryption.
+
+Further, encrypting with a KEYMODE-CUE universal argument greater
+than 4 - eg, preceded by a doubled Ctrl-U - causes association of
+the specified recipients with the file, replacing those currently
+associated with it.  This can be used to deassociate any
+recipients with the file, by selecting no recipients in the
+dialog.
+
+Encrypted topic's bullets are set to a `~' to signal that the
+contents of the topic (body and subtopics, but not heading) is
+pending encryption or encrypted.  `*' asterisk immediately after
+the bullet signals that the body is encrypted, its absence means
+the topic is meant to be encrypted but is not currently.  When a
+file with topics pending encryption is saved, topics pending
+encryption are encrypted.  See allout-encrypt-unencrypted-on-saves
+for auto-encryption specifics.
 
 \*NOTE WELL* that automatic encryption that happens during saves will
 default to symmetric encryption -- you must deliberately (re)encrypt key-pair
@@ -6031,59 +6018,35 @@
 
 Level-one topics, with prefix consisting solely of an `*' asterisk, cannot be
 encrypted.  If you want to encrypt the contents of a top-level topic, use
-\\[allout-shift-in] to increase its depth.
-
-  Passphrase Caching
-
-The encryption passphrase is solicited if not currently available in the
-passphrase cache from a recent encryption action.
-
-The solicited passphrase is retained for reuse in a cache, if enabled.  See
-`pgg-cache-passphrase' and `pgg-passphrase-cache-expiry' for details.
-
-  Symmetric Passphrase Hinting and Verification
-
-If the file previously had no associated passphrase, or had a different
-passphrase than specified, the user is prompted to repeat the new one for
-corroboration.  A random string encrypted by the new passphrase is set on
-the buffer-specific variable `allout-passphrase-verifier-string', for
-confirmation of the passphrase when next obtained, before encrypting or
-decrypting anything with it.  This helps avoid mistakenly shifting between
-keys.
-
-If allout customization var `allout-passphrase-verifier-handling' is
-non-nil, an entry for `allout-passphrase-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 passphrase
-verifier across Emacs sessions.
-
-Similarly, `allout-passphrase-hint-string' stores a user-provided reminder
-about their passphrase, and `allout-passphrase-hint-handling' specifies
-when the hint is presented, or if passphrase hints are disabled.  If
-enabled (see the `allout-passphrase-hint-handling' docstring for details),
-the hint string is stored in the local-variables section of the file, and
-solicited whenever the passphrase is changed."
+\\[allout-shift-in] to increase its depth."
   (interactive "P")
   (save-excursion
     (allout-back-to-current-heading)
-    (allout-toggle-subtree-encryption fetch-pass)
-    )
-  )
-;;;_  > allout-toggle-subtree-encryption (&optional fetch-pass)
-(defun allout-toggle-subtree-encryption (&optional fetch-pass)
+    (allout-toggle-subtree-encryption keymode-cue)))
+;;;_  > allout-toggle-subtree-encryption (&optional keymode-cue)
+(defun allout-toggle-subtree-encryption (&optional keymode-cue)
   "Encrypt clear text or decrypt encoded topic contents (body and subtopics.)
 
-Optional FETCH-PASS universal argument provokes key-pair encryption with
-single universal argument.  With doubled universal argument (value = 16),
-it forces prompting for the passphrase regardless of availability from the
-passphrase cache.  With no universal argument, the appropriate passphrase
-is obtained from the cache, if available, else from the user.
-
-Currently only GnuPG encryption is supported, and integration
-with gpg-agent is not yet implemented.
-
-\**NOTE WELL** that the encrypted text must be ascii-armored.  For gnupg
-encryption, include the option ``armor'' in your ~/.gnupg/gpg.conf file.
+Entry encryption defaults to symmetric key mode unless keypair
+recipients are associated with the file \(see
+`epa-file-encrypt-to') or the function is invoked with a
+\(KEYMODE-CUE) universal argument greater than 1.
+
+When encrypting, KEYMODE-CUE universal argument greater than 1
+causes prompting for recipients for public-key keypair
+encryption.  Selecting no recipients results in symmetric key
+encryption.
+
+Further, encrypting with a KEYMODE-CUE universal argument greater
+than 4 - eg, preceded by a doubled Ctrl-U - causes association of
+the specified recipients with the file, replacing those currently
+associated with it.  This can be used to deassociate any
+recipients with the file, by selecting no recipients in the
+dialog.
+
+Encryption and decryption uses the emacs epg library.
+
+Encrypted text will be ascii-armored.
 
 See `allout-toggle-current-subtree-encryption' for more details."
 
@@ -6121,16 +6084,6 @@
                                    (if was-encrypted "de" "en"))
                           nil))
            ;; Assess key parameters:
-           (key-info (or
-                      ;; detect the type by which it is already encrypted
-                      (and was-encrypted
-                           (allout-encrypted-key-info subject-text))
-                      (and (member fetch-pass '(4 (4)))
-                           '(keypair nil))
-                      '(symmetric nil)))
-           (for-key-type (car key-info))
-           (for-key-identity (cadr key-info))
-           (fetch-pass (and fetch-pass (member fetch-pass '(16 (16)))))
            (was-coding-system buffer-file-coding-system))
 
       (when (not was-encrypted)
@@ -6156,8 +6109,7 @@
 
       (setq result-text
             (allout-encrypt-string subject-text was-encrypted
-                                    (current-buffer)
-                                    for-key-type for-key-identity fetch-pass))
+                                   (current-buffer) keymode-cue))
 
        ;; Replace the subtree with the processed product.
       (allout-unprotected
@@ -6188,335 +6140,172 @@
            (insert "*"))))
       (run-hook-with-args 'allout-structure-added-hook
                           bullet-pos subtree-end))))
-;;;_  > allout-encrypt-string (text decrypt allout-buffer key-type for-key
-;;;                                  fetch-pass &optional retried verifying
-;;;                                  passphrase)
-(defun allout-encrypt-string (text decrypt allout-buffer key-type for-key
-                                   fetch-pass &optional retried rejected
-                                   verifying passphrase)
+;;;_  > allout-encrypt-string (text decrypt allout-buffer keymode-cue
+;;;                                 &optional rejected)
+(defun allout-encrypt-string (text decrypt allout-buffer keymode-cue
+                                   &optional rejected)
   "Encrypt or decrypt message TEXT.
 
+Returns the resulting string, or nil if the transformation fails.
+
 If DECRYPT is true (default false), then decrypt instead of encrypt.
 
-FETCH-PASS (default false) forces fresh prompting for the passphrase.
-
-KEY-TYPE, either `symmetric' or `keypair', specifies which type
-of cypher to use.
-
-FOR-KEY is human readable identification of the first of the user's
-eligible secret keys a keypair decryption targets, or else nil.
-
-Optional RETRIED is for internal use -- conveys the number of failed keys
-that have been solicited in sequence leading to this current call.
-
-Optional PASSPHRASE enables explicit delivery of the decryption passphrase,
-for verification purposes.
-
-Optional REJECTED is for internal use -- conveys the number of
+ALLOUT-BUFFER identifies the buffer containing the text.
+
+Entry encryption defaults to symmetric key mode unless keypair
+recipients are associated with the file \(see
+`epa-file-encrypt-to') or the function is invoked with a
+\(KEYMODE-CUE) universal argument greater than 1.
+
+When encrypting, KEYMODE-CUE universal argument greater than 1
+causes prompting for recipients for public-key keypair
+encryption.  Selecting no recipients results in symmetric key
+encryption.
+
+Further, encrypting with a KEYMODE-CUE universal argument greater
+than 4 - eg, preceded by a doubled Ctrl-U - causes association of
+the specified recipients with the file, replacing those currently
+associated with it.  This can be used to deassociate any
+recipients with the file, by selecting no recipients in the
+dialog.
+
+Optional REJECTED is for internal use, to convey the number of
 rejections due to matches against
 `allout-encryption-ciphertext-rejection-regexps', as limited by
 `allout-encryption-ciphertext-rejection-ceiling'.
 
-Returns the resulting string, or nil if the transformation fails."
-
-  (require 'pgg)
-
-  (if (not (fboundp 'pgg-encrypt-symmetric))
-      (error "Allout encryption depends on a newer version of pgg"))
-
-  (let* ((scheme (upcase
-                  (format "%s" (or pgg-scheme pgg-default-scheme "GPG"))))
-         (for-key (and (equal key-type 'keypair)
-                       (or for-key
-                           (split-string (read-string
-                                          (format "%s message recipients: "
-                                                  scheme))
-                                         "[ \t,]+"))))
-         (target-prompt-id (if (equal key-type 'keypair)
-                               (if (= (length for-key) 1)
-                                   (car for-key) for-key)
-                             (buffer-name allout-buffer)))
-         (target-cache-id (format "%s-%s"
-                                  key-type
-                                  (if (equal key-type 'keypair)
-                                      target-prompt-id
-                                    (or (buffer-file-name allout-buffer)
-                                        target-prompt-id))))
+PROBLEM: Attempting symmetric decryption with an incorrect key
+not only fails, but for some GnuPG v2 versions the incorrect key
+is apparently retained in the gpg cache and reused, preventing
+decryption, until the cache finally times out.  That can take
+several minutes.  \(Decryption of other entries is not affected.)
+To clear this problem before the cache times out, deliberately
+clear your gpg-agent's cache by sending it a '-HUP' signal."
+
+  (require 'epg)
+  (require 'epa)
+
+  (let* ((epg-context (let* ((context (epg-make-context nil t)))
+                        (epg-context-set-passphrase-callback
+                         context #'epa-passphrase-callback-function)
+                        context))
          (encoding (with-current-buffer allout-buffer
                      buffer-file-coding-system))
          (multibyte (with-current-buffer allout-buffer
-                     enable-multibyte-characters))
-         (strip-plaintext-regexps
-          (if (not decrypt)
-              (allout-get-configvar-values
-               'allout-encryption-plaintext-sanitization-regexps)))
-         (reject-ciphertext-regexps
-          (if (not decrypt)
-              (allout-get-configvar-values
-               'allout-encryption-ciphertext-rejection-regexps)))
+                      enable-multibyte-characters))
+         ;; "sanitization" avoids encryption results that are outline 
structure.
+         (sani-regexps 'allout-encryption-plaintext-sanitization-regexps)
+         (strip-plaintext-regexps (if (not decrypt)
+                                      (allout-get-configvar-values
+                                       sani-regexps)))
+         (rejection-regexps 'allout-encryption-ciphertext-rejection-regexps)
+         (reject-ciphertext-regexps (if (not decrypt)
+                                        (allout-get-configvar-values
+                                         rejection-regexps)))
          (rejected (or rejected 0))
          (rejections-left (- allout-encryption-ciphertext-rejection-ceiling
                              rejected))
-         result-text status
+         (keypair-mode (cond (decrypt 'decrypting)
+                             ((<= (prefix-numeric-value keymode-cue) 1)
+                              'default)
+                             ((<= (prefix-numeric-value keymode-cue) 4)
+                              'prompt)
+                             ((> (prefix-numeric-value keymode-cue) 4)
+                              'prompt-save)))
+         (keypair-message (concat "Select encryption recipients.\n"
+                                  "Symmetric encryption is done if no"
+                                  " recipients are selected.  "))
+         (encrypt-to (and (boundp 'epa-file-encrypt-to) epa-file-encrypt-to))
+         recipients
+         massaged-text
+         result-text
          )
 
-    (if (and fetch-pass (not passphrase))
-        ;; Force later fetch by evicting passphrase from the cache.
-        (pgg-remove-passphrase-from-cache target-cache-id t))
-
-    (catch 'encryption-failed
-
-        ;; We handle only symmetric-key passphrase caching.
-        (if (and (not passphrase)
-                 (not (equal key-type 'keypair)))
-            (setq passphrase (allout-obtain-passphrase for-key
-                                                       target-cache-id
-                                                       target-prompt-id
-                                                       key-type
-                                                       allout-buffer
-                                                       retried fetch-pass)))
-
-        (with-temp-buffer
-
-          (insert text)
-
-          ;; convey the text characteristics of the original buffer:
-          (allout-set-buffer-multibyte multibyte)
-          (when encoding
-            (set-buffer-file-coding-system encoding)
-            (if (not decrypt)
-                (encode-coding-region (point-min) (point-max) encoding)))
-
-          (when (and strip-plaintext-regexps (not decrypt))
-            (dolist (re strip-plaintext-regexps)
-              (let ((re (if (listp re) (car re) re))
-                    (replacement (if (listp re) (cadr re) "")))
-                (goto-char (point-min))
-                (save-match-data
-                  (while (re-search-forward re nil t)
-                    (replace-match replacement nil nil))))))
-
-          (cond
-
-           ;; symmetric:
-           ((equal key-type 'symmetric)
-            (setq status
-                  (if decrypt
-
-                      (pgg-decrypt (point-min) (point-max) passphrase)
-
-                    (pgg-encrypt-symmetric (point-min) (point-max)
-                                           passphrase)))
-
-            (if status
-                (pgg-situate-output (point-min) (point-max))
-              ;; failed -- handle passphrase caching
-              (if verifying
-                  (throw 'encryption-failed nil)
-                (pgg-remove-passphrase-from-cache target-cache-id t)
-                (error "Symmetric-cipher %scryption failed -- %s"
-                       (if decrypt "de" "en")
-                       "try again with different passphrase"))))
-
-           ;; encrypt `keypair':
-           ((not decrypt)
-
-            (setq status
-
-                  (pgg-encrypt for-key
-                               nil (point-min) (point-max) passphrase))
-
-            (if status
-                (pgg-situate-output (point-min) (point-max))
-              (error (pgg-remove-passphrase-from-cache target-cache-id t)
-                     (error "encryption failed"))))
-
-           ;; decrypt `keypair':
-           (t
-
-            (setq status
-                  (pgg-decrypt (point-min) (point-max) passphrase))
-
-            (if status
-                (pgg-situate-output (point-min) (point-max))
-              (error (pgg-remove-passphrase-from-cache target-cache-id t)
-                     (error "decryption failed")))))
-
-          (setq result-text
-                (buffer-substring-no-properties
-                 1 (- (point-max) (if decrypt 0 1))))
-          )
-
-        ;; validate result -- non-empty
-        (cond ((not result-text)
-               (if verifying
-                   nil
-                 ;; transform was fruitless, retry w/new passphrase.
-                 (pgg-remove-passphrase-from-cache target-cache-id t)
-                 (allout-encrypt-string text decrypt allout-buffer
-                                        key-type for-key nil
-                                        (if retried (1+ retried) 1)
-                                        rejected verifying nil)))
-
-              ;; Retry (within limit) if ciphertext contains rejections:
-              ((and (not decrypt)
-                    ;; Check for disqualification of this ciphertext:
-                    (let ((regexps reject-ciphertext-regexps)
-                          reject-it)
-                      (while (and regexps (not reject-it))
-                        (setq reject-it (string-match (car regexps)
-                                                      result-text))
-                        (pop regexps))
-                      reject-it))
-               (setq rejections-left (1- rejections-left))
-               (if (<= rejections-left 0)
-                   (error (concat "Ciphertext rejected too many times"
-                                  " (%s), per `%s'")
-                          allout-encryption-ciphertext-rejection-ceiling
-                          'allout-encryption-ciphertext-rejection-regexps)
-                 (allout-encrypt-string text decrypt allout-buffer
-                                        key-type for-key nil
-                                        retried (1+ rejected)
-                                        verifying passphrase)))
-              ;; Barf if encryption yields extraordinary control chars:
-              ((and (not decrypt)
-                    (string-match "address@hidden"
-                                  result-text))
-               (error (concat "Encryption produced non-armored text, which"
-                              "conflicts with allout mode -- reconfigure!")))
-
-              ;; valid result and just verifying or non-symmetric:
-              ((or verifying (not (equal key-type 'symmetric)))
-               (if (or verifying decrypt)
-                   (pgg-add-passphrase-to-cache target-cache-id
-                                                passphrase t))
-               result-text)
-
-              ;; valid result and regular symmetric -- "register"
-              ;; passphrase with mnemonic aids/cache.
-              (t
-               (set-buffer allout-buffer)
-               (if passphrase
-                   (pgg-add-passphrase-to-cache target-cache-id
-                                                passphrase t))
-               (allout-update-passphrase-mnemonic-aids for-key passphrase
-                                                       allout-buffer)
-               result-text)
-              )
-        )
-    )
-  )
-;;;_  > allout-obtain-passphrase (for-key cache-id prompt-id key-type
-;;;                                       allout-buffer retried fetch-pass)
-(defun allout-obtain-passphrase (for-key cache-id prompt-id key-type
-                                         allout-buffer retried fetch-pass)
-  "Obtain passphrase for a key from the cache or else from the user.
-
-When obtaining from the user, symmetric-cipher passphrases are verified
-against either, if available and enabled, a random string that was
-encrypted against the passphrase, or else against repeated entry by the
-user for corroboration.
-
-FOR-KEY is the key for which the passphrase is being obtained.
-
-CACHE-ID is the cache id of the key for the passphrase.
-
-PROMPT-ID is the id for use when prompting the user.
-
-KEY-TYPE is either `symmetric' or `keypair'.
-
-ALLOUT-BUFFER is the buffer containing the entry being en/decrypted.
-
-RETRIED is the number of this attempt to obtain this passphrase.
-
-FETCH-PASS causes the passphrase to be solicited from the user, regardless
-of the availability of a cached copy."
-
-  (if (not (equal key-type 'symmetric))
-      ;; do regular passphrase read on non-symmetric passphrase:
-      (pgg-read-passphrase (format "%s passphrase%s: "
-                                   (upcase (format "%s" (or pgg-scheme
-                                                            pgg-default-scheme
-                                                            "GPG")))
-                                     (if prompt-id
-                                         (format " for %s" prompt-id)
-                                       ""))
-                           cache-id t)
-
-    ;; Symmetric hereon:
-
-    (with-current-buffer allout-buffer
-      (let* ((hint (if (and (not (string= allout-passphrase-hint-string ""))
-                            (or (equal allout-passphrase-hint-handling 'always)
-                                (and (equal allout-passphrase-hint-handling
-                                            'needed)
-                                     retried)))
-                       (format " [%s]" allout-passphrase-hint-string)
-                     ""))
-             (retry-message (if retried (format " (%s retry)" retried) ""))
-             (prompt-sans-hint (format "'%s' symmetric passphrase%s: "
-                                       prompt-id retry-message))
-             (full-prompt (format "'%s' symmetric passphrase%s%s: "
-                                  prompt-id hint retry-message))
-             (prompt full-prompt)
-             (verifier-string (allout-get-encryption-passphrase-verifier))
-
-             (cached (and (not fetch-pass)
-                          (pgg-read-passphrase-from-cache cache-id t)))
-             (got-pass (or cached
-                           (pgg-read-passphrase full-prompt cache-id t)))
-             confirmation)
-
-        (if (not got-pass)
-            nil
-
-          ;; Duplicate our handle on the passphrase so it's not clobbered by
-          ;; deactivate-passwd memory clearing:
-          (setq got-pass (copy-sequence got-pass))
-
-          (cond (verifier-string
-                 (save-window-excursion
-                   (if (allout-encrypt-string verifier-string 'decrypt
-                                              allout-buffer 'symmetric
-                                              for-key nil 0 0 'verifying
-                                              (copy-sequence got-pass))
-                       (setq confirmation (format "%s" got-pass))))
-
-                 (if (and (not confirmation)
-                          (if (yes-or-no-p
-                               (concat "Passphrase differs from established"
-                                       " -- use new one instead? "))
-                              ;; deactivate password for subsequent
-                              ;; confirmation:
-                              (progn
-                                (pgg-remove-passphrase-from-cache cache-id t)
-                                (setq prompt prompt-sans-hint)
-                                nil)
-                            t))
-                     (progn (pgg-remove-passphrase-from-cache cache-id t)
-                            (error "Wrong passphrase"))))
-                ;; No verifier string -- force confirmation by repetition of
-                ;; (new) passphrase:
-                ((or fetch-pass (not cached))
-                 (pgg-remove-passphrase-from-cache cache-id t))))
-        ;; confirmation vs new input -- doing pgg-read-passphrase will do the
-        ;; right thing, in either case:
-        (if (not confirmation)
-            (setq confirmation
-                  (pgg-read-passphrase (concat prompt
-                                               " ... confirm spelling: ")
-                                       cache-id t)))
-        (prog1
-            (if (equal got-pass confirmation)
-                confirmation
-              (if (yes-or-no-p (concat "spelling of original and"
-                                       " confirmation differ -- retry? "))
-                  (progn (setq retried (if retried (1+ retried) 1))
-                         (pgg-remove-passphrase-from-cache cache-id t)
-                         ;; recurse to this routine:
-                         (pgg-read-passphrase prompt-sans-hint cache-id t))
-                (pgg-remove-passphrase-from-cache cache-id t)
-                (error "Confirmation failed"))))))))
+    ;; Massage the subject text for encoding and filtering.
+    (with-temp-buffer
+      (insert text)
+      ;; convey the text characteristics of the original buffer:
+      (allout-set-buffer-multibyte multibyte)
+      (when encoding
+        (set-buffer-file-coding-system encoding)
+        (if (not decrypt)
+            (encode-coding-region (point-min) (point-max) encoding)))
+
+      ;; remove sanitization regexps matches before encrypting:
+      (when (and strip-plaintext-regexps (not decrypt))
+        (dolist (re strip-plaintext-regexps)
+          (let ((re (if (listp re) (car re) re))
+                (replacement (if (listp re) (cadr re) "")))
+            (goto-char (point-min))
+            (save-match-data
+              (while (re-search-forward re nil t)
+                (replace-match replacement nil nil))))))
+      (setq massaged-text (buffer-substring-no-properties (point-min)
+                                                          (point-max))))
+    ;; determine key mode and, if keypair, recipients:
+    (setq recipients
+          (case keypair-mode
+
+            (decrypting nil)
+
+            (default (if encrypt-to (epg-list-keys epg-context encrypt-to)))
+
+            ((prompt prompt-save)
+             (save-window-excursion
+               (epa-select-keys epg-context keypair-message)))))
+
+    (setq result-text
+          (if decrypt
+              (epg-decrypt-string epg-context
+                                  (encode-coding-string massaged-text
+                                                        (or encoding 'utf-8)))
+            (epg-encrypt-string epg-context
+                                (encode-coding-string massaged-text
+                                                      (or encoding 'utf-8))
+                                recipients)))
+
+    ;; validate result -- non-empty
+    (if (not result-text)
+        (error "%scryption failed." (if decrypt "De" "En")))
+
+
+    (when (eq keypair-mode 'prompt-save)
+      ;; set epa-file-encrypt-to in the buffer:
+      (setq epa-file-encrypt-to (mapcar (lambda (key)
+                                          (epg-user-id-string
+                                           (car (epg-key-user-id-list key))))
+                                        recipients))
+      ;; change the file variable:
+      (allout-adjust-file-variable "epa-file-encrypt-to" epa-file-encrypt-to))
+
+    (cond
+     ;; Retry (within limit) if ciphertext contains rejections:
+     ((and (not decrypt)
+           ;; Check for disqualification of this ciphertext:
+           (let ((regexps reject-ciphertext-regexps)
+                 reject-it)
+             (while (and regexps (not reject-it))
+               (setq reject-it (string-match (car regexps) result-text))
+               (pop regexps))
+             reject-it))
+      (setq rejections-left (1- rejections-left))
+      (if (<= rejections-left 0)
+          (error (concat "Ciphertext rejected too many times"
+                         " (%s), per `%s'")
+                 allout-encryption-ciphertext-rejection-ceiling
+                 'allout-encryption-ciphertext-rejection-regexps)
+        ;; try again (gpg-agent may have the key cached):
+        (allout-encrypt-string text decrypt allout-buffer keypair-mode
+                               (1+ rejected))))
+
+     ;; Barf if encryption yields extraordinary control chars:
+     ((and (not decrypt)
+           (string-match "address@hidden"
+                         result-text))
+      (error (concat "Encryption produced non-armored text, which"
+                     "conflicts with allout mode -- reconfigure!")))
+
+     (t result-text))))
 ;;;_  > allout-encrypted-topic-p ()
 (defun allout-encrypted-topic-p ()
   "True if the current topic is encryptable and encrypted."
@@ -6527,129 +6316,6 @@
          (save-match-data (looking-at "\\*")))
     )
   )
-;;;_  > allout-encrypted-key-info (text)
-;; XXX gpg-specific, alas
-(defun allout-encrypted-key-info (text)
-  "Return a pair of the key type and identity of a recipient's secret key.
-
-The key type is one of `symmetric' or `keypair'.
-
-If `keypair', and some of the user's secret keys are among those for which
-the message was encoded, return the identity of the first.  Otherwise,
-return nil for the second item of the pair.
-
-An error is raised if the text is not encrypted."
-  (require 'pgg-parse)
-  (save-excursion
-    (with-temp-buffer
-      (insert text)
-      (let* ((parsed-armor (pgg-parse-armor-region (point-min) (point-max)))
-             ;; pgg-gpg-symmetric-key-p has lost track.
-             (type (if (assq 'symmetric-key-algorithm (car (cdr parsed-armor)))
-                       'symmetric
-                     'keypair))
-             secret-keys first-secret-key for-key-owner)
-        (if (equal type 'keypair)
-            (setq secret-keys (pgg-gpg-lookup-all-secret-keys)
-                  first-secret-key (pgg-gpg-select-matching-key parsed-armor
-                                                                secret-keys)
-                  for-key-owner (and first-secret-key
-                                     (pgg-gpg-lookup-key-owner
-                                      first-secret-key))))
-        (list type (pgg-gpg-key-id-from-key-owner for-key-owner))
-        )
-      )
-    )
-  )
-;;;_  > allout-create-encryption-passphrase-verifier (passphrase)
-(defun allout-create-encryption-passphrase-verifier (passphrase)
-  "Encrypt random message for later validation of symmetric key's passphrase."
-  ;; use 20 random ascii characters, across the entire ascii range.
-  (random t)
-  (let ((spew (make-string 20 ?\0)))
-    (dotimes (i (length spew))
-      (aset spew i (1+ (random 254))))
-    (allout-encrypt-string spew nil (current-buffer) 'symmetric
-                           nil nil 0 0 passphrase))
-  )
-;;;_  > allout-update-passphrase-mnemonic-aids (for-key passphrase
-;;;                                                     outline-buffer)
-(defun allout-update-passphrase-mnemonic-aids (for-key passphrase
-                                                       outline-buffer)
-  "Update passphrase verifier and hint strings if necessary.
-
-See `allout-passphrase-verifier-string' and `allout-passphrase-hint-string'
-settings.
-
-PASSPHRASE is the passphrase being mnemonicized.
-
-OUTLINE-BUFFER is the buffer of the outline being adjusted.
-
-These are used to help the user keep track of the passphrase they use for
-symmetric encryption in the file.
-
-Behavior is governed by `allout-passphrase-verifier-handling',
-`allout-passphrase-hint-handling', and also, controlling whether the values
-are preserved on Emacs local file variables,
-`allout-enable-file-variable-adjustment'."
-
-  ;; If passphrase doesn't agree with current verifier:
-  ;;   - adjust the verifier
-  ;;   - if passphrase hint handling is enabled, adjust the passphrase hint
-  ;;   - if file var settings are enabled, adjust the file vars
-
-  (let* ((new-verifier-needed (not (allout-verify-passphrase
-                                    for-key passphrase outline-buffer)))
-         (new-verifier-string
-          (if new-verifier-needed
-              ;; Collapse to a single line and enclose in string quotes:
-              (subst-char-in-string
-               ?\n ?\C-a (allout-create-encryption-passphrase-verifier
-                          passphrase))))
-         new-hint)
-    (when new-verifier-string
-      ;; do the passphrase hint first, since it's interactive
-      (when (and allout-passphrase-hint-handling
-                 (not (equal allout-passphrase-hint-handling 'disabled)))
-        (setq new-hint
-              (read-from-minibuffer "Passphrase hint to jog your memory: "
-                                    allout-passphrase-hint-string))
-        (when (not (string= new-hint allout-passphrase-hint-string))
-          (setq allout-passphrase-hint-string new-hint)
-          (allout-adjust-file-variable "allout-passphrase-hint-string"
-                                       allout-passphrase-hint-string)))
-      (when allout-passphrase-verifier-handling
-        (setq allout-passphrase-verifier-string new-verifier-string)
-        (allout-adjust-file-variable "allout-passphrase-verifier-string"
-                                     allout-passphrase-verifier-string))
-      )
-    )
-  )
-;;;_  > allout-get-encryption-passphrase-verifier ()
-(defun allout-get-encryption-passphrase-verifier ()
-  "Return text of the encrypt passphrase verifier, unmassaged, or nil if none.
-
-Derived from value of `allout-passphrase-verifier-string'."
-
-  (let ((verifier-string (and (boundp 'allout-passphrase-verifier-string)
-                              allout-passphrase-verifier-string)))
-    (if verifier-string
-        ;; Return it uncollapsed
-        (subst-char-in-string ?\C-a ?\n verifier-string))
-   )
-  )
-;;;_  > allout-verify-passphrase (key passphrase allout-buffer)
-(defun allout-verify-passphrase (key passphrase allout-buffer)
-  "True if passphrase successfully decrypts verifier, nil otherwise.
-
-\"Otherwise\" includes absence of passphrase verifier."
-  (with-current-buffer allout-buffer
-    (and (boundp 'allout-passphrase-verifier-string)
-         allout-passphrase-verifier-string
-         (allout-encrypt-string (allout-get-encryption-passphrase-verifier)
-                                 'decrypt allout-buffer 'symmetric
-                                 key nil 0 0 'verifying passphrase)
-         t)))
 ;;;_  > allout-next-topic-pending-encryption (&optional except-mark)
 (defun allout-next-topic-pending-encryption (&optional except-mark)
   "Return the point of the next topic pending encryption, or nil if none.


reply via email to

[Prev in Thread] Current Thread [Next in Thread]