Function: allout-encrypt-string
allout-encrypt-string is a byte-compiled function defined in
allout.el.gz.
Signature
(allout-encrypt-string TEXT DECRYPT ALLOUT-BUFFER KEYMODE-CUE &optional REJECTED)
Documentation
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.
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 dissociate 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.
NOTE: A few GnuPG v2 versions improperly preserve incorrect
symmetric decryption keys, preventing entry of the correct key on
subsequent decryption attempts until the cache times-out. That
can take several minutes. (Decryption of other entries is not
affected.) Upgrade your EasyPG version, if you can, and you can
deliberately clear your gpg-agent's cache by sending it a -HUP
signal.
Source Code
;; Defined in /usr/src/emacs/lisp/allout.el.gz
;;;_ > 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.
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 dissociate 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'.
NOTE: A few GnuPG v2 versions improperly preserve incorrect
symmetric decryption keys, preventing entry of the correct key on
subsequent decryption attempts until the cache times-out. That
can take several minutes. (Decryption of other entries is not
affected.) Upgrade your EasyPG version, if you can, and you can
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))
;; "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))
(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
)
;; Massage the subject text for encoding and filtering.
(with-temp-buffer
(insert text)
;; convey the text characteristics of the original buffer:
(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
(pcase keypair-mode
('decrypting nil)
('default (if encrypt-to (epg-list-keys epg-context encrypt-to)))
((or 'prompt 'prompt-save)
(save-window-excursion
(epa-select-keys epg-context keypair-message)))))
(setq result-text
(if decrypt
(condition-case err
(epg-decrypt-string epg-context
(encode-coding-string massaged-text
(or encoding 'utf-8)))
(epg-error
(signal 'egp-error
(cons (concat (cadr err) " - gpg version problem?")
(cddr err)))))
(replace-regexp-in-string "\n$" ""
(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 "[\C-a\C-k\C-o-\C-z\C-@]"
result-text))
(error (concat "Encryption produced non-armored text, which"
"conflicts with allout mode -- reconfigure!")))
(t result-text))))