async email sending in emacs (mu4e)

mu4e-pimped.el

(require 'advice-tools)
(require 'mu4e)
(require 'mu4e-main)
(require 'cl-lib)
(require 'alert)
(require 'dash)
(require 'bui)
(require 's)

(defun mu4e-pimped-set-mail-send-funcs (async-sending)
  "If ASYNC-SENDING is non-nil, then overwrite send-mail functions."
  (if async-sending
      (progn
        (setq send-mail-function 'mu4e-pimped-send-mail-async
              message-send-mail-function 'mu4e-pimped-send-mail-async)
        (advice-tools/advice-add-if-def
         #'mu4e--main-queue-size
         :override #'mu4e-pimped--num-queued-emails)
        (advice-tools/advice-add-if-def
         #'smtpmail-send-queued-mail
         :override #'mu4e-pimped--flush-queued-emails))
    ;; restore original function and uninstall advice
    (setq send-mail-function 'sendmail-query-once
          message-send-mail-function 'smtpmail-send-it)
    (advice-tools/advice-unadvice #'mu4e--main-queue-size)
    (advice-tools/advice-unadvice #'smtpmail-send-queued-mail)))

(defun mu4e-pimped--set-mail-async (key value)
  "Set function for setting customation option `mu4e-pimped-use-async-send-mail'.

Sets KEY to VALUE. This function also installs advice and sets
 `send-mail-function' to use async database-backed mail sending."
  (set-default-toplevel-value key value)
  (mu4e-pimped-set-mail-send-funcs value))

(defcustom mu4e-pimped-use-async-send-mail
  nil
  "If non-nil, then send mail asynchronously.

This uses the async package, but to avoid loosing mail when
sending fails, mail information is stored in an SQLite database."
  :group 'mu4e-pimped
  :set #'mu4e-pimped--set-mail-async
  :require 'mu4e-pimped
  :type 'boolean)

(defconst mu4e-pimped-send-mail-sqlite-db
  "send-mail.db"
  "This SQLite database in the user .emacs.d directory stores mail to send.")

(defun mu4e-pimped-redraw-mu4e-main-if-need-be ()
  "If the current buffer is the mu4e main view, then refresh it."
  (when (string-equal (buffer-name (current-buffer)) mu4e-main-buffer-name)
	(mu4e~main-redraw-buffer)))


(defun mu4e-pimped--get-send-mail-db ()
  "Return SQlite file storing send mail database."
  (expand-file-name mu4e-pimped-send-mail-sqlite-db user-emacs-directory))

(defmacro mu4e-pimped--with-send-db (&rest body)
  "Locally bind `db' to the database for send mail and execute BODY."
  `(let ((db (sqlite-open (mu4e-pimped--get-send-mail-db))))
     (unless (sqlite-available-p)
       (error "Cannot send email async if Emacs is not build with support for
sqlite"))
     (unless (sqlitep db)
       (error "Cannot open sqlitedb storing emails: %s" 
              (mu4e-pimped--get-send-mail-db)))
     ,@body))

(defun mu4e-pimped--store-email (content)
  "Store email CONTENT as a message in sqlite db.

This function returns a plist with the emails date: an sha1 hash
of the content and the content. If the email
already exists, then just return plist without modifying the
database."
  (mu4e-pimped--with-send-db
   (let ((hash (sha1 content)))
     (sqlite-execute db "CREATE TABLE IF NOT EXISTS emails (hash VARCHAR PRIMARY
 KEY, content VARCHAR, ts VARCHAR, error VARCHAR);")
     (unless (sqlite-select db "SELECT * FROM emails WHERE hash = ?;" `(,hash))
       (sqlite-execute db "INSERT INTO emails VALUES (?, ?, datetime(), NULL);"
                       `(,hash ,content)))
     `(:hash ,hash :content ,content))))

(defun mu4e-pimped--get-email-hash (content)
  "Calculate a sha1 hash for email CONTENT."
  (sha1 content))

(defun mu4e-pimped--delete-email (hash)
  "Delete email with HASH of its content from sqlite db."
  (mu4e-pimped--with-send-db
   (sqlite-execute db "DELETE FROM emails WHERE hash = ?;" `(,hash))))

(defun mu4e-pimped--store-email-error (hash emsg)
  "Set error message EMSG for email with hash HASH."
  (mu4e-pimped--with-send-db
   (sqlite-execute db "UPDATE emails SET error = ? WHERE hash = ?;" 
                   `(,hash ,emsg))))

(defun mu4e-pimped--get-queued-emails ()
  "Get all email queued in sqlite db that have not been send yet."
  (mu4e-pimped--with-send-db
   (--map `(:hash ,(car it)
                  :content ,(cadr it)
                  :ts ,(caddr it)
                  :error ,(cadddr it))
          (sqlite-select db "SELECT * FROM emails ORDER BY ts ASC;"))))

(defun mu4e-pimped--num-queued-emails ()
  "Determine how many emails are currently queued."
  (mu4e-pimped--with-send-db
   (let ((res (sqlite-select db "SELECT count(*) FROM emails;")))
     (if res (caar res) 0))))

(defun mu4e-pimped--flush-queued-emails ()
  "Send emails that did not end up geeting send.

Loops over emails stored in sqlite database that where supposed
to be send but did not end up being send and try to send them."
  (dolist (e (mu4e-pimped--get-queued-emails))
    (message "trying to flush %s" (mu4e-pimped--email-to-string e))
    (with-temp-buffer
      (insert (plist-get e :content))
      (mu4e-pimped--send-a-mail-async (current-buffer) t))))

(defun mu4e-pimped--email-to-string (e)
  "Create a human friendly text representations of email E."
  (let ((email (mu4e-pimped--queued-mail-entry e)))
    (cl-destructuring-bind (&key to from subject date &allow-other-keys) email
      (concat
       "to: " to
       " from: " from
       " subject: " (substring subject 0 100)
       " date: " date))))

(defun mu4e-pimped-send-mail-async ()
  "Send email from current buffer asynchronously.

Outgoing emails are recorded in a sqlite db to be able to recover
from failures."
  (mu4e-pimped--send-a-mail-async (current-buffer)))

(defun mu4e-pimped--send-a-mail-async (buf &optional force)
  "Send mail from BUF asynchronously.

State is maintained in a SQLite db to be able to recover from
failures to send the email. If FORCE is provided, then always try
sending the email even if `smtpmail-queue-mail' is non-nil."
  (with-current-buffer buf
    (let* ((to (message-field-value "To"))
           (buf-content (buffer-substring-no-properties
                         (point-min) (point-max)))
           (dbentry (mu4e-pimped--store-email buf-content))
           (hash (plist-get dbentry :hash))
           (dosend (or force (not smtpmail-queue-mail)))
           (smtpmail-queue-mail nil))
      ;; only try sending if we have not queued
      (when dosend
        ;; start other emacs that does the sending
        (async-start
         ;; async lambda to send email and
         `(lambda ()
            (require 'smtpmail)
            (with-temp-buffer
              (insert ,buf-content)
              (set-buffer-multibyte nil)
              ;; Pass in the variable environment for smtpmail
              ,(async-inject-variables
                "\\`\\(smtpmail\\|async-smtpmail\\|\\(user-\\)?mail\\)\
-\\|auth-sources\\|epg\\|nsm"
                nil
                "\\`\\(mail-header-format-function\\|smtpmail-address-buffer\
\\|mail-mode-abbrev-table\\)")
              (run-hooks 'async-smtpmail-before-send-hook)
              (condition-case
                  e
                  (progn
                    ;; actually send email
                    (smtpmail-send-it)
                    (with-temp-buffer
                      (insert "\n================================================================================\nsuccess!\n\n")
                      (append-to-file (point-min) (point-max) "~/emailoutput"))
                    ;; if no error, then delete email
                    (let ((db (sqlite-open ,(mu4e-pimped--get-send-mail-db))))
                      (unless (sqlite-available-p)
                        (error "Cannot send email async if Emacs is not build 
with support for sqlite"))
                      (unless (sqlitep db)
                        (error "Cannot open sqlitedb storing emails: %s" 
                               ,(mu4e-pimped--get-send-mail-db)))
                      (with-temp-buffer
                        (insert "opened DB!\n\n")
                        (insert (format "write hash %s" ,hash))
                        (append-to-file (point-min) (point-max) "~/emailoutput"))
                      (sqlite-execute db "DELETE FROM emails WHERE hash = ?;" 
                                      (list ,hash)))
                    ;; return nil on success, but sleep to make sure email is
                    ;; deleted before we return
                    (sleep-for 0 500)
                    nil)
                ('error
                 (let ((db (sqlite-open ,(mu4e-pimped--get-send-mail-db))))
                   (unless (sqlite-available-p)
                     (error "Cannot send email async if Emacs is not build with
 support forsqlite"))
                   (unless (sqlitep db)
                     (error "Cannot open sqlitedb storing emails: %s" 
                            ,(mu4e-pimped--get-send-mail-db)))
                   (with-temp-buffer
                     (insert (format "error %s\n\n" (error-message-string e)))
                     (append-to-file (point-min) (point-max) "~/emailoutput"))
                   (sqlite-execute db 
                                   "UPDATE emails SET error = ? WHERE hash = ?;" 
                                   (list  (error-message-string e) ,hash)))))))
         ;; determine success and
         (lambda (&optional msg)
           (if msg
               (message "Delivering message to %s...failed:\n\n%s"
                        to
                        msg)
             (message "Delivering message to %s...done" to))
           (mu4e-pimped-redraw-mu4e-main-if-need-be)))))))

;; bui list of unsend email
(defun mu4e-pimped--queued-mail-entry (e)
  "Create bui list element for unsend email E."
  (cl-destructuring-bind (&key hash content error &allow-other-keys) e
    (with-temp-buffer
      (insert content)
      `((id . ,hash)
        (from . ,(message-field-value "From"))
        (to . ,(message-field-value "To"))
        (subject . ,(message-field-value "Subject"))
        (content . ,(buffer-substring (message-goto-body) (point-max)))
        (date . ,(message-field-value "Date"))
        (emsg . ,error))))) ;;TODO extract date for better sorting

(defun mu4e-pimped--queued-mail-entries ()
  "Return list of queued emails for bui presentation."
  (-map #'mu4e-pimped--queued-mail-entry
        (mu4e-pimped--get-queued-emails)))

(defun mu4e-pimped--bui-queued-mail-entries (&optional search-type 
                                                       &rest search-values)
  "Search for queued emails with SEARCH-TYPE being one of SEARCH-VALUES."
  (cl-case search-type
    (id (-filter (lambda (x) (--some (string= (alist-get 'id x) it) 
                                     search-values))
                 (mu4e-pimped--queued-mail-entries)))
    (t (mu4e-pimped--queued-mail-entries))))

;; show content
(defun mu4e-pimped--bui-info-content (content entry)
  "Show email CONTENT from ENTRY."
  (ignore entry)
  (insert content))

;; define entry types
(bui-define-entry-type mu4e-pimped-queued-mail-bui-entries
  :get-entries-function #'mu4e-pimped--bui-queued-mail-entries)

(defun mu4e-pimped--bui-describe (&rest emails)
  "Display infos for EMAILS."
  (bui-get-display-entries 'mu4e-pimped-queued-mail-bui-entries 'info
                           (cons 'id emails)))

;; main tabulated list interface
(bui-define-interface mu4e-pimped-queued-mail-bui-entries list
  :buffer-name "*Pending emails*"
  :describe-function #'mu4e-pimped--bui-describe
  :format '((from nil 40)
            (to nil 40)
            (date nil 40)
            (subject nil 150 t)
            (emsg nil 20 t))
  :sort-key '(date from to))

;; detailed info list
(bui-define-interface mu4e-pimped-queued-mail-bui-entries info
  :format '((from format (format))
            (to format (format))
            (subject format (format))
            (date format (format))
            nil
            (content nil mu4e-pimped--bui-info-content)))

;;;###autoload
(defun mu4e-pimped-queued-mail-show-bui ()
  "Display pending emails."
  (interactive)
  (bui-get-display-entries 'mu4e-pimped-queued-mail-bui-entries 'list))

(provide 'mu4e-pimped)