* toward a solution to nnimap and large UIDs
@ 2003-12-10 19:40 Kim Minh Kaplan
2003-12-10 20:56 ` Simon Josefsson
0 siblings, 1 reply; 3+ messages in thread
From: Kim Minh Kaplan @ 2003-12-10 19:40 UTC (permalink / raw)
Hello,
I have started work on making Gnus work with IMAP servers with UIDs
larger than 27bits and I am now able to read such groups. I'm looking
for knowledgeable people who would be wanting to test my patches...
Kim Minh.
^ permalink raw reply [flat|nested] 3+ messages in thread
* Re: toward a solution to nnimap and large UIDs
2003-12-10 19:40 toward a solution to nnimap and large UIDs Kim Minh Kaplan
@ 2003-12-10 20:56 ` Simon Josefsson
2003-12-11 15:36 ` Kim Minh Kaplan
0 siblings, 1 reply; 3+ messages in thread
From: Simon Josefsson @ 2003-12-10 20:56 UTC (permalink / raw)
Cc: ding
Kim Minh Kaplan <kmkaplan@selfoffice.com> writes:
> Hello,
>
> I have started work on making Gnus work with IMAP servers with UIDs
> larger than 27bits and I am now able to read such groups. I'm looking
> for knowledgeable people who would be wanting to test my patches...
Please send them to the list, I'd be interested in understanding how
you implement it.
^ permalink raw reply [flat|nested] 3+ messages in thread
* Re: toward a solution to nnimap and large UIDs
2003-12-10 20:56 ` Simon Josefsson
@ 2003-12-11 15:36 ` Kim Minh Kaplan
0 siblings, 0 replies; 3+ messages in thread
From: Kim Minh Kaplan @ 2003-12-11 15:36 UTC (permalink / raw)
[-- Attachment #1: Type: text/plain, Size: 1849 bytes --]
Simon Josefsson writes:
> Please send them to the list, I'd be interested in understanding how
> you implement it.
OK, here it is. But it is still not suitable for public consumption...
To workaround Emacs' limitation on integers size, I map IMAP's UIDs to
article numbers, starting at 1, then incrementing as new UIDs are
discovered. UIDs are kept as strings while article numbers are Emacs
integers. The function that builds this mapping is
`nnimap-update-uid-map'. I'm still not sure where it should be called
and you'll have to insert a call to it somewhere in your sources. For
the moment I have put it near the top of
`nnimap-request-update-info-internal' and it seems ok here. If you
know more about this, tell me.
Also, you have to manually trigger the use of this numbering scheme,
otherwise it will not be used. The reasons for this are:
1. This is pre-alpha quality implementation that may (will) loose
your mails,
2. Going from traditional integer UIDs to string UIDs will wreck
all your flag settings, cache and surely more things...
Now that you have been warned, if you still want to set it to work,
you have to add a (msg-high . 0) parameter to the nnimap group that
will use the string UIDs. That is, in the *Group* buffer, with point
on the nnimap group, do "G E" (M-x gnus-group-edit-group) and make it
look something like:
("nnimap+imap:INBOX" 3 nil nil
(nnimap "imap")
((msg-high . 0)))
Then cross fingers and update the group and enter it and read it... A
sign that it is working is that another new parameter will be added to
all nimap groups with the mapping from article number to UID. Even in
groups which don't use it. Only groups with the `msg-high' parameter
will use the new numbering scheme.
I'd be pleased to discuss issues regarding this scheme.
Kim Minh.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: start to fix UID limitation --]
[-- Type: text/x-patch, Size: 15322 bytes --]
Index: lisp/imap.el
===================================================================
RCS file: /usr/local/cvsroot/gnus/lisp/imap.el,v
retrieving revision 6.67
diff -u -w -r6.67 imap.el
--- lisp/imap.el 17 Nov 2003 05:55:15 -0000 6.67
+++ lisp/imap.el 11 Dec 2003 15:35:47 -0000
@@ -1420,7 +1420,9 @@
(defun imap-list-to-message-set (list)
(mapconcat (lambda (item)
- (number-to-string item))
+ (if (numberp item)
+ (number-to-string item)
+ item))
(if (listp list)
list
(list list))
@@ -1430,9 +1432,9 @@
(mapconcat
(lambda (item)
(if (consp item)
- (format "%d:%d"
+ (format "%s:%s"
(car item) (cdr item))
- (format "%d" item)))
+ (format "%s" item)))
(if (and (listp range) (not (listp (cdr range))))
(list range) ;; make (1 . 2) into ((1 . 2))
range)
@@ -1472,7 +1474,10 @@
(defun imap-message-put (uid propname value &optional buffer)
(with-current-buffer (or buffer (current-buffer))
(if imap-message-data
- (put (intern (number-to-string uid) imap-message-data)
+ (put (intern (typecase uid
+ (number (number-to-string uid))
+ (t uid))
+ imap-message-data)
propname value)
(error "Imap-message-data is nil, uid %s prop %s value %s buffer %s"
uid propname value (current-buffer)))
@@ -1480,7 +1485,10 @@
(defun imap-message-get (uid propname &optional buffer)
(with-current-buffer (or buffer (current-buffer))
- (get (intern-soft (number-to-string uid) imap-message-data)
+ (get (intern-soft (typecase uid
+ (number (number-to-string uid))
+ (t uid))
+ imap-message-data)
propname)))
(defun imap-message-map (func propname &optional buffer)
@@ -1586,7 +1594,7 @@
(and (imap-fetch "*" "UID")
(list (imap-mailbox-get-1 'uidvalidity mailbox)
(apply 'max (imap-message-map
- (lambda (uid prop) uid) 'UID))))
+ (lambda (uid prop) uid) 'UIDINT))))
(if old-mailbox
(imap-mailbox-select old-mailbox (eq state 'examine))
(imap-mailbox-unselect)))))))
@@ -1630,7 +1638,7 @@
(and (imap-fetch "*" "UID")
(list (imap-mailbox-get-1 'uidvalidity mailbox)
(apply 'max (imap-message-map
- (lambda (uid prop) uid) 'UID))))
+ (lambda (uid prop) uid) 'UIDINT))))
(if old-mailbox
(imap-mailbox-select old-mailbox (eq state 'examine))
(imap-mailbox-unselect)))))))
@@ -1850,6 +1858,14 @@
(string-to-number (match-string 0))
(goto-char (match-end 0)))))
+;; Keep uids as strings because Emacs integers are < 32 bits.
+
+(defun imap-parse-uid ()
+ (when (looking-at "0*\\([0-9]+\\)")
+ (prog1
+ (match-string 1)
+ (goto-char (match-end 0)))))
+
;; literal = "{" number "}" CRLF *CHAR8
;; ; Number represents the number of CHAR8s
@@ -2297,9 +2313,7 @@
(let ((token (read (current-buffer))))
(imap-forward)
(cond ((eq token 'UID)
- (setq uid (condition-case ()
- (read (current-buffer))
- (error))))
+ (setq uid (imap-parse-uid)))
((eq token 'FLAGS)
(setq flags (imap-parse-flag-list))
(if (not flags)
@@ -2332,6 +2346,7 @@
(when uid
(setq imap-current-message uid)
(imap-message-put uid 'UID uid)
+ (imap-message-put uid 'UIDINT (string-to-number uid))
(and (or flags flags-empty) (imap-message-put uid 'FLAGS flags))
(and envelope (imap-message-put uid 'ENVELOPE envelope))
(and internaldate (imap-message-put uid 'INTERNALDATE internaldate))
Index: lisp/nnimap.el
===================================================================
RCS file: /usr/local/cvsroot/gnus/lisp/nnimap.el,v
retrieving revision 6.71
diff -u -w -r6.71 nnimap.el
--- lisp/nnimap.el 4 Sep 2003 22:22:18 -0000 6.71
+++ lisp/nnimap.el 11 Dec 2003 15:35:51 -0000
@@ -438,6 +438,184 @@
(setq nnimap-current-server (or server nnimap-current-server)
nnimap-server-buffer (nnimap-get-server-buffer nnimap-current-server)))
+
+(defun nnimap-uid-cmp (a b)
+ (let ((la (length a))
+ (lb (length b)))
+ (if (/= la lb )
+ (- la lb)
+ (let ((idx 0))
+ (while (and (< idx la)
+ (char-equal (aref a idx) (aref b idx)))
+ (setq idx (1+ idx)))
+ (if (< idx la)
+ (- (aref a idx) (aref b idx))
+ 0)))))
+
+;; The imap-uid-to-msg-map is an alist of (MSG-NUMBER . UID) that is
+;; *sorted* by MSG-NUMBER. MSG-NUMBER is an integer and UID is a
+;; string.
+
+(defun nnimap-update-uid-map (group server)
+ "Update the UID to Gnus idea of a message number for this group"
+ (let* ((gnusgroup (gnus-group-prefixed-name group
+ (gnus-server-to-method
+ (format "nnimap:%s" server))))
+ (uidmap (cons
+ nil
+ (gnus-group-find-parameter gnusgroup 'imap-uid-to-msg-map t)))
+ (msghigh (gnus-group-find-parameter gnusgroup 'msg-high))
+ (uids (progn
+ (imap-fetch "1:*" "UID")
+ (sort (imap-message-map #'(lambda (uid Uid) uid) 'UID)
+ #'(lambda (a b) (minusp (nnimap-uid-cmp a b))))))
+ (tailptr uidmap))
+ ;; First remove disappeared UIDs
+ (while (and (not (null uids))
+ (consp (cdr tailptr)))
+ (let ((cmp (nnimap-uid-cmp (car uids) (cdadr tailptr))))
+ (cond
+ ((zerop cmp)
+ ;; OK, already in the list... Skip that
+ (setq uids (cdr uids)
+ tailptr (cdr tailptr)))
+ ((plusp cmp)
+ ;; The current UID from the map jas been expunged, remove it
+ ;; from the map
+ (setcdr tailptr (cddr tailptr)))
+ (t (error "This should not happen !")))))
+ ;; All remaining in the map have been deleted
+ (setcdr tailptr nil)
+ ;; Add new UIDS
+ (if (null msghigh)
+ (setq msghigh (if (null (car tailptr))
+ 0
+ (caar tailptr))))
+ (while (consp uids)
+ (setcdr tailptr (cons (cons (setq msghigh (1+ msghigh))
+ (car uids))
+ nil))
+ (setq tailptr (cdr tailptr)
+ uids (cdr uids)))
+ ;; XXX - Don't set this now if it was not already set to allow
+ ;; cohabitation of the two style of message numbering.
+ (if (gnus-group-find-parameter gnusgroup 'msg-high)
+ (gnus-group-set-parameter gnusgroup 'msg-high msghigh))
+ (gnus-group-set-parameter gnusgroup 'imap-uid-to-msg-map (cdr uidmap))))
+
+(defun nnimap-following-uid (gnusgroup uid)
+ "Returns the uid just following `uid' in `gnusgroup'."
+ (if (gnus-group-find-parameter gnusgroup 'msg-high)
+ (let ((uidmap (gnus-group-find-parameter gnusgroup
+ 'imap-uid-to-msg-map
+ t)))
+ (while (and uidmap (not (equal a (cdar uidmap))))
+ (setq uidmap (cdr uidmap)))
+ (cdadr uidmap))
+ (1+ uid)))
+
+(defun nnimap-uid-consecutive-p (gnusgroup a b)
+ "Test if UID B is for message just after uid A."
+ (equal b (nnimap-following-uid gnusgroup a)))
+
+(defun nnimap-compress-uid-list (gnusgroup uids)
+ (let* ((res (cons nil '()))
+ (tail res)
+ low high)
+ (while uids
+ (cond
+ ((and low (not (nnimap-uid-consecutive-p gnusgroup high (car uids))))
+ (setcdr tail `(,(if (= low high)
+ low
+ (cons low high))))
+ (setq tail (cdr tail)
+ low (car uids)
+ high low))
+ (low
+ (setq high (car uids)))
+ (t
+ (setq low (car uids)
+ high low)))
+ (setq uids (cdr uids)))
+ (if low
+ (setcdr tail `(,(if (equal low high)
+ low
+ (cons low high)))))
+ (cdr res)))
+
+(defun nnimap-uid-simple-range-length (uidmap start end)
+ (if uidmap
+ (let ((count 0))
+ (while uidmap
+ (if (not (minusp (nnimap-uid-cmp (cdr (pop uidmap)) start)))
+ ;; (>= (cdr (pop uidmap)) start)
+ (progn
+ (setq count (1+ count))
+ (while uidmap
+ (if (not (plusp (nnimap-uid-cmp end (cdr (pop uidmap)))))
+ ;; (<= end (cdr (pop uidmap)))
+ (setq uidmap nil))
+ (setq count (1+ count))))))
+ count)
+ 0))
+
+
+(defun nnimap-uid-range-length (range group server)
+ (let ((gnusgroup (gnus-group-prefixed-name group
+ (gnus-server-to-method
+ (format "nnimap:%s" server)))))
+ (if (gnus-group-find-parameter gnusgroup 'msg-high)
+ (let ((uidmap (gnus-group-find-parameter
+ gnusgroup 'imap-uid-to-msg-map t))
+ (res 0))
+ (mapc
+ #'(lambda (i)
+ (setq res (+ res
+ (cond
+ ((consp i)
+ (nnimap-uid-simple-range-length uidmap (car i) (cdr i)))
+ (t i)))))
+ range)
+ res)
+ (gnus-range-length range))))
+
+(defun nnimap-msgnum-to-uid (gnusgroup num)
+ (if (gnus-group-find-parameter gnusgroup 'msg-high)
+ (cdr (assq num (gnus-group-find-parameter
+ gnusgroup 'imap-uid-to-msg-map t)))
+ num))
+
+(defun nnimap-msgnum-to-uid-0 (num group server)
+ (nnimap-msgnum-to-uid
+ (gnus-group-prefixed-name group
+ (gnus-server-to-method
+ (format "nnimap:%s" server)))
+ num))
+
+(defun nnimap-articles-to-uids (group server articles)
+ (let* ((gnusgroup (gnus-group-prefixed-name group
+ (gnus-server-to-method
+ (format "nnimap:%s" server))))
+ (res (cons nil '()))
+ (tail res)
+ msg)
+ (while (not (null articles))
+ (setq msg (nnimap-msgnum-to-uid gnusgroup (car articles))
+ articles (cdr articles))
+ (when msg
+ (setcdr tail (cons msg nil))
+ (setq tail (cdr tail))))
+ (cdr res)))
+
+(defun nnimap-uid-to-msgnum (group server uid)
+ (let ((gnusgroup (gnus-group-prefixed-name group
+ (gnus-server-to-method
+ (format "nnimap:%s" server)))))
+ (if (gnus-group-find-parameter gnusgroup 'msg-high)
+ (car (rassoc uid (gnus-group-find-parameter
+ gnusgroup 'imap-uid-to-msg-map t)))
+ (string-to-number uid))))
+
(defun nnimap-verify-uidvalidity (group server)
"Verify stored uidvalidity match current one in GROUP on SERVER."
(let* ((gnusgroup (gnus-group-prefixed-name
@@ -485,12 +663,24 @@
(when (or (string= group (imap-current-mailbox))
(imap-mailbox-select group examine))
(let (minuid maxuid)
+ (let ((gnusgroup
+ (gnus-group-prefixed-name group
+ (gnus-server-to-method
+ (format "nnimap:%s"
+ nnimap-current-server)))))
+ (if (setq maxuid (gnus-group-find-parameter gnusgroup 'msg-high))
+ ;; New style message numbers
+ (let ((map
+ (gnus-group-find-parameter gnusgroup 'imap-uid-to-msg-map t)))
+ (if (null map)
+ (setq minuid maxuid)
+ (setq minuid (caar map))))
(when (> (imap-mailbox-get 'exists) 0)
(imap-fetch "1,*" "UID" nil 'nouidfetch)
- (imap-message-map (lambda (uid Uid)
+ (imap-message-map (lambda (struid uid)
(setq minuid (if minuid (min minuid uid) uid)
maxuid (if maxuid (max maxuid uid) uid)))
- 'UID))
+ 'UIDINT))))
(list (imap-mailbox-get 'exists) minuid maxuid)))))
(defun nnimap-possibly-change-group (group &optional server)
@@ -508,7 +698,9 @@
(yes-or-no-p
(format
"nnimap: Group %s is not uidvalid. Continue? " group)))
- imap-current-mailbox
+ (progn
+ (nnimap-update-uid-map group server)
+ imap-current-mailbox)
(imap-mailbox-unselect)
(error "nnimap: Group %s is not uid-valid" group))
(nnheader-report 'nnimap (imap-error-text)))))))
@@ -550,12 +742,13 @@
(with-temp-buffer
(buffer-disable-undo)
(insert headers)
- (let ((head (nnheader-parse-naked-head)))
- (mail-header-set-number head uid)
+ (let ((head (nnheader-parse-naked-head))
+ (msgnum (nnimap-uid-to-msgnum mbx nnimap-current-server uid)))
+ (mail-header-set-number head msgnum)
(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 (format "%s %s:%d" (system-name) mbx msgnum))
head))))))
(defun nnimap-retrieve-which-headers (articles fetch-old)
@@ -643,7 +836,7 @@
(defun nnimap-retrieve-headers-from-server (articles group server)
(with-current-buffer nnimap-server-buffer
(let ((imap-fetch-data-hook '(nnimap-retrieve-headers-progress))
- (nnimap-length (gnus-range-length articles))
+ (nnimap-length (nnimap-uid-range-length articles group server))
(nnimap-counter 0))
(imap-fetch (imap-range-to-message-set articles)
(concat "(UID RFC822.SIZE BODY "
@@ -670,12 +863,20 @@
(nnimap-group-overview-filename group server)))))
(deffoo nnimap-retrieve-headers (articles &optional group server fetch-old)
+ (setq articles (nnimap-articles-to-uids group server articles))
(when (nnimap-possibly-change-group group server)
(with-current-buffer nntp-server-buffer
(erase-buffer)
(if (nnimap-dont-use-nov-p group server)
(nnimap-retrieve-headers-from-server
- (gnus-compress-sequence articles) group server)
+ (nnimap-compress-uid-list (gnus-group-prefixed-name
+ group
+ (gnus-server-to-method
+ (format "nnimap:%s" server)))
+ articles)
+ group
+ server)
+ ;;; XXX Il faut aussi modifier ce else !
(let (uids cached low high)
(when (setq uids (nnimap-retrieve-which-headers articles fetch-old)
low (car uids)
@@ -829,42 +1030,45 @@
(nnheader-ms-strip-cr)
(funcall gnus-callback t))))
-(defun nnimap-request-article-part (article part prop &optional
+;;; XXX - nnimap-request-article-part expect a article number, *not* an uid !
+
+(defun nnimap-request-article-part (num part prop &optional
group server to-buffer detail)
(when (nnimap-possibly-change-group group server)
- (let ((article (if (stringp article)
+ (let ((article (if (stringp num)
(car-safe (imap-search
- (format "HEADER Message-Id \"%s\"" article)
+ (format "HEADER Message-Id \"%s\"" num)
nnimap-server-buffer))
- article)))
+ (nnimap-msgnum-to-uid-0 num group server))))
(when article
- (gnus-message 10 "nnimap: Fetching (part of) article %d from %s..."
- article (or group imap-current-mailbox
+ (gnus-message 10 "nnimap: Fetching (part of) article %s from %s..."
+ num (or group imap-current-mailbox
gnus-newsgroup-name))
(if (not nnheader-callback-function)
(with-current-buffer (or to-buffer nntp-server-buffer)
(erase-buffer)
- (let ((data (imap-fetch article part prop nil
- nnimap-server-buffer)))
+ ;; XXX - Hack: pass article as a list to receive the result
+ (let ((data (car (imap-fetch `(,article) part prop nil
+ nnimap-server-buffer))))
(insert (nnimap-demule (if detail
(nth 2 (car data))
data))))
(nnheader-ms-strip-cr)
(gnus-message
10 "nnimap: Fetching (part of) article %d from %s...done"
- article (or group imap-current-mailbox gnus-newsgroup-name))
+ num (or group imap-current-mailbox gnus-newsgroup-name))
(if (bobp)
(nnheader-report 'nnimap "No such article %d in %s: %s"
- article (or group imap-current-mailbox
+ num (or group imap-current-mailbox
gnus-newsgroup-name)
(imap-error-text nnimap-server-buffer))
- (cons group article)))
+ (cons group num)))
(add-hook 'imap-fetch-data-hook
(nnimap-make-callback article
nnheader-callback-function
nntp-server-buffer))
(imap-fetch-asynch article part nil nnimap-server-buffer)
- (cons group article))))))
+ (cons group num))))))
(deffoo nnimap-asynchronous-p ()
t)
^ permalink raw reply [flat|nested] 3+ messages in thread
end of thread, other threads:[~2003-12-11 15:36 UTC | newest]
Thread overview: 3+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2003-12-10 19:40 toward a solution to nnimap and large UIDs Kim Minh Kaplan
2003-12-10 20:56 ` Simon Josefsson
2003-12-11 15:36 ` Kim Minh Kaplan
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for NNTP newsgroup(s).