(eval-and-compile
(require 'nnheader))
+(eval-when-compile
+ (require 'cl))
+
+(require 'netrc)
+
(nnoo-declare nnimap)
(defvoo nnimap-address nil
"How nnimap will talk to the IMAP server.
Values are `ssl' and `network'.")
+(defvoo nnimap-shell-program (if (boundp 'imap-shell-program)
+ (if (listp imap-shell-program)
+ (car imap-shell-program)
+ imap-shell-program)
+ "ssh %s imapd"))
+
(defvoo nnimap-inbox nil
"The mail box where incoming mail arrives and should be split out of.")
(defun nnimap-buffer ()
(nnimap-find-process-buffer nntp-server-buffer))
-(defmacro nnimap-with-process-buffer (&rest body)
- `(with-current-buffer (nnimap-find-process-buffer (current-buffer))
- ,@body))
-
(defun 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 %s)"
+ (format "(UID RFC822.SIZE BODYSTRUCTURE %s)"
(format
- (if (member "IMAP4rev1"
+ (if (member "IMAP4REV1"
(nnimap-capabilities nnimap-object))
"BODY.PEEK[HEADER.FIELDS %s]"
"RFC822.HEADER.LINES %s")
(defun nnimap-transform-headers ()
(goto-char (point-min))
- (let (article bytes)
+ (let (article bytes lines)
(block nil
(while (not (eobp))
(while (not (looking-at "^\\* [0-9]+ FETCH.*UID \\([0-9]+\\)"))
(when (eobp)
(return)))
(setq article (match-string 1)
- bytes (nnimap-get-length))
+ bytes (nnimap-get-length)
+ lines nil)
+ (beginning-of-line)
+ (when (search-forward "BODYSTRUCTURE" (line-end-position) t)
+ (let ((structure (ignore-errors (read (current-buffer)))))
+ (while (and (consp structure)
+ (not (stringp (car structure))))
+ (setq structure (car structure)))
+ (setq lines (nth 7 structure))))
(delete-region (line-beginning-position) (line-end-position))
(insert (format "211 %s Article retrieved." article))
(forward-line 1)
(insert (format "Bytes: %d\n" bytes))
+ (when lines
+ (insert (format "Lines: %s\n" lines)))
(re-search-forward "^\r$")
(delete-region (line-beginning-position) (line-end-position))
(insert ".")
(push (list buffer (current-buffer)) nnimap-connection-alist)
(current-buffer)))
+(defun nnimap-open-shell-stream (name buffer host port)
+ (let ((process (start-process name buffer shell-file-name
+ shell-command-switch
+ (format-spec
+ nnimap-shell-program
+ (format-spec-make
+ ?s host
+ ?p port)))))
+ process))
+
(defun nnimap-open-connection (buffer)
(with-current-buffer (nnimap-make-process-buffer buffer)
- (let ((credentials
- (cond
- ((eq nnimap-stream 'network)
- (open-network-stream "*nnimap*" (current-buffer) nnimap-address
- (or nnimap-server-port "imap"))
- (netrc-credentials nnimap-address "imap"))
- ((eq nnimap-stream 'ssl)
- (open-tls-stream "*nnimap*" (current-buffer) nnimap-address
- (or nnimap-server-port "imaps"))
- (netrc-credentials nnimap-address "imaps" "imap")))))
+ (let* ((coding-system-for-read 'binary)
+ (coding-system-for-write 'binary)
+ (credentials
+ (cond
+ ((eq nnimap-stream 'network)
+ (open-network-stream "*nnimap*" (current-buffer) nnimap-address
+ (or nnimap-server-port
+ (if (netrc-find-service-number "imap")
+ "imap"
+ "143")))
+ (auth-source-user-or-password
+ '("login" "password") nnimap-address "imap" nil t))
+ ((eq nnimap-stream 'stream)
+ (nnimap-open-shell-stream
+ "*nnimap*" (current-buffer) nnimap-address
+ (or nnimap-server-port "imap"))
+ (auth-source-user-or-password
+ '("login" "password") nnimap-address "imap" nil t))
+ ((eq nnimap-stream 'ssl)
+ (open-tls-stream "*nnimap*" (current-buffer) nnimap-address
+ (or nnimap-server-port
+ (if (netrc-find-service-number "imaps")
+ "imaps"
+ "993")))
+ (or
+ (auth-source-user-or-password
+ '("login" "password") nnimap-address "imap")
+ (auth-source-user-or-password
+ '("login" "password") nnimap-address "imaps" nil t))))))
(setf (nnimap-process nnimap-object)
(get-buffer-process (current-buffer)))
(unless credentials
- (delete-process (nnimap-process nnimap-object))
- (error "Can't find user name/password for %s" nnimap-address))
+ (delete-process (nnimap-process nnimap-object)))
(when (and (nnimap-process nnimap-object)
(memq (process-status (nnimap-process nnimap-object))
'(open run)))
(gnus-set-process-query-on-exit-flag (nnimap-process nnimap-object) nil)
(let ((result (nnimap-command "LOGIN %S %S"
(car credentials) (cadr credentials))))
- (unless (car result)
- (delete-process (nnimap-process nnimap-object))
- (error "Unable to login to the server: %s"
- (mapconcat #'identity (cadr result) " ")))
- (setf (nnimap-capabilities nnimap-object)
- (or (nnimap-find-parameter "CAPABILITY" (cdr result))
- (nnimap-find-parameter
- "CAPABILITY" (cdr (nnimap-command "CAPABILITY")))))
- (when (member "QRESYNC" (nnimap-capabilities nnimap-object))
- (nnimap-command "ENABLE QRESYNC"))
- t)))))
+ (if (not (car result))
+ (progn
+ (delete-process (nnimap-process nnimap-object))
+ nil)
+ (setf (nnimap-capabilities nnimap-object)
+ (mapcar
+ #'upcase
+ (or (nnimap-find-parameter "CAPABILITY" (cdr result))
+ (nnimap-find-parameter
+ "CAPABILITY" (cdr (nnimap-command "CAPABILITY"))))))
+ (when (member "QRESYNC" (nnimap-capabilities nnimap-object))
+ (nnimap-command "ENABLE QRESYNC"))
+ t))))))
(defun nnimap-find-parameter (parameter elems)
(let (result)
(when (and result
article)
(erase-buffer)
- (nnimap-with-process-buffer
- (erase-buffer)
- (setq result
- (nnimap-command
- (if (member "IMAP4rev1" (nnimap-capabilities nnimap-object))
- "UID FETCH %d BODY.PEEK[]"
- "UID FETCH %d RFC822.PEEK")
- article)))
+ (with-current-buffer (nnimap-buffer)
+ (erase-buffer)
+ (setq result
+ (nnimap-command
+ (if (member "IMAP4REV1" (nnimap-capabilities nnimap-object))
+ "UID FETCH %d BODY.PEEK[]"
+ "UID FETCH %d RFC822.PEEK")
+ article)))
(let ((buffer (nnimap-find-process-buffer (current-buffer))))
(when (car result)
(with-current-buffer to-buffer
(defun nnimap-request-set-mark (group actions &optional server)
(when (nnimap-possibly-change-group group server)
(let (sequence)
- (with-current-buffer (nnimap-find-process-buffer nntp-server-buffer)
+ (with-current-buffer (nnimap-buffer)
;; Just send all the STORE commands without waiting for
;; response. If they're successful, they're successful.
(dolist (action actions)
(let ((message (buffer-string))
(message-id (message-field-value "message-id"))
sequence)
- (with-current-buffer nntp-server-buffer
- (nnimap-with-process-buffer
- (setq sequence (nnimap-send-command
- "APPEND %S {%d}" (utf7-encode group t)
- (length message)))
- (process-send-string (get-buffer-process (current-buffer)) message)
- (process-send-string (get-buffer-process (current-buffer)) "\r\n")
- (let ((result (nnimap-get-response sequence)))
- (when result
- (cons group
- (nnimap-find-article-by-message-id group message-id)))))))))
+ (with-current-buffer (nnimap-buffer)
+ (setq sequence (nnimap-send-command
+ "APPEND %S {%d}" (utf7-encode group t)
+ (length message)))
+ (process-send-string (get-buffer-process (current-buffer)) message)
+ (process-send-string (get-buffer-process (current-buffer)) "\r\n")
+ (let ((result (nnimap-get-response sequence)))
+ (when result
+ (cons group
+ (nnimap-find-article-by-message-id group message-id))))))))
(defun nnimap-add-cr ()
(goto-char (point-min))
(when (car result)
(dolist (line (cdr result))
(when (and (equal (car line) "LIST")
- (not (string-match "noselect" (caadr line))))
+ (not (and (caadr line)
+ (string-match "noselect" (caadr line)))))
(push (car (last line)) groups)))
(nreverse groups))))
(with-current-buffer nntp-server-buffer
(erase-buffer)
(let ((groups
- (nnimap-with-process-buffer
- (nnimap-get-groups)))
+ (with-current-buffer (nnimap-buffer)
+ (nnimap-get-groups)))
sequences responses)
(when groups
- (nnimap-with-process-buffer
- (dolist (group groups)
- (push (list (nnimap-send-command "EXAMINE %S" (utf7-encode group t))
- group)
- sequences))
- (nnimap-wait-for-response (caar sequences))
- (setq responses
- (nnimap-get-responses (mapcar #'car sequences))))
+ (with-current-buffer (nnimap-buffer)
+ (dolist (group groups)
+ (push (list (nnimap-send-command "EXAMINE %S" (utf7-encode group t))
+ group)
+ sequences))
+ (nnimap-wait-for-response (caar sequences))
+ (setq responses
+ (nnimap-get-responses (mapcar #'car sequences))))
(dolist (response responses)
(let* ((sequence (car response))
(response (cadr response))
(setq exists (string-to-number (car elem)))))
(when uidnext
(setq highest (1- (string-to-number (car uidnext)))))
- (if (zerop exists)
- ;; Empty group.
- (insert (format "%S %d %d y\n"
- (utf7-decode group t) highest (1+ highest)))
+ (cond
+ ((null highest)
+ (insert (format "%S 0 1 y\n" (utf7-decode group t))))
+ ((zerop exists)
+ ;; Empty group.
+ (insert (format "%S %d %d y\n"
+ (utf7-decode group t) highest (1+ highest))))
+ (t
;; Return the widest possible range.
(insert (format "%S %d 1 y\n" (utf7-decode group t)
- (or highest exists))))))))
+ (or highest exists)))))))))
t))))
(defun nnimap-retrieve-group-data-early (server infos)
sequences))))
(defun nnimap-finish-retrieve-group-infos (server infos sequences)
- (when (nnimap-possibly-change-group nil server)
+ (when (and 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))
(completep (and start-article
(= start-article 1))))
;; First set the active ranges based on high/low.
- (if completep
+ (if (or completep
+ (not (gnus-active group)))
(gnus-set-active group
(if high
(cons low high)
nil)
(defun nnimap-possibly-change-group (group server)
- (when (and server
- (not (nnimap-server-opened server)))
- (nnimap-open-server server))
- (if (not group)
- t
- (with-current-buffer (nnimap-buffer)
- (if (equal group (nnimap-group nnimap-object))
- t
- (let ((result (nnimap-command "SELECT %S" (utf7-encode group t))))
- (when (car result)
- (setf (nnimap-group nnimap-object) group)
- result))))))
+ (let ((open-result t))
+ (when (and server
+ (not (nnimap-server-opened server)))
+ (setq open-result (nnimap-open-server server)))
+ (cond
+ ((not open-result)
+ nil)
+ ((not group)
+ t)
+ (t
+ (with-current-buffer (nnimap-buffer)
+ (if (equal group (nnimap-group nnimap-object))
+ t
+ (let ((result (nnimap-command "SELECT %S" (utf7-encode group t))))
+ (when (car result)
+ (setf (nnimap-group nnimap-object) group)
+ result))))))))
(defun nnimap-find-connection (buffer)
"Find the connection delivering to BUFFER."
(nnimap-article-ranges articles)
(format "(UID %s%s)"
(format
- (if (member "IMAP4rev1"
+ (if (member "IMAP4REV1"
(nnimap-capabilities nnimap-object))
"BODY.PEEK[HEADER] BODY.PEEK"
"RFC822.PEEK"))