From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Ted Zlatanov Newsgroups: gmane.emacs.devel Subject: imap-hash.el (for inclusion in Emacs) and tramp-imap.el Date: Wed, 23 Sep 2009 16:12:23 -0500 Organization: =?utf-8?B?0KLQtdC+0LTQvtGAINCX0LvQsNGC0LDQvdC+0LI=?= @ Cienfuegos Message-ID: <87r5txpdqg.fsf_-_@lifelogs.com> References: <86k5n1443g.fsf@lifelogs.com> <86k55otuwi.fsf@lifelogs.com> <86vdp7qk67.fsf@lifelogs.com> <87bpqx1vfv.fsf@gmx.de> <86k55cb4ye.fsf@jumptrading.com> <86skjz5a8v.fsf@lifelogs.com> <877i184pcp.fsf@gmx.de> <873a942pdy.fsf@lifelogs.com> <87bpnlskov.fsf_-_@lifelogs.com> <87prby6ya0.fsf@gmx.de> <878wgrjsto.fsf@lifelogs.com> <87eiq0t7vo.fsf_-_@lifelogs.com> NNTP-Posting-Host: lo.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: ger.gmane.org 1253740383 1240 80.91.229.12 (23 Sep 2009 21:13:03 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Wed, 23 Sep 2009 21:13:03 +0000 (UTC) Cc: michael.albinus@gmx.de, Emacs Development Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Wed Sep 23 23:12:55 2009 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([199.232.76.165]) by lo.gmane.org with esmtp (Exim 4.50) id 1MqZ8t-0003TX-1k for ged-emacs-devel@m.gmane.org; Wed, 23 Sep 2009 23:12:55 +0200 Original-Received: from localhost ([127.0.0.1]:56971 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1MqZ8s-00065g-BG for ged-emacs-devel@m.gmane.org; Wed, 23 Sep 2009 17:12:50 -0400 Original-Received: from mailman by lists.gnu.org with tmda-scanned (Exim 4.43) id 1MqZ8f-0005xT-64 for emacs-devel@gnu.org; Wed, 23 Sep 2009 17:12:37 -0400 Original-Received: from exim by lists.gnu.org with spam-scanned (Exim 4.43) id 1MqZ8a-0005vL-8i for emacs-devel@gnu.org; Wed, 23 Sep 2009 17:12:36 -0400 Original-Received: from [199.232.76.173] (port=48495 helo=monty-python.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1MqZ8Z-0005vA-UO for emacs-devel@gnu.org; Wed, 23 Sep 2009 17:12:31 -0400 Original-Received: from chirelay1o.jumptrading.com ([38.98.147.153]:39043 helo=chirelay1.jumptrading.com) by monty-python.gnu.org with esmtp (Exim 4.60) (envelope-from ) id 1MqZ8X-00051C-Ol for emacs-devel@gnu.org; Wed, 23 Sep 2009 17:12:31 -0400 Original-Received: from chirelay1.jumptrading.com (unknown [127.0.0.1]) by chirelay1.jumptrading.com (Symantec Mail Security) with ESMTP id 176EC320030 for ; Wed, 23 Sep 2009 16:08:55 -0500 (CDT) X-AuditID: 26629395-9ef9bbb000003d9b-6d-4aba8e66b214 Original-Received: from chiexchange02.w2k.jumptrading.com (unknown [38.98.147.140]) by chirelay1.jumptrading.com (Symantec Mail Security) with ESMTP id E01C52DC008 for ; Wed, 23 Sep 2009 16:08:54 -0500 (CDT) Original-Received: from internalsmtp.w2k.jumptrading.com (10.2.4.29) by chiexchange02.w2k.jumptrading.com (10.2.4.71) with Microsoft SMTP Server id 8.1.291.1; Wed, 23 Sep 2009 16:12:25 -0500 Original-Received: from tzlatanov-ubuntu-desktop.jumptrading.com ([10.2.21.147]) by internalsmtp.w2k.jumptrading.com with Microsoft SMTPSVC(6.0.3790.1830); Wed, 23 Sep 2009 16:12:25 -0500 X-Face: bd.DQ~'29fIs`T_%O%C\g%6jW)yi[zuz6; d4V0`@y-~$#3P_Ng{@m+e4o<4P'#(_GJQ%TT= D}[Ep*b!\e,fBZ'j_+#"Ps?s2!4H2-Y"sx" In-Reply-To: <87eiq0t7vo.fsf_-_@lifelogs.com> (Ted Zlatanov's message of "Mon, 21 Sep 2009 14:28:27 -0500") User-Agent: Gnus/5.110011 (No Gnus v0.11) Emacs/23.1.50 (gnu/linux) X-OriginalArrivalTime: 23 Sep 2009 21:12:25.0699 (UTC) FILETIME=[8CB42B30:01CA3C92] X-Brightmail-Tracker: AAAAAA== X-detected-operating-system: by monty-python.gnu.org: GNU/Linux 2.4-2.6 X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.5 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.devel:115564 Archived-At: --=-=-= Content-Type: text/plain I wrote this to the Tramp and Gnus mailing lists: "imap-hash.el lets you treat an IMAP mailbox as a hash. It lets you get individual keys' headers and body data (keys are message UIDs) or map a function across *all the messages in the mailbox*. The function is only called for those that match a given subject, but really I should be using SEARCH. So the library is not optimized for speed. Also, it does not handle invalid mailbox names gracefully yet. Consider it an alpha version. I plan to eventually use imap-hash.el to store distributed Gnus data, specifically the Gnus registry, the newsrc file, scoring files, etc. tramp-imap.el uses imap-hash.el to provide a Tramp interface to read and write files as messages in an IMAP mailbox. It's also an alpha version, but it will at least let you (given a valid IMAP mailbox) read and write directory contents. It uses EPG (thanks to Daiki Ueno's help) to encrypt the file contents when they are stored as messages." I would like to put imap-hash.el in lisp/net/imap-hash.el if possible, to support Gnus and Tramp from one location. Is that OK? It would make my life easier and others can use the library if they wish. See attached. Thanks Ted --=-=-= Content-Type: application/emacs-lisp Content-Disposition: attachment; filename="imap-hash.el" Content-Transfer-Encoding: quoted-printable ;;; imap-hash.el --- Hashtable-like interface to an IMAP mailbox ;; Copyright (C) 2009 Free Software Foundation, Inc. ;; Author: Teodor Zlatanov ;; Keywords: mail ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . ;;; Commentary: ;; This module provides hashtable-like functions on top of imap.el ;; functionality. All the authentication is handled by auth-source so ;; there are no authentication options here, only the server and ;; mailbox names are needed. ;; This only works with IMAP4r1. Sorry to everyone without it, but ;; the compatibility code is too annoying and it's 2009. ;;; Code: (require 'imap) (require 'message) (autoload 'auth-source-user-or-password "auth-source") ;; retrieve these headers (defvar imap-hash-headers (append '(Subject From Date Message-Id References In-Reply-To Xref))) (defun imap-hash-make (server port mailbox &optional user password ssl) "Makes a new imap-hash object using SERVER, PORT, and MAILBOX.=20=20 SSL, USER, PASSWORD are optional. The test is set to t, meaning all messages are considered." (when (and server port mailbox) (list :server server :port port :mailbox mailbox=20 :ssl ssl :user user :password password=20 :test t))) (defun imap-hash-p (iht) "Checks whether IHT is a valid imap-hash." (and (imap-hash-server iht) (imap-hash-port iht) (imap-hash-mailbox iht) (imap-hash-test iht))) (defmacro imap-hash-gather (uid) `(imap-message-get ,uid 'BODYDETAIL)) (defmacro imap-hash-data-body (details) `(nth 2 (nth 1 ,details))) (defmacro imap-hash-data-headers (details) `(nth 2 (nth 0 ,details))) (defun imap-hash-get (key iht &optional refetch) "Get the value for KEY in the imap-hash IHT. Requires either `imap-hash-fetch' to be called beforehand (e.g. by `imap-hash-map'), or REFETCH to be t. Returns a list of the headers (an alist, see `imap-hash-map') and the body of the message as a string. Also see `imap-hash-test'." (with-current-buffer (imap-hash-get-buffer iht) (when refetch (imap-hash-fetch iht nil key)) (let ((details (imap-hash-gather key))) (list (imap-hash-get-headers (imap-hash-data-headers details)) (imap-hash-get-body=20 (imap-hash-data-body details)))))) (defun imap-hash-put (value iht &optional key) "Put VALUE in the imap-hash IHT. Returns the new key. If KEY is given, removes it. VALUE can be a list of the headers (an alist, see `imap-hash-map')=20 and the body of the message as a string. It can also be a uid, in which case `imap-hash-get' will be called to get the value. Also see `imap-hash-test'." (let ((server-buffer (imap-hash-get-buffer iht)) (value (if (listp value) value (imap-hash-get value iht))) newuid) (when value (with-temp-buffer (funcall 'imap-hash-make-message=20 (nth 0 value)=20 (nth 1 value) nil) (setq newuid (nth 1 (imap-message-append (imap-hash-mailbox iht)=20 (current-buffer) nil nil server-buffer))) (when key (imap-hash-rem key iht)))) newuid)) (defun imap-hash-make-message (headers body &optional overrides) "Make a message with HEADERS and BODY suitable for `imap-append', using `message-setup'.. Look in the alist OVERRIDES for header overrides as per `imap-hash-headers'= ." ;; don't insert a signature no matter what (let (message-signature) (message-setup (append overrides headers)) (message-generate-headers message-required-mail-headers) (message-remove-header "X-Draft-From") (message-goto-body) (insert (or (aget overrides 'body) body "")) (goto-char (point-min)) ;; TODO: make this search better (if (search-forward "--text follows this line--" nil t) (delete-region (line-beginning-position) (line-end-position)) (error "Could not find the body separator in the encoded message!")))) (defun imap-hash-rem (key iht) "Remove KEY in the imap-hash IHT. Also see `imap-hash-test'. Requires `imap-hash-fetch' to have been called and the imap-hash server buffer to be current,=20 so it's best to use it inside `imap-hash-map'. The key will not be found on the next `imap-hash-map' call." (with-current-buffer (imap-hash-get-buffer iht) (imap-message-flags-add (imap-range-to-message-set (list key)) "\\Deleted" 'silent) (imap-mailbox-expunge t))) (defun imap-hash-clear (iht) "Remove all keys in the imap-hash IHT. Also see `imap-hash-test'." (imap-hash-map (lambda (uid b c) (imap-hash-rem uid iht)) iht)) (defun imap-hash-get-headers (text-headers) (with-temp-buffer (insert (or text-headers "")) (imap-hash-remove-cr-followed-by-lf) (mapcar (lambda (header)=20 (cons header (message-fetch-field (format "%s" header)))) imap-hash-headers))) (defun imap-hash-get-body (text) (with-temp-buffer (insert (or text "")) (imap-hash-remove-cr-followed-by-lf) (buffer-string))) (defun imap-hash-map (function iht &optional headers-only &rest messages) "Call FUNCTION for all entries in IHT and pass it the message uid, the headers (an alist, see `imap-hash-headers'), and the body contents as a string. If HEADERS-ONLY is not nil, the body will be nil. Returns results of evaluating, as would `mapcar'. If MESSAGES are given, iterate only over those UIDs. Also see `imap-hash-test'." (imap-hash-fetch iht headers-only) (let ((test (imap-hash-test iht))) (with-current-buffer (imap-hash-get-buffer iht) (delq nil (imap-message-map (lambda (message ignored-parameter) (let* ((details (imap-hash-gather message)) (headers (imap-hash-data-headers details)) (hlist (imap-hash-get-headers headers)) (runit (cond ((stringp test)=20 (string-match test=20 (format "%s" (aget hlist 'Subject)))) ((functionp test)=20 (funcall test hlist)) ;; otherwise, return test itself (t test)))) ;;(debug message headers) (when runit (funcall function message (imap-hash-get-headers headers) (imap-hash-get-body (imap-hash-data-body details)))))) "UID"))))) (defun imap-hash-count (iht) "Counts the number of messages in the imap-hash IHT. Also see `imap-hash-test'. It uses `imap-hash-map' so just use that function if you want to do more than count the elements." (length (imap-hash-map (lambda (a b c)) iht t))) (defalias 'imap-hash-size 'imap-hash-count) (defun imap-hash-test (iht) "Returns the test used by `imap-hash-map' for IHT. When the test is t, any key will be a candidate. When the test is a string, messages will be filtered on that string as a re= gexp against the subject. When the test is a function, messages will be filtered with it.=20=20 The function is passed the message headers (see `imap-hash-get-headers')." (plist-get iht :test)) (defun imap-hash-server (iht)=20 "Returns the server used by the imap-hash IHT." (plist-get iht :server)) (defun imap-hash-port (iht)=20 "Returns the port used by the imap-hash IHT." (plist-get iht :port)) (defun imap-hash-ssl (iht)=20 "Returns the SSL need for the imap-hash IHT." (plist-get iht :ssl)) (defun imap-hash-mailbox (iht) "Returns the mailbox used by the imap-hash IHT." (plist-get iht :mailbox)) (defun imap-hash-user (iht)=20 "Returns the username used by the imap-hash IHT." (plist-get iht :user)) (defun imap-hash-password (iht)=20 "Returns the password used by the imap-hash IHT." (plist-get iht :password)) (defun imap-hash-open-connection (iht) "Open the connection used for IMAP interactions with the imap-hash IHT." (let* ((server (imap-hash-server iht)) (port (imap-hash-port iht)) (ssl-need (imap-hash-ssl iht)) (auth-need (not (and (imap-hash-user iht)=20 (imap-hash-password iht)))) ;; this will not be needed if auth-need is t (auth-info (when auth-need (auth-source-user-or-password=20 '("login" "password")=20 server port))) (auth-user (or (imap-hash-user iht)=20 (nth 0 auth-info))) (auth-passwd (or (imap-hash-password iht)=20 (nth 1 auth-info))) (imap-logout-timeout nil)) ;; (debug "opening server: opened+state" (imap-opened) imap-state) ;; this is the only place where IMAP vs IMAPS matters (if (imap-open server port (if ssl-need 'ssl nil) nil (current-buffer)) (progn ;; (debug "after opening server: opened+state" (imap-opened (current= -buffer)) imap-state) ;; (debug "authenticating" auth-user auth-passwd) (if (not (imap-capability 'IMAP4rev1)) (error "IMAP server does not support IMAP4r1, it won't work, sorry.") (imap-authenticate auth-user auth-passwd) (imap-id) ;; (debug "after authenticating: opened+state" (imap-opened (current-buff= er)) imap-state) (imap-opened (current-buffer)))) (error "Could not open the IMAP buffer")))) (defun imap-hash-get-buffer (iht) "Get or create the connection buffer to be used for the imap-hash IHT." (let* ((name (imap-hash-buffer-name iht)) (buffer (get-buffer name))) (if (and buffer (imap-opened buffer)) buffer (when buffer (kill-buffer buffer)) (with-current-buffer (get-buffer-create name) (setq buffer-undo-list t) (when (imap-hash-open-connection iht) (current-buffer)))))) (defun imap-hash-buffer-name (iht) "Get the connection buffer to be used for the imap-hash IHT." (when (imap-hash-p iht) (let ((server (imap-hash-server iht)) (port (imap-hash-port iht)) (ssl-text (if (imap-hash-ssl iht) "SSL" "NoSSL"))) (format "*imap-hash/%s:%s:%s*" server port ssl-text)))) (defun imap-hash-fetch (iht &optional headers-only &rest messages) "Fetch all the messages for imap-hash IHT. Get only the headers if HEADERS-ONLY is not nil." (with-current-buffer (imap-hash-get-buffer iht) (let ((range (if messages=20 (list=20 (imap-range-to-message-set messages) (imap-range-to-message-set messages)) '("1:*" . "1,*:*")))) ;; (with-current-buffer "*imap-debug*" ;; (erase-buffer)) (imap-mailbox-unselect) (imap-mailbox-select (imap-hash-mailbox iht)) ;; (debug "after selecting mailbox: opened+state" (imap-opened) imap-= state) ;; (setq imap-message-data (make-vector imap-message-prime 0) (imap-fetch-safe range (concat (format "(UID RFC822.SIZE BODY %s " (if headers-only "" "BODY.PEEK[TEXT]")) (format "BODY.PEEK[HEADER.FIELDS %s])"=20 imap-hash-headers)))))) =20=20 ;; from nnheader.el (defsubst imap-hash-remove-cr-followed-by-lf () (goto-char (point-max)) (while (search-backward "\r\n" nil t) (delete-char 1))) ;; from nnheader.el (defun imap-hash-ms-strip-cr (&optional string) "Strip ^M from the end of all lines in current buffer or STRING." (if string (with-temp-buffer (insert string) (imap-hash-remove-cr-followed-by-lf) (buffer-string)) (save-excursion (imap-hash-remove-cr-followed-by-lf)))) (provide 'imap-hash) ;;; imap-hash.el ends here ;; ignore, for testing only ;;; (setq iht (imap-hash-make "yourhosthere.com" "imap" "INBOX.test")) ;;; (setq iht (imap-hash-make "yourhosthere.com" "imap" "test")) ;;; (imap-hash-make "server1" "INBOX.mailbox2") ;;; (imap-hash-p iht) ;;; (imap-hash-get 35 iht) ;;; (imap-hash-get 38 iht) ;;; (imap-hash-get 37 iht t) ;;; (mapc (lambda (buffer) (with-current-buffer buffer (erase-buffer))) '("= *imap-debug*" "*imap-log*")) ;;; (imap-hash-put (imap-hash-get 5 iht) iht) ;;; (with-current-buffer (imap-hash-get-buffer iht) (let ((uid (imap-hash-p= ut (imap-hash-get 5 iht) iht))) (imap-hash-put uid iht uid))) ;;; (imap-hash-put (imap-hash-get 35 iht) iht) ;;; (imap-hash-make-message '((Subject . "normal")) "normal body") ;;; (imap-hash-make-message '((Subject . "old")) "old body" '((Subject . "n= ew"))) ;;; (imap-hash-make-message '((Subject . "old")) "old body" '((body . "new = body")) (lambda (subject) (concat "overwrite-" subject))) ;;; (imap-hash-make-message '((Subject . "old")) "old body" '((Subject . "c= hange this")) (lambda (subject) (concat "overwrite-" subject))) ;;; (imap-hash-make-message '((Subject . "Twelcome")) "body here" nil) ;; (with-current-buffer (imap-hash-get-buffer iht) (imap-hash-rem (imap-has= h-put (imap-hash-get 5 iht) iht) iht)) ;;; (kill-buffer (imap-hash-buffer-name iht)) ;;; (imap-hash-map 'debug iht) ;;; (imap-hash-map 'debug iht t) ;;;(tramp-imap-handle-file-inode "/imap:yourhosthere.com:/test/welcome") ;;;(imap-hash-count iht) ;;; (mapc (lambda (buffer) (with-current-buffer buffer (erase-buffer))) '("= *imap-debug*" "*imap-log*")) ;;; (kill-buffer (imap-hash-buffer-name iht)) ;;; this should always return t if the server is up, automatically reopenin= g if needed ;;; (imap-opened (imap-hash-get-buffer iht)) ;;; (imap-hash-buffer-name iht) ;;; (with-current-buffer (imap-hash-get-buffer iht) (debug "mailbox data, a= uth and state" imap-mailbox-data imap-auth imap-state)) ;;;(tramp-imap-handle-file-inode "/imap:yourhosthere.com:/test/welcome") ;;; (imap-hash-fetch iht nil) ;;; (imap-hash-fetch iht t) ;;; (imap-hash-fetch iht nil 1 2 3) ;;; (imap-hash-fetch iht t 1 2 3) --=-=-=--