X-Git-Url: https://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fnnimap.el;h=618db2bb5bce8d7a09f2809721d8b6251acdc4b0;hp=086cabb12019e9aed056b124a361bca0fa35ea0f;hb=b95775bc81748368cb104852b8b9331b0191735c;hpb=1358cd7a569f291e138a765f2b75c0e16e727838 diff --git a/lisp/nnimap.el b/lisp/nnimap.el index 086cabb12..618db2bb5 100644 --- a/lisp/nnimap.el +++ b/lisp/nnimap.el @@ -37,8 +37,12 @@ (require 'gnus) (require 'nnoo) (require 'netrc) +(require 'utf7) (require 'parse-time) +(autoload 'auth-source-forget-user-or-password "auth-source") +(autoload 'auth-source-user-or-password "auth-source") + (nnoo-declare nnimap) (defvoo nnimap-address nil @@ -51,7 +55,7 @@ it will default to `imap'.") (defvoo nnimap-stream 'ssl "How nnimap will talk to the IMAP server. -Values are `ssl' and `network'.") +Values are `ssl', `network', `starttls' or `shell'.") (defvoo nnimap-shell-program (if (boundp 'imap-shell-program) (if (listp imap-shell-program) @@ -62,27 +66,35 @@ Values are `ssl' and `network'.") (defvoo nnimap-inbox nil "The mail box where incoming mail arrives and should be split out of.") +(defvoo nnimap-split-methods nil + "How mail is split. +Uses the same syntax as nnmail-split-methods") + (defvoo nnimap-authenticator nil "How nnimap authenticate itself to the server. Possible choices are nil (use default methods) or `anonymous'.") -(defvoo nnimap-fetch-partial-articles nil - "If non-nil, nnimap will fetch partial articles. -If t, nnimap will fetch only the first part. If a string, it -will fetch all parts that have types that match that string. A -likely value would be \"text/\" to automatically fetch all -textual parts.") - (defvoo nnimap-expunge t "If non-nil, expunge articles after deleting them. This is always done if the server supports UID EXPUNGE, but it's not done by default on servers that doesn't support that command.") +(defvoo nnimap-streaming t + "If non-nil, try to use streaming commands with IMAP servers. +Switching this off will make nnimap slower, but it helps with +some servers.") (defvoo nnimap-connection-alist nil) (defvoo nnimap-current-infos nil) +(defvoo nnimap-fetch-partial-articles nil + "If non-nil, Gnus will fetch partial articles. +If t, nnimap will fetch only the first part. If a string, it +will fetch all parts that have types that match that string. A +likely value would be \"text/\" to automatically fetch all +textual parts.") + (defvar nnimap-process nil) (defvar nnimap-status-string "") @@ -90,8 +102,12 @@ not done by default on servers that doesn't support that command.") (defvar nnimap-split-download-body-default nil "Internal variable with default value for `nnimap-split-download-body'.") +(defvar nnimap-keepalive-timer nil) +(defvar nnimap-process-buffers nil) + (defstruct nnimap - group process commands capabilities select-result newlinep) + group process commands capabilities select-result newlinep server + last-command-time greeting) (defvar nnimap-object nil) @@ -106,8 +122,6 @@ not done by default on servers that doesn't support that command.") (download "gnus-download") (forward "gnus-forward"))) -(defvar nnimap-split-methods nil) - (defun nnimap-buffer () (nnimap-find-process-buffer nntp-server-buffer)) @@ -116,7 +130,6 @@ not done by default on servers that doesn't support that command.") (erase-buffer) (when (nnimap-possibly-change-group group server) (with-current-buffer (nnimap-buffer) - (nnimap-send-command "SELECT %S" (utf7-encode group t)) (erase-buffer) (nnimap-wait-for-response (nnimap-send-command @@ -124,8 +137,7 @@ not done by default on servers that doesn't support that command.") (nnimap-article-ranges (gnus-compress-sequence articles)) (format "(UID RFC822.SIZE BODYSTRUCTURE %s)" (format - (if (member "IMAP4REV1" - (nnimap-capabilities nnimap-object)) + (if (nnimap-ver4-p) "BODY.PEEK[HEADER.FIELDS %s]" "RFC822.HEADER.LINES %s") (append '(Subject From Date Message-Id @@ -135,19 +147,26 @@ not done by default on servers that doesn't support that command.") (nnimap-transform-headers)) (insert-buffer-substring (nnimap-find-process-buffer (current-buffer)))) - t)) + 'headers)) (defun nnimap-transform-headers () (goto-char (point-min)) - (let (article bytes lines size) + (let (article bytes lines size string) (block nil (while (not (eobp)) (while (not (looking-at "^\\* [0-9]+ FETCH.*UID \\([0-9]+\\)")) (delete-region (point) (progn (forward-line 1) (point))) (when (eobp) (return))) - (setq article (match-string 1) - bytes (nnimap-get-length) + (setq article (match-string 1)) + ;; Unfold quoted {number} strings. + (while (re-search-forward "[^]] {\\([0-9]+\\)}\r\n" + (1+ (line-end-position)) t) + (setq size (string-to-number (match-string 1))) + (delete-region (+ (match-beginning 0) 2) (point)) + (setq string (delete-region (point) (+ (point) size))) + (insert (format "%S" string))) + (setq bytes (nnimap-get-length) lines nil) (beginning-of-line) (setq size @@ -157,7 +176,8 @@ not done by default on servers that doesn't support that command.") (match-string 1))) (beginning-of-line) (when (search-forward "BODYSTRUCTURE" (line-end-position) t) - (let ((structure (ignore-errors (read (current-buffer))))) + (let ((structure (ignore-errors + (read (current-buffer))))) (while (and (consp structure) (not (stringp (car structure)))) (setq structure (car structure))) @@ -212,8 +232,10 @@ not done by default on servers that doesn't support that command.") (buffer-disable-undo) (gnus-add-buffer) (set (make-local-variable 'after-change-functions) nil) - (set (make-local-variable 'nnimap-object) (make-nnimap)) + (set (make-local-variable 'nnimap-object) + (make-nnimap :server (nnoo-current-server 'nnimap))) (push (list buffer (current-buffer)) nnimap-connection-alist) + (push (current-buffer) nnimap-process-buffers) (current-buffer))) (defun nnimap-open-shell-stream (name buffer host port) @@ -226,7 +248,7 @@ not done by default on servers that doesn't support that command.") ?s host ?p port))))) -(defun nnimap-credentials (address ports) +(defun nnimap-credentials (address ports &optional inhibit-create) (let (port credentials) ;; Request the credentials from all ports, but only query on the ;; last port if all the previous ones have failed. @@ -234,71 +256,126 @@ not done by default on servers that doesn't support that command.") (setq port (pop ports))) (setq credentials (auth-source-user-or-password - '("login" "password") address port nil (null ports)))) + '("login" "password") address port nil + (if inhibit-create + nil + (null ports))))) credentials)) +(defun nnimap-keepalive () + (let ((now (current-time))) + (dolist (buffer nnimap-process-buffers) + (when (buffer-name buffer) + (with-current-buffer buffer + (when (and nnimap-object + (nnimap-last-command-time nnimap-object) + (> (time-to-seconds + (time-subtract + now + (nnimap-last-command-time nnimap-object))) + ;; More than five minutes since the last command. + (* 5 60))) + (nnimap-send-command "NOOP"))))))) + (defun nnimap-open-connection (buffer) - (with-current-buffer (nnimap-make-process-buffer buffer) - (let* ((coding-system-for-read 'binary) - (coding-system-for-write 'binary) - (ports - (cond - ((eq nnimap-stream 'network) - (open-network-stream - "*nnimap*" (current-buffer) nnimap-address - (or nnimap-server-port - (if (netrc-find-service-number "imap") - "imap" - "143"))) - '("143" "imap")) - ((eq nnimap-stream 'shell) - (nnimap-open-shell-stream - "*nnimap*" (current-buffer) nnimap-address - (or nnimap-server-port "imap")) - '("imap")) - ((eq nnimap-stream 'ssl) - (open-tls-stream - "*nnimap*" (current-buffer) nnimap-address - (or nnimap-server-port - (if (netrc-find-service-number "imaps") - "imaps" - "993"))) - '("143" "993" "imap" "imaps")))) - connection-result login-result credentials) - (setf (nnimap-process nnimap-object) - (get-buffer-process (current-buffer))) - (when (and (nnimap-process nnimap-object) - (memq (process-status (nnimap-process nnimap-object)) - '(open run))) - (gnus-set-process-query-on-exit-flag (nnimap-process nnimap-object) nil) - (when (setq connection-result (nnimap-wait-for-connection)) - (unless (equal connection-result "PREAUTH") - (if (not (setq credentials - (if (eq nnimap-authenticator 'anonymous) - (list "anonymous" - (message-make-address)) - (nnimap-credentials - nnimap-address - (if nnimap-server-port - (cons (format "%s" nnimap-server-port) ports) - ports))))) - (setq nnimap-object nil) - (setq login-result (nnimap-command "LOGIN %S %S" - (car credentials) - (cadr credentials))) - (unless (car login-result) - (delete-process (nnimap-process nnimap-object)) - (setq nnimap-object nil)))) - (when nnimap-object + (unless nnimap-keepalive-timer + (setq nnimap-keepalive-timer (run-at-time (* 60 15) (* 60 15) + 'nnimap-keepalive))) + (block nil + (with-current-buffer (nnimap-make-process-buffer buffer) + (let* ((coding-system-for-read 'binary) + (coding-system-for-write 'binary) + (port nil) + (ports + (cond + ((eq nnimap-stream 'network) + (open-network-stream + "*nnimap*" (current-buffer) nnimap-address + (setq port + (or nnimap-server-port + (if (netrc-find-service-number "imap") + "imap" + "143")))) + '("143" "imap")) + ((eq nnimap-stream 'shell) + (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"))) + '("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")))) + connection-result login-result credentials) + (setf (nnimap-process nnimap-object) + (get-buffer-process (current-buffer))) + (if (not (and (nnimap-process nnimap-object) + (memq (process-status (nnimap-process nnimap-object)) + '(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) + (if (not (setq connection-result (nnimap-wait-for-connection))) + (nnheader-report 'nnimap + "%s" (buffer-substring + (point) (line-end-position))) + ;; Store the greeting (for debugging purposes). + (setf (nnimap-greeting nnimap-object) + (buffer-substring (line-beginning-position) + (line-end-position))) + ;; Store the capabilities. (setf (nnimap-capabilities nnimap-object) (mapcar #'upcase - (or (nnimap-find-parameter "CAPABILITY" (cdr login-result)) - (nnimap-find-parameter - "CAPABILITY" (cdr (nnimap-command "CAPABILITY")))))) - (when (member "QRESYNC" (nnimap-capabilities nnimap-object)) - (nnimap-command "ENABLE QRESYNC")) - t)))))) + (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)) + (unless (equal connection-result "PREAUTH") + (if (not (setq credentials + (if (eq nnimap-authenticator 'anonymous) + (list "anonymous" + (message-make-address)) + (or + ;; First look for the credentials based + ;; on the virtual server name. + (nnimap-credentials + (nnoo-current-server 'nnimap) ports t) + ;; Then look them up based on the + ;; physical address. + (nnimap-credentials nnimap-address ports))))) + (setq nnimap-object nil) + (setq login-result (nnimap-command "LOGIN %S %S" + (car credentials) + (cadr credentials))) + (unless (car login-result) + ;; If the login failed, then forget the credentials + ;; that are now possibly cached. + (dolist (host (list (nnoo-current-server 'nnimap) + nnimap-address)) + (dolist (port ports) + (dolist (element '("login" "password")) + (auth-source-forget-user-or-password + element host port)))) + (delete-process (nnimap-process nnimap-object)) + (setq nnimap-object nil)))) + (when nnimap-object + (when (member "QRESYNC" (nnimap-capabilities nnimap-object)) + (nnimap-command "ENABLE QRESYNC")) + t))))))) (defun nnimap-find-parameter (parameter elems) (let (result) @@ -330,7 +407,7 @@ not done by default on servers that doesn't support that command.") (deffoo nnimap-request-article (article &optional group server to-buffer) (with-current-buffer nntp-server-buffer (let ((result (nnimap-possibly-change-group group server)) - parts) + parts structure) (when (stringp article) (setq article (nnimap-find-article-by-message-id group article))) (when (and result @@ -339,35 +416,120 @@ not done by default on servers that doesn't support that command.") (with-current-buffer (nnimap-buffer) (erase-buffer) (when nnimap-fetch-partial-articles - (if (eq nnimap-fetch-partial-articles t) - (setq parts '(1)) - (nnimap-command "UID FETCH %d (BODYSTRUCTURE)" article) - (goto-char (point-min)) - (when (re-search-forward "FETCH.*BODYSTRUCTURE" nil t) - (let ((structure (ignore-errors (read (current-buffer))))) - (setq parts (nnimap-find-wanted-parts structure)))))) - (setq result - (nnimap-command - (if (member "IMAP4REV1" (nnimap-capabilities nnimap-object)) - "UID FETCH %d BODY.PEEK[]" - "UID FETCH %d RFC822.PEEK") - article)) - ;; Check that we really got an article. - (goto-char (point-min)) - (unless (looking-at "\\* [0-9]+ FETCH") - (setq result nil))) - (let ((buffer (nnimap-find-process-buffer (current-buffer)))) - (when (car result) - (with-current-buffer (or to-buffer nntp-server-buffer) - (insert-buffer-substring buffer) - (goto-char (point-min)) - (let ((bytes (nnimap-get-length))) - (delete-region (line-beginning-position) - (progn (forward-line 1) (point))) - (goto-char (+ (point) bytes)) - (delete-region (point) (point-max)) - (nnheader-ms-strip-cr)) - (cons group article)))))))) + (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))) + parts (nnimap-find-wanted-parts structure)))) + (when (if parts + (nnimap-get-partial-article article parts structure) + (nnimap-get-whole-article article)) + (let ((buffer (current-buffer))) + (with-current-buffer (or to-buffer nntp-server-buffer) + (erase-buffer) + (insert-buffer-substring buffer) + (nnheader-ms-strip-cr) + (cons group article))))))))) + +(defun nnimap-get-whole-article (article) + (let ((result + (nnimap-command + (if (nnimap-ver4-p) + "UID FETCH %d BODY.PEEK[]" + "UID FETCH %d RFC822.PEEK") + article))) + ;; Check that we really got an article. + (goto-char (point-min)) + (unless (re-search-forward "\\* [0-9]+ FETCH" nil t) + (setq result nil)) + (when result + ;; Remove any data that may have arrived before the FETCH data. + (beginning-of-line) + (unless (bobp) + (delete-region (point-min) (point))) + (let ((bytes (nnimap-get-length))) + (delete-region (line-beginning-position) + (progn (forward-line 1) (point))) + (goto-char (+ (point) bytes)) + (delete-region (point) (point-max))) + t))) + +(defun nnimap-ver4-p () + (member "IMAP4REV1" (nnimap-capabilities nnimap-object))) + +(defun nnimap-get-partial-article (article parts structure) + (let ((result + (nnimap-command + "UID FETCH %d (%s %s)" + article + (if (nnimap-ver4-p) + "BODY.PEEK[HEADER]" + "RFC822.HEADER") + (if (nnimap-ver4-p) + (mapconcat (lambda (part) + (format "BODY.PEEK[%s]" part)) + parts " ") + (mapconcat (lambda (part) + (format "RFC822.PEEK[%s]" part)) + parts " "))))) + (when result + (nnimap-convert-partial-article structure)))) + +(defun nnimap-convert-partial-article (structure) + ;; First just skip past the headers. + (goto-char (point-min)) + (let ((bytes (nnimap-get-length)) + id parts) + ;; Delete "FETCH" line. + (delete-region (line-beginning-position) + (progn (forward-line 1) (point))) + (goto-char (+ (point) bytes)) + ;; Collect all the body parts. + (while (looking-at ".*BODY\\[\\([.0-9]+\\)\\]") + (setq id (match-string 1) + bytes (nnimap-get-length)) + (beginning-of-line) + (delete-region (point) (progn (forward-line 1) (point))) + (push (list id (buffer-substring (point) (+ (point) bytes))) + parts) + (delete-region (point) (+ (point) bytes))) + ;; Delete trailing junk. + (delete-region (point) (point-max)) + ;; Now insert all the parts again where they fit in the structure. + (nnimap-insert-partial-structure structure parts) + t)) + +(defun nnimap-insert-partial-structure (structure parts &optional subp) + (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))) + (while (not (stringp (car structure))) + (insert "\n--" boundary "\n") + (if (consp (caar structure)) + (nnimap-insert-partial-structure (pop structure) parts t) + (let ((bit (pop structure))) + (insert (format "Content-type: %s/%s" + (downcase (nth 0 bit)) + (downcase (nth 1 bit)))) + (if (member "CHARSET" (nth 2 bit)) + (insert (format + "; charset=%S\n" (cadr (member "CHARSET" (nth 2 bit))))) + (insert "\n")) + (insert (format "Content-transfer-encoding: %s\n" + (nth 5 bit))) + (insert "\n") + (when (assoc (nth 9 bit) parts) + (insert (cadr (assoc (nth 9 bit) parts))))))) + (insert "\n--" boundary "--\n"))) (defun nnimap-find-wanted-parts (structure) (message-flatten-list (nnimap-find-wanted-parts-1 structure ""))) @@ -383,13 +545,16 @@ not done by default on servers that doesn't support that command.") (number-to-string num) (format "%s.%s" prefix num))) parts) - (let ((type (format "%s/%s" (nth 0 sub) (nth 1 sub)))) - (when (string-match nnimap-fetch-partial-articles type) - (push (if (string= prefix "") + (let ((type (format "%s/%s" (nth 0 sub) (nth 1 sub))) + (id (if (string= prefix "") (number-to-string num) - (format "%s.%s" prefix num)) - parts))) - (incf num)))) + (format "%s.%s" prefix num)))) + (setcar (nthcdr 9 sub) id) + (when (if (eq nnimap-fetch-partial-articles t) + (equal id "1") + (string-match nnimap-fetch-partial-articles type)) + (push id parts)))) + (incf num))) (nreverse parts))) (deffoo nnimap-request-group (group &optional server dont-check info) @@ -418,13 +583,11 @@ not done by default on servers that doesn't support that command.") (when info (nnimap-update-infos marks (list info))) (goto-char (point-max)) - (cond - (marks - (setq high (nth 3 (car marks)) - low (nth 4 (car marks)))) - ((re-search-backward "UIDNEXT \\([0-9]+\\)" nil t) - (setq high (1- (string-to-number (match-string 1))) - low 1))))) + (let ((uidnext (nth 5 (car marks)))) + (setq high (if uidnext + (1- uidnext) + (nth 3 (car marks))) + low (or (nth 4 (car marks)) uidnext))))) (erase-buffer) (insert (format @@ -496,12 +659,13 @@ not done by default on servers that doesn't support that command.") articles) ((and force (eq nnmail-expiry-target 'delete)) - (unless (nnimap-delete-article articles) + (unless (nnimap-delete-article (gnus-compress-sequence articles)) (message "Article marked for deletion, but not expunged.")) nil) (t (let ((deletable-articles - (if force + (if (or force + (eq nnmail-expiry-wait 'immediate)) articles (gnus-sorted-intersection articles @@ -509,7 +673,7 @@ not done by default on servers that doesn't support that command.") (if (null deletable-articles) articles (if (eq nnmail-expiry-target 'delete) - (nnimap-delete-article deletable-articles) + (nnimap-delete-article (gnus-compress-sequence deletable-articles)) (setq deletable-articles (nnimap-process-expiry-targets deletable-articles group server))) @@ -536,7 +700,7 @@ not done by default on servers that doesn't support that command.") ;; Change back to the current group again. (nnimap-possibly-change-group group server) (setq deleted-articles (nreverse deleted-articles)) - (nnimap-delete-article deleted-articles) + (nnimap-delete-article (gnus-compress-sequence deleted-articles)) deleted-articles)) (defun nnimap-find-expired-articles (group) @@ -586,7 +750,6 @@ not done by default on servers that doesn't support that command.") (deffoo nnimap-request-scan (&optional group server) (when (and (nnimap-possibly-change-group nil server) - (equal group nnimap-inbox) nnimap-inbox nnimap-split-methods) (message "nnimap %s splitting mail..." server) @@ -624,6 +787,7 @@ not done by default on servers that doesn't support that command.") (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) @@ -637,7 +801,10 @@ not done by default on servers that doesn't support that command.") "\n" "\r\n")) (let ((result (nnimap-get-response sequence))) - (when result + (if (not (car result)) + (progn + (message "%s" (nnheader-get-report-string 'nnimap)) + nil) (cons group (nnimap-find-article-by-message-id group message-id)))))))) @@ -739,7 +906,12 @@ not done by default on servers that doesn't support that command.") (nnimap-send-command "UID FETCH %d:* FLAGS" start) start (car elem)) - sequences)))) + sequences))) + ;; Some servers apparently can't have many outstanding + ;; commands, so throttle them. + (when (and (not nnimap-streaming) + (car sequences)) + (nnimap-wait-for-response (caar sequences)))) sequences)))) (deffoo nnimap-finish-retrieve-group-infos (server infos sequences) @@ -747,26 +919,26 @@ not done by default on servers that doesn't support that command.") (nnimap-possibly-change-group nil server)) (with-current-buffer (nnimap-buffer) ;; Wait for the final data to trickle in. - (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. - (nnimap-update-infos (nnimap-flags-to-marks - (nnimap-parse-flags - (nreverse sequences))) - infos) - ;; Finally, just return something resembling an active file in - ;; the nntp buffer, so that the agent can save the info, too. - (with-current-buffer nntp-server-buffer - (erase-buffer) - (dolist (info infos) - (let* ((group (gnus-info-group info)) - (active (gnus-active group))) - (when active - (insert (format "%S %d %d y\n" - (gnus-group-real-name group) - (cdr active) - (car active)))))))))) + (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. + (nnimap-update-infos (nnimap-flags-to-marks + (nnimap-parse-flags + (nreverse sequences))) + infos) + ;; Finally, just return something resembling an active file in + ;; the nntp buffer, so that the agent can save the info, too. + (with-current-buffer nntp-server-buffer + (erase-buffer) + (dolist (info infos) + (let* ((group (gnus-info-group info)) + (active (gnus-active group))) + (when active + (insert (format "%S %d %d y\n" + (gnus-group-real-name group) + (cdr active) + (car active))))))))))) (defun nnimap-update-infos (flags infos) (dolist (info infos) @@ -775,19 +947,35 @@ not done by default on servers that doesn't support that command.") (defun nnimap-update-info (info marks) (when marks - (destructuring-bind (existing flags high low uidnext start-article) 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)))) + (when uidnext + (setq high (1- uidnext))) ;; First set the active ranges based on high/low. (if (or completep (not (gnus-active group))) (gnus-set-active group - (if high - (cons low high) + (cond + ((and low high) + (cons low high)) + (uidnext ;; No articles in this group. - (cons (1- uidnext) uidnext))) - (setcdr (gnus-active group) high)) + (cons uidnext (1- uidnext))) + (start-article + (cons start-article (1- start-article))) + (t + ;; No articles and no uidnext. + nil))) + (gnus-set-active + group + (cons (car (gnus-active group)) + (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 @@ -820,6 +1008,7 @@ not done by default on servers that doesn't support that command.") (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) @@ -842,7 +1031,7 @@ not done by default on servers that doesn't support that command.") (push (list group info active) nnimap-current-infos)))) (defun nnimap-flags-to-marks (groups) - (let (data group totalp uidnext articles start-article mark) + (let (data group totalp uidnext articles start-article mark permanent-flags) (dolist (elem groups) (setq group (car elem) uidnext (nth 1 elem) @@ -858,9 +1047,10 @@ not done by default on servers that doesn't support that command.") (setq mark (assoc flag marks)) (if (not mark) (push (list flag (car article)) marks) - (setcdr mark (cons (car article) (cdr mark))))) - (push (list group existing marks high low uidnext start-article) - data)))) + (setcdr mark (cons (car article) (cdr mark)))))) + (push (list group existing marks high low uidnext start-article + permanent-flags) + data))) data)) (defun nnimap-parse-flags (sequences) @@ -878,15 +1068,17 @@ not done by default on servers that doesn't support that command.") (forward-line 1) (setq end (point)) (goto-char start) - (setq permanent-forward + (setq permanent-flags (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)) + (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)) @@ -962,6 +1154,7 @@ not done by default on servers that doesn't support that command.") (defun nnimap-command (&rest args) (erase-buffer) + (setf (nnimap-last-command-time nnimap-object) (current-time)) (let* ((sequence (apply #'nnimap-send-command args)) (response (nnimap-get-response sequence))) (if (equal (caar response) "OK") @@ -989,17 +1182,22 @@ not done by default on servers that doesn't support that command.") (match-string 1)))) (defun nnimap-wait-for-response (sequence &optional messagep) - (let ((process (get-buffer-process (current-buffer)))) + (let ((process (get-buffer-process (current-buffer))) + openp) (goto-char (point-max)) - (while (and (memq (process-status process) - '(open run)) - (not (re-search-backward (format "^%d .*\n" sequence) - (max (point-min) (- (point) 500)) - t))) + (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))))) + (goto-char (point-max))) + openp)) (defun nnimap-parse-response () (let ((lines (split-string (nnimap-last-response-string) "\r\n" t)) @@ -1026,13 +1224,18 @@ not done by default on servers that doesn't support that command.") (cond ((eql char ?\[) (split-string (buffer-substring - (1+ (point)) (1- (search-forward "]"))))) + (1+ (point)) + (1- (search-forward "]" (line-end-position) 'move))))) ((eql char ?\() (split-string (buffer-substring - (1+ (point)) (1- (search-forward ")"))))) + (1+ (point)) + (1- (search-forward ")" (line-end-position) 'move))))) ((eql char ?\") (forward-char 1) - (buffer-substring (point) (1- (search-forward "\"")))) + (buffer-substring + (point) + (1- (or (search-forward "\"" (line-end-position) 'move) + (point))))) (t (buffer-substring (point) (if (search-forward " " nil t) (1- (point)) @@ -1073,8 +1276,7 @@ not done by default on servers that doesn't support that command.") (nnimap-article-ranges articles) (format "(UID %s%s)" (format - (if (member "IMAP4REV1" - (nnimap-capabilities nnimap-object)) + (if (nnimap-ver4-p) "BODY.PEEK[HEADER] BODY.PEEK" "RFC822.PEEK")) (if nnimap-split-download-body-default @@ -1130,8 +1332,8 @@ not done by default on servers that doesn't support that command.") ;; And then mark the successful copy actions as deleted, ;; and possibly expunge them. (nnimap-mark-and-expunge-incoming - (nnimap-parse-copied-articles sequences)) - (nnimap-mark-and-expunge-incoming junk-articles)))))))) + (nnimap-parse-copied-articles sequences))) + (nnimap-mark-and-expunge-incoming junk-articles))))))) (defun nnimap-mark-and-expunge-incoming (range) (when range