cgit.sxemacs.org Git - gnus/blob - lisp/mail-source.el

   1 ;;; mail-source.el --- functions for fetching mail
   2 ;; Copyright (C) 1999, 2000, 2001, 2002, 2003 Free Software Foundation, Inc.
   3
   4 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
   5 ;; Keywords: news, mail
   6
   7 ;; This file is part of GNU Emacs.
   8
   9 ;; GNU Emacs is free software; you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation; either version 2, or (at your option)
  12 ;; any later version.
  13
  14 ;; GNU Emacs is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  21 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  22 ;; Boston, MA 02111-1307, USA.
  23
  24 ;;; Commentary:
  25
  26 ;;; Code:
  27
  28 (eval-when-compile
  29   (require 'cl)
  30   (require 'imap)
  31   (eval-when-compile (defvar display-time-mail-function)))
  32 (eval-and-compile
  33   (autoload 'pop3-movemail "pop3")
  34   (autoload 'pop3-get-message-count "pop3")
  35   (autoload 'nnheader-cancel-timer "nnheader")
  36   (autoload 'nnheader-run-at-time "nnheader"))
  37 (require 'format-spec)
  38 (require 'mm-util)
  39 (require 'message) ;; for `message-directory'
  40
  41 (defgroup mail-source nil
  42   "The mail-fetching library."
  43   :version "21.1"
  44   :group 'gnus)
  45
  46 ;; Define these at compile time to avoid dragging in imap always.
  47 (defconst mail-source-imap-authenticators
  48   (eval-when-compile
  49     (mapcar (lambda (a)
  50               (list 'const (car a)))
  51      imap-authenticator-alist)))
  52 (defconst mail-source-imap-streams
  53   (eval-when-compile
  54     (mapcar (lambda (a)
  55               (list 'const (car a)))
  56      imap-stream-alist)))
  57
  58 (defcustom mail-sources nil
  59   "*Where the mail backends will look for incoming mail.
  60 This variable is a list of mail source specifiers.
  61 See Info node `(gnus)Mail Source Specifiers'."
  62   :group 'mail-source
  63   :link '(custom-manual "(gnus)Mail Source Specifiers")
  64   :type `(repeat
  65           (choice :format "%[Value Menu%] %v"
  66                   :value (file)
  67                   (cons :tag "Spool file"
  68                         (const :format "" file)
  69                         (checklist :tag "Options" :greedy t
  70                                    (group :inline t
  71                                           (const :format "" :value :path)
  72                                           file)))
  73                   (cons :tag "Several files in a directory"
  74                         (const :format "" directory)
  75                         (checklist :tag "Options" :greedy t
  76                                    (group :inline t
  77                                           (const :format "" :value :path)
  78                                           (directory :tag "Path"))
  79                                    (group :inline t
  80                                           (const :format "" :value :suffix)
  81                                           (string :tag "Suffix"))
  82                                    (group :inline t
  83                                           (const :format "" :value :predicate)
  84                                           (function :tag "Predicate"))
  85                                    (group :inline t
  86                                           (const :format "" :value :prescript)
  87                                           (choice :tag "Prescript"
  88                                                   :value nil
  89                                                   (string :format "%v")
  90                                                   (function :format "%v")))
  91                                    (group :inline t
  92                                           (const :format "" :value :postscript)
  93                                           (choice :tag "Postscript"
  94                                                   :value nil
  95                                                   (string :format "%v")
  96                                                   (function :format "%v")))
  97                                    (group :inline t
  98                                           (const :format "" :value :plugged)
  99                                           (boolean :tag "Plugged"))))
 100                   (cons :tag "POP3 server"
 101                         (const :format "" pop)
 102                         (checklist :tag "Options" :greedy t
 103                                    (group :inline t
 104                                           (const :format "" :value :server)
 105                                           (string :tag "Server"))
 106                                    (group :inline t
 107                                           (const :format "" :value :port)
 108                                           (choice :tag "Port"
 109                                                   :value "pop3"
 110                                                   (number :format "%v")
 111                                                   (string :format "%v")))
 112                                    (group :inline t
 113                                           (const :format "" :value :user)
 114                                           (string :tag "User"))
 115                                    (group :inline t
 116                                           (const :format "" :value :password)
 117                                           (string :tag "Password"))
 118                                    (group :inline t
 119                                           (const :format "" :value :program)
 120                                           (string :tag "Program"))
 121                                    (group :inline t
 122                                           (const :format "" :value :prescript)
 123                                           (choice :tag "Prescript"
 124                                                   :value nil
 125                                                   (string :format "%v")
 126                                                   (function :format "%v")))
 127                                    (group :inline t
 128                                           (const :format "" :value :postscript)
 129                                           (choice :tag "Postscript"
 130                                                   :value nil
 131                                                   (string :format "%v")
 132                                                   (function :format "%v")))
 133                                    (group :inline t
 134                                           (const :format "" :value :function)
 135                                           (function :tag "Function"))
 136                                    (group :inline t
 137                                           (const :format ""
 138                                                  :value :authentication)
 139                                           (choice :tag "Authentication"
 140                                                   :value apop
 141                                                   (const password)
 142                                                   (const apop)))
 143                                    (group :inline t
 144                                           (const :format "" :value :plugged)
 145                                           (boolean :tag "Plugged"))))
 146                   (cons :tag "Maildir (qmail, postfix...)"
 147                         (const :format "" maildir)
 148                         (checklist :tag "Options" :greedy t
 149                                    (group :inline t
 150                                           (const :format "" :value :path)
 151                                           (directory :tag "Path"))
 152                                    (group :inline t
 153                                           (const :format "" :value :plugged)
 154                                           (boolean :tag "Plugged"))))
 155                   (cons :tag "IMAP server"
 156                         (const :format "" imap)
 157                         (checklist :tag "Options" :greedy t
 158                                    (group :inline t
 159                                           (const :format "" :value :server)
 160                                           (string :tag "Server"))
 161                                    (group :inline t
 162                                           (const :format "" :value :port)
 163                                           (choice :tag "Port"
 164                                                   :value 143
 165                                                   number string))
 166                                    (group :inline t
 167                                           (const :format "" :value :user)
 168                                           (string :tag "User"))
 169                                    (group :inline t
 170                                           (const :format "" :value :password)
 171                                           (string :tag "Password"))
 172                                    (group :inline t
 173                                           (const :format "" :value :stream)
 174                                           (choice :tag "Stream"
 175                                                   :value network
 176                                                   ,@mail-source-imap-streams))
 177                                    (group :inline t
 178                                           (const :format "" :value :program)
 179                                           (string :tag "Program"))
 180                                    (group :inline t
 181                                           (const :format ""
 182                                                  :value :authenticator)
 183                                           (choice :tag "Authenticator"
 184                                                   :value login
 185                                                   ,@mail-source-imap-authenticators))
 186                                    (group :inline t
 187                                           (const :format "" :value :mailbox)
 188                                           (string :tag "Mailbox"
 189                                                   :value "INBOX"))
 190                                    (group :inline t
 191                                           (const :format "" :value :predicate)
 192                                           (string :tag "Predicate"
 193                                                   :value "UNSEEN UNDELETED"))
 194                                    (group :inline t
 195                                           (const :format "" :value :fetchflag)
 196                                           (string :tag "Fetchflag"
 197                                                   :value  "\\Deleted"))
 198                                    (group :inline t
 199                                           (const :format ""
 200                                                  :value :dontexpunge)
 201                                           (boolean :tag "Dontexpunge"))
 202                                    (group :inline t
 203                                           (const :format "" :value :plugged)
 204                                           (boolean :tag "Plugged"))))
 205                   (cons :tag "Webmail server"
 206                         (const :format "" webmail)
 207                         (checklist :tag "Options" :greedy t
 208                                    (group :inline t
 209                                          (const :format "" :value :subtype)
 210                                          ;; Should be generated from
 211                                          ;; `webmail-type-definition', but we
 212                                          ;; can't require webmail without W3.
 213                                          (choice :tag "Subtype"
 214                                                  :value hotmail
 215                                                  (const hotmail)
 216                                                  (const yahoo)
 217                                                  (const netaddress)
 218                                                  (const netscape)
 219                                                  (const my-deja)))
 220                                    (group :inline t
 221                                           (const :format "" :value :user)
 222                                           (string :tag "User"))
 223                                    (group :inline t
 224                                           (const :format "" :value :password)
 225                                           (string :tag "Password"))
 226                                    (group :inline t
 227                                           (const :format ""
 228                                                  :value :dontexpunge)
 229                                           (boolean :tag "Dontexpunge"))
 230                                    (group :inline t
 231                                           (const :format "" :value :plugged)
 232                                           (boolean :tag "Plugged")))))))
 233
 234 (defcustom mail-source-ignore-errors nil
 235   "*Ignore errors when querying mail sources.
 236 If nil, the user will be prompted when an error occurs.  If non-nil,
 237 the error will be ignored.")
 238
 239 (defcustom mail-source-primary-source nil
 240   "*Primary source for incoming mail.
 241 If non-nil, this maildrop will be checked periodically for new mail."
 242   :group 'mail-source
 243   :type 'sexp)
 244
 245 (defcustom mail-source-flash t
 246   "*If non-nil, flash periodically when mail is available."
 247   :group 'mail-source
 248   :type 'boolean)
 249
 250 (defcustom mail-source-crash-box "~/.emacs-mail-crash-box"
 251   "File where mail will be stored while processing it."
 252   :group 'mail-source
 253   :type 'file)
 254
 255 (defcustom mail-source-directory message-directory
 256   "Directory where files (if any) will be stored."
 257   :group 'mail-source
 258   :type 'directory)
 259
 260 (defcustom mail-source-default-file-modes 384
 261   "Set the mode bits of all new mail files to this integer."
 262   :group 'mail-source
 263   :type 'integer)
 264
 265 (defcustom mail-source-delete-incoming nil
 266   "*If non-nil, delete incoming files after handling.
 267 If t, delete immediately, if nil, never delete.  If a positive number, delete
 268 files older than number of days."
 269   ;; Note: The removing happens in `mail-source-callback', i.e. no old
 270   ;; incoming files will be deleted, unless you receive new mail.
 271   ;;
 272   ;; You may also set this to `nil' and call `mail-source-delete-old-incoming'
 273   ;; from a hook or interactively.
 274   :group 'mail-source
 275   :type '(choice (const :tag "immediately" t)
 276                  (const :tag "never" nil)
 277                  (integer :tag "days")))
 278
 279 (defcustom mail-source-delete-old-incoming-confirm t
 280   "*If non-nil, ask for for confirmation before deleting old incoming files.
 281 This variable only applies when `mail-source-delete-incoming' is a positive
 282 number."
 283   :group 'mail-source
 284   :type 'boolean)
 285
 286 (defcustom mail-source-incoming-file-prefix "Incoming"
 287   "Prefix for file name for storing incoming mail"
 288   :group 'mail-source
 289   :type 'string)
 290
 291 (defcustom mail-source-report-new-mail-interval 5
 292   "Interval in minutes between checks for new mail."
 293   :group 'mail-source
 294   :type 'number)
 295
 296 (defcustom mail-source-idle-time-delay 5
 297   "Number of idle seconds to wait before checking for new mail."
 298   :group 'mail-source
 299   :type 'number)
 300
 301 (defcustom mail-source-movemail-program nil
 302   "If non-nil, name of program for fetching new mail."
 303   :group 'mail-source
 304   :type '(choice (const nil) string))
 305
 306 ;;; Internal variables.
 307
 308 (defvar mail-source-string ""
 309   "A dynamically bound string that says what the current mail source is.")
 310
 311 (defvar mail-source-new-mail-available nil
 312   "Flag indicating when new mail is available.")
 313
 314 (eval-and-compile
 315   (defvar mail-source-common-keyword-map
 316     '((:plugged))
 317     "Mapping from keywords to default values.
 318 Common keywords should be listed here.")
 319
 320   (defvar mail-source-keyword-map
 321     '((file
 322        (:prescript)
 323        (:prescript-delay)
 324        (:postscript)
 325        (:path (or (getenv "MAIL")
 326                   (expand-file-name (user-login-name) rmail-spool-directory))))
 327       (directory
 328        (:prescript)
 329        (:prescript-delay)
 330        (:postscript)
 331        (:path)
 332        (:suffix ".spool")
 333        (:predicate identity))
 334       (pop
 335        (:prescript)
 336        (:prescript-delay)
 337        (:postscript)
 338        (:server (getenv "MAILHOST"))
 339        (:port 110)
 340        (:user (or (user-login-name) (getenv "LOGNAME") (getenv "USER")))
 341        (:program)
 342        (:function)
 343        (:password)
 344        (:authentication password))
 345       (maildir
 346        (:path (or (getenv "MAILDIR") "~/Maildir/"))
 347        (:subdirs ("new" "cur"))
 348        (:function))
 349       (imap
 350        (:server (getenv "MAILHOST"))
 351        (:port)
 352        (:stream)
 353        (:program)
 354        (:authentication)
 355        (:user (or (user-login-name) (getenv "LOGNAME") (getenv "USER")))
 356        (:password)
 357        (:mailbox "INBOX")
 358        (:predicate "UNSEEN UNDELETED")
 359        (:fetchflag "\\Deleted")
 360        (:dontexpunge))
 361       (webmail
 362        (:subtype hotmail)
 363        (:user (or (user-login-name) (getenv "LOGNAME") (getenv "USER")))
 364        (:password)
 365        (:dontexpunge)
 366        (:authentication password)))
 367     "Mapping from keywords to default values.
 368 All keywords that can be used must be listed here."))
 369
 370 (defvar mail-source-fetcher-alist
 371   '((file mail-source-fetch-file)
 372     (directory mail-source-fetch-directory)
 373     (pop mail-source-fetch-pop)
 374     (maildir mail-source-fetch-maildir)
 375     (imap mail-source-fetch-imap)
 376     (webmail mail-source-fetch-webmail))
 377   "A mapping from source type to fetcher function.")
 378
 379 (defvar mail-source-password-cache nil)
 380
 381 (defvar mail-source-plugged t)
 382
 383 ;;; Functions
 384
 385 (eval-and-compile
 386   (defun mail-source-strip-keyword (keyword)
 387     "Strip the leading colon off the KEYWORD."
 388     (intern (substring (symbol-name keyword) 1))))
 389
 390 (eval-and-compile
 391   (defun mail-source-bind-1 (type)
 392     (let* ((defaults (cdr (assq type mail-source-keyword-map)))
 393            default bind)
 394       (while (setq default (pop defaults))
 395         (push (list (mail-source-strip-keyword (car default))
 396                     nil)
 397               bind))
 398       bind)))
 399
 400 (defmacro mail-source-bind (type-source &rest body)
 401   "Return a `let' form that binds all variables in source TYPE.
 402 TYPE-SOURCE is a list where the first element is the TYPE, and
 403 the second variable is the SOURCE.
 404 At run time, the mail source specifier SOURCE will be inspected,
 405 and the variables will be set according to it.  Variables not
 406 specified will be given default values.
 407
 408 After this is done, BODY will be executed in the scope
 409 of the `let' form.
 410
 411 The variables bound and their default values are described by
 412 the `mail-source-keyword-map' variable."
 413   `(let ,(mail-source-bind-1 (car type-source))
 414      (mail-source-set-1 ,(cadr type-source))
 415      ,@body))
 416
 417 (put 'mail-source-bind 'lisp-indent-function 1)
 418 (put 'mail-source-bind 'edebug-form-spec '(sexp body))
 419
 420 (defun mail-source-set-1 (source)
 421   (let* ((type (pop source))
 422          (defaults (cdr (assq type mail-source-keyword-map)))
 423          default value keyword)
 424     (while (setq default (pop defaults))
 425       (set (mail-source-strip-keyword (setq keyword (car default)))
 426            (if (setq value (plist-get source keyword))
 427                (mail-source-value value)
 428              (mail-source-value (cadr default)))))))
 429
 430 (eval-and-compile
 431   (defun mail-source-bind-common-1 ()
 432     (let* ((defaults mail-source-common-keyword-map)
 433            default bind)
 434       (while (setq default (pop defaults))
 435         (push (list (mail-source-strip-keyword (car default))
 436                     nil)
 437               bind))
 438       bind)))
 439
 440 (defun mail-source-set-common-1 (source)
 441   (let* ((type (pop source))
 442          (defaults mail-source-common-keyword-map)
 443          (defaults-1 (cdr (assq type mail-source-keyword-map)))
 444          default value keyword)
 445     (while (setq default (pop defaults))
 446       (set (mail-source-strip-keyword (setq keyword (car default)))
 447            (if (setq value (plist-get source keyword))
 448                (mail-source-value value)
 449              (if (setq value (assq  keyword defaults-1))
 450                  (mail-source-value (cadr value))
 451                (mail-source-value (cadr default))))))))