emacs: lisp/gnus/nnimap.el comparison

comparison lisp/gnus/nnimap.el @ 110422:93e093c035a0

Merge changes made in Gnus trunk. nnimap.el (nnimap-request-group): Use the stored info for the dont-check case. nnimap.el: Use deffoo instead of defun for interface functions. gnus-int.el (gnus-request-group): Take an optional `info' parameter. nnimap.el: Allow nnimap-request-group to do a complete marks sync on `M-g'. nnimap.el: Get credentials for numerical equivalents of the port numbers. gnus-html.el (gnus-html-wash-tags): Add support for i, b and u HTML tags. nnimap.el (nnimap-update-info): Extend the info so that we can set the marks. nnimap.el (nnimap-open-connection): Fix typo -- should be 'shell, not 'stream. nnimap.el: Allow PREAUTH nnimap connections to log in without credentials. nnimap.el (nnimap-update-info): Fix off-by-one error when concatenating ranges when doing a partial update. gnus-html.el (gnus-html-schedule-image-fetching): Use `url' rather than curl to retrieve images. nnimap.el (nnimap-update-info): When doing partial marks update, get the range update right. nnimap.el (nnimap-wait-for-response): Be a bit more lax in finding the end of the command we're looking for. nnimap.el: Allow sending \n instead of \r\n on 'shell streams. gnus-html.el (gnus-html-schedule-image-fetching): Fetch all images in parallel.

author	Katsumi Yamaoka <yamaoka@jpl.org>
date	Sat, 18 Sep 2010 23:36:29 +0000
parents	bde55f3d7125
children	6060b86fc551

comparison

equal deleted inserted replaced

-:fac7cd0d50e0
+:93e093c035a0
 "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-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'.")
 (defstruct nnimap
-group process commands capabilities)
+group process commands capabilities select-result newlinep)
 (defvar nnimap-object nil)
 (defvar nnimap-mark-alist
 '((read "\\Seen")
 (defvar nnimap-split-methods nil)
 (defun nnimap-buffer ()
 (nnimap-find-process-buffer nntp-server-buffer))
-(defun nnimap-retrieve-headers (articles &optional group server fetch-old)
+(deffoo nnimap-retrieve-headers (articles &optional group server fetch-old)
 (with-current-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))
 	     (format "%d:%d" (car elem) (cdr elem))
 	   (number-to-string elem))
 	 result))
 (mapconcat #'identity (nreverse result) ",")))))
-(defun nnimap-open-server (server &optional defs)
+(deffoo nnimap-open-server (server &optional defs)
 (if (nnimap-server-opened server)
 t
 (unless (assq 'nnimap-address defs)
 (setq defs (append defs (list (list 'nnimap-address server)))))
 (nnoo-change-server 'nnimap server defs)
 				 (format-spec-make
 				  ?s host
 				  ?p port)))))
 process))
+(defun nnimap-credentials (address ports)
+(let (port credentials)
+;; Request the credentials from all ports, but only query on the
+;; last port if all the previous ones have failed.
+(while (and (null credentials)
+		(setq port (pop ports)))
+(setq credentials
+	    (auth-source-user-or-password
+	     '("login" "password") address port nil (null ports))))
+credentials))
 (defun nnimap-open-connection (buffer)
 (with-current-buffer (nnimap-make-process-buffer buffer)
 (let* ((coding-system-for-read 'binary)
 	   (coding-system-for-write 'binary)
-	   (credentials
+	   (ports
 	    (cond
 	     ((eq nnimap-stream 'network)
-	      (open-network-stream "*nnimap*" (current-buffer) nnimap-address
+	      (open-network-stream
-				   (or nnimap-server-port
+	       "*nnimap*" (current-buffer) nnimap-address
-				       (if (netrc-find-service-number "imap")
+	       (or nnimap-server-port
-					   "imap"
+		   (if (netrc-find-service-number "imap")
-					 "143")))
+		       "imap"
-	      (auth-source-user-or-password
+		     "143")))
-	       '("login" "password") nnimap-address "imap" nil t))
+	      '("143" "imap"))
-	     ((eq nnimap-stream 'stream)
+	     ((eq nnimap-stream 'shell)
 	      (nnimap-open-shell-stream
 	       "*nnimap*" (current-buffer) nnimap-address
 	       (or nnimap-server-port "imap"))
-	      (auth-source-user-or-password
+	      '("imap"))
-	       '("login" "password") nnimap-address "imap" nil t))
 	     ((eq nnimap-stream 'ssl)
-	      (open-tls-stream "*nnimap*" (current-buffer) nnimap-address
+	      (open-tls-stream
-			       (or nnimap-server-port
+	       "*nnimap*" (current-buffer) nnimap-address
-				   (if (netrc-find-service-number "imaps")
+	       (or nnimap-server-port
-				       "imaps"
+		   (if (netrc-find-service-number "imaps")
-				     "993")))
+		       "imaps"
-	      (or
+		     "993")))
-	       (auth-source-user-or-password
+	      '("143" "993" "imap" "imaps"))))
-		'("login" "password") nnimap-address "imap")
+	   connection-result login-result credentials)
-	       (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)))
 (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"
+	(when (setq connection-result (nnimap-wait-for-connection))
-				      (car credentials) (cadr credentials))))
+	  (unless (equal connection-result "PREAUTH")
-	  (if (not (car result))
+	    (if (not (setq credentials
-	      (progn
+			   (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)
 		(delete-process (nnimap-process nnimap-object))
-		nil)
+		(setq nnimap-object nil))))
+	  (when nnimap-object
+	    (when (eq nnimap-stream 'shell)
+	      (setf (nnimap-newlinep nnimap-object) t))
 	    (setf (nnimap-capabilities nnimap-object)
 		  (mapcar
 		   #'upcase
-		   (or (nnimap-find-parameter "CAPABILITY" (cdr result))
+		   (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))))))
 	     (consp (cadr elem))
 	     (equal (caadr elem) parameter))
 	(setq result (cdr (cadr elem))))))
 result))
-(defun nnimap-close-server (&optional server)
+(deffoo nnimap-close-server (&optional server)
 t)
-(defun nnimap-request-close ()
+(deffoo nnimap-request-close ()
 t)
-(defun nnimap-server-opened (&optional server)
+(deffoo nnimap-server-opened (&optional server)
 (and (nnoo-current-server-p 'nnimap server)
 nntp-server-buffer
 (gnus-buffer-live-p nntp-server-buffer)
 (nnimap-find-connection nntp-server-buffer)))
-(defun nnimap-status-message (&optional server)
+(deffoo nnimap-status-message (&optional server)
 nnimap-status-string)
-(defun nnimap-request-article (article &optional group server to-buffer)
+(deffoo nnimap-request-article (article &optional group server to-buffer)
 (with-current-buffer nntp-server-buffer
 (let ((result (nnimap-possibly-change-group group server)))
 (when (stringp article)
 	(setq article (nnimap-find-article-by-message-id group article)))
 (when (and result
 		(goto-char (+ (point) bytes))
 		(delete-region (point) (point-max))
 		(nnheader-ms-strip-cr))
 	      t)))))))
-(defun nnimap-request-group (group &optional server dont-check)
+(deffoo nnimap-request-group (group &optional server dont-check info)
 (with-current-buffer nntp-server-buffer
 (let ((result (nnimap-possibly-change-group group server))
-	  articles)
+	  articles active marks high low)
 (when result
-	(setq articles (nnimap-get-flags "1:*"))
+	(if (and dont-check
-	(erase-buffer)
+		 (setq active (nth 2 (assoc group nnimap-current-infos))))
-	(insert
+	    (insert (format "211 %d %d %d %S\n"
-	 (format
+			    (- (cdr active) (car active))
-	  "211 %d %d %d %S\n"
+			    (car active)
-	  (length articles)
+			    (cdr active)
-	  (or (caar articles) 0)
+			    group))
-	  (or (caar (last articles)) 0)
+	  (with-current-buffer (nnimap-buffer)
-	  group))
+	    (erase-buffer)
-	t))))
+	    (let ((group-sequence
+		   (nnimap-send-command "SELECT %S" (utf7-encode group)))
+		  (flag-sequence
+		   (nnimap-send-command "UID FETCH 1:* FLAGS")))
+	      (nnimap-wait-for-response flag-sequence)
+	      (setq marks
+		    (nnimap-flags-to-marks
+		     (nnimap-parse-flags
+		      (list (list group-sequence flag-sequence 1 group)))))
+	      (when info
+		(nnimap-update-infos marks (list info)))
+	      (goto-char (point-max))
+	      (cond
+	       (marks
+		(setq high (nth 3 (car marks))
+		      low (nth 4 (car marks))))
+	       ((re-search-backward "UIDNEXT \\([0-9]+\\)" nil t)
+		(setq high (string-to-number (match-string 1))
+		      low 1)))))
+	  (erase-buffer)
+	  (insert
+	   (format
+	    "211 %d %d %d %S\n"
+	    (1+ (- high low))
+	    low high group))))
+t)))
 (defun nnimap-get-flags (spec)
 (let ((articles nil)
 	elems)
 (with-current-buffer (nnimap-buffer)
 	(push (cons (string-to-number (cadr (member "UID" elems)))
 		    (cadr (member "FLAGS" elems)))
 	      articles)))
 (nreverse articles)))
-(defun nnimap-close-group (group &optional server)
+(deffoo nnimap-close-group (group &optional server)
 t)
 (deffoo nnimap-request-move-article (article group server accept-form
 					     &optional last internal-move-group)
 (when (nnimap-possibly-change-group group server)
 (dolist (mark marks)
 (when (setq flag (cadr (assq mark nnimap-mark-alist)))
 	(push flag flags)))
 flags))
-(defun nnimap-request-set-mark (group actions &optional server)
+(deffoo nnimap-request-set-mark (group actions &optional server)
 (when (nnimap-possibly-change-group group server)
 (let (sequence)
 (with-current-buffer (nnimap-buffer)
 	;; Just send all the STORE commands without waiting for
 	;; response.  If they're successful, they're successful.
 (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")
+	(process-send-string (get-buffer-process (current-buffer))
+			     (if (nnimap-newlinep nnimap-object)
+				 "\n"
+			       "\r\n"))
 	(let ((result (nnimap-get-response sequence)))
 	  (when result
 	    (cons group
 		  (nnimap-find-article-by-message-id group message-id))))))))
 		   (not (and (caadr line)
 			     (string-match "noselect" (caadr line)))))
 	  (push (car (last line)) groups)))
 (nreverse groups))))
-(defun nnimap-request-list (&optional server)
+(deffoo nnimap-request-list (&optional server)
 (nnimap-possibly-change-group nil server)
 (with-current-buffer nntp-server-buffer
 (erase-buffer)
 (let ((groups
 	   (with-current-buffer (nnimap-buffer)
 		  ;; Return the widest possible range.
 		  (insert (format "%S %d 1 y\n" (utf7-decode group t)
 				  (or highest exists)))))))))
 	t))))
-(defun nnimap-retrieve-group-data-early (server infos)
+(deffoo nnimap-retrieve-group-data-early (server infos)
 (when (nnimap-possibly-change-group nil server)
 (with-current-buffer (nnimap-buffer)
 ;; QRESYNC handling isn't implemented.
 (let ((qresyncp (member "notQRESYNC" (nnimap-capabilities nnimap-object)))
 	    marks groups sequences)
 			  start
 			  (car elem))
 		    sequences))))
 	sequences))))
-(defun nnimap-finish-retrieve-group-infos (server infos sequences)
+(deffoo nnimap-finish-retrieve-group-infos (server infos sequences)
 (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))
 	       (read (gnus-range-difference
 		      (cons start-article high) unread)))
 	  (when (> start-article 1)
 	    (setq read
 		  (gnus-range-nconcat
-		   (gnus-sorted-range-intersection
+		   (if (> start-article 1)
-		    (cons 1 start-article)
+		       (gnus-sorted-range-intersection
-		    (gnus-info-read info))
+			(cons 1 (1- start-article))
+			(gnus-info-read info))
+		     (gnus-info-read info))
 		   read)))
 	  (gnus-info-set-read info read)
 	  ;; Update the marks.
 	  (setq marks (gnus-info-marks info))
 	  ;; Note the active level for the next run-through.
 	      (setq marks (delq old-marks marks))
 	      (pop old-marks)
 	      (when (and old-marks
 			 (> start-article 1))
 		(setq old-marks (gnus-range-difference
-				 (cons start-article high)
+				 old-marks
-				 old-marks))
+				 (cons start-article high)))
 		(setq new-marks (gnus-range-nconcat old-marks new-marks)))
 	      (when new-marks
 		(push (cons (car type) new-marks) marks)))
-	    (gnus-info-set-marks info marks)))))))
+	    (gnus-info-set-marks info marks t)
+	    (nnimap-store-info info (gnus-active group))))))))
+(defun nnimap-store-info (info active)
+(let* ((group (gnus-group-real-name (gnus-info-group info)))
+	 (entry (assoc group nnimap-current-infos)))
+(if entry
+	(setcdr entry (list info active))
+(push (list group info active) nnimap-current-infos))))
 (defun nnimap-flags-to-marks (groups)
 (let (data group totalp uidnext articles start-article mark)
 (dolist (elem groups)
 (setq group (car elem)
 groups))
 (defun nnimap-find-process-buffer (buffer)
 (cadr (assoc buffer nnimap-connection-alist)))
-(defun nnimap-request-post (&optional server)
+(deffoo nnimap-request-post (&optional server)
 (setq nnimap-status-string "Read-only server")
 nil)
 (defun nnimap-possibly-change-group (group server)
 (let ((open-result 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)
+	      (setf (nnimap-group nnimap-object) group
+		    (nnimap-select-result nnimap-object) result)
 	      result))))))))
 (defun nnimap-find-connection (buffer)
 "Find the connection delivering to BUFFER."
 (let ((entry (assoc buffer nnimap-connection-alist)))
 (defun nnimap-send-command (&rest args)
 (process-send-string
 (get-buffer-process (current-buffer))
 (nnimap-log-command
-(format "%d %s\r\n"
+(format "%d %s%s\n"
 	    (incf nnimap-sequence)
-	    (apply #'format args))))
+	    (apply #'format args)
+	    (if (nnimap-newlinep nnimap-object)
+		""
+	      "\r"))))
 nnimap-sequence)
 (defun nnimap-log-command (command)
 (with-current-buffer (get-buffer-create "*imap log*")
 (goto-char (point-max))
 (defun nnimap-get-response (sequence)
 (nnimap-wait-for-response sequence)
 (nnimap-parse-response))
+(defun nnimap-wait-for-connection ()
+(let ((process (get-buffer-process (current-buffer))))
+(goto-char (point-min))
+(while (and (memq (process-status process)
+		      '(open run))
+		(not (re-search-forward "^\\* " nil t)))
+(nnheader-accept-process-output process)
+(goto-char (point-min)))
+(and (looking-at "[A-Z0-9]+")
+	 (match-string 0))))
 (defun nnimap-wait-for-response (sequence &optional messagep)
 (goto-char (point-max))
-(while (or (bobp)
+(while (not (re-search-backward (format "^%d .*\n" sequence)
-	     (progn
+				  (max (point-min) (- (point) 500))
-	       (forward-line -1)
+				  t))
-	       (not (looking-at (format "^%d .*\n" sequence)))))
 (when messagep
 (message "Read %dKB" (/ (buffer-size) 1000)))
 (nnheader-accept-process-output (get-buffer-process (current-buffer)))
 (goto-char (point-max))))

Mercurial > emacs

comparison lisp/gnus/nnimap.el @ 110422:93e093c035a0