Mercurial > emacs

comparison lisp/gnus/nnimap.el @ 110615:84a76c5e1b1c

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Merge changes made in Gnus trunk. sieve-manage.el (sieve-manage-default-stream): Make default stream customizable. nnimap.el (nnimap-request-accept-article): Send a "." at the end, which may or may not help. nnimap.el (nnimap-open-connection): Have the `network' nnimap connection use STARTTLS opportunistically. gnus-sum.el (gnus-summary-insert-new-articles): Copy the old-high watermark so that nothing alters it while scanning for new messages. nnimap.el (nnimap-request-accept-article): Remove the "." at the end, since some servers don't like it. nnimap.el (nnimap-open-connection): Forget credentials if the server says the password was wrong. nnimap.el (nnimap-parse-line): Protect against invalid data. gnus-art.el, gnus-sum.el, nnimap.el: Allow setting the partial fetch per server instead of globally. message.el (message-cite-prefix-regexp): Revert last edit. nnmairix.el: Make it work with latest changes in nnimap. gnus-sum.el (gnus-summary-move-article): Don't alter gnus-newsgroup-active. gnus-sum.el (gnus-summary-exit): Kill the article buffer later, so that you don't get flashes of other buffers. nnimap.el: Fix up partial nnimap fetching. gnus-sum.el: Rework the `/ N' based on the new gnus-newsgroup-highest variable.
author Katsumi Yamaoka <yamaoka@jpl.org>
date Mon, 27 Sep 2010 23:07:47 +0000
parents 5bd3c6bdbcb0
children b1c50a3d738a
comparison
equal deleted inserted replaced
110614:ced897c0b9f0 110615:84a76c5e1b1c
82 some servers.") 82 some servers.")
83 83
84 (defvoo nnimap-connection-alist nil) 84 (defvoo nnimap-connection-alist nil)
85 85
86 (defvoo nnimap-current-infos nil) 86 (defvoo nnimap-current-infos nil)
87
88 (defvoo nnimap-fetch-partial-articles nil
89 "If non-nil, Gnus will fetch partial articles.
90 If t, nnimap will fetch only the first part. If a string, it
91 will fetch all parts that have types that match that string. A
92 likely value would be \"text/\" to automatically fetch all
93 textual parts.")
87 94
88 (defvar nnimap-process nil) 95 (defvar nnimap-process nil)
89 96
90 (defvar nnimap-status-string "") 97 (defvar nnimap-status-string "")
91 98
269 276
270 (defun nnimap-open-connection (buffer) 277 (defun nnimap-open-connection (buffer)
271 (unless nnimap-keepalive-timer 278 (unless nnimap-keepalive-timer
272 (setq nnimap-keepalive-timer (run-at-time (* 60 15) (* 60 15) 279 (setq nnimap-keepalive-timer (run-at-time (* 60 15) (* 60 15)
273 'nnimap-keepalive))) 280 'nnimap-keepalive)))
274 (with-current-buffer (nnimap-make-process-buffer buffer) 281 (block nil
275 (let* ((coding-system-for-read 'binary) 282 (with-current-buffer (nnimap-make-process-buffer buffer)
276 (coding-system-for-write 'binary) 283 (let* ((coding-system-for-read 'binary)
277 (port nil) 284 (coding-system-for-write 'binary)
278 (ports 285 (port nil)
279 (cond 286 (ports
280 ((eq nnimap-stream 'network) 287 (cond
281 (open-network-stream 288 ((eq nnimap-stream 'network)
282 "*nnimap*" (current-buffer) nnimap-address 289 (open-network-stream
283 (setq port 290 "*nnimap*" (current-buffer) nnimap-address
284 (or nnimap-server-port 291 (setq port
285 (if (netrc-find-service-number "imap") 292 (or nnimap-server-port
286 "imap" 293 (if (netrc-find-service-number "imap")
287 "143")))) 294 "imap"
288 '("143" "imap")) 295 "143"))))
289 ((eq nnimap-stream 'shell) 296 '("143" "imap"))
290 (nnimap-open-shell-stream 297 ((eq nnimap-stream 'shell)
291 "*nnimap*" (current-buffer) nnimap-address 298 (nnimap-open-shell-stream
292 (setq port (or nnimap-server-port "imap"))) 299 "*nnimap*" (current-buffer) nnimap-address
293 '("imap")) 300 (setq port (or nnimap-server-port "imap")))
294 ((eq nnimap-stream 'starttls) 301 '("imap"))
295 (starttls-open-stream 302 ((eq nnimap-stream 'starttls)
296 "*nnimap*" (current-buffer) nnimap-address 303 (starttls-open-stream
297 (setq port (or nnimap-server-port "imap"))) 304 "*nnimap*" (current-buffer) nnimap-address
298 '("imap")) 305 (setq port (or nnimap-server-port "imap")))
299 ((eq nnimap-stream 'ssl) 306 '("imap"))
300 (open-tls-stream 307 ((eq nnimap-stream 'ssl)
301 "*nnimap*" (current-buffer) nnimap-address 308 (open-tls-stream
302 (setq port 309 "*nnimap*" (current-buffer) nnimap-address
303 (or nnimap-server-port 310 (setq port
304 (if (netrc-find-service-number "imaps") 311 (or nnimap-server-port
305 "imaps" 312 (if (netrc-find-service-number "imaps")
306 "993")))) 313 "imaps"
307 '("143" "993" "imap" "imaps")))) 314 "993"))))
308 connection-result login-result credentials) 315 '("143" "993" "imap" "imaps"))))
309 (setf (nnimap-process nnimap-object) 316 connection-result login-result credentials)
310 (get-buffer-process (current-buffer))) 317 (setf (nnimap-process nnimap-object)
311 (if (not (and (nnimap-process nnimap-object) 318 (get-buffer-process (current-buffer)))
312 (memq (process-status (nnimap-process nnimap-object)) 319 (if (not (and (nnimap-process nnimap-object)
313 '(open run)))) 320 (memq (process-status (nnimap-process nnimap-object))
314 (nnheader-report 'nnimap "Unable to contact %s:%s via %s" 321 '(open run))))
315 nnimap-address port nnimap-stream) 322 (nnheader-report 'nnimap "Unable to contact %s:%s via %s"
316 (gnus-set-process-query-on-exit-flag (nnimap-process nnimap-object) nil) 323 nnimap-address port nnimap-stream)
317 (if (not (setq connection-result (nnimap-wait-for-connection))) 324 (gnus-set-process-query-on-exit-flag (nnimap-process nnimap-object) nil)
318 (nnheader-report 'nnimap 325 (if (not (setq connection-result (nnimap-wait-for-connection)))
319 "%s" (buffer-substring 326 (nnheader-report 'nnimap
320 (point) (line-end-position))) 327 "%s" (buffer-substring
321 (setf (nnimap-greeting nnimap-object) 328 (point) (line-end-position)))
322 (buffer-substring (line-beginning-position) 329 ;; Store the greeting (for debugging purposes).
323 (line-end-position))) 330 (setf (nnimap-greeting nnimap-object)
324 (when (eq nnimap-stream 'starttls) 331 (buffer-substring (line-beginning-position)
325 (nnimap-command "STARTTLS") 332 (line-end-position)))
326 (starttls-negotiate (nnimap-process nnimap-object))) 333 ;; Store the capabilities.
327 (when nnimap-server-port
328 (push (format "%s" nnimap-server-port) ports))
329 (unless (equal connection-result "PREAUTH")
330 (if (not (setq credentials
331 (if (eq nnimap-authenticator 'anonymous)
332 (list "anonymous"
333 (message-make-address))
334 (or
335 ;; First look for the credentials based
336 ;; on the virtual server name.
337 (nnimap-credentials
338 (nnoo-current-server 'nnimap) ports t)
339 ;; Then look them up based on the
340 ;; physical address.
341 (nnimap-credentials nnimap-address ports)))))
342 (setq nnimap-object nil)
343 (setq login-result (nnimap-command "LOGIN %S %S"
344 (car credentials)
345 (cadr credentials)))
346 (unless (car login-result)
347 (delete-process (nnimap-process nnimap-object))
348 (setq nnimap-object nil))))
349 (when nnimap-object
350 (setf (nnimap-capabilities nnimap-object) 334 (setf (nnimap-capabilities nnimap-object)
351 (mapcar 335 (mapcar
352 #'upcase 336 #'upcase
353 (or (nnimap-find-parameter "CAPABILITY" (cdr login-result)) 337 (nnimap-find-parameter
354 (nnimap-find-parameter 338 "CAPABILITY" (cdr (nnimap-command "CAPABILITY")))))
355 "CAPABILITY" (cdr (nnimap-command "CAPABILITY")))))) 339 (when (eq nnimap-stream 'starttls)
356 (when (member "QRESYNC" (nnimap-capabilities nnimap-object)) 340 (nnimap-command "STARTTLS")
357 (nnimap-command "ENABLE QRESYNC")) 341 (starttls-negotiate (nnimap-process nnimap-object)))
358 t)))))) 342 ;; If this is a STARTTLS-capable server, then sever the
343 ;; connection and start a STARTTLS connection instead.
344 (when (and (eq nnimap-stream 'network)
345 (member "STARTTLS" (nnimap-capabilities nnimap-object)))
346 (let ((nnimap-stream 'starttls))
347 (delete-process (nnimap-process nnimap-object))
348 (kill-buffer (current-buffer))
349 (return
350 (nnimap-open-connection buffer))))
351 (when nnimap-server-port
352 (push (format "%s" nnimap-server-port) ports))
353 (unless (equal connection-result "PREAUTH")
354 (if (not (setq credentials
355 (if (eq nnimap-authenticator 'anonymous)
356 (list "anonymous"
357 (message-make-address))
358 (or
359 ;; First look for the credentials based
360 ;; on the virtual server name.
361 (nnimap-credentials
362 (nnoo-current-server 'nnimap) ports t)
363 ;; Then look them up based on the
364 ;; physical address.
365 (nnimap-credentials nnimap-address ports)))))
366 (setq nnimap-object nil)
367 (setq login-result (nnimap-command "LOGIN %S %S"
368 (car credentials)
369 (cadr credentials)))
370 (unless (car login-result)
371 ;; If the login failed, then forget the credentials
372 ;; that are now possibly cached.
373 (dolist (host (list (nnoo-current-server 'nnimap)
374 nnimap-address))
375 (dolist (port ports)
376 (dolist (element '("login" "password"))
377 (auth-source-forget-user-or-password
378 element host port))))
379 (delete-process (nnimap-process nnimap-object))
380 (setq nnimap-object nil))))
381 (when nnimap-object
382 (when (member "QRESYNC" (nnimap-capabilities nnimap-object))
383 (nnimap-command "ENABLE QRESYNC"))
384 t)))))))
359 385
360 (defun nnimap-find-parameter (parameter elems) 386 (defun nnimap-find-parameter (parameter elems)
361 (let (result) 387 (let (result)
362 (dolist (elem elems) 388 (dolist (elem elems)
363 (cond 389 (cond
393 (when (and result 419 (when (and result
394 article) 420 article)
395 (erase-buffer) 421 (erase-buffer)
396 (with-current-buffer (nnimap-buffer) 422 (with-current-buffer (nnimap-buffer)
397 (erase-buffer) 423 (erase-buffer)
398 (when gnus-fetch-partial-articles 424 (when nnimap-fetch-partial-articles
399 (if (eq gnus-fetch-partial-articles t) 425 (nnimap-command "UID FETCH %d (BODYSTRUCTURE)" article)
400 (setq parts '(1)) 426 (goto-char (point-min))
401 (nnimap-command "UID FETCH %d (BODYSTRUCTURE)" article) 427 (when (re-search-forward "FETCH.*BODYSTRUCTURE" nil t)
402 (goto-char (point-min)) 428 (setq structure (ignore-errors (read (current-buffer)))
403 (when (re-search-forward "FETCH.*BODYSTRUCTURE" nil t) 429 parts (nnimap-find-wanted-parts structure))))
404 (setq structure (ignore-errors (read (current-buffer)))
405 parts (nnimap-find-wanted-parts structure)))))
406 (when (if parts 430 (when (if parts
407 (nnimap-get-partial-article article parts structure) 431 (nnimap-get-partial-article article parts structure)
408 (nnimap-get-whole-article article)) 432 (nnimap-get-whole-article article))
409 (let ((buffer (current-buffer))) 433 (let ((buffer (current-buffer)))
410 (with-current-buffer (or to-buffer nntp-server-buffer) 434 (with-current-buffer (or to-buffer nntp-server-buffer)
523 (let ((type (format "%s/%s" (nth 0 sub) (nth 1 sub))) 547 (let ((type (format "%s/%s" (nth 0 sub) (nth 1 sub)))
524 (id (if (string= prefix "") 548 (id (if (string= prefix "")
525 (number-to-string num) 549 (number-to-string num)
526 (format "%s.%s" prefix num)))) 550 (format "%s.%s" prefix num))))
527 (setcar (nthcdr 9 sub) id) 551 (setcar (nthcdr 9 sub) id)
528 (when (string-match gnus-fetch-partial-articles type) 552 (when (if (eq nnimap-fetch-partial-articles t)
553 (equal id "1")
554 (string-match nnimap-fetch-partial-articles type))
529 (push id parts)))) 555 (push id parts))))
530 (incf num))) 556 (incf num)))
531 (nreverse parts))) 557 (nreverse parts)))
532 558
533 (deffoo nnimap-request-group (group &optional server dont-check info) 559 (deffoo nnimap-request-group (group &optional server dont-check info)
939 (start-article 965 (start-article
940 (cons start-article (1- start-article))) 966 (cons start-article (1- start-article)))
941 (t 967 (t
942 ;; No articles and no uidnext. 968 ;; No articles and no uidnext.
943 nil))) 969 nil)))
944 (setcdr (gnus-active group) (or high (1- uidnext)))) 970 (gnus-set-active
971 group
972 (cons (car (gnus-active group))
973 (or high (1- uidnext)))))
945 (when (and (not high) 974 (when (and (not high)
946 uidnext) 975 uidnext)
947 (setq high (1- uidnext))) 976 (setq high (1- uidnext)))
948 ;; Then update the list of read articles. 977 ;; Then update the list of read articles.
949 (let* ((unread 978 (let* ((unread
1191 (forward-char 1) 1220 (forward-char 1)
1192 (push 1221 (push
1193 (cond 1222 (cond
1194 ((eql char ?\[) 1223 ((eql char ?\[)
1195 (split-string (buffer-substring 1224 (split-string (buffer-substring
1196 (1+ (point)) (1- (search-forward "]"))))) 1225 (1+ (point))
1226 (1- (search-forward "]" (line-end-position) 'move)))))
1197 ((eql char ?\() 1227 ((eql char ?\()
1198 (split-string (buffer-substring 1228 (split-string (buffer-substring
1199 (1+ (point)) (1- (search-forward ")"))))) 1229 (1+ (point))
1230 (1- (search-forward ")" (line-end-position) 'move)))))
1200 ((eql char ?\") 1231 ((eql char ?\")
1201 (forward-char 1) 1232 (forward-char 1)
1202 (buffer-substring (point) (1- (search-forward "\"")))) 1233 (buffer-substring
1234 (point)
1235 (1- (or (search-forward "\"" (line-end-position) 'move)
1236 (point)))))
1203 (t 1237 (t
1204 (buffer-substring (point) (if (search-forward " " nil t) 1238 (buffer-substring (point) (if (search-forward " " nil t)
1205 (1- (point)) 1239 (1- (point))
1206 (goto-char (point-max)))))) 1240 (goto-char (point-max))))))
1207 result))) 1241 result)))