Mercurial > emacs

comparison lisp/gnus/pop3.el @ 82951:0fde48feb604

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import Gnus 5.10 from the v5_10 branch of the Gnus repository.
author Andreas Schwab <schwab@suse.de>
date Thu, 22 Jul 2004 16:45:51 +0000
parents 695cf19ef79e
children 28d9e552d178
comparison
equal deleted inserted replaced
56503:8bbd2323fbf2 82951:0fde48feb604
1 ;;; pop3.el --- Post Office Protocol (RFC 1460) interface 1 ;;; pop3.el --- Post Office Protocol (RFC 1460) interface
2 2
3 ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002 3 ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003
4 ;; Free Software Foundation, Inc. 4 ;; Free Software Foundation, Inc.
5 5
6 ;; Author: Richard L. Pieri <ratinox@peorth.gweep.net> 6 ;; Author: Richard L. Pieri <ratinox@peorth.gweep.net>
7 ;; Maintainer: FSF 7 ;; Maintainer: FSF
8 ;; Keywords: mail 8 ;; Keywords: mail
51 51
52 (defvar pop3-authentication-scheme 'pass 52 (defvar pop3-authentication-scheme 'pass
53 "*POP3 authentication scheme. 53 "*POP3 authentication scheme.
54 Defaults to 'pass, for the standard USER/PASS authentication. Other valid 54 Defaults to 'pass, for the standard USER/PASS authentication. Other valid
55 values are 'apop.") 55 values are 'apop.")
56
57 (defvar pop3-leave-mail-on-server nil
58 "*Non-nil if the mail is to be left on the POP server after fetching.")
59 56
60 (defvar pop3-timestamp nil 57 (defvar pop3-timestamp nil
61 "Timestamp returned when initially connected to the POP server. 58 "Timestamp returned when initially connected to the POP server.
62 Used for APOP authentication.") 59 Used for APOP authentication.")
63 60
76 ;; for debugging only 73 ;; for debugging only
77 (if pop3-debug (switch-to-buffer (process-buffer process))) 74 (if pop3-debug (switch-to-buffer (process-buffer process)))
78 ;; query for password 75 ;; query for password
79 (if (and pop3-password-required (not pop3-password)) 76 (if (and pop3-password-required (not pop3-password))
80 (setq pop3-password 77 (setq pop3-password
81 (pop3-read-passwd (format "Password for %s: " pop3-maildrop)))) 78 (read-passwd (format "Password for %s: " pop3-maildrop))))
82 (cond ((equal 'apop pop3-authentication-scheme) 79 (cond ((equal 'apop pop3-authentication-scheme)
83 (pop3-apop process pop3-maildrop)) 80 (pop3-apop process pop3-maildrop))
84 ((equal 'pass pop3-authentication-scheme) 81 ((equal 'pass pop3-authentication-scheme)
85 (pop3-user process pop3-maildrop) 82 (pop3-user process pop3-maildrop)
86 (pop3-pass process)) 83 (pop3-pass process))
87 (t (error "Invalid POP3 authentication scheme"))) 84 (t (error "Invalid POP3 authentication scheme")))
88 (setq message-count (car (pop3-stat process))) 85 (setq message-count (car (pop3-stat process)))
89 (unwind-protect 86 (unwind-protect
90 (while (<= n message-count) 87 (while (<= n message-count)
91 (message (format "Retrieving message %d of %d from %s..." 88 (message "Retrieving message %d of %d from %s..."
92 n message-count pop3-mailhost)) 89 n message-count pop3-mailhost)
93 (pop3-retr process n crashbuf) 90 (pop3-retr process n crashbuf)
94 (save-excursion 91 (save-excursion
95 (set-buffer crashbuf) 92 (set-buffer crashbuf)
96 (let ((coding-system-for-write 'binary)) 93 (let ((coding-system-for-write 'binary))
97 (write-region (point-min) (point-max) crashbox t 'nomesg)) 94 (write-region (point-min) (point-max) crashbox t 'nomesg))
98 (set-buffer (process-buffer process)) 95 (set-buffer (process-buffer process))
99 (while (> (buffer-size) 5000) 96 (while (> (buffer-size) 5000)
100 (goto-char (point-min)) 97 (goto-char (point-min))
101 (forward-line 50) 98 (forward-line 50)
102 (delete-region (point-min) (point)))) 99 (delete-region (point-min) (point))))
103 (unless pop3-leave-mail-on-server 100 (pop3-dele process n)
104 (pop3-dele process n))
105 (setq n (+ 1 n)) 101 (setq n (+ 1 n))
106 (if pop3-debug (sit-for 1) (sit-for 0.1)) 102 (if pop3-debug (sit-for 1) (sit-for 0.1))
107 ) 103 )
108 (pop3-quit process)) 104 (pop3-quit process))
109 (kill-buffer crashbuf) 105 (kill-buffer crashbuf)
119 ;; for debugging only 115 ;; for debugging only
120 (if pop3-debug (switch-to-buffer (process-buffer process))) 116 (if pop3-debug (switch-to-buffer (process-buffer process)))
121 ;; query for password 117 ;; query for password
122 (if (and pop3-password-required (not pop3-password)) 118 (if (and pop3-password-required (not pop3-password))
123 (setq pop3-password 119 (setq pop3-password
124 (pop3-read-passwd (format "Password for %s: " pop3-maildrop)))) 120 (read-passwd (format "Password for %s: " pop3-maildrop))))
125 (cond ((equal 'apop pop3-authentication-scheme) 121 (cond ((equal 'apop pop3-authentication-scheme)
126 (pop3-apop process pop3-maildrop)) 122 (pop3-apop process pop3-maildrop))
127 ((equal 'pass pop3-authentication-scheme) 123 ((equal 'pass pop3-authentication-scheme)
128 (pop3-user process pop3-maildrop) 124 (pop3-user process pop3-maildrop)
129 (pop3-pass process)) 125 (pop3-pass process))
175 (let ((case-fold-search nil) 171 (let ((case-fold-search nil)
176 match-end) 172 match-end)
177 (save-excursion 173 (save-excursion
178 (set-buffer (process-buffer process)) 174 (set-buffer (process-buffer process))
179 (goto-char pop3-read-point) 175 (goto-char pop3-read-point)
180 (while (not (search-forward "\r\n" nil t)) 176 (while (and (memq (process-status process) '(open run))
181 (accept-process-output process 3) 177 (not (search-forward "\r\n" nil t)))
178 (nnheader-accept-process-output process)
182 (goto-char pop3-read-point)) 179 (goto-char pop3-read-point))
183 (setq match-end (point)) 180 (setq match-end (point))
184 (goto-char pop3-read-point) 181 (goto-char pop3-read-point)
185 (if (looking-at "-ERR") 182 (if (looking-at "-ERR")
186 (error (buffer-substring (point) (- match-end 2))) 183 (error (buffer-substring (point) (- match-end 2)))
189 (setq pop3-read-point match-end) 186 (setq pop3-read-point match-end)
190 (if return 187 (if return
191 (buffer-substring (point) match-end) 188 (buffer-substring (point) match-end)
192 t) 189 t)
193 ))))) 190 )))))
194
195 (defvar pop3-read-passwd nil)
196 (defun pop3-read-passwd (prompt)
197 (if (not pop3-read-passwd)
198 (if (fboundp 'read-passwd)
199 (setq pop3-read-passwd 'read-passwd)
200 (if (load "passwd" t)
201 (setq pop3-read-passwd 'read-passwd)
202 (autoload 'ange-ftp-read-passwd "ange-ftp")
203 (setq pop3-read-passwd 'ange-ftp-read-passwd))))
204 (funcall pop3-read-passwd prompt))
205 191
206 (defun pop3-clean-region (start end) 192 (defun pop3-clean-region (start end)
207 (setq end (set-marker (make-marker) end)) 193 (setq end (set-marker (make-marker) end))
208 (save-excursion 194 (save-excursion
209 (goto-char start) 195 (goto-char start)
261 ;; Date: 08 Jul 1996 23:22:24 -0400 247 ;; Date: 08 Jul 1996 23:22:24 -0400
262 ;; should be 248 ;; should be
263 ;; Tue Jul 9 09:04:21 1996 249 ;; Tue Jul 9 09:04:21 1996
264 (setq date 250 (setq date
265 (cond ((not date) 251 (cond ((not date)
266 "Tue Jan 1 00:00:0 1900") 252 "Tue Jan 1 00:00:0 1900")
267 ((string-match "[A-Z]" (nth 0 date)) 253 ((string-match "[A-Z]" (nth 0 date))
268 (format "%s %s %s %s %s" 254 (format "%s %s %s %s %s"
269 (nth 0 date) (nth 2 date) (nth 1 date) 255 (nth 0 date) (nth 2 date) (nth 1 date)
270 (nth 4 date) (nth 3 date))) 256 (nth 4 date) (nth 3 date)))
271 (t 257 (t
314 (defun pop3-apop (process user) 300 (defun pop3-apop (process user)
315 "Send alternate authentication information to the server." 301 "Send alternate authentication information to the server."
316 (let ((pass pop3-password)) 302 (let ((pass pop3-password))
317 (if (and pop3-password-required (not pass)) 303 (if (and pop3-password-required (not pass))
318 (setq pass 304 (setq pass
319 (pop3-read-passwd (format "Password for %s: " pop3-maildrop)))) 305 (read-passwd (format "Password for %s: " pop3-maildrop))))
320 (if pass 306 (if pass
321 (let ((hash (pop3-md5 (concat pop3-timestamp pass)))) 307 (let ((hash (pop3-md5 (concat pop3-timestamp pass))))
322 (pop3-send-command process (format "APOP %s %s" user hash)) 308 (pop3-send-command process (format "APOP %s %s" user hash))
323 (let ((response (pop3-read-response process t))) 309 (let ((response (pop3-read-response process t)))
324 (if (not (and response (string-match "+OK" response))) 310 (if (not (and response (string-match "+OK" response)))
361 (pop3-read-response process) 347 (pop3-read-response process)
362 (let ((start pop3-read-point) end) 348 (let ((start pop3-read-point) end)
363 (save-excursion 349 (save-excursion
364 (set-buffer (process-buffer process)) 350 (set-buffer (process-buffer process))
365 (while (not (re-search-forward "^\\.\r\n" nil t)) 351 (while (not (re-search-forward "^\\.\r\n" nil t))
366 (accept-process-output process 3) 352 ;; Fixme: Shouldn't depend on nnheader.
353 (nnheader-accept-process-output process)
367 ;; bill@att.com ... to save wear and tear on the heap 354 ;; bill@att.com ... to save wear and tear on the heap
368 ;; uncommented because the condensed version below is a problem for 355 ;; uncommented because the condensed version below is a problem for
369 ;; some. 356 ;; some.
370 (if (> (buffer-size) 20000) (sleep-for 1)) 357 (if (> (buffer-size) 20000) (sleep-for 1))
371 (if (> (buffer-size) 50000) (sleep-for 1)) 358 (if (> (buffer-size) 50000) (sleep-for 1))