X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fpop3.el;h=4d9dfdaf2aa650034a77a752a2b496fc19326132;hp=20f7ba34b3cd5556118700f0cdb1c0c9d93880c5;hb=d8b872b8a3b98292e6f3e81f5d40ba263c55ce2b;hpb=660680f231d4dfc948038a554600e90c6a99dea2 diff --git a/lisp/pop3.el b/lisp/pop3.el index 20f7ba34b..4d9dfdaf2 100644 --- a/lisp/pop3.el +++ b/lisp/pop3.el @@ -1,10 +1,9 @@ ;;; pop3.el --- Post Office Protocol (RFC 1460) interface -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, -;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1996-2015 Free Software Foundation, Inc. ;; Author: Richard L. Pieri -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Keywords: mail ;; This file is part of GNU Emacs. @@ -33,6 +32,14 @@ ;;; Code: +(eval-when-compile (require 'cl)) + +(eval-and-compile + ;; In Emacs 24, `open-protocol-stream' is an autoloaded alias for + ;; `make-network-stream'. + (unless (fboundp 'open-protocol-stream) + (require 'proto-stream))) + (require 'mail-utils) (defvar parse-time-months) @@ -81,28 +88,64 @@ valid value is 'apop'." :version "22.1" ;; Oort Gnus :group 'pop3) +(defcustom pop3-stream-length 100 + "How many messages should be requested at one time. +The lower the number, the more latency-sensitive the fetching +will be. If your pop3 server doesn't support streaming at all, +set this to 1." + :type 'number + :version "24.1" + :group 'pop3) + (defcustom pop3-leave-mail-on-server nil - "*Non-nil if the mail is to be left on the POP server after fetching. - -If `pop3-leave-mail-on-server' is non-nil the mail is to be left -on the POP server after fetching. Note that POP servers maintain -no state information between sessions, so what the client -believes is there and what is actually there may not match up. -If they do not, then you may get duplicate mails or the whole -thing can fall apart and leave you with a corrupt mailbox." - ;; We can't use the UILD support from XEmacs mail-lib or cvs.m17n.org: - ;; http://thread.gmane.org/v9lld8fml4.fsf@marauder.physik.uni-ulm.de - ;; http://thread.gmane.org/b9yy8hzy9ej.fsf@jpl.org - ;; Any volunteer to re-implement this? - :version "22.1" ;; Oort Gnus - :type 'boolean + "Non-nil if the mail is to be left on the POP server after fetching. +Mails once fetched will never be fetched again by the UIDL control. + +If this is neither nil nor a number, all mails will be left on the +server. If this is a number, leave mails on the server for this many +days since you first checked new mails. If this is nil, mails will be +deleted on the server right after fetching. + +Gnus users should use the `:leave' keyword in a mail source to direct +the behavior per server, rather than directly modifying this value. + +Note that POP servers maintain no state information between sessions, +so what the client believes is there and what is actually there may +not match up. If they do not, then you may get duplicate mails or +the whole thing can fall apart and leave you with a corrupt mailbox." + :version "24.4" + :type '(choice (const :tag "Don't leave mails" nil) + (const :tag "Leave all mails" t) + (number :tag "Leave mails for this many days" :value 14)) :group 'pop3) -(defcustom pop3-display-message-size-flag t - "*If non-nil, display the size of the message that is being fetched." - :version "22.1" ;; Oort Gnus - :type 'boolean - :group 'pop3) +(defcustom pop3-uidl-file "~/.pop3-uidl" + "File used to save UIDL." + :version "24.4" + :type 'file + :group 'pop3) + +(defcustom pop3-uidl-file-backup '(0 9) + "How to backup the UIDL file `pop3-uidl-file' when updating. +If it is a list of numbers, the first one binds `kept-old-versions' and +the other binds `kept-new-versions' to keep number of oldest and newest +versions. Otherwise, the value binds `version-control' (which see). + +Note: Backup will take place whenever you check new mails on a server. +So, you may lose the backup files having been saved before a trouble +if you set it so as to make too few backups whereas you have access to +many servers." + :version "24.4" + :type '(choice (group :tag "Keep versions" :format "\n%v" :indent 3 + (number :tag "oldest") + (number :tag "newest")) + (sexp :format "%v" + :match (lambda (widget value) + (condition-case nil + (not (and (numberp (car value)) + (numberp (car (cdr value))))) + (error t))))) + :group 'pop3) (defvar pop3-timestamp nil "Timestamp returned when initially connected to the POP server. @@ -120,7 +163,7 @@ Used for APOP authentication.") (defalias 'pop3-accept-process-output 'nnheader-accept-process-output) ;; Borrowed from `nnheader.el': (defvar pop3-read-timeout - (if (string-match "windows-nt\\|os/2\\|emx\\|cygwin" + (if (string-match "windows-nt\\|os/2\\|cygwin" (symbol-name system-type)) 1.0 0.01) @@ -134,15 +177,137 @@ Shorter values mean quicker response, but are more CPU intensive.") (truncate pop3-read-timeout)) 1000)))))) -(defun pop3-movemail (&optional crashbox) - "Transfer contents of a maildrop to the specified CRASHBOX." - (or crashbox (setq crashbox (expand-file-name "~/.crashbox"))) - (let* ((process (pop3-open-server pop3-mailhost pop3-port)) - (crashbuf (get-buffer-create " *pop3-retr*")) - (n 1) - message-count - message-sizes - (pop3-password pop3-password)) +(defvar pop3-uidl) +;; List of UIDLs of existing messages at present in the server: +;; ("UIDL1" "UIDL2" "UIDL3"...) + +(defvar pop3-uidl-saved) +;; Locally saved UIDL data; an alist of the server, the user, and the UIDL +;; and timestamp pairs: +;; (("SERVER_A" ("USER_A1" "UIDL1" TIMESTAMP1 "UIDL2" TIMESTAMP2...) +;; ("USER_A2" "UIDL1" TIMESTAMP1 "UIDL2" TIMESTAMP2...) +;; ...) +;; ("SERVER_B" ("USER_B1" "UIDL1" TIMESTAMP1 "UIDL2" TIMESTAMP2...) +;; ("USER_B2" "UIDL1" TIMESTAMP1 "UIDL2" TIMESTAMP2...) +;; ...)) +;; Where TIMESTAMP is the most significant two digits of an Emacs time, +;; i.e. the return value of `current-time'. + +;;;###autoload +(defun pop3-movemail (file) + "Transfer contents of a maildrop to the specified FILE. +Use streaming commands." + (let ((process (pop3-open-server pop3-mailhost pop3-port)) + messages total-size + pop3-uidl + pop3-uidl-saved) + (pop3-logon process) + (if pop3-leave-mail-on-server + (setq messages (pop3-uidl-stat process) + total-size (cadr messages) + messages (car messages)) + (let ((size (pop3-stat process))) + (dotimes (i (car size)) (push (1+ i) messages)) + (setq messages (nreverse messages) + total-size (cadr size)))) + (when messages + (with-current-buffer (process-buffer process) + (pop3-send-streaming-command process "RETR" messages total-size) + (pop3-write-to-file file messages) + (unless pop3-leave-mail-on-server + (pop3-send-streaming-command process "DELE" messages nil)))) + (if pop3-leave-mail-on-server + (when (prog1 (pop3-uidl-dele process) (pop3-quit process)) + (pop3-uidl-save)) + (pop3-quit process) + ;; Remove UIDL data for the account that got not to leave mails. + (setq pop3-uidl-saved (pop3-uidl-load)) + (let ((elt (assoc pop3-maildrop + (cdr (assoc pop3-mailhost pop3-uidl-saved))))) + (when elt + (setcdr elt nil) + (pop3-uidl-save)))) + t)) + +(defun pop3-send-streaming-command (process command messages total-size) + (erase-buffer) + (let ((count (length messages)) + (i 1) + (start-point (point-min)) + (waited-for 0)) + (while messages + (process-send-string process (format "%s %d\r\n" command (pop messages))) + ;; Only do 100 messages at a time to avoid pipe stalls. + (when (zerop (% i pop3-stream-length)) + (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 + (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 messages) + (let ((pop-buffer (current-buffer)) + (start (point-min)) + beg end + temp-buffer) + (with-temp-buffer + (setq temp-buffer (current-buffer)) + (with-current-buffer pop-buffer + (goto-char (point-min)) + (while (re-search-forward "^\\+OK" nil t) + (forward-line 1) + (setq beg (point)) + (when (re-search-forward "^\\.\r?\n" nil t) + (setq start (point)) + (forward-line -1) + (setq end (point))) + (with-current-buffer temp-buffer + (goto-char (point-max)) + (let ((hstart (point))) + (insert-buffer-substring pop-buffer beg end) + (pop3-clean-region hstart (point)) + (goto-char (point-max)) + (pop3-munge-message-separator hstart (point)) + (when pop3-leave-mail-on-server + (pop3-uidl-add-xheader hstart (pop messages))) + (goto-char (point-max)))))) + (let ((coding-system-for-write 'binary)) + (goto-char (point-min)) + ;; Check whether something inserted a newline at the start and + ;; delete it. + (when (eolp) + (delete-char 1)) + (write-region (point-min) (point-max) file nil 'nomesg))))) + +(defun pop3-logon (process) + (let ((pop3-password pop3-password)) ;; for debugging only (if pop3-debug (switch-to-buffer (process-buffer process))) ;; query for password @@ -154,42 +319,7 @@ Shorter values mean quicker response, but are more CPU intensive.") ((equal 'pass pop3-authentication-scheme) (pop3-user process pop3-maildrop) (pop3-pass process)) - (t (error "Invalid POP3 authentication scheme"))) - (setq message-count (car (pop3-stat process))) - (when (and pop3-display-message-size-flag - (> message-count 0)) - (setq message-sizes (pop3-list process))) - (unwind-protect - (while (<= n message-count) - (if pop3-display-message-size-flag - (message "Retrieving message %d of %d from %s... (%.1fk)" - n message-count pop3-mailhost - (/ (cdr (assoc n message-sizes)) - 1024.0)) - (message "Retrieving message %d of %d from %s..." - n message-count pop3-mailhost)) - (pop3-retr process n crashbuf) - (save-excursion - (set-buffer crashbuf) - (let ((coding-system-for-write 'binary)) - (write-region (point-min) (point-max) crashbox t 'nomesg)) - (set-buffer (process-buffer process)) - (while (> (buffer-size) 5000) - (goto-char (point-min)) - (forward-line 50) - (delete-region (point-min) (point)))) - (unless pop3-leave-mail-on-server - (pop3-dele process n)) - (setq n (+ 1 n)) - (pop3-accept-process-output process)) - (when (and pop3-leave-mail-on-server - (> n 1)) - (message "pop3.el doesn't support UIDL. Setting `pop3-leave-mail-on-server' -to %s might not give the result you'd expect." pop3-leave-mail-on-server) - (sit-for 1)) - (pop3-quit process)) - (kill-buffer crashbuf)) - t) + (t (error "Invalid POP3 authentication scheme"))))) (defun pop3-get-message-count () "Return the number of messages in the maildrop." @@ -212,16 +342,190 @@ to %s might not give the result you'd expect." pop3-leave-mail-on-server) (pop3-quit process) message-count)) -(autoload 'open-tls-stream "tls") -(autoload 'starttls-open-stream "starttls") -(autoload 'starttls-negotiate "starttls") ; avoid warning +(defun pop3-uidl-stat (process) + "Return a list of unread message numbers and total size." + (pop3-send-command process "UIDL") + (let (err messages size) + (if (condition-case code + (progn + (pop3-read-response process) + t) + (error (setq err (error-message-string code)) + nil)) + (let ((start pop3-read-point) + saved list) + (with-current-buffer (process-buffer process) + (while (not (re-search-forward "^\\.\r\n" nil t)) + (unless (memq (process-status process) '(open run)) + (error "pop3 server closed the connection")) + (pop3-accept-process-output process) + (goto-char start)) + (setq pop3-read-point (point-marker) + pop3-uidl nil) + (while (progn (forward-line -1) (>= (point) start)) + (when (looking-at "[0-9]+ \\([^\n\r ]+\\)") + (push (match-string 1) pop3-uidl))) + (when pop3-uidl + (setq pop3-uidl-saved (pop3-uidl-load) + saved (cdr (assoc pop3-maildrop + (cdr (assoc pop3-mailhost + pop3-uidl-saved))))) + (let ((i (length pop3-uidl))) + (while (> i 0) + (unless (member (nth (1- i) pop3-uidl) saved) + (push i messages)) + (decf i))) + (when messages + (setq list (pop3-list process) + size 0) + (dolist (msg messages) + (setq size (+ size (cdr (assq msg list))))) + (list messages size))))) + (message "%s doesn't support UIDL (%s), so we try a regressive way..." + pop3-mailhost err) + (sit-for 1) + (setq size (pop3-stat process)) + (dotimes (i (car size)) (push (1+ i) messages)) + (setcar size (nreverse messages)) + size))) + +(defun pop3-uidl-dele (process) + "Delete messages according to `pop3-leave-mail-on-server'. +Return non-nil if it is necessary to update the local UIDL file." + (let* ((ctime (current-time)) + (srvr (assoc pop3-mailhost pop3-uidl-saved)) + (saved (assoc pop3-maildrop (cdr srvr))) + i uidl mod new tstamp dele) + (setcdr (cdr ctime) nil) + ;; Add new messages to the data to be saved. + (cond ((and pop3-uidl saved) + (setq i (1- (length pop3-uidl))) + (while (>= i 0) + (unless (member (setq uidl (nth i pop3-uidl)) (cdr saved)) + (push ctime new) + (push uidl new)) + (decf i))) + (pop3-uidl + (setq new (apply 'nconc (mapcar (lambda (elt) (list elt ctime)) + pop3-uidl))))) + (when new (setq mod t)) + ;; List expirable messages and delete them from the data to be saved. + (setq ctime (when (numberp pop3-leave-mail-on-server) + (/ (+ (* (car ctime) 65536.0) (cadr ctime)) 86400)) + i (1- (length saved))) + (while (> i 0) + (if (member (setq uidl (nth (1- i) saved)) pop3-uidl) + (progn + (setq tstamp (nth i saved)) + (if (and ctime + (> (- ctime (/ (+ (* (car tstamp) 65536.0) (cadr tstamp)) + 86400)) + pop3-leave-mail-on-server)) + ;; Mails to delete. + (progn + (setq mod t) + (push uidl dele)) + ;; Mails to keep. + (push tstamp new) + (push uidl new))) + ;; Mails having been deleted in the server. + (setq mod t)) + (decf i 2)) + (cond (saved + (setcdr saved new)) + (srvr + (setcdr (last srvr) (list (cons pop3-maildrop new)))) + (t + (add-to-list 'pop3-uidl-saved + (list pop3-mailhost (cons pop3-maildrop new)) + t))) + ;; Actually delete the messages in the server. + (when dele + (setq uidl nil + i (length pop3-uidl)) + (while (> i 0) + (when (member (nth (1- i) pop3-uidl) dele) + (push i uidl)) + (decf i)) + (when uidl + (pop3-send-streaming-command process "DELE" uidl nil))) + mod)) + +(defun pop3-uidl-load () + "Load saved UIDL." + (when (file-exists-p pop3-uidl-file) + (with-temp-buffer + (condition-case code + (progn + (insert-file-contents pop3-uidl-file) + (goto-char (point-min)) + (read (current-buffer))) + (error + (message "Error while loading %s (%s)" + pop3-uidl-file (error-message-string code)) + (sit-for 1) + nil))))) + +(defun pop3-uidl-save () + "Save UIDL." + (with-temp-buffer + (if pop3-uidl-saved + (progn + (insert "(") + (dolist (srvr pop3-uidl-saved) + (when (cdr srvr) + (insert "(\"" (pop srvr) "\"\n ") + (dolist (elt srvr) + (when (cdr elt) + (insert "(\"" (pop elt) "\"\n ") + (while elt + (insert (format "\"%s\" %s\n " (pop elt) (pop elt)))) + (delete-char -4) + (insert ")\n "))) + (delete-char -3) + (if (eq (char-before) ?\)) + (insert ")\n ") + (goto-char (1+ (point-at-bol))) + (delete-region (point) (point-max))))) + (when (eq (char-before) ? ) + (delete-char -2)) + (insert ")\n")) + (insert "()\n")) + (let ((buffer-file-name pop3-uidl-file) + (delete-old-versions t) + (kept-new-versions kept-new-versions) + (kept-old-versions kept-old-versions) + (version-control version-control)) + (if (consp pop3-uidl-file-backup) + (setq kept-new-versions (cadr pop3-uidl-file-backup) + kept-old-versions (car pop3-uidl-file-backup) + version-control t) + (setq version-control pop3-uidl-file-backup)) + (save-buffer)))) + +(defun pop3-uidl-add-xheader (start msgno) + "Add X-UIDL header." + (let ((case-fold-search t)) + (save-restriction + (narrow-to-region start (progn + (goto-char start) + (search-forward "\n\n" nil 'move) + (1- (point)))) + (goto-char start) + (while (re-search-forward "^x-uidl:" nil t) + (while (progn + (forward-line 1) + (memq (char-after) '(?\t ? )))) + (delete-region (match-beginning 0) (point))) + (goto-char (point-max)) + (insert "X-UIDL: " (nth (1- msgno) pop3-uidl) "\n")))) (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 @@ -229,76 +533,55 @@ this is nil, `ssl' is assumed for connexions to port (const :tag "SSL/TLS" ssl) (const starttls))) +(eval-and-compile + (if (fboundp 'set-process-query-on-exit-flag) + (defalias 'pop3-set-process-query-on-exit-flag + 'set-process-query-on-exit-flag) + (defalias 'pop3-set-process-query-on-exit-flag + 'process-kill-without-query))) + (defun pop3-open-server (mailhost port) "Open TCP connection to MAILHOST on PORT. Returns the process associated with the connection." (let ((coding-system-for-read 'binary) (coding-system-for-write 'binary) - process) - (save-excursion - (set-buffer (get-buffer-create (concat " trace of POP session to " - mailhost))) + result) + (with-current-buffer + (get-buffer-create (concat " trace of POP session to " + mailhost)) (erase-buffer) (setq pop3-read-point (point-min)) - (setq process - (cond - ((or (eq pop3-stream-type 'ssl) - (and (not pop3-stream-type) (member port '(995 "pop3s")))) - ;; gnutls-cli, openssl don't accept service names - (if (or (equal port "pop3s") - (null port)) - (setq port 995)) - (let ((process (open-tls-stream "POP" (current-buffer) - mailhost port))) - (when process - ;; There's a load of info printed that needs deleting. - (let ((again 't)) - ;; repeat until - ;; - either we received the +OK line - ;; - or accept-process-output timed out without getting - ;; anything - (while (and again - (setq again (memq (process-status process) - '(open run)))) - (setq again (pop3-accept-process-output process)) - (goto-char (point-max)) - (forward-line -1) - (cond ((looking-at "\\+OK") - (setq again nil) - (delete-region (point-min) (point))) - ((not again) - (pop3-quit process) - (error "POP SSL connexion failed"))))) - process))) - ((eq pop3-stream-type 'starttls) - ;; gnutls-cli, openssl don't accept service names - (if (equal port "pop3") - (setq port 110)) - (let ((process (starttls-open-stream "POP" (current-buffer) - mailhost (or port 110)))) - (pop3-send-command process "STLS") - (let ((response (pop3-read-response process t))) - (if (and response (string-match "+OK" response)) - (starttls-negotiate process) - (pop3-quit process) - (error "POP server doesn't support starttls"))) - process)) - (t - (open-network-stream "POP" (current-buffer) mailhost port)))) - (let ((response (pop3-read-response process t))) - (setq pop3-timestamp - (substring response (or (string-match "<" response) 0) - (+ 1 (or (string-match ">" response) -1))))) - process))) + (setq result + (open-protocol-stream + "POP" (current-buffer) mailhost port + :type (cond + ((or (eq pop3-stream-type 'ssl) + (and (not pop3-stream-type) + (member port '(995 "pop3s")))) + 'tls) + (t + (or pop3-stream-type 'network))) + :warn-unless-encrypted t + :capability-command "CAPA\r\n" + :end-of-command "^\\(-ERR\\|+OK\\).*\n" + :end-of-capability "^\\.\r?\n\\|^-ERR" + :success "^\\+OK.*\n" + :return-list t + :starttls-function + (lambda (capabilities) + (and (string-match "\\bSTLS\\b" capabilities) + "STLS\r\n")))) + (when result + (let ((response (plist-get (cdr result) :greeting))) + (setq pop3-timestamp + (substring response (or (string-match "<" response) 0) + (+ 1 (or (string-match ">" response) -1))))) + (pop3-set-process-query-on-exit-flag (car result) nil) + (erase-buffer) + (car result))))) ;; Support functions -(defun pop3-process-filter (process output) - (save-excursion - (set-buffer (process-buffer process)) - (goto-char (point-max)) - (insert output))) - (defun pop3-send-command (process command) (set-buffer (process-buffer process)) (goto-char (point-max)) @@ -314,8 +597,7 @@ Returns the process associated with the connection." Return the response string if optional second argument is non-nil." (let ((case-fold-search nil) match-end) - (save-excursion - (set-buffer (process-buffer process)) + (with-current-buffer (process-buffer process) (goto-char pop3-read-point) (while (and (memq (process-status process) '(open run)) (not (search-forward "\r\n" nil t))) @@ -415,10 +697,7 @@ If NOW, use that time instead." nil (goto-char (point-max)) (insert "\n")) - (narrow-to-region (point) (point-max)) - (let ((size (- (point-max) (point-min)))) - (goto-char (point-min)) - (widen) + (let ((size (- (point-max) (point)))) (forward-line -1) (insert (format "Content-Length: %s\n" size))) ))))) @@ -468,15 +747,14 @@ If NOW, use that time instead." (defun pop3-list (process &optional msg) "If MSG is nil, return an alist of (MESSAGE-ID . SIZE) pairs. Otherwise, return the size of the message-id MSG" - (pop3-send-command process (if msg + (pop3-send-command process (if msg (format "LIST %d" msg) "LIST")) (let ((response (pop3-read-response process t))) (if msg (string-to-number (nth 2 (split-string response " "))) (let ((start pop3-read-point) end) - (save-excursion - (set-buffer (process-buffer process)) + (with-current-buffer (process-buffer process) (while (not (re-search-forward "^\\.\r\n" nil t)) (pop3-accept-process-output process) (goto-char start)) @@ -486,17 +764,17 @@ Otherwise, return the size of the message-id MSG" (mapcar #'(lambda (s) (let ((split (split-string s " "))) (cons (string-to-number (nth 0 split)) (string-to-number (nth 1 split))))) - (delete "" (split-string (buffer-substring start end) - "\r\n")))))))) + (split-string (buffer-substring start end) "\r\n" t))))))) (defun pop3-retr (process msg crashbuf) "Retrieve message-id MSG to buffer CRASHBUF." (pop3-send-command process (format "RETR %s" msg)) (pop3-read-response process) (let ((start pop3-read-point) end) - (save-excursion - (set-buffer (process-buffer process)) + (with-current-buffer (process-buffer process) (while (not (re-search-forward "^\\.\r\n" nil t)) + (unless (memq (process-status process) '(open run)) + (error "pop3 server closed the connection")) (pop3-accept-process-output process) (goto-char start)) (setq pop3-read-point (point-marker)) @@ -511,8 +789,7 @@ Otherwise, return the size of the message-id MSG" (setq end (point-marker)) (pop3-clean-region start end) (pop3-munge-message-separator start end) - (save-excursion - (set-buffer crashbuf) + (with-current-buffer crashbuf (erase-buffer)) (copy-to-buffer crashbuf start end) (delete-region start end) @@ -549,8 +826,7 @@ and close the connection." (pop3-send-command process "QUIT") (pop3-read-response process t) (if process - (save-excursion - (set-buffer (process-buffer process)) + (with-current-buffer (process-buffer process) (goto-char (point-max)) (delete-process process)))) @@ -633,6 +909,13 @@ and close the connection." ;; Possible responses: ;; +OK [all delete marks removed] +;; UIDL [msg] +;; Arguments: a message-id (optional) +;; Restrictions: transaction state; msg must not be deleted +;; Possible responses: +;; +OK [uidl listing follows] +;; -ERR [no such message] + ;;; UPDATE STATE ;; QUIT @@ -643,5 +926,4 @@ and close the connection." (provide 'pop3) -;; arch-tag: 2facc142-1d74-498e-82af-4659b64cac12 ;;; pop3.el ends here