Gmailについて考える

(require 'smtpmail)
(require 'cl)
(require 'gnus-gmail-oauth)
(require 'gnus-x-gm-raw)
(require 'oauth2)
(require 'nnir)
(require 'url)

(defvar gmail-current-oauth2-application nil)
(defvar gmail-current-email nil)
(defvar gmail-current-token nil)
(defvar gmail-base-token nil)

(defvar gmail-current-authorize-url nil
  "Gmail用認証URL

通常はnilを設定する。必要に応じてこの変数をシャドーイングし使用する。")

(defun gmail-oauth2-param-get (sym)
  (alist-get sym
	     (cdr (car gmail-current-oauth2-application))))

(defun gmail-base-token-param-get (sym)
  (alist-get sym gmail-base-token))

(defun gmail-token-param-get (sym)
  (alist-get sym gmail-current-token))

(defun gmail-convert-json-to-elisp ()
  (interactive)
  (let ((data (json-read-from-string (buffer-string)))
	(buf (get-buffer-create "*Google OAuth2 Parameters*")))
    (prin1 data buf)
    (display-buffer buf)))

(defun gmail-format-authorize-url ()
  (format
   (string-join '("%s"
		  "?redirect_uri=urn:ietf:wg:oauth:2.0:oob"
		  "&scope=https://mail.google.com/"
		  "&response_type=code"
		  "&client_id=%s"))
   (gmail-oauth2-param-get 'auth_uri)
   (gmail-oauth2-param-get 'client_id)))

(defun gmail-login ()
  (interactive)
  (let ((gmail-authorize-url (gmail-format-authorize-url)))
    (browse-url gmail-authorize-url)))

(defun gmail-get-access-token-from-code (code)
  (interactive "sCode: ")
  (make-process
   :name "*Gmail Get Access Token From Code*"
   :buffer "*Gmail Get Access Token From Code*"
   :command
   `("curl" ,(gmail-oauth2-param-get 'token_uri)
     "--request" "POST"
     "--header" "Content-Type: application/x-www-form-urlencoded"
     "--data"
     ,(format
       "redirect_uri=urn:ietf:wg:oauth:2.0:oob&grant_type=authorization_code&client_id=%s&client_secret=%s&code=%s"
       (gmail-oauth2-param-get 'client_id)
       (gmail-oauth2-param-get 'client_secret)
       code))))

(defun gmail-get-access-token-from-refres-token ()
  "Gmail API用のアクセストークンをリフレッシュする"
  (interactive)
  (make-process
   :name "*Gmail Refresh Token*"
   :buffer "*Gmail Refresh Token*"
   :command
   `("curl" ,(gmail-oauth2-param-get 'token_uri)
     "--request" "POST"
     "--header" "Content-Type: application/x-www-form-urlencoded"
     "--data"
     ,(format
       "redirect_uri=urn:ietf:wg:oauth:2.0:oob&grant_type=refresh_token&client_id=%s&client_secret=%s&refresh_token=%s"
       (gmail-oauth2-param-get 'client_id)
       (gmail-oauth2-param-get 'client_secret)
       (gmail-base-token-param-get 'refresh_token)))
   :sentinel
   (lambda (process event)
     (when (string-equal event "finished\n")
       (setq gmail-current-token (json-read-from-string
				  (with-current-buffer "*Gmail Refresh Token*"
				    (buffer-string))))))))

(defun gnus-gmail-oauth-token ()
  "既存の関数を上書きする"
  (make-oauth2-token :access-token (gmail-token-param-get 'access_token)))

(defun gnus-gmail-oauth2-imap-authenticator (user password)
  "Authenticator for GMail OAuth2.  Use as before-until advice for nnimap-login
See:  https://developers.google.com/gmail/xoauth2_protocol"
  (if (nnimap-capability "AUTH=XOAUTH2")
      (let ((token (gnus-gmail-oauth-token))
	    access-token)
	(setq access-token (oauth2-token-access-token token))
	(if (or (null token)
		(null access-token))
	    nil
	  (let (sequence challenge)
	    (erase-buffer)
	    (setq sequence (nnimap-send-command
			    "AUTHENTICATE XOAUTH2 %s"
			    (base64-encode-string
			     (format "user=%s\001auth=Bearer %s\001\001"
				     (nnimap-quote-specials user)
				     (nnimap-quote-specials access-token)))))
	    (setq challenge (nnimap-wait-for-line "^\\(.*\\)\n"))
	    ;; on successful authentication, first line is capabilities,
	    ;; next line is response
	    (if (string-match "^\\* CAPABILITY" challenge)
		(let (response (nnimap-get-response sequence))
		  (cons t response))
	      ;; send empty response on error
	      (let (response)
		(erase-buffer)
		(process-send-string
		 (get-buffer-process (current-buffer))
		 "\r\n")
		(setq response (nnimap-get-response sequence))
		(nnheader-report 'nnimap "%s"
				 (mapconcat (lambda (a)
					      (format "%s" a))
					    (car response) " "))
		nil)))))))

(setq gnutls-min-prime-bits 1024)
(setq gnutls-algorithm-priority "SECURE128:-VERS-SSL3.0:-VERS-TLS1.3")
(setq gnus-select-method '(nnnil ""))

(setq gnus-secondary-select-methods
      `((nnimap "gmail"
		(nnimap-address "imap.gmail.com")
		(nnimap-user ,gmail-current-email)
		(nnimap-server-port 993)
		(nnimap-stream ssl)
		;; Search
		(nnir-search-engine imap))))

(add-to-list 'nnir-imap-search-arguments '("gmail" . "X-GM-RAW"))
(setq nnir-imap-default-search-key "gmail")
(defadvice nnir-run-imap (before decode-group activate)
  (ad-set-arg 2 (mapcar 'gnus-group-decoded-name (ad-get-arg 2))))

(advice-add 'nnimap-login :before-until #'gnus-gmail-oauth2-imap-authenticator)
(setq gnus-permanently-visible-groups "^nnimap\\+gmail:INBOX\\|^nnimap\\+gmail:\\[Gmail\\]")

(setq gnus-gmail-oauth-client-id (gmail-oauth2-param-get 'client_id))
(setq gnus-gmail-oauth-client-secret (gmail-oauth2-param-get 'client_secret))

;; SMTMP XOAUTH2
(setq smtpmail-smtp-server "smtp.gmail.com"
      smtpmail-smtp-service 587)
(defvar %smtpmail-try-auth-method (symbol-function 'smtpmail-try-auth-method))
(defun smtpmail-try-auth-method (process mech user password)
 (if (eql mech 'xoauth2)
   (let ((token (gnus-gmail-oauth-token))
	  access-token)
     (setq access-token (oauth2-token-access-token token))
     (smtpmail-command-or-throw
      process
      (concat "AUTH XOAUTH2 "
              (base64-encode-string
               (format "user=%s\001auth=Bearer %s\001\001"
                       (nnimap-quote-specials user)
                       (nnimap-quote-specials access-token)) t))
      235))
   (funcall (symbol-value '%smtpmail-try-auth-method) process mech user password)))

(add-to-list 'smtpmail-auth-supported 'xoauth2)

(provide 'gmail)