branch: externals/autocrypt
commit cb40022cba2a9a9f677ba8fd36ffde4d2477f91b
Author: Philip K <[email protected]>
Commit: Philip K <[email protected]>
refactored message specific code into autocrypt-compose-* functions
---
autocrypt-message.el | 98 ++++++++++++++--------------------------------------
autocrypt.el | 72 +++++++++++++++++++++++++++++++++++++-
2 files changed, 96 insertions(+), 74 deletions(-)
diff --git a/autocrypt-message.el b/autocrypt-message.el
index 41926caa8d..012d9d1f12 100644
--- a/autocrypt-message.el
+++ b/autocrypt-message.el
@@ -28,82 +28,34 @@
;;;###autoload
(defun autocrypt-message-install ()
"Install autocrypt hooks for message mode."
- (add-hook 'message-setup-hook #'autocrypt-message-setup)
- (add-hook 'message-send-hook #'autocrypt-message-pre-send)
- (define-key message-mode-map (kbd "C-c RET C-a") #'autocrypt-message-setup))
+ (add-hook 'message-setup-hook #'autocrypt-compose-setup)
+ (add-hook 'message-send-hook #'autocrypt-compose-pre-send)
+ (unless (lookup-key message-mode-map (kbd "C-c RET C-a"))
+ (define-key message-mode-map (kbd "C-c RET C-a")
#'autocrypt-message-setup)))
(defun autocrypt-message-uninstall ()
"Remove autocrypt hooks for message mode."
- (remove-hook 'message-setup-hook #'autocrypt-message-setup)
- (remove-hook 'message-send-hook #'autocrypt-message-pre-send)
- (define-key message-mode-map (kbd "C-c RET C-a") nil))
-
-;; https://autocrypt.org/level1.html#key-gossip-injection-in-outbound-messages
-(defun autocrypt-message-gossip-p (recipients)
- "Find out if the current message should have gossip headers.
-Argument RECIPIENTS is a list of addresses this message is
-addressed to."
- (and (mml-secure-is-encrypted-p)
- (< 1 (length recipients))
- (cl-every
- (lambda (rec)
- (let ((peer (cdr (assoc rec autocrypt-peers))))
- (and peer (not (autocrypt-peer-deactivated peer)))))
- recipients)))
-
-(defun autocrypt-message-setup ()
- "Check if Autocrypt is possible, and add pseudo headers."
- (interactive)
- (let ((recs (autocrypt-list-recipients))
- (from (autocrypt-canonicalise (message-field-value "from"))))
- ;; encrypt message if applicable
- (save-excursion
- (cl-case (autocrypt-recommendation from recs)
- (encrypt
- (mml-secure-message-sign-encrypt "pgpmime"))
- (available
- (message-add-header "Do-Autocrypt: no"))
- (discourage
- (message-add-header "Do-Discouraged-Autocrypt: no"))))))
-
-(defun autocrypt-message-pre-send ()
- "Insert Autocrypt headers before sending a message.
-
-Will handle and remove \"Do-(Discourage-)Autocrypt\" if found."
- (let* ((recs (autocrypt-list-recipients))
- (from (autocrypt-canonicalise (message-field-value "from"))))
- ;; encrypt message if applicable
- (when (eq (autocrypt-recommendation from recs) 'encrypt)
- (mml-secure-message-sign-encrypt "pgpmime"))
- ;; check for manual autocrypt confirmations
- (let ((do-autocrypt (message-fetch-field "Do-Autocrypt"))
- (ddo-autocrypt (message-fetch-field "Do-Discouraged-Autocrypt"))
- (query "Are you sure you want to use Autocrypt, even though it is
discouraged?"))
- (when (and (not (mml-secure-is-encrypted-p))
- (or (and do-autocrypt
- (string= (downcase do-autocrypt) "yes"))
- (and ddo-autocrypt
- (string= (downcase ddo-autocrypt) "yes")
- (yes-or-no-p query))))
- (mml-secure-message-sign-encrypt "pgpmime")))
- (message-remove-header "Do-Autocrypt")
- (message-remove-header "Do-Discouraged-Autocrypt")
- ;; insert gossip data
- (when (autocrypt-message-gossip-p recs)
- (let ((buf (generate-new-buffer " *autocrypt gossip*")))
- (with-current-buffer buf
- (dolist (addr (autocrypt-list-recipients))
- (let ((header (autocrypt-generate-header addr t)))
- (insert "Autocrypt-Gossip: " header "\n"))))
- (mml-attach-buffer buf)
- (mml-secure-part "pgpmime")
- (add-hook 'message-send-hook
- (lambda () (kill-buffer buf))
- nil t)))
- ;; insert autocrypt header
- (let ((header (and from (autocrypt-generate-header from))))
- (when header
- (message-add-header (concat "Autocrypt: " header))))))
+ (remove-hook 'message-setup-hook #'autocrypt-compose-setup)
+ (remove-hook 'message-send-hook #'autocrypt-compose-pre-send)
+ (when (eq (lookup-key message-mode-map (kbd "C-c RET C-a"))
+ #'autocrypt-message-setup)
+ (define-key message-mode-map (kbd "C-c RET C-a") nil)))
+
+(defun autocrypt-message-add-header (key val)
+ "Insert header with key KEY and value VAL into message head."
+ (message-add-header (concat key ": " val)))
+
+(defun autocrypt-message-sign-encrypt ()
+ "Sign and encrypt message."
+ (mml-secure-message-sign-encrypt "pgpmime"))
+
+(defun autocrypt-message-secure-attach (payload)
+ "Attach and encrypt buffer PAYLOAD."
+ (mml-attach-buffer payload)
+ (mml-secure-part "pgpmime")
+ (add-hook 'message-send-hook
+ (lambda () (kill-buffer payload))
+ nil t))
(provide 'autocrypt-message)
diff --git a/autocrypt.el b/autocrypt.el
index 713e27264f..112e4e1f6d 100644
--- a/autocrypt.el
+++ b/autocrypt.el
@@ -121,7 +121,12 @@ Every member of this list has to be an instance of the
(message
:install autocrypt-message-install
:uninstall autocrypt-message-uninstall
- :header message-fetch-field))
+ :header message-fetch-field
+ :add-header autocrypt-message-add-header
+ :remove-header message-remove-header
+ :sign-encrypt autocrypt-message-sign-encrypt
+ :secure-attach autocrypt-message-secure-attach
+ :encrypted-p mml-secure-is-encrypted-p))
"Alist for all MUA specific functions.
The value of each record is a plist. The value of each property
@@ -409,6 +414,71 @@ preference (\"prefer-encrypt\")."
(and (< (buffer-size) (* 10 1024))
(buffer-string))))))
+(defun autocrypt-gossip-p (recipients)
+ "Find out if the current message should have gossip headers.
+Argument RECIPIENTS is a list of addresses this message is
+addressed to."
+ (and (autocrypt-mua-call :encrypted-p)
+ (< 1 (length recipients))
+ (cl-every
+ (lambda (rec)
+ (let ((peer (cdr (assoc rec autocrypt-peers))))
+ (and peer (not (autocrypt-peer-deactivated peer)))))
+ recipients)))
+
+(defun autocrypt-compose-setup ()
+ "Check if Autocrypt is possible, and add pseudo headers."
+ (interactive)
+ (let ((recs (autocrypt-list-recipients))
+ (can-remove (autocrypt-mua-func :remove-header))
+ (from (autocrypt-canonicalise (autocrypt-mua-call :header "From"))))
+ ;; encrypt message if applicable
+ (save-excursion
+ (cl-case (autocrypt-recommendation from recs)
+ (encrypt
+ (autocrypt-mua-call :sign-encrypt))
+ (available
+ (when can-remove
+ (autocrypt-mua-call :add-header "Do-Autocrypt" "no")))
+ (discourage
+ (when can-remove
+ (autocrypt-mua-call :add-header "Do-Discouraged-Autocrypt"
"no")))))))
+
+(defun autocrypt-compose-pre-send ()
+ "Insert Autocrypt headers before sending a message.
+
+Will handle and remove \"Do-(Discourage-)Autocrypt\" if found."
+ (let* ((recs (autocrypt-list-recipients))
+ (from (autocrypt-canonicalise (autocrypt-mua-call :header "From"))))
+ ;; encrypt message if applicable
+ (when (eq (autocrypt-recommendation from recs) 'encrypt)
+ (autocrypt-mua-call :sign-encrypt))
+ ;; check for manual autocrypt confirmations
+ (let ((do-autocrypt (autocrypt-mua-call :header "Do-Autocrypt"))
+ (ddo-autocrypt (autocrypt-mua-call :header
"Do-Discouraged-Autocrypt"))
+ (query "Are you sure you want to use Autocrypt, even though it is
discouraged?"))
+ (when (and (not (autocrypt-mua-call :encrypted-p))
+ (or (and do-autocrypt
+ (string= (downcase do-autocrypt) "yes"))
+ (and ddo-autocrypt
+ (string= (downcase ddo-autocrypt) "yes")
+ (yes-or-no-p query))))
+ (autocrypt-mua-call :sign-encrypt)))
+ (autocrypt-mua-call :remove-header "Do-Autocrypt")
+ (autocrypt-mua-call :remove-header "Do-Discouraged-Autocrypt")
+ ;; insert gossip data
+ (when (autocrypt-gossip-p recs)
+ (let ((payload (generate-new-buffer " *autocrypt gossip*")))
+ (with-current-buffer payload
+ (dolist (addr (autocrypt-list-recipients))
+ (let ((header (autocrypt-generate-header addr t)))
+ (insert "Autocrypt-Gossip: " header "\n"))))
+ (autocrypt-mua-call :secure-attach payload)))
+ ;; insert autocrypt header
+ (let ((header (and from (autocrypt-generate-header from))))
+ (when header
+ (autocrypt-mua-call :add-header "Autocrypt" header)))))
+
(defun autocrypt-create-account ()
"Create a GPG key for Autocrypt."
(interactive)
