1 |
;;; pop3.el --- Post Office Protocol (RFC 1460) interface |
;;; pop3.el --- Post Office Protocol (RFC 1460) interface |
2 |
|
|
3 |
;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002 |
;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 |
4 |
;; Free Software Foundation, Inc. |
;; Free Software Foundation, Inc. |
5 |
|
|
6 |
;; Author: Richard L. Pieri <ratinox@peorth.gweep.net> |
;; Author: Richard L. Pieri <ratinox@peorth.gweep.net> |
54 |
Defaults to 'pass, for the standard USER/PASS authentication. Other valid |
Defaults to 'pass, for the standard USER/PASS authentication. Other valid |
55 |
values are 'apop.") |
values are 'apop.") |
56 |
|
|
|
(defvar pop3-leave-mail-on-server nil |
|
|
"*Non-nil if the mail is to be left on the POP server after fetching.") |
|
|
|
|
57 |
(defvar pop3-timestamp nil |
(defvar pop3-timestamp nil |
58 |
"Timestamp returned when initially connected to the POP server. |
"Timestamp returned when initially connected to the POP server. |
59 |
Used for APOP authentication.") |
Used for APOP authentication.") |
75 |
;; query for password |
;; query for password |
76 |
(if (and pop3-password-required (not pop3-password)) |
(if (and pop3-password-required (not pop3-password)) |
77 |
(setq pop3-password |
(setq pop3-password |
78 |
(pop3-read-passwd (format "Password for %s: " pop3-maildrop)))) |
(read-passwd (format "Password for %s: " pop3-maildrop)))) |
79 |
(cond ((equal 'apop pop3-authentication-scheme) |
(cond ((equal 'apop pop3-authentication-scheme) |
80 |
(pop3-apop process pop3-maildrop)) |
(pop3-apop process pop3-maildrop)) |
81 |
((equal 'pass pop3-authentication-scheme) |
((equal 'pass pop3-authentication-scheme) |
85 |
(setq message-count (car (pop3-stat process))) |
(setq message-count (car (pop3-stat process))) |
86 |
(unwind-protect |
(unwind-protect |
87 |
(while (<= n message-count) |
(while (<= n message-count) |
88 |
(message (format "Retrieving message %d of %d from %s..." |
(message "Retrieving message %d of %d from %s..." |
89 |
n message-count pop3-mailhost)) |
n message-count pop3-mailhost) |
90 |
(pop3-retr process n crashbuf) |
(pop3-retr process n crashbuf) |
91 |
(save-excursion |
(save-excursion |
92 |
(set-buffer crashbuf) |
(set-buffer crashbuf) |
97 |
(goto-char (point-min)) |
(goto-char (point-min)) |
98 |
(forward-line 50) |
(forward-line 50) |
99 |
(delete-region (point-min) (point)))) |
(delete-region (point-min) (point)))) |
100 |
(unless pop3-leave-mail-on-server |
(pop3-dele process n) |
|
(pop3-dele process n)) |
|
101 |
(setq n (+ 1 n)) |
(setq n (+ 1 n)) |
102 |
(if pop3-debug (sit-for 1) (sit-for 0.1)) |
(if pop3-debug (sit-for 1) (sit-for 0.1)) |
103 |
) |
) |
117 |
;; query for password |
;; query for password |
118 |
(if (and pop3-password-required (not pop3-password)) |
(if (and pop3-password-required (not pop3-password)) |
119 |
(setq pop3-password |
(setq pop3-password |
120 |
(pop3-read-passwd (format "Password for %s: " pop3-maildrop)))) |
(read-passwd (format "Password for %s: " pop3-maildrop)))) |
121 |
(cond ((equal 'apop pop3-authentication-scheme) |
(cond ((equal 'apop pop3-authentication-scheme) |
122 |
(pop3-apop process pop3-maildrop)) |
(pop3-apop process pop3-maildrop)) |
123 |
((equal 'pass pop3-authentication-scheme) |
((equal 'pass pop3-authentication-scheme) |
173 |
(save-excursion |
(save-excursion |
174 |
(set-buffer (process-buffer process)) |
(set-buffer (process-buffer process)) |
175 |
(goto-char pop3-read-point) |
(goto-char pop3-read-point) |
176 |
(while (not (search-forward "\r\n" nil t)) |
(while (and (memq (process-status process) '(open run)) |
177 |
(accept-process-output process 3) |
(not (search-forward "\r\n" nil t))) |
178 |
|
(nnheader-accept-process-output process) |
179 |
(goto-char pop3-read-point)) |
(goto-char pop3-read-point)) |
180 |
(setq match-end (point)) |
(setq match-end (point)) |
181 |
(goto-char pop3-read-point) |
(goto-char pop3-read-point) |
189 |
t) |
t) |
190 |
))))) |
))))) |
191 |
|
|
|
(defvar pop3-read-passwd nil) |
|
|
(defun pop3-read-passwd (prompt) |
|
|
(if (not pop3-read-passwd) |
|
|
(if (fboundp 'read-passwd) |
|
|
(setq pop3-read-passwd 'read-passwd) |
|
|
(if (load "passwd" t) |
|
|
(setq pop3-read-passwd 'read-passwd) |
|
|
(autoload 'ange-ftp-read-passwd "ange-ftp") |
|
|
(setq pop3-read-passwd 'ange-ftp-read-passwd)))) |
|
|
(funcall pop3-read-passwd prompt)) |
|
|
|
|
192 |
(defun pop3-clean-region (start end) |
(defun pop3-clean-region (start end) |
193 |
(setq end (set-marker (make-marker) end)) |
(setq end (set-marker (make-marker) end)) |
194 |
(save-excursion |
(save-excursion |
249 |
;; Tue Jul 9 09:04:21 1996 |
;; Tue Jul 9 09:04:21 1996 |
250 |
(setq date |
(setq date |
251 |
(cond ((not date) |
(cond ((not date) |
252 |
"Tue Jan 1 00:00:0 1900") |
"Tue Jan 1 00:00:0 1900") |
253 |
((string-match "[A-Z]" (nth 0 date)) |
((string-match "[A-Z]" (nth 0 date)) |
254 |
(format "%s %s %s %s %s" |
(format "%s %s %s %s %s" |
255 |
(nth 0 date) (nth 2 date) (nth 1 date) |
(nth 0 date) (nth 2 date) (nth 1 date) |
302 |
(let ((pass pop3-password)) |
(let ((pass pop3-password)) |
303 |
(if (and pop3-password-required (not pass)) |
(if (and pop3-password-required (not pass)) |
304 |
(setq pass |
(setq pass |
305 |
(pop3-read-passwd (format "Password for %s: " pop3-maildrop)))) |
(read-passwd (format "Password for %s: " pop3-maildrop)))) |
306 |
(if pass |
(if pass |
307 |
(let ((hash (pop3-md5 (concat pop3-timestamp pass)))) |
(let ((hash (pop3-md5 (concat pop3-timestamp pass)))) |
308 |
(pop3-send-command process (format "APOP %s %s" user hash)) |
(pop3-send-command process (format "APOP %s %s" user hash)) |
349 |
(save-excursion |
(save-excursion |
350 |
(set-buffer (process-buffer process)) |
(set-buffer (process-buffer process)) |
351 |
(while (not (re-search-forward "^\\.\r\n" nil t)) |
(while (not (re-search-forward "^\\.\r\n" nil t)) |
352 |
(accept-process-output process 3) |
;; Fixme: Shouldn't depend on nnheader. |
353 |
|
(nnheader-accept-process-output process) |
354 |
;; bill@att.com ... to save wear and tear on the heap |
;; bill@att.com ... to save wear and tear on the heap |
355 |
;; uncommented because the condensed version below is a problem for |
;; uncommented because the condensed version below is a problem for |
356 |
;; some. |
;; some. |