Mercurial > emacs

comparison lisp/gnus/pop3.el @ 57442:2d9a1d1ac73d

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-610 Merge from gnus--rel--5.10 Patches applied: * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-45 Update from CVS
author Miles Bader <miles@gnu.org>
date Tue, 12 Oct 2004 02:25:56 +0000
parents 55fd4f77387a
children 505c55fe8dc9 ff0e824afa37
comparison
equal deleted inserted replaced
57441:4c881805ff35 57442:2d9a1d1ac73d
35 35
36 ;;; Code: 36 ;;; Code:
37 37
38 (require 'mail-utils) 38 (require 'mail-utils)
39 39
40 (defvar pop3-maildrop (or (user-login-name) (getenv "LOGNAME") (getenv "USER") nil) 40 (defgroup pop3 nil
41 "*POP3 maildrop.") 41 "Post Office Protocol"
42 (defvar pop3-mailhost (or (getenv "MAILHOST") nil) 42 :group 'mail
43 "*POP3 mailhost.") 43 :group 'mail-source)
44 (defvar pop3-port 110 44
45 "*POP3 port.") 45 (defcustom pop3-maildrop (or (user-login-name)
46 46 (getenv "LOGNAME")
47 (defvar pop3-password-required t 47 (getenv "USER"))
48 "*Non-nil if a password is required when connecting to POP server.") 48 "*POP3 maildrop."
49 :version "21.4" ;; Oort Gnus
50 :type 'string
51 :group 'pop3)
52
53 (defcustom pop3-mailhost (or (getenv "MAILHOST") ;; nil -> mismatch
54 "pop3")
55 "*POP3 mailhost."
56 :version "21.4" ;; Oort Gnus
57 :type 'string
58 :group 'pop3)
59
60 (defcustom pop3-port 110
61 "*POP3 port."
62 :version "21.4" ;; Oort Gnus
63 :type 'number
64 :group 'pop3)
65
66 (defcustom pop3-password-required t
67 "*Non-nil if a password is required when connecting to POP server."
68 :version "21.4" ;; Oort Gnus
69 :type 'boolean
70 :group 'pop3)
71
72 ;; Should this be customizable?
49 (defvar pop3-password nil 73 (defvar pop3-password nil
50 "*Password to use when connecting to POP server.") 74 "*Password to use when connecting to POP server.")
51 75
52 (defvar pop3-authentication-scheme 'pass 76 (defcustom pop3-authentication-scheme 'pass
53 "*POP3 authentication scheme. 77 "*POP3 authentication scheme.
54 Defaults to 'pass, for the standard USER/PASS authentication. Other valid 78 Defaults to 'pass, for the standard USER/PASS authentication. Other valid
55 values are 'apop.") 79 values are 'apop."
56 80 :version "21.4" ;; Oort Gnus
57 (defvar pop3-leave-mail-on-server nil 81 :type '(choice (const :tag "USER/PASS" pass)
58 "*Non-nil if the mail is to be left on the POP server after fetching.") 82 (const :tag "APOP" apop))
83 :group 'pop3)
84
85 (defcustom pop3-leave-mail-on-server nil
86 "*Non-nil if the mail is to be left on the POP server after fetching."
87 :version "21.4" ;; Oort Gnus
88 :type 'boolean
89 :group 'pop3)
59 90
60 (defvar pop3-timestamp nil 91 (defvar pop3-timestamp nil
61 "Timestamp returned when initially connected to the POP server. 92 "Timestamp returned when initially connected to the POP server.
62 Used for APOP authentication.") 93 Used for APOP authentication.")
63 94
69 (or crashbox (setq crashbox (expand-file-name "~/.crashbox"))) 100 (or crashbox (setq crashbox (expand-file-name "~/.crashbox")))
70 (let* ((process (pop3-open-server pop3-mailhost pop3-port)) 101 (let* ((process (pop3-open-server pop3-mailhost pop3-port))
71 (crashbuf (get-buffer-create " *pop3-retr*")) 102 (crashbuf (get-buffer-create " *pop3-retr*"))
72 (n 1) 103 (n 1)
73 message-count 104 message-count
74 (pop3-password pop3-password) 105 (pop3-password pop3-password))
75 )
76 ;; for debugging only 106 ;; for debugging only
77 (if pop3-debug (switch-to-buffer (process-buffer process))) 107 (if pop3-debug (switch-to-buffer (process-buffer process)))
78 ;; query for password 108 ;; query for password
79 (if (and pop3-password-required (not pop3-password)) 109 (if (and pop3-password-required (not pop3-password))
80 (setq pop3-password 110 (setq pop3-password
112 142
113 (defun pop3-get-message-count () 143 (defun pop3-get-message-count ()
114 "Return the number of messages in the maildrop." 144 "Return the number of messages in the maildrop."
115 (let* ((process (pop3-open-server pop3-mailhost pop3-port)) 145 (let* ((process (pop3-open-server pop3-mailhost pop3-port))
116 message-count 146 message-count
117 (pop3-password pop3-password) 147 (pop3-password pop3-password))
118 )
119 ;; for debugging only 148 ;; for debugging only
120 (if pop3-debug (switch-to-buffer (process-buffer process))) 149 (if pop3-debug (switch-to-buffer (process-buffer process)))
121 ;; query for password 150 ;; query for password
122 (if (and pop3-password-required (not pop3-password)) 151 (if (and pop3-password-required (not pop3-password))
123 (setq pop3-password 152 (setq pop3-password
157 (set-buffer (process-buffer process)) 186 (set-buffer (process-buffer process))
158 (goto-char (point-max)) 187 (goto-char (point-max))
159 (insert output))) 188 (insert output)))
160 189
161 (defun pop3-send-command (process command) 190 (defun pop3-send-command (process command)
162 (set-buffer (process-buffer process)) 191 (set-buffer (process-buffer process))
163 (goto-char (point-max)) 192 (goto-char (point-max))
164 ;; (if (= (aref command 0) ?P) 193 ;; (if (= (aref command 0) ?P)
165 ;; (insert "PASS <omitted>\r\n") 194 ;; (insert "PASS <omitted>\r\n")
166 ;; (insert command "\r\n")) 195 ;; (insert command "\r\n"))
167 (setq pop3-read-point (point)) 196 (setq pop3-read-point (point))
168 (goto-char (point-max)) 197 (goto-char (point-max))
169 (process-send-string process (concat command "\r\n")) 198 (process-send-string process (concat command "\r\n")))
170 )
171 199
172 (defun pop3-read-response (process &optional return) 200 (defun pop3-read-response (process &optional return)
173 "Read the response from the server. 201 "Read the response from the server.
174 Return the response string if optional second argument is non-nil." 202 Return the response string if optional second argument is non-nil."
175 (let ((case-fold-search nil) 203 (let ((case-fold-search nil)
353 (save-excursion 381 (save-excursion
354 (set-buffer (process-buffer process)) 382 (set-buffer (process-buffer process))
355 (while (not (re-search-forward "^\\.\r\n" nil t)) 383 (while (not (re-search-forward "^\\.\r\n" nil t))
356 ;; Fixme: Shouldn't depend on nnheader. 384 ;; Fixme: Shouldn't depend on nnheader.
357 (nnheader-accept-process-output process) 385 (nnheader-accept-process-output process)
358 ;; bill@att.com ... to save wear and tear on the heap
359 ;; uncommented because the condensed version below is a problem for
360 ;; some.
361 (if (> (buffer-size) 20000) (sleep-for 1))
362 (if (> (buffer-size) 50000) (sleep-for 1))
363 (if (> (buffer-size) 100000) (sleep-for 1))
364 (if (> (buffer-size) 200000) (sleep-for 1))
365 (if (> (buffer-size) 500000) (sleep-for 1))
366 ;; bill@att.com
367 ;; condensed into:
368 ;; (sometimes causes problems for really large messages.)
369 ; (if (> (buffer-size) 20000) (sleep-for (/ (buffer-size) 20000)))
370 (goto-char start)) 386 (goto-char start))
371 (setq pop3-read-point (point-marker)) 387 (setq pop3-read-point (point-marker))
372 ;; this code does not seem to work for some POP servers... 388 ;; this code does not seem to work for some POP servers...
373 ;; and I cannot figure out why not. 389 ;; and I cannot figure out why not.
374 ; (goto-char (match-beginning 0)) 390 ;; (goto-char (match-beginning 0))
375 ; (backward-char 2) 391 ;; (backward-char 2)
376 ; (if (not (looking-at "\r\n")) 392 ;; (if (not (looking-at "\r\n"))
377 ; (insert "\r\n")) 393 ;; (insert "\r\n"))
378 ; (re-search-forward "\\.\r\n") 394 ;; (re-search-forward "\\.\r\n")
379 (goto-char (match-beginning 0)) 395 (goto-char (match-beginning 0))
380 (setq end (point-marker)) 396 (setq end (point-marker))
381 (pop3-clean-region start end) 397 (pop3-clean-region start end)
382 (pop3-munge-message-separator start end) 398 (pop3-munge-message-separator start end)
383 (save-excursion 399 (save-excursion