(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'.")
(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")))
+ (let ((tls-program (nnimap-extend-tls-programs)))
+ (open-tls-stream
+ "*nnimap*" (current-buffer) nnimap-address
+ (setq port (or nnimap-server-port "imap"))
+ 'starttls))
'("imap"))
- ((eq nnimap-stream 'ssl)
+ ((memq nnimap-stream '(ssl tls))
(open-tls-stream
"*nnimap*" (current-buffer) nnimap-address
(setq port
#'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)))
(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-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-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))))
+ 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 (point))
+ (read (current-buffer))))
parts (nnimap-find-wanted-parts structure))))
(when (if parts
(nnimap-get-partial-article article parts structure)
(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
(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 (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)
(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))))))
+
(deffoo nnimap-retrieve-group-data-early (server infos)
(when (nnimap-possibly-change-group nil server)
(with-current-buffer (nnimap-buffer)
(nnimap-update-info info (cdr (assoc group flags))))))
(defun nnimap-update-info (info marks)
- (when marks
+ (when (and marks
+ ;; Ignore groups with no UIDNEXT values.
+ (nth 4 marks))
(destructuring-bind (existing flags high low uidnext start-article
permanent-flags) marks
(let ((group (gnus-info-group info))
(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)
(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)))
projects / gnus / blobdiff