;;; nnimap.el --- imap backend for Gnus
-;; Copyright (C) 1998,1999 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc.
;; Author: Simon Josefsson <jas@pdc.kth.se>
;; Jim Radford <radford@robby.caltech.edu>
;; Todo, minor things:
;;
;; o Don't require half of Gnus -- backends should be standalone
-;; o Support escape characters in `message-tokenize-header'
;; o Verify that we don't use IMAP4rev1 specific things (RFC2060 App B)
;; o Dont uid fetch 1,* in nnimap-retrive-groups (slow)
;; o Split up big fetches (1,* header especially) in smaller chunks
;; .newsrc.eld)
;; o What about Gnus's article editing, can we support it? NO!
;; o Use \Draft to support the draft group??
+;; o Duplicate suppression
;;; Code:
second is a regexp that nnimap will try to match on the header to find
a fit.
-The first element can also be a list. In that case, the first element
-is the server the second element is the group on that server in which
-the matching article will be stored.
-
The second element can also be a function. In that case, it will be
called narrowed to the headers with the first element of the rule as
the argument. It should return a non-nil value if it thinks that the
This variable can also have a function as its value, the function will
be called with the headers narrowed and should return a group where it
-thinks the article should be splitted to.")
+thinks the article should be splitted to. See `nnimap-split-fancy'.
+
+To allow for different split rules on different virtual servers, and
+even different split rules in different inboxes on the same server,
+the syntax of this variable have been extended along the lines of:
+
+(setq nnimap-split-rule
+ '((\"my1server\" (\".*\" ((\"ding\" \"ding@gnus.org\")
+ (\"junk\" \"From:.*Simon\")))
+ (\"my2server\" (\"INBOX\" nnimap-split-fancy))
+ (\"my[34]server\" (\".*\" ((\"private\" \"To:.*Simon\")
+ (\"junk\" my-junk-func)))))
+
+The virtual server name is in fact a regexp, so that the same rules
+may apply to several servers. In the example, the servers
+\"my3server\" and \"my4server\" both use the same rules. Similarly,
+the inbox string is also a regexp. The actual splitting rules are as
+before, either a function, or a list with group/regexp or
+group/function elements.")
+
+(defvar nnimap-split-predicate "UNSEEN UNDELETED"
+ "The predicate used to find articles to split.
+If you use another IMAP client to peek on articles but always would
+like nnimap to split them once it's started, you could change this to
+\"UNDELETED\". Other available predicates are available in
+RFC2060 section 6.4.4.")
(defvar nnimap-split-fancy nil
"Like `nnmail-split-fancy', which see.")
;; Internal variables:
-(defvar nnimap-debug nil);; "*nnimap-debug*")
+(defvar nnimap-debug nil
+ "Name of buffer to record debugging info.
+For example: (setq nnimap-debug \"*nnimap-debug*\")")
(defvar nnimap-current-move-server nil)
(defvar nnimap-current-move-group nil)
(defvar nnimap-current-move-article nil)
(gnus-group-add-parameter gnusgroup (cons 'uidvalidity new-uidvalidity))
t)))
+(defun nnimap-before-find-minmax-bugworkaround ()
+ "Function called before iterating through mailboxes with
+`nnimap-find-minmax-uid'."
+ ;; XXX this is for UoW imapd problem, it doesn't notice new mail in
+ ;; currently selected mailbox without a re-select/examine.
+ (or (null (imap-current-mailbox nnimap-server-buffer))
+ (imap-mailbox-unselect nnimap-server-buffer)))
+
(defun nnimap-find-minmax-uid (group &optional examine)
"Find lowest and highest active article nummber in GROUP.
If EXAMINE is non-nil the group is selected read-only."
nnimap-progress-how-often)
nnimap-progress-chars)))
(with-current-buffer nntp-server-buffer
- (let (headers lines chars uid)
+ (let (headers lines chars uid mbx)
(with-current-buffer nnimap-server-buffer
(setq uid imap-current-message
+ mbx imap-current-mailbox
headers (if (imap-capability 'IMAP4rev1)
;; xxx don't just use car? alist doesn't contain
;; anything else now, but it might...
(nnheader-fold-continuation-lines)
(subst-char-in-region (point-min) (point-max) ?\t ? )
(nnheader-ms-strip-cr)
+ (nnheader-fold-continuation-lines)
+ (subst-char-in-region (point-min) (point-max) ?\t ? )
(let ((head (nnheader-parse-head 'naked)))
(mail-header-set-number head uid)
(mail-header-set-chars head chars)
(mail-header-set-lines head lines)
+ (mail-header-set-xref
+ head (format "%s %s:%d" (system-name) mbx uid))
head))))))
(defun nnimap-retrieve-which-headers (articles fetch-old)
(if (numberp (car-safe articles))
(imap-search
(concat "UID "
- (nnimap-range-to-string
+ (imap-range-to-message-set
(gnus-compress-sequence
(append (gnus-uncompress-sequence
(and fetch-old
(when (file-exists-p nov)
(nnheader-insert-file-contents nov)
(set-buffer-modified-p nil)
- (let ((min (progn (goto-char (point-min))
- (when (not (eobp))
- (read (current-buffer)))))
- (max (progn (goto-char (point-max))
- (forward-line -1)
- (when (not (bobp))
- (read (current-buffer))))))
+ (let ((min (ignore-errors (goto-char (point-min))
+ (read (current-buffer))))
+ (max (ignore-errors (goto-char (point-max))
+ (forward-line -1)
+ (read (current-buffer)))))
(if (and (numberp min) (numberp max))
(cons min max)
;; junk, remove it, it's saved later
(let ((imap-fetch-data-hook '(nnimap-retrieve-headers-progress))
(nnimap-length (gnus-range-length articles))
(nnimap-counter 0))
- (imap-fetch (nnimap-range-to-string articles)
+ (imap-fetch (imap-range-to-message-set articles)
(concat "(UID RFC822.SIZE BODY "
(let ((headers
(append '(Subject From Date Message-Id
;; remove nov's for articles which has expired on server
(goto-char (point-min))
(dolist (uid (gnus-set-difference articles uids))
- (when (re-search-forward (format "^%d\t" uid) nil t)
- (gnus-delete-line)))))
+ (when (re-search-forward (format "^%d\t" uid) nil t)
+ (gnus-delete-line)))))
;; nothing cached, fetch whole range from server
(nnimap-retrieve-headers-from-server
(cons low high) group server))
(imap-capability 'IMAP4rev1 nnimap-server-buffer))
(imap-close nnimap-server-buffer)
(nnheader-report 'nnimap "Server %s is not IMAP4 compliant" server))
- (let (list alist user passwd)
- (and (fboundp 'gnus-parse-netrc)
- (setq list (gnus-parse-netrc nnimap-authinfo-file)
- alist (or (and (gnus-netrc-get
- (gnus-netrc-machine list server) "machine")
- (gnus-netrc-machine list server))
- (gnus-netrc-machine list nnimap-address))
- user (gnus-netrc-get alist "login")
- passwd (gnus-netrc-get alist "password")))
+ (let* ((list (gnus-parse-netrc nnimap-authinfo-file))
+ (port (if nnimap-server-port
+ (int-to-string nnimap-server-port)
+ "imap"))
+ (alist (gnus-netrc-machine list (or nnimap-server-address
+ nnimap-address server)
+ port "imap"))
+ (user (gnus-netrc-get alist "login"))
+ (passwd (gnus-netrc-get alist "password")))
(if (imap-authenticate user passwd nnimap-server-buffer)
(prog1
(push (list server nnimap-server-buffer)
(with-current-buffer nnimap-callback-buffer
(insert
(with-current-buffer nnimap-server-buffer
- (nnimap-demule (imap-message-get (imap-current-message) 'RFC822)))) ;xxx
+ (if (imap-capability 'IMAP4rev1)
+ ;; xxx don't just use car? alist doesn't contain
+ ;; anything else now, but it might...
+ (nth 2 (car (imap-message-get (imap-current-message) 'BODYDETAIL)))
+ (imap-message-get (imap-current-message) 'RFC822))))
(nnheader-ms-strip-cr)
(funcall nnimap-callback-callback-function t)))
-(defun nnimap-request-article-part (article part prop
- &optional group server to-buffer)
+(defun nnimap-request-article-part (article part prop &optional
+ group server to-buffer detail)
(when (nnimap-possibly-change-group group server)
(let ((article (if (stringp article)
(car-safe (imap-search
(format "HEADER Message-Id %s" article)
nnimap-server-buffer))
- article))
- fetch-data)
+ article)))
(when article
- (gnus-message 9 "nnimap: Fetching (part of) article %d..." article)
+ (gnus-message 10 "nnimap: Fetching (part of) article %d..." article)
(if (not nnheader-callback-function)
(with-current-buffer (or to-buffer nntp-server-buffer)
(erase-buffer)
- (setq fetch-data (imap-fetch article part
- prop nil nnimap-server-buffer))
- (when fetch-data
- (if (eq prop 'BODYDETAIL)
- (insert (nth 2 (car fetch-data)))
- (insert fetch-data))
- (nnheader-ms-strip-cr)
- (gnus-message 9 "nnimap: Fetching (part of) article %d...done"
- article)
- (if (bobp)
- (nnheader-report 'nnimap "No such article: %s"
- (imap-error-text nnimap-server-buffer))
- (cons group article))))
+ (let ((data (imap-fetch article part prop nil
+ nnimap-server-buffer)))
+ (when data
+ (insert (if detail (nth 2 (car data)) data))
+ (nnheader-ms-strip-cr)
+ (gnus-message 10
+ "nnimap: Fetching (part of) article %d...done"
+ article)
+ (if (bobp)
+ (nnheader-report 'nnimap "No such article: %s"
+ (imap-error-text nnimap-server-buffer))
+ (cons group article)))))
(add-hook 'imap-fetch-data-hook 'nnimap-callback)
(setq nnimap-callback-callback-function nnheader-callback-function
nnimap-callback-buffer nntp-server-buffer)
(deffoo nnimap-request-article (article &optional group server to-buffer)
(if (imap-capability 'IMAP4rev1 nnimap-server-buffer)
(nnimap-request-article-part
- article "BODY.PEEK[]" 'BODYDETAIL group server to-buffer)
+ article "BODY.PEEK[]" 'BODYDETAIL group server to-buffer 'detail)
(nnimap-request-article-part
article "RFC822.PEEK" 'RFC822 group server to-buffer)))
(deffoo nnimap-request-head (article &optional group server to-buffer)
- (nnimap-request-article-part
- article "RFC822.HEADER" 'RFC822.HEADER group server to-buffer))
+ (if (imap-capability 'IMAP4rev1 nnimap-server-buffer)
+ (nnimap-request-article-part
+ article "BODY.PEEK[HEADER]" 'BODYDETAIL group server to-buffer 'detail)
+ (nnimap-request-article-part
+ article "RFC822.HEADER" 'RFC822.HEADER group server to-buffer)))
(deffoo nnimap-request-body (article &optional group server to-buffer)
(if (imap-capability 'IMAP4rev1 nnimap-server-buffer)
(nnimap-request-article-part
- article "BODY.PEEK[TEXT]" 'BODYDETAIL group server to-buffer)
+ article "BODY.PEEK[TEXT]" 'BODYDETAIL group server to-buffer 'detail)
(nnimap-request-article-part
article "RFC822.TEXT.PEEK" 'RFC822.TEXT group server to-buffer)))
group (gnus-server-to-method (format "nnimap:%s" server))))
server)
(when (nnimap-possibly-change-group group server)
+ (nnimap-before-find-minmax-bugworkaround)
(let (info)
(cond (fast group)
((null (setq info (nnimap-find-minmax-uid group t)))
(erase-buffer))
(gnus-message 5 "nnimap: Generating active list%s..."
(if (> (length server) 0) (concat " for " server) ""))
+ (nnimap-before-find-minmax-bugworkaround)
(with-current-buffer nnimap-server-buffer
(dolist (pattern (nnimap-pattern-to-list-arguments nnimap-list-pattern))
(dolist (mbx (funcall nnimap-request-list-method
(deffoo nnimap-request-post (&optional server)
(let ((success t))
- (dolist (mbx (message-tokenize-header
- (message-fetch-field "Newsgroups")) success)
+ (dolist (mbx (message-unquote-tokens
+ (message-tokenize-header
+ (message-fetch-field "Newsgroups") ", ")) success)
(let ((to-newsgroup (gnus-group-prefixed-name mbx gnus-command-method)))
(or (gnus-active to-newsgroup)
(gnus-activate-group to-newsgroup)
(gnus-message 5 "nnimap: Checking mailboxes...")
(with-current-buffer nntp-server-buffer
(erase-buffer)
+ (nnimap-before-find-minmax-bugworkaround)
(dolist (group groups)
(gnus-message 7 "nnimap: Checking mailbox %s" group)
(or (member "\\NoSelect"
(when (and range marks)
(cond ((eq what 'del)
(imap-message-flags-del
- (nnimap-range-to-string range)
+ (imap-range-to-message-set range)
(nnimap-mark-to-flag marks nil t)))
((eq what 'add)
(imap-message-flags-add
- (nnimap-range-to-string range)
+ (imap-range-to-message-set range)
(nnimap-mark-to-flag marks nil t)))
((eq what 'set)
(imap-message-flags-set
- (nnimap-range-to-string range)
+ (imap-range-to-message-set range)
(nnimap-mark-to-flag marks nil t)))))))
(gnus-message 7 "nnimap: Setting marks in %s...done" group))))
nil)
(or nnimap-split-crosspost
(throw 'split-done to-groups))))))))))
+(defun nnimap-assoc-match (key alist)
+ (let (element)
+ (while (and alist (not element))
+ (if (string-match (car (car alist)) key)
+ (setq element (car alist)))
+ (setq alist (cdr alist)))
+ element))
+
(defun nnimap-split-find-rule (server inbox)
- nnimap-split-rule)
+ (if (and (listp nnimap-split-rule) (listp (car nnimap-split-rule))
+ (list (cdar nnimap-split-rule)) (listp (cadar nnimap-split-rule)))
+ ;; extended format
+ (cadr (nnimap-assoc-match inbox (cdr (nnimap-assoc-match
+ server nnimap-split-rule))))
+ nnimap-split-rule))
(defun nnimap-split-find-inbox (server)
(if (listp nnimap-split-inbox)
;; find split rule for this server / inbox
(when (setq rule (nnimap-split-find-rule server inbox))
;; iterate over articles
- (dolist (article (imap-search "UNSEEN UNDELETED"))
+ (dolist (article (imap-search nnimap-split-predicate))
(when (nnimap-request-head article)
;; copy article to right group(s)
(setq removeorig nil)
(gnus-message 5 "nnimap: Listing subscribed mailboxes%s%s..."
(if (> (length server) 0) " on " "") server)
(erase-buffer)
+ (nnimap-before-find-minmax-bugworkaround)
(dolist (pattern (nnimap-pattern-to-list-arguments
nnimap-list-pattern))
- (dolist (mbx (imap-mailbox-lsub "*" (car pattern) nil
+ (dolist (mbx (imap-mailbox-lsub "*" (car pattern) nil
nnimap-server-buffer))
- (or (member-if (lambda (mailbox)
- (string= (downcase mailbox) "\\noselect"))
- (imap-mailbox-get 'list-flags mbx
- nnimap-server-buffer))
+ (or (catch 'found
+ (dolist (mailbox (imap-mailbox-get 'list-flags mbx
+ nnimap-server-buffer))
+ (if (string= (downcase mailbox) "\\noselect")
+ (throw 'found t)))
+ nil)
(let ((info (nnimap-find-minmax-uid mbx 'examine)))
(when info
(insert (format "\"%s\" %d %d y\n"
(with-current-buffer nnimap-server-buffer
(if force
(and (imap-message-flags-add
- (nnimap-range-to-string artseq) "\\Deleted")
+ (imap-range-to-message-set artseq) "\\Deleted")
(setq articles nil))
(let ((days (or (and nnmail-expiry-wait-function
(funcall nnmail-expiry-wait-function group))
nnmail-expiry-wait)))
(cond ((eq days 'immediate)
(and (imap-message-flags-add
- (nnimap-range-to-string artseq) "\\Deleted")
+ (imap-range-to-message-set artseq) "\\Deleted")
(setq articles nil)))
((numberp days)
(let ((oldarts (imap-search
(format "UID %s NOT SINCE %s"
- (nnimap-range-to-string artseq)
+ (imap-range-to-message-set artseq)
(nnimap-date-days-ago days))))
(imap-fetch-data-hook
'(nnimap-request-expire-articles-progress)))
(and oldarts
(imap-message-flags-add
- (nnimap-range-to-string
+ (imap-range-to-message-set
(gnus-compress-sequence oldarts))
"\\Deleted")
(setq articles (gnus-set-difference
(goto-char (point-min))
(while (search-forward "\n" nil t)
(replace-match "\r\n")))
- ;; next line for Cyrus server bug
- (imap-mailbox-unselect nnimap-server-buffer)
+ ;; this 'or' is for Cyrus server bug
+ (or (null (imap-current-mailbox nnimap-server-buffer))
+ (imap-mailbox-unselect nnimap-server-buffer))
(imap-message-append group (current-buffer) nil nil
nnimap-server-buffer)))
(cons group (nth 1 uid))
(cons (cons key value) (nnimap-remassoc key alist))
(nnimap-remassoc key alist)))
-(defun nnimap-range-to-string (range)
- (mapconcat
- (lambda (item)
- (if (consp item)
- (format "%d:%d"
- (car item) (cdr item))
- (format "%d" item)))
- (if (and (listp range) (not (listp (cdr range))))
- (list range);; make (1 . 2) into ((1 . 2))
- range)
- ","))
-
(when nnimap-debug
(require 'trace)
(buffer-disable-undo (get-buffer-create nnimap-debug))
nnimap-possibly-change-server
nnimap-verify-uidvalidity
nnimap-find-minmax-uid
+ nnimap-before-find-minmax-bugworkaround
nnimap-possibly-change-group
;;nnimap-replace-whitespace
nnimap-retrieve-headers-progress
nnimap-mark-permanent-p
nnimap-remassoc
nnimap-update-alist-soft
- nnimap-range-to-string
)))
(provide 'nnimap)
projects / elisp / gnus.git- / blobdiff