2010年12月13日

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

林と申します。

From: script concept <concept.script@xxxxx>
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))))


投稿者 xml-rpc : 2010年12月13日 22:38
役に立ちました?:
過去のフィードバック 平均:(0) 総合:(0) 投票回数:(0)
本記事へのTrackback: http://hoop.euqset.org/blog/mt-tb2006.cgi/100712
トラックバック
コメント
コメントする




画像の中に見える文字を入力してください。