From mboxrd@z Thu Jan 1 00:00:00 1970 X-Msuck: nntp://news.gmane.io/gmane.emacs.gnus.general/49843 Path: main.gmane.org!not-for-mail From: Ted Zlatanov Newsgroups: gmane.emacs.gnus.general Subject: Re: regular and adaptive scoring with nnimap Date: Wed, 05 Feb 2003 15:35:20 -0500 Organization: =?koi8-r?q?=F4=C5=CF=C4=CF=D2=20=FA=CC=C1=D4=C1=CE=CF=D7?= @ Cienfuegos Sender: owner-ding@hpc.uh.edu Message-ID: <4nwukea2k7.fsf@lockgroove.bwh.harvard.edu> References: <84u1fwlxj5.fsf@lucy.is.informatik.uni-duisburg.de> <84u1fw7zaw.fsf@lucy.is.informatik.uni-duisburg.de> <4nk7gq8mms.fsf@lockgroove.bwh.harvard.edu> <84wukqtk3c.fsf@lucy.is.informatik.uni-duisburg.de> <4nof5txezm.fsf@lockgroove.bwh.harvard.edu> <4nk7gfd7q6.fsf@lockgroove.bwh.harvard.edu> NNTP-Posting-Host: main.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: main.gmane.org 1044477305 11182 80.91.224.249 (5 Feb 2003 20:35:05 GMT) X-Complaints-To: usenet@main.gmane.org NNTP-Posting-Date: Wed, 5 Feb 2003 20:35:05 +0000 (UTC) Return-path: Original-Received: from malifon.math.uh.edu ([129.7.128.13]) by main.gmane.org with esmtp (Exim 3.35 #1 (Debian)) id 18gWG4-0002td-00 for ; Wed, 05 Feb 2003 21:35:00 +0100 Original-Received: from sina.hpc.uh.edu ([129.7.128.10] ident=lists) by malifon.math.uh.edu with esmtp (Exim 3.20 #1) id 18gWH4-0003lb-00; Wed, 05 Feb 2003 14:36:02 -0600 Original-Received: by sina.hpc.uh.edu (TLB v0.09a (1.20 tibbs 1996/10/09 22:03:07)); Wed, 05 Feb 2003 14:36:59 -0600 (CST) Original-Received: from sclp3.sclp.com (sclp3.sclp.com [66.230.238.2]) by sina.hpc.uh.edu (8.9.3/8.9.3) with SMTP id OAA17578 for ; Wed, 5 Feb 2003 14:36:41 -0600 (CST) Original-Received: (qmail 85514 invoked by alias); 5 Feb 2003 20:35:39 -0000 Original-Received: (qmail 85503 invoked from network); 5 Feb 2003 20:35:39 -0000 Original-Received: from clifford.bwh.harvard.edu (134.174.9.41) by 66.230.238.6 with SMTP; 5 Feb 2003 20:35:39 -0000 Original-Received: from lockgroove.bwh.harvard.edu (lockgroove [134.174.9.133]) by clifford.bwh.harvard.edu (8.10.2+Sun/8.11.0) with ESMTP id h15KZaj03879 for ; Wed, 5 Feb 2003 15:35:37 -0500 (EST) Original-Received: (from tzz@localhost) by lockgroove.bwh.harvard.edu (8.11.6+Sun/8.11.0) id h15KZLr03364; Wed, 5 Feb 2003 15:35:21 -0500 (EST) Original-To: ding@gnus.org 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" Mail-Followup-To: ding@gnus.org In-Reply-To: (Simon Josefsson's message of "Wed, 05 Feb 2003 06:52:07 +0100") User-Agent: Gnus/5.090015 (Oort Gnus v0.15) Emacs/21.2 (sparc-sun-solaris2.8) Precedence: list X-Majordomo: 1.94.jlt7 Xref: main.gmane.org gmane.emacs.gnus.general:49843 X-Report-Spam: http://spam.gmane.org/gmane.emacs.gnus.general:49843 --=-=-= Attached is the latest imap-db.el. It only does file-exists-p right now, but it's got the functions for file retrieval and file creation in place. It can't write over an existing file yet (replace body). Plus, I think the file retrieval may need to get just the body, not the body plus the headers. imap-db-create-article is especially hairy. I'm not sure I'm doing the right things in there. I'm not inserting the new article in the nnmail cache, for instance. I added the imap-possibly-change-group function, feel free to move it to imap.el if it's OK. I picked a fairly simple format: nnimap://mail.lifelogs.com/ding?SUBJECT%20spam that's it, no UIDs, no authentications, no uidvalidity. I'm happy to let nnimap.el handle all of that. Anyhow, let me know if there are obvious bugs or errors in the code. Ted --=-=-= Content-Type: application/emacs-lisp Content-Disposition: attachment; filename=imap-db.el Content-Transfer-Encoding: 8bit ;;; imap-db.el --- imap-based file storage for Gnus ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 ;; Free Software Foundation, Inc. ;; Author: Ted Zlatanov ;; Keywords: news ;; This file is part of GNU Emacs. ;; GNU Emacs 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 2, or (at your option) ;; any later version. ;; GNU Emacs 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 GNU Emacs; see the file COPYING. If not, write to the ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. ;;; Commentary: ;;; Code: (eval-when-compile (require 'cl)) (require 'gnus) (require 'gnus-sum) (require 'nnimap) (defgroup imap-db nil "nnimap file handling" :group 'imap) ;; we use nnimap:// instead of the RFC imap:// for now ;; example: nnimap://mail.lifelogs.com/ding?SUBJECT%20spam (defcustom imap-db-pattern (concat "^\\nnimap://" ; prefix "\\([^/]+\\)" ; mail server "/\\([^?]+\\)" ; mailbox ;; subject "\\?SUBJECT%20\\(.+\\)") "Pattern to match imap-db files. First group is server, second group is mailbox, third group is article ID (filename)." :group 'imap-db :type 'regexp) (defun imap-db-get-article-contents (article group &optional server) (let ((data)) (when (numberp article) (with-temp-buffer (nnimap-request-article article group server (buffer-name)) (setq data (buffer-string)))) data)) ;; (imap-db-get-article-contents 9525 "mail") (defun imap-db-list-groups (&optional server) (nnimap-open-server server) ; harmless if the server is already open (with-current-buffer (nnimap-get-server-buffer server) (imap-mailbox-list "%"))) ;; (imap-db-list-groups) (defun imap-possibly-change-group (group &optional server) (nnimap-open-server server) ; harmless if the server is already open (with-current-buffer (nnimap-get-server-buffer server) (if (imap-current-mailbox-p group) imap-current-mailbox (if (imap-mailbox-select group) imap-current-mailbox (error "Could not select group: %s" (imap-error-text)))))) (defun imap-db-get-uids-for-parameter (group parameter value &optional server) (let ((articles)) (when (and (stringp value) (stringp parameter) (stringp group)) (imap-possibly-change-group group server) (with-current-buffer (nnimap-get-server-buffer server) (setq articles (imap-search (format "HEADER %s \"%s\"" parameter value))))) articles)) (defun imap-db-get-uids-for-subject (group subject &optional server) (imap-db-get-uids-for-parameter group "Subject" subject server)) ;; (nnimap-close-server "mail.lifelogs.com") ;; (nnimap-server-opened "mail.lifelogs.com") ;; (imap-possibly-change-group "mail" "mail.lifelogs.com") ;; (imap-db-get-uids-for-parameter "ding" "Subject" "spam" "mail.lifelogs.com") ;; (imap-db-get-uids-for-parameter "ding" "Message-Id" "") ;; (imap-db-get-uids-for-subject "ding" "spam" "mail.lifelogs.com") (defun imap-db-get-subject-for-uid (uid &optional group server) (with-temp-buffer (nnimap-request-head uid group server (buffer-name)) (message-fetch-field "Subject"))) ;; (imap-db-get-subject-for-uid 9525 "mail" "mail.lifelogs.com") (defun imap-db-create-article (group name body &optional server last) "Create an article in a mail newsgroup." (interactive "sGroup: \nsName: \nsBody: ") (let ((now (current-time)) uid) (save-excursion (set-buffer (gnus-get-buffer-create " *import file*")) (erase-buffer) (goto-char (point-min)) ;; This doesn't look like an article, so we fudge some headers. (insert "From: imap-db\n" "Subject: " name "\n" "Date: " (message-make-date now) "\n" "Message-ID: " (message-make-message-id) "\n\n" body "\n") (imap-possibly-change-group group server) (with-current-buffer (current-buffer) (goto-char (point-min)) ;; turn into rfc822 format (\r\n eol's) (while (search-forward "\n" nil t) (replace-match "\r\n"))) ;; this is for Cyrus server bug (when (imap-current-mailbox nnimap-server-buffer) (imap-mailbox-unselect nnimap-server-buffer)) (setq uid (imap-message-append group (current-buffer) nil nil nnimap-server-buffer)) (kill-buffer (current-buffer))) (nth 1 uid))) ;; (imap-db-create-article "mail" "test" "hello") (defun imap-db-exists-article (group name &optional server) "Check for the existence of an article in a mail newsgroup." ;; listp returns t when argument is nil (consp (imap-db-get-uids-for-subject group name server))) (defun imap-db-file-handler (operation filename &rest args) ;; First check for the specific operations ;; that we have special handling for. (string-match imap-db-pattern filename) (let ((server (match-string 1 filename)) (group (match-string 2 filename)) (subject (match-string 3 filename))) ;; (debug operation server group subject) (cond ((or (eq operation 'file-executable-p) (eq operation 'file-symlink-p)) nil) ((eq operation 'expand-file-name) filename) ((eq operation 'file-exists-p) (imap-db-exists-article group subject server)) ;; Handle any operation we don't know about. (t (let ((inhibit-file-name-handlers (cons 'nnimap-file-handler (and (eq inhibit-file-name-operation operation) inhibit-file-name-handlers))) (inhibit-file-name-operation operation)) (apply operation filename args)))))) (add-to-list 'file-name-handler-alist (cons imap-db-pattern 'imap-db-file-handler)) ;;(setq file-name-handler-alist (cdr file-name-handler-alist)) ;; to be done: ;; `add-name-to-file', `copy-file', `delete-directory', `delete-file', ;; `diff-latest-backup-file', `directory-file-name', `directory-files', ;; `dired-call-process', `dired-compress-file', `dired-uncache', ;; `file-accessible-directory-p', ;; `file-attributes', `file-directory-p' ;; `file-local-copy', `file-modes', `file-name-all-completions', ;; `file-name-as-directory', `file-name-completion', `file-name-directory', ;; `file-name-nondirectory', `file-name-sans-versions', ;; `file-newer-than-file-p', `file-ownership-preserved-p', ;; `file-readable-p', `file-regular-p', `file-truename', ;; `file-writable-p', `find-backup-file-name', `get-file-buffer', ;; `insert-directory', `insert-file-contents', `load', `make-directory', ;; `make-symbolic-link', `rename-file', `set-file-modes', ;; `set-visited-file-modtime', `shell-command', ;; `unhandled-file-name-directory', `vc-registered', ;; `verify-visited-file-modtime', ;; `write-region'. (provide 'imap-db) ;;; imap-db.el ends here --=-=-=--