Mew to support IMAP XOAUTH2

mew-xoauth2.el

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Mew XOAUTH2
;;
;; * Setup
;;
;; 1) Install oauth2.el and GnuPG
;;
;; 2) In your .emacs:
;;
;;   (with-eval-after-load 'mew
;;     (require 'mew-xoauth2)
;;     (setq mew-gmail-oauth-client-id "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx.apps.googleusercontent.com"
;;               mew-gmail-oauth-client-secret "xxxxxxxxxxxxxxxxxxxxxxxx")
;;
;; 3) Patch mew-imap.el
;;
;; diff --git a/mew-imap.el b/mew-imap.el
;; index 0d4447c..7e604c8 100644
;; --- a/mew-imap.el
;; +++ b/mew-imap.el
;; @@ -1477,8 +1477,12 @@ (defun mew-imap-filter (process string)
;;         (if (string= status "greeting")
;;  	   (setq next (mew-imap-fsm-next "greeting" "OK"))
;;  	 (setq stay t)))
;; -      ((and (goto-char (point-min)) (looking-at "\\+"))
;; -       (setq next (mew-imap-fsm-next status "OK")))
;; +      ((and (goto-char (point-min)) (looking-at "\\+ *\\(.*\\)"))
;; +       (setq next (mew-imap-fsm-next
;; +                   status
;; +                   (if (string= status "auth-xoauth2")
;; +                       (mew-imap-xoauth2-json-status (mew-match-string 1))
;; +                     "OK"))))
;;        ((and (goto-char (point-max)) (= (forward-line -1) 0) (looking-at eos))
;;         (mew-imap-set-tag pnm nil)
;;         (setq code (mew-match-string 1))
;;
;;
;; * Thanks to
;;   OAuth related code is picked from:
;;   https://github.com/ggervasio/gnus-gmail-oauth/blob/master/gnus-gmail-oauth.el
;;   https://github.com/jd/google-contacts.el/blob/master/google-oauth.el
;;

(require 'oauth2)

(defvar mew-gmail-oauth-client-id nil
  "Client ID for OAuth.")

(defvar mew-gmail-oauth-client-secret nil
  "Mew secret key.")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; OAuth

(defconst google-oauth-auth-url "https://accounts.google.com/o/oauth2/auth"
  "Google OAuth2 server URL.")

(defconst google-oauth-token-url "https://accounts.google.com/o/oauth2/token"
  "Google OAuth2 server URL.")

(defun google-oauth-auth (resource-url client-id client-secret)
  "Request access to a resource."
  (oauth2-auth google-oauth-auth-url google-oauth-token-url client-id client-secret resource-url))

(defun google-oauth-auth-and-store (resource-url client-id client-secret)
  "Request access to a Google resource and store it using `auth-source'."
  (oauth2-auth-and-store google-oauth-auth-url google-oauth-token-url
                         resource-url client-id client-secret))

(defconst mew-gmail-resource-url "https://mail.google.com/"
  "URL used to request access to GMail.")

(defun mew-gmail-oauth-token ()
  "Get OAuth token for Mew to access GMail."
  (let ((token (google-oauth-auth-and-store
               mew-gmail-resource-url
               mew-gmail-oauth-client-id
               mew-gmail-oauth-client-secret)))
    (oauth2-refresh-access token)
    token))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Mew

(setq mew-imap-auth-alist
  '(("XOAUTH2"  mew-imap-command-auth-xoauth2)
    ("CRAM-MD5" mew-imap-command-auth-cram-md5)
    ("LOGIN"    mew-imap-command-auth-login)))

(setq mew-imap-auth-list
      '("XOAUTH2" "LOGIN" "CRAM-MD5"))

(defun mew-imap-command-auth-xoauth2 (pro pnm)
  (let* ((user (mew-imap-get-user pnm))
         (token (oauth2-token-access-token (mew-gmail-oauth-token)))
         (token-string (mew-imap-xoauth2-token-string user token)))
    (mew-imap-process-send-string pro pnm (format "AUTHENTICATE XOAUTH2 %s" token-string))
    (mew-imap-set-status pnm "auth-xoauth2")))

(defun mew-imap-command-xoauth2-wpwd (pro pnm)
  (mew-imap-set-done pnm t)
  (mew-passwd-set-passwd (mew-imap-passtag pnm) nil)
  (delete-process pro)
  (error "IMAP password is wrong!"))

(defun mew-imap-xoauth2-token-string (user token)
  ;; base64(user=user@example.com^Aauth=Bearer ya29vF9dft4...^A^A)
  (base64-encode-string (format "user=%s\1auth=Bearer %s\1\1" user token) t))

(defun mew-imap-xoauth2-json-status (status-string)
  ;; https://developers.google.com/gmail/imap/xoauth2-protocol#error_response_2
  (let ((json-status (json-parse-string (base64-decode-string status-string))))
    (if (string-match "^4" (gethash "status" json-status)) ;; 4XX
        "NO" "OK")))

(setq mew-imap-fsm
  '(("greeting"      ("OK" . "capability"))
    ("capability"    ("OK" . "post-capability"))
    ("auth-xoauth2"  ("OK" .  "next") ("NO" . "xoauth2-wpwd"))
    ("auth-cram-md5" ("OK" . "pwd-cram-md5") ("NO" . "wpwd"))
    ("pwd-cram-md5"  ("OK" . "next") ("NO" . "wpwd"))
    ("auth-login"    ("OK" . "user-login") ("NO" . "wpwd"))
    ("user-login"    ("OK" . "pwd-login") ("NO" . "wpwd"))
    ("pwd-login"     ("OK" . "next") ("NO" . "wpwd"))
    ("login"         ("OK" . "next") ("NO" . "wpwd"))
    ("select"        ("OK" . "post-select"))
    ("flags"         ("OK" . "flags")) ;; xxx NG but loop
    ("uid"           ("OK" . "umsg"))
    ("copy"          ("OK" . "copy") ("NO \\[TRYCREATE\\]" . "create") ("NO" . "wmbx"))
    ("create"        ("OK" . "copy") ("NO" . "wmbx"))
    ("dels"          ("OK" . "dels")) ;; xxx NG but loop
    ("expunge"       ("OK" . "post-expunge"))
    ;;
    ("search"        ("OK" . "post-search"))
    ;;
    ("fetch"         ("OK" . "post-fetch"))
    ;;
    ("namespace"     ("OK" . "post-namespace") ("NO\\|BAD" . "list"))
    ("list"          ("OK" . "post-list"))
    ;;
    ("delete"        ("OK" . "logout") ("NO" . "logout3"))
    ("rename"        ("OK" . "logout") ("NO" . "logout3"))
    ;;
    ("logout"        ("OK" . "noop"))
    ("logout2"       ("OK" . "noop"))
    ("logout3"       ("OK" . "noop"))))

(provide 'mew-xoauth2)