Mercurial > emacs
comparison lisp/gnus/pop3.el @ 57442:2d9a1d1ac73d
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 |