19
17

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

More than 3 years have passed since last update.

@waiseiningenchokon(矮星人間 ちょこん)

GNU Emacs + Gnus + Gmail + OAuth2 の環境を作ろう

19
Last updated at Posted at 2020-05-21

はじめに

タイトルは大変お世話になったページのリスペクトです。

メールサーバーは自分で運用しないとセキュリティ対策をしたとは言えない。そんな風に考えていた時期が俺にもありました。今は考えるのが面倒になったのでGmailに巻かれています。

Gmailに移ってもそれまで使っていたEmacs+Gnusの環境を手放すつもりは無かったので「安全性の低いアプリの許可」を設定してEmacs+Gnusライフを謳歌していました。しかしこの聖域にもGoogleの魔の手は迫っていたのです。

2020年6月からG SuiteGoogle Workspaceのユーザ管理で「安全性の低いアプリの許可」にする設定を使えなくするそうです。そして翌年には完全に廃止。酷い酷いよGoogle様。TLSで接続しているんだからユーザーIDとパスワードでもいいじゃないか。漏洩なんてしないよ。まぁパスワードを使いまわすアホな子が多いのと「安全性の低いアプリの許可」をオフにことでGoolge様にアプリ登録が必要となり、怪しい動きをするアプリがあればGoogle様で接続不可にするのが比較的容易(怪しい動きを確実に遮断とは言っていない)というのが理由のようです。

「安全性の低いアプリの許可」をオフにするとアプリパスワードという無意味文字列のパスワードが使えるようになります。これを使えばアホな子対策にはなりますが、Goolge様の監視可能になるという主張には対応できません。どうせならGoogle様におんぶにだっこで面倒を見てもらいましょう。OAuth2を使って。

実践編というタイトルですが、このドキュメントしかありません。他の編はありませんので、そのつもりでお願いします。また元々実践編というタイトルにしようと思っていたのですが投稿直前に今のタイトルに直したので記述が残ってました。OAuth2の細かい仕組みは説明していません。そういうのは他にいっぱい良いドキュメントがありますので、そちらを見てください。あくまでEmacs+GnusでGmailにOAuth2アクセスするためのやり方に特化しているドキュメントです。

テスト環境のまとめ

OS
Windows 10
Emacs
26.2以降(2021年11月に追記。27.2でも動きました。2022年5月に追加。28.1でも動きますがおまけ8を見てください)

Windowsなのは深い意味はありません。SolarisでもLinuxでもNetBSDOpenBSDでもFreeBSDでもmacOSでも多分一緒です(NetBSDOpenBSD以降は使ったことありません)。

Emacsはgnutlsが使えるようになっていないといけません。*scratch*バッファで以下を入力して行末でC-jしてください。gnutlsが使えるなら、nil以外が返るはずです。

(gnutls-available-p)

アクセストークンの保護

OAuth2は地獄の番犬Kerberos(がぉー)などと同じで認証後はアクセストークンを使用して資源にアクセスします。アクセストークンにはユーザIDやパスワードなどの情報が無いので安全でないネットワークに流しても大丈夫という地獄の番犬Kerberos(がぉー)の発想と一緒ですね。

このアクセストークンには有効期限あります。OAuth2ではアプリ登録を行う際にどの程度にするか設定可能です。設定は、例えば1時間で有効期限が切れるとか、1日で切れるとかです。

アクセストークンがアプリ外に漏れるとセキュリティ上の影響が大きいのでメモリにだけ保持するとかいろいろ保護方法があると思います。EmacsのOAuth2実装ではsecure plist storeというelispを使ってアクセストークンを保護しています。このsecure plist storeは以下ような依存関係にあります。

  • secure plist store(plstore,elisp)
    • the EasyPG Library(epg,elisp)
      • GnuPG(gpg/gpg2,binary)

最終的にはGnuPGコマンドを呼び出します。お使いの環境でGnuPGが使えるようになっていないとうまく行きません。この辺りの確認を以降で説明します。

EasyPG Libraryは、MIMEデファクトウォーズのDaiki Uenoさん作ですね。EPISODE IV:新たなるMIMEライブラリで最後、WanderlustとSemi-gnusを叩き込んだけど、EPISODE V:Gnusの逆襲で逆転されちゃうんですよね。まぁ嘘なんですけど。

EasyPG LibraryがEmacsに取り込まれる経緯を論文にまとめられているので一読すると勉強になるのではないでしょうか。

GnuPG

WindowsならGpg4winをインストールしてしまうのが一番簡単でしょう。donate等の判断はご自身の考えでどうぞ。私は昔からcygwinを使っているのでcygwinで実行環境を作っています。他の環境でもパッケージ等があると思いますので、未インストールならインストールしてください。インストール環境によりますが、コマンド名はgpgかgpg2になると思います。以降はgpgである前提で説明します。

あまりバージョンが古いとepgの方で弾く場合があります。これを機に最新にしてみてはいかがでしょうか?Configurations for GNU Emacs#3.21 [epa.el] GPGを使うなどを参考するのも良いかもしれません。

GnuPGの動作確認のためファイルを用意しましょう。Emacsのshellバッファを起動してください。以下のような感じでテストファイルを作成します。

Microsoft Windows [Version 10.0.18363.836]
(c) 2019 Microsoft Corporation. All rights reserved.

c:\Users\waiseiningenchokon\AppData\Roaming>echo GnuPG test > test.txt

c:\Users\waiseiningenchokon\AppData\Roaming>type test.txt
GnuPG test 

c:\Users\waiseiningenchokon\AppData\Roaming>

GnuPGを使って暗号化します。

c:\Users\waiseiningenchokon\AppData\Roaming>gpg --cipher-algo AES256 --symmetric test.txt
gpg: AllowSetForegroundWindow(6996) failed: アクセスが拒否されました。


c:\Users\waiseiningenchokon\AppData\Roaming>

pinentryの入力ダイアログが表示されると思います。ここに該当ファイルのパスフレーズ(8文字以上も可能なパスワード)を2度入力します。2回目は最初の入力の入力ミスが無いかを確認するためです。

例にある「アクセスが拒否されました。」はshellバッファから起動したために発生しています。pinentryの入力ダイアログが消えた際に入力元のウインドウのZオーダーをいじろうとしているようですが、Emacsの子ウインドウなのでエラーになっているものと思われます。epgからのコマンド実行はウインドウが無い状態で行われるので気にしなても大丈夫です。

このコマンドが成功するとtest.txt.gpgというファイルが作成されます。これが暗号化されたファイルです。

今度は以下で複合化してみます。

c:\Users\waiseiningenchokon\AppData\Roaming>gpg -o decrypt_test.txt --decrypt test.txt.gpg
gpg: AES256暗号化済みデータ
gpg: 1 個のパスフレーズで暗号化

c:\Users\waiseiningenchokon\AppData\Roaming>

この辺り、GnuPGのバージョンよって動作が異なるようですが、最新版(3.1.11)を使うとパスフレーズの入力がありませんでした。これはGnuPGのAgentが動作しているからです。タスクマネジャーの詳細でgpg-agent.exeというプロセスが動作していると思います。これが動いていると入力済のパスフレーズがキャッシュされ代理入力してくれます。試しにgpg-agentを停止してから複合化してみましょう。今度はパスフレーズの入力ダイアログが表示されると思います。

c:\Users\waiseiningenchokon\AppData\Roaming>gpgconf --kill gpg-agent

c:\Users\waiseiningenchokon\AppData\Roaming>del decrypt_test.txt 

c:\Users\waiseiningenchokon\AppData\Roaming>gpg -o decrypt_test.txt --decrypt test.txt.gpg
gpg: AES256暗号化済みデータ
gpg: 1 個のパスフレーズで暗号化

c:\Users\waiseiningenchokon\AppData\Roaming>

Emacsのshellバッファで作業するのは、gpgコマンドがepgライブラリなどelispから呼び出し可能であることを確認するためです。もしここでgpgコマンドが呼びさせない場合はPATHなどを見直してください。

入力ダイアログが出ない場合は、pinenryの実体がどこにインストールされたかを確認し、~/.gnupg/gpg-agent.confファイルをpinentry-programというキー値で指定すれば良い場合があります。

ここをクリアしないと本ドキュメントを実践することはできないのでがんばってください。

secure plist store

GnuPGの動作確認ができたら、plstoreの動作も確認しましょう。以下のelispを*scratch*で実行してください。行毎に行末でC-jです。

(setq store (plstore-open "~/test.plist"))

(plstore-put store "foo" '(:host "foo.example.jp") '(:password "secret"))

(plstore-save store)

(plstore-close store)

plstore-save実行時にpinentryのダイアログが2度表示されれば正常に暗号化されて保存されています。今度はopenしてみましょう。最初にgpgconf --kill gpg-agentを使用してGnuPGのAgentを停止してください。その後以下のelispを*scratch*で実行してください。行毎に行末でC-jです。

(setq store (plstore-open "~/test.plist"))

(setq node (plstore-get store "foo"))

(plstore-close store)

plstore-getの段階でpinentryのダイアログが出れば正常です。これでplstoreに関する確認は終了です。

うまく行かない場合は、デバッグが必要ですが関連しそうな変数を以下に挙げておきます。

変数名 意味
epg-gpg-program GnuPGのコマンドパス。gpg2など
epg-gpg-home-directory GnuPGのコマンドで使用する環境設定ディレクトリ。~/.gnupgなど

elispをかき集める

足腰を鍛え終えたので、本格的に環境整備を行いましょう。先人の知恵をかき集めましょう。以下に必要となるelispをまとめます。

elisp コメント
oauth2 OAuth2の基礎ライブラリです
google-contacts Goolgeアクセス用の便利ライブラリのようです。下で使います
gnus-gmail-oauth OAuth2をgmail対応にします
gnus-x-gm-raw gmailの検索条件をG Gで使えるようにします
log4e gnus-x-gm-rawの依存ライブラリです
yaxception gnus-x-gm-rawの依存ライブラリです

こんなドキュメント見ているのだからEmacsのload-path辺りの話はご自身で管理方針があると思います。お好みな方法でelispのload-pathを通してください。

おまけ3でマルチアカウント対応したため、必要elispも変更になっています。でもおまけ3は一通り内容を読んでいる前提で書いているので、以降の内容に目を通してもらってからおまけ3に進んでください。

client id/client secretの取得

GmailをOAuth2でアクセスする場合に必要です。取得方法などは他に良いドキュメントがありますので、そちらを参照してください。

client idを取得する際に登録作業があるのでGoolge様の監視可能になるという理屈なのでおんぶにだっこ作戦のためしっかり登録しましょう。

GnusのIMAPの設定

以下に最低限の設定をまとめます。ご自身の設定もあると思いますので適当にマージしてください。

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

(setq gnus-select-method '(nnnil ""))
;; Gmail (IMAP)
(add-to-list
 'gnus-secondary-select-methods
 '(nnimap "gmail"
          (nnimap-address "imap.gmail.com")
          (nnimap-server-port 993)
          (nnimap-stream ssl)
          ;; Search
          (nnir-search-engine imap)))

;;
;; gmail search
;;
(require 'nnir)
(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))))
(require 'gnus-x-gm-raw)

(setq gnus-gmail-oauth-client-id "[取得したclient id]")
(setq gnus-gmail-oauth-client-secret "[取得したclient secret]")

(require 'gnus-gmail-oauth)

(advice-add 'nnimap-login :before-until #'gnus-gmail-oauth2-imap-authenticator)

(setq gnus-permanently-visible-groups "^nnimap\\+gmail:INBOX\\|^nnimap\\+gmail:\\[Gmail\\]")

この状態でM-x gnusで起動するとユーザIDとパスワードを聞かれると思います。OAuth2で認証するので認証には不要なのですがGnusの内部処理で見ているようなでお使いのアカウント情報を入れてください。

その後 minibufferにEnter the code youer browser displayed:というメッセージが表示され、ブラウザが起動すると思います。ここでGmailアカウントにログインし、許可を選択するとコードが表示されます。このコードをminibufferに入力してください。

ブラウザの起動はbrowse-url.elが使用されます。お使いの環境で動作するように設定してください。Windowsなら何もしなくてもデフォルトブラウザが起動すると思います。

コード入力後、pinentryのダイアログが表示されます。これはOAuth2認証で取得したアクセストークンを~/.emacs.d/oauth2.plstoreに保存するためのパスフレーズ入力です。何度が入力が要求されると思いますが、すべて同じ値で大丈夫です。

うまく行けば、初回同期としてGmailのすべてのラベルの同期処理が実行されます。その後、ラベルがグループとして列挙されると思います。表示されない場合は、jでジャンプするかgnus-permanently-visible-groupsの値を調整してください。

GnusのSMTPの設定

ここまでの設定はIMAP側の設定です。このままでは送信は従来通りの認証になってしまいます。SMTP AUTHにもOAuth2拡張がありますので、その設定も行いましょう。以下の内容を追加してください。

.gnus.el
(load "smtpmail")
(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)

接続ユーザに関する情報は~/.authinfoファイルに保存されています。最初のIMAP接続時に作成されていると思いますが、Gnusがちゃんと認識する形式に直しましょう。以下のようにすれば良いと思います。

.authinfo
machine gmail login あなたのgmailアカウント password notrecord
machine smtp.gmail.com login あなたのgmailアカウント port 587 password notrecord

passwordはOAuth2認証では未使用なので本来不要なのですが、入っていないとGnusがパスワード問い合わせを行うので適当に入れます。認証方式のloginは、xoauth2としたいところですが、Gnusのパース処理の関係で最初から有効な値になっていないと問題があるようなのでloginとしています。ただし実際のlogin処理はOAuth2に差し替えてしまっているので問題ありません。

それではこの状態でGnusを再起動してグループバッファでmとしてください。メール作成画面になります。C-cで送信です。pinentryダイアログが出て送信されるはずです。

うまく行ったでしょうか?送信のたびにpinentryダイアログが表示されるのは、送信のたびにアクセストークンのリフレッシュを行っているためです。IMAPログイン時の情報を引っ張ってくる方法もあるのですが、その場合、有効期限が切れている場合はやっぱりリフレッシュが必要なので、面倒なのでこうなっています。~~必要なら修正してください。~~おまけで修正しました。

検索

検索したいグループでG Gを押すと検索文字列の入力になります。ここで使用できるキーワードはfrom:などのGmailで使用できる検索演算子すべてです。結構便利です。

アクセストークンの保護の再び

アクセストークンはplstoreで保護されると説明しました。でもclient idとclient secretはべた書きです。良いのでしょうか?

client id/client secretが漏洩した場合を考えてみます。攻撃者は自身のソフトで漏洩したclient id/client secretを使用しますが、最初の接続時に許可が必要となります。このためGmailのアカウント情報も同時に漏洩していないと悪さはできません。

許可が必要かどうかは初回接続時にブラウザで表示されたコードを持っているかどうかにより左右されます。そしてEmacsの実装ではこのコードはplstore内にありますので保護されていると言って良いと思います。

このように考えると、OAuth2は、このコードがログインアカウントとパスワードの代わりをしていて、このコードを得るための色々面倒な手続きをと考えることができるかもしれません。もちろん個々の通信では地獄の番犬Kerberos(がぉー)に倣って、アクセストークンを使うことにより、安全でないネットワーク対策も忘れてません。

いずれにしても情報漏洩は良いことではないので、もし気持ち悪いようならclient id/client secretを暗号化したファイルから読み込む等の対策をされた方が良いでしょう。この辺りの判断はみなさんに委ねます。

GmailのIMAP実装の削除動作

GnusではIMAPメールの削除はSTOREコマンドによるDeletedフラグの設定とEXPUNGEコマンドの発行により処理します。GmailのIMAP機能でもこれらのコマンドは有効ですが、EXPUNGE後、メールの削除は行われません。

Gmailではこの操作が行われるとメールが持つラベルがすべて削除されます。いわゆるアーカイブと言われる状態になっているのだと思います。「[Gmail]/すべてのメール」グループでhas:nouserlabels !label:INBOXで検索可能な状態です。

この辺りの動作を制御するため、Gmailの設定に「最後に表示された IMAP フォルダからメールを削除/消去するようマークを付けた場合」というオプションがあります。しかしこれを「メッセージをゴミ箱に移動」にしても、この動作は変わりませんでした。

どう考えてもおかしいのでG SuiteGoogle Workspaceのサポートに質問しましたが、帰ってきた答えはThunderbirdではうまく動くというものでした。要するにGmailのヘルプ画面に設定例が載っているクライアント以外は知らないということみたいです。まぁ営利企業ですからね。しょうがないですね。

その後、Thunderbirdの動作を確認したところ、ThunderbirdのGmailアカウントでの削除はEXPUNGEコマンドは使用しておらず、「[Gmail]/ゴミ箱」への移動を行っていました。そういうことか。F.A.B。

Gnusでメールを削除する場合も同じ処理を行ってください。削除したいと思ったらB-[DEL](またはB-[backspace])ではなく、B-mです。ここで「nnimap+gmail:[Gmail]/ゴミ箱」グループを選択すると、Thunderbirdと同じ処理となります。また「[Gmail]/ゴミ箱」内ならB-[DEL](またはB-[backspace])は効くみたいです。おそらくごみ箱を空にする的な動作が、EXPUNGEコマンドに割当たっているのだと思います。でもこの辺りのドキュメントを見つけられませんでした。~~もしかしたら、この事を知っているのは世界で、このドキュメントを読んだあなただけかもしれませんよ。~~多分、もうあなただけではないと思います。

GmailのIMAP実装のメール管理

IMAPではメールをメールBOXというディレクトリ形式の構造で管理します。しかしGmailはメールをフラットな構造で管理しています。IMAPのメールBOXのように見える情報はラベルという仕組みで似たように見せているだけで実装が大きく異なっています。

Gmailはメールの保存に使用しているデータベース的なストレージのキーにMessage-IDヘッダを使用しています。通常のIMAPサーバーの場合、COPYコマンドなどを使うことにより、同じMessage-IDのメールを異なるメールBOXに保存することが可能です。しかしGmailはこれができません。もしすでに存在するMessage-IDがCOPY(またはMOVE)された場合、コマンド自体は成功しますが後から来たメールはGmailには反映されません。異なるメールBOXへのCOPYだった場合は、存在するメールにラベルの追加が行われるだけです。

この動きの何が問題かというと他のプロバイダーからメールをForwardしているようなケースです。今時のメールサーバーはSPFやDMARCなどでAuthentication-Resultsヘッダが付くと思いますが、ForwardではFromアドレスがSPF/DMARCで許可しているメールサーバーと異なるため、Gmailは失敗と認識しAuthentication-Resultsヘッダを付与します。そしてこの失敗メールが該当Message-IDのメールとなります。

その後、プロバイダーのメールサーバーから別途メールを取得しGmailにCOPYしたとしても先の理由により、COPYメールは破棄されてしまいます。つまり正しいAuthentication-ResultsヘッダのメールがGmailには保存できない状態になるということです。

この問題に対処するには、プロバイダーから来たForwardメールを先の手順でゴミ箱に移動し、ゴミ箱からも削除します。その後、プロバイダーからのメールをコピーなり移動なりしましょう。移動の場合、手順を間違うと移動元のメールは消失してしまうので、かなり悲しい思いをします。気を付けましょう。

おまけ1 メール送信でパスフレーズの入力を少なくしたい

おまけの子、一衣です。

普段あまりやらないのですが、立て続けにメールを送信しまくるという作業を最近やりました。それでメール送信のたびにパスフレーズを入力するのが面倒になり見直しました。

確認の結果、リフレッシュが必要なアクセストークンでSMTP AUTHを行うと認証エラーが返ってくることが分かったので、以下のような修正を行いました。

  1. とりあえずplstoreにあるアクセストークンで認証してみる。
  2. 認証エラーが発生した場合は、これまで通りの処理を行う。

smtpmail-try-auth-methodを以下のように入れ替えてください。

(defun smtpmail-try-auth-method (process mech user password)
  (if (eql mech 'xoauth2)
      (let ((token (google-oauth-auth-and-store
                    gnus-gmail-resource-url
                    gnus-gmail-oauth-client-id
                    gnus-gmail-oauth-client-secret))
            access-token
            ret)
        (setq access-token (oauth2-token-access-token token))
        (setq ret (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))
                   ))
        (when (not (eq (car ret) 235))
          (smtpmail-send-command process "NOOP")
          (smtpmail-read-response process)
          (setq token (gnus-gmail-oauth-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)))

AUTH XOAUTH2は認証されると、レスポンスコード235が返りますが、失敗するとレスポンスコード334が返ります。なぜかその後、適当なコマンドを送るとレスポンスコード535が返り認証エラー処理が終了します。なんで空を返すのか良く分かりませんが、ここによるとそれが正しい動きらしいのでNOOPコマンドを送るようにしています。もし問題が出るようなら、Google様の例のように空コマンドを送るように修正してください。レスポンスコード334の方では例にあるように以下のようなJSONがBASE64で返ってきました。

{"status":"400","schemes":"Bearer","scope":"https://mail.google.com/"}

省略可能なパスフレーズは、送信時の状態により以下のようになります。

状態 plstore-getのパスフレーズ入力 plstore-saveの2回のパスフレーズ入力
IMAPの受信などリフレッシュ直後 不要 不要
gpg-agentのdefault-ttl経過後 必要 不要
認証エラー(リフレッシュが必要) 必要 必要

gpg-agentのdefault-ttlなるキーワードが突然登場しましたね。一度入力したパスフレーズはgpg-agentでキャッシュされることは説明しましたが、このキャッシュには保存期間があります。それがdefault-ttlです。

default-ttlは初期値として600秒が設定されています。10分です。IMAPの受信などから10分経過した段階でメール送信を行おうとするとplstore-get用のパスフレーズの入力が必要となります。この値はgpg-agent.confという設定ファイルを作り、default-ttlというキーワードで調整できるようですが、私は試していません。

10分経過した後に、IMAP受信してもパスフレーズの入力が来ないことあるよ?って思った方は、このドキュメントの内容を良く使われている方ですね。ありがとうございます。この理由はIMAPの受信でパスフレーズの入力が必要となるタイミングはIMAPサーバーが切断してきた場合だからです。細かいタイムアウト時間は調べていませんが1時間程度放置すると切断されるようです。また最終接続時からのカウントになるので、マメに受信しているとなかなか切断されません。このことからマメに受信されている方はパスフレーズを入力しないことが多いと思いますが、メール送信に関しては先の表の通りの入力が必要です。

gpg-agentのdefault-ttlも連続アクセスすれば延長されますので、短い時間に複数のメールを送信したい場合は、最初の一回でパスフレーズを入力すれば連続送信可能なはずです。

おまけ2 WindowsのEmacs+Gnusでもビデオ会議の招待メール送りたい

2021年4月の追記
Microsoft Teamsの仕様が変わって、CF_TEXTでURLをコピーすることが可能になりました。なのでここに書いた方法を使わなくても、Gnusで招待メールが送れます。Microsoft Teamsの開発者の人たちも困ってたんだね。きっと。やったね。Zoomはアカウント持ってないのでわかりません。以下から原文です。

結論から先に言うと、Emacsだけではできません。PowerShellの力を借ります。もしEmacsだけでできることを期待されているなら、読み飛ばしてください(あと他の環境の方も)。

ご時世なのか最近流行っていますよね。ビデオ会議。私も流行に後れてはいけないと思い、クロマキーシートを買いました。初めの一歩として。

ビデオ会議を主催すると、参加者への招待メールを送るみたいなリンクとメール用のコピペボタンが表示されます。なるほどと感心しつつ、コピペボタンを押してGnusでメール作成するためにC-yしてみると『Join Microsoft Teams Meeting.Learn more about Teams』とかいう文字列がペーストされます(Microsoft Teamsの場合)。不思議に思い、放置していたWindowsのメールアプリを起動してアカウントを適当に作成してペーストしてみると、htmlのリンクとして会議用のURLがペーストされました。リンクの青い文字は『Join Microsoft Teams Meeting』です。そういうことか

WindowsのクリップボードAPIには保存するデータのデータ型を指定する引数があります。メール用のコピペボタンではここにhtmlを指定しているようです。Emacsで対応しているデータ型をソースから調べてみると、CF_TEXTというデータ型を指定しています。これはテキスト形式のことです。このためこのような問題が発生しているようです。

Emacsがテキスト形式しか対応していないのは、なんとなく理由が分かります。移植元となっているX Window System(X11)に関係しています。X11もWindowsと同様にクリップボードによるCopy&Pasteに対応しています。ただ実装はかなり素朴でルートウインドウのウインドウプロパティを使ってデータのやり取りするというものです。

ウインドウプロパティにもデータ型のような仕組みあるのですが、X11がMIPS,PowerPC,SPARC,Alphaといった様々な環境で動作することを前提としているため、結局、文字列によるやり取りが一番問題が少ないというソフトウェア作法的な発想に収まり、大抵のプログラムはテキスト形式でデータをやり取りしています。Windows版のEmacsもX11ベースからの移植なので、クリップボードの機能もX11相当の実装になっているのだと思われます。

elispからデータ型を指定できるような実装ならなんとかなりそうですが、CF_TEXTはハードコードされているため、これ以上はEmacsではどうしようもありません。ビデオ会議の招待のためだけにEmacs+Gnus以外の環境を整えるのでしょうか? なんかモヤモヤします。

解決策を模索した結果、PowerShellで処理するのが一番気持ちの均衡が保てそうという結論に至りました。以下のPowerShellスクリプトを実行するとClipToUrlという関数が定義されます。この関数はクリップボードにあるhtmlデータを取得し、html上のhrefで指定されたURLをダンプしまくります。メール用のコピペボタンを押したらこの関数を実行してください。その中にビデオ会議用のURLもあるはずなので、改めてGnusにC-yします。

Add-Type -AssemblyName System.Windows.Forms
$re = [regex]'href="([^"]+)"'

function ClipToUrl {
  $data = [Windows.Forms.Clipboard]::GetData([Windows.Forms.DataFormats]::Html)
  if ($data -ne $null)
  {
    $re.Matches($data) | foreach { $_.Groups[1].Value}
  }
}

原理主義者って愚かですね。

おまけ3 マルチアカウントで行こう。

ふと、GnusのIMAPでマルチアカウントってできるのかなと思いだしました。調べてみると、ここにあるようにnnimapの次に書く文字列がそのIMAPサーバーを特定するキーワードになっていて、アカウントとの紐づけは.authinfoのmachineキーワードで行うようです。アカウント毎のSMTPサーバーの選択は、`X-Message-SMTP-Method'というメッセージヘッダをつけてあげるとそれが使われる。とあります。

でも、実は私は、SMTPサーバーに関してはここの設定を参考に.gnus.elの設定を行ってました。この方式と先の方式の違いは、アカウント毎のSMTPサーバーのテーブルを持つことです。このテーブルにはSMTPサーバーの認証方式なども設定するので、サーバー毎にTLSの設定なども切り替えられます。こちらの方式を使っているのは、単に先の方式を知らなかっただけなのですが、IMAP+OAuth2のマルチアカウントにも応用できないでしょうか?

現在、OAuth2の情報としてclient idとclient secretをべた書きしてます。この情報はアカウントに紐づく情報なので、先のSMTPサーバーのテーブルに一緒に登録してしまうのです。そしてOAuth2接続するコードをちょっといじって、べた書きの変数名に上で設定した値を設定してしまう。いけそうじゃないですか?簡単そうだし。ちょっとソースを調べてみましょう。

うーーん。どうもOAuth2に必要な情報は以下のようになるようです。ちゃんとOAuth2の仕組み分かっている人には常識ですよね。私は先人の智慧に頼っていたのでちゃんと把握してませんでした。そして既存のコードでは、Gmail向けに固定している部分が多々あります。そのまま使うのは苦しそうですね。

OAuth2に必要な項目
クライアントID
クライアントSecret
スコープ
認証URL
トークンURL
リダイレクトURL

固定コードを排除していくと残るelispはoauth2.elだけになります。他のelispは使いまわしは難しそうです。しょうがない、SMTPのテーブルと合わせてコードを起こしましょうか。

私のLISPの知識は、littleどころかtiny lisperくらいなのでwizardな方から見ると変なコードかもしれませんがご容赦ください。以下が作ったコードです。

gnusimapoauth2.el

問題の修正1でソースの修正を行いました。入手はそちらからお願いします。

名前とプレフィックスがアホみたいに長いのは、このコードが将来、悪い影響を与えないようにするためです。こんな名前付ける奴はそうそういないでしょう。設定は以下のような感じになります。

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

(setq gnus-select-method '(nnnil "")) 

;; Gmail (IMAP)
(add-to-list
 'gnus-secondary-select-methods
 '(nnimap "gmail"
          (nnimap-address "imap.gmail.com")
          (nnimap-server-port 993)
          (nnimap-stream ssl)
         ;; Search
          (nnir-search-engine imap)))

;;
;; gmail search
;;

(require 'nnir)
(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))))

(require 'gnus-x-gm-raw)

(require 'gnusimapoauth2)

(setq gnusimapoauth2-accounts
      '(
	(:user "あなたのアカウント"
	       :smtp-server "smtp.gmail.com"
	       :smtp-port 587
	       :smtp-user "あなたのアカウント"
	       :smtp-password "notrecord"
	       :smtp-auth-supported xoauth2
	       :smtp-stream-type starttls
	       :oauth2-client-id "[あなたのアカウントのclient id]"
	       :oauth2-client-secret "[あなたのアカウントのclient secret]"
	       :oauth2-scope "https://mail.google.com/"
	       :oauth2-auth-url "https://accounts.google.com/o/oauth2/auth"
	       :oauth2-token-url "https://accounts.google.com/o/oauth2/token"
	       :oauth2-redirect-url "urn:ietf:wg:oauth:2.0:oob"
	       )
	))


(defadvice message-make-fqdn
  (around my-set-user-fqdn activate compile)
  "Change the message-id from addresse."
  (let ((from  (save-excursion
		 (message-narrow-to-headers)
		 (message-fetch-field "from" t))))
    (if (not (null from))
	(setq message-user-fqdn
	      (concat (if (string-match "^[^@]+@\\([^>]+\\)" from)
			  (match-string 1 from)
			from)))
      )
    ad-do-it)
  )

(advice-add 'nnimap-login :before-until #'gnusimapoauth2-imap-authenticator)

(setq gnus-permanently-visible-groups "^nnml\\|^nndraft:drafts\\|^nnimap\\+gmail:INBOX\\|^nnimap\\+gmail:\\[Gmail\\]")

gnusimapoauth2-accountsというのがSMTPテーブルとOAuth2用の情報をマージしたテーブル定義です。Gnusのmail-sourcesの定義をパクって似たような感じにしてみました。一応M-x customize-variableできますが面倒なので例のように書いた方が良いでしょう。各シンボルのの値は以下の通りです。

シンボル 設定値
:user IMAPの場合は、.authinfoでヒットしたアカウント。SMTPの場合はFromアドレス
:smtp-server 使用するSMTPサーバー
:smtp-port SMTPサーバーのポート
:smtp-user SMTP認証に使うユーザ
:smtp-password SMTP認証に使うパスワード
:smtp-auth-supported SMTP認証に使う方式。例の他にlogin,cram-md5など
:smtp-stream-type SMTP接続する際のTLSの使用方法
:oauth2-client-id クライアントID
:oauth2-client-secret クライアントSecret
:oauth2-scope スコープ
:oauth2-auth-url 認証URL
:oauth2-token-url トークンURL
:oauth2-redirect-url リダイレクトURL

先頭がsmtp-の部分が先の例のSMTPテーブルの内容でoauth2-が追加した内容です。smtpmail-try-auth-methodの差し替えなどもgnusimapoauth2.elで定義したので.gnus.el側はシンプルにしました。スコープや認証URLなどは先人の智慧からそのままのコピーです。

message-make-fqdnはメッセージIDのFQDNを差し替える定義なのですが、今なら多分nadviceというのでできるのかもしれません。このコードはずいぶん前に拾ってきたコードなのでdefadviceのままになっています。私、本当はmicro lisperくらいなんで、このadviceって使い方が良くわかってないんです。smtpmail-try-auth-methodの差し替えも本当はこれを使えば書けるじゃないかと思っているんですけど、元々のコードがこうなっていたのでそのまま使っています。

私の作った部分は単純でIMAPの場合は、nnimap-login時に渡されるユーザを使って、SMTPの場合は、送信メッセージのFromアドレスを使って、gnusimapoauth2-accountsを検索してヒットした内容をgnusimapoauth2-accountという構造体に設定するという仕組みです。oauth2.elの呼び出し時の引数やSMTPサーバーの設定を、この構造体から設定するようにしてアカウント毎の認証を可能にしています。詳細は後述しますがoauth2.elをそのまま使えない部分もあるためコピペして独自コードに差し替えしている部分もあります。

gnusimapoauth2-accountsの検索は、『プログラムカウンターのよる資源消費をメモリ資源の消費に差し替えるのだ』というような内容をどっかの本で読んだので、かたくなに再帰しています。普段のコード書きでも再帰ってほとんど使わないので、変なコードだなと思ったなら、あなたの感覚の方が正しいです。

マルチアカウントの定義を行う場合は、最初のURLのようにnnimapの定義を以下のようにします。add-to-listにしてますが、先の例のようにsetqでも良いです。

.gnus.el
(add-to-list
 'gnus-secondary-select-methods
 '(nnimap "work"
          (nnimap-address "imap.gmail.com")
          (nnimap-server-port 993)
          (nnimap-stream ssl)
         ;; Search
          (nnir-search-engine imap)))

(add-to-list
 'gnus-secondary-select-methods
 '(nnimap "home"
          (nnimap-address "imap.gmail.com")
          (nnimap-server-port 993)
          (nnimap-stream ssl)
          ;; Search
          (nnir-search-engine imap)))

(setq gnus-permanently-visible-groups "^nnml\\|^nndraft:drafts\\|^nnimap\\+work:INBOX\\|^nnimap\\+work:\\[Gmail\\]\\|^nnimap\\+home:INBOX\\|^nnimap\\+home:\\[Gmail\\]")

グループ名が変更になります。nnimap+workとnnimap+homeです。gnus-permanently-visible-groupsが元のままだと表示されなくなるので調整してください。

.authinfoは先の例のようにnnimapのキーワード単位にアカウントを定義します。smtpサーバーの設定であるsmtp.gmail.comもアカウント毎に用意してください。この定義がないとsmtpmail-try-auth-methodを呼ぶ際のuser引数が正しく設定されません。

.authinfo
machine work login 仕事のアカウント password notrecord
machine home login 家のアカウント password notrecord
machine smtp.gmail.com login 仕事のアカウント port 587 password notrecord
machine smtp.gmail.com login 家のアカウント port 587 password notrecord

gnusimapoauth2-accountsの定義は以下のようになります。

.gnus.el
(setq gnusimapoauth2-accounts
      '(
	(:user "仕事のアカウント"
	       :smtp-server "smtp.gmail.com"
	       :smtp-port 587
	       :smtp-user "仕事のアカウント"
	       :smtp-password "notrecord"
	       :smtp-auth-supported xoauth2
	       :smtp-stream-type starttls
	       :oauth2-client-id "[仕事のアカウントで取得したclient id]"
	       :oauth2-client-secret "[仕事のアカウントで取得したclient secret]"
	       :oauth2-scope "https://mail.google.com/"
	       :oauth2-auth-url "https://accounts.google.com/o/oauth2/auth"
	       :oauth2-token-url "https://accounts.google.com/o/oauth2/token"
	       :oauth2-redirect-url "urn:ietf:wg:oauth:2.0:oob"
	       )
	(:user "家のアカウント"
	       :smtp-server "smtp.gmail.com"
	       :smtp-port 587
	       :smtp-user "家のアカウント"
	       :smtp-password "notrecord"
	       :smtp-auth-supported xoauth2
	       :smtp-stream-type starttls
	       :oauth2-client-id "[家のアカウントで取得したclient id]"
	       :oauth2-client-secret "[家のアカウントで取得したclient secret]"
	       :oauth2-scope "https://mail.google.com/"
	       :oauth2-auth-url "https://accounts.google.com/o/oauth2/auth"
	       :oauth2-token-url "https://accounts.google.com/o/oauth2/token"
	       :oauth2-redirect-url "urn:ietf:wg:oauth:2.0:oob"
	       )
	))

client idとclient secretはアカウント単位に取得が必要です。それぞれで取得を行ってください。

確認のため久しぶりにclient idを取得したら、前とかなり違ってました。なのでちょっとまとめておきましょう。ころころ変えているようなので2021年4月版です。時間が経ってからご覧の方は、最新情報を確認してください。

  1. Google Cloud Platformの管理コンソールにログインする。
  2. タイトルバーのプロジェクト選択をクリックしてプロジェクト選択一覧を表示する。
  3. プロジェクト選択で左の方にある新しいプロジェクトを選択する。
  4. プロジェクト名入力して新しいプロジェクトを作成する。
  5. 左上のナビゲーションメニュー(Google Cloud Platformの左)をから『APIとサービス』->『ライブラリ』を選択
  6. APIとサービスの検索テキストボックスにGmailと入力してGmail APIを選択する。
  7. Gmail APIを有効化する。
  8. ナビゲーションメニューをから『APIとサービス』->『OAuth同意画面』を選択
  9. ユーザの種類はGoogle Workspaceユーザなら内部、それ以外は外部
  10. アプリ名、ユーザサポートメール、デベロッパーの連絡先を入力して次へ。アプリ名はプロジェクト名と同じで良いでしょう。メールアドレスはGmailのアドレスで
  11. スコープを追加または削除を選択
  12. フィルタにGmailと入力してGmail APIを選択
  13. Gmail APIのhttps://mail.google.com/ を選択して、下の方の更新を押す。
  14. 次へ
  15. ADD USERSでテストユーザを追加。自信のGmailアドレスで良いと思います。削除できないので入力は慎重に。
  16. ナビゲーションメニューをから『APIとサービス』->『認証情報』を選択
  17. 認証情報を作成からOAuthクライアントIDを選択
  18. アプリケーションの種類を『テレビと入力が限られたデバイス』を選択。redirect-urlにurn:ietf:wg:oauth:2.0:oobを指定しています。この指定があると、いつものコード表示画面が出るのですが、本当は自分でコード確認画面を作るのが正しいやりかたのようです。ウェブアプリケーションとかにするとURLの入力が必要になります。なので、これにしてください。自由に使えるWebサーバーがあるならウェブアプリケーションでも構いません。

以上です。長いですね。すでに作成済の画面を見ながら書いたので、多少違いあるかもしれないですが、流れとして上の通りです。なんか違うと思ったら申し訳ありませんがググってください。

公開ステータスはテストのままで使用しないとGoogleの検証がどうの言われますので、公開ステータスはテストのままにして登録を行ってください。許可画面が出る前にテストだけどいいの?的な確認が来ますがContinueしてください。

アクセストークンはアカウント単位にplstoreへの保存が必要なのですが、oauth2.elのアクセストークン用のキー生成は以下の定義になっています。

(defun oauth2-compute-id (auth-url token-url resource-url)
  "Compute an unique id based on URLs.
This allows to store the token in an unique way."
  (secure-hash 'md5 (concat auth-url token-url resource-url)))

キー生成時に使っている文字列は、auth-url,token-url,redirect-urlの3つです。.gnus.elの例にあるように、Gmailの場合、すべてのアカウントが同じ値になるので、アカウント単位にアクセストークンを保持することができません。このため、gnusimapoauth2.elでは、oauth2-auth-and-storeとoauth2-compute-idは独自の定義のものを使用しています(といってもほぼコピーなのですが)。

独自のoauth2-compute-idでは、auth-url,token-url,redirect-urlの頭にclient-idを足してMD5計算を行います。これで重複は無くなりますのでアカウント単位に情報を保持できるようになります。

plstoreのキーを変更するため、これまで使用していたplstoreは使用することはできません。差し替えた場合は、許可をやり直してください。またマルチアカウント化する際も、一挙にplstoreを作ろうとすると、どちらでログインしたら良いかなど、分からなくなることが多いので.gnus.elのadd-to-listを一つだけに絞って1アカウントづつ許可しした方が無難です。内部変数が残るので、1つのアカウントの許可が完了したら(plstoreに書き終えたら)一度emacsを落としてadd-to-listを直して再度実行するという手順を踏んだ方が良いです。小さなことからコツコツとです。

許可の際に表示されるコード表示画面にはログアウトボタンがありません。コードのコピペ後、ログアウトしないと次のアカウントが許可を前のアカウントで行うとするようで、認証エラーになる場合があります。別なタブでログイン画面を表示するなどして必ずログアウトしてから次のアカウントに進んでください。

必要となるelispを整理しましょう。以下のようになります。

elisp コメント
oauth2 OAuth2の基礎ライブラリです
google-contacts いままでありがとう
gnus-gmail-oauth いままでありがとう
gnus-x-gm-raw gmailの検索条件をG Gで使えるようにします
log4e gnus-x-gm-rawの依存ライブラリです
yaxception gnus-x-gm-rawの依存ライブラリです
gnusimapoauth2.el このドキュメントから

マルチアカウントの設定を行うとアカウント単位にplstoreへの読み込みと保存が発生します。読み込みの方はgpg-agentのキャッシュが聞くのでまだ良いのですが、保存に関しては毎回パスフレーズの入力が必要となります。1アカウント毎に、2回のパスフレーズ入力が必要なのでアカウント数*2のパスフレーズの入力が必要となってしまいます。面倒くさいですよね。the EasyPG Libraryの方にパスフレーズをキャッシュする機構があるようなのですが、ソースを読むとGnuPG 1.x系を前提にした機能のようでした。現行版である2.x系では動かないようです。またコメントにはobsoleteである旨が書いてあります。GnuPGの開発方針がgpg-agentに統一していく方向らしいのでしょうがないですね。嘆いてもしょうがないので、解消する方法を2つほど用意しました。

一つ目は解消というより軽減措置です。サーバーの状態を確認する一覧を^のgnus-group-enter-server-modeで表示させることができます。通常の接続状態だとopenedと表示されます。このサーバーの状態がdeniedになると、そのサーバーへの接続が行われなくなります。通常運用でdeniedになる可能性があるケースはサーバーへのログインに失敗した場合などです。ちなみにサーバー一覧は、qで抜けることができます。

denied状態になったサーバーは接続確認も行われなくなるので、パスフレーズの入力も不要となります。最初の起動時は全部パスフレーズを入力し、常用以外はdined状態すればパスフレーズの入力を最低限の回数に抑えることができます。帰り際に再度全部確認するという運用はどうでしょうか?

dined状態にする方法は、サーバー一覧で目的のサーバーにカーソルを移動しDを押します。denied状態を解除するのは、Cを押します。Cを押すと状態がclosedになります。この状態のサーバーはメールの一覧更新(g)で再接続が行われます。

もう一つの方法はplstoreのアクセス方法を変更する方法です。oauth2-auth-and-storeを独自にしたと書きましたが、ついでにsaveに関する動作を変更しました。oauth2-refresh-accessの差し替えも必要だったので差し替えています。

gnusimapoauth2-plstore-save-userという変数が定義できます。この変数に最後に接続するnnimapのアカウントを設定してください。設定したアカウントで接続した場合だけplstoreのsaveが発生するようになります。ちょっと間抜けな実装ですが、ご容赦ください。サーバーの接続が発生した場合、最後に必ず動く関数を探したのですが、無さそうなのこんな実装になっています。

設定する値は、gnus-secondary-select-methodsの値を確認すれば把握することができます。M-x describe-variableか*scratch*で括弧を入れずに変数名を書いてC-jしてください。リストの内容が確認できると思います。最後のnnimapの定義がこの変数に設定する値です。add-to-listで設定している場合は、値を先頭に追加する仕様なので、最初に定義した内容が最後になっていると思います。そのアカウント名を設定します。

.gnus.el
(setq gnusimapoauth2-plstore-save-user "仕事のアカウント")

この方法の弱点はsave用アカウントが接続されなくなってしまうとplstoreのsaveが行われなくなることです。

接続はサーバー単位に行っているのでタイムアウトの差などでsave用以外のアカウントは接続され、save用アカウントは接続されないといった状態が発生します。また一覧更新(g)ではなく、個別にグループを開くと、その時点で接続が発生する場合もあるため、接続タイミングが狂います。この方式の実装は接続が全サーバーで同時に発生することを前提としているので、結構、脆弱です。

pinentyの入力が来ないなと思ったら変数gnusimapoauth2-plstoreの値を確認してください。save後はnilになります。nil以外ならsave用アカウントの接続が行われなかったことを意味します。

このような状態になってしまった場合、一番簡単な対処方法は、save用アカウントのサーバーの状態をclosedにしてしまうことです。こうすると一覧更新(g)で再接続されるため、plstoreへのsaveも行われます。

もう一つの対処方法は以下の関数を*scratch*で呼び出すことです。この関数はsave用アカウントだった場合に呼び出している関数です。この呼び出しでsaveされます。

(gnusimapoauth2-plstore-save gnusimapoauth2-plstore t)

saveされないデメリットは、plstoreへの保存内容が暗号化されずにbufferに残ることです。またemacsが落ちてしまった場合などにアクセストークンが無くなってしまう可能性があります。このような状態になった場合は、最悪、再度、許可を行う必要が出るかもしれません。この方法が怪しげだなと思ったなら、gnusimapoauth2-plstore-save-userは初期値であるnilのままにしてください。この値がnilなら従来通りアカウント単位にplstoreへのsaveが行われます。

この設定を利用してOutlook.comに接続するドキュメントも作りました。興味のあるかたはぜひ

問題の修正1 Gmail以外でSMTP認証のアクセストークン切れが発生した場合

おまけ3のマルチアカウント対応で、Gmail以外のアカウントにも対応したのですが、Gmail以外のアカウントの場合、おまけ1 メール送信でパスフレーズの入力を少なくしたいで説明した認証エラーの動作が発生しない場合があるようです。というかOutlook.comでは同じ動作になりませんでした。Gmailの動作が標準なのかと思ってました。とほほ。

おまけ1では、とりあえずplstoreにあるアクセストークンで認証してみて、エラーだったらリフレッシュを行うという対応を行いました。Gmailの場合、plstoreのアクセストークンで認証エラーが発生した場合、334が返るので、NOOPコマンドを送ると535が返ると説明しました。しかしOutlook.comの場合、334が返らず直接535が返ります。つまりNOOPコマンドを送る必要が無いということです。

問題はこれだけでなく、SMTP通信に使用している、smtpmail-command-or-throw関数は、レスポンスコードが400以上の場合、問答無用で例外と投げるという動作をしていましてた。このため、Outlook.comの場合は、アクセストークン切れの状態でメール送信をすると必ず送信が失敗するという動作になっていました。確認ミスですね。すいません。

この問題に対応するため以下の対応を行いました。

  1. smtpmail-command-or-throw関数はを呼ぶのをやめて、この関数内で呼んでいる、smtpmail-send-command関数とsmtpmail-read-response関数を直接呼ぶように直した。
  2. NOOPコマンドの送信は、レスポンスコードが334が返ってきた場合だけの直した。

以下修正済の内容です。申し訳ありませんが入れ替えをお願いします。

gnusimapoauth2.el

おまけ4で修正を行いました。そちらが最新ですので、入手はそちらからお願いします。ここは最初の投稿時にソースがありました。

おまけ4 Package cl is deprecatedに対応する

Emacsのバージョンを27.2に上げました。そうすると起動時にPackage cl is deprecatedと警告されてしまうようになりました。どうも(require 'cl)しているのがいけないようです。代替策として、cl-libが用意されているので『早くそっちに切り替えてよ』という催促のようです。

clとcl-libの2つがあるのは知っていましたが、Common Lispとの互換性確保のためのライブラリという程度の認識だったので使用禁止になるとは思ってませんでした。micro lisperなのでしょうがないですね。

なんでclを使っているのかというと、ここのelispが使っていたからなのですが、コードを確認してみると、その部分は書き換えてしまっているので今は未使用です。そう言えばdefstructもcl由来で、これってoauth2.elからパクって来たよなぁと思って確認すると最新版では(require 'cl-lib)に書き換わっていて、defstructもcl-defstructに直ってました。隙を突かれた格好ですね。

再びパクって(require 'cl)を(require 'cl-lib)に直し、defstructもcl-defstructに直してコンパイルすると、loopでエラーが発生します。これがCommon Lisp由来だというのは知っていたのですが、(require 'cl-lib)しているのになぜエラーになるか分からず、結局condに書き換えてしまいました。後で良く調べたら、cl-loopというのが追加になってました。cl-libは全部頭にcl-が付くんですね。でも直してしまったのでこのまま行こうと思います。

以下対応済の内容です。後述する対応で、lexical-binding:tにした方が良さそうだったので、そっちも直しています。

gnusimapoauth2.el

おまけ6で修正を行いました。そちらが最新ですので、入手はそちらからお願いします。ここは最初の投稿時にソースがありました。

さてこれで私の作ったコードの対応は終わったのですが、gnus-x-gm-rawの方も(require 'cl)を使っています。ここによると、初期化時に

(setq byte-compile-warnings '(not cl-functions obsolete))

と書いておくと警告がでなくなるそうです。なら私のコードもこの対応で良かったのですが、バージョンが上がると回避できなくなるかもしれません。という訳で僭越ながらパッチを作成したのでそれも一応載せておきます。使用ライブラリの方の修正も必要だったので複数ファイルのパッチになっています。カレントディレクトリにgnus-x-gm-raw.el,log4e.el,yaxception.elを置いた状態で、patchコマンドを実行してください。

gnus-x-gm-raw-etc.diff
diff -cr orig/gnus-x-gm-raw.el cl-lib/gnus-x-gm-raw.el
*** orig/gnus-x-gm-raw.el	2021-10-12 16:29:57.329201300 +0900
--- cl-lib/gnus-x-gm-raw.el	2021-10-12 14:44:09.041708200 +0900
***************
*** 1,4 ****
! ;;; gnus-x-gm-raw.el --- Search mail of Gmail using X-GM-RAW as web interface
  
  ;; Copyright (C) 2014  Hiroaki Otsu
  
--- 1,4 ----
! ;;; gnus-x-gm-raw.el --- Search mail of Gmail using X-GM-RAW as web interface -*- lexical-binding:t -*-
  
  ;; Copyright (C) 2014  Hiroaki Otsu
  
***************
*** 62,68 ****
  ;; Enjoy!!!
  
  
! (eval-when-compile (require 'cl))
  (require 'gnus)
  (require 'nnimap)
  (require 'log4e)
--- 62,68 ----
  ;; Enjoy!!!
  
  
! (require 'cl-lib)
  (require 'gnus)
  (require 'nnimap)
  (require 'log4e)
***************
*** 111,117 ****
    (let (ope-or ope-not ope-phrase ope-type not-first)
      (mapconcat
       'identity
!      (loop for e in (mapcar
                       (lambda (e)
                         (gnus-x-gm-raw--trace "make literal current element : %s" e)
                         (cond ((listp e)
--- 111,117 ----
    (let (ope-or ope-not ope-phrase ope-type not-first)
      (mapconcat
       'identity
!      (cl-loop for e in (mapcar
                       (lambda (e)
                         (gnus-x-gm-raw--trace "make literal current element : %s" e)
                         (cond ((listp e)
***************
*** 143,149 ****
                               (t
                                (setq ope-type (gnus-x-gm-raw:convert-type-operator e))
                                (gnus-x-gm-raw--trace "converted type operator : %s" ope-type))))
!                      (loop for e in args append (split-string e " +")))
             if (stringp e) collect e)
       " ")))
  
--- 143,149 ----
                               (t
                                (setq ope-type (gnus-x-gm-raw:convert-type-operator e))
                                (gnus-x-gm-raw--trace "converted type operator : %s" ope-type))))
!                      (cl-loop for e in args append (split-string e " +")))
             if (stringp e) collect e)
       " ")))
  
***************
*** 152,164 ****
      (let* ((literal (gnus-x-gm-raw:make-literal args))
             (llength (string-bytes literal))
             (proc (get-buffer-process (current-buffer)))
!            (uid (incf nnimap-sequence))
             (cr (if (nnimap-newlinep nnimap-object) "" "\r"))
             (cmd (format "%s UID SEARCH CHARSET UTF-8 X-GM-RAW {%d}%s\n" uid llength cr))
             (waitf (lambda (re)
                      (yaxception:$
                        (yaxception:try
!                         (loop with elre = (format "^%s .*$" uid)
                                with cnt = 0
                                while (< cnt 10)
                                do (goto-char (point-min))
--- 152,164 ----
      (let* ((literal (gnus-x-gm-raw:make-literal args))
             (llength (string-bytes literal))
             (proc (get-buffer-process (current-buffer)))
!            (uid (cl-incf nnimap-sequence))
             (cr (if (nnimap-newlinep nnimap-object) "" "\r"))
             (cmd (format "%s UID SEARCH CHARSET UTF-8 X-GM-RAW {%d}%s\n" uid llength cr))
             (waitf (lambda (re)
                      (yaxception:$
                        (yaxception:try
!                         (cl-loop with elre = (format "^%s .*$" uid)
                                with cnt = 0
                                while (< cnt 10)
                                do (goto-char (point-min))
***************
*** 170,176 ****
                                              nil)
                                else
                                do (progn (accept-process-output proc 0.2 nil t)
!                                         (incf cnt)
                                          (sleep-for 0.5))
                                finally
                                do (gnus-x-gm-raw--error "timeout wait for response of %s" re)))
--- 170,176 ----
                                              nil)
                                else
                                do (progn (accept-process-output proc 0.2 nil t)
!                                         (cl-incf cnt)
                                          (sleep-for 0.5))
                                finally
                                do (gnus-x-gm-raw--error "timeout wait for response of %s" re)))
***************
*** 199,205 ****
      ad-do-it))
  
  (defadvice nnir-imap-next-symbol (around gnus-x-gm-raw:fix-phrase activate)
!   (lexical-let ((quoted (and gnus-x-gm-raw::active (looking-at "\""))))
      ad-do-it
      (when (and quoted ad-return-value)
        (setq ad-return-value (cons 'phrase ad-return-value)))))
--- 199,205 ----
      ad-do-it))
  
  (defadvice nnir-imap-next-symbol (around gnus-x-gm-raw:fix-phrase activate)
!   (let ((quoted (and gnus-x-gm-raw::active (looking-at "\""))))
      ad-do-it
      (when (and quoted ad-return-value)
        (setq ad-return-value (cons 'phrase ad-return-value)))))
diff -cr orig/log4e.el cl-lib/log4e.el
*** orig/log4e.el	2021-10-12 16:28:16.137639600 +0900
--- cl-lib/log4e.el	2021-10-12 16:34:32.429047100 +0900
***************
*** 1,4 ****
! ;;; log4e.el --- provide logging framework for elisp
  
  ;; Copyright (C) 2013  Hiroaki Otsu
  
--- 1,4 ----
! ;;; log4e.el --- provide logging framework for elisp -*- lexical-binding:t -*-
  
  ;; Copyright (C) 2013  Hiroaki Otsu
  
***************
*** 66,72 ****
  
  
  ;;; Code:
! (eval-when-compile (require 'cl))
  (require 'rx)
  
  
--- 66,72 ----
  
  
  ;;; Code:
! (require 'cl-lib)
  (require 'rx)
  
  
***************
*** 191,197 ****
        (insert logtext "\n")
        (when propertize-p
          (put-text-property begin (+ begin 1) 'log4e--level level))
!       (loop initially (goto-char begin)
              while (and msgargs
                         (re-search-forward log4e--regexp-msg-format nil t))
              do (let* ((currtype (match-string-no-properties 0))
--- 191,197 ----
        (insert logtext "\n")
        (when propertize-p
          (put-text-property begin (+ begin 1) 'log4e--level level))
!       (cl-loop initially (goto-char begin)
              while (and msgargs
                         (re-search-forward log4e--regexp-msg-format nil t))
              do (let* ((currtype (match-string-no-properties 0))
***************
*** 391,397 ****
             (dbgsym (log4e--make-symbol-toggle-debugging prefix))
             (codsyssym (log4e--make-symbol-buffer-coding-system prefix))
             (addrsym (log4e--make-symbol-author-mail-address prefix))
!            (funcnm-alist (loop with custom-alist = (car (cdr log-function-name-custom-alist))
                                    for lvl in '(fatal error warn info debug trace)
                                    for lvlpair = (assq lvl custom-alist)
                                    for fname = (or (cdr-safe lvlpair) "")
--- 391,397 ----
             (dbgsym (log4e--make-symbol-toggle-debugging prefix))
             (codsyssym (log4e--make-symbol-buffer-coding-system prefix))
             (addrsym (log4e--make-symbol-author-mail-address prefix))
!            (funcnm-alist (cl-loop with custom-alist = (car (cdr log-function-name-custom-alist))
                                    for lvl in '(fatal error warn info debug trace)
                                    for lvlpair = (assq lvl custom-alist)
                                    for fname = (or (cdr-safe lvlpair) "")
***************
*** 552,558 ****
           (argtext (when fstartpt (match-string-no-properties 2)))
           (prefix (save-excursion
                     (goto-char (point-min))
!                    (loop while (re-search-forward "(log4e:deflogger[ \n]+\"\\([^\"]+\\)\"" nil t)
                              for prefix = (match-string-no-properties 1)
                              for currface = (get-text-property (match-beginning 0) 'face)
                              if (not (eq currface 'font-lock-comment-face))
--- 552,558 ----
           (argtext (when fstartpt (match-string-no-properties 2)))
           (prefix (save-excursion
                     (goto-char (point-min))
!                    (cl-loop while (re-search-forward "(log4e:deflogger[ \n]+\"\\([^\"]+\\)\"" nil t)
                              for prefix = (match-string-no-properties 1)
                              for currface = (get-text-property (match-beginning 0) 'face)
                              if (not (eq currface 'font-lock-comment-face))
***************
*** 564,578 ****
               (argtext (replace-regexp-in-string "^ +" "" argtext))
               (argtext (replace-regexp-in-string " +$" "" argtext))
               (args (split-string argtext " +"))
!              (args (loop for arg in args
                              if (and (not (string= arg ""))
                                      (not (string-match "\\`&" arg)))
                              collect arg))
!              (logtext (loop with ret = (format "start %s." fncnm)
                                 for arg in args
                                 do (setq ret (concat ret " " arg "[%s]"))
                                 finally return ret))
!              (sexpformat (loop with ret = "(%s--log 'trace \"%s\""
                                    for arg in args
                                    do (setq ret (concat ret " %s"))
                                    finally return (concat ret ")")))
--- 564,578 ----
               (argtext (replace-regexp-in-string "^ +" "" argtext))
               (argtext (replace-regexp-in-string " +$" "" argtext))
               (args (split-string argtext " +"))
!              (args (cl-loop for arg in args
                              if (and (not (string= arg ""))
                                      (not (string-match "\\`&" arg)))
                              collect arg))
!              (logtext (cl-loop with ret = (format "start %s." fncnm)
                                 for arg in args
                                 do (setq ret (concat ret " " arg "[%s]"))
                                 finally return ret))
!              (sexpformat (cl-loop with ret = "(%s--log 'trace \"%s\""
                                    for arg in args
                                    do (setq ret (concat ret " %s"))
                                    finally return (concat ret ")")))
diff -cr orig/yaxception.el cl-lib/yaxception.el
*** orig/yaxception.el	2021-10-12 16:29:21.959657400 +0900
--- cl-lib/yaxception.el	2021-10-12 13:17:25.968514000 +0900
***************
*** 1,4 ****
! ;;; yaxception.el --- Provide framework about exception like Java for Elisp
  
  ;; Copyright (C) 2013  Hiroaki Otsu
  
--- 1,4 ----
! ;;; yaxception.el --- Provide framework about exception like Java for Elisp -*- lexical-binding:t -*-
  
  ;; Copyright (C) 2013  Hiroaki Otsu
  
***************
*** 90,96 ****
  
  
  ;;; Code:
! (require 'cl)
  
  
  (defvar yaxception-debug-enable nil)
--- 90,96 ----
  
  
  ;;; Code:
! (require 'cl-lib)
  
  
  (defvar yaxception-debug-enable nil)
***************
*** 116,122 ****
      (erase-buffer)))
  
  
! (defstruct yaxception name msgtmpl parent tmplkeys)
  
  
  (defvar yaxception-custom-err-hash (make-hash-table :test 'equal))
--- 116,122 ----
      (erase-buffer)))
  
  
! (cl-defstruct yaxception name msgtmpl parent tmplkeys)
  
  
  (defvar yaxception-custom-err-hash (make-hash-table :test 'equal))
***************
*** 128,134 ****
  (defvar yaxception-signal-hook-function 'yaxception-build-stacktrace)
  
  
! (defun* yaxception:deferror (errsymbol parent errmsgtmpl &rest tmplkeys)
    "Define custom error.
  
  ERRSYMBOL is symbol for custom error. It's OK that not yet defined symbol.
--- 128,134 ----
  (defvar yaxception-signal-hook-function 'yaxception-build-stacktrace)
  
  
! (cl-defun yaxception:deferror (errsymbol parent errmsgtmpl &rest tmplkeys)
    "Define custom error.
  
  ERRSYMBOL is symbol for custom error. It's OK that not yet defined symbol.
***************
*** 149,155 ****
      (error (message "[yaxception:deferror] %s" (error-message-string e))
             nil)))
  
! (defmacro* yaxception:$ (try &rest catch_or_finally)
    "Start handling error.
  
  TRY is a `yaxception:try' sexp.
--- 149,155 ----
      (error (message "[yaxception:deferror] %s" (error-message-string e))
             nil)))
  
! (cl-defmacro yaxception:$ (try &rest catch_or_finally)
    "Start handling error.
  
  TRY is a `yaxception:try' sexp.
***************
*** 165,173 ****
  
  If you mind the decrease of performance by this function, see `yaxception:$~'."
    (declare (indent 0))
!   (lexical-let* (catches finally)
      (condition-case e
!         (loop for e in catch_or_finally
                for s = (when (listp e) (car e))
                for symbolnm = (when s (format "%s" s))
                do (cond ((string= symbolnm "yaxception:catch")   (cond (catches
--- 165,173 ----
  
  If you mind the decrease of performance by this function, see `yaxception:$~'."
    (declare (indent 0))
!   (let* (catches finally)
      (condition-case e
!         (cl-loop for e in catch_or_finally
                for s = (when (listp e) (car e))
                for symbolnm = (when s (format "%s" s))
                do (cond ((string= symbolnm "yaxception:catch")   (cond (catches
***************
*** 191,197 ****
                        ,yaxception-return-value)))
           ,finally))))
  
! (defmacro* yaxception:$~ (try &rest catch_or_finally)
    "Wrapper of `yaxception:$' to keep performance.
  
  This function has the following restriction in exchange for performance.
--- 191,197 ----
                        ,yaxception-return-value)))
           ,finally))))
  
! (cl-defmacro yaxception:$~ (try &rest catch_or_finally)
    "Wrapper of `yaxception:$' to keep performance.
  
  This function has the following restriction in exchange for performance.
***************
*** 200,206 ****
    `(let ((yaxception-signal-hook-function nil))
       (yaxception:$ ,try ,@catch_or_finally)))
  
! (defmacro* yaxception:try (&rest body)
    "Execute BODY.
  
  BODY is sexp.
--- 200,206 ----
    `(let ((yaxception-signal-hook-function nil))
       (yaxception:$ ,try ,@catch_or_finally)))
  
! (cl-defmacro yaxception:try (&rest body)
    "Execute BODY.
  
  BODY is sexp.
***************
*** 210,216 ****
    (declare (indent 0))
    `(progn ,@body))
  
! (defmacro* yaxception:catch (errsymbol errvar &rest body)
    "Execute BODY if the error happened that has ERRSYMBOL in `error-conditions'.
  
  ERRSYMBOL is symbol of a error or parent error that want to catch.
--- 210,216 ----
    (declare (indent 0))
    `(progn ,@body))
  
! (cl-defmacro yaxception:catch (errsymbol errvar &rest body)
    "Execute BODY if the error happened that has ERRSYMBOL in `error-conditions'.
  
  ERRSYMBOL is symbol of a error or parent error that want to catch.
***************
*** 227,233 ****
               (setq ,yaxception-errcatched t)
               ,@body))))
  
! (defmacro* yaxception:finally (&rest body)
    "Execute BODY.
  
  BODY is sexp.
--- 227,233 ----
               (setq ,yaxception-errcatched t)
               ,@body))))
  
! (cl-defmacro yaxception:finally (&rest body)
    "Execute BODY.
  
  BODY is sexp.
***************
*** 237,243 ****
    (declare (indent 0))
    `(progn ,@body))
  
! (defmacro* yaxception:throw (err_or_errsymbol &rest args &allow-other-keys)
    "Raise error directly or create and raise error from given value.
  
  ERR_OR_ERRSYMBOL is variable or symbol. Accept the following value.
--- 237,243 ----
    (declare (indent 0))
    `(progn ,@body))
  
! (cl-defmacro yaxception:throw (err_or_errsymbol &rest args &allow-other-keys)
    "Raise error directly or create and raise error from given value.
  
  ERR_OR_ERRSYMBOL is variable or symbol. Accept the following value.
***************
*** 325,331 ****
             "")))
  
  
! (defun* yaxception-throw-custom-err (errsymbol errinfoh)
    (yaxception-debug "start throw custom err : %s" errsymbol)
    (let* ((parents (yaxception-get-err-parents errsymbol))
           (errmsg (yaxception-get-err-msg errsymbol errinfoh)))
--- 325,331 ----
             "")))
  
  
! (cl-defun yaxception-throw-custom-err (errsymbol errinfoh)
    (yaxception-debug "start throw custom err : %s" errsymbol)
    (let* ((parents (yaxception-get-err-parents errsymbol))
           (errmsg (yaxception-get-err-msg errsymbol errinfoh)))
***************
*** 333,348 ****
          (progn
            (put errsymbol 'error-conditions parents)
            (put errsymbol 'error-message errmsg)
!           (loop for k being the hash-keys in errinfoh using (hash-values v)
                  if (and (symbolp k)
                          (string-match "^:" (symbol-name k)))
                  do (put errsymbol k v)))
        (error (message "[yaxception-throw-custom-err] %s" (error-message-string e))))
      (signal errsymbol (gethash " " errinfoh))))
  
! (defun* yaxception-get-err-info-hash (&rest args &allow-other-keys)
    (condition-case e
!       (loop with s
              with h = (make-hash-table :test 'equal)
              for e in args
              do (cond ((and (symbolp e)
--- 333,348 ----
          (progn
            (put errsymbol 'error-conditions parents)
            (put errsymbol 'error-message errmsg)
!           (cl-loop for k being the hash-keys in errinfoh using (hash-values v)
                  if (and (symbolp k)
                          (string-match "^:" (symbol-name k)))
                  do (put errsymbol k v)))
        (error (message "[yaxception-throw-custom-err] %s" (error-message-string e))))
      (signal errsymbol (gethash " " errinfoh))))
  
! (cl-defun yaxception-get-err-info-hash (&rest args &allow-other-keys)
    (condition-case e
!       (cl-loop with s
              with h = (make-hash-table :test 'equal)
              for e in args
              do (cond ((and (symbolp e)
***************
*** 378,384 ****
               (msgtmpl (cond ((yaxception-p e) (yaxception-msgtmpl e))
                              (t                (get errsymbol 'error-message))))
               (msgtmpl (if (functionp msgtmpl) (funcall msgtmpl) msgtmpl))
!              (msgargs (loop for k in tmplkeys
                              for s = (intern (concat ":" (symbol-name k)))
                              collect (gethash s errinfoh))))
          (apply 'format msgtmpl msgargs))
--- 378,384 ----
               (msgtmpl (cond ((yaxception-p e) (yaxception-msgtmpl e))
                              (t                (get errsymbol 'error-message))))
               (msgtmpl (if (functionp msgtmpl) (funcall msgtmpl) msgtmpl))
!              (msgargs (cl-loop for k in tmplkeys
                              for s = (intern (concat ":" (symbol-name k)))
                              collect (gethash s errinfoh))))
          (apply 'format msgtmpl msgargs))
***************
*** 386,392 ****
             "")))
  
  (defun yaxception-get-err-symbols ()
!   (loop for s in (apropos-internal "^[a-z\\-:/]+$")
          when (yaxception-err-symbol-p s)
          collect s))
  
--- 386,392 ----
             "")))
  
  (defun yaxception-get-err-symbols ()
!   (cl-loop for s in (apropos-internal "^[a-z\\-:/]+$")
          when (yaxception-err-symbol-p s)
          collect s))
  
***************
*** 421,427 ****
            (forward-line 1)
            (beginning-of-line)
            (let* ((ctxtype)
!                  (calllist (loop for line = (replace-regexp-in-string "[\0\r\n]" "" (thing-at-point 'line))
                                   until (or (string-match yaxception-regexp-yaxception-in-backtrace line)
                                             (eobp))
                                   for c = (cond ((string-match yaxception-regexp-function-in-backtrace line)
--- 421,427 ----
            (forward-line 1)
            (beginning-of-line)
            (let* ((ctxtype)
!                  (calllist (cl-loop for line = (replace-regexp-in-string "[\0\r\n]" "" (thing-at-point 'line))
                                   until (or (string-match yaxception-regexp-yaxception-in-backtrace line)
                                             (eobp))
                                   for c = (cond ((string-match yaxception-regexp-function-in-backtrace line)

修正内容は、(require 'cl)を(require 'cl-lib)に直したのと、clで定義されてい関数などの頭にcl-を付けただけです。lexical-letというを使っていたのですが、lexical-binding:tにすると普通のletでも良さそうだったので、そう直しています。micro lisperが人様のコードに手を加えて申し訳ありません。私が使用している範囲では問題なく動作しています。

おまけ5 plstoreをちょっと操作できるようにする

マルチアカウントの設定を行うとplstoreに複数のキーが作成されます。Outlook.comで問題になったのですが、特定のアカウントだけ許可をやり直したい場合、plstoreから該当キーを削除する必要があります。plstore-deleteという関数があるので、これを使えば良いと思って試したのですが、何故かうまく行きません。というわけで、ちょっとしたサポートツールを書きました。

ちょこっとツールなので初期化で読み込んだりする必要は無いでしょう。必要な時にM-x load-fileするかM-x eval-bufferなどで定義してください。定義すると、gnumsimapoauth2support-search-idとgnumsimapoauth2support-copy-plstoreという関数が*scratch*で使えるようになります。

gnusimapoauth2support.el
gnusimapoauth2support.el
;;; gnusimapoauth2support.el ---  gnusimapoauth2 hepler tool -*- lexical-binding:t -*-

(require 'gnusimapoauth2)

(defun gnumsimapoauth2support-search-id (from)
  (gnusimapoauth2-search-accounts from)
  (gnusimapoauth2-compute-id gnusimapoauth2-account-oauth2-client-id
			     gnusimapoauth2-account-oauth2-auth-url
			     gnusimapoauth2-account-oauth2-token-url
			     gnusimapoauth2-account-oauth2-scope)
)

(defun gnumsimapoauth2support-copy-plstore (id from to)
  (let*
      ((fromstore (plstore-open from))
       (tostore (plstore-open to))
       fromlist)
    (setq fromlist (cdr (plstore-get fromstore id)))
    (plstore-put tostore id nil `(:access-token
                                  ,(plist-get fromlist :access-token)
                                  :refresh-token
                                  ,(plist-get fromlist :refresh-token)
                                  :access-response
                                  ,(plist-get fromlist :access-response)))
    (plstore-save tostore)
    (plstore-close fromstore)
    (plstore-close tostore))
)

(provide 'gnusimapoauth2support)

gnumsimapoauth2support-search-idは、指定されたアカウントからplstoreのキー値を取得する関数です。gnumsimapoauth2support-copy-plstoreは指定されたアカウントidの値をコピー元のファイルからコピー先のファイルへコピーします。引数は以下のようになります。

(gnumsimapoauth2support-search-id "アカウント")

(gnumsimapoauth2support-copy-plstore "アカウントのid" "コピー元ファイル名" "コピー先ファイル名")

例えば3個のアカウントがあって、2個目のアカウントを削除する場合は、以下のように関数を呼び出します。

(gnumsimapoauth2support-copy-plstore (gnumsimapoauth2support-search-id "1個目のアカウント") "~/.emacs.d/oauth2.plstore" "~/backup-oauth2.plstore")

(gnumsimapoauth2support-copy-plstore (gnumsimapoauth2support-search-id "3個目のアカウント") "~/.emacs.d/oauth2.plstore" "~/backup-oauth2.plstore")

これで2個目のアカウントを除いた、~/backup-oauth2.plstoreが出来上がるので、これを~/.emacs.d/oauth2.plstoreにdired等でrenameすれば2個目のアカウントの削除されたことにります。もしoauth2のplstoreファイル名を変更しているなら、変更後のファイル名を指定してください。

関数はgnusimapoauth2-accountsを参照するので初期化後に使用してください。このドキュメントのサンプル通りならgnusを起動すれば初期化されます。

おまけ6 マルチアカウント時のパスフレーズ入力を改善する

マルチアカウント運用を続けていて、思った通りには動いているのですが、save用アカウントが接続されないケースはやっぱり発生していて、なんかいまいちだなぁと思い続けていました。

save用アカウントが接続されない場合、おまけ3に書いたようにgnusimapoauth2-plstore-saveを明に呼び出すという運用はやっていなくて、^でサーバー一覧を出して、save用アカウントをclosedにして一覧更新(g)をするという方法に落ち着きました。

そんな中、mail-sourcesにpopサーバーだけじゃなくfileというキーワードを登録できることに気づきました。fileの場合、指定したパスを検索する仕組みが動くようです。キーワードで動作を変更できるなら、plstore-saveとかいうキーワードを追加して、その中でsaveするようにできるんじゃないかと思いだし、調査すると、なんと使えそうなhookを発見しました。前に調べた時は目が節穴だったですね。

このhookをググってみると、このような例を見つけました。この例は、新しい記事の到着を監視するために、このhookを使っているようです。gnus-after-getting-new-news-hookは一覧更新した場合、つまりgを押した時に最後の呼ばれるhookのようです。そしてgnus-summary-exit-hookは特定のグループを選択して抜ける際に呼ばれるhookのようです。私が希望するタイミングと合ってそうです。

gnus-summary-exit-hookの方は、ちょっと気になって調べてみましたが、選択した直後に呼ばれるのではなく、qで抜ける時に動作するhookでした。ソースを再度調べるとgnus-summary-generate-hookというhookもあって、こっちが一覧を生成した時に呼ばれるhookで私が望むタイミングのhookでした。

メッセージをダンプするだけのテストhookを作って、さらに調査するとgnus-after-getting-new-news-hookは起動時には呼ばれないことが分かりました。これを補うためのgnus-started-hookというhookがあるのも発見したので、この3つのhookを使えばplstoreがopenしたタイミングでsaveすることができそうです。

というわけで修正版です。

gnusimapoauth2.el
gnusimapoauth2.el
;;; gnusimapoauth2.el --- Poor support for OAuth 2 with IMAP and SMTP protocols -*- lexical-binding:t -*-

(require 'cl-lib)
(require 'smtpmail)
(require 'message)
(require 'oauth2)
(require 'nnimap)
(require 'gnus-start)
(require 'gnus-sum)
(require 'gnus-util)

;; smtpmail.el customize  variable.
(setq send-mail-function 'smtpmail-send-it
      message-send-mail-function 'smtpmail-send-it
      )

(cl-defstruct gnusimapoauth2-account
   user
   smtp-server
   smtp-port
   smtp-user
   smtp-password
   smtp-auth-supported
   smtp-stream-type
   oauth2-client-id
   oauth2-client-secret
   oauth2-scope
   oauth2-auth-url
   oauth2-token-url
   oauth2-redirect-url)

(defcustom gnusimapoauth2-accounts '(())
  "gnus smtp and oauth2 account."
  :group 'gnusimapoauth2
  :version "26.2"
  :type `(choice
	  (const :tag "None" nil)
	  (repeat :tag "List"
  	   (checklist :tag "Options" :greedy t
		    (group :inline t
			   (const :format "" :value :user)
			   (string :tag "User"))
		    (group :inline t
			   (const :format "" :value :smtp-server)
			   (string :tag "SMTP Server"))
		    (group :inline t
			   (const :format "" :value :smtp-port)
			   (choice :tag "SMTP Port"
				   :value 25
				   (integer :format "%v")
				   (string :format "%v")))
		    (group :inline t
			   (const :format "" :value :smtp-user)
			   (string :tag "SMTP AUTH User"))
		    (group :inline t
			   (const :format "" :value :smtp-password)
			   (string :tag "SMTP AUTH Password"))
		    (group :inline t
			   (const :format ""
				  :value :smtp-auth-supported)
			   (choice :tag "SMTP AUTH Supported"
				   :value login
				   (const cram-md5)
				   (const login)
				   (const xoauth2)
				   (const plain)))
		    (group :inline t
			   (const :format ""
				  :value :smtp-stream-type)
			   (choice :tag "SMTP Stream Type"
				   :value plain
				   (const starttls)
				   (const ssl)
				   (const plain)))
		    (group :inline t
			   (const :format "" :value :oauth2-client-id)
			   (string :tag "OAUTH2 Client Id"))
		    (group :inline t
			   (const :format "" :value :oauth2-client-secret)
			   (string :tag "OAUTH2 Client Secret"))
		    (group :inline t
			   (const :format "" :value :oauth2-scope)
			   (string :tag "OAUTH2 Scope"))
		    (group :inline t
			   (const :format "" :value :oauth2-auth-url)
			   (string :tag "OAUTH2 AUTH URL"))
		    (group :inline t
			   (const :format "" :value :oauth2-token-url)
			   (string :tag "OAUTH2 Token URL"))
		    (group :inline t
			   (const :format "" :value :oauth2-redirect-url)
			   (string :tag "OAUTH2 Redirect URL"))
		    ))))


(defun gnusimapoauth2-set-account(account)
  (let (key val)
    (when (not (null account))
      (setq key (car account))
      (setq account (cdr account))
      (setq val (car account))
      (cond ((eq key :user) (setq gnusimapoauth2-account-user val))
	((eq key :smtp-server ) (setq gnusimapoauth2-account-smtp-server val))
	((eq key :smtp-port  ) (setq gnusimapoauth2-account-smtp-port val))
	((eq key :smtp-user ) (setq gnusimapoauth2-account-smtp-user val))
	((eq key :smtp-password ) (setq gnusimapoauth2-account-smtp-auth val))
	((eq key :smtp-auth-supported ) (setq gnusimapoauth2-account-smtp-auth-supported val))
	((eq key :smtp-stream-type ) (setq gnusimapoauth2-account-smtp-stream-type val))
	((eq key :oauth2-client-id ) (setq gnusimapoauth2-account-oauth2-client-id val))
	((eq key :oauth2-client-secret ) (setq gnusimapoauth2-account-oauth2-client-secret val))
	((eq key :oauth2-scope) (setq gnusimapoauth2-account-oauth2-scope val))
	((eq key :oauth2-auth-url) (setq gnusimapoauth2-account-oauth2-auth-url val))
	((eq key :oauth2-token-url) (setq gnusimapoauth2-account-oauth2-token-url val))
	((eq key :oauth2-redirect-url) (setq gnusimapoauth2-account-oauth2-redirect-url val))
	)
      (gnusimapoauth2-set-account (cdr account))
      )
    )
  )

(defun gnusimapoauth2-reset-account()
    (setq gnusimapoauth2-account-user           nil)
    (setq gnusimapoauth2-account-smtp-server    nil)
    (setq gnusimapoauth2-account-smtp-port      nil)
    (setq gnusimapoauth2-account-smtp-user      nil)
    (setq gnusimapoauth2-account-smtp-password  nil)
    (setq gnusimapoauth2-account-smtp-auth-supported  nil)
    (setq gnusimapoauth2-account-smtp-stream-type      nil)
    (setq gnusimapoauth2-account-oauth2-client-id      nil)
    (setq gnusimapoauth2-account-oauth2-client-secret  nil)
    (setq gnusimapoauth2-account-oauth2-scope nil)
    (setq gnusimapoauth2-account-oauth2-auth-url  nil)
    (setq gnusimapoauth2-account-oauth2-token-url  nil)
    (setq gnusimapoauth2-account-oauth2-redirect-url  nil)
  )


(defun gnusimapoauth2-search-accountsr(from accounts)
  (when (not (null accounts))
    (gnusimapoauth2-reset-account)
    (gnusimapoauth2-set-account (car accounts))
    (if (not (string-match gnusimapoauth2-account-user from))
	(gnusimapoauth2-search-accountsr from (cdr accounts))
      't
      )
    
    )
  )

(defun gnusimapoauth2-search-accounts(from)
  (when (not (gnusimapoauth2-search-accountsr from gnusimapoauth2-accounts))
    (gnusimapoauth2-reset-account)
    (error "gnusimapoauth2 account not found: `%s'." from)
    )
  )

(defun gnusimapoauth2-change-smtp ()
  "Change the SMTP server according to the current from line."
  (save-excursion
    (let ((from
	  (save-restriction
	    (message-narrow-to-headers)
	    (message-fetch-field "from" t))
	  ))
	  (gnusimapoauth2-search-accounts from)
      (cond
       ((memq gnusimapoauth2-account-smtp-auth-supported
	      '(cram-md5 plain login xoauth2))
	; set envelope from variable.
	(setq smtpmail-mail-address (if (string-match "^.*<\\(.*\\)>.*$" from) (match-string 1 from) from))
	;
	; set smtp variable.
	;
	(setq smtpmail-smtp-server gnusimapoauth2-account-smtp-server
	      smtpmail-smtp-service gnusimapoauth2-account-smtp-port
	      smtpmail-smtp-user gnusimapoauth2-account-smtp-user
	      smtpmail-auth-supported (list gnusimapoauth2-account-smtp-auth-supported)
	      smtpmail-stream-type gnusimapoauth2-account-smtp-stream-type)
	(message "Setting SMTP server to `%s:%s' for user `%s'."
		 gnusimapoauth2-account-smtp-server gnusimapoauth2-account-smtp-port gnusimapoauth2-account-smtp-user)
	)
       ))
    )
  )


(defvar %smtpmail-via-smtp (symbol-function 'smtpmail-via-smtp))
(defun smtpmail-via-smtp (recipient smtpmail-text-buffer
				    &optional ask-for-password)
  (with-current-buffer smtpmail-text-buffer
    (gnusimapoauth2-change-smtp))
  (funcall (symbol-value '%smtpmail-via-smtp) recipient smtpmail-text-buffer ask-for-password))

;;
;; (custom-set-variables
;; '(gnusimapoauth2-plstore-save-hook t))
;;

(defcustom gnusimapoauth2-plstore-save-hook nil
  "Use hook to save plstore.
Set the value with custom-set-variables.
Because setter doesn't work"
  :group 'gnusimapoauth2
  :type 'boolean
  :set (lambda (sym val)
         (custom-set-default sym val)
         (cond 
	     (val
	       (add-hook 'gnus-started-hook
			 'gnusimapoauth2-plstore-hook)
	       (add-hook 'gnus-after-getting-new-news-hook
			 'gnusimapoauth2-plstore-hook)
	       (add-hook 'gnus-summary-generate-hook
			 'gnusimapoauth2-plstore-hook)
	       )
	   (t
	     (remove-hook 'gnus-started-hook
			  'gnusimapoauth2-plstore-hook)
	     (remove-hook 'gnus-after-getting-new-news-hook
			  'gnusimapoauth2-plstore-hook)
	     (remove-hook 'gnus-summary-generate-hook
			  'gnusimapoauth2-plstore-hook)
	     ))
         )
  )

(defvar gnusimapoauth2-plstore nil)

(defun gnusimapoauth2-plstore-open (file)
  (if gnusimapoauth2-plstore-save-hook
      (if gnusimapoauth2-plstore gnusimapoauth2-plstore
	(progn
	  (gnus-message 7 "Open. Save gnusimapoauth2-plstore")
	  (setq gnusimapoauth2-plstore (plstore-open file)))
	)
    (progn
      (if gnusimapoauth2-plstore
	  (progn
	    (plstore-save gnusimapoauth2-plstore)
	    (setq gnusimapoauth2-plstore nil)))
      (plstore-open file)
      )
    )
  )

(defun gnusimapoauth2-plstore-save (plstore closeflag)
  (if gnusimapoauth2-plstore-save-hook
      (if closeflag
	(if gnusimapoauth2-plstore
	      (progn
		(plstore-save gnusimapoauth2-plstore)
		(setq gnusimapoauth2-plstore nil)
		(gnus-message 7 "Save. close gnusimapoauth2-plstore"))
	  (gnus-message 7 "Save. skip close"))
	)
    (plstore-save plstore)
    )
  )

(defun gnusimapoauth2-compute-id (client-id auth-url token-url resource-url)
  (secure-hash 'md5 (concat client-id auth-url token-url resource-url)))

(defun gnusimapoauth2-refresh-access (token closeflag)
  (setf (oauth2-token-access-token token)
        (cdr (assoc 'access_token
                    (oauth2-make-access-request
                     (oauth2-token-token-url token)
                     (concat "client_id=" (oauth2-token-client-id token)
                             "&client_secret=" (oauth2-token-client-secret token)
                             "&refresh_token=" (oauth2-token-refresh-token token)
                             "&grant_type=refresh_token")))))
  ;; If the token has a plstore, update it
  (let ((plstore (oauth2-token-plstore token)))
    (when plstore
      (plstore-put plstore (oauth2-token-plstore-id token)
                   nil `(:access-token
                         ,(oauth2-token-access-token token)
                         :refresh-token
                         ,(oauth2-token-refresh-token token)
                         :access-response
                         ,(oauth2-token-access-response token)
                         ))
      (gnusimapoauth2-plstore-save plstore closeflag)))
  token)

(defun gnusimapoauth2-auth-and-store (from closeflag)
  (gnusimapoauth2-search-accounts from)
  ;; plstore key MD5 concat clinet-id auth-url token-url scope
  (let* ((plstore (gnusimapoauth2-plstore-open oauth2-token-file))
         (id (gnusimapoauth2-compute-id gnusimapoauth2-account-oauth2-client-id
					gnusimapoauth2-account-oauth2-auth-url
					gnusimapoauth2-account-oauth2-token-url
					gnusimapoauth2-account-oauth2-scope))
         (plist (cdr (plstore-get plstore id))))
    ;; Check if we found something matching this access
    (if plist
        ;; We did, return the token object
        (make-oauth2-token :plstore plstore
                           :plstore-id id
                           :client-id gnusimapoauth2-account-oauth2-client-id
                           :client-secret gnusimapoauth2-account-oauth2-client-secret
                           :access-token (plist-get plist :access-token)
                           :refresh-token (plist-get plist :refresh-token)
                           :token-url gnusimapoauth2-account-oauth2-token-url
                           :access-response (plist-get plist :access-response))
      (let ((token (oauth2-auth gnusimapoauth2-account-oauth2-auth-url
				gnusimapoauth2-account-oauth2-token-url
                                gnusimapoauth2-account-oauth2-client-id
				gnusimapoauth2-account-oauth2-client-secret
				gnusimapoauth2-account-oauth2-scope
				nil
				gnusimapoauth2-account-oauth2-redirect-url)))
        ;; Set the plstore
        (setf (oauth2-token-plstore token) plstore)
        (setf (oauth2-token-plstore-id token) id)
        (plstore-put plstore id nil `(:access-token
                                      ,(oauth2-token-access-token token)
                                      :refresh-token
                                      ,(oauth2-token-refresh-token token)
                                      :access-response
                                      ,(oauth2-token-access-response token)))
        (gnusimapoauth2-plstore-save plstore closeflag)
        token)))
  )


(defun gnusimapoauth2-token (from closeflag)
  "Get OAuth token."
  (let ((token (gnusimapoauth2-auth-and-store from closeflag)))
    ;; HACK -- always refresh
    (gnusimapoauth2-refresh-access token closeflag)
    token))

(defun gnusimapoauth2-imap-authenticator (user password)
  "Authenticator for Imap OAuth2.  Use as before-until advice for nnimap-login."
  (if (nnimap-capability "AUTH=XOAUTH2")
      (let ((token (gnusimapoauth2-token user (not gnusimapoauth2-plstore-save-hook))) 
	    access-token)
	(setq access-token (oauth2-token-access-token token))
	(if (or (null token)
		(null access-token))
	    nil
	  (let (sequence response)
	    (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)) t)
			    ))
	    (setq response (nnimap-get-response sequence))
	    ;;(save-excursion (message "debug1:%s" response))
	    ;; next line is response
	    (if (nnimap-ok-p response)
		  (cons t response)
	      ;; send empty response on error
	      (progn
		(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) )
	    )))
    )
  )

(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 (gnusimapoauth2-auth-and-store user t))
            access-token
            ret)
        (setq access-token (oauth2-token-access-token token))
        (setq ret (progn
		     (smtpmail-send-command
		      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))
		      )
		     (smtpmail-read-response process)))
        (when (not (eq (car ret) 235))
	  (when (eq (car ret) 334)
	    (smtpmail-send-command process "NOOP")
	    (smtpmail-read-response process)
	    )
          (setq token (gnusimapoauth2-token user t))
          (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)


(defun gnusimapoauth2-plstore-hook ()
  (when gnusimapoauth2-plstore-save-hook
    (gnus-message 7 "Run gnusimapoauth2-plstore-hook")
    (gnusimapoauth2-plstore-save gnusimapoauth2-plstore t)
    )
  )

(provide 'gnusimapoauth2)

gnusimapoauth2-plstore-save-userは廃止しました。その代わりにgnusimapoauth2-plstore-save-hookというカスタマイズ変数を作りました。-hookですが関数ではありません。booleanの変数です。この値をtにすると先に上げたhookでplstoreのsaveが動きます。

defcustomにsetterが定義できるのを見つけたのでgnusimapoauth2-plstore-save-hookに付けています。先ほど説明したhookへの追加(add-hook)は、setterを使って実現しています。このsetterはsetqだと動かなくなってしまうので、以下のようにcustom-set-variablesを使って設定してください。

.gnus.el
(require 'gnusimapoauth2)

(custom-set-variables
 '(gnusimapoauth2-plstore-save-hook t))

gnusimapoauth2-plstore-save-hookの定義はgnusimapoauth2.el内で行っているので、必ずrequire後に値を設定してください。EmacsのM-x customizeを使うと.emacsにcustom-set-variablesを追加すると思います。このタイミングだとrequireされていない可能性があるので、必ず手で追加してください。

一度設定したら、変更することはないと思いますが、値をnilに戻す場合もcustom-set-variablesを使用してください。この時もsetterが動き、remove-hookが動作してhookを削除します。

gnusimapoauth2-plstore-save-hookをいじらなければhookは追加されないので、これまで通りの動作になります。

gnusimapoauth2-plstore-save-hookを設定すると、save用のパスフレーズを入力するタイミングが変わります。gnusimapoauth2-plstore-save-hookが未設定の場合はログイン時にパスフレーズの入力を求められますが、設定後は一覧更新が終了した段階で入力するように変わります。これはgnus-after-getting-new-news-hookの呼び出しタイミングがそこだからです。グループを選択した場合のgnus-summary-generate-hookは、これまでと同じようなタイミングなので違和感はないと思います。

おまけ7 GmailのOAuth out-of-band(OOB)廃止に対応する

再びGoole様の魔の手が迫ってます。OOBを廃止するから対応しろというメールが突然、到来しました。聖域に再び危機が訪れています。ところでOOBって何ですか?

OAuth OOBとかでググると認証フローがどうのと色々難しいことが書いてあるWebページがヒットします。ちゃんとした内容は、ちゃんと分かった人が書いている資料を見た方が良いと思うので、そちらでお願いします。このドキュメントが扱っている部分で関係があるのは、:oauth2-redirect-urlに指定しているurn:ietf:wg:oauth:2.0:oobをやめろということのようです。この指定があると接続を許可した時にGoogle様によってコード確認画面が表示されます。

そう言えばOutlook.comへの接続ドキュメントを書いている時に、なんか非推奨になっているみたいなことを、どっかで読んだなぁと思いつつ。Googole様の参考にしろと言っているURLを見てみました。詳細はリンク先を見て頂きたいですけど要約すると以下のような感じのようです。

  • ループバック IP アドレスフローを禁止
    • redirect_uriへのlocalhostの指定をやめろ
  • OAuth アウトオブバンド（OOB）フローが非推奨に
    • redirect_uriへのurn:ietf:wg:oauth:2.0:oobの指定をやめろ

今回メールで警告されたのは下の方です。またこの制限はアプリの公開ステータスがテストなら対象にならないとあります。Google Cloud Platformの管理コンソールでアプリを登録する際、『OAuth同意画面』でユーザの種類を選択できます。普通のGmailを使っている場合は外部を選んでいると思いますが、その場合、公開ステータスをテストにしておかないとGoogle様の審査が必要とか言われるので、テストにしていると思います。この状態なら今回の対応は不要ということになります。一方でGoogle Workspaceユーザの場合、内部が選択可能になり、これが選択されていると公開ステータスが非表示になりGoolge様の審査が無いですが、公開している状態になります。今回警告されたはこっちの場合です。私はGoogle Workspaceユーザで、ユーザの種類を内部としているので警告の対象となりました。

公開ステータスをテストにされている場合は、対応不要です。でもここに書いてある内容を対応しても問題ないので、特別な理由がないなら対応された方が良いのではないかと思います。いつ危機が訪れるか分からないからです。

さて、先ほどのURLに対応方法というのが載っています。デスクトップアプリとして登録しているので、そちらを見てみるとループバック IPとURIスキームというので対応しろとあります。ループバックIPも廃止になるんだから、URIスキームを使わないといけないんでしょうけど、これストアからダウンロードするUWPアプリじゃないとダメみたいです。そもそもWindows以外のOSどうすんだよって話です。

Goolge様ついにやりやがった。排除だわ。営利企業だわ。自分たちの利益にならないアプリは使わせないつもりだわ。詰んだわ。

と思ったのですが、私の読解力が足りないだけでした。ごめんなさいGoogle様。ループバックIPの廃止は、iOS、Android、Chrome アプリに限るみたいです。デスクトップアプリは使って良いみたいです。良かったですね。今ってmacOSってiOSと統合されてんですよね?この記述がモバイル系だけを前提にしているのかは分からいです。

gnusimapoauth2-accountsの定義を以下のように変更しましょう。:oauth2-redirect-urlの部分を書き換えです。

.gnus.el
(setq gnusimapoauth2-accounts
      '(
	(:user "仕事のアカウント"
	       :smtp-server "smtp.gmail.com"
	       :smtp-port 587
	       :smtp-user "仕事のアカウント"
	       :smtp-password "notrecord"
	       :smtp-auth-supported xoauth2
	       :smtp-stream-type starttls
	       :oauth2-client-id "[仕事のアカウントで取得したclient id]"
	       :oauth2-client-secret "[仕事のアカウントで取得したclient secret]"
	       :oauth2-scope "https://mail.google.com/"
	       :oauth2-auth-url "https://accounts.google.com/o/oauth2/auth"
	       :oauth2-token-url "https://accounts.google.com/o/oauth2/token"
	       :oauth2-redirect-url "https://localhost/"
	       )
	(:user "家のアカウント"
	       :smtp-server "smtp.gmail.com"
	       :smtp-port 587
	       :smtp-user "家のアカウント"
	       :smtp-password "notrecord"
	       :smtp-auth-supported xoauth2
	       :smtp-stream-type starttls
	       :oauth2-client-id "[家のアカウントで取得したclient id]"
	       :oauth2-client-secret "[家のアカウントで取得したclient secret]"
	       :oauth2-scope "https://mail.google.com/"
	       :oauth2-auth-url "https://accounts.google.com/o/oauth2/auth"
	       :oauth2-token-url "https://accounts.google.com/o/oauth2/token"
	       :oauth2-redirect-url "https://localhost/"
	       )
	))

これでOOBの廃止に対応完了です。この対応を行うと許可の動作が変更になります。おおむねOutlook.comへの接続ドキュメントで書いたような動きになります。

許可が完了するとコードを表示するためにredirect_uriに遷移しますが、その際、以下のようなURLになります。

https://localhost/?code=XXXX&scope=https://mail.google.com/

code=XXXXのXXXX部分がGoogle様のコード表示画面に表示されていたコードです。普通はローカルにTLSなWebサーバーが動いていないと思います。なので上記に遷移しようとしても遷移できませんというエラーになります。でもアドレス部分には上記URLが表示されているので、それをコピペすれば、これまでのようにEmacsへコードを入力することが可能です。EdgeとFirefoxで試しましたがアドレスにURLは残ったままだったので他のブラウザでも同様ではないかと思います。

今回の廃止処置って、このコードの流出を防ぎたいからなのだと思いますが、自分のブラウザのアドレス部にコードが表示されてしまうと誰かに見られてしまうかもしれませんね。長くて覚えられないから良いのでしょうか。でも後ろに立っている人が完全記憶能力を持っていたら覚えられちゃいますよね。後ろに完全記憶能力を持った人が立っていないことを確認してから許可した方が良いでしょう。結局、セキュリティってなんらかの想定があって成り立っているものなのに、大抵の場合、詳しい説明をぜずに使えば良いみたいな雰囲気で強要されるので困ったもんですよね。スマホを使う系は特に。最近だと銀行アプリがそんな感じになっているように感じますす。一応サポート窓口みたいなのありますけど、そこのオペレーターさんがすべてを理解して説明しているとは思えないですからね。ここでは品質管理の父と言われる石川馨先生の言葉をパクッて偉ぶってみましょう。セキュリティは教育に始まり、教育に終わる。

おまけ8 Emacs 28.1に対応する

Emacsを28.1に上げました。gnusimapoauth2.elに関しては特に問題ないのですが、なんと検索に使っていたnnirが今回からobsoleteになってしましました。Gnus起動時におまけ4と同様にdeprecatedの警告が表示されます。酷い去年、直したばっかりなのに...

まぁちゃんと開発を追っかけない不良ユーザだからいけないんですよね。nnirに変わってnnselectという仕組みに切り替わったようです。IMAPサーバーの検索もgnus-search.elで行われるようになりました。インターフェースが変わってこれまでのコードを使うことができません。すっごく後ろ向きだったんですけど、しょうがないのでコードを書きました。以下です。

gnus-x-gm-raw-search.el
gnus-x-gm-raw-search.el
;;; gnus-x-gm-raw-search.el --- Search Gmail for Gnus -*- lexical-binding:t -*-
;;;
;;; .gnus.el:
;;;   (advice-add 'gnus-search-run-search :before-until #'gnus-x-gm-raw-search-run-search)
;;;

(require 'gnus-search)
(require 'nnheader)
(require 'nnimap)

(defcustom gnus-x-gm-raw-search-gmail-server
  "imap.gmail.com"
  "A regexp to match gmail server."
  :group 'gnus-x-gm-raw-search
  :version "28.1"
  :type 'regexp)



(defun gnus-x-gm-raw-search-wait-for-response (process elre)
  (let (openp)
    (condition-case nil
        (progn
	  (goto-char (point-max))
	  (while (and (setq openp (memq (process-status process)
					'(open run)))
		      (progn
			;; Skip past any "*" lines that the server has
			;; output.
			(while (and (not (bobp))
				    (progn
				      (forward-line -1)
				      (looking-at "\\*\\|[0-9]+ OK NOOP"))))
			(not (re-search-forward elre nil t))))
	    (nnheader-accept-process-output process)
	    (goto-char (point-max)))
          openp)
      (quit
       (when debug-on-quit
	 (debug "Quit"))
       ;; The user hit C-g while we were waiting: kill the process, in case
       ;; it's a gnutls-cli process that's stuck (tends to happen a lot behind
       ;; NAT routers).
       (delete-process process)
       nil))))

(defun gnus-x-gm-raw-search-run-search (engine server query groups)
  (save-excursion
    (let ((svrlist (gnus-server-to-method server))
	  svr addr q-string llength proc uid cr cmd grouplist group
	  artlist result
	  (coding-system-for-write 'utf-8-unix))
      (when (eq (car svrlist) 'nnimap)
	(setq addr (cadr (assq 'nnimap-address svrlist)))
	(when (string-match gnus-x-gm-raw-search-gmail-server addr)
	  (message "gnus-x-gm-raw-search")
	  (setq svr (cadr svrlist))
	  (message "Opening server %s" svr)
	  (gnus-open-server server)
	  (setq grouplist (or groups (gnus-search-get-active server)))
	  (setq q-string (gnus-search-make-query-string engine query))
	  (setq llength (string-bytes q-string))

	  (while (and (setq group (pop grouplist)) (null artlist))
	    (when (nnimap-change-group
		   (gnus-group-short-name group) svr)
	      (with-current-buffer (nnimap-buffer)
		(message "Searching %s..." group)
		(setq proc (get-buffer-process (current-buffer)))
		(setq uid (cl-incf nnimap-sequence))
		(setq cr (if (nnimap-newlinep nnimap-object) "" "\r"))
		(setq cmd (format "%s UID SEARCH CHARSET UTF-8 X-GM-RAW {%d}%s\n" uid llength cr))
		(setf (nnimap-last-command-time nnimap-object) (current-time))
		(process-send-string proc cmd)
		(when (gnus-x-gm-raw-search-wait-for-response
		       proc "^\\+ go ahead\\s-*$")
		  (erase-buffer)
		  (process-send-string proc (concat q-string cr "\n"))
		  (setf (nnimap-initial-resync nnimap-object) 0)
		  (setq result (nnimap-get-response uid))
		  (when (car result)
		    (setq artlist
			  (vconcat
			   (mapcar
			    (lambda (artnum)
			      (let ((artn (string-to-number artnum)))
				(when (> artn 0)
				  (vector group artn 100))))
			    (cdr (assoc "SEARCH" (cdr result))))
			   artlist))
		    )
		  )
		(message "Searching %s...done" group)
		)
	      )
	    )
	  (nreverse artlist))
	)
     )
    )
  )

(provide 'gnus-x-gm-raw-search)

gnus-search-run-searchという関数が検索を行う実体なのですが、この関数、cl-defmethodというので定義されています。この定義方法はC++やJavaで言うところのOverload、Lispだとgenericの一種になるのでしょうか。引数の型によって実装を切り替える仕組みで定義されています。advice-addでこの関数を差し替えているのですが、指定引数でのadvice-addの方法が分からないので、関数の頭でGmail用のimapサーバに接続して検索しようとしているのか確認しています。具体的には接続サーバーがimap.gmail.comかどうかなのですが、この部分は変数にしていて変更可能です。gnus-x-gm-raw-search-gmail-serverという変数をstring-matchの第一引数に指定しているので、もし変わったら、この値を調整してください。以下のようなelispを*scratch*で実行すれば何にすれば良いか確認できると思います。行末でC-jです。

.gnus.el

(string-match "\\(altgmail.exsample.com\\|imap.gmail.com\\)" "altgmail.exsample.com")

gnus-x-gm-raw-search-gmail-serverはdefcustomで定義しているので、custom-set-variablesで設定した方が良いですが、setterは未定義なのでsetqでも動きます。一貫性ありませんね。

.gnus.elのnnir関連の定義は削ってください。代わりにgnus-x-gm-raw-search.elの読み込みとadvice-addを追加します。

.gnus.el
...

;; Gmail (IMAP)
(add-to-list
 'gnus-secondary-select-methods
 '(nnimap "gmail"
          (nnimap-address "imap.gmail.com")
          (nnimap-server-port 993)
          (nnimap-stream ssl)
          ;; Search
;;削除     (nnir-search-engine imap)
	  ))

;;
;; gmail search
;;

;;削除(require 'nnir)
;;削除(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))))
;;削除
;;削除(require 'gnus-x-gm-raw)

;;追加
(require 'gnus-x-gm-raw-search)
(advice-add 'gnus-search-run-search :before-until #'gnus-x-gm-raw-search-run-search)

;; 必要なら
;;(custom-set-variables
;; '(gnus-x-gm-raw-search-gmail-server "imap.gmail.com"))


(require 'gnusimapoauth2)
;; 必要なら
;;(custom-set-variables
;; '(gnusimapoauth2-plstore-save-hook t))

...

使い方はこれまでと一緒です。検索したいグループでG Gを押します。入力可能なキーワードとこれまでと一緒で、Gmailで使用できる検索演算子はすべて使用できます。Gmail以外の接続の場合は、nnselectがもともと持っているコードが動きます。でもこのコードって多分日本語での検索はサポートされていないと思います。ASCIIなら検索可能だと思いますので、その範囲で使ってください。

あとがき

昔、新世紀エヴァンゲリオンの考察同人誌というのを読んだことがあって、”あとがき”みたいな部分に、”この本を書く上でいろいろなことを調べた(死海文書?とか)。異論や反論があるなら、最低限自分と同じレベルの調査を行ってからじゃないと聞く耳持たない。”というようなことが書いてあって同人誌っていうのは凄い世界だなぁと思いました。

19
17
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
Sign upLogin
19
17

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?