;;; 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>
(download "gnus-download")
(forward "gnus-forward")))
+(defvar nnimap-quirks
+ '(("QRESYNC" "Zimbra" "QRESYNC ")))
+
(defun nnimap-buffer ()
(nnimap-find-process-buffer nntp-server-buffer))
(nnimap-article-ranges (gnus-compress-sequence articles))
(nnimap-header-parameters))
t)
- (nnimap-transform-headers))
+ (nnimap-transform-headers)
+ (nnheader-remove-cr-followed-by-lf))
(insert-buffer-substring
(nnimap-find-process-buffer (current-buffer))))
'headers))
(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
+ ((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)
;; 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)
(push flag flags)))
flags))
+(deffoo nnimap-request-update-group-status (group status &optional server)
+ (when (nnimap-possibly-change-group nil server)
+ (let ((command (assoc
+ status
+ '((subscribe "SUBSCRIBE")
+ (unsubscribe "UNSUBSCRIBE")))))
+ (when command
+ (with-current-buffer (nnimap-buffer)
+ (nnimap-command "%s %S" (cadr command) (utf7-encode group t)))))))
+
(deffoo nnimap-request-set-mark (group actions &optional server)
(when (nnimap-possibly-change-group group server)
(let (sequence)
uidvalidity
modseq)
(push
- (list (nnimap-send-command "EXAMINE %S (QRESYNC (%s %s))"
+ (list (nnimap-send-command "EXAMINE %S (%s (%s %s))"
(utf7-encode group t)
+ (nnimap-quirk "QRESYNC")
uidvalidity modseq)
'qresync
nil group 'qresync)
sequences))))
sequences))))
+(defun nnimap-quirk (command)
+ (let ((quirk (assoc command nnimap-quirks)))
+ ;; If this server is of a type that matches a quirk, then return
+ ;; the "quirked" command instead of the proper one.
+ (if (or (null quirk)
+ (not (string-match (nth 1 quirk) (nnimap-greeting nnimap-object))))
+ command
+ (nth 2 quirk))))
+
(deffoo nnimap-finish-retrieve-group-infos (server infos sequences)
(when (and sequences
(nnimap-possibly-change-group nil server))
(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)
(not (re-search-backward
(format "^%d .*\n" sequence)
(if nnimap-streaming
- (max (point-min) (- (point) 500))
+ (max (point-min)
+ (min
+ (- (point) 500)
+ (save-excursion
+ (forward-line -3)
+ (point))))
(point-min))
t)))
(when messagep