(defvoo nnimap-split-fancy nil
"Uses the same syntax as nnmail-split-fancy.")
+(defvoo nnimap-unsplittable-articles '(%Deleted %Seen)
+ "Articles with the flags in the list will not be considered when splitting.")
+
(make-obsolete-variable 'nnimap-split-rule "see `nnimap-split-methods'"
"Emacs 24.1")
(defun nnimap-buffer ()
(nnimap-find-process-buffer nntp-server-buffer))
+(defun nnimap-header-parameters ()
+ (format "(UID RFC822.SIZE BODYSTRUCTURE %s)"
+ (format
+ (if (nnimap-ver4-p)
+ "BODY.PEEK[HEADER.FIELDS %s]"
+ "RFC822.HEADER.LINES %s")
+ (append '(Subject From Date Message-Id
+ References In-Reply-To Xref)
+ nnmail-extra-headers))))
+
(deffoo nnimap-retrieve-headers (articles &optional group server fetch-old)
(with-current-buffer nntp-server-buffer
(erase-buffer)
(nnimap-send-command
"UID FETCH %s %s"
(nnimap-article-ranges (gnus-compress-sequence articles))
- (format "(UID RFC822.SIZE BODYSTRUCTURE %s)"
- (format
- (if (nnimap-ver4-p)
- "BODY.PEEK[HEADER.FIELDS %s]"
- "RFC822.HEADER.LINES %s")
- (append '(Subject From Date Message-Id
- References In-Reply-To Xref)
- nnmail-extra-headers))))
+ (nnimap-header-parameters))
t)
(nnimap-transform-headers))
(insert-buffer-substring
(return)))
(setq article (match-string 1))
;; Unfold quoted {number} strings.
- (while (re-search-forward "[^]] {\\([0-9]+\\)}\r\n"
+ (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))
(insert (format "Chars: %s\n" size)))
(when lines
(insert (format "Lines: %s\n" lines)))
- (re-search-forward "^\r$")
+ (unless (re-search-forward "^\r$" nil t)
+ (goto-char (point-max)))
(delete-region (line-beginning-position) (line-end-position))
(insert ".")
(forward-line 1)))))
((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)
- (let ((tls-program (nnimap-extend-tls-programs)))
+ (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"))
- 'starttls))
+ (setq port (or nnimap-server-port "imap"))))
'("imap"))
((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)
;; physical address.
(nnimap-credentials nnimap-address ports)))))
(setq nnimap-object nil)
- (setq login-result (nnimap-command "LOGIN %S %S"
- (car credentials)
- (cadr credentials)))
+ (setq login-result
+ (if (member "AUTH=PLAIN"
+ (nnimap-capabilities nnimap-object))
+ (nnimap-command
+ "AUTHENTICATE PLAIN %s"
+ (base64-encode-string
+ (format "\000%s\000%s"
+ (nnimap-quote-specials (car credentials))
+ (nnimap-quote-specials (cadr credentials)))))
+ (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.
(nnimap-command "ENABLE QRESYNC"))
(nnimap-process nnimap-object))))))))
-(defun nnimap-extend-tls-programs ()
- (let ((programs tls-program)
- result)
- (unless (consp programs)
- (setq programs (list programs)))
- (dolist (program programs)
- (when (assoc (car (split-string program)) tls-starttls-switches)
- (push (if (not (string-match "%s" program))
- (concat program " " "%s")
- program)
- result)))
- (nreverse result)))
+(defun nnimap-quote-specials (string)
+ (with-temp-buffer
+ (insert string)
+ (goto-char (point-min))
+ (while (re-search-forward "[\\\"]" nil t)
+ (forward-char -1)
+ (insert "\\")
+ (forward-char 1))
+ (buffer-string)))
(defun nnimap-find-parameter (parameter elems)
(let (result)
(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 ()
(let ((start (point)))
(forward-sexp 1)
(downcase-region start (point))
- (goto-char (point))
+ (goto-char start)
(read (current-buffer))))
parts (nnimap-find-wanted-parts structure))))
(when (if parts
(nnheader-ms-strip-cr)
(cons group article)))))))))
-(defun nnimap-get-whole-article (article)
+(deffoo nnimap-request-head (article &optional group server to-buffer)
+ (when (nnimap-possibly-change-group group server)
+ (with-current-buffer (nnimap-buffer)
+ (when (stringp article)
+ (setq article (nnimap-find-article-by-message-id group article)))
+ (nnimap-get-whole-article
+ article (format "UID FETCH %%d %s"
+ (nnimap-header-parameters)))
+ (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 &optional command)
(let ((result
(nnimap-command
- (if (nnimap-ver4-p)
- "UID FETCH %d BODY.PEEK[]"
- "UID FETCH %d RFC822.PEEK")
+ (or 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))
(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))))
+ (let ((has-boundary (member "boundary" bstruc)))
+ (when has-boundary
+ (setq boundary (cadr has-boundary)))))
(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
(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.
- (nnimap-command "EXAMINE %S" (utf7-encode group 7))
+ ;; 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-move-article (article group server accept-form
&optional last internal-move-group)
(with-temp-buffer
- (when (nnimap-request-article article group server (current-buffer))
+ (mm-disable-multibyte)
+ (when (funcall (if internal-move-group
+ 'nnimap-request-head
+ 'nnimap-request-article)
+ article group server (current-buffer))
;; If the move is internal (on the same server), just do it the easy
;; way.
(let ((message-id (message-field-value "message-id")))
((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
(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)
(let ((message-id (message-field-value "message-id"))
sequence message)
(nnimap-add-cr)
- (setq message (buffer-string))
+ (setq message (buffer-substring-no-properties (point-min) (point-max)))
(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))))))))
+(deffoo nnimap-request-replace-article (article group buffer)
+ (let (group-art)
+ (when (and (nnimap-possibly-change-group group nil)
+ ;; Put the article into the group.
+ (with-current-buffer buffer
+ (setq group-art
+ (nnimap-request-accept-article group nil t))))
+ (nnimap-delete-article (list article))
+ ;; Return the new article number.
+ (cdr group-art))))
+
(defun nnimap-add-cr ()
(goto-char (point-min))
(while (re-search-forward "\r?\n" nil t)
(with-current-buffer (nnimap-buffer)
(erase-buffer)
(setf (nnimap-group nnimap-object) nil)
- ;; QRESYNC handling isn't implemented.
(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
(utf7-encode group t))
(nnimap-send-command "UID FETCH %d:* FLAGS" start)
start group command)
- 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))))
sequences))))
(deffoo nnimap-finish-retrieve-group-infos (server infos sequences)
(unless (eq permanent-flags 'not-scanned)
(gnus-group-set-parameter
info 'permanent-flags
- (if (memq '%* permanent-flags)
- t
- nil)))
+ (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 (cdr (assq 'permanent-flags (gnus-info-params info)))
+ (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.
(gnus-info-read info))
(gnus-info-read info))
read)))
- (gnus-info-set-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))
- (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)))))
+ (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)
(setq start end))
(setq start (point))
(goto-char end))
- (while (search-forward " FETCH " start t)
+ (while (re-search-forward "^\\* [0-9]+ FETCH " start t)
(setq elems (read (current-buffer)))
(push (cons (cadr (memq 'UID elems))
(cadr (memq 'FLAGS elems)))
(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
(if (nnimap-newlinep nnimap-object)
""
"\r"))))
+ ;; Some servers apparently can't have many outstanding
+ ;; commands, so throttle them.
+ (unless nnimap-streaming
+ (nnimap-wait-for-response nnimap-sequence))
nnimap-sequence)
(defun nnimap-log-command (command)
(point-min))
t)))
(when messagep
- (message "nnimap read %dk" (/ (buffer-size) 1000)))
+ (nnheader-message 7 "nnimap read %dk" (/ (buffer-size) 1000)))
(nnheader-accept-process-output process)
(goto-char (point-max)))
openp)
(defun nnimap-parse-line (line)
(let (char result)
(with-temp-buffer
+ (mm-disable-multibyte)
(insert line)
(goto-char (point-min))
(while (not (eobp))
new-articles)
(erase-buffer)
(nnimap-command "SELECT %S" nnimap-inbox)
+ (setf (nnimap-group nnimap-object) group)
(setq new-articles (nnimap-new-articles (nnimap-get-flags "1:*")))
(when new-articles
(nnimap-fetch-inbox new-articles)
(defun nnimap-new-articles (flags)
(let (new)
(dolist (elem flags)
- (when (or (null (cdr elem))
- (and (not (memq '%Deleted (cdr elem)))
- (not (memq '%Seen (cdr elem)))))
+ (unless (gnus-list-memq-of-list nnimap-unsplittable-articles
+ (cdr elem))
(push (car elem) new)))
(gnus-compress-sequence (nreverse new))))
projects / gnus / blobdiff