cgit.sxemacs.org Git - gnus/blob - lisp/nnimap.el

   1 ;;; nnimap.el --- IMAP interface for Gnus
   2
   3 ;; Copyright (C) 2010-2011 Free Software Foundation, Inc.
   4
   5 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
   6 ;;         Simon Josefsson <simon@josefsson.org>
   7
   8 ;; This file is part of GNU Emacs.
   9
  10 ;; GNU Emacs is free software: you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation, either version 3 of the License, or
  13 ;; (at your option) any later version.
  14
  15 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  22
  23 ;;; Commentary:
  24
  25 ;; nnimap interfaces Gnus with IMAP servers.
  26
  27 ;;; Code:
  28
  29 ;; For Emacs <22.2 and XEmacs.
  30 (eval-and-compile
  31   (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
  32
  33 (eval-and-compile
  34   (require 'nnheader))
  35
  36 (eval-when-compile
  37   (require 'cl))
  38
  39 (require 'nnheader)
  40 (require 'gnus-util)
  41 (require 'gnus)
  42 (require 'nnoo)
  43 (require 'netrc)
  44 (require 'utf7)
  45 (require 'tls)
  46 (require 'parse-time)
  47 (require 'nnmail)
  48 (require 'proto-stream)
  49
  50 (autoload 'auth-source-forget+ "auth-source")
  51 (autoload 'auth-source-search "auth-source")
  52
  53 (nnoo-declare nnimap)
  54
  55 (defvoo nnimap-address nil
  56   "The address of the IMAP server.")
  57
  58 (defvoo nnimap-server-port nil
  59   "The IMAP port used.
  60 If nnimap-stream is `ssl', this will default to `imaps'.  If not,
  61 it will default to `imap'.")
  62
  63 (defvoo nnimap-stream 'undecided
  64   "How nnimap will talk to the IMAP server.
  65 Values are `ssl', `network', `network-only, `starttls' or
  66 `shell'.  The default is to try `ssl' first, and then
  67 `network'.")
  68
  69 (defvoo nnimap-shell-program (if (boundp 'imap-shell-program)
  70                                  (if (listp imap-shell-program)
  71                                      (car imap-shell-program)
  72                                    imap-shell-program)
  73                                "ssh %s imapd"))
  74
  75 (defvoo nnimap-inbox nil
  76   "The mail box where incoming mail arrives and should be split out of.
  77 For example, \"INBOX\".")
  78
  79 (defvoo nnimap-split-methods nil
  80   "How mail is split.
  81 Uses the same syntax as `nnmail-split-methods'.")
  82
  83 (defvoo nnimap-split-fancy nil
  84   "Uses the same syntax as `nnmail-split-fancy'.")
  85
  86 (defvoo nnimap-unsplittable-articles '(%Deleted %Seen)
  87   "Articles with the flags in the list will not be considered when splitting.")
  88
  89 (make-obsolete-variable 'nnimap-split-rule "see `nnimap-split-methods'"
  90                         "Emacs 24.1")
  91
  92 (defvoo nnimap-authenticator nil
  93   "How nnimap authenticate itself to the server.
  94 Possible choices are nil (use default methods) or `anonymous'.")
  95
  96 (defvoo nnimap-expunge t
  97   "If non-nil, expunge articles after deleting them.
  98 This is always done if the server supports UID EXPUNGE, but it's
  99 not done by default on servers that doesn't support that command.")
 100
 101 (defvoo nnimap-streaming t
 102   "If non-nil, try to use streaming commands with IMAP servers.
 103 Switching this off will make nnimap slower, but it helps with
 104 some servers.")
 105
 106 (defvoo nnimap-connection-alist nil)
 107
 108 (defvoo nnimap-current-infos nil)
 109
 110 (defvoo nnimap-fetch-partial-articles nil
 111   "If non-nil, Gnus will fetch partial articles.
 112 If t, nnimap will fetch only the first part.  If a string, it
 113 will fetch all parts that have types that match that string.  A
 114 likely value would be \"text/\" to automatically fetch all
 115 textual parts.")
 116
 117 (defvar nnimap-process nil)
 118
 119 (defvar nnimap-status-string "")
 120
 121 (defvar nnimap-split-download-body-default nil
 122   "Internal variable with default value for `nnimap-split-download-body'.")
 123
 124 (defvar nnimap-keepalive-timer nil)
 125 (defvar nnimap-process-buffers nil)
 126
 127 (defstruct nnimap
 128   group process commands capabilities select-result newlinep server
 129   last-command-time greeting examined stream-type)
 130
 131 (defvar nnimap-object nil)
 132
 133 (defvar nnimap-mark-alist
 134   '((read "\\Seen" %Seen)
 135     (tick "\\Flagged" %Flagged)
 136     (reply "\\Answered" %Answered)
 137     (expire "gnus-expire")
 138     (dormant "gnus-dormant")
 139     (score "gnus-score")
 140     (save "gnus-save")
 141     (download "gnus-download")
 142     (forward "gnus-forward")))
 143
 144 (defvar nnimap-quirks
 145   '(("QRESYNC" "Zimbra" "QRESYNC ")))
 146
 147 (defvar nnimap-inhibit-logging nil)
 148
 149 (defun nnimap-buffer ()
 150   (nnimap-find-process-buffer nntp-server-buffer))
 151
 152 (defun nnimap-header-parameters ()
 153   (format "(UID RFC822.SIZE BODYSTRUCTURE %s)"
 154           (format
 155            (if (nnimap-ver4-p)
 156                "BODY.PEEK[HEADER.FIELDS %s]"
 157              "RFC822.HEADER.LINES %s")
 158            (append '(Subject From Date Message-Id
 159                              References In-Reply-To Xref)
 160                    nnmail-extra-headers))))
 161
 162 (deffoo nnimap-retrieve-headers (articles &optional group server fetch-old)
 163   (with-current-buffer nntp-server-buffer
 164     (erase-buffer)
 165     (when (nnimap-possibly-change-group group server)
 166       (with-current-buffer (nnimap-buffer)
 167         (erase-buffer)
 168         (nnimap-wait-for-response
 169          (nnimap-send-command
 170           "UID FETCH %s %s"
 171           (nnimap-article-ranges (gnus-compress-sequence articles))
 172           (nnimap-header-parameters))
 173          t)
 174         (nnimap-transform-headers)
 175         (nnheader-remove-cr-followed-by-lf))
 176       (insert-buffer-substring
 177        (nnimap-find-process-buffer (current-buffer))))
 178     'headers))
 179
 180 (defun nnimap-transform-headers ()
 181   (goto-char (point-min))
 182   (let (article bytes lines size string)
 183     (block nil
 184       (while (not (eobp))
 185         (while (not (looking-at "^\\* [0-9]+ FETCH.*UID \\([0-9]+\\)"))
 186           (delete-region (point) (progn (forward-line 1) (point)))
 187           (when (eobp)
 188             (return)))
 189         (setq article (match-string 1))