|
31717
|
1 ;;; mail-source.el --- functions for fetching mail
|
|
64754
|
2
|
|
|
3 ;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004,
|
|
79708
|
4 ;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
|
|
31717
|
5
|
|
|
6 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
|
|
|
7 ;; Keywords: news, mail
|
|
|
8
|
|
|
9 ;; This file is part of GNU Emacs.
|
|
|
10
|
|
94662
|
11 ;; GNU Emacs is free software: you can redistribute it and/or modify
|
|
31717
|
12 ;; it under the terms of the GNU General Public License as published by
|
|
94662
|
13 ;; the Free Software Foundation, either version 3 of the License, or
|
|
|
14 ;; (at your option) any later version.
|
|
31717
|
15
|
|
|
16 ;; GNU Emacs is distributed in the hope that it will be useful,
|
|
|
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
19 ;; GNU General Public License for more details.
|
|
|
20
|
|
|
21 ;; You should have received a copy of the GNU General Public License
|
|
94662
|
22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
|
|
31717
|
23
|
|
|
24 ;;; Commentary:
|
|
|
25
|
|
|
26 ;;; Code:
|
|
|
27
|
|
87246
|
28 ;; For Emacs < 22.2.
|
|
|
29 (eval-and-compile
|
|
|
30 (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
|
|
|
31
|
|
86888
|
32 (require 'format-spec)
|
|
32918
|
33 (eval-when-compile
|
|
|
34 (require 'cl)
|
|
86154
|
35 (require 'imap))
|
|
95820
|
36 (autoload 'auth-source-user-or-password "auth-source")
|
|
|
37 (autoload 'pop3-movemail "pop3")
|
|
|
38 (autoload 'pop3-get-message-count "pop3")
|
|
|
39 (autoload 'nnheader-cancel-timer "nnheader")
|
|
32918
|
40 (require 'mm-util)
|
|
56927
|
41 (require 'message) ;; for `message-directory'
|
|
31717
|
42
|
|
86154
|
43 (defvar display-time-mail-function)
|
|
|
44
|
|
31717
|
45 (defgroup mail-source nil
|
|
|
46 "The mail-fetching library."
|
|
31764
|
47 :version "21.1"
|
|
31717
|
48 :group 'gnus)
|
|
|
49
|
|
32918
|
50 ;; Define these at compile time to avoid dragging in imap always.
|
|
|
51 (defconst mail-source-imap-authenticators
|
|
|
52 (eval-when-compile
|
|
|
53 (mapcar (lambda (a)
|
|
|
54 (list 'const (car a)))
|
|
|
55 imap-authenticator-alist)))
|
|
|
56 (defconst mail-source-imap-streams
|
|
|
57 (eval-when-compile
|
|
|
58 (mapcar (lambda (a)
|
|
|
59 (list 'const (car a)))
|
|
|
60 imap-stream-alist)))
|
|
|
61
|
|
87097
|
62 (defcustom mail-sources '((file))
|
|
|
63 "Where the mail backends will look for incoming mail.
|
|
31764
|
64 This variable is a list of mail source specifiers.
|
|
|
65 See Info node `(gnus)Mail Source Specifiers'."
|
|
31717
|
66 :group 'mail-source
|
|
92336
|
67 :version "23.1" ;; No Gnus
|
|
56927
|
68 :link '(custom-manual "(gnus)Mail Source Specifiers")
|
|
71262
|
69 :type `(choice
|
|
87097
|
70 (const :tag "None" nil)
|
|
|
71 (repeat :tag "List"
|
|
71262
|
72 (choice :format "%[Value Menu%] %v"
|
|
|
73 :value (file)
|
|
88045
|
74 (cons :tag "Group parameter `mail-source'"
|
|
|
75 (const :format "" group))
|
|
71262
|
76 (cons :tag "Spool file"
|
|
|
77 (const :format "" file)
|
|
|
78 (checklist :tag "Options" :greedy t
|
|
|
79 (group :inline t
|
|
|
80 (const :format "" :value :path)
|
|
|
81 file)))
|
|
|
82 (cons :tag "Several files in a directory"
|
|
|
83 (const :format "" directory)
|
|
|
84 (checklist :tag "Options" :greedy t
|
|
|
85 (group :inline t
|
|
|
86 (const :format "" :value :path)
|
|
|
87 (directory :tag "Path"))
|
|
|
88 (group :inline t
|
|
|
89 (const :format "" :value :suffix)
|
|
|
90 (string :tag "Suffix"))
|
|
|
91 (group :inline t
|
|
|
92 (const :format "" :value :predicate)
|
|
|
93 (function :tag "Predicate"))
|
|
|
94 (group :inline t
|
|
|
95 (const :format "" :value :prescript)
|
|
|
96 (choice :tag "Prescript"
|
|
|
97 :value nil
|
|
|
98 (string :format "%v")
|
|
|
99 (function :format "%v")))
|
|
|
100 (group :inline t
|
|
|
101 (const :format "" :value :postscript)
|
|
|
102 (choice :tag "Postscript"
|
|
|
103 :value nil
|
|
|
104 (string :format "%v")
|
|
|
105 (function :format "%v")))
|
|
|
106 (group :inline t
|
|
|
107 (const :format "" :value :plugged)
|
|
|
108 (boolean :tag "Plugged"))))
|
|
|
109 (cons :tag "POP3 server"
|
|
|
110 (const :format "" pop)
|
|
|
111 (checklist :tag "Options" :greedy t
|
|
|
112 (group :inline t
|
|
|
113 (const :format "" :value :server)
|
|
|
114 (string :tag "Server"))
|
|
|
115 (group :inline t
|
|
|
116 (const :format "" :value :port)
|
|
|
117 (choice :tag "Port"
|
|
|
118 :value "pop3"
|
|
85712
|
119 (integer :format "%v")
|
|
71262
|
120 (string :format "%v")))
|
|
|
121 (group :inline t
|
|
|
122 (const :format "" :value :user)
|
|
|
123 (string :tag "User"))
|
|
|
124 (group :inline t
|
|
|
125 (const :format "" :value :password)
|
|
|
126 (string :tag "Password"))
|
|
|
127 (group :inline t
|
|
|
128 (const :format "" :value :program)
|
|
|
129 (string :tag "Program"))
|
|
|
130 (group :inline t
|
|
|
131 (const :format "" :value :prescript)
|
|
|
132 (choice :tag "Prescript"
|
|
|
133 :value nil
|
|
|
134 (string :format "%v")
|
|
85712
|
135 (function :format "%v")
|
|
|
136 (const :tag "None" nil)))
|
|
71262
|
137 (group :inline t
|
|
|
138 (const :format "" :value :postscript)
|
|
|
139 (choice :tag "Postscript"
|
|
|
140 :value nil
|
|
|
141 (string :format "%v")
|
|
85712
|
142 (function :format "%v")
|
|
|
143 (const :tag "None" nil)))
|
|
71262
|
144 (group :inline t
|
|
|
145 (const :format "" :value :function)
|
|
|
146 (function :tag "Function"))
|
|
|
147 (group :inline t
|
|
|
148 (const :format ""
|
|
|
149 :value :authentication)
|
|
|
150 (choice :tag "Authentication"
|
|
|
151 :value apop
|
|
|
152 (const password)
|
|
|
153 (const apop)))
|
|
|
154 (group :inline t
|
|
|
155 (const :format "" :value :plugged)
|
|
85712
|
156 (boolean :tag "Plugged"))
|
|
|
157 (group :inline t
|
|
|
158 (const :format "" :value :stream)
|
|
|
159 (choice :tag "Stream"
|
|
|
160 :value nil
|
|
|
161 (const :tag "Clear" nil)
|
|
|
162 (const starttls)
|
|
|
163 (const :tag "SSL/TLS" ssl)))))
|
|
71262
|
164 (cons :tag "Maildir (qmail, postfix...)"
|
|
|
165 (const :format "" maildir)
|
|
|
166 (checklist :tag "Options" :greedy t
|
|
|
167 (group :inline t
|
|
|
168 (const :format "" :value :path)
|
|
|
169 (directory :tag "Path"))
|
|
|
170 (group :inline t
|
|
|
171 (const :format "" :value :plugged)
|
|
|
172 (boolean :tag "Plugged"))))
|
|
|
173 (cons :tag "IMAP server"
|
|
|
174 (const :format "" imap)
|
|
|
175 (checklist :tag "Options" :greedy t
|
|
|
176 (group :inline t
|
|
|
177 (const :format "" :value :server)
|
|
|
178 (string :tag "Server"))
|
|
|
179 (group :inline t
|
|
|
180 (const :format "" :value :port)
|
|
|
181 (choice :tag "Port"
|
|
|
182 :value 143
|
|
85712
|
183 integer string))
|
|
71262
|
184 (group :inline t
|
|
|
185 (const :format "" :value :user)
|
|
|
186 (string :tag "User"))
|
|
|
187 (group :inline t
|
|
|
188 (const :format "" :value :password)
|
|
|
189 (string :tag "Password"))
|
|
|
190 (group :inline t
|
|
|
191 (const :format "" :value :stream)
|
|
|
192 (choice :tag "Stream"
|
|
|
193 :value network
|
|
|
194 ,@mail-source-imap-streams))
|
|
|
195 (group :inline t
|
|
|
196 (const :format "" :value :program)
|
|
|
197 (string :tag "Program"))
|
|
|
198 (group :inline t
|
|
|
199 (const :format ""
|
|
|
200 :value :authenticator)
|
|
|
201 (choice :tag "Authenticator"
|
|
|
202 :value login
|
|
|
203 ,@mail-source-imap-authenticators))
|
|
|
204 (group :inline t
|
|
|
205 (const :format "" :value :mailbox)
|
|
|
206 (string :tag "Mailbox"
|
|
|
207 :value "INBOX"))
|
|
|
208 (group :inline t
|
|
|
209 (const :format "" :value :predicate)
|
|
|
210 (string :tag "Predicate"
|
|
|
211 :value "UNSEEN UNDELETED"))
|
|
|
212 (group :inline t
|
|
|
213 (const :format "" :value :fetchflag)
|
|
|
214 (string :tag "Fetchflag"
|
|
|
215 :value "\\Deleted"))
|
|
|
216 (group :inline t
|
|
|
217 (const :format ""
|
|
|
218 :value :dontexpunge)
|
|
|
219 (boolean :tag "Dontexpunge"))
|
|
|
220 (group :inline t
|
|
|
221 (const :format "" :value :plugged)
|
|
|
222 (boolean :tag "Plugged"))))
|
|
|
223 (cons :tag "Webmail server"
|
|
|
224 (const :format "" webmail)
|
|
|
225 (checklist :tag "Options" :greedy t
|
|
|
226 (group :inline t
|
|
85712
|
227 (const :format "" :value :subtype)
|
|
|
228 ;; Should be generated from
|
|
|
229 ;; `webmail-type-definition', but we
|
|
|
230 ;; can't require webmail without W3.
|
|
|
231 (choice :tag "Subtype"
|
|
|
232 :value hotmail
|
|
|
233 (const hotmail)
|
|
|
234 (const yahoo)
|
|
|
235 (const netaddress)
|
|
|
236 (const netscape)
|
|
|
237 (const my-deja)))
|
|
71262
|
238 (group :inline t
|
|
|
239 (const :format "" :value :user)
|
|
|
240 (string :tag "User"))
|
|
|
241 (group :inline t
|
|
|
242 (const :format "" :value :password)
|
|
|
243 (string :tag "Password"))
|
|
|
244 (group :inline t
|
|
|
245 (const :format ""
|
|
|
246 :value :dontexpunge)
|
|
|
247 (boolean :tag "Dontexpunge"))
|
|
|
248 (group :inline t
|
|
|
249 (const :format "" :value :plugged)
|
|
|
250 (boolean :tag "Plugged"))))))))
|
|
31717
|
251
|
|
56927
|
252 (defcustom mail-source-ignore-errors nil
|
|
|
253 "*Ignore errors when querying mail sources.
|
|
|
254 If nil, the user will be prompted when an error occurs. If non-nil,
|
|
57153
|
255 the error will be ignored."
|
|
59996
|
256 :version "22.1"
|
|
57153
|
257 :group 'mail-source
|
|
|
258 :type 'boolean)
|
|
56927
|
259
|
|
31717
|
260 (defcustom mail-source-primary-source nil
|
|
|
261 "*Primary source for incoming mail.
|
|
|
262 If non-nil, this maildrop will be checked periodically for new mail."
|
|
|
263 :group 'mail-source
|
|
|
264 :type 'sexp)
|
|
|
265
|
|
56927
|
266 (defcustom mail-source-flash t
|
|
|
267 "*If non-nil, flash periodically when mail is available."
|
|
|
268 :group 'mail-source
|
|
|
269 :type 'boolean)
|
|
|
270
|
|
31717
|
271 (defcustom mail-source-crash-box "~/.emacs-mail-crash-box"
|
|
|
272 "File where mail will be stored while processing it."
|
|
|
273 :group 'mail-source
|
|
|
274 :type 'file)
|
|
|
275
|
|
56927
|
276 (defcustom mail-source-directory message-directory
|
|
57581
|
277 "Directory where incoming mail source files (if any) will be stored."
|
|
31717
|
278 :group 'mail-source
|
|
|
279 :type 'directory)
|
|
|
280
|
|
|
281 (defcustom mail-source-default-file-modes 384
|
|
|
282 "Set the mode bits of all new mail files to this integer."
|
|
|
283 :group 'mail-source
|
|
|
284 :type 'integer)
|
|
|
285
|
|
92147
|
286 (defcustom mail-source-delete-incoming
|
|
|
287 10 ;; development versions
|
|
|
288 ;; 2 ;; released versions
|
|
|
289 "If non-nil, delete incoming files after handling.
|
|
56927
|
290 If t, delete immediately, if nil, never delete. If a positive number, delete
|
|
92147
|
291 files older than number of days.
|
|
|
292
|
|
|
293 Removing of old files happens in `mail-source-callback', i.e. no
|
|
|
294 old incoming files will be deleted unless you receive new mail.
|
|
|
295 You may also set this variable to nil and call
|
|
|
296 `mail-source-delete-old-incoming' interactively."
|
|
56927
|
297 :group 'mail-source
|
|
92147
|
298 :version "22.2" ;; No Gnus / Gnus 5.10.10 (default changed)
|
|
56927
|
299 :type '(choice (const :tag "immediately" t)
|
|
|
300 (const :tag "never" nil)
|
|
|
301 (integer :tag "days")))
|
|
|
302
|
|
92695
|
303 (defcustom mail-source-delete-old-incoming-confirm nil
|
|
|
304 "If non-nil, ask for confirmation before deleting old incoming files.
|
|
56927
|
305 This variable only applies when `mail-source-delete-incoming' is a positive
|
|
|
306 number."
|
|
92695
|
307 :version "22.2" ;; No Gnus / Gnus 5.10.10 (default changed)
|
|
31717
|
308 :group 'mail-source
|
|
|
309 :type 'boolean)
|
|
|
310
|
|
|
311 (defcustom mail-source-incoming-file-prefix "Incoming"
|
|
|
312 "Prefix for file name for storing incoming mail"
|
|
|
313 :group 'mail-source
|
|
|
314 :type 'string)
|
|
|
315
|
|
|
316 (defcustom mail-source-report-new-mail-interval 5
|
|
|
317 "Interval in minutes between checks for new mail."
|
|
|
318 :group 'mail-source
|
|
|
319 :type 'number)
|
|
|
320
|
|
|
321 (defcustom mail-source-idle-time-delay 5
|
|
|
322 "Number of idle seconds to wait before checking for new mail."
|
|
|
323 :group 'mail-source
|
|
|
324 :type 'number)
|
|
|
325
|
|
56927
|
326 (defcustom mail-source-movemail-program nil
|
|
|
327 "If non-nil, name of program for fetching new mail."
|
|
59996
|
328 :version "22.1"
|
|
56927
|
329 :group 'mail-source
|
|
|
330 :type '(choice (const nil) string))
|
|
|
331
|
|
31717
|
332 ;;; Internal variables.
|
|
|
333
|
|
|
334 (defvar mail-source-string ""
|
|
|
335 "A dynamically bound string that says what the current mail source is.")
|
|
|
336
|
|
|
337 (defvar mail-source-new-mail-available nil
|
|
|
338 "Flag indicating when new mail is available.")
|
|
|
339
|
|
|
340 (eval-and-compile
|
|
|
341 (defvar mail-source-common-keyword-map
|
|
|
342 '((:plugged))
|
|
|
343 "Mapping from keywords to default values.
|
|
|
344 Common keywords should be listed here.")
|
|
|
345
|
|
|
346 (defvar mail-source-keyword-map
|
|
|
347 '((file
|
|
|
348 (:prescript)
|
|
|
349 (:prescript-delay)
|
|
|
350 (:postscript)
|
|
|
351 (:path (or (getenv "MAIL")
|
|
32918
|
352 (expand-file-name (user-login-name) rmail-spool-directory))))
|
|
31717
|
353 (directory
|
|
43422
|
354 (:prescript)
|
|
|
355 (:prescript-delay)
|
|
|
356 (:postscript)
|
|
31717
|
357 (:path)
|
|
|
358 (:suffix ".spool")
|
|
|
359 (:predicate identity))
|
|
|
360 (pop
|
|
|
361 (:prescript)
|
|
|
362 (:prescript-delay)
|
|
|
363 (:postscript)
|
|
|
364 (:server (getenv "MAILHOST"))
|
|
|
365 (:port 110)
|
|
|
366 (:user (or (user-login-name) (getenv "LOGNAME") (getenv "USER")))
|
|
|
367 (:program)
|
|
|
368 (:function)
|
|
|
369 (:password)
|
|
85712
|
370 (:authentication password)
|
|
|
371 (:stream nil))
|
|
31717
|
372 (maildir
|
|
|
373 (:path (or (getenv "MAILDIR") "~/Maildir/"))
|
|
56927
|
374 (:subdirs ("cur" "new"))
|
|
31717
|
375 (:function))
|
|
|
376 (imap
|
|
|
377 (:server (getenv "MAILHOST"))
|
|
|
378 (:port)
|
|
|
379 (:stream)
|
|
56927
|
380 (:program)
|
|
31717
|
381 (:authentication)
|
|
|
382 (:user (or (user-login-name) (getenv "LOGNAME") (getenv "USER")))
|
|
|
383 (:password)
|
|
|
384 (:mailbox "INBOX")
|
|
|
385 (:predicate "UNSEEN UNDELETED")
|
|
|
386 (:fetchflag "\\Deleted")
|
|
56927
|
387 (:prescript)
|
|
|
388 (:prescript-delay)
|
|
|
389 (:postscript)
|
|
31717
|
390 (:dontexpunge))
|
|
|
391 (webmail
|
|
|
392 (:subtype hotmail)
|
|
|
393 (:user (or (user-login-name) (getenv "LOGNAME") (getenv "USER")))
|
|
|
394 (:password)
|
|
|
395 (:dontexpunge)
|
|
|
396 (:authentication password)))
|
|
|
397 "Mapping from keywords to default values.
|
|
|
398 All keywords that can be used must be listed here."))
|
|
|
399
|
|
|
400 (defvar mail-source-fetcher-alist
|
|
|
401 '((file mail-source-fetch-file)
|
|
|
402 (directory mail-source-fetch-directory)
|
|
|
403 (pop mail-source-fetch-pop)
|
|
|
404 (maildir mail-source-fetch-maildir)
|
|
|
405 (imap mail-source-fetch-imap)
|
|
|
406 (webmail mail-source-fetch-webmail))
|
|
|
407 "A mapping from source type to fetcher function.")
|
|
|
408
|
|
|
409 (defvar mail-source-password-cache nil)
|
|
|
410
|
|
|
411 (defvar mail-source-plugged t)
|
|
|
412
|
|
|
413 ;;; Functions
|
|
|
414
|
|
|
415 (eval-and-compile
|
|
|
416 (defun mail-source-strip-keyword (keyword)
|
|
|
417 "Strip the leading colon off the KEYWORD."
|
|
|
418 (intern (substring (symbol-name keyword) 1))))
|
|
|
419
|
|
94369
|
420 ;; generate a list of variable names paired with nil values
|
|
|
421 ;; suitable for usage in a `let' form
|
|
31717
|
422 (eval-and-compile
|
|
|
423 (defun mail-source-bind-1 (type)
|
|
|
424 (let* ((defaults (cdr (assq type mail-source-keyword-map)))
|
|
|
425 default bind)
|
|
|
426 (while (setq default (pop defaults))
|
|
|
427 (push (list (mail-source-strip-keyword (car default))
|
|
|
428 nil)
|
|
|
429 bind))
|
|
|
430 bind)))
|
|
|
431
|
|
|
432 (defmacro mail-source-bind (type-source &rest body)
|
|
|
433 "Return a `let' form that binds all variables in source TYPE.
|
|
|
434 TYPE-SOURCE is a list where the first element is the TYPE, and
|
|
|
435 the second variable is the SOURCE.
|
|
|
436 At run time, the mail source specifier SOURCE will be inspected,
|
|
|
437 and the variables will be set according to it. Variables not
|
|
|
438 specified will be given default values.
|
|
|
439
|
|
94369
|
440 The user and password will be loaded from the auth-source values
|
|
|
441 if those are available. They override the original user and
|
|
|
442 password in a second `let' form.
|
|
|
443
|
|
31717
|
444 After this is done, BODY will be executed in the scope
|
|
94369
|
445 of the second `let' form.
|
|
31717
|
446
|
|
|
447 The variables bound and their default values are described by
|
|
|
448 the `mail-source-keyword-map' variable."
|
|
94369
|
449 `(let* ,(mail-source-bind-1 (car type-source))
|
|
31717
|
450 (mail-source-set-1 ,(cadr type-source))
|
|
94451
|
451 ,@body))
|
|
31717
|
452
|
|
|
453 (put 'mail-source-bind 'lisp-indent-function 1)
|
|
56927
|
454 (put 'mail-source-bind 'edebug-form-spec '(sexp body))
|
|
31717
|
455
|
|
|
456 (defun mail-source-set-1 (source)
|
|
|
457 (let* ((type (pop source))
|
|
|
458 (defaults (cdr (assq type mail-source-keyword-map)))
|
|
94451
|
459 default value keyword user-auth pass-auth)
|
|
31717
|
460 (while (setq default (pop defaults))
|
|
94369
|
461 ;; for each default :SYMBOL, set SYMBOL to the plist value for :SYMBOL
|
|
|
462 ;; using `mail-source-value' to evaluate the plist value
|
|
31717
|
463 (set (mail-source-strip-keyword (setq keyword (car default)))
|
|
94451
|
464 ;; note the following reasons for this structure:
|
|
|
465 ;; 1) the auth-sources user and password override everything
|
|
|
466 ;; 2) it avoids macros, so it's cleaner
|
|
|
467 ;; 3) it falls through to the mail-sources and then default values
|
|
|
468 (cond
|
|
|
469 ((and
|
|
|
470 (eq keyword :user)
|
|
|
471 (setq user-auth
|
|
|
472 (auth-source-user-or-password
|
|
|
473 "login"
|
|
|
474 ;; this is "host" in auth-sources
|
|
|
475 (if (boundp 'server) (symbol-value 'server) "")
|
|
|
476 type)))
|
|
|
477 user-auth)
|
|
|
478 ((and
|
|
|
479 (eq keyword :password)
|
|
|
480 (setq pass-auth
|
|
|
481 (auth-source-user-or-password
|
|
|
482 "password"
|
|
|
483 ;; this is "host" in auth-sources
|
|
|
484 (if (boundp 'server) (symbol-value 'server) "")
|
|
|
485 type)))
|
|
|
486 pass-auth)
|
|
|
487 (t (if (setq value (plist-get source keyword))
|
|
|
488 (mail-source-value value)
|
|
|
489 (mail-source-value (cadr default)))))))))
|
|
31717
|
490
|
|
|
491 (eval-and-compile
|
|
|
492 (defun mail-source-bind-common-1 ()
|
|
|
493 (let* ((defaults mail-source-common-keyword-map)
|
|
|
494 default bind)
|
|
|
495 (while (setq default (pop defaults))
|
|
|
496 (push (list (mail-source-strip-keyword (car default))
|
|
|
497 nil)
|
|
|
498 bind))
|
|
|
499 bind)))
|
|
|
500
|
|
|
501 (defun mail-source-set-common-1 (source)
|
|
|
502 (let* ((type (pop source))
|
|
|
503 (defaults mail-source-common-keyword-map)
|
|
|
504 (defaults-1 (cdr (assq type mail-source-keyword-map)))
|
|
|
505 default value keyword)
|
|
|
506 (while (setq default (pop defaults))
|
|
|
507 (set (mail-source-strip-keyword (setq keyword (car default)))
|
|
|
508 (if (setq value (plist-get source keyword))
|
|
|
509 (mail-source-value value)
|
|
|
510 (if (setq value (assq keyword defaults-1))
|
|
|
511 (mail-source-value (cadr value))
|
|
|
512 (mail-source-value (cadr default))))))))
|
|
|
513
|
|
|
514 (defmacro mail-source-bind-common (source &rest body)
|
|
|
515 "Return a `let' form that binds all common variables.
|
|
|
516 See `mail-source-bind'."
|
|
|
517 `(let ,(mail-source-bind-common-1)
|
|
|
518 (mail-source-set-common-1 source)
|
|
|
519 ,@body))
|
|
|
520
|
|
|
521 (put 'mail-source-bind-common 'lisp-indent-function 1)
|
|
56927
|
522 (put 'mail-source-bind-common 'edebug-form-spec '(sexp body))
|
|
31717
|
523
|
|
|
524 (defun mail-source-value (value)
|
|
|
525 "Return the value of VALUE."
|
|
|
526 (cond
|
|
|
527 ;; String
|
|
|
528 ((stringp value)
|
|
|
529 value)
|
|
|
530 ;; Function
|
|
93824
|
531 ((and (listp value) (symbolp (car value)) (fboundp (car value)))
|
|
31717
|
532 (eval value))
|
|
|
533 ;; Just return the value.
|
|
|
534 (t
|
|
|
535 value)))
|
|
|
536
|
|
|
537 (defun mail-source-fetch (source callback)
|
|
|
538 "Fetch mail from SOURCE and call CALLBACK zero or more times.
|
|
|
539 CALLBACK will be called with the name of the file where (some of)
|
|
|
540 the mail from SOURCE is put.
|
|
|
541 Return the number of files that were found."
|
|
|
542 (mail-source-bind-common source
|
|
|
543 (if (or mail-source-plugged plugged)
|
|
|
544 (save-excursion
|
|
|
545 (let ((function (cadr (assq (car source) mail-source-fetcher-alist)))
|
|
|
546 (found 0))
|
|
|
547 (unless function
|
|
|
548 (error "%S is an invalid mail source specification" source))
|
|
|
549 ;; If there's anything in the crash box, we do it first.
|
|
|
550 (when (file-exists-p mail-source-crash-box)
|
|
|
551 (message "Processing mail from %s..." mail-source-crash-box)
|
|
|
552 (setq found (mail-source-callback
|
|
85712
|
553 callback mail-source-crash-box))
|
|
|
554 (mail-source-delete-crash-box))
|
|
31717
|
555 (+ found
|
|
56927
|
556 (if (or debug-on-quit debug-on-error)
|
|
31717
|
557 (funcall function source callback)
|
|
56927
|
558 (condition-case err
|
|
|
559 (funcall function source callback)
|
|
|
560 (error
|
|
|
561 (if (and (not mail-source-ignore-errors)
|
|
|
562 (not
|
|
|
563 (yes-or-no-p
|
|
|
564 (format "Mail source %s error (%s). Continue? "
|
|
|
565 (if (memq ':password source)
|
|
|
566 (let ((s (copy-sequence source)))
|
|
59996
|
567 (setcar (cdr (memq ':password s))
|
|
56927
|
568 "********")
|
|
|
569 s)
|
|
|
570 source)
|
|
|
571 (cadr err)))))
|
|
|
572 (error "Cannot get new mail"))
|
|
|
573 0)))))))))
|
|
31717
|
574
|
|
56927
|
575 (defun mail-source-delete-old-incoming (&optional age confirm)
|
|
|
576 "Remove incoming files older than AGE days.
|
|
|
577 If CONFIRM is non-nil, ask for confirmation before removing a file."
|
|
|
578 (interactive "P")
|
|
|
579 (let* ((high2days (/ 65536.0 60 60 24));; convert high bits to days
|
|
|
580 (low2days (/ 1.0 65536.0)) ;; convert low bits to days
|
|
|
581 (diff (if (natnump age) age 30));; fallback, if no valid AGE given
|
|
|
582 currday files)
|
|
|
583 (setq files (directory-files
|
|
|
584 mail-source-directory t
|
|
93386
|
585 (concat "\\`"
|
|
|
586 (regexp-quote mail-source-incoming-file-prefix)))
|
|
56927
|
587 currday (* (car (current-time)) high2days)
|
|
|
588 currday (+ currday (* low2days (nth 1 (current-time)))))
|
|
|
589 (while files
|
|
|
590 (let* ((ffile (car files))
|
|
|
591 (bfile (gnus-replace-in-string
|
|
|
592 ffile "\\`.*/\\([^/]+\\)\\'" "\\1"))
|
|
|
593 (filetime (nth 5 (file-attributes ffile)))
|
|
|
594 (fileday (* (car filetime) high2days))
|
|
|
595 (fileday (+ fileday (* low2days (nth 1 filetime)))))
|
|
|
596 (setq files (cdr files))
|
|
|
597 (when (and (> (- currday fileday) diff)
|
|
92695
|
598 (if confirm
|
|
|
599 (y-or-n-p
|
|
|
600 (format "\
|
|
|
601 Delete old (> %s day(s)) incoming mail file `%s'? " diff bfile))
|
|
|
602 (gnus-message 8 "\
|
|
|
603 Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile)
|
|
|
604 t))
|
|
56927
|
605 (delete-file ffile))))))
|
|
31717
|
606
|
|
|
607 (defun mail-source-callback (callback info)
|
|
85712
|
608 "Call CALLBACK on the mail file. Pass INFO on to CALLBACK."
|
|
31717
|
609 (if (or (not (file-exists-p mail-source-crash-box))
|
|
|
610 (zerop (nth 7 (file-attributes mail-source-crash-box))))
|
|
|
611 (progn
|
|
|
612 (when (file-exists-p mail-source-crash-box)
|
|
|
613 (delete-file mail-source-crash-box))
|
|
|
614 0)
|
|
85712
|
615 (funcall callback mail-source-crash-box info)))
|
|
|
616
|
|
|
617 (defun mail-source-delete-crash-box ()
|
|
|
618 (when (file-exists-p mail-source-crash-box)
|
|
|
619 ;; Delete or move the incoming mail out of the way.
|
|
|
620 (if (eq mail-source-delete-incoming t)
|
|
|
621 (delete-file mail-source-crash-box)
|
|
|
622 (let ((incoming
|
|
|
623 (mm-make-temp-file
|
|
|
624 (expand-file-name
|
|
|
625 mail-source-incoming-file-prefix
|
|
|
626 mail-source-directory))))
|
|
|
627 (unless (file-exists-p (file-name-directory incoming))
|
|
|
628 (make-directory (file-name-directory incoming) t))
|
|
|
629 (rename-file mail-source-crash-box incoming t)
|
|
|
630 ;; remove old incoming files?
|
|
|
631 (when (natnump mail-source-delete-incoming)
|
|
|
632 (mail-source-delete-old-incoming
|
|
|
633 mail-source-delete-incoming
|
|
|
634 mail-source-delete-old-incoming-confirm))))))
|
|
31717
|
635
|
|
|
636 (defun mail-source-movemail (from to)
|
|
|
637 "Move FROM to TO using movemail."
|
|
|
638 (if (not (file-writable-p to))
|
|
|
639 (error "Can't write to crash box %s. Not moving mail" to)
|
|
|
640 (let ((to (file-truename (expand-file-name to)))
|
|
|
641 errors result)
|
|
|
642 (setq to (file-truename to)
|
|
|
643 from (file-truename from))
|
|
|
644 ;; Set TO if have not already done so, and rename or copy
|
|
|
645 ;; the file FROM to TO if and as appropriate.
|
|
|
646 (cond
|
|
|
647 ((file-exists-p to)
|
|
|
648 ;; The crash box exists already.
|
|
|
649 t)
|
|
|
650 ((not (file-exists-p from))
|
|
|
651 ;; There is no inbox.
|
|
|
652 (setq to nil))
|
|
|
653 ((zerop (nth 7 (file-attributes from)))
|
|
|
654 ;; Empty file.
|
|
|
655 (setq to nil))
|
|
|
656 (t
|
|
|
657 ;; If getting from mail spool directory, use movemail to move
|
|
|
658 ;; rather than just renaming, so as to interlock with the
|
|
|
659 ;; mailer.
|
|
|
660 (unwind-protect
|
|
|
661 (save-excursion
|
|
|
662 (setq errors (generate-new-buffer " *mail source loss*"))
|
|
|
663 (let ((default-directory "/"))
|
|
|
664 (setq result
|
|
|
665 (apply
|
|
|
666 'call-process
|
|
|
667 (append
|
|
|
668 (list
|
|
56927
|
669 (or mail-source-movemail-program
|
|
|
670 (expand-file-name "movemail" exec-directory))
|
|
31717
|
671 nil errors nil from to)))))
|
|
|
672 (when (file-exists-p to)
|
|
|
673 (set-file-modes to mail-source-default-file-modes))
|
|
56927
|
674 (if (and (or (not (buffer-modified-p errors))
|
|
|
675 (zerop (buffer-size errors)))
|
|
|
676 (and (numberp result)
|
|
|
677 (zerop result)))
|
|
31717
|
678 ;; No output => movemail won.
|
|
|
679 t
|
|
|
680 (set-buffer errors)
|
|
|
681 ;; There may be a warning about older revisions. We
|
|
|
682 ;; ignore that.
|
|
|
683 (goto-char (point-min))
|
|
|
684 (if (search-forward "older revision" nil t)
|
|
|
685 t
|
|
|
686 ;; Probably a real error.
|
|
|
687 (subst-char-in-region (point-min) (point-max) ?\n ?\ )
|
|
|
688 (goto-char (point-max))
|
|
|
689 (skip-chars-backward " \t")
|
|
|
690 (delete-region (point) (point-max))
|
|
|
691 (goto-char (point-min))
|
|
|
692 (when (looking-at "movemail: ")
|
|
|
693 (delete-region (point-min) (match-end 0)))
|
|
56927
|
694 ;; Result may be a signal description string.
|
|
31717
|
695 (unless (yes-or-no-p
|
|
56927
|
696 (format "movemail: %s (%s return). Continue? "
|
|
31717
|
697 (buffer-string) result))
|
|
|
698 (error "%s" (buffer-string)))
|
|
|
699 (setq to nil)))))))
|
|
|
700 (when (and errors
|
|
|
701 (buffer-name errors))
|
|
|
702 (kill-buffer errors))
|
|
|
703 ;; Return whether we moved successfully or not.
|
|
|
704 to)))
|
|
|
705
|
|
|
706 (defun mail-source-movemail-and-remove (from to)
|
|
|
707 "Move FROM to TO using movemail, then remove FROM if empty."
|
|
|
708 (or (not (mail-source-movemail from to))
|
|
|
709 (not (zerop (nth 7 (file-attributes from))))
|
|
|
710 (delete-file from)))
|
|
|
711
|
|
|
712 (defun mail-source-fetch-with-program (program)
|
|
56927
|
713 (eq 0 (call-process shell-file-name nil nil nil
|
|
|
714 shell-command-switch program)))
|
|
31717
|
715
|
|
|
716 (defun mail-source-run-script (script spec &optional delay)
|
|
|
717 (when script
|
|
56927
|
718 (if (functionp script)
|
|
31717
|
719 (funcall script)
|
|
|
720 (mail-source-call-script
|
|
|
721 (format-spec script spec))))
|
|
|
722 (when delay
|
|
|
723 (sleep-for delay)))
|
|
|
724
|
|
|
725 (defun mail-source-call-script (script)
|
|
85712
|
726 (let ((background nil)
|
|
|
727 (stderr (get-buffer-create " *mail-source-stderr*"))
|
|
|
728 result)
|
|
31717
|
729 (when (string-match "& *$" script)
|
|
|
730 (setq script (substring script 0 (match-beginning 0))
|
|
|
731 background 0))
|
|
85712
|
732 (setq result
|
|
|
733 (call-process shell-file-name nil background nil
|
|
|
734 shell-command-switch script))
|
|
|
735 (when (and result
|
|
|
736 (not (zerop result)))
|
|
|
737 (set-buffer stderr)
|
|
|
738 (message "Mail source error: %s" (buffer-string)))
|
|
|
739 (kill-buffer stderr)))
|
|
31717
|
740
|
|
|
741 ;;;
|
|
|
742 ;;; Different fetchers
|
|
|
743 ;;;
|
|
|
744
|
|
|
745 (defun mail-source-fetch-file (source callback)
|
|
|
746 "Fetcher for single-file sources."
|
|
|
747 (mail-source-bind (file source)
|
|
|
748 (mail-source-run-script
|
|
|
749 prescript (format-spec-make ?t mail-source-crash-box)
|
|
|
750 prescript-delay)
|
|
|
751 (let ((mail-source-string (format "file:%s" path)))
|
|
|
752 (if (mail-source-movemail path mail-source-crash-box)
|
|
|
753 (prog1
|
|
|
754 (mail-source-callback callback path)
|
|
|
755 (mail-source-run-script
|
|
85712
|
756 postscript (format-spec-make ?t mail-source-crash-box))
|
|
|
757 (mail-source-delete-crash-box))
|
|
31717
|
758 0))))
|
|
|
759
|
|
|
760 (defun mail-source-fetch-directory (source callback)
|
|
|
761 "Fetcher for directory sources."
|
|
|
762 (mail-source-bind (directory source)
|
|
43421
|
763 (mail-source-run-script
|
|
56927
|
764 prescript (format-spec-make ?t path) prescript-delay)
|
|
31717
|
765 (let ((found 0)
|
|
|
766 (mail-source-string (format "directory:%s" path)))
|
|
|
767 (dolist (file (directory-files
|
|
|
768 path t (concat (regexp-quote suffix) "$")))
|
|
|
769 (when (and (file-regular-p file)
|
|
|
770 (funcall predicate file)
|
|
|
771 (mail-source-movemail file mail-source-crash-box))
|
|
85712
|
772 (incf found (mail-source-callback callback file))
|
|
|
773 (mail-source-run-script postscript (format-spec-make ?t path))
|
|
|
774 (mail-source-delete-crash-box)))
|
|
31717
|
775 found)))
|
|
|
776
|
|
|
777 (defun mail-source-fetch-pop (source callback)
|
|
|
778 "Fetcher for single-file sources."
|
|
|
779 (mail-source-bind (pop source)
|
|
85712
|
780 ;; fixme: deal with stream type in format specs
|
|
31717
|
781 (mail-source-run-script
|
|
|
782 prescript
|
|
|
783 (format-spec-make ?p password ?t mail-source-crash-box
|
|
|
784 ?s server ?P port ?u user)
|
|
|
785 prescript-delay)
|
|
|
786 (let ((from (format "%s:%s:%s" server user port))
|
|
|
787 (mail-source-string (format "pop:%s@%s" user server))
|
|
|
788 result)
|
|
|
789 (when (eq authentication 'password)
|
|
|
790 (setq password
|
|
|
791 (or password
|
|
|
792 (cdr (assoc from mail-source-password-cache))
|
|
56927
|
793 (read-passwd
|
|
31717
|
794 (format "Password for %s at %s: " user server)))))
|
|
|
795 (when server
|
|
|
796 (setenv "MAILHOST" server))
|
|
|
797 (setq result
|
|
|
798 (cond
|
|
|
799 (program
|
|
|
800 (mail-source-fetch-with-program
|
|
|
801 (format-spec
|
|
|
802 program
|
|
|
803 (format-spec-make ?p password ?t mail-source-crash-box
|
|
|
804 ?s server ?P port ?u user))))
|
|
|
805 (function
|
|
|
806 (funcall function mail-source-crash-box))
|
|
|
807 ;; The default is to use pop3.el.
|
|
|
808 (t
|
|
66299
|
809 (require 'pop3)
|
|
31717
|
810 (let ((pop3-password password)
|
|
|
811 (pop3-maildrop user)
|
|
|
812 (pop3-mailhost server)
|
|
|
813 (pop3-port port)
|
|
|
814 (pop3-authentication-scheme
|
|
85712
|
815 (if (eq authentication 'apop) 'apop 'pass))
|
|
|
816 (pop3-stream-type stream))
|
|
56927
|
817 (if (or debug-on-quit debug-on-error)
|
|
|
818 (save-excursion (pop3-movemail mail-source-crash-box))
|
|
|
819 (condition-case err
|
|
|
820 (save-excursion (pop3-movemail mail-source-crash-box))
|
|
|
821 (error
|
|
|
822 ;; We nix out the password in case the error
|
|
|
823 ;; was because of a wrong password being given.
|
|
|
824 (setq mail-source-password-cache
|
|
|
825 (delq (assoc from mail-source-password-cache)
|
|
|
826 mail-source-password-cache))
|
|
|
827 (signal (car err) (cdr err)))))))))
|
|
31717
|
828 (if result
|
|
|
829 (progn
|
|
|
830 (when (eq authentication 'password)
|
|
|
831 (unless (assoc from mail-source-password-cache)
|
|
|
832 (push (cons from password) mail-source-password-cache)))
|
|
|
833 (prog1
|
|
|
834 (mail-source-callback callback server)
|
|
|
835 ;; Update display-time's mail flag, if relevant.
|
|
|
836 (if (equal source mail-source-primary-source)
|
|
|
837 (setq mail-source-new-mail-available nil))
|
|
|
838 (mail-source-run-script
|
|
|
839 postscript
|
|
|
840 (format-spec-make ?p password ?t mail-source-crash-box
|
|
85712
|
841 ?s server ?P port ?u user))
|
|
|
842 (mail-source-delete-crash-box)))
|
|
31717
|
843 ;; We nix out the password in case the error
|
|
|
844 ;; was because of a wrong password being given.
|
|
|
845 (setq mail-source-password-cache
|
|
|
846 (delq (assoc from mail-source-password-cache)
|
|
|
847 mail-source-password-cache))
|
|
|
848 0))))
|
|
|
849
|
|
|
850 (defun mail-source-check-pop (source)
|
|
|
851 "Check whether there is new mail."
|
|
|
852 (mail-source-bind (pop source)
|
|
|
853 (let ((from (format "%s:%s:%s" server user port))
|
|
|
854 (mail-source-string (format "pop:%s@%s" user server))
|
|
|
855 result)
|
|
|
856 (when (eq authentication 'password)
|
|
|
857 (setq password
|
|
|
858 (or password
|
|
|
859 (cdr (assoc from mail-source-password-cache))
|
|
56927
|
860 (read-passwd
|
|
31717
|
861 (format "Password for %s at %s: " user server))))
|
|
|
862 (unless (assoc from mail-source-password-cache)
|
|
|
863 (push (cons from password) mail-source-password-cache)))
|
|
|
864 (when server
|
|
|
865 (setenv "MAILHOST" server))
|
|
|
866 (setq result
|
|
|
867 (cond
|
|
|
868 ;; No easy way to check whether mail is waiting for these.
|
|
|
869 (program)
|
|
|
870 (function)
|
|
|
871 ;; The default is to use pop3.el.
|
|
|
872 (t
|
|
66299
|
873 (require 'pop3)
|
|
31717
|
874 (let ((pop3-password password)
|
|
|
875 (pop3-maildrop user)
|
|
|
876 (pop3-mailhost server)
|
|
|
877 (pop3-port port)
|
|
|
878 (pop3-authentication-scheme
|
|
|
879 (if (eq authentication 'apop) 'apop 'pass)))
|
|
56927
|
880 (if (or debug-on-quit debug-on-error)
|
|
|
881 (save-excursion (pop3-get-message-count))
|
|
|
882 (condition-case err
|
|
|
883 (save-excursion (pop3-get-message-count))
|
|
|
884 (error
|
|
|
885 ;; We nix out the password in case the error
|
|
|
886 ;; was because of a wrong password being given.
|
|
|
887 (setq mail-source-password-cache
|
|
|
888 (delq (assoc from mail-source-password-cache)
|
|
|
889 mail-source-password-cache))
|
|
|
890 (signal (car err) (cdr err)))))))))
|
|
31717
|
891 (if result
|
|
|
892 ;; Inform display-time that we have new mail.
|
|
|
893 (setq mail-source-new-mail-available (> result 0))
|
|
|
894 ;; We nix out the password in case the error
|
|
|
895 ;; was because of a wrong password being given.
|
|
|
896 (setq mail-source-password-cache
|
|
|
897 (delq (assoc from mail-source-password-cache)
|
|
|
898 mail-source-password-cache)))
|
|
|
899 result)))
|
|
|
900
|
|
56927
|
901 (defun mail-source-touch-pop ()
|
|
|
902 "Open and close a POP connection shortly.
|
|
|
903 POP server should be defined in `mail-source-primary-source' (which is
|
|
|
904 preferred) or `mail-sources'. You may use it for the POP-before-SMTP
|
|
|
905 authentication. To do that, you need to set the
|
|
|
906 `message-send-mail-function' variable as `message-smtpmail-send-it'
|
|
|
907 and put the following line in your ~/.gnus.el file:
|
|
|
908
|
|
|
909 \(add-hook 'message-send-mail-hook 'mail-source-touch-pop)
|
|
|
910
|
|
|
911 See the Gnus manual for details."
|
|
|
912 (let ((sources (if mail-source-primary-source
|
|
|
913 (list mail-source-primary-source)
|
|
|
914 mail-sources)))
|
|
|
915 (while sources
|
|
|
916 (if (eq 'pop (car (car sources)))
|
|
|
917 (mail-source-check-pop (car sources)))
|
|
|
918 (setq sources (cdr sources)))))
|
|
|
919
|
|
31717
|
920 (defun mail-source-new-mail-p ()
|
|
|
921 "Handler for `display-time' to indicate when new mail is available."
|
|
56927
|
922 ;; Flash (ie. ring the visible bell) if mail is available.
|
|
|
923 (if (and mail-source-flash mail-source-new-mail-available)
|
|
|
924 (let ((visible-bell t))
|
|
|
925 (ding)))
|
|
31717
|
926 ;; Only report flag setting; flag is updated on a different schedule.
|
|
|
927 mail-source-new-mail-available)
|
|
|
928
|
|
|
929
|
|
|
930 (defvar mail-source-report-new-mail nil)
|
|
|
931 (defvar mail-source-report-new-mail-timer nil)
|
|
|
932 (defvar mail-source-report-new-mail-idle-timer nil)
|
|
|
933
|
|
|
934 (defun mail-source-start-idle-timer ()
|
|
|
935 ;; Start our idle timer if necessary, so we delay the check until the
|
|
|
936 ;; user isn't typing.
|
|
|
937 (unless mail-source-report-new-mail-idle-timer
|
|
|
938 (setq mail-source-report-new-mail-idle-timer
|
|
|
939 (run-with-idle-timer
|
|
|
940 mail-source-idle-time-delay
|
|
|
941 nil
|
|
|
942 (lambda ()
|
|
56927
|
943 (unwind-protect
|
|
|
944 (mail-source-check-pop mail-source-primary-source)
|
|
|
945 (setq mail-source-report-new-mail-idle-timer nil)))))
|
|
31717
|
946 ;; Since idle timers created when Emacs is already in the idle
|
|
|
947 ;; state don't get activated until Emacs _next_ becomes idle, we
|
|
|
948 ;; need to force our timer to be considered active now. We do
|
|
|
949 ;; this by being naughty and poking the timer internals directly
|
|
|
950 ;; (element 0 of the vector is nil if the timer is active).
|
|
|
951 (aset mail-source-report-new-mail-idle-timer 0 nil)))
|
|
|
952
|
|
|
953 (defun mail-source-report-new-mail (arg)
|
|
|
954 "Toggle whether to report when new mail is available.
|
|
|
955 This only works when `display-time' is enabled."
|
|
|
956 (interactive "P")
|
|
|
957 (if (not mail-source-primary-source)
|
|
38413
|
958 (error "Need to set `mail-source-primary-source' to check for new mail"))
|
|
31717
|
959 (let ((on (if (null arg)
|
|
|
960 (not mail-source-report-new-mail)
|
|
|
961 (> (prefix-numeric-value arg) 0))))
|
|
|
962 (setq mail-source-report-new-mail on)
|
|
|
963 (and mail-source-report-new-mail-timer
|
|
32102
|
964 (nnheader-cancel-timer mail-source-report-new-mail-timer))
|
|
31717
|
965 (and mail-source-report-new-mail-idle-timer
|
|
32102
|
966 (nnheader-cancel-timer mail-source-report-new-mail-idle-timer))
|
|
31717
|
967 (setq mail-source-report-new-mail-timer nil)
|
|
|
968 (setq mail-source-report-new-mail-idle-timer nil)
|
|
|
969 (if on
|
|
|
970 (progn
|
|
|
971 (require 'time)
|
|
31764
|
972 ;; display-time-mail-function is an Emacs 21 feature.
|
|
31717
|
973 (setq display-time-mail-function #'mail-source-new-mail-p)
|
|
|
974 ;; Set up the main timer.
|
|
|
975 (setq mail-source-report-new-mail-timer
|
|
85712
|
976 (run-at-time
|
|
56927
|
977 (* 60 mail-source-report-new-mail-interval)
|
|
|
978 (* 60 mail-source-report-new-mail-interval)
|
|
|
979 #'mail-source-start-idle-timer))
|
|
31717
|
980 ;; When you get new mail, clear "Mail" from the mode line.
|
|
|
981 (add-hook 'nnmail-post-get-new-mail-hook
|
|
|
982 'display-time-event-handler)
|
|
|
983 (message "Mail check enabled"))
|
|
|
984 (setq display-time-mail-function nil)
|
|
|
985 (remove-hook 'nnmail-post-get-new-mail-hook
|
|
|
986 'display-time-event-handler)
|
|
|
987 (message "Mail check disabled"))))
|
|
|
988
|
|
|
989 (defun mail-source-fetch-maildir (source callback)
|
|
|
990 "Fetcher for maildir sources."
|
|
|
991 (mail-source-bind (maildir source)
|
|
|
992 (let ((found 0)
|
|
|
993 mail-source-string)
|
|
|
994 (unless (string-match "/$" path)
|
|
|
995 (setq path (concat path "/")))
|
|
|
996 (dolist (subdir subdirs)
|
|
|
997 (when (file-directory-p (concat path subdir))
|
|
|
998 (setq mail-source-string (format "maildir:%s%s" path subdir))
|
|
|
999 (dolist (file (directory-files (concat path subdir) t))
|
|
|
1000 (when (and (not (file-directory-p file))
|
|
|
1001 (not (if function
|
|
|
1002 (funcall function file mail-source-crash-box)
|
|
49598
|
1003 (let ((coding-system-for-write
|
|
31717
|
1004 mm-text-coding-system)
|
|
49598
|
1005 (coding-system-for-read
|
|
31717
|
1006 mm-text-coding-system))
|
|
|
1007 (with-temp-file mail-source-crash-box
|
|
|
1008 (insert-file-contents file)
|
|
|
1009 (goto-char (point-min))
|
|
56927
|
1010 ;;; ;; Unix mail format
|
|
|
1011 ;;; (unless (looking-at "\n*From ")
|
|
|
1012 ;;; (insert "From maildir "
|
|
|
1013 ;;; (current-time-string) "\n"))
|
|
|
1014 ;;; (while (re-search-forward "^From " nil t)
|
|
|
1015 ;;; (replace-match ">From "))
|
|
|
1016 ;;; (goto-char (point-max))
|
|
32333
|
1017 ;;; (insert "\n\n")
|
|
31717
|
1018 ;; MMDF mail format
|
|
32333
|
1019 (insert "\001\001\001\001\n"))
|
|
31717
|
1020 (delete-file file)))))
|
|
85712
|
1021 (incf found (mail-source-callback callback file))
|
|
|
1022 (mail-source-delete-crash-box)))))
|
|
31717
|
1023 found)))
|
|
|
1024
|
|
95820
|
1025 (autoload 'imap-open "imap")
|
|
|
1026 (autoload 'imap-authenticate "imap")
|
|
|
1027 (autoload 'imap-mailbox-select "imap")
|
|
|
1028 (autoload 'imap-mailbox-unselect "imap")
|
|
|
1029 (autoload 'imap-mailbox-close "imap")
|
|
|
1030 (autoload 'imap-search "imap")
|
|
|
1031 (autoload 'imap-fetch "imap")
|
|
|
1032 (autoload 'imap-close "imap")
|
|
|
1033 (autoload 'imap-error-text "imap")
|
|
|
1034 (autoload 'imap-message-flags-add "imap")
|
|
|
1035 (autoload 'imap-list-to-message-set "imap")
|
|
|
1036 (autoload 'imap-range-to-message-set "imap")
|
|
|
1037 (autoload 'nnheader-ms-strip-cr "nnheader")
|
|
31717
|
1038
|
|
87246
|
1039 (autoload 'gnus-compress-sequence "gnus-range")
|
|
|
1040
|
|
32102
|
1041 (defvar mail-source-imap-file-coding-system 'binary
|
|
|
1042 "Coding system for the crashbox made by `mail-source-fetch-imap'.")
|
|
|
1043
|
|
87246
|
1044 ;; Autoloads will bring in imap before this is called.
|
|
|
1045 (declare-function imap-capability "imap" (&optional identifier buffer))
|
|
|
1046
|
|
31717
|
1047 (defun mail-source-fetch-imap (source callback)
|
|
|
1048 "Fetcher for imap sources."
|
|
|
1049 (mail-source-bind (imap source)
|
|
56927
|
1050 (mail-source-run-script
|
|
|
1051 prescript (format-spec-make ?p password ?t mail-source-crash-box
|
|
|
1052 ?s server ?P port ?u user)
|
|
|
1053 prescript-delay)
|
|
31717
|
1054 (let ((from (format "%s:%s:%s" server user port))
|
|
|
1055 (found 0)
|
|
56927
|
1056 (buf (generate-new-buffer " *imap source*"))
|
|
31717
|
1057 (mail-source-string (format "imap:%s:%s" server mailbox))
|
|
56927
|
1058 (imap-shell-program (or (list program) imap-shell-program))
|
|
31717
|
1059 remove)
|
|
|
1060 (if (and (imap-open server port stream authentication buf)
|
|
|
1061 (imap-authenticate
|
|
|
1062 user (or (cdr (assoc from mail-source-password-cache))
|
|
|
1063 password) buf)
|
|
|
1064 (imap-mailbox-select mailbox nil buf))
|
|
32918
|
1065 (let ((coding-system-for-write mail-source-imap-file-coding-system)
|
|
32333
|
1066 str)
|
|
31717
|
1067 (with-temp-file mail-source-crash-box
|
|
32918
|
1068 ;; Avoid converting 8-bit chars from inserted strings to
|
|
|
1069 ;; multibyte.
|
|
|
1070 (mm-disable-multibyte)
|
|
31717
|
1071 ;; remember password
|
|
|
1072 (with-current-buffer buf
|
|
56927
|
1073 (when (and imap-password
|
|
|
1074 (not (assoc from mail-source-password-cache)))
|
|
31717
|
1075 (push (cons from imap-password) mail-source-password-cache)))
|
|
|
1076 ;; if predicate is nil, use all uids
|
|
|
1077 (dolist (uid (imap-search (or predicate "1:*") buf))
|
|
56927
|
1078 (when (setq str
|
|
|
1079 (if (imap-capability 'IMAP4rev1 buf)
|
|
|
1080 (caddar (imap-fetch uid "BODY.PEEK[]"
|
|
|
1081 'BODYDETAIL nil buf))
|
|
|
1082 (imap-fetch uid "RFC822.PEEK" 'RFC822 nil buf)))
|
|
31717
|
1083 (push uid remove)
|
|
|
1084 (insert "From imap " (current-time-string) "\n")
|
|
|
1085 (save-excursion
|
|
|
1086 (insert str "\n\n"))
|
|
85712
|
1087 (while (let ((case-fold-search nil))
|
|
|
1088 (re-search-forward "^From " nil t))
|
|
31717
|
1089 (replace-match ">From "))
|
|
|
1090 (goto-char (point-max))))
|
|
|
1091 (nnheader-ms-strip-cr))
|
|
|
1092 (incf found (mail-source-callback callback server))
|
|
85712
|
1093 (mail-source-delete-crash-box)
|
|
31717
|
1094 (when (and remove fetchflag)
|
|
56927
|
1095 (setq remove (nreverse remove))
|
|
31717
|
1096 (imap-message-flags-add
|
|
32102
|
1097 (imap-range-to-message-set (gnus-compress-sequence remove))
|
|
|
1098 fetchflag nil buf))
|
|
31717
|
1099 (if dontexpunge
|
|
|
1100 (imap-mailbox-unselect buf)
|
|
56927
|
1101 (imap-mailbox-close nil buf))
|
|
31717
|
1102 (imap-close buf))
|
|
|
1103 (imap-close buf)
|
|
|
1104 ;; We nix out the password in case the error
|
|
|
1105 ;; was because of a wrong password being given.
|
|
|
1106 (setq mail-source-password-cache
|
|
|
1107 (delq (assoc from mail-source-password-cache)
|
|
|
1108 mail-source-password-cache))
|
|
56927
|
1109 (error "IMAP error: %s" (imap-error-text buf)))
|
|
31717
|
1110 (kill-buffer buf)
|
|
56927
|
1111 (mail-source-run-script
|
|
|
1112 postscript
|
|
|
1113 (format-spec-make ?p password ?t mail-source-crash-box
|
|
|
1114 ?s server ?P port ?u user))
|
|
31717
|
1115 found)))
|
|
|
1116
|
|
95820
|
1117 (autoload 'webmail-fetch "webmail")
|
|
31717
|
1118
|
|
|
1119 (defun mail-source-fetch-webmail (source callback)
|
|
|
1120 "Fetch for webmail source."
|
|
|
1121 (mail-source-bind (webmail source)
|
|
|
1122 (let ((mail-source-string (format "webmail:%s:%s" subtype user))
|
|
|
1123 (webmail-newmail-only dontexpunge)
|
|
|
1124 (webmail-move-to-trash-can (not dontexpunge)))
|
|
|
1125 (when (eq authentication 'password)
|
|
|
1126 (setq password
|
|
|
1127 (or password
|
|
49598
|
1128 (cdr (assoc (format "webmail:%s:%s" subtype user)
|
|
31717
|
1129 mail-source-password-cache))
|
|
56927
|
1130 (read-passwd
|
|
31717
|
1131 (format "Password for %s at %s: " user subtype))))
|
|
|
1132 (when (and password
|
|
49598
|
1133 (not (assoc (format "webmail:%s:%s" subtype user)
|
|
31717
|
1134 mail-source-password-cache)))
|
|
49598
|
1135 (push (cons (format "webmail:%s:%s" subtype user) password)
|
|
31717
|
1136 mail-source-password-cache)))
|
|
|
1137 (webmail-fetch mail-source-crash-box subtype user password)
|
|
85712
|
1138 (mail-source-callback callback (symbol-name subtype))
|
|
|
1139 (mail-source-delete-crash-box))))
|
|
31717
|
1140
|
|
|
1141 (provide 'mail-source)
|
|
|
1142
|
|
93975
|
1143 ;; arch-tag: 72948025-1d17-4d6c-bb12-ef1aa2c490fd
|
|
31717
|
1144 ;;; mail-source.el ends here
|
