Emacs/Mew で毛色の変わった IMAP4 サーバと話せるようにした件

Emacs/Mew について

Emacs はエディタというか環境と いうかなにかそんなもの。 詳しく知りたい?じゃあ、近くに居るUNIX遣いを捕まえて聞いてみてほしい。 知らないってヤツは多分モグリだけど、中にはコチコチの vi 教信者もいるから要注意。幸運を祈っている。 あ、僕?僕は Emacsもviも大好き ですよ、はい。

MewEmacs 上で動くMUAの一つで、僕はこれが 一番使いやすい。 なんといってもLispで実装されているので素敵なのである。(ミーハー)

MewはもちろんIMAP4に対応している。まあプロトコルでいえばIMAP4だけじゃ なくてSMTP, Submission, POP3, NNTPなんかも扱える。基本のメール読み書き の機能がしっかりしているだけではなくて、細かいところに気の利いた工夫が 入っているところが素晴らしい。

今回の問題は、特に名を秘す某所のIMAP4サーバの細かい動作がいわゆる普通 のIMAP4とは違ってたってことだ。規格のオプション部分に対応してないって だけなので、どっちが悪いっていう話でもないんだけど、そのせいで、Mewか らアクセスするとメッセージをフォルダへ整理できない場合があることが判明 した。

動かないシーケンス

MewでIMAP4を使う設定にしていると、立ち上げ直後は Summaryモード に居ることに なる。 メールのDate・From/To・Subject・bodyの一部を1メッセージ1行で列挙した アレだ。

適当にメールを取り込んだ後なら、読み終わったメールを ‘o’ で フォルダ に整理する こともあ るだろう。 ところが、整理先のフォルダが存在しない時、フォルダを作成できずに失敗す るというのが今回の現象である。

つまり、Summaryモードであるメッセージに対して’o’して整理先として例え ば’%foo/bar’を指定した時、fooなりbarなりが存在しない時にはミニバッファ で

%foo/bar does not exist. Create it? (y or n)

と訊かれる。(これは正常) 当然に’y’と答えると、今度はミニバッファにエラーメッセージが表示される。

Cannot create ‘%foo/bar’ or the messages do not exist

‘mew-debug’変数を’t’にしてMewのデバッグ出力を追うと、いきなり’COPY foo/bar’を試みて失敗し、そのまま終了(ここではLOGOUT)していることがわか る。

<=SEND=> aszu2871 UID COPY 38276 “foo/bar”

<COPY> aszu2871 NO UID COPY non-existed mailbox

<=SEND=> wukd7922 LOGOUT

処理を追う

フォルダ作るかと聞いておいて敢えて作りに行かないってのはかなりロックな 感じがするので、少し追ってみた。

この’o’は mew-summary-refile に紐付けられていて、要はそのメールをど のフォルダに整頓するかをマーク付けするのである。 実際にそのフォルダ(がなければ作ってそこ)へ移動させるのは引き続く ‘x’ ( mew-summary-exec ) である。

で、この’x’の先の処理がどうなっているかを見ていくと、次の順で関数を呼 び出していくことがわかる。(半泣きで edebug-defun を叩いてたのは 秘密です)

  • mew-summary-exec
  • mew-summary-exec-region
  • mew-summary-exec-remote ← IMAP4を扱うので -remote。POP3なんかだと実 体をローカルに持ってきちゃうので -local に分岐。
  • mew-summary-exec-remote-get-execinfo ← execinfo を作ってやるべきこ とを書き込み、mew-imap-*系の関数に引き渡す。
  • mew-imap-retrieve
  • ネットワークプロセスを作ってmew-imap-filterやmew-imap-sentinelを登録 する。
  • mew-imap-fsm 変数に定義された状態遷移表に従って必要な処理を行う。

全部読んでるわけではないので錯誤はあると思うが、まあだいたいこんな感じ。 で、その mew-imap-fsm はどうなっているかというと、

(defvar mew-imap-fsm
‘((“greeting” (“OK” . “capability”))
(“capability” (“OK” . “post-capability”))
(中略)

(“uid” (“OK” . “umsg”)) (“copy” (“OK” . “copy”) (“NO \[TRYCREATE\]” . “create”) (“NO” . “wmbx”)) (“create” (“OK” . “copy”) (“NO” . “wmbx”)) (“dels” (“OK” . “dels”)) ;; xxx NG but loop

(後略)

こうなっていて、左辺の copy が mew-imap-command-copy 呼び出しに対応し、 その戻りが OK ならもう一度 mew-imap-command-copy を呼び出す、NO だけな ら mew-imap-command-wmbx (Wrong Mailboxということらしい。エラールーチ ン) を呼ぶ、あるいは、NO [TRYCREATE] と返ってくれば mew-imap-command-create を呼び出すような動きである。

つまり、Mew の側の動きとしては、フォルダが存在するか否かを気にせずにま ずは copy を試みて、「失敗。フォルダ作ってみれ?」と言われれば作りに行 くが、単に「失敗」と言われたら「そんなフォルダございませんことよ」とば かりにエラーにするわけである。

何とか動かす

普通のIMAP4 サーバならこれで動くのだろうけれど、ここのやつは TRYCREATE なんていう気の利いた応答はしないので、問題現象が発現するわけだ。

そこで、なんとか動くようにしたのが次のパッチである。 あちこちに mew-imap-debug でデバッグ出力を入れてあるが、もちろんこれら は処理の本筋には関係ない。Mew で print文デバッグをやってみたというだけ のことだが、きっと3日もすればやり方を忘れちゃうので残しておく。

--- mew-imap.el.orig 2014-04-29 20:43:10.000000000 +0900
+++ mew-imap.el      2015-04-10 14:55:20.489544400 +0900
@@ -64,7 +64,9 @@
     ("select"        ("OK" . "post-select"))
     ("flags"         ("OK" . "flags")) ;; xxx NG but loop
     ("uid"           ("OK" . "umsg"))
-    ("copy"          ("OK" . "copy") ("NO \\[TRYCREATE\\]" . "create") ("NO" . "wmbx"))
+    ;;    ("copy"          ("OK" . "copy") ("NO \\[TRYCREATE\\]" . "create") ("NO" . "wmbx"))
+    ("copy"          ("OK" . "copy") ("NO" . "precreate"))
+    ("precreate"     ("OK" . "create") ("NO" . "create"))
     ("create"        ("OK" . "copy") ("NO" . "wmbx"))
     ("dels"      ("OK" . "dels")) ;; xxx NG but loop
     ("expunge"       ("OK" . "post-expunge"))
@@ -421,6 +423,11 @@
       (mew-imap-set-status pnm "dels") ;; logout
       (mew-imap-command-dels pro pnm))
      (t
+      ;; moto kawasaki
+      (mew-imap-debug
+       "pre-copy"
+       (format "rtt=%s rttl=%s dttl=%s jcnt=%s.\n" rtt rttl dttl jcnt))
+
       (cond
        (jcnt
        (cond
@@ -451,6 +458,12 @@
         (rtr (car rtrs))
         (dst (mew-copyinfo-get-dst rtr))
         (uid (mew-copyinfo-get-uid rtr)))
+
+    ;; moto kawasaki
+    (mew-imap-debug
+     "copy"
+     (format "rtrs=%s rtr=%s dst=%s uid=%s.\n" rtrs rtr dst uid))
+
     (if (null rtr)
        (cond
         ((mew-imap-get-dels pnm)
@@ -464,19 +477,62 @@
       (setq dst (mew-imap-expand-mailbox
                 case (mew-imap-utf-7-encode-string dst)))
       (mew-imap-set-rfl pnm rtr)
+
+      ;; moto kawasaki
+      (mew-imap-debug
+       "copy2"
+       (format "rtrs=%s rtr=%s dst=%s uid=%s.\n" rtrs rtr dst uid))
+
       (if spam
          (mew-imap-process-send-string pro pnm "COPY %s \"%s\"" uid dst)
        (mew-imap-process-send-string pro pnm "UID COPY %s \"%s\"" uid dst)))))

+(defun mew-imap-command-precreate (pro pnm)
+  (let* ((case (mew-imap-get-case pnm))
+     (rtrs (mew-imap-get-rtrs pnm))
+     (rtr (mew-imap-get-rfl pnm))
+     (dst (mew-copyinfo-get-dst rtr))) ;; 'exec or 'jobs
+
+    ;; moto kawasaki
+    (mew-imap-debug
+     "precreate"
+     (format "rtrs=%s rtr=%s dst=%s.\n" rtrs rtr dst))
+
+;;    (mew-imap-set-rgcnt pnm (1- (mew-imap-get-rgcnt pnm)))
+;;    (mew-imap-set-rtrs pnm (cons rtr rtrs))
+    (setq dst (mew-imap-expand-mailbox
+           case (mew-imap-utf-7-encode-string dst)))
+
+    (setq dst (replace-regexp-in-string "/[^/]*$" "" dst))  ;; moto kawasaki
+
+    ;; moto kawasaki
+    (mew-imap-debug
+     "precreate2"
+     (format "rtrs=%s rtr=%s dst=%s.\n" rtrs rtr dst))
+
+    (mew-imap-process-send-string pro pnm "CREATE \"%s\"" dst)))
+
 (defun mew-imap-command-create (pro pnm)
   (let* ((case (mew-imap-get-case pnm))
         (rtrs (mew-imap-get-rtrs pnm))
         (rtr (mew-imap-get-rfl pnm))
         (dst (mew-copyinfo-get-dst rtr))) ;; 'exec or 'jobs
+
+    ;; moto kawasaki
+    (mew-imap-debug
+     "create"
+     (format "rtrs=%s rtr=%s dst=%s.\n" rtrs rtr dst))
+
     (mew-imap-set-rgcnt pnm (1- (mew-imap-get-rgcnt pnm)))
     (mew-imap-set-rtrs pnm (cons rtr rtrs))
     (setq dst (mew-imap-expand-mailbox
               case (mew-imap-utf-7-encode-string dst)))
+
+    ;; moto kawasaki
+    (mew-imap-debug
+     "create2"
+     (format "rtrs=%s rtr=%s dst=%s.\n" rtrs rtr dst))
+
     (mew-imap-process-send-string pro pnm "CREATE \"%s\"" dst)))

 (defun mew-imap-escape-format (str)
@@ -998,6 +1054,11 @@
   (let ((str (apply 'format args))
        (tag (mew-imap-tag)))
     (mew-imap-debug "=SEND=" (concat tag " " str))
+
+    ;; moto kawasaki
+    (mew-imap-debug "process-send-string"
+                    (format "rtrs=%s." (mew-imap-get-rtrs pnm)))
+
     (mew-imap-set-tag pnm tag)
     (if (and (processp pro) (eq (process-status pro) 'open))
        (process-send-string pro (concat tag " " str mew-cs-eol))
@@ -1399,6 +1460,12 @@
         (bytes (mew-imap-get-bytes pnm))
         stay next func code)
     (mew-imap-debug (upcase status) string)
+
+    ;; moto kawasaki
+    (mew-imap-debug
+     "filter"
+     (format "pnm=%s status=%s tag=%s eos=%s bytes=%s rtrs=%s.\n"
+             pnm status tag eos bytes (mew-imap-get-rtrs pnm)))
     (mew-filter
      ;; Process's buffer
      (goto-char (point-max))
@@ -1410,6 +1477,7 @@
                        (mew-imap-get-rttl pnm)
                        (mew-imap-get-rcnt pnm)
                        (mew-refileinfo-get-size (car (mew-imap-get-rtrs pnm)))
+
                        nil
                        (mew-imap-secure-p pnm))
        (goto-char (point-min))
@@ -1454,6 +1522,13 @@
        (mew-imap-set-status pnm next)
        (setq func (intern-soft (concat "mew-imap-command-" next)))
        (goto-char (point-min))
+
+       ;; moto kawasaki
+       (mew-imap-debug
+        "filter"
+        (format "next=%s status=%s func=%s rtrs=%s.\n"
+                next status func (mew-imap-get-rtrs pnm)))
+
        (if (fboundp func)
           (funcall func process pnm)
         (error "No function called %s" (symbol-name func)))

パッチの肝は次のとおりである。

  1. (パッチの冒頭で) mew-imap-fsm をいじって copy の戻りに TRYCREATE を 期待しない代わりに NO なら precreate へ遷移するようにした。
  2. precreate は新しい状態で、これに対応する mew-imap-command-precreate も新しく定義された関数である。
  3. mew-imap-command-precreate はパッチの中央付近に定義されている通りで、 作成するべきフォルダを特定して、そのフォルダを作成するような CREATE コマンド (これは IMAP4 プロトコル上のコマンド) を発行する。
  4. precreate では、フォルダ名 foo/bar が渡された時には / の後ろ側を削 りとった残りの foo を作成するように動く。これと後続の create が foo/bar を作成する(これは元々の動き)ことで2段階のフォルダの作成が できるようにしてある。
  5. precreate の戻りが OK でも NO でも、本来の流れ (copy → create に沿 うように precreate 状態から create 状態へ遷移させる。

見ての通り、1段または2段の新フォルダなら作成できるが、3段またはそれ 以上の新フォルダには対応していない。(1段目が既存のフォルダで2段目・ 3段目を新規に作ることは可能な気がする)

いかにも quick dirty hack だが、まあ、これでなんとか生きていけるのであっ た。

追記

2017/Nov/27 時点で Mew 6.6 に当たるパッチは以下の通り。 でもダメだこれ、新規にフォルダーの下にrefileできない。

*** mew-imap.el.orig.20171127        2015-02-06 12:15:34.000000000 +0900
--- mew-imap.el      2017-11-27 10:49:41.000000000 +0900
***************
*** 64,70 ****
      ("select"        ("OK" . "post-select"))
      ("flags"         ("OK" . "flags")) ;; xxx NG but loop
      ("uid"           ("OK" . "umsg"))
!     ("copy"          ("OK" . "copy") ("NO \\[TRYCREATE\\]" . "create") ("NO" . "wmbx"))
      ("create"        ("OK" . "copy") ("NO" . "wmbx"))
      ("dels"             ("OK" . "dels")) ;; xxx NG but loop
      ("expunge"       ("OK" . "post-expunge"))
--- 64,72 ----
      ("select"        ("OK" . "post-select"))
      ("flags"         ("OK" . "flags")) ;; xxx NG but loop
      ("uid"           ("OK" . "umsg"))
!     ;;    ("copy"          ("OK" . "copy") ("NO \\[TRYCREATE\\]" . "create") ("NO" . "wmbx"))
!     ("copy"          ("OK" . "copy") ("NO" . "precreate"))
!     ("precreate"     ("OK" . "create") ("NO" . "create"))
      ("create"        ("OK" . "copy") ("NO" . "wmbx"))
      ("dels"             ("OK" . "dels")) ;; xxx NG but loop
      ("expunge"       ("OK" . "post-expunge"))
***************
*** 421,426 ****
--- 423,433 ----
        (mew-imap-set-status pnm "dels") ;; logout
        (mew-imap-command-dels pro pnm))
       (t
+       ;; moto kawasaki
+       (mew-imap-debug
+        "pre-copy"
+        (format "rtt=%s rttl=%s dttl=%s jcnt=%s.\n" rtt rttl dttl jcnt))
+
        (cond
         (jcnt
     (cond
***************
*** 451,456 ****
--- 458,467 ----
      (rtr (car rtrs))
      (dst (mew-copyinfo-get-dst rtr))
      (uid (mew-copyinfo-get-uid rtr)))
+          ;; moto kawasaki
+          (mew-imap-debug
+           "copy"
+           (format "rtrs=%s rtr=%s dst=%s uid=%s.\n" rtrs rtr dst uid))
      (if (null rtr)
     (cond
      ((mew-imap-get-dels pnm)
***************
*** 464,482 ****
--- 475,530 ----
        (setq dst (mew-imap-expand-mailbox
              case (mew-imap-utf-7-encode-string dst)))
        (mew-imap-set-rfl pnm rtr)
+       ;; moto kawasaki
+       (mew-imap-debug
+        "copy2"
+        (format "rtrs=%s rtr=%s dst=%s uid=%s.\n" rtrs rtr dst uid))
        (if spam
       (mew-imap-process-send-string pro pnm "COPY %s \"%s\"" uid dst)
     (mew-imap-process-send-string pro pnm "UID COPY %s \"%s\"" uid dst)))))

+ (defun mew-imap-command-precreate (pro pnm)
+   (let* ((case (mew-imap-get-case pnm))
+      (rtrs (mew-imap-get-rtrs pnm))
+      (rtr (mew-imap-get-rfl pnm))
+      (dst (mew-copyinfo-get-dst rtr))) ;; 'exec or 'jobs
+
+     ;; moto kawasaki
+     (mew-imap-debug
+      "precreate"
+      (format "rtrs=%s rtr=%s dst=%s.\n" rtrs rtr dst))
+
+ ;;    (mew-imap-set-rgcnt pnm (1- (mew-imap-get-rgcnt pnm)))
+ ;;    (mew-imap-set-rtrs pnm (cons rtr rtrs))
+     (setq dst (mew-imap-expand-mailbox
+            case (mew-imap-utf-7-encode-string dst)))
+
+     (setq dst (replace-regexp-in-string "/[^/]*$" "" dst))  ;; moto kawasaki
+
+     ;; moto kawasaki
+     (mew-imap-debug
+      "precreate2"
+      (format "rtrs=%s rtr=%s dst=%s.\n" rtrs rtr dst))
+
+     (mew-imap-process-send-string pro pnm "CREATE \"%s\"" dst)))
+
  (defun mew-imap-command-create (pro pnm)
    (let* ((case (mew-imap-get-case pnm))
      (rtrs (mew-imap-get-rtrs pnm))
      (rtr (mew-imap-get-rfl pnm))
      (dst (mew-copyinfo-get-dst rtr))) ;; 'exec or 'jobs
+    ;; moto kawasaki
+    (mew-imap-debug
+     "create"
+     (format "rtrs=%s rtr=%s dst=%s.\n" rtrs rtr dst))
      (mew-imap-set-rgcnt pnm (1- (mew-imap-get-rgcnt pnm)))
      (mew-imap-set-rtrs pnm (cons rtr rtrs))
      (setq dst (mew-imap-expand-mailbox
            case (mew-imap-utf-7-encode-string dst)))
+     ;; moto kawasaki
+     (mew-imap-debug
+      "create2"
+      (format "rtrs=%s rtr=%s dst=%s.\n" rtrs rtr dst))
      (mew-imap-process-send-string pro pnm "CREATE \"%s\"" dst)))

  (defun mew-imap-escape-format (str)
***************
*** 998,1003 ****
--- 1046,1056 ----
    (let ((str (apply 'format args))
     (tag (mew-imap-tag)))
      (mew-imap-debug "=SEND=" (concat tag " " str))
+
+     ;; moto kawasaki
+     (mew-imap-debug "process-send-string"
+                     (format "rtrs=%s." (mew-imap-get-rtrs pnm)))
+
      (mew-imap-set-tag pnm tag)
      (if (and (processp pro) (eq (process-status pro) 'open))
     (process-send-string pro (concat tag " " str mew-cs-eol))
***************
*** 1399,1404 ****
--- 1452,1463 ----
      (bytes (mew-imap-get-bytes pnm))
      stay next func code)
      (mew-imap-debug (upcase status) string)
+
+     ;; moto kawasaki
+     (mew-imap-debug
+      "filter"
+      (format "pnm=%s status=%s tag=%s eos=%s bytes=%s rtrs=%s.\n"
+              pnm status tag eos bytes (mew-imap-get-rtrs pnm)))
      (mew-filter
       ;; Process's buffer
       (goto-char (point-max))
***************
*** 1454,1459 ****
--- 1513,1525 ----
         (mew-imap-set-status pnm next)
         (setq func (intern-soft (concat "mew-imap-command-" next)))
         (goto-char (point-min))
+
+        ;; moto kawasaki
+        (mew-imap-debug
+         "filter"
+         (format "next=%s status=%s func=%s rtrs=%s.\n"
+                 next status func (mew-imap-get-rtrs pnm)))
+
         (if (fboundp func)
        (funcall func process pnm)
      (error "No function called %s" (symbol-name func)))

備考

2015/Jun/12 作成

GNU Emacs 24.4.1 (i686-pc-cygwin) of 2015-02-01 on gnupack と Mew version 6.6 で作業した。