[mew-dist 29300] Re: Bcc/Dcc の痕跡がほしい

[Hayashi Masahiro ( 林 雅博 )]

林と申します。

From: script concept <concept.script at example.com>
Subject: [mew-dist 29294] Bcc/Dcc の痕跡がほしい
Date: Sat, 11 Dec 2010 02:09:42 +0900

>  Bcc あるいは Dcc を使った場合、Fcc したバックアップファイルでは自分が一体誰
> に対して Bcc あるいは Dcc したのか、記録が残りません。
>  これがわかるような（残るような）方法はないでしょうか？

私は Bcc をめったにしないので、そんなに必要を感じないのですが、前にちょっ
と作ってあったので改修して動くようにしてみました。あまりよいアイデアで
もないですが、もしかするとお役に立つかもしれないので投稿します。

# 動きますかね。(^^;

Bcc: はごく稀に使うのですが、Dcc: は今はじめて使ったのでよくわかってい
ません。

mew-fcc に設定してあるフォルダ内でのみ bcc を推測して X-Mew: で表示しま
す。To: フィールドの parse 、 Message-Id: の parse などなど、あまりちゃん
と作ってませんが、個人利用の拡張ならこれで充分かもなぁと。

--
 Hayashi Masahiro


(defvar mew-my-bcc-sent-interval-threshold (* 60 60)
  "Seconds of maximum interval between original message and bcc/dcc message.
Default is 1 hour.")

;; Get Bcc: and Dcc: in `mew-fcc' folder.
(defadvice mew-xinfo-get-xcc 
  (around mew-my-bcc-get-guessed-bcc (fld msg) activate)
  (if (and (mew-fcc) (string= (mew-fcc) fld))
      (let* ((msgid (mew-header-get-value mew-message-id:))
             (logs (mew-my-bcc/dcc-guessed-from-smtplog msgid))
             bccs dccs x-mew value)
        (when logs
          (setq bccs (mew-my-bcc-filter msgid logs))
          (when bccs
            ;; newline must be
            (setq value (format "%s %s\n" mew-bcc: (mapconcat 'identity bccs ", ")))
            (setq x-mew (cons value x-mew)))
          (setq dccs (mew-my-dcc-filter logs))
          (when dccs
            ;; newline must be
            (setq value (format "%s %s\n" mew-dcc: (mapconcat 'identity dccs ", ")))
            (setq x-mew (cons value x-mew)))
          (setq ad-return-value x-mew)))
    ad-do-it))

(defun mew-my-dcc-filter (logs)
  (let ((subj (mew-header-get-value mew-subj:))
        (to (mew-header-get-value mew-to:))
        (cc (mew-header-get-value mew-cc:))
        (addrs (split-string (nth 1 (car logs)) ","))
        ret)
    (unless (string= mew-bcc-subject subj)
      (mapc
       (lambda (addr)
         (let ((regexp (concat "\\b" (regexp-quote addr) "\\b")))
           (cond
            ((and to (string-match regexp to)))
            ((and cc (string-match regexp cc)))
            (t
             (setq ret (cons addr ret))))))
       addrs))
    (nreverse ret)))

(defun mew-my-bcc-filter (origin-id logs)
  (let ((buf (get-buffer (mew-fcc))))
    (when buf
      (with-current-buffer buf
        (save-excursion
          (let ((regexp (format "^%s *%s" mew-message-id: (regexp-quote origin-id)))
                ret)
            (mapc
             (lambda (log)
               (goto-char (point-min))
               (let ((id (nth 0 log))
                     (addr (nth 1 log)))
                 (when (re-search-forward (mew-regex-sumsyn-my-id id) nil t)
                   (let* ((msg (mew-summary-message-number))
                          (file (mew-expand-msg (mew-fcc) msg)))
                     (with-temp-buffer
                       (mew-insert-file-contents file)
                       (goto-char (point-min))
                       (when (re-search-forward regexp nil t)
                         (setq ret (cons addr ret)))))
                   origin-id)))
             (cdr logs))
            (nreverse ret)))))))

(defun mew-my-bcc/dcc-guessed-from-smtplog (msgid)
  (catch 'found
    (let ((log-regexp "^\\([0-9/]+ [0-9:]+\\) id=\\([^ ]+\\).* recipients=\\([^ ]+\\)"))
      (mapc
       (lambda (log)
         (with-temp-buffer
           (insert-file-contents log)
           (when (re-search-forward (format " id=%s .* status=sent" (regexp-quote msgid)) nil t)
             ;; search nearly sent mails from msgid
             (forward-line 0)
             (let (sent-time time id ret recipients)
               (when (looking-at log-regexp)
                 ;; capture to/dcc/cc address
                 (setq recipients (match-string 3))
                 (setq ret (cons (list msgid recipients) nil))
                 (setq sent-time (mew-my-smtplog-to-epoch (match-string 1)))
                 (forward-line 1)
                 (while (and (looking-at log-regexp)
                             (progn
                               (setq id (match-string 2))
                               (setq recipients (match-string 3))
                               (setq time (mew-my-smtplog-to-epoch (match-string 1)))
                               ;; restrict time range
                               (> (+ sent-time mew-my-bcc-sent-interval-threshold) time)))
                   (setq ret (cons (list id recipients) ret))
                   (forward-line 1)))
               (throw 'found (nreverse ret))))))
       ;; get log file and rotated log files
       (directory-files mew-conf-path  t (concat "^" (regexp-quote mew-smtp-log-file)))))
    nil))

(defun mew-my-smtplog-to-epoch (string)
  (let* ((strings (split-string string "[/: ]"))
         (getter (lambda (idx) (string-to-number (nth idx strings))))
         (year (funcall getter 0))
         (mon (funcall getter 1))
         (day (funcall getter 2))
         (hour (funcall getter 3))
         (min (funcall getter 4))
         (sec (funcall getter 5)))
    (float-time (encode-time sec min hour day mon year))))