(require 'gnus)
(require 'nnoo)
(require 'netrc)
+(require 'utf7)
+(require 'tls)
+(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-stream 'ssl
"How nnimap will talk to the IMAP server.
-Values are `ssl' and `network'.")
+Values are `ssl', `network', `starttls' or `shell'.")
(defvoo nnimap-shell-program (if (boundp 'imap-shell-program)
(if (listp imap-shell-program)
(defvoo nnimap-inbox nil
"The mail box where incoming mail arrives and should be split out of.")
-(defvoo nnimap-expunge-inbox nil
- "If non-nil, expunge the inbox after fetching mail.
-This is always done if the server supports UID EXPUNGE, but it's
-not done by default on servers that doesn't support that command.")
+(defvoo nnimap-split-methods nil
+ "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'.")
+(defvoo nnimap-expunge t
+ "If non-nil, expunge articles after deleting them.
+This is always done if the server supports UID EXPUNGE, but it's
+not done by default on servers that doesn't support that command.")
+
+(defvoo nnimap-streaming t
+ "If non-nil, try to use streaming commands with IMAP servers.
+Switching this off will make nnimap slower, but it helps with
+some servers.")
+
+(defvoo nnimap-connection-alist nil)
+
+(defvoo nnimap-current-infos nil)
+
(defvoo nnimap-fetch-partial-articles nil
- "If non-nil, nnimap will fetch partial articles.
+ "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.")
-(defvoo nnimap-connection-alist nil)
-
-(defvoo nnimap-current-infos nil)
-
(defvar nnimap-process nil)
(defvar nnimap-status-string "")
(defvar nnimap-split-download-body-default nil
"Internal variable with default value for `nnimap-split-download-body'.")
+(defvar nnimap-keepalive-timer nil)
+(defvar nnimap-process-buffers nil)
+
(defstruct nnimap
- group process commands capabilities select-result newlinep)
+ group process commands capabilities select-result newlinep server
+ last-command-time greeting)
(defvar nnimap-object nil)
(defvar nnimap-mark-alist
- '((read "\\Seen")
- (tick "\\Flagged")
- (reply "\\Answered")
+ '((read "\\Seen" %Seen)
+ (tick "\\Flagged" %Flagged)
+ (reply "\\Answered" %Answered)
(expire "gnus-expire")
(dormant "gnus-dormant")
(score "gnus-score")
(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
(nnimap-article-ranges (gnus-compress-sequence articles))
(format "(UID RFC822.SIZE BODYSTRUCTURE %s)"
(format
- (if (member "IMAP4REV1"
- (nnimap-capabilities nnimap-object))
+ (if (nnimap-ver4-p)
"BODY.PEEK[HEADER.FIELDS %s]"
"RFC822.HEADER.LINES %s")
(append '(Subject From Date Message-Id
(nnimap-transform-headers))
(insert-buffer-substring
(nnimap-find-process-buffer (current-buffer))))
- t))
+ 'headers))
(defun nnimap-transform-headers ()
(goto-char (point-min))
- (let (article bytes lines)
+ (let (article bytes lines size string)
(block nil
(while (not (eobp))
(while (not (looking-at "^\\* [0-9]+ FETCH.*UID \\([0-9]+\\)"))
(delete-region (point) (progn (forward-line 1) (point)))
(when (eobp)
(return)))
- (setq article (match-string 1)
- bytes (nnimap-get-length)
+ (setq article (match-string 1))
+ ;; Unfold quoted {number} strings.
+ (while (re-search-forward "[^]] {\\([0-9]+\\)}\r\n"
+ (1+ (line-end-position)) t)
+ (setq size (string-to-number (match-string 1)))
+ (delete-region (+ (match-beginning 0) 2) (point))
+ (setq string (delete-region (point) (+ (point) size)))
+ (insert (format "%S" string)))
+ (setq bytes (nnimap-get-length)
lines nil)
(beginning-of-line)
+ (setq size
+ (and (re-search-forward "RFC822.SIZE \\([0-9]+\\)"
+ (line-end-position)
+ t)
+ (match-string 1)))
+ (beginning-of-line)
(when (search-forward "BODYSTRUCTURE" (line-end-position) t)
- (let ((structure (ignore-errors (read (current-buffer)))))
+ (let ((structure (ignore-errors
+ (read (current-buffer)))))
(while (and (consp structure)
(not (stringp (car structure))))
(setq structure (car structure)))
(delete-region (line-beginning-position) (line-end-position))
(insert (format "211 %s Article retrieved." article))
(forward-line 1)
- (insert (format "Chars: %d\n" bytes))
+ (when size
+ (insert (format "Chars: %s\n" size)))
(when lines
(insert (format "Lines: %s\n" lines)))
(re-search-forward "^\r$")
(buffer-disable-undo)
(gnus-add-buffer)
(set (make-local-variable 'after-change-functions) nil)
- (set (make-local-variable 'nnimap-object) (make-nnimap))
+ (set (make-local-variable 'nnimap-object)
+ (make-nnimap :server (nnoo-current-server 'nnimap)))
(push (list buffer (current-buffer)) nnimap-connection-alist)
+ (push (current-buffer) nnimap-process-buffers)
(current-buffer)))
(defun nnimap-open-shell-stream (name buffer host port)
?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 ()
+ (let ((now (current-time)))
+ (dolist (buffer nnimap-process-buffers)
+ (when (buffer-name buffer)
+ (with-current-buffer buffer
+ (when (and nnimap-object
+ (nnimap-last-command-time nnimap-object)
+ (> (time-to-seconds
+ (time-subtract
+ now
+ (nnimap-last-command-time nnimap-object)))
+ ;; More than five minutes since the last command.
+ (* 5 60)))
+ (nnimap-send-command "NOOP")))))))
+
(defun nnimap-open-connection (buffer)
- (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 '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))
- (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
+ (unless nnimap-keepalive-timer
+ (setq nnimap-keepalive-timer (run-at-time (* 60 15) (* 60 15)
+ 'nnimap-keepalive)))
+ (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)
+ (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)
+ (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 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))
+ (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)
+ (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"))
+ (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)
(deffoo nnimap-request-article (article &optional group server to-buffer)
(with-current-buffer nntp-server-buffer
(let ((result (nnimap-possibly-change-group group server))
- parts)
+ parts structure)
(when (stringp article)
(setq article (nnimap-find-article-by-message-id group article)))
(when (and result
(with-current-buffer (nnimap-buffer)
(erase-buffer)
(when nnimap-fetch-partial-articles
- (if (eq nnimap-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)
- (let ((structure (ignore-errors (read (current-buffer)))))
- (setq parts (nnimap-find-wanted-parts structure))))))
- (setq result
- (nnimap-command
- (if (member "IMAP4REV1" (nnimap-capabilities nnimap-object))
- "UID FETCH %d BODY.PEEK[]"
- "UID FETCH %d RFC822.PEEK")
- article))
- ;; Check that we really got an article.
- (goto-char (point-min))
- (unless (looking-at "\\* [0-9]+ FETCH")
- (setq result nil)))
- (let ((buffer (nnimap-find-process-buffer (current-buffer))))
- (when (car result)
- (with-current-buffer (or to-buffer nntp-server-buffer)
- (insert-buffer-substring buffer)
- (goto-char (point-min))
- (let ((bytes (nnimap-get-length)))
- (delete-region (line-beginning-position)
- (progn (forward-line 1) (point)))
- (goto-char (+ (point) bytes))
- (delete-region (point) (point-max))
- (nnheader-ms-strip-cr))
- t)))))))
+ (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))
+ (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)
+ (let ((result
+ (nnimap-command
+ (if (nnimap-ver4-p)
+ "UID FETCH %d BODY.PEEK[]"
+ "UID FETCH %d RFC822.PEEK")
+ article)))
+ ;; Check that we really got an article.
+ (goto-char (point-min))
+ (unless (re-search-forward "\\* [0-9]+ FETCH" nil t)
+ (setq result nil))
+ (when result
+ ;; 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)))
+ (goto-char (+ (point) bytes))
+ (delete-region (point) (point-max)))
+ t)))
+
+(defun nnimap-ver4-p ()
+ (member "IMAP4REV1" (nnimap-capabilities nnimap-object)))
+
+(defun nnimap-get-partial-article (article parts structure)
+ (let ((result
+ (nnimap-command
+ "UID FETCH %d (%s %s)"
+ article
+ (if (nnimap-ver4-p)
+ "BODY.PEEK[HEADER]"
+ "RFC822.HEADER")
+ (if (nnimap-ver4-p)
+ (mapconcat (lambda (part)
+ (format "BODY.PEEK[%s]" part))
+ parts " ")
+ (mapconcat (lambda (part)
+ (format "RFC822.PEEK[%s]" part))
+ parts " ")))))
+ (when result
+ (nnimap-convert-partial-article structure))))
+
+(defun nnimap-convert-partial-article (structure)
+ ;; First just skip past the headers.
+ (goto-char (point-min))
+ (let ((bytes (nnimap-get-length))
+ id parts)
+ ;; Delete "FETCH" line.
+ (delete-region (line-beginning-position)
+ (progn (forward-line 1) (point)))
+ (goto-char (+ (point) bytes))
+ ;; Collect all the body parts.
+ (while (looking-at ".*BODY\\[\\([.0-9]+\\)\\]")
+ (setq id (match-string 1)
+ bytes (nnimap-get-length))
+ (beginning-of-line)
+ &
projects / gnus / blobdiff