+2011-05-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * pop3.el (pop3-open-server): Upgrade opportunistically to STARTTLS.
+ (open-tls-stream): Remove superfluous tls/starttls autoloads.
+
+2011-05-01 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * gnus-sum.el (gnus-summary-next-article): Don't bug out if the summary
+ buffer has moved to a different frame.
+
+2011-05-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * nnimap.el (nnimap-request-article): Use nntp-insert-buffer-substring
+ to get the conversion from unibyte to multibyte buffers to work on
+ Emacs 22.
+
+ * nntp.el (nntp-request-article): Slight clean-up.
+
2011-04-29 Lars Magne Ingebrigtsen <larsi@gnus.org>
* shr.el (shr-strike-through): New face.
(deffoo nntp-request-article (article &optional group server buffer command)
(nntp-with-open-group
- group server
+ group server
(when (nntp-send-command-and-decode
"\r?\n\\.\r?\n" "ARTICLE"
(if (numberp article) (int-to-string article) article))
- (if (and buffer
- (not (equal buffer nntp-server-buffer)))
- (with-current-buffer nntp-server-buffer
- (copy-to-buffer buffer (point-min) (point-max))
- (nntp-find-group-and-number group))
- (nntp-find-group-and-number group)))))
+ (when (and buffer
+ (not (equal buffer nntp-server-buffer)))
+ (with-current-buffer nntp-server-buffer
+ (copy-to-buffer buffer (point-min) (point-max))))
+ (nntp-find-group-and-number group))))
(deffoo nntp-request-head (article &optional group server)
(nntp-with-open-group
;;; 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)
(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
Returns the process associated with the connection."
(let ((coding-system-for-read 'binary)
(coding-system-for-write 'binary)
- process)
+ 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))
- ;; Delay STLS until server greeting is read (Bug#7438).
- (starttls-open-stream "POP" (current-buffer)
- mailhost (or port 110)))
- (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)))))
- (when (eq pop3-stream-type 'starttls)
- (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"))))
- (pop3-set-process-query-on-exit-flag process nil)
- 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)))
+ :capability-command "CAPA\r\n"
+ :end-of-command "^\\.\r?\n\\|^\\+[A-Z]+ .*\n"
+ :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)
+ (car result)))))
;; Support functions