;;; 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, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Author: Richard L. Pieri <ratinox@peorth.gweep.net>
;; Maintainer: FSF
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; 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.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;; Code:
(require 'mail-utils)
+(defvar parse-time-months)
(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-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)
(defcustom pop3-authentication-scheme 'pass
"*POP3 authentication scheme.
-Defaults to 'pass, for the standard USER/PASS authentication. Other valid
-values are 'apop."
- :version "21.4" ;; Oort Gnus
- :type '(choice (const :tag "USER/PASS" pass)
+Defaults to `pass', for the standard USER/PASS authentication. The other
+valid value is 'apop'."
+ :type '(choice (const :tag "Normal user/password" pass)
(const :tag "APOP" apop))
+ :version "22.1" ;; Oort Gnus
: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 the `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 "21.4" ;; Oort Gnus
+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
:group 'pop3)
(truncate pop3-read-timeout))
1000))))
+(autoload 'nnheader-accept-process-output "nnheader")
+
(defun pop3-movemail (&optional crashbox)
"Transfer contents of a maildrop to the specified CRASHBOX."
(or crashbox (setq crashbox (expand-file-name "~/.crashbox")))
(unless pop3-leave-mail-on-server
(pop3-dele process n))
(setq n (+ 1 n))
- (if pop3-debug (sit-for 1) (sit-for 0.1))
- )
+ (nnheader-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)
- )
+ (kill-buffer crashbuf))
t)
(defun pop3-get-message-count ()
(pop3-quit process)
message-count))
+(autoload 'open-tls-stream "tls")
+(autoload 'starttls-open-stream "starttls")
+(autoload 'starttls-negotiate "starttls") ; avoid warning
+
+(defcustom pop3-stream-type nil
+ "*Transport security type for POP3 connexions.
+This may be either nil (plain connexion), `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
+995 (pop3s)."
+ :version "23.1" ;; No Gnus
+ :group 'pop3
+ :type '(choice (const :tag "Plain" nil)
+ (const :tag "SSL/TLS" ssl)
+ (const starttls)))
+
(defun pop3-open-server (mailhost port)
"Open TCP connection to MAILHOST on PORT.
Returns the process associated with the connection."
mailhost)))
(erase-buffer)
(setq pop3-read-point (point-min))
- (setq process (open-network-stream "POP" (current-buffer) mailhost port))
+ (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)
(setq match-end (point))
(goto-char pop3-read-point)
(if (looking-at "-ERR")
- (error (buffer-substring (point) (- match-end 2)))
+ (error "%s" (buffer-substring (point) (- match-end 2)))
(if (not (looking-at "+OK"))
(progn (setq pop3-read-point match-end) nil)
(setq pop3-read-point match-end)
(forward-char)))
(set-marker end nil))
-(eval-when-compile (defvar parse-time-months))
-
;; Copied from message-make-date.
(defun pop3-make-date (&optional now)
"Make a valid date header.
;; Date: 08 Jul 1996 23:22:24 -0400
;; should be
;; Tue Jul 9 09:04:21 1996
+
+ ;; Fixme: This should use timezone on the date field contents.
(setq date
(cond ((not date)
"Tue Jan 1 00:00:0 1900")
(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."
(setq pass
(read-passwd (format "Password for %s: " pop3-maildrop))))
(if pass
- (let ((hash (md5 (concat pop3-timestamp pass))))
+ (let ((hash (md5 (concat pop3-timestamp pass) nil nil 'binary)))
(pop3-send-command process (format "APOP %s %s" user hash))
(let ((response (pop3-read-response process t)))
(if (not (and response (string-match "+OK" response)))
"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-list (process &optional msg)
"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)
;; -ERR [invalid password]
;; -ERR [unable to lock maildrop]
+;; STLS (RFC 2595)
+;; Arguments: none
+;; Restrictions: Only permitted in AUTHORIZATION state.
+;; Possible responses:
+;; +OK
+;; -ERR
+
;;; TRANSACTION STATE
;; STAT
(provide 'pop3)
-;;; arch-tag: 2facc142-1d74-498e-82af-4659b64cac12
+;; arch-tag: 2facc142-1d74-498e-82af-4659b64cac12
;;; pop3.el ends here
projects / gnus / blobdiff