+2005-11-23 Dave Love <fx@gnu.org>
+
+ Add pop3s, pop3/starttls.
+
+ * pop3.el (pop3-authentication-scheme): Clarify doc.
+ (open-tls-stream, starttls-open-stream): Autoload.
+ (pop3-stream-type): New.
+ (pop3-open-server): Use it.
+
+ * mail-source.el (mail-sources): Fix some :types. Add stream type
+ for POP.
+ (mail-source-keyword-map): Add :stream for POP.
+ (mail-source-fetch-pop): Use pop3-stream-type.
+
2005-11-22 Katsumi Yamaoka <yamaoka@jpl.org>
* nnmail.el (nnmail-fancy-expiry-target): Use current-time instead
(const :format "" :value :port)
(choice :tag "Port"
:value "pop3"
- (number :format "%v")
+ (integer :format "%v")
(string :format "%v")))
(group :inline t
(const :format "" :value :user)
(choice :tag "Prescript"
:value nil
(string :format "%v")
- (function :format "%v")))
+ (function :format "%v")
+ (const :tag "None" nil)))
(group :inline t
(const :format "" :value :postscript)
(choice :tag "Postscript"
:value nil
(string :format "%v")
- (function :format "%v")))
+ (function :format "%v")
+ (const :tag "None" nil)))
(group :inline t
(const :format "" :value :function)
(function :tag "Function"))
(const apop)))
(group :inline t
(const :format "" :value :plugged)
- (boolean :tag "Plugged"))))
+ (boolean :tag "Plugged"))
+ (group :inline t
+ (const :format "" :value :stream)
+ (choice :tag "Stream"
+ :value nil
+ (const :tag "Clear" nil)
+ (const starttls)
+ (const :tag "SSL/TLS" ssl)))))
(cons :tag "Maildir (qmail, postfix...)"
(const :format "" maildir)
(checklist :tag "Options" :greedy t
(const :format "" :value :port)
(choice :tag "Port"
:value 143
- number string))
+ integer string))
(group :inline t
(const :format "" :value :user)
(string :tag "User"))
(:password)
(:connection)
(:authentication password)
+ (:stream nil)
(:leave))
(maildir
(:path (or (getenv "MAILDIR") "~/Maildir/"))
(defun mail-source-fetch-pop (source callback)
"Fetcher for single-file sources."
(mail-source-bind (pop source)
+ ;; fixme: deal with stream type in format specs
(mail-source-run-script
prescript
(format-spec-make ?p password ?t mail-source-crash-box
(pop3-mailhost server)
(pop3-port port)
(pop3-authentication-scheme
- (if (eq authentication 'apop) 'apop 'pass)))
+ (if (eq authentication 'apop) 'apop 'pass))
+ (pop3-stream-type stream))
(if (or debug-on-quit debug-on-error)
(save-excursion (pop3-get-message-count))
(condition-case err
(defcustom pop3-authentication-scheme 'pass
"*POP3 authentication scheme.
-Defaults to 'pass, for the standard USER/PASS authentication. Other valid
-values are 'apop."
- :version "22.1" ;; 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
(pop3-quit process)
message-count))
+(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" ; fixme?
+ :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.
(setq
process
(cond
- ((eq pop3-connection-type 'ssl)
+ ((or (eq pop3-connection-type 'ssl)
+ (eq pop3-stream-type 'ssl)
+ (and (not pop3-stream-type) (= port 995))) ; pop3s
(pop3-open-ssl-stream "POP" (current-buffer) mailhost port))
- ((eq pop3-connection-type 'tls)
+ ((or (memq pop3-connection-type '(tls starttls))
+ (memq pop3-stream-type '(tls starttls)))
(pop3-open-tls-stream "POP" (current-buffer) mailhost port))
(t
(let ((coding-system-for-read 'binary)
"-connect" ,(format "%s:%d" host service)))
(process (open-ssl-stream name buffer host service)))
(when process
+ ;; There's a load of info printed that needs deleting.
(with-current-buffer buffer
(goto-char (point-min))
(while (and (memq (process-status process) '(open run))
;; 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")
;; +OK [negotiation is ready]
;; -ERR [security layer is already active]
+;; STLS (RFC 2595)
+;; Arguments: none
+;; Restrictions: Only permitted in AUTHORIZATION state.
+;; Possible responses:
+;; +OK
+;; -ERR
+
;;; TRANSACTION STATE
;; STAT