;;; Code:
+;; For Emacs <22.2 and XEmacs.
+(eval-and-compile
+ (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
+
(eval-and-compile
(require 'nnheader))
(require 'nnoo)
(require 'netrc)
(require 'utf7)
+(require 'tls)
(require 'parse-time)
(autoload 'auth-source-forget-user-or-password "auth-source")
"How mail is split.
Uses the same syntax as nnmail-split-methods")
+(defvoo nnimap-split-fancy nil
+ "Uses the same syntax as nnmail-split-fancy.")
+
+(make-obsolete-variable 'nnimap-split-rule "see `nnimap-split-methods'"
+ "Emacs 24.1")
+
(defvoo nnimap-authenticator nil
"How nnimap authenticate itself to the server.
Possible choices are nil (use default methods) or `anonymous'.")
(* 5 60)))
(nnimap-send-command "NOOP")))))))
+(declare-function gnutls-negotiate "subr" (fn file &optional arglist fileonly))
+
(defun nnimap-open-connection (buffer)
(unless nnimap-keepalive-timer
(setq nnimap-keepalive-timer (run-at-time (* 60 15) (* 60 15)
(port nil)
(ports
(cond
- ((eq nnimap-stream 'network)
+ ((or (eq nnimap-stream 'network)
+ (and (eq nnimap-stream 'starttls)
+ (fboundp 'open-gnutls-stream)))
+ (nnheader-message 7 "Opening connection to %s..."
+ nnimap-address)
(open-network-stream
"*nnimap*" (current-buffer) nnimap-address
(setq port
"143"))))
'("143" "imap"))
((eq nnimap-stream 'shell)
+ (nnheader-message 7 "Opening connection to %s via shell..."
+ nnimap-address)
(nnimap-open-shell-stream
"*nnimap*" (current-buffer) nnimap-address
(setq port (or nnimap-server-port "imap")))
'("imap"))
((eq nnimap-stream 'starttls)
- (starttls-open-stream
- "*nnimap*" (current-buffer) nnimap-address
- (setq port (or nnimap-server-port "imap")))
+ (nnheader-message 7 "Opening connection to %s via starttls..."
+ nnimap-address)
+ (let ((tls-program
+ '("openssl s_client -connect %h:%p -no_ssl2 -ign_eof -starttls imap")))
+ (open-tls-stream
+ "*nnimap*" (current-buffer) nnimap-address
+ (setq port (or nnimap-server-port "imap"))))
'("imap"))
- ((eq nnimap-stream 'ssl)
- (open-tls-stream
- "*nnimap*" (current-buffer) nnimap-address
- (setq port
- (or nnimap-server-port
- (if (netrc-find-service-number "imaps")
- "imaps"
- "993"))))
- '("143" "993" "imap" "imaps"))))
+ ((memq nnimap-stream '(ssl tls))
+ (nnheader-message 7 "Opening connection to %s via tls..."
+ nnimap-address)
+ (funcall (if (fboundp 'open-gnutls-stream)
+ 'open-gnutls-stream
+ 'open-tls-stream)
+ "*nnimap*" (current-buffer) nnimap-address
+ (setq port
+ (or nnimap-server-port
+ (if (netrc-find-service-number "imaps")
+ "imaps"
+ "993"))))
+ '("143" "993" "imap" "imaps"))
+ (t
+ (error "Unknown stream type: %s" nnimap-stream))))
connection-result login-result credentials)
(setf (nnimap-process nnimap-object)
(get-buffer-process (current-buffer)))
'(open run))))
(nnheader-report 'nnimap "Unable to contact %s:%s via %s"
nnimap-address port nnimap-stream)
- (gnus-set-process-query-on-exit-flag (nnimap-process nnimap-object) nil)
+ (gnus-set-process-query-on-exit-flag
+ (nnimap-process nnimap-object) nil)
(if (not (setq connection-result (nnimap-wait-for-connection)))
(nnheader-report 'nnimap
"%s" (buffer-substring
#'upcase
(nnimap-find-parameter
"CAPABILITY" (cdr (nnimap-command "CAPABILITY")))))
- (when (eq nnimap-stream 'starttls)
- (nnimap-command "STARTTLS")
- (starttls-negotiate (nnimap-process nnimap-object)))
+ (when nnimap-server-port
+ (push (format "%s" nnimap-server-port) ports))
;; If this is a STARTTLS-capable server, then sever the
;; connection and start a STARTTLS connection instead.
- (when (and (eq nnimap-stream 'network)
- (member "STARTTLS" (nnimap-capabilities nnimap-object)))
+ (cond
+ ((and (or (and (eq nnimap-stream 'network)
+ (member "STARTTLS"
+ (nnimap-capabilities nnimap-object)))
+ (eq nnimap-stream 'starttls))
+ (fboundp 'open-gnutls-stream))
+ (nnimap-command "STARTTLS")
+ (gnutls-negotiate (nnimap-process nnimap-object) nil))
+ ((and (eq nnimap-stream 'network)
+ (member "STARTTLS" (nnimap-capabilities nnimap-object)))
(let ((nnimap-stream 'starttls))
- (delete-process (nnimap-process nnimap-object))
- (kill-buffer (current-buffer))
- (return
- (nnimap-open-connection buffer))))
- (when nnimap-server-port
- (push (format "%s" nnimap-server-port) ports))
+ (let ((tls-process
+ (nnimap-open-connection buffer)))
+ ;; If the STARTTLS connection was successful, we
+ ;; kill our first non-encrypted connection. If it
+ ;; wasn't successful, we just use our unencrypted
+ ;; connection.
+ (when (memq (process-status tls-process) '(open run))
+ (delete-process (nnimap-process nnimap-object))
+ (kill-buffer (current-buffer))
+ (return tls-process))))))
(unless (equal connection-result "PREAUTH")
(if (not (setq credentials
(if (eq nnimap-authenticator 'anonymous)
(when nnimap-object
(when (member "QRESYNC" (nnimap-capabilities nnimap-object))
(nnimap-command "ENABLE QRESYNC"))
- t)))))))
+ (nnimap-process nnimap-object))))))))
(defun nnimap-find-parameter (parameter elems)
(let (result)
result))
(deffoo nnimap-close-server (&optional server)
- t)
+ (when (nnoo-change-server 'nnimap server nil)
+ (ignore-errors
+ (delete-process (get-buffer-process (nnimap-buffer))))
+ (nnoo-close-server 'nnimap server)
+ t))
(deffoo nnimap-request-close ()
t)
(nnimap-command "UID FETCH %d (BODYSTRUCTURE)" article)
(goto-char (point-min))
(when (re-search-forward "FETCH.*BODYSTRUCTURE" nil t)
- (setq structure (ignore-errors (read (current-buffer)))
+ (setq structure (ignore-errors
+ (let ((start (point)))
+ (forward-sexp 1)
+ (downcase-region start (point))
+ (goto-char start)
+ (read (current-buffer))))
parts (nnimap-find-wanted-parts structure))))
(when (if parts
(nnimap-get-partial-article article parts structure)
t))
(defun nnimap-insert-partial-structure (structure parts &optional subp)
- (let ((type (car (last structure 4)))
- (boundary (let ((bstruc structure))
- (while (consp (car bstruc))
- (pop bstruc))
- (setq bstruc (car (cdr bstruc)))
- (and (stringp (car bstruc))
- (string= (downcase (car bstruc)) "boundary")
- (cadr bstruc)))))
+ (let (type boundary)
+ (let ((bstruc structure))
+ (while (consp (car bstruc))
+ (pop bstruc))
+ (setq type (car bstruc))
+ (setq bstruc (car (cdr bstruc)))
+ (when (and (stringp (car bstruc))
+ (string= (downcase (car bstruc)) "boundary"))
+ (setq boundary (cadr bstruc))))
(when subp
(insert (format "Content-type: multipart/%s; boundary=%S\n\n"
(downcase type) boundary)))
(nreverse parts)))
(deffoo nnimap-request-group (group &optional server dont-check info)
- (let ((result (nnimap-possibly-change-group group server))
+ (let ((result (nnimap-possibly-change-group
+ ;; Don't SELECT the group if we're going to select it
+ ;; later, anyway.
+ (if dont-check
+ nil
+ group)
+ server))
articles active marks high low)
(with-current-buffer nntp-server-buffer
(when result
(nnimap-send-command "SELECT %S" (utf7-encode group t)))
(flag-sequence
(nnimap-send-command "UID FETCH 1:* FLAGS")))
+ (setf (nnimap-group nnimap-object) group)
(nnimap-wait-for-response flag-sequence)
(setq marks
(nnimap-flags-to-marks
(nnimap-parse-flags
- (list (list group-sequence flag-sequence 1 group)))))
- (when info
+ (list (list group-sequence flag-sequence
+ 1 group "SELECT")))))
+ (when (and info
+ marks)
(nnimap-update-infos marks (list info)))
(goto-char (point-max))
(let ((uidnext (nth 5 (car marks))))
- (setq high (if uidnext
- (1- uidnext)
- (nth 3 (car marks)))
- low (or (nth 4 (car marks)) uidnext)))))
+ (setq high (or (if uidnext
+ (1- uidnext)
+ (nth 3 (car marks)))
+ 0)
+ low (or (nth 4 (car marks)) uidnext 1)))))
(erase-buffer)
(insert
(format
(with-current-buffer (nnimap-buffer)
(car (nnimap-command "DELETE %S" (utf7-encode group t))))))
+(deffoo nnimap-request-rename-group (group new-name &optional server)
+ (when (nnimap-possibly-change-group nil server)
+ (with-current-buffer (nnimap-buffer)
+ ;; Make sure we don't have this group open read/write by asking
+ ;; to examine a mailbox that doesn't exist. This seems to be
+ ;; the only way that allows us to reliably go back to unselected
+ ;; state on Courier.
+ (nnimap-command "EXAMINE DOES.NOT.EXIST")
+ (setf (nnimap-group nnimap-object) nil)
+ (car (nnimap-command "RENAME %S %S"
+ (utf7-encode group t) (utf7-encode new-name t))))))
+
(deffoo nnimap-request-expunge-group (group &optional server)
(when (nnimap-possibly-change-group group server)
(with-current-buffer (nnimap-buffer)
(defun nnimap-get-flags (spec)
(let ((articles nil)
- elems)
+ elems end)
(with-current-buffer (nnimap-buffer)
(erase-buffer)
(nnimap-wait-for-response (nnimap-send-command
"UID FETCH %s FLAGS" spec))
+ (setq end (point))
+ (subst-char-in-region (point-min) (point-max)
+ ?\\ ?% t)
(goto-char (point-min))
- (while (re-search-forward "^\\* [0-9]+ FETCH (\\(.*\\))" nil t)
- (setq elems (nnimap-parse-line (match-string 1)))
- (push (cons (string-to-number (cadr (member "UID" elems)))
- (cadr (member "FLAGS" elems)))
+ (while (search-forward " FETCH " end t)
+ (setq elems (read (current-buffer)))
+ (push (cons (cadr (memq 'UID elems))
+ (cadr (memq 'FLAGS elems)))
articles)))
(nreverse articles)))
(deffoo nnimap-request-move-article (article group server accept-form
&optional last internal-move-group)
(with-temp-buffer
+ (mm-disable-multibyte)
(when (nnimap-request-article article group server (current-buffer))
;; If the move is internal (on the same server), just do it the easy
;; way.
((and force
(eq nnmail-expiry-target 'delete))
(unless (nnimap-delete-article (gnus-compress-sequence articles))
- (message "Article marked for deletion, but not expunged."))
+ (nnheader-message 7 "Article marked for deletion, but not expunged."))
nil)
(t
(let ((deletable-articles
(dolist (article articles)
(let ((target nnmail-expiry-target))
(with-temp-buffer
+ (mm-disable-multibyte)
(when (nnimap-request-article article group server (current-buffer))
- (message "Expiring article %s:%d" group article)
+ (nnheader-message 7 "Expiring article %s:%d" group article)
(when (functionp target)
(setq target (funcall target group)))
(when (and target
(defun nnimap-find-article-by-message-id (group message-id)
- (when (nnimap-possibly-change-group group nil)
- (with-current-buffer (nnimap-buffer)
- (let ((result
- (nnimap-command "UID SEARCH HEADER Message-Id %S" message-id))
- article)
- (when (car result)
- ;; Select the last instance of the message in the group.
- (and (setq article
- (car (last (assoc "SEARCH" (cdr result)))))
- (string-to-number article)))))))
+ (with-current-buffer (nnimap-buffer)
+ (erase-buffer)
+ (setf (nnimap-group nnimap-object) nil)
+ (nnimap-send-command "EXAMINE %S" (utf7-encode group t))
+ (let ((sequence
+ (nnimap-send-command "UID SEARCH HEADER Message-Id %S" message-id))
+ article result)
+ (setq result (nnimap-wait-for-response sequence))
+ (when (and result
+ (car (setq result (nnimap-parse-response))))
+ ;; Select the last instance of the message in the group.
+ (and (setq article
+ (car (last (assoc "SEARCH" (cdr result)))))
+ (string-to-number article))))))
(defun nnimap-delete-article (articles)
(with-current-buffer (nnimap-buffer)
(when (and (nnimap-possibly-change-group nil server)
nnimap-inbox
nnimap-split-methods)
- (message "nnimap %s splitting mail..." server)
+ (nnheader-message 7 "nnimap %s splitting mail..." server)
(nnimap-split-incoming-mail)))
(defun nnimap-marks-to-flags (marks)
(when (nnimap-possibly-change-group group server)
(let (sequence)
(with-current-buffer (nnimap-buffer)
+ (erase-buffer)
;; Just send all the STORE commands without waiting for
;; response. If they're successful, they're successful.
(dolist (action actions)
(deffoo nnimap-request-accept-article (group &optional server last)
(when (nnimap-possibly-change-group nil server)
(nnmail-check-syntax)
- (nnimap-add-cr)
- (let ((message (buffer-string))
- (message-id (message-field-value "message-id"))
- sequence)
+ (let ((message-id (message-field-value "message-id"))
+ sequence message)
+ (nnimap-add-cr)
+ (setq message (buffer-string))
(with-current-buffer (nnimap-buffer)
(setq sequence (nnimap-send-command
"APPEND %S {%d}" (utf7-encode group t)
(let ((result (nnimap-get-response sequence)))
(if (not (car result))
(progn
- (message "%s" (nnheader-get-report-string 'nnimap))
+ (nnheader-message 7 "%s" (nnheader-get-report-string 'nnimap))
nil)
(cons group
(nnimap-find-article-by-message-id group message-id))))))))
(or highest exists)))))))))
t))))
+(deffoo nnimap-request-newgroups (date &optional server)
+ (nnimap-possibly-change-group nil server)
+ (with-current-buffer nntp-server-buffer
+ (erase-buffer)
+ (dolist (group (with-current-buffer (nnimap-buffer)
+ (nnimap-get-groups)))
+ (unless (assoc group nnimap-current-infos)
+ ;; Insert dummy numbers here -- they don't matter.
+ (insert (format "%S 0 1 y\n" group))))
+ t))
+
(deffoo nnimap-retrieve-group-data-early (server infos)
(when (nnimap-possibly-change-group nil server)
(with-current-buffer (nnimap-buffer)
+ (erase-buffer)
+ (setf (nnimap-group nnimap-object) nil)
;; QRESYNC handling isn't implemented.
- (let ((qresyncp (member "notQRESYNC" (nnimap-capabilities nnimap-object)))
- marks groups sequences)
+ (let ((qresyncp (member "QRESYNC" (nnimap-capabilities nnimap-object)))
+ params groups sequences active uidvalidity modseq group)
;; Go through the infos and gather the data needed to know
;; what and how to request the data.
(dolist (info infos)
- (setq marks (gnus-info-marks info))
- (push (list (gnus-group-real-name (gnus-info-group info))
- (cdr (assq 'active marks))
- (cdr (assq 'uid marks)))
- groups))
- ;; Then request the data.
- (erase-buffer)
- (setf (nnimap-group nnimap-object) nil)
- (dolist (elem groups)
+ (setq params (gnus-info-params info)
+ group (gnus-group-real-name (gnus-info-group info))
+ active (cdr (assq 'active params))
+ uidvalidity (cdr (assq 'uidvalidity params))
+ modseq (cdr (assq 'modseq params)))
(if (and qresyncp
- (nth 2 elem))
+ uidvalidity
+ modseq)
(push
- (list 'qresync
- (nnimap-send-command "EXAMINE %S (QRESYNC (%s %s))"
- (car elem)
- (car (nth 2 elem))
- (cdr (nth 2 elem)))
- nil
- (car elem))
+ (list (nnimap-send-command "EXAMINE %S (QRESYNC (%s %s))"
+ (utf7-encode group t)
+ uidvalidity modseq)
+ 'qresync
+ nil group 'qresync)
sequences)
(let ((start
- (if (nth 1 elem)
+ (if (and active uidvalidity)
;; Fetch the last 100 flags.
- (max 1 (- (cdr (nth 1 elem)) 100))
- 1)))
- (push (list (nnimap-send-command "EXAMINE %S" (car elem))
+ (max 1 (- (cdr active) 100))
+ 1))
+ (command
+ (if uidvalidity
+ "EXAMINE"
+ ;; If we don't have a UIDVALIDITY, then this is
+ ;; the first time we've seen the group, so we
+ ;; have to do a SELECT (which is slower than an
+ ;; examine), but will tell us whether the group
+ ;; is read-only or not.
+ "SELECT")))
+ (push (list (nnimap-send-command "%s %S" command
+ (utf7-encode group t))
(nnimap-send-command "UID FETCH %d:* FLAGS" start)
- start
- (car elem))
+ start group command)
sequences)))
;; Some servers apparently can't have many outstanding
;; commands, so throttle them.
(nnimap-possibly-change-group nil server))
(with-current-buffer (nnimap-buffer)
;; Wait for the final data to trickle in.
- (when (nnimap-wait-for-response (cadar sequences))
- ;; Now we should have all the data we need, no matter whether
- ;; we're QRESYNCING, fetching all the flags from scratch, or
- ;; just fetching the last 100 flags per group.
+ (when (nnimap-wait-for-response (if (eq (cadar sequences) 'qresync)
+ (caar sequences)
+ (cadar sequences))
+ t)
+ ;; Now we should have most of the data we need, no matter
+ ;; whether we're QRESYNCING, fetching all the flags from
+ ;; scratch, or just fetching the last 100 flags per group.
(nnimap-update-infos (nnimap-flags-to-marks
(nnimap-parse-flags
(nreverse sequences)))
(defun nnimap-update-infos (flags infos)
(dolist (info infos)
- (let ((group (gnus-group-real-name (gnus-info-group info))))
- (nnimap-update-info info (cdr (assoc group flags))))))
+ (let* ((group (gnus-group-real-name (gnus-info-group info)))
+ (marks (cdr (assoc group flags))))
+ (when marks
+ (nnimap-update-info info marks)))))
(defun nnimap-update-info (info marks)
- (when marks
- (destructuring-bind (existing flags high low uidnext start-article
- permanent-flags) marks
- (let ((group (gnus-info-group info))
- (completep (and start-article
- (= start-article 1))))
+ (destructuring-bind (existing flags high low uidnext start-article
+ permanent-flags uidvalidity
+ vanished highestmodseq) marks
+ (cond
+ ;; Ignore groups with no UIDNEXT/marks. This happens for
+ ;; completely empty groups.
+ ((and (not existing)
+ (not uidnext))
+ (let ((active (cdr (assq 'active (gnus-info-params info)))))
+ (when active
+ (gnus-set-active (gnus-info-group info) active))))
+ ;; We have a mismatch between the old and new UIDVALIDITY
+ ;; identifiers, so we have to re-request the group info (the next
+ ;; time). This virtually never happens.
+ ((let ((old-uidvalidity
+ (cdr (assq 'uidvalidity (gnus-info-params info)))))
+ (and old-uidvalidity
+ (not (equal old-uidvalidity uidvalidity))
+ (> start-article 1)))
+ (gnus-group-remove-parameter info 'uidvalidity)
+ (gnus-group-remove-parameter info 'modseq))
+ ;; We have the data needed to update.
+ (t
+ (let* ((group (gnus-info-group info))
+ (completep (and start-article
+ (= start-article 1)))
+ (active (or (gnus-active group)
+ (cdr (assq 'active (gnus-info-params info))))))
(when uidnext
(setq high (1- uidnext)))
;; First set the active ranges based on high/low.
(uidnext
;; No articles in this group.
(cons uidnext (1- uidnext)))
+ (active
+ active)
(start-article
(cons start-article (1- start-article)))
(t
nil)))
(gnus-set-active
group
- (cons (car (gnus-active group))
+ (cons (car active)
(or high (1- uidnext)))))
- (when (and (not high)
- uidnext)
- (setq high (1- uidnext)))
- ;; Then update the list of read articles.
- (let* ((unread
- (gnus-compress-sequence
- (gnus-set-difference
- (gnus-set-difference
- existing
- (cdr (assoc '%Seen flags)))
- (cdr (assoc '%Flagged flags)))))
- (read (gnus-range-difference
- (cons start-article high) unread)))
- (when (> start-article 1)
- (setq read
- (gnus-range-nconcat
- (if (> start-article 1)
- (gnus-sorted-range-intersection
- (cons 1 (1- start-article))
- (gnus-info-read info))
- (gnus-info-read info))
- read)))
- (gnus-info-set-read info read)
- ;; Update the marks.
- (setq marks (gnus-info-marks info))
- ;; Note the active level for the next run-through.
- (let ((active (assq 'active marks)))
- (if active
- (setcdr active (gnus-active group))
- (push (cons 'active (gnus-active group)) marks)))
- (dolist (type (cdr nnimap-mark-alist))
- (let ((old-marks (assoc (car type) marks))
- (new-marks
- (gnus-compress-sequence
- (cdr (or (assoc (caddr type) flags) ; %Flagged
- (assoc (intern (cadr type) obarray) flags)
- (assoc (cadr type) flags)))))) ; "\Flagged"
- (setq marks (delq old-marks marks))
- (pop old-marks)
- (when (and old-marks
- (> start-article 1))
- (setq old-marks (gnus-range-difference
- old-marks
- (cons start-article high)))
- (setq new-marks (gnus-range-nconcat old-marks new-marks)))
- (when new-marks
- (push (cons (car type) new-marks) marks)))
- (gnus-info-set-marks info marks t)
- (nnimap-store-info info (gnus-active group))))))))
+ ;; See whether this is a read-only group.
+ (unless (eq permanent-flags 'not-scanned)
+ (gnus-group-set-parameter
+ info 'permanent-flags
+ (and (or (memq '%* permanent-flags)
+ (memq '%Seen permanent-flags))
+ permanent-flags)))
+ ;; Update marks and read articles if this isn't a
+ ;; read-only IMAP group.
+ (when (setq permanent-flags
+ (cdr (assq 'permanent-flags (gnus-info-params info))))
+ (if (and highestmodseq
+ (not start-article))
+ ;; We've gotten the data by QRESYNCing.
+ (nnimap-update-qresync-info
+ info existing (nnimap-imap-ranges-to-gnus-ranges vanished) flags)
+ ;; Do normal non-QRESYNC flag updates.
+ ;; Update the list of read articles.
+ (let* ((unread
+ (gnus-compress-sequence
+ (gnus-set-difference
+ (gnus-set-difference
+ existing
+ (cdr (assoc '%Seen flags)))
+ (cdr (assoc '%Flagged flags)))))
+ (read (gnus-range-difference
+ (cons start-article high) unread)))
+ (when (> start-article 1)
+ (setq read
+ (gnus-range-nconcat
+ (if (> start-article 1)
+ (gnus-sorted-range-intersection
+ (cons 1 (1- start-article))
+ (gnus-info-read info))
+ (gnus-info-read info))
+ read)))
+ (when (or (not (listp permanent-flags))
+ (memq '%Seen permanent-flags))
+ (gnus-info-set-read info read))
+ ;; Update the marks.
+ (setq marks (gnus-info-marks info))
+ (dolist (type (cdr nnimap-mark-alist))
+ (when (or (not (listp permanent-flags))
+ (memq (assoc (caddr type) flags) permanent-flags)
+ (memq '%* permanent-flags))
+ (let ((old-marks (assoc (car type) marks))
+ (new-marks
+ (gnus-compress-sequence
+ (cdr (or (assoc (caddr type) flags) ; %Flagged
+ (assoc (intern (cadr type) obarray) flags)
+ (assoc (cadr type) flags)))))) ; "\Flagged"
+ (setq marks (delq old-marks marks))
+ (pop old-marks)
+ (when (and old-marks
+ (> start-article 1))
+ (setq old-marks (gnus-range-difference
+ old-marks
+ (cons start-article high)))
+ (setq new-marks (gnus-range-nconcat old-marks new-marks)))
+ (when new-marks
+ (push (cons (car type) new-marks) marks)))))
+ (gnus-info-set-marks info marks t))))
+ ;; Note the active level for the next run-through.
+ (gnus-group-set-parameter info 'active (gnus-active group))
+ (gnus-group-set-parameter info 'uidvalidity uidvalidity)
+ (gnus-group-set-parameter info 'modseq highestmodseq)
+ (nnimap-store-info info (gnus-active group)))))))
+
+(defun nnimap-update-qresync-info (info existing vanished flags)
+ ;; Add all the vanished articles to the list of read articles.
+ (gnus-info-set-read
+ info
+ (gnus-add-to-range
+ (gnus-add-to-range
+ (gnus-range-add (gnus-info-read info)
+ vanished)
+ (cdr (assq '%Flagged flags)))
+ (cdr (assq '%Seen flags))))
+ (let ((marks (gnus-info-marks info)))
+ (dolist (type (cdr nnimap-mark-alist))
+ (let ((ticks (assoc (car type) marks))
+ (new-marks
+ (cdr (or (assoc (caddr type) flags) ; %Flagged
+ (assoc (intern (cadr type) obarray) flags)
+ (assoc (cadr type) flags))))) ; "\Flagged"
+ (setq marks (delq ticks marks))
+ (pop ticks)
+ ;; Add the new marks we got.
+ (setq ticks (gnus-add-to-range ticks new-marks))
+ ;; Remove the marks from messages that don't have them.
+ (setq ticks (gnus-remove-from-range
+ ticks
+ (gnus-compress-sequence
+ (gnus-sorted-complement existing new-marks))))
+ (when ticks
+ (push (cons (car type) ticks) marks)))
+ (gnus-info-set-marks info marks t))))
+
+(defun nnimap-imap-ranges-to-gnus-ranges (irange)
+ (if (zerop (length irange))
+ nil
+ (let ((result nil))
+ (dolist (elem (split-string irange ","))
+ (push
+ (if (string-match ":" elem)
+ (let ((numbers (split-string elem ":")))
+ (cons (string-to-number (car numbers))
+ (string-to-number (cadr numbers))))
+ (string-to-number elem))
+ result))
+ (nreverse result))))
(defun nnimap-store-info (info active)
(let* ((group (gnus-group-real-name (gnus-info-group info)))
(push (list group info active) nnimap-current-infos))))
(defun nnimap-flags-to-marks (groups)
- (let (data group totalp uidnext articles start-article mark permanent-flags)
+ (let (data group totalp uidnext articles start-article mark permanent-flags
+ uidvalidity vanished highestmodseq)
(dolist (elem groups)
(setq group (car elem)
uidnext (nth 1 elem)
start-article (nth 2 elem)
permanent-flags (nth 3 elem)
- articles (nthcdr 4 elem))
+ uidvalidity (nth 4 elem)
+ vanished (nth 5 elem)
+ highestmodseq (nth 6 elem)
+ articles (nthcdr 7 elem))
(let ((high (caar articles))
marks low existing)
(dolist (article articles)
(push (list flag (car article)) marks)
(setcdr mark (cons (car article) (cdr mark))))))
(push (list group existing marks high low uidnext start-article
- permanent-flags)
+ permanent-flags uidvalidity vanished highestmodseq)
data)))
data))
;; Change \Delete etc to %Delete, so that the reader can read it.
(subst-char-in-region (point-min) (point-max)
?\\ ?% t)
- (let (start end articles groups uidnext elems permanent-flags)
+ (let (start end articles groups uidnext elems permanent-flags
+ uidvalidity vanished highestmodseq)
(dolist (elem sequences)
- (destructuring-bind (group-sequence flag-sequence totalp group) elem
+ (destructuring-bind (group-sequence flag-sequence totalp group command)
+ elem
(setq start (point))
- ;; The EXAMINE was successful.
- (when (and (search-forward (format "\n%d OK " group-sequence) nil t)
- (progn
- (forward-line 1)
- (setq end (point))
- (goto-char start)
- (setq permanent-flags
+ (when (and
+ ;; The EXAMINE was successful.
+ (search-forward (format "\n%d OK " group-sequence) nil t)
+ (progn
+ (forward-line 1)
+ (setq end (point))
+ (goto-char start)
+ (setq permanent-flags
+ (if (equal command "SELECT")
(and (search-forward "PERMANENTFLAGS "
- (or end (point-min)) t)
- (read (current-buffer))))
- (goto-char start)
- (setq uidnext
- (and (search-forward "UIDNEXT "
- (or end (point-min)) t)
- (read (current-buffer))))
- (goto-char end)
- (forward-line -1))
- ;; The UID FETCH FLAGS was successful.
- (search-forward (format "\n%d OK " flag-sequence) nil t))
- (setq start (point))
- (goto-char end)
- (while (search-forward " FETCH " start t)
+ (or end (point-min)) t)
+ (read (current-buffer)))
+ 'not-scanned))
+ (goto-char start)
+ (setq uidnext
+ (and (search-forward "UIDNEXT "
+ (or end (point-min)) t)
+ (read (current-buffer))))
+ (goto-char start)
+ (setq uidvalidity
+ (and (re-search-forward "UIDVALIDITY \\([0-9]+\\)"
+ (or end (point-min)) t)
+ ;; Store UIDVALIDITY as a string, as it's
+ ;; too big for 32-bit Emacsen, usually.
+ (match-string 1)))
+ (goto-char start)
+ (setq vanished
+ (and (eq flag-sequence 'qresync)
+ (re-search-forward "VANISHED.* \\([0-9:,]+\\)"
+ (or end (point-min)) t)
+ (match-string 1)))
+ (goto-char start)
+ (setq highestmodseq
+ (and (search-forward "HIGHESTMODSEQ "
+ (or end (point-min)) t)
+ (read (current-buffer))))
+ (goto-char end)
+ (forward-line -1))
+ ;; The UID FETCH FLAGS was successful.
+ (or (eq flag-sequence 'qresync)
+ (search-forward (format "\n%d OK " flag-sequence) nil t)))
+ (if (eq flag-sequence 'qresync)
+ (progn
+ (goto-char start)
+ (setq start end))
+ (setq start (point))
+ (goto-char end))
+ (while (re-search-forward "^\\* [0-9]+ FETCH " start t)
(setq elems (read (current-buffer)))
(push (cons (cadr (memq 'UID elems))
(cadr (memq 'FLAGS elems)))
articles))
- (push (nconc (list group uidnext totalp permanent-flags) articles)
+ (push (nconc (list group uidnext totalp permanent-flags uidvalidity
+ vanished highestmodseq)
+ articles)
groups)
+ (goto-char end)
(setq articles nil))))
groups))
(setq nnimap-status-string "Read-only server")
nil)
+(deffoo nnimap-request-thread (id)
+ (let* ((refs (split-string
+ (or (mail-header-references (gnus-summary-article-header))
+ "")))
+ (cmd (let ((value
+ (format
+ "(OR HEADER REFERENCES %s HEADER Message-Id %s)"
+ id id)))
+ (dolist (refid refs value)
+ (setq value (format
+ "(OR (OR HEADER Message-Id %s HEADER REFERENCES %s) %s)"
+ refid refid value)))))
+ (result
+ (with-current-buffer (nnimap-buffer)
+ (nnimap-command "UID SEARCH %s" cmd))))
+ (gnus-fetch-headers (and (car result)
+ (delete 0 (mapcar #'string-to-number
+ (cdr (assoc "SEARCH" (cdr result)))))))))
+
(defun nnimap-possibly-change-group (group server)
(let ((open-result t))
(when (and server
(goto-char (point-min))
(while (and (memq (process-status process)
'(open run))
- (not (re-search-forward "^\\* .*\n" nil t)))
+ (not (re-search-forward "^[*.] .*\n" nil t)))
(nnheader-accept-process-output process)
(goto-char (point-min)))
(forward-line -1)
- (and (looking-at "\\* \\([A-Z0-9]+\\)")
+ (and (looking-at "[*.] \\([A-Z0-9]+\\)")
(match-string 1))))
(defun nnimap-wait-for-response (sequence &optional messagep)
(let ((process (get-buffer-process (current-buffer)))
openp)
- (goto-char (point-max))
- (while (and (setq openp (memq (process-status process)
- '(open run)))
- (not (re-search-backward
- (format "^%d .*\n" sequence)
- (if nnimap-streaming
- (max (point-min) (- (point) 500))
- (point-min))
- t)))
- (when messagep
- (message "Read %dKB" (/ (buffer-size) 1000)))
- (nnheader-accept-process-output process)
- (goto-char (point-max)))
- openp))
+ (condition-case nil
+ (progn
+ (goto-char (point-max))
+ (while (and (setq openp (memq (process-status process)
+ '(open run)))
+ (not (re-search-backward
+ (format "^%d .*\n" sequence)
+ (if nnimap-streaming
+ (max (point-min) (- (point) 500))
+ (point-min))
+ t)))
+ (when messagep
+ (nnheader-message 7 "nnimap read %dk" (/ (buffer-size) 1000)))
+ (nnheader-accept-process-output process)
+ (goto-char (point-max)))
+ openp)
+ (quit
+ ;; The user hit C-g while we were waiting: kill the process, in case
+ ;; it's a gnutls-cli process that's stuck (tends to happen a lot behind
+ ;; NAT routers).
+ (delete-process process)
+ nil))))
(defun nnimap-parse-response ()
(let ((lines (split-string (nnimap-last-response-string) "\r\n" t))
(defun nnimap-parse-line (line)
(let (char result)
(with-temp-buffer
+ (mm-disable-multibyte)
(insert line)
(goto-char (point-min))
(while (not (eobp))
(push
(cond
((eql char ?\[)
- (split-string (buffer-substring
- (1+ (point))
- (1- (search-forward "]" (line-end-position) 'move)))))
+ (split-string
+ (buffer-substring
+ (1+ (point))
+ (1- (search-forward "]" (line-end-position) 'move)))))
((eql char ?\()
- (split-string (buffer-substring
- (1+ (point))
- (1- (search-forward ")" (line-end-position) 'move)))))
+ (split-string
+ (buffer-substring
+ (1+ (point))
+ (1- (search-forward ")" (line-end-position) 'move)))))
((eql char ?\")
(forward-char 1)
(buffer-substring
(defun nnimap-split-incoming-mail ()
(with-current-buffer (nnimap-buffer)
(let ((nnimap-incoming-split-list nil)
- (nnmail-split-methods nnimap-split-methods)
+ (nnmail-split-methods (if (eq nnimap-split-methods 'default)
+ nnmail-split-methods
+ nnimap-split-methods))
+ (nnmail-split-fancy (or nnimap-split-fancy
+ nnmail-split-fancy))
(nnmail-inhibit-default-split-group t)
(groups (nnimap-get-groups))
new-articles)
(defun nnimap-mark-and-expunge-incoming (range)
(when range
(setq range (nnimap-article-ranges range))
+ (erase-buffer)
(let ((sequence
(nnimap-send-command
"UID STORE %s +FLAGS.SILENT (\\Deleted)" range)))
(forward-char (1+ bytes))
(setq bytes (nnimap-get-length))
(delete-region (line-beginning-position) (line-end-position))
- (forward-char (1+ bytes))
- (delete-region (line-beginning-position) (line-end-position))))))
+ ;; There's a body; skip past that.
+ (when bytes
+ (forward-char (1+ bytes))
+ (delete-region (line-beginning-position) (line-end-position)))))))
(defun nnimap-dummy-active-number (group &optional server)
1)