Mercurial > emacs

comparison lisp/gnus/pop3.el @ 56927:55fd4f77387a after-merge-gnus-5_10

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Merge from emacs--gnus--5.10, gnus--rel--5.10 Patches applied: * miles@gnu.org--gnu-2004/emacs--gnus--5.10--base-0 tag of miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-464 * miles@gnu.org--gnu-2004/emacs--gnus--5.10--patch-1 Import from CVS branch gnus-5_10-branch * miles@gnu.org--gnu-2004/emacs--gnus--5.10--patch-2 Merge from lorentey@elte.hu--2004/emacs--multi-tty--0, emacs--cvs-trunk--0 * miles@gnu.org--gnu-2004/emacs--gnus--5.10--patch-3 Merge from gnus--rel--5.10 * miles@gnu.org--gnu-2004/emacs--gnus--5.10--patch-4 Merge from gnus--rel--5.10 * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-18 Update from CVS * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-19 Remove autoconf-generated files from archive * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-20 Update from CVS
author Miles Bader <miles@gnu.org>
date Sat, 04 Sep 2004 13:13:48 +0000
parents 695cf19ef79e
children 2d9a1d1ac73d cce1c0ee76ee
comparison
equal deleted inserted replaced
56926:f8e248e9a717 56927:55fd4f77387a
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, 2004
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
76 ;; for debugging only 76 ;; for debugging only
77 (if pop3-debug (switch-to-buffer (process-buffer process))) 77 (if pop3-debug (switch-to-buffer (process-buffer process)))
78 ;; query for password 78 ;; query for password
79 (if (and pop3-password-required (not pop3-password)) 79 (if (and pop3-password-required (not pop3-password))
80 (setq pop3-password 80 (setq pop3-password
81 (pop3-read-passwd (format "Password for %s: " pop3-maildrop)))) 81 (read-passwd (format "Password for %s: " pop3-maildrop))))
82 (cond ((equal 'apop pop3-authentication-scheme) 82 (cond ((equal 'apop pop3-authentication-scheme)
83 (pop3-apop process pop3-maildrop)) 83 (pop3-apop process pop3-maildrop))
84 ((equal 'pass pop3-authentication-scheme) 84 ((equal 'pass pop3-authentication-scheme)
85 (pop3-user process pop3-maildrop) 85 (pop3-user process pop3-maildrop)
86 (pop3-pass process)) 86 (pop3-pass process))
87 (t (error "Invalid POP3 authentication scheme"))) 87 (t (error "Invalid POP3 authentication scheme")))
88 (setq message-count (car (pop3-stat process))) 88 (setq message-count (car (pop3-stat process)))
89 (unwind-protect 89 (unwind-protect
90 (while (<= n message-count) 90 (while (<= n message-count)
91 (message (format "Retrieving message %d of %d from %s..." 91 (message "Retrieving message %d of %d from %s..."
92 n message-count pop3-mailhost)) 92 n message-count pop3-mailhost)
93 (pop3-retr process n crashbuf) 93 (pop3-retr process n crashbuf)
94 (save-excursion 94 (save-excursion
95 (set-buffer crashbuf) 95 (set-buffer crashbuf)
96 (let ((coding-system-for-write 'binary)) 96 (let ((coding-system-for-write 'binary))
97 (write-region (point-min) (point-max) crashbox t 'nomesg)) 97 (write-region (point-min) (point-max) crashbox t 'nomesg))
119 ;; for debugging only 119 ;; for debugging only
120 (if pop3-debug (switch-to-buffer (process-buffer process))) 120 (if pop3-debug (switch-to-buffer (process-buffer process)))
121 ;; query for password 121 ;; query for password
122 (if (and pop3-password-required (not pop3-password)) 122 (if (and pop3-password-required (not pop3-password))
123 (setq pop3-password 123 (setq pop3-password
124 (pop3-read-passwd (format "Password for %s: " pop3-maildrop)))) 124 (read-passwd (format "Password for %s: " pop3-maildrop))))
125 (cond ((equal 'apop pop3-authentication-scheme) 125 (cond ((equal 'apop pop3-authentication-scheme)
126 (pop3-apop process pop3-maildrop)) 126 (pop3-apop process pop3-maildrop))
127 ((equal 'pass pop3-authentication-scheme) 127 ((equal 'pass pop3-authentication-scheme)
128 (pop3-user process pop3-maildrop) 128 (pop3-user process pop3-maildrop)
129 (pop3-pass process)) 129 (pop3-pass process))
175 (let ((case-fold-search nil) 175 (let ((case-fold-search nil)
176 match-end) 176 match-end)
177 (save-excursion 177 (save-excursion
178 (set-buffer (process-buffer process)) 178 (set-buffer (process-buffer process))
179 (goto-char pop3-read-point) 179 (goto-char pop3-read-point)
180 (while (not (search-forward "\r\n" nil t)) 180 (while (and (memq (process-status process) '(open run))
181 (accept-process-output process 3) 181 (not (search-forward "\r\n" nil t)))
182 (nnheader-accept-process-output process)
182 (goto-char pop3-read-point)) 183 (goto-char pop3-read-point))
183 (setq match-end (point)) 184 (setq match-end (point))
184 (goto-char pop3-read-point) 185 (goto-char pop3-read-point)
185 (if (looking-at "-ERR") 186 (if (looking-at "-ERR")
186 (error (buffer-substring (point) (- match-end 2))) 187 (error (buffer-substring (point) (- match-end 2)))
189 (setq pop3-read-point match-end) 190 (setq pop3-read-point match-end)
190 (if return 191 (if return
191 (buffer-substring (point) match-end) 192 (buffer-substring (point) match-end)
192 t) 193 t)
193 ))))) 194 )))))
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 195
206 (defun pop3-clean-region (start end) 196 (defun pop3-clean-region (start end)
207 (setq end (set-marker (make-marker) end)) 197 (setq end (set-marker (make-marker) end))
208 (save-excursion 198 (save-excursion
209 (goto-char start) 199 (goto-char start)
261 ;; Date: 08 Jul 1996 23:22:24 -0400 251 ;; Date: 08 Jul 1996 23:22:24 -0400
262 ;; should be 252 ;; should be
263 ;; Tue Jul 9 09:04:21 1996 253 ;; Tue Jul 9 09:04:21 1996
264 (setq date 254 (setq date
265 (cond ((not date) 255 (cond ((not date)
266 "Tue Jan 1 00:00:0 1900") 256 "Tue Jan 1 00:00:0 1900")
267 ((string-match "[A-Z]" (nth 0 date)) 257 ((string-match "[A-Z]" (nth 0 date))
268 (format "%s %s %s %s %s" 258 (format "%s %s %s %s %s"
269 (nth 0 date) (nth 2 date) (nth 1 date) 259 (nth 0 date) (nth 2 date) (nth 1 date)
270 (nth 4 date) (nth 3 date))) 260 (nth 4 date) (nth 3 date)))
271 (t 261 (t
314 (defun pop3-apop (process user) 304 (defun pop3-apop (process user)
315 "Send alternate authentication information to the server." 305 "Send alternate authentication information to the server."
316 (let ((pass pop3-password)) 306 (let ((pass pop3-password))
317 (if (and pop3-password-required (not pass)) 307 (if (and pop3-password-required (not pass))
318 (setq pass 308 (setq pass
319 (pop3-read-passwd (format "Password for %s: " pop3-maildrop)))) 309 (read-passwd (format "Password for %s: " pop3-maildrop))))
320 (if pass 310 (if pass
321 (let ((hash (pop3-md5 (concat pop3-timestamp pass)))) 311 (let ((hash (pop3-md5 (concat pop3-timestamp pass))))
322 (pop3-send-command process (format "APOP %s %s" user hash)) 312 (pop3-send-command process (format "APOP %s %s" user hash))
323 (let ((response (pop3-read-response process t))) 313 (let ((response (pop3-read-response process t)))
324 (if (not (and response (string-match "+OK" response))) 314 (if (not (and response (string-match "+OK" response)))
361 (pop3-read-response process) 351 (pop3-read-response process)
362 (let ((start pop3-read-point) end) 352 (let ((start pop3-read-point) end)
363 (save-excursion 353 (save-excursion
364 (set-buffer (process-buffer process)) 354 (set-buffer (process-buffer process))
365 (while (not (re-search-forward "^\\.\r\n" nil t)) 355 (while (not (re-search-forward "^\\.\r\n" nil t))
366 (accept-process-output process 3) 356 ;; Fixme: Shouldn't depend on nnheader.
357 (nnheader-accept-process-output process)
367 ;; bill@att.com ... to save wear and tear on the heap 358 ;; bill@att.com ... to save wear and tear on the heap
368 ;; uncommented because the condensed version below is a problem for 359 ;; uncommented because the condensed version below is a problem for
369 ;; some. 360 ;; some.
370 (if (> (buffer-size) 20000) (sleep-for 1)) 361 (if (> (buffer-size) 20000) (sleep-for 1))
371 (if (> (buffer-size) 50000) (sleep-for 1)) 362 (if (> (buffer-size) 50000) (sleep-for 1))