Mercurial > emacs

comparison lisp/gnus/nnimap.el @ 111789:f97704487fb3

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Merge changes made in Gnus trunk. nnir.el: Batch header retrieval. proto-stream.el: New library to provide protocol-specific TLS/STARTTLS connections for IMAP, NNTP, SMTP, POP3 and similar protocols. nnimap.el (nnimap-open-connection): Use it. proto-stream.el (open-proto-stream): Complete the documentation. nnimap.el (nnimap-open-connection): Check for "OK" from the greeting. nntp.el: Use proto-streams for the relevant connections types. nntp.el (nntp-open-connection): Switch on STARTTLS on supported servers. proto-stream.el (open-proto-stream): Add a way to specify what the end of a command is. proto-stream.el (proto-stream-open-tls): Delete output from openssl if we're using tls.el. proto-stream.el (proto-stream-open-network): If we don't have gnutls-cli or gnutls built in, then don't try to establish a STARTTLS connection. color.el (color-lab->srgb): Fix function call name. proto-stream.el: Fix the syntax in the comment. nntp.el (nntp-open-connection): Fix the STARTTLS command syntax. proto-stream.el (proto-stream-open-starttls): Actually implement the starttls.el STARTTLS. proto-stream.el (proto-stream-always-use-starttls): New variable. proto-stream.el (proto-stream-open-starttls): De-duplicate the starttls code. proto-stream.el (proto-stream-open-starttls): Folded back into the main function. proto-stream.el (proto-stream-command): Refactor out. nnimap.el (nnimap-stream): Change default to `undecided'. nnimap.el (nnimap-open-connection): If `nnimap-stream' is `undecided', try ssl first, and then network. nnimap.el (nnimap-open-connection-1): Respect nnimap-server-port. nnimap.el (nnimap-open-connection): Be more backwards-compatible. proto-stream.el (open-protocol-stream): Renamed from open-proto-stream. proto-stream.el (proto-stream-open-network): When doing opportunistic TLS upgrades we don't really care about the identity of the peer. gnus.texi (Customizing the IMAP Connection): Note the new defaults. gnus.texi (Direct Functions): Note the STARTTLS upgrade. proto-stream.el (proto-stream-open-network): Force starttls.el to use gnutls-cli, since that what we've checked for. proto-stream.el (proto-stream-always-use-starttls): Only default to t if open-gnutls-stream exists. proto-stream.el (proto-stream-open-network): If STARTTLS failed, then just open a normal connection. proto-stream.el (proto-stream-open-network): Wait until the greeting before doing STARTTLS. nnimap.el (nnimap-open-connection-1): Always upgrade to STARTTLS (for backwards compatibility). nnimap.el (nnimap-open-connection-1): Really respect nnimap-server-port. nntp.el (nntp-open-connection): Provide a :success condition. nnimap.el (nnimap-open-connection-1): Ditto. proto-stream.el (proto-stream-open-network): See what the response to the STARTTLS command is. proto-stream.el (proto-stream-open-network): Add some comments. proto-stream.el: Fix example. proto-stream.el (open-protocol-stream): Actually mention the STARTTLS upgrade. nnir.el (nnir-get-active): Skip nnir-ignored-newsgroups when searching. nnir.el (nnir-ignore-newsgroups): Fix default value. nnir.el (nnir-run-gmane): Use mm-delete-duplicates instead of delete-dups that is not available in XEmacs 21.4. mm-util.el (mm-delete-duplicates): Add comment. gnus-sum.el (gnus-summary-delete-article): If delete fails don't change the registry. nnimap.el (nnimap-open-connection-1): w32 open-network-stream doesn't seem to accept strings-with-numbers as port numbers. color.el: fix docstring to use English rather than math notation for intervals. shr.el (shr-find-fill-point): Don't break before apostrophes. nnir.el (nnir-request-move-article): Bail out if no move support in group. color.el (color-rgb->hsv): Fix docstring. nnir.el (nnir-get-active): Improve active list retrieval. shr.el (shr-find-fill-point): Work better for kinsoku chars and apostrophes. gnus-gravatar.el (gnus-gravatar-size): Set gnus-gravatar-size to nil. nnimap.el (nnimap-open-connection-1): Use gnus-string-match-p. nnimap.el (nnimap-open-connection-1): Fix PREAUTH. proto-stream.el (open-protocol-stream): All starttls connections are handled by the network handler. gnus-gravatar.el (gnus-gravatar-insert): Delete unnecessary binding to t of inhibit-read-only since it is inside gnus-with-article-headers. gnus-gravatar.el (gnus-gravatar-transform-address): Use mail-extract-address-components that supports non-ASCII names rather than mail-header-parse-addresses. shr.el (shr-find-fill-point): Don't break line between kinsoku-bol characters. gnus-gravatar.el (gnus-gravatar-insert): Allow LWSP in the middle of names. nnmaildir.el (nnmaildir-request-set-mark): Add article to add-mark funcall. gnus-msg.el: Remove nastygram thing. message.el (message-from-style): Fix comment. message.el (message-user-organization): Do not use gnus-local-organization. gnus.el: Remove gnus-local-organization. rtree.el: New file to handle range trees. nnir.el, gnus-sum.el: Redo the way nnir handles registry updates. rtree.el (rtree-extract): Simplify. gnus-win.el (gnus-configure-windows): Remove Gnus 3.x setting support. gnus-msg.el: Mark gnus-outgoing-message-group as obsolete. gnus.texi (Archived Messages): Remove gnus-outgoing-message-group. gnus-win.el (gnus-configure-frame): Remove old compatibility code. rtree.el (rtree-memq): Rewrite it as a non-recursive function. rtree.el (rtree-add, rtree-delq, rtree-length): Implement. rtree.el (rtree-add): Make code slightly faster. nnir.el: Allow modified summary-line-format in nnir summary buffers.
author Katsumi Yamaoka <yamaoka@jpl.org>
date Thu, 02 Dec 2010 22:21:31 +0000
parents 8071f778f77e
children 79219ca01c7b
comparison
equal deleted inserted replaced
111788:8e746f396237 111789:f97704487fb3
43 (require 'netrc) 43 (require 'netrc)
44 (require 'utf7) 44 (require 'utf7)
45 (require 'tls) 45 (require 'tls)
46 (require 'parse-time) 46 (require 'parse-time)
47 (require 'nnmail) 47 (require 'nnmail)
48 (require 'proto-stream)
48 49
49 (eval-when-compile 50 (eval-when-compile
50 (require 'gnus-sum)) 51 (require 'gnus-sum))
51 52
52 (autoload 'auth-source-forget-user-or-password "auth-source") 53 (autoload 'auth-source-forget-user-or-password "auth-source")
60 (defvoo nnimap-server-port nil 61 (defvoo nnimap-server-port nil
61 "The IMAP port used. 62 "The IMAP port used.
62 If nnimap-stream is `ssl', this will default to `imaps'. If not, 63 If nnimap-stream is `ssl', this will default to `imaps'. If not,
63 it will default to `imap'.") 64 it will default to `imap'.")
64 65
65 (defvoo nnimap-stream 'ssl 66 (defvoo nnimap-stream 'undecided
66 "How nnimap will talk to the IMAP server. 67 "How nnimap will talk to the IMAP server.
67 Values are `ssl', `network', `starttls' or `shell'.") 68 Values are `ssl', `network', `starttls' or `shell'.
69 The default is to try `ssl' first, and then `network'.")
68 70
69 (defvoo nnimap-shell-program (if (boundp 'imap-shell-program) 71 (defvoo nnimap-shell-program (if (boundp 'imap-shell-program)
70 (if (listp imap-shell-program) 72 (if (listp imap-shell-program)
71 (car imap-shell-program) 73 (car imap-shell-program)
72 imap-shell-program) 74 imap-shell-program)
269 (make-nnimap :server (nnoo-current-server 'nnimap))) 271 (make-nnimap :server (nnoo-current-server 'nnimap)))
270 (push (list buffer (current-buffer)) nnimap-connection-alist) 272 (push (list buffer (current-buffer)) nnimap-connection-alist)
271 (push (current-buffer) nnimap-process-buffers) 273 (push (current-buffer) nnimap-process-buffers)
272 (current-buffer))) 274 (current-buffer)))
273 275
274 (defun nnimap-open-shell-stream (name buffer host port)
275 (let ((process-connection-type nil))
276 (start-process name buffer shell-file-name
277 shell-command-switch
278 (format-spec
279 nnimap-shell-program
280 (format-spec-make
281 ?s host
282 ?p port)))))
283
284 (defun nnimap-credentials (address ports &optional inhibit-create) 276 (defun nnimap-credentials (address ports &optional inhibit-create)
285 (let (port credentials) 277 (let (port credentials)
286 ;; Request the credentials from all ports, but only query on the 278 ;; Request the credentials from all ports, but only query on the
287 ;; last port if all the previous ones have failed. 279 ;; last port if all the previous ones have failed.
288 (while (and (null credentials) 280 (while (and (null credentials)
308 (nnimap-last-command-time nnimap-object))) 300 (nnimap-last-command-time nnimap-object)))
309 ;; More than five minutes since the last command. 301 ;; More than five minutes since the last command.
310 (* 5 60))) 302 (* 5 60)))
311 (nnimap-send-command "NOOP"))))))) 303 (nnimap-send-command "NOOP")))))))
312 304
313 (declare-function gnutls-negotiate "gnutls"
314 (proc type &optional priority-string trustfiles keyfiles))
315
316 (defun nnimap-open-connection (buffer) 305 (defun nnimap-open-connection (buffer)
306 ;; Be backwards-compatible -- the earlier value of nnimap-stream was
307 ;; `ssl' when nnimap-server-port was nil. Sort of.
308 (when (and nnimap-server-port
309 (eq nnimap-stream 'undecided))
310 (setq nnimap-stream 'ssl))
311 (let ((stream
312 (if (eq nnimap-stream 'undecided)
313 (loop for type in '(ssl network)
314 for stream = (let ((nnimap-stream type))
315 (nnimap-open-connection-1 buffer))
316 while (eq stream 'no-connect)
317 finally (return stream))
318 (nnimap-open-connection-1 buffer))))
319 (if (eq stream 'no-connect)
320 nil
321 stream)))
322
323 (defun nnimap-open-connection-1 (buffer)
317 (unless nnimap-keepalive-timer 324 (unless nnimap-keepalive-timer
318 (setq nnimap-keepalive-timer (run-at-time (* 60 15) (* 60 15) 325 (setq nnimap-keepalive-timer (run-at-time (* 60 15) (* 60 15)
319 'nnimap-keepalive))) 326 'nnimap-keepalive)))
320 (block nil 327 (with-current-buffer (nnimap-make-process-buffer buffer)
321 (with-current-buffer (nnimap-make-process-buffer buffer) 328 (let* ((coding-system-for-read 'binary)
322 (let* ((coding-system-for-read 'binary) 329 (coding-system-for-write 'binary)
323 (coding-system-for-write 'binary) 330 (port nil)
324 (port nil) 331 (ports
325 (ports 332 (cond
326 (cond 333 ((or (eq nnimap-stream 'network)
327 ((or (eq nnimap-stream 'network) 334 (eq nnimap-stream 'starttls))
328 (and (eq nnimap-stream 'starttls) 335 (nnheader-message 7 "Opening connection to %s..."
329 (fboundp 'open-gnutls-stream))) 336 nnimap-address)
330 (nnheader-message 7 "Opening connection to %s..." 337 '("143" "imap"))
331 nnimap-address) 338 ((eq nnimap-stream 'shell)
332 (open-network-stream 339 (nnheader-message 7 "Opening connection to %s via shell..."
333 "*nnimap*" (current-buffer) nnimap-address 340 nnimap-address)
334 (setq port 341 '("imap"))
335 (or nnimap-server-port 342 ((memq nnimap-stream '(ssl tls))
336 (if (netrc-find-service-number "imap") 343 (nnheader-message 7 "Opening connection to %s via tls..."
337 "imap" 344 nnimap-address)
338 "143")))) 345 '("143" "993" "imap" "imaps"))
339 '("143" "imap")) 346 (t
340 ((eq nnimap-stream 'shell) 347 (error "Unknown stream type: %s" nnimap-stream))))
341 (nnheader-message 7 "Opening connection to %s via shell..." 348 (proto-stream-always-use-starttls t)
342 nnimap-address) 349 login-result credentials)
343 (nnimap-open-shell-stream 350 (when nnimap-server-port
344 "*nnimap*" (current-buffer) nnimap-address 351 (setq ports (append ports (list nnimap-server-port))))
345 (setq port (or nnimap-server-port "imap"))) 352 (destructuring-bind (stream greeting capabilities)
346 '("imap")) 353 (open-protocol-stream
347 ((eq nnimap-stream 'starttls) 354 "*nnimap*" (current-buffer) nnimap-address (car (last ports))
348 (nnheader-message 7 "Opening connection to %s via starttls..." 355 :type nnimap-stream
349 nnimap-address) 356 :shell-command nnimap-shell-program
350 (let ((tls-program 357 :capability-command "1 CAPABILITY\r\n"
351 '("openssl s_client -connect %h:%p -no_ssl2 -ign_eof -starttls imap"))) 358 :success " OK "
352 (open-tls-stream 359 :starttls-function
353 "*nnimap*" (current-buffer) nnimap-address 360 (lambda (capabilities)
354 (setq port (or nnimap-server-port "imap")))) 361 (when (gnus-string-match-p "STARTTLS" capabilities)
355 '("imap")) 362 "1 STARTTLS\r\n")))
356 ((memq nnimap-stream '(ssl tls)) 363 (setf (nnimap-process nnimap-object) stream)
357 (nnheader-message 7 "Opening connection to %s via tls..." 364 (if (not stream)
358 nnimap-address) 365 (progn
359 (funcall (if (fboundp 'open-gnutls-stream) 366 (nnheader-report 'nnimap "Unable to contact %s:%s via %s"
360 'open-gnutls-stream 367 nnimap-address port nnimap-stream)
361 'open-tls-stream) 368 'no-connect)
362 "*nnimap*" (current-buffer) nnimap-address 369 (gnus-set-process-query-on-exit-flag stream nil)
363 (setq port 370 (if (not (gnus-string-match-p "[*.] \\(OK\\|PREAUTH\\)" greeting))
364 (or nnimap-server-port 371 (nnheader-report 'nnimap "%s" greeting)
365 (if (netrc-find-service-number "imaps")
366 "imaps"
367 "993"))))
368 '("143" "993" "imap" "imaps"))
369 (t
370 (error "Unknown stream type: %s" nnimap-stream))))
371 connection-result login-result credentials)
372 (setf (nnimap-process nnimap-object)
373 (get-buffer-process (current-buffer)))
374 (if (not (and (nnimap-process nnimap-object)
375 (memq (process-status (nnimap-process nnimap-object))
376 '(open run))))
377 (nnheader-report 'nnimap "Unable to contact %s:%s via %s"
378 nnimap-address port nnimap-stream)
379 (gnus-set-process-query-on-exit-flag
380 (nnimap-process nnimap-object) nil)
381 (if (not (setq connection-result (nnimap-wait-for-connection)))
382 (nnheader-report 'nnimap
383 "%s" (buffer-substring
384 (point) (line-end-position)))
385 ;; Store the greeting (for debugging purposes). 372 ;; Store the greeting (for debugging purposes).
386 (setf (nnimap-greeting nnimap-object) 373 (setf (nnimap-greeting nnimap-object) greeting)
387 (buffer-substring (line-beginning-position) 374 (setf (nnimap-capabilities nnimap-object)
388 (line-end-position))) 375 (mapcar #'upcase
389 (nnimap-get-capabilities) 376 (split-string capabilities)))
390 (when nnimap-server-port 377 (unless (gnus-string-match-p "[*.] PREAUTH" greeting)
391 (push (format "%s" nnimap-server-port) ports))
392 ;; If this is a STARTTLS-capable server, then sever the
393 ;; connection and start a STARTTLS connection instead.
394 (cond
395 ((and (or (and (eq nnimap-stream 'network)
396 (nnimap-capability "STARTTLS"))
397 (eq nnimap-stream 'starttls))
398 (fboundp 'open-gnutls-stream))
399 (nnimap-command "STARTTLS")
400 (gnutls-negotiate (nnimap-process nnimap-object) nil)
401 ;; Get the capabilities again -- they may have changed
402 ;; after doing STARTTLS.
403 (nnimap-get-capabilities))
404 ((and (eq nnimap-stream 'network)
405 (nnimap-capability "STARTTLS"))
406 (let ((nnimap-stream 'starttls))
407 (let ((tls-process
408 (nnimap-open-connection buffer)))
409 ;; If the STARTTLS connection was successful, we
410 ;; kill our first non-encrypted connection. If it
411 ;; wasn't successful, we just use our unencrypted
412 ;; connection.
413 (when (memq (process-status tls-process) '(open run))
414 (delete-process (nnimap-process nnimap-object))
415 (kill-buffer (current-buffer))
416 (return tls-process))))))
417 (unless (equal connection-result "PREAUTH")
418 (if (not (setq credentials 378 (if (not (setq credentials
419 (if (eq nnimap-authenticator 'anonymous) 379 (if (eq nnimap-authenticator 'anonymous)
420 (list "anonymous" 380 (list "anonymous"
421 (message-make-address)) 381 (message-make-address))
422 (or 382 (or
453 (setq nnimap-object nil)))) 413 (setq nnimap-object nil))))
454 (when nnimap-object 414 (when nnimap-object
455 (when (nnimap-capability "QRESYNC") 415 (when (nnimap-capability "QRESYNC")
456 (nnimap-command "ENABLE QRESYNC")) 416 (nnimap-command "ENABLE QRESYNC"))
457 (nnimap-process nnimap-object)))))))) 417 (nnimap-process nnimap-object))))))))
458
459 (defun nnimap-get-capabilities ()
460 (setf (nnimap-capabilities nnimap-object)
461 (mapcar
462 #'upcase
463 (nnimap-find-parameter
464 "CAPABILITY" (cdr (nnimap-command "CAPABILITY"))))))
465 418
466 (defun nnimap-quote-specials (string) 419 (defun nnimap-quote-specials (string)
467 (with-temp-buffer 420 (with-temp-buffer
468 (insert string) 421 (insert string)
469 (goto-char (point-min)) 422 (goto-char (point-min))
1108 (setf (nnimap-examined nnimap-object) group) 1061 (setf (nnimap-examined nnimap-object) group)
1109 (if (and qresyncp 1062 (if (and qresyncp
1110 uidvalidity 1063 uidvalidity
1111 modseq) 1064 modseq)
1112 (push 1065 (push
1113 (list (nnimap-send-command "EXAMINE %S (QRESYNC (%s %s))" 1066 (list (nnimap-send-command "EXAMINE %S (QRESYNC (%s %s))"
1114 (utf7-encode group t) 1067 (utf7-encode group t)
1115 uidvalidity modseq) 1068 uidvalidity modseq)
1116 'qresync 1069 'qresync
1117 nil group 'qresync) 1070 nil group 'qresync)
1118 sequences) 1071 sequences)