X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fnnimap.el;h=8dad44d3c7e70dd37a7dd2ae9d30fbadf47673b7;hp=138833c22b133013d2b91dd383d20aee081cc27d;hb=47893f5bd2ab35872d43003adc55cafac43b7b7c;hpb=a43e635ba3ee5c96cff15992a78c0c691ccc17d2 diff --git a/lisp/nnimap.el b/lisp/nnimap.el index 138833c22..8dad44d3c 100644 --- a/lisp/nnimap.el +++ b/lisp/nnimap.el @@ -38,8 +38,12 @@ (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-address nil @@ -67,6 +71,12 @@ Values are `ssl', `network', `starttls' or `shell'.") "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'.") @@ -300,19 +310,25 @@ textual parts.") (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"))) + (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")))) + ((memq nnimap-stream '(ssl tls)) + (funcall (if (fboundp 'open-gnutls-stream) + 'open-gnutls-stream + '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")) + (t + (error "Unknown stream type: %s" nnimap-stream)))) connection-result login-result credentials) (setf (nnimap-process nnimap-object) (get-buffer-process (current-buffer))) @@ -321,7 +337,8 @@ textual parts.") '(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) + (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 @@ -336,20 +353,23 @@ textual parts.") #'upcase (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)) ;; 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)) - (delete-process (nnimap-process nnimap-object)) - (kill-buffer (current-buffer)) - (return - (nnimap-open-connection buffer)))) - (when nnimap-server-port - (push (format "%s" nnimap-server-port) ports)) + (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) @@ -381,7 +401,20 @@ textual parts.") (when nnimap-object (when (member "QRESYNC" (nnimap-capabilities nnimap-object)) (nnimap-command "ENABLE QRESYNC")) - t))))))) + (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) @@ -396,7 +429,10 @@ textual parts.") result)) (deffoo nnimap-close-server (&optional server) - t) + (when (nnoo-change-server 'nnimap server nil) + (ignore-errors + (delete-process (get-buffer-process (nnimap-buffer)))) + t)) (deffoo nnimap-request-close () t) @@ -422,13 +458,16 @@ textual parts.") (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) - (setq structure (ignore-errors (read (current-buffer))) - parts (nnimap-find-wanted-parts structure))))) + (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)) @@ -508,8 +547,15 @@ textual parts.") 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))) @@ -551,7 +597,9 @@ textual parts.") (number-to-string num) (format "%s.%s" prefix num)))) (setcar (nthcdr 9 sub) id) - (when (string-match nnimap-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))) @@ -583,10 +631,11 @@ textual parts.") (nnimap-update-infos marks (list info))) (goto-char (point-max)) (let ((uidnext (nth 5 (car marks)))) - (setq high (if uidnext - (1- uidnext) - (nth 3 (car marks))) - low (or (nth 4 (car marks)) uidnext))))) + (setq high (or (if uidnext + (1- uidnext) + (nth 3 (car marks))) + 0) + low (or (nth 4 (car marks)) uidnext 1))))) (erase-buffer) (insert (format @@ -603,6 +652,12 @@ textual parts.") (with-current-buffer (nnimap-buffer) (car (nnimap-command "DELETE %S" (utf7-encode group t)))))) +(deffoo nnimap-request-rename-group (group new-name &optional server) + (when (nnimap-possibly-change-group nil server) + (with-current-buffer (nnimap-buffer) + (car (nnimap-command "RENAME %S %S" + (utf7-encode group t) (utf7-encode new-name t)))))) + (deffoo nnimap-request-expunge-group (group &optional server) (when (nnimap-possibly-change-group group server) (with-current-buffer (nnimap-buffer) @@ -720,16 +775,20 @@ textual parts.") (defun nnimap-find-article-by-message-id (group message-id) - (when (nnimap-possibly-change-group group nil) - (with-current-buffer (nnimap-buffer) - (let ((result - (nnimap-command "UID SEARCH HEADER Message-Id %S" message-id)) - article) - (when (car result) - ;; Select the last instance of the message in the group. - (and (setq article - (car (last (assoc "SEARCH" (cdr result))))) - (string-to-number article))))))) + (with-current-buffer (nnimap-buffer) + (erase-buffer) + (setf (nnimap-group nnimap-object) nil) + (nnimap-send-command "EXAMINE %S" (utf7-encode group t)) + (let ((sequence + (nnimap-send-command "UID SEARCH HEADER Message-Id %S" message-id)) + article result) + (setq result (nnimap-wait-for-response sequence)) + (when (and result + (car (setq result (nnimap-parse-response)))) + ;; Select the last instance of the message in the group. + (and (setq article + (car (last (assoc "SEARCH" (cdr result))))) + (string-to-number article)))))) (defun nnimap-delete-article (articles) (with-current-buffer (nnimap-buffer) @@ -765,6 +824,7 @@ textual parts.") (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) @@ -786,9 +846,10 @@ textual parts.") (deffoo nnimap-request-accept-article (group &optional server last) (when (nnimap-possibly-change-group nil server) (nnmail-check-syntax) - (let ((message (buffer-string)) - (message-id (message-field-value "message-id")) - sequence) + (let ((message-id (message-field-value "message-id")) + sequence message) + (nnimap-add-cr) + (setq message (buffer-string)) (with-current-buffer (nnimap-buffer) (setq sequence (nnimap-send-command "APPEND %S {%d}" (utf7-encode group t) @@ -866,6 +927,17 @@ textual parts.") (or highest exists))))))))) t)))) +(deffoo nnimap-request-newgroups (date &optional server) + (nnimap-possibly-change-group nil server) + (with-current-buffer nntp-server-buffer + (erase-buffer) + (dolist (group (with-current-buffer (nnimap-buffer) + (nnimap-get-groups))) + (unless (assoc group nnimap-current-infos) + ;; Insert dummy numbers here -- they don't matter. + (insert (format "%S 0 1 y\n" group)))) + t)) + (deffoo nnimap-retrieve-group-data-early (server infos) (when (nnimap-possibly-change-group nil server) (with-current-buffer (nnimap-buffer) @@ -917,7 +989,7 @@ textual parts.") (nnimap-possibly-change-group nil server)) (with-current-buffer (nnimap-buffer) ;; Wait for the final data to trickle in. - (when (nnimap-wait-for-response (cadar sequences)) + (when (nnimap-wait-for-response (cadar sequences) t) ;; Now we should have all the data we need, no matter whether ;; we're QRESYNCING, fetching all the flags from scratch, or ;; just fetching the last 100 flags per group. @@ -944,7 +1016,11 @@ textual parts.") (nnimap-update-info info (cdr (assoc group flags)))))) (defun nnimap-update-info (info marks) - (when marks + (when (and marks + ;; Ignore groups with no UIDNEXT/marks. This happens for + ;; completely empty groups. + (or (car marks) + (nth 4 marks))) (destructuring-bind (existing flags high low uidnext start-article permanent-flags) marks (let ((group (gnus-info-group info)) @@ -971,9 +1047,6 @@ textual parts.") group (cons (car (gnus-active group)) (or high (1- uidnext))))) - (when (and (not high) - uidnext) - (setq high (1- uidnext))) ;; Then update the list of read articles. (let* ((unread (gnus-compress-sequence @@ -1172,11 +1245,11 @@ textual parts.") (goto-char (point-min)) (while (and (memq (process-status process) '(open run)) - (not (re-search-forward "^\\* .*\n" nil t))) + (not (re-search-forward "^[*.] .*\n" nil t))) (nnheader-accept-process-output process) (goto-char (point-min))) (forward-line -1) - (and (looking-at "\\* \\([A-Z0-9]+\\)") + (and (looking-at "[*.] \\([A-Z0-9]+\\)") (match-string 1)))) (defun nnimap-wait-for-response (sequence &optional messagep) @@ -1192,7 +1265,7 @@ textual parts.") (point-min)) t))) (when messagep - (message "Read %dKB" (/ (buffer-size) 1000))) + (message "nnimap read %dk" (/ (buffer-size) 1000))) (nnheader-accept-process-output process) (goto-char (point-max))) openp)) @@ -1221,13 +1294,15 @@ textual parts.") (push (cond ((eql char ?\[) - (split-string (buffer-substring - (1+ (point)) - (1- (search-forward "]" (line-end-position) 'move))))) + (split-string + (buffer-substring + (1+ (point)) + (1- (search-forward "]" (line-end-position) 'move))))) ((eql char ?\() - (split-string (buffer-substring - (1+ (point)) - (1- (search-forward ")" (line-end-position) 'move))))) + (split-string + (buffer-substring + (1+ (point)) + (1- (search-forward ")" (line-end-position) 'move))))) ((eql char ?\") (forward-char 1) (buffer-substring @@ -1285,7 +1360,11 @@ textual parts.") (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-split-fancy (or nnimap-split-fancy + nnmail-split-fancy)) (nnmail-inhibit-default-split-group t) (groups (nnimap-get-groups)) new-articles) @@ -1336,6 +1415,7 @@ textual parts.") (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)))