Fetch Gmail article showed in web browser into local folder

gmail-grabber.el

;;; gmail-grabber.el --- Fetch Gmail article showed in web browser into local folder

;; Description: Fetch Gmail article showed in web browser into local folder
;; Author:  Yoshinari Nomura <nom@quickhack.net>
;; Created: 2020-01-30
;; Version: 0.1.1
;; Keywords: Mew Gmail
;; URL:
;; Package-Requires:

;;;
;;; Commentary:
;;;

;; On reading Gmail in some web browser, you would want to reply to it
;; using Emacs MUA (Mew).  This small elisp enables us to do that:
;;  1) When reading a Gmail article on your web browser (Chrome, Firefox...).
;;  2) Activate Emacs and invoke `gmail-grabber-mew-fetch-from-browser`.
;;  3) Emacs captures the URL part of your web browser and extract
;;     information about the article: message-id, thread-id, ...
;;  5) Invoke glima to fetch the article according to the information.
;;  6) Store the article into local file, say, ~/Mail/inbox/3.
;;  7) Kick your MUA (mew) on Emacs.
;;
;; Maybe it would be easy to use another MUA or something instead of Mew.
;; 

;;; Code:

(declare-function grab-x-link-chrome "grab-x-link")
(declare-function mew-summary-visit-folder "mew-summary4")
(declare-function mew-summary-ls "mew-scan")
(declare-function url-unhex-string  "url-util")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Constant and settings

(defvar gmail-grabber-url-regexp ;; FIXME: defconst?
  "https://mail.google.com/mail/u/\\([0-9]\\)/#\\(.+\\)/\\([^/]+\\)$"
  "Regexp for grabbing message-url in browser window, looks like:
https://mail.google.com/mail/u/1/#inbox/WhctKJV...
https://mail.google.com/mail/u/1/#label/shop%2Famazon/WhctKJV...")

(defvar gmail-grabber-user-number-alist ;; FIXME: defcustom?
  nil
  "If you have multiple accounts, set this alist:
  '((\"0\" . \"account1@gmail.com\") (\"1\" . \"account2@gmail.com\") ...)
  Number \"0\", \"1\".. is indicated in Gmail URL part like:
  https://mail.google.com/mail/u/0/#inbox...")

(defvar gmail-grabber-grab-link-function ;; FIXME: defcustom?
  'grab-x-link-chrome
  ;; 'grab-x-link-firefox
  ;; 'org-mac-firefox-get-frontmost-url
  ;; 'org-mac-chrome-get-frontmost-url
  ;; 'org-mac-safari-get-frontmost-url
  "Function to grab URL of your browser window.
it (car (funcall gmail-grabber-grab-link-function))
should return Front-most URL in your browser.")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Public functions

(defun gmail-grabber-mew-fetch-from-browser (&optional folder)
  "Store Gmail article showed on your web browser into local Mew FOLDER.
Default FOLDER is +inbox"
  (interactive)
  (let* ((folder (or folder "+inbox"))
         (new-message-path (mew-folder-new-message folder)))
    (mew-summary-visit-folder folder t)
    (gmail-grabber-glima-fetch-article-to-file
     (gmail-grabber-get-params-from-browser) new-message-path)
    (mew-summary-ls nil t t)
    (goto-char (point-max))))

(defun gmail-grabber-mew-fetch-from-url (gmail-url &optional folder)
  "Fetch Gmail article from GMAIL-URL and store it into local Mew FOLDER.
Default folder is +inbox"
  (let ((params (gmail-grabber-url-to-params gmail-url))
        (new-message-path (mew-folder-new-message (or folder "+inbox"))))
    (gmail-grabber-glima-fetch-article-to-file params new-message-path)))

(defun gmail-grabber-get-params-from-browser ()
  "Get information about a Gmail article that showed on your web browser.
Set `gmail-grabber-grab-link-function` to interact with your browser.
See `gmail-grabber-url-to-params` about the format of information."
  (let ((gmail-url (funcall gmail-grabber-grab-link-function)))
    (gmail-grabber-url-to-params
     (if (consp gmail-url)
         ;; ("URL" . "TITLE")
         (car gmail-url)
       ;; "URL"
       gmail-url))))

(defun gmail-grabber-glima-fetch-article-to-file (params filename &optional overwrite)
  "Fetch Gmail article using PARAMS and store it into FILENAME.
Overwrite if OVERWRITE is non-nil.
see also `gmail-grabber-url-to-params` about the format of PARAMS."
  (let* ((message-id  (cdr (assoc 'message-id params)))
         (user-number (cdr (assoc 'user-number params)))
         (user (cdr (assoc user-number gmail-grabber-user-number-alist)))
         (full-path  (expand-file-name filename)))
    ;; Sanity check
    (if (and (not overwrite) (file-exists-p full-path))
        (error "File %s is already exists" filename))
    (unless message-id
      (error "No valid message-id in params"))
    ;; Call glima
    (call-process-shell-command
     (format "glima show %s --raw %s > %s"
             (if user (format "--user %s" (shell-quote-argument user)) "")
             message-id
             (shell-quote-argument full-path)))))

(defun gmail-grabber-url-to-params (gmail-url)
  "Get information about a GMAIL-URL of Gmail article.
Example:
  https://mail.google.com/mail/u/1/#label/labo%2Fstaff/WhctKJV...
   -> ((user-number . "1")
       (folder     . \"label/labo/staff\")
       (thread-id  . \"16fe5683996e2bd2\")
       (message-id . \"16fefe1a2a849a60\"))"
  (if (string-match gmail-grabber-url-regexp gmail-url)
      (let ((user-number (match-string 1 gmail-url))
            (folder      (match-string 2 gmail-url))
            (magic       (match-string 3 gmail-url)))
        `((user-number . ,user-number)
          (folder . ,(decode-coding-string (url-unhex-string folder) 'utf-8))
          ,@(gmail-grabber--url-magic-trailer-to-params magic)))
    (error "Invalid Gmail URL: %s" gmail-url)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; private functions

;; WhctKJVjVlrsQlNtRrRFzwdBLJgFzndxTbtsvtQZxPfGtkZTrkRdpXShNFlNVtjXqSfqLXG
;;  → "f:1657226717035126661|msg-f:1657226717035126661"
;;  → ((thread-id . "16ffa6eb352a5f85") (message-id . "16ffa6eb352a5f85"))
(defun gmail-grabber--url-magic-trailer-to-params (magic-trailer)
  (let ((decoded-string (gmail-grabber--decode-url-magic-trailer magic-trailer)))
    (if (string-match "f:\\([0-9]+\\)|msg-f:\\([0-9]+\\)" decoded-string)
        `((thread-id  . ,(format "%x" (string-to-number (match-string 1 decoded-string))))
          (message-id . ,(format "%x" (string-to-number (match-string 2 decoded-string)))))
      (error "Invalid URL params: %s" magic-trailer))))

;; WhctKJVjVlrsQlNtRrRFzwdBLJgFzndxTbtsvtQZxPfGtkZTrkRdpXShNFlNVtjXqSfqLXG
;; → "f:1657226717035126661|msg-f:1657226717035126661"
;; see https://stackoverflow.com/questions/50800330/gmail-api-does-not-support-new-thread-ids
(defun gmail-grabber--decode-url-magic-trailer (magic-trailer)
  (let* ((alphabet-i "BCDFGHJKLMNPQRSTVWXZbcdfghjklmnpqrstvwxz")
         (alphabet-o "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/")
         (base64-string
          (gmail-grabber--digit-list-to-string
           (gmail-grabber--convert-radix
            (gmail-grabber--string-to-digit-list magic-trailer alphabet-i)
            (length alphabet-i)
            (length alphabet-o))
           alphabet-o)))
    (base64-decode-string
     (concat base64-string
             (make-string (% (- 4 (% (length base64-string) 4)) 4) ?=)))))

(defun gmail-grabber--convert-radix (digit-list current-radix new-radix)
  "Convert DIGIT-LIST in CURRENT-RADIX to a new digit-list in NEW-RADIX."
  (let ((new-digit-list '(0)))
    ;; Loop MSB-first
    (while (setq digit (car digit-list))
      (setq new-digit-list (gmail-grabber--linear-equation new-digit-list new-radix current-radix digit)
            digit-list (cdr digit-list)))
    new-digit-list))

(defun gmail-grabber--linear-equation (digit-list radix coefficient constant)
  "Return COEFFICIENT * (DIGIT-LIST in RADIX) + CONSTANT."
  (let ((digit-list-lsb-first (reverse digit-list))
        (new-digit-list '())
        (offset constant))
    ;; Loop LSB-Fist
    (while (setq digit (car digit-list-lsb-first))
      (setq new-digit (+ (* coefficient digit) offset))
      (if (>= new-digit radix)
          ;; if new-digit is not less than radix,
          ;; make new-digit lower than radix, and
          ;; carry offset to upper digits.
          (setq reminder (% new-digit radix)
                offset (/ (- new-digit reminder) radix)
                new-digit reminder)
        (setq offset 0))
      (setq new-digit-list (cons new-digit new-digit-list)
            digit-list-lsb-first (cdr digit-list-lsb-first)))
    ;; if offset is still remained, slide it to upper digits.
    (while (not (eq offset 0))
      (setq reminder (% offset radix)
            new-digit-list (cons reminder new-digit-list)
            offset (/ (- offset reminder) radix)))
    new-digit-list))

(defun gmail-grabber--string-to-digit-list (string &optional alphabet)
  (let* ((case-fold-search nil)
         (alphabet (or alphabet "BCDFGHJKLMNPQRSTVWXZbcdfghjklmnpqrstvwxz"))
         (vlist (mapcar (lambda (x) (string-match (char-to-string x) alphabet)) string)))
    (if (member nil vlist)
        (error "Invalid string %s" string)
      vlist)))

(defun gmail-grabber--digit-list-to-string (digit-list &optional alphabet)
  (let* ((alphabet (or alphabet "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"))
         (clist (mapcar (lambda (x) (elt alphabet x)) digit-list)))
    (apply 'string clist)))

(provide 'gmail-grabber)

;;; gmail-grabber.el ends here