X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/5009803bda518652cc6f4b9fba02c0aed185c2a3..6651c01506b4c903a8e473544ee4f7af9c555bca:/lisp/gnus/pop3.el diff --git a/lisp/gnus/pop3.el b/lisp/gnus/pop3.el index e29ddb0d44..25330989e0 100644 --- a/lisp/gnus/pop3.el +++ b/lisp/gnus/pop3.el @@ -1,6 +1,6 @@ ;;; pop3.el --- Post Office Protocol (RFC 1460) interface -;; Copyright (C) 1996-2011 Free Software Foundation, Inc. +;; Copyright (C) 1996-2012 Free Software Foundation, Inc. ;; Author: Richard L. Pieri ;; Maintainer: FSF @@ -167,23 +167,45 @@ Use streaming commands." (defun pop3-send-streaming-command (process command count total-size) (erase-buffer) - (let ((i 1)) + (let ((i 1) + (start-point (point-min)) + (waited-for 0)) (while (>= count i) (process-send-string process (format "%s %d\r\n" command i)) ;; Only do 100 messages at a time to avoid pipe stalls. (when (zerop (% i pop3-stream-length)) - (pop3-wait-for-messages process i total-size)) - (incf i))) - (pop3-wait-for-messages process count total-size)) - -(defun pop3-wait-for-messages (process count total-size) - (while (< (pop3-number-of-responses total-size) count) + (setq start-point + (pop3-wait-for-messages process pop3-stream-length + total-size start-point)) + (incf waited-for pop3-stream-length)) + (incf i)) + (pop3-wait-for-messages process (- count waited-for) + total-size start-point))) + +(defun pop3-wait-for-messages (process count total-size start-point) + (while (> count 0) + (goto-char start-point) + (while (or (and (re-search-forward "^\\+OK" nil t) + (or (not total-size) + (re-search-forward "^\\.\r?\n" nil t))) + (re-search-forward "^-ERR " nil t)) + (decf count) + (setq start-point (point))) + (unless (memq (process-status process) '(open run)) + (error "pop3 process died")) (when total-size - (message "pop3 retrieved %dKB (%d%%)" - (truncate (/ (buffer-size) 1000)) - (truncate (* (/ (* (buffer-size) 1.0) - total-size) 100)))) - (pop3-accept-process-output process))) + (let ((size 0)) + (goto-char (point-min)) + (while (re-search-forward "^\\+OK.*\n" nil t) + (setq size (+ size (- (point)) + (if (re-search-forward "^\\.\r?\n" nil 'move) + (match-beginning 0) + (point))))) + (message "pop3 retrieved %dKB (%d%%)" + (truncate (/ size 1000)) + (truncate (* (/ (* size 1.0) total-size) 100))))) + (pop3-accept-process-output process)) + start-point) (defun pop3-write-to-file (file) (let ((pop-buffer (current-buffer)) @@ -217,17 +239,6 @@ Use streaming commands." (delete-char 1)) (write-region (point-min) (point-max) file nil 'nomesg))))) -(defun pop3-number-of-responses (endp) - (let ((responses 0)) - (save-excursion - (goto-char (point-min)) - (while (or (and (re-search-forward "^\\+OK" nil t) - (or (not endp) - (re-search-forward "^\\.\r?\n" nil t))) - (re-search-forward "^-ERR " nil t)) - (incf responses))) - responses)) - (defun pop3-logon (process) (let ((pop3-password pop3-password)) ;; for debugging only @@ -265,11 +276,11 @@ Use streaming commands." message-count)) (defcustom pop3-stream-type nil - "*Transport security type for POP3 connexions. -This may be either nil (plain connexion), `ssl' (use an + "*Transport security type for POP3 connections. +This may be either nil (plain connection), `ssl' (use an SSL/TSL-secured stream) or `starttls' (use the starttls mechanism to turn on TLS security after opening the stream). However, if -this is nil, `ssl' is assumed for connexions to port +this is nil, `ssl' is assumed for connections to port 995 (pop3s)." :version "23.1" ;; No Gnus :group 'pop3 @@ -306,7 +317,7 @@ Returns the process associated with the connection." (t (or pop3-stream-type 'network))) :capability-command "CAPA\r\n" - :end-of-command "^\\(-ERR\\|+OK \\).*\n" + :end-of-command "^\\(-ERR\\|+OK\\).*\n" :end-of-capability "^\\.\r?\n\\|^-ERR" :success "^\\+OK.*\n" :return-list t