diff --git a/emacs/notmuch-mua.el b/emacs/notmuch-mua.el index 72fb7705..c5671731 100644 --- a/emacs/notmuch-mua.el +++ b/emacs/notmuch-mua.el @@ -490,12 +490,56 @@ will be addressed to all recipients of the source message." (notmuch-mua-reply query-string sender reply-all) (deactivate-mark))) +(defun notmuch-mua-check-no-misplaced-secure-tag () + "Query user if there is a misplaced secure mml tag. + +Emacs message-send will (probably) ignore a secure mml tag unless +it is at the start of the body. Returns t if there is no such +tag, or the user confirms they mean it." + (save-excursion + (let ((body-start (progn (message-goto-body) (point)))) + (goto-char (point-max)) + (or + ;; We are always fine if there is no secure tag. + (not (search-backward "<#secure" nil 't)) + ;; There is a secure tag, so it must be at the start of the + ;; body, with no secure tag earlier (i.e., in the headers). + (and (= (point) body-start) + (not (search-backward "<#secure" nil 't))) + ;; The user confirms they means it. + (yes-or-no-p "\ +There is a <#secure> tag not at the start of the body. It is +likely that the message will be sent unsigned and unencrypted. +Really send? "))))) + +(defun notmuch-mua-check-secure-tag-has-newline () + "Query if the secure mml tag has a newline following it. + +Emacs message-send will (probably) ignore a correctly placed +secure mml tag unless it is followed by a newline. Returns t if +any secure tag is followed by a newline, or the user confirms +they mean it." + (save-excursion + (message-goto-body) + (or + ;; There is no (correctly placed) secure tag. + (not (looking-at "<#secure")) + ;; The secure tag is followed by a newline. + (looking-at "<#secure[^\n>]*>\n") + ;; The user confirms they means it. + (yes-or-no-p "\ +The <#secure> tag at the start of the body is not followed by a +newline. It is likely that the message will be sent unsigned and +unencrypted. Really send? ")))) + (defun notmuch-mua-send-common (arg &optional exit) (interactive "P") - (letf (((symbol-function 'message-do-fcc) #'notmuch-maildir-message-do-fcc)) - (if exit - (message-send-and-exit arg) - (message-send arg)))) + (when (and (notmuch-mua-check-no-misplaced-secure-tag) + (notmuch-mua-check-secure-tag-has-newline)) + (letf (((symbol-function 'message-do-fcc) #'notmuch-maildir-message-do-fcc)) + (if exit + (message-send-and-exit arg) + (message-send arg))))) (defun notmuch-mua-send-and-exit (&optional arg) (interactive "P")