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

   1 ;;; nnimap.el --- IMAP interface for Gnus
   2
   3 ;; Copyright (C) 2010 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 (eval-and-compile
  30   (require 'nnheader))
  31
  32 (eval-when-compile
  33   (require 'cl))
  34
  35 (require 'nnheader)
  36 (require 'gnus-util)
  37 (require 'gnus)
  38 (require 'nnoo)
  39 (require 'netrc)
  40 (require 'utf7)
  41 (require 'parse-time)
  42
  43 (autoload 'auth-source-forget-user-or-password "auth-source")
  44 (autoload 'auth-source-user-or-password "auth-source")
  45
  46 (nnoo-declare nnimap)
  47
  48 (defvoo nnimap-address nil
  49   "The address of the IMAP server.")
  50
  51 (defvoo nnimap-server-port nil
  52   "The IMAP port used.
  53 If nnimap-stream is `ssl', this will default to `imaps'.  If not,
  54 it will default to `imap'.")
  55
  56 (defvoo nnimap-stream 'ssl
  57   "How nnimap will talk to the IMAP server.
  58 Values are `ssl', `network', `starttls' or `shell'.")
  59
  60 (defvoo nnimap-shell-program (if (boundp 'imap-shell-program)
  61                                  (if (listp imap-shell-program)
  62                                      (car imap-shell-program)
  63                                    imap-shell-program)
  64                                "ssh %s imapd"))
  65
  66 (defvoo nnimap-inbox nil
  67   "The mail box where incoming mail arrives and should be split out of.")
  68
  69 (defvoo nnimap-split-methods nil
  70   "How mail is split.
  71 Uses the same syntax as nnmail-split-methods")
  72
  73 (make-obsolete-variable 'nnimap-split-rule "see `nnimap-split-methods'"
  74                         "Emacs 24.1")
  75
  76 (defvoo nnimap-authenticator nil
  77   "How nnimap authenticate itself to the server.
  78 Possible choices are nil (use default methods) or `anonymous'.")
  79
  80 (defvoo nnimap-expunge t
  81   "If non-nil, expunge articles after deleting them.
  82 This is always done if the server supports UID EXPUNGE, but it's
  83 not done by default on servers that doesn't support that command.")
  84
  85 (defvoo nnimap-streaming t
  86   "If non-nil, try to use streaming commands with IMAP servers.
  87 Switching this off will make nnimap slower, but it helps with
  88 some servers.")
  89
  90 (defvoo nnimap-connection-alist nil)
  91
  92 (defvoo nnimap-current-infos nil)
  93
  94 (defvoo nnimap-fetch-partial-articles nil
  95   "If non-nil, Gnus will fetch partial articles.
  96 If t, nnimap will fetch only the first part.  If a string, it
  97 will fetch all parts that have types that match that string.  A
  98 likely value would be \"text/\" to automatically fetch all
  99 textual parts.")
 100
 101 (defvar nnimap-process nil)
 102
 103 (defvar nnimap-status-string "")
 104
 105 (defvar nnimap-split-download-body-default nil
 106   "Internal variable with default value for `nnimap-split-download-body'.")
 107
 108 (defvar nnimap-keepalive-timer nil)
 109 (defvar nnimap-process-buffers nil)
 110
 111 (defstruct nnimap
 112   group process commands capabilities select-result newlinep server
 113   last-command-time greeting)
 114
 115 (defvar nnimap-object nil)
 116
 117 (defvar nnimap-mark-alist
 118   '((read "\\Seen" %Seen)
 119     (tick "\\Flagged" %Flagged)
 120     (reply "\\Answered" %Answered)
 121     (expire "gnus-expire")
 122     (dormant "gnus-dormant")
 123     (score "gnus-score")
 124     (save "gnus-save")
 125     (download "gnus-download")
 126     (forward "gnus-forward")))
 127
 128 (defun nnimap-buffer ()
 129   (nnimap-find-process-buffer nntp-server-buffer))
 130
 131 (deffoo nnimap-retrieve-headers (articles &optional group server fetch-old)
 132   (with-current-buffer nntp-server-buffer
 133     (erase-buffer)
 134     (when (nnimap-possibly-change-group group server)
 135       (with-current-buffer (nnimap-buffer)
 136         (erase-buffer)
 137         (nnimap-wait-for-response
 138          (nnimap-send-command
 139           "UID FETCH %s %s"
 140           (nnimap-article-ranges (gnus-compress-sequence articles))
 141           (format "(UID RFC822.SIZE BODYSTRUCTURE %s)"
 142                   (format
 143                    (if (nnimap-ver4-p)
 144                        "BODY.PEEK[HEADER.FIELDS %s]"
 145                      "RFC822.HEADER.LINES %s")
 146                    (append '(Subject From Date Message-Id
 147                                      References In-Reply-To Xref)
 148                            nnmail-extra-headers))))
 149          t)
 150         (nnimap-transform-headers))
 151       (insert-buffer-substring
 152        (nnimap-find-process-buffer (current-buffer))))
 153     'headers))
 154
 155 (defun nnimap-transform-headers ()
 156   (goto-char (point-min))
 157   (let (article bytes lines size string)
 158     (block nil
 159       (while (not (eobp))
 160         (while (not (looking-at "^\\* [0-9]+ FETCH.*UID \\([0-9]+\\)"))
 161           (delete-region (point) (progn (forward-line 1) (point)))
 162           (when (eobp)
 163             (return)))
 164         (setq article (match-string 1))
 165         ;; Unfold quoted {number} strings.
 166         (while (re-search-forward "[^]] {\\([0-9]+\\)}\r\n"
 167                                   (1+ (line-end-position)) t)
 168           (setq size (string-to-number (match-string 1)))
 169           (delete-region (+ (match-beginning 0) 2) (point))
 170           (setq string (delete-region (point) (+ (point) size)))
 171           (insert (format "%S" string)))
 172         (setq bytes (nnimap-get-length)
 173               lines nil)
 174         (beginning-of-line)
 175         (setq size
 176               (and (re-search-forward "RFC822.SIZE \\([0-9]+\\)"
 177                                       (line-end-position)
 178                                       t)
 179                    (match-string 1)))
 180         (beginning-of-line)
 181         (when (search-forward "BODYSTRUCTURE" (line-end-position) t)
 182           (let ((structure (ignore-errors
 183                              (read (current-buffer)))))
 184             (while (and (consp structure)
 185                         (not (stringp (car structure))))
 186               (setq structure (car structure)))
 187             (setq lines (nth 7 structure))))
 188         (delete-region (line-beginning-position) (line-end-position))
 189         (insert (format "211 %s Article retrieved." article))
 190         (forward-line 1)
 191         (when size
 192           (insert (format "Chars: %s\n" size)))
 193         (when lines
 194           (insert (format "Lines: %s\n" lines)))
 195         (re-search-forward "^\r$")
 196         (delete-region (line-beginning-position) (line-end-position))
 197         (insert ".")
 198         (forward-line 1)))))
 199
 200 (defun nnimap-get-length ()
 201   (and (re-search-forward "{\\([0-9]+\\)}" (line-end-position) t)
 202        (string-to-number (match-string 1))))
 203
 204 (defun nnimap-article-ranges (ranges)
 205   (let (result)
 206     (cond
 207      ((numberp ranges)
 208       (number-to-string ranges))
 209      ((numberp (cdr ranges))
 210       (format "%d:%d" (car ranges) (cdr ranges)))
 211      (t