(require 'gnus)
(require 'nnoo)
(require 'netrc)
+(require 'utf7)
(require 'parse-time)
+(autoload 'auth-source-forget-user-or-password "auth-source")
+(autoload 'auth-source-user-or-password "auth-source")
+
(nnoo-declare nnimap)
(defvoo nnimap-address nil
(defvoo nnimap-inbox nil
"The mail box where incoming mail arrives and should be split out of.")
+(defvoo nnimap-split-methods nil
+ "How mail is split.
+Uses the same syntax as nnmail-split-methods")
+
+(make-obsolete-variable 'nnimap-split-rule "see `nnimap-split-methods'"
+ "Gnus 5.13")
+
(defvoo nnimap-authenticator nil
"How nnimap authenticate itself to the server.
Possible choices are nil (use default methods) or `anonymous'.")
(defvoo nnimap-current-infos nil)
+(defvoo nnimap-fetch-partial-articles nil
+ "If non-nil, Gnus will fetch partial articles.
+If t, nnimap will fetch only the first part. If a string, it
+will fetch all parts that have types that match that string. A
+likely value would be \"text/\" to automatically fetch all
+textual parts.")
+
(defvar nnimap-process nil)
(defvar nnimap-status-string "")
(defstruct nnimap
group process commands capabilities select-result newlinep server
- last-command-time)
+ last-command-time greeting)
(defvar nnimap-object nil)
(download "gnus-download")
(forward "gnus-forward")))
-(defvar nnimap-split-methods nil)
-
(defun nnimap-buffer ()
(nnimap-find-process-buffer nntp-server-buffer))
(erase-buffer)
(when (nnimap-possibly-change-group group server)
(with-current-buffer (nnimap-buffer)
- (nnimap-send-command "SELECT %S" (utf7-encode group t))
(erase-buffer)
(nnimap-wait-for-response
(nnimap-send-command
?s host
?p port)))))
-(defun nnimap-credentials (address ports)
+(defun nnimap-credentials (address ports &optional inhibit-create)
(let (port credentials)
;; Request the credentials from all ports, but only query on the
;; last port if all the previous ones have failed.
(setq port (pop ports)))
(setq credentials
(auth-source-user-or-password
- '("login" "password") address port nil (null ports))))
+ '("login" "password") address port nil
+ (if inhibit-create
+ nil
+ (null ports)))))
credentials))
(defun nnimap-keepalive ()
(unless nnimap-keepalive-timer
(setq nnimap-keepalive-timer (run-at-time (* 60 15) (* 60 15)
'nnimap-keepalive)))
- (with-current-buffer (nnimap-make-process-buffer buffer)
- (let* ((coding-system-for-read 'binary)
- (coding-system-for-write 'binary)
- (ports
- (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")))
- '("143" "imap"))
- ((eq nnimap-stream 'shell)
- (nnimap-open-shell-stream
- "*nnimap*" (current-buffer) nnimap-address
- (or nnimap-server-port "imap"))
- '("imap"))
- ((eq nnimap-stream 'starttls)
- (starttls-open-stream
- "*nnimap*" (current-buffer) nnimap-address
- (or nnimap-server-port "imap"))
- '("imap"))
- ((eq nnimap-stream 'ssl)
- (open-tls-stream
- "*nnimap*" (current-buffer) nnimap-address
- (or nnimap-server-port
- (if (netrc-find-service-number "imaps")
- "imaps"
- "993")))
- '("143" "993" "imap" "imaps"))))
- connection-result login-result credentials)
- (setf (nnimap-process nnimap-object)
- (get-buffer-process (current-buffer)))
- (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)
- (when (setq connection-result (nnimap-wait-for-connection))
- (when (eq nnimap-stream 'starttls)
- (nnimap-command "STARTTLS")
- (starttls-negotiate (nnimap-process nnimap-object)))
- (unless (equal connection-result "PREAUTH")
- (if (not (setq credentials
- (if (eq nnimap-authenticator 'anonymous)
- (list "anonymous"
- (message-make-address))
- (nnimap-credentials
- nnimap-address
- (if nnimap-server-port
- (cons (format "%s" nnimap-server-port) ports)
- ports)))))
- (setq nnimap-object nil)
- (setq login-result (nnimap-command "LOGIN %S %S"
- (car credentials)
- (cadr credentials)))
- (unless (car login-result)
- (delete-process (nnimap-process nnimap-object))
- (setq nnimap-object nil))))
- (when nnimap-object
+ (block nil
+ (with-current-buffer (nnimap-make-process-buffer buffer)
+ (let* ((coding-system-for-read 'binary)
+ (coding-system-for-write 'binary)
+ (port nil)
+ (ports
+ (cond
+ ((eq nnimap-stream 'network)
+ (open-network-stream
+ "*nnimap*" (current-buffer) nnimap-address
+ (setq port
+ (or nnimap-server-port
+ (if (netrc-find-service-number "imap")
+ "imap"
+ "143"))))
+ '("143" "imap"))
+ ((eq nnimap-stream 'shell)
+ (nnimap-open-shell-stream
+ "*nnimap*" (current-buffer) nnimap-address
+ (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")))
+ '("imap"))
+ ((eq nnimap-stream 'ssl)
+ (open-tls-stream
+ "*nnimap*" (current-buffer) nnimap-address
+ (setq port
+ (or nnimap-server-port
+ (if (netrc-find-service-number "imaps")
+ "imaps"
+ "993"))))
+ '("143" "993" "imap" "imaps"))))
+ connection-result login-result credentials)
+ (setf (nnimap-process nnimap-object)
+ (get-buffer-process (current-buffer)))
+ (if (not (and (nnimap-process nnimap-object)
+ (memq (process-status (nnimap-process nnimap-object))
+ '(open run))))
+ (nnheader-report 'nnimap "Unable to contact %s:%s via %s"
+ nnimap-address port nnimap-stream)
+ (gnus-set-process-query-on-exit-flag (nnimap-process nnimap-object) nil)
+ (if (not (setq connection-result (nnimap-wait-for-connection)))
+ (nnheader-report 'nnimap
+ "%s" (buffer-substring
+ (point) (line-end-position)))
+ ;; Store the greeting (for debugging purposes).
+ (setf (nnimap-greeting nnimap-object)
+ (buffer-substring (line-beginning-position)
+ (line-end-position)))
+ ;; Store the capabilities.
(setf (nnimap-capabilities nnimap-object)
(mapcar
#'upcase
- (or (nnimap-find-parameter "CAPABILITY" (cdr login-result))
- (nnimap-find-parameter
- "CAPABILITY" (cdr (nnimap-command "CAPABILITY"))))))
- (when (member "QRESYNC" (nnimap-capabilities nnimap-object))
- (nnimap-command "ENABLE QRESYNC"))
- t))))))
+ (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))
+ (unless (equal connection-result "PREAUTH")
+ (if (not (setq credentials
+ (if (eq nnimap-authenticator 'anonymous)
+ (list "anonymous"
+ (message-make-address))
+ (or
+ ;; First look for the credentials based
+ ;; on the virtual server name.
+ (nnimap-credentials
+ (nnoo-current-server 'nnimap) ports t)
+ ;; Then look them up based on the
+ ;; physical address.
+ (nnimap-credentials nnimap-address ports)))))
+ (setq nnimap-object nil)
+ (setq login-result (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.
+ (dolist (host (list (nnoo-current-server 'nnimap)
+ nnimap-address))
+ (dolist (port ports)
+ (dolist (element '("login" "password"))
+ (auth-source-forget-user-or-password
+ element host port))))
+ (delete-process (nnimap-process nnimap-object))
+ (setq nnimap-object nil))))
+ (when nnimap-object
+ (when (member "QRESYNC" (nnimap-capabilities nnimap-object))
+ (nnimap-command "ENABLE QRESYNC"))
+ t)))))))
(defun nnimap-find-parameter (parameter elems)
(let (result)
(erase-buffer)
(with-current-buffer (nnimap-buffer)
(erase-buffer)
- (when gnus-fetch-partial-articles
- (if (eq gnus-fetch-partial-articles t)
- (setq parts '(1))
- (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)))
- parts (nnimap-find-wanted-parts structure)))))
+ (when nnimap-fetch-partial-articles
+ (nnimap-command "UID FETCH %d (BODYSTRUCTURE)" article)
+ (goto-char (point-min))
+ (when (re-search-forward "FETCH.*BODYSTRUCTURE" nil t)
+ (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-get-whole-article article))
article)))
;; Check that we really got an article.
(goto-char (point-min))
- (unless (looking-at "\\* [0-9]+ FETCH")
+ (unless (re-search-forward "\\* [0-9]+ FETCH" nil t)
(setq result nil))
(when result
- (goto-char (point-min))
+ ;; Remove any data that may have arrived before the FETCH data.
+ (beginning-of-line)
+ (unless (bobp)
+ (delete-region (point-min) (point)))
(let ((bytes (nnimap-get-length)))
(delete-region (line-beginning-position)
(progn (forward-line 1) (point)))
t))
(defun nnimap-insert-partial-structure (structure parts &optional subp)
- (let ((type (car (last structure 4)))
- (boundary (cadr (member "BOUNDARY" (car (last structure 3))))))
+ (let (type boundary)
+ (let ((bstruc structure))
+ (while (consp (car bstruc))
+ (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))))
(when subp
(insert (format "Content-type: multipart/%s; boundary=%S\n\n"
(downcase type) boundary)))
(number-to-string num)
(format "%s.%s" prefix num))))
(setcar (nthcdr 9 sub) id)
- (when (string-match gnus-fetch-partial-articles type)
+ (when (if (eq nnimap-fetch-partial-articles t)
+ (equal id "1")
+ (string-match nnimap-fetch-partial-articles type))
(push id parts))))
(incf num)))
(nreverse parts)))
articles)
((and force
(eq nnmail-expiry-target 'delete))
- (unless (nnimap-delete-article articles)
+ (unless (nnimap-delete-article (gnus-compress-sequence articles))
(message "Article marked for deletion, but not expunged."))
nil)
(t
(if (null deletable-articles)
articles
(if (eq nnmail-expiry-target 'delete)
- (nnimap-delete-article deletable-articles)
+ (nnimap-delete-article (gnus-compress-sequence deletable-articles))
(setq deletable-articles
(nnimap-process-expiry-targets
deletable-articles group server)))
;; Change back to the current group again.
(nnimap-possibly-change-group group server)
(setq deleted-articles (nreverse deleted-articles))
- (nnimap-delete-article deleted-articles)
+ (nnimap-delete-article (gnus-compress-sequence deleted-articles))
deleted-articles))
(defun nnimap-find-expired-articles (group)
(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)
"\n"
"\r\n"))
(let ((result (nnimap-get-response sequence)))
- (when result
+ (if (not (car result))
+ (progn
+ (message "%s" (nnheader-get-report-string 'nnimap))
+ nil)
(cons group
(nnimap-find-article-by-message-id group message-id))))))))
;; commands, so throttle them.
(when (and (not nnimap-streaming)
(car sequences))
- (nnimap-wait-for-response (car sequences))))
+ (nnimap-wait-for-response (caar sequences))))
sequences))))
(deffoo nnimap-finish-retrieve-group-infos (server infos sequences)
(t
;; No articles and no uidnext.
nil)))
- (setcdr (gnus-active group) (or high (1- uidnext))))
+ (gnus-set-active
+ group
+ (cons (car (gnus-active group))
+ (or high (1- uidnext)))))
(when (and (not high)
uidnext)
(setq high (1- uidnext)))
(goto-char (point-max))
(while (and (setq openp (memq (process-status process)
'(open run)))
- (not (re-search-backward (format "^%d .*\n" sequence)
- (max (point-min) (- (point) 500))
- t)))
+ (not (re-search-backward
+ (format "^%d .*\n" sequence)
+ (if nnimap-streaming
+ (max (point-min) (- (point) 500))
+ (point-min))
+ t)))
(when messagep
(message "Read %dKB" (/ (buffer-size) 1000)))
(nnheader-accept-process-output process)
(cond
((eql char ?\[)
(split-string (buffer-substring
- (1+ (point)) (1- (search-forward "]")))))
+ (1+ (point))
+ (1- (search-forward "]" (line-end-position) 'move)))))
((eql char ?\()
(split-string (buffer-substring
- (1+ (point)) (1- (search-forward ")")))))
+ (1+ (point))
+ (1- (search-forward ")" (line-end-position) 'move)))))
((eql char ?\")
(forward-char 1)
- (buffer-substring (point) (1- (search-forward "\""))))
+ (buffer-substring
+ (point)
+ (1- (or (search-forward "\"" (line-end-position) 'move)
+ (point)))))
(t
(buffer-substring (point) (if (search-forward " " nil t)
(1- (point))
(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-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