;;; nnimap.el --- IMAP interface for Gnus
-;; Copyright (C) 2010 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2011 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Simon Josefsson <simon@josefsson.org>
(defstruct nnimap
group process commands capabilities select-result newlinep server
- last-command-time greeting examined)
+ last-command-time greeting examined stream-type)
(defvar nnimap-object nil)
login-result credentials)
(when nnimap-server-port
(setq ports (append ports (list nnimap-server-port))))
- (destructuring-bind (stream greeting capabilities)
+ (destructuring-bind (stream greeting capabilities stream-type)
(open-protocol-stream
"*nnimap*" (current-buffer) nnimap-address (car (last ports))
:type nnimap-stream
(when (gnus-string-match-p "STARTTLS" capabilities)
"1 STARTTLS\r\n")))
(setf (nnimap-process nnimap-object) stream)
+ (setf (nnimap-stream-type nnimap-object) stream-type)
(if (not stream)
(progn
(nnheader-report 'nnimap "Unable to contact %s:%s via %s"
(nnimap-credentials nnimap-address ports)))))
(setq nnimap-object nil)
(setq login-result
- (if (and (nnimap-capability "AUTH=PLAIN")
- (nnimap-capability "LOGINDISABLED"))
- (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))))
+ (nnimap-login (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))))))))
+(autoload 'rfc2104-hash "rfc2104")
+
+(defun nnimap-login (user password)
+ (cond
+ ;; Prefer plain LOGIN if it's enabled (since it requires fewer
+ ;; round trips than CRAM-MD5, and it's less likely to be buggy),
+ ;; and we're using an encrypted connection.
+ ((and (not (nnimap-capability "LOGINDISABLED"))
+ (eq (nnimap-stream-type nnimap-object) 'tls))
+ (nnimap-command "LOGIN %S %S" user password))
+ ((nnimap-capability "AUTH=CRAM-MD5")
+ (erase-buffer)
+ (let ((sequence (nnimap-send-command "AUTHENTICATE CRAM-MD5"))
+ (challenge (nnimap-wait-for-line "^\\+\\(.*\\)\n")))
+ (process-send-string
+ (get-buffer-process (current-buffer))
+ (concat
+ (base64-encode-string
+ (concat user " "
+ (rfc2104-hash 'md5 64 16 password
+ (base64-decode-string challenge))))
+ "\r\n"))
+ (nnimap-wait-for-response sequence)))
+ ((not (nnimap-capability "LOGINDISABLED"))
+ (nnimap-command "LOGIN %S %S" user password))
+ ((nnimap-capability "AUTH=PLAIN")
+ (nnimap-command
+ "AUTHENTICATE PLAIN %s"
+ (base64-encode-string
+ (format "\000%s\000%s"
+ (nnimap-quote-specials user)
+ (nnimap-quote-specials password)))))))
+
(defun nnimap-quote-specials (string)
(with-temp-buffer
(insert string)
(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))))))
+ (if (null article)
+ nil
+ (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
;; Collect all the body parts.
(while (looking-at ".*BODY\\[\\([.0-9]+\\)\\]")
(setq id (match-string 1)
- bytes (nnimap-get-length))
+ bytes (or (nnimap-get-length) 0))
(beginning-of-line)
(delete-region (point) (progn (forward-line 1) (point)))
(push (list id (buffer-substring (point) (+ (point) bytes)))
(let ((result (nnimap-possibly-change-group
;; Don't SELECT the group if we're going to select it
;; later, anyway.
- (if (and dont-check
+ (if (and (not dont-check)
(assoc group nnimap-current-infos))
nil
group)
"\n"
"\r\n"))
(let ((result (nnimap-get-response sequence)))
- (if (not (car result))
+ (if (not (nnimap-ok-p result))
(progn
- (nnheader-message 7 "%s" (nnheader-get-report-string 'nnimap))
+ (nnheader-report 'nnimap "%s" result)
nil)
(cons group
(or (nnimap-find-uid-response "APPENDUID" (car result))
(nnimap-find-article-by-message-id
group message-id)))))))))
+(defun nnimap-ok-p (value)
+ (and (consp value)
+ (consp (car value))
+ (equal (caar value) "OK")))
+
(defun nnimap-find-uid-response (name list)
(let ((result (car (last (nnimap-find-response-element name list)))))
(and result
(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
- (cond
- (active
- (cons (min (or low (car active))
- (car active))
- (max (or high (cdr active))
- (cdr active))))
- ((and low high)
- (cons low high))
- (uidnext
- ;; No articles in this group.
- (cons uidnext (1- uidnext)))
- (start-article
- (cons start-article (1- start-article)))
- (t
- ;; No articles and no uidnext.
- nil)))
- (gnus-set-active
- group
+ (gnus-set-active
+ group
+ (if (or completep
+ (not (gnus-active group)))
+ (cond
+ (active
+ (cons (min (or low (car active))
+ (car active))
+ (max (or high (cdr active))
+ (cdr active))))
+ ((and low high)
+ (cons low high))
+ (uidnext
+ ;; No articles in this group.
+ (cons uidnext (1- uidnext)))
+ (start-article
+ (cons start-article (1- start-article)))
+ (t
+ ;; No articles and no uidnext.
+ nil))
(cons (car active)
(or high (1- uidnext)))))
;; See whether this is a read-only group.
(when new-marks
(push (cons (car type) new-marks) marks)))))
(gnus-info-set-marks info marks t))))
+ ;; Tell Gnus whether there are any \Recent messages in any of
+ ;; the groups.
+ (let ((recent (cdr (assoc '%Recent flags))))
+ (when (and active recent)
+ (while recent
+ (when (> (car recent) (cdr active))
+ (push (list (cons (gnus-group-real-name group) 0))
+ nnmail-split-history)
+ (setq recent nil))
+ (pop recent))))
;; 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 nnimap-status-string "Read-only server")
nil)
+(declare-function gnus-fetch-headers "gnus-sum"
+ (articles &optional limit force-new dependencies))
+
(deffoo nnimap-request-thread (header)
(let* ((id (mail-header-id header))
(refs (split-string
(nnimap-parse-response))
(defun nnimap-wait-for-connection (&optional regexp)
- (unless regexp
- (setq regexp "^[*.] .*\n"))
+ (nnimap-wait-for-line (or regexp "^[*.] .*\n") "[*.] \\([A-Z0-9]+\\)"))
+
+(defun nnimap-wait-for-line (regexp &optional response-regexp)
(let ((process (get-buffer-process (current-buffer))))
(goto-char (point-min))
(while (and (memq (process-status process)
(nnheader-accept-process-output process)
(goto-char (point-min)))
(forward-line -1)
- (and (looking-at "[*.] \\([A-Z0-9]+\\)")
+ (and (looking-at (or response-regexp regexp))
(match-string 1))))
(defun nnimap-wait-for-response (sequence &optional messagep)
(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)
- (min
- (- (point) 500)
- (save-excursion
- (forward-line -3)
- (point))))
- (point-min))
- t)))
+ (progn
+ ;; Skip past any "*" lines that the server has
+ ;; output.
+ (while (and (not (bobp))
+ (progn
+ (forward-line -1)
+ (looking-at "\\*"))))
+ (not (looking-at (format "%d " sequence)))))
(when messagep
(nnheader-message 7 "nnimap read %dk" (/ (buffer-size) 1000)))
(nnheader-accept-process-output process)