"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)
(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
(gnus-set-process-query-on-exit-flag (nnimap-process nnimap-object) nil)
(when (setq connection-result (nnimap-wait-for-connection))
(when (eq nnimap-stream 'starttls)
- (nnimap-send-command "STARTTLS")
+ (nnimap-command "STARTTLS")
(starttls-negotiate (nnimap-process nnimap-object)))
(unless (equal connection-result "PREAUTH")
(if (not (setq credentials
(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
(erase-buffer)
(with-current-buffer (nnimap-buffer)
(erase-buffer)
- (when nnimap-fetch-partial-articles
- (if (eq nnimap-fetch-partial-articles t)
+ (when gnus-fetch-partial-articles
+ (if (eq gnus-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))))))))
+ (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 (looking-at "\\* [0-9]+ FETCH")
+ (setq result nil))
+ (when result
+ (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)))
+ 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 (car (last structure 4)))
+ (boundary (cadr (member "BOUNDARY" (car (last structure 3))))))
+ (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 "")))
(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 (string-match gnus-fetch-partial-articles type)
+ (push id parts))))
+ (incf num)))
(nreverse parts)))
(deffoo nnimap-request-group (group &optional server dont-check info)
(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)
(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)
(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))
+ (while (and (setq openp (memq (process-status process)
+ '(open run)))
(not (re-search-backward (format "^%d .*\n" sequence)
(max (point-min) (- (point) 500))
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))
(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