;;; pop3.el --- Post Office Protocol (RFC 1460) interface
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004
-;; Free Software Foundation, Inc.
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
+;; 2004, 2005 Free Software Foundation, Inc.
;; Author: Richard L. Pieri <ratinox@peorth.gweep.net>
;; Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
;;; Gnus:
-;; You can use this program for Gnus, without needing any modification.
-;; There are two ways to do that; one is to replace Gnus' pop3.el with
-;; it when installing Gnus; the other is to replace Gnus' pop3.el which
-;; has been installed with this module and byte-compile it.
+;; Put something like the following line in your ~/.gnus.el file if
+;; you'd like to use this module together with Gnus, not T-gnus.
+;;
+;;(eval-after-load "mail-source" '(require 'pop3))
+;;
+;; There are two ways to install this module; one is to replace
+;; pop3.el of the Gnus version with this module when installing Gnus;
+;; the other is to replace pop3.el of the Gnus version which has been
+;; installed with this module and byte-compile it.
;; Note: you should not modify the value for the `pop' section of the
;; `mail-source-keyword-map' variable.
(require 'cl))
(require 'mail-utils)
-(require 'nnheader)
(defgroup pop3 nil
- "Post Office Protocol"
+ "Post Office Protocol."
:group 'mail
:group 'mail-source)
(getenv "LOGNAME")
(getenv "USER"))
"*POP3 maildrop."
- :version "21.4" ;; Oort Gnus
+ :version "22.1" ;; Oort Gnus
:type 'string
:group 'pop3)
(defcustom pop3-mailhost (or (getenv "MAILHOST") ;; nil -> mismatch
"pop3")
"*POP3 mailhost."
- :version "21.4" ;; Oort Gnus
+ :version "22.1" ;; Oort Gnus
:type 'string
:group 'pop3)
(defcustom pop3-port 110
"*POP3 port."
- :version "21.4" ;; Oort Gnus
+ :version "22.1" ;; Oort Gnus
:type 'number
:group 'pop3)
(defcustom pop3-connection-type nil
"*POP3 connection type."
- :type 'boolean
+ :type '(choice (const :tag "Not specified" nil)
+ (const tls)
+ (const ssl))
:group 'pop3)
(defcustom pop3-password-required t
"*Non-nil if a password is required when connecting to POP server."
- :version "21.4" ;; Oort Gnus
+ :version "22.1" ;; Oort Gnus
:type 'boolean
:group 'pop3)
"*POP3 authentication scheme.
Defaults to 'pass, for the standard USER/PASS authentication. Other valid
values are 'apop."
- :version "21.4" ;; Oort Gnus
+ :version "22.1" ;; Oort Gnus
:type '(choice (const :tag "USER/PASS" pass)
(const :tag "APOP" apop))
:group 'pop3)
(defcustom pop3-leave-mail-on-server nil
- "*Non-nil if the mail is to be left on the POP server after fetching."
- :version "21.4" ;; Oort Gnus
+ "*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 the whole thing can fall apart and leave you
+with a corrupt mailbox."
+ :version "22.1" ;; Oort Gnus
:type 'boolean
:group 'pop3)
(defcustom pop3-maximum-message-size nil
"If non-nil only download messages smaller than this."
:type '(choice (const :tag "Unlimited" nil)
- (integer :tag "Maximum size" :format "%t: %v\n" :size 0))
+ (integer :tag "Maximum size"))
:group 'pop3)
(defcustom pop3-except-header-regexp nil
"If non-nil we do not retrieve messages whose headers are matching this regexp."
:type '(choice (const :tag "Retrieve any messages" nil)
- (regexp :format "%t: %v\n" :size 0))
+ (regexp :format "\n%t: %v"))
:group 'pop3)
(defcustom pop3-uidl-file-name "~/.uidls"
"File in which to store the UIDL of processed messages."
- :type '(file :format "%t: %v\n" :size 0)
+ :type 'file
:group 'pop3)
-(defcustom pop3-uidl-support nil
+(defvar pop3-uidl-support nil
"Alist of servers and flags of whether they support UIDLs.
-Users don't have to set this value."
- :type 'boolean
- :group 'pop3)
+Users don't have to set this value.")
(defvar pop3-uidl-obarray (make-vector 31 0)
"Uidl hash table.")
"openssl"
"ssleay")
"The program to run in a subprocess to open an SSL connection."
- :type '(string :format "%t: %v\n" :size 0)
+ :type 'string
:group 'pop3)
(defcustom pop3-ssl-program-arguments
'("s_client" "-quiet")
"Arguments to be passed to the program `pop3-ssl-program-name'."
- :type '(repeat (string :format "%v\n" :size 0))
+ :type '(repeat (string :format "%v"))
:group 'pop3)
(defun pop3-progress-message (format percent &rest args)
(apply (function message) format args))
+;; Borrowed from nnheader-accept-process-output in nnheader.el.
+(defvar pop3-read-timeout
+ (if (string-match "windows-nt\\|os/2\\|emx\\|cygwin"
+ (symbol-name system-type))
+ ;; http://thread.gmane.org/v9655t3pjo.fsf@marauder.physik.uni-ulm.de
+ ;;
+ ;; IIRC, values lower than 1.0 didn't/don't work on Windows/DOS.
+ ;;
+ ;; There should probably be a runtime test to determine the timing
+ ;; resolution, or a primitive to report it. I don't know off-hand
+ ;; what's possible. Perhaps better, maybe the Windows/DOS primitive
+ ;; could round up non-zero timeouts to a minimum of 1.0?
+ 1.0
+ 0.1)
+ "How long pop3 should wait between checking for the end of output.
+Shorter values mean quicker response, but are more CPU intensive.")
+
+;; Borrowed from nnheader-accept-process-output in nnheader.el.
+(defun pop3-accept-process-output (process)
+ (accept-process-output
+ process
+ (truncate pop3-read-timeout)
+ (truncate (* (- pop3-read-timeout
+ (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")))
(goto-char (point-max))
(forward-line -1)
(not (looking-at "+OK")))
- (nnheader-accept-process-output process)
+ (pop3-accept-process-output process)
(sit-for 1))
(delete-region (point-min) (point)))
(and process (memq (process-status process) '(open run))
(goto-char pop3-read-point)
(while (and (memq (process-status process) '(open run))
(not (search-forward "\r\n" nil t)))
- (nnheader-accept-process-output process)
+ (pop3-accept-process-output process)
(goto-char pop3-read-point))
(setq match-end (point))
(goto-char pop3-read-point)
(pop3-send-command process (format "USER %s" user))
(let ((response (pop3-read-response process t)))
(if (not (and response (string-match "+OK" response)))
- (error (format "USER %s not valid" user)))))
+ (error "USER %s not valid" user))))
(defun pop3-pass (process)
"Send authentication information to the server."
"Return the number of messages in the maildrop and the maildrop's size."
(pop3-send-command process "STAT")
(let ((response (pop3-read-response process t)))
- (list (string-to-int (nth 1 (split-string response " ")))
- (string-to-int (nth 2 (split-string response " "))))))
+ (list (string-to-number (nth 1 (split-string response " ")))
+ (string-to-number (nth 2 (split-string response " "))))))
(defun pop3-retr (process msg crashbuf)
"Retrieve message-id MSG to buffer CRASHBUF."
"Return highest accessed message-id number for the session."
(pop3-send-command process "LAST")
(let ((response (pop3-read-response process t)))
- (string-to-int (nth 1 (split-string response " ")))))
+ (string-to-number (nth 1 (split-string response " ")))))
(defun pop3-rset (process)
"Remove all delete marks from current maildrop."
(apply 'narrow-to-region (pop3-get-extended-response process))
(goto-char (point-min))
(while (looking-at "\\([^ \n\t]*\\) \\([^ \n\t]*\\)")
- (setq msgno (string-to-int (match-string 1))
+ (setq msgno (string-to-number (match-string 1))
uidl (match-string 2))
(push (cons msgno uidl) pairs)
(beginning-of-line 2))
(apply 'narrow-to-region (pop3-get-extended-response process))
(goto-char (point-min))
(while (looking-at "\\([^ \n\t]*\\) \\([^ \n\t]*\\)")
- (setq msgno (string-to-int (match-string 1))
- len (string-to-int (match-string 2)))
+ (setq msgno (string-to-number (match-string 1))
+ len (string-to-number (match-string 2)))
(push (cons msgno len) pairs)
(beginning-of-line 2))
(cons (length pairs) (nreverse pairs)))))))
(set-buffer (process-buffer process))
(goto-char start)
(while (not (re-search-forward "^\\.\r\n" nil t))
- ;; Fixme: Shouldn't depend on nnheader.
- (nnheader-accept-process-output process)
+ (pop3-accept-process-output process)
(goto-char start))
(setq pop3-read-point (point-marker))
(goto-char (match-beginning 0))
projects / elisp / gnus.git- / blobdiff