lisp/net/tramp-imap.el

   1 ;;; tramp-imap.el --- Tramp interface to IMAP through imap.el
   2
   3 ;; Copyright (C) 2009, 2010 Free Software Foundation, Inc.
   4
   5 ;; Author: Teodor Zlatanov <tzz@lifelogs.com>
   6 ;; Keywords: mail, comm
   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 ;; Package to provide Tramp over IMAP
  26
  27 ;;; Setup:
  28
  29 ;; just load and open files, e.g.
  30 ;; /imaps:user@yourhosthere.com:/INBOX.test/1
  31 ;; or
  32 ;; /imap:user@yourhosthere.com:/INBOX.test/1
  33
  34 ;; where `imap' goes over IMAP, while `imaps' goes over IMAP+SSL
  35
  36 ;; This module will use imap-hash.el to access the IMAP mailbox.
  37
  38 ;; This module will use auth-source.el to authenticate against the
  39 ;; IMAP server, PLUS it will use auth-source.el to get your passphrase
  40 ;; for the symmetrically encrypted messages.  For the former, use the
  41 ;; usual IMAP ports.  For the latter, use the port "tramp-imap".
  42
  43 ;; example .authinfo / .netrc file:
  44
  45 ;; machine yourhosthere.com port tramp-imap login USER password SYMMETRIC-PASSPHRASE
  46
  47 ;; note above is the symmetric encryption passphrase for GPG
  48 ;; below is the regular password for IMAP itself and other things on that host
  49
  50 ;; machine yourhosthere.com login USER password NORMAL-PASSWORD
  51
  52
  53 ;;; Code:
  54
  55 (require 'assoc)
  56 (require 'tramp)
  57 (require 'tramp-compat)
  58 (require 'message)
  59 (require 'imap-hash)
  60 (require 'epa)
  61 (autoload 'auth-source-user-or-password "auth-source")
  62
  63 ;; We use the additional header "X-Size" for encoding the size of a file.
  64 (add-to-list 'imap-hash-headers 'X-Size 'append)
  65
  66 ;; Define Tramp IMAP method ...
  67 (defconst tramp-imap-method "imap"
  68   "*Method to connect via IMAP protocol.")
  69
  70 (add-to-list 'tramp-methods (list tramp-imap-method '(tramp-default-port 143)))
  71
  72 ;; Add a default for `tramp-default-user-alist'.  Default is the local user.
  73 (add-to-list 'tramp-default-user-alist
  74              `(,tramp-imap-method nil ,(user-login-name)))
  75
  76 ;; Define Tramp IMAPS method ...
  77 (defconst tramp-imaps-method "imaps"
  78   "*Method to connect via secure IMAP protocol.")
  79
  80 ;; ... and add it to the method list.
  81 (add-to-list 'tramp-methods (list tramp-imaps-method '(tramp-default-port 993)))
  82
  83 ;; Add a default for `tramp-default-user-alist'.  Default is the local user.
  84 (add-to-list 'tramp-default-user-alist
  85              `(,tramp-imaps-method nil ,(user-login-name)))
  86
  87 ;; Add completion function for IMAP method.
  88 ;; (tramp-set-completion-function
  89 ;;  tramp-imap-method tramp-completion-function-alist-ssh) ; TODO: test this
  90 ;;  tramp-imaps-method tramp-completion-function-alist-ssh) ; TODO: test this
  91
  92 ;; New handlers should be added here.
  93 (defconst tramp-imap-file-name-handler-alist
  94   '(
  95     ;; `access-file' performed by default handler
  96     (add-name-to-file . ignore)
  97     ;; `byte-compiler-base-file-name' performed by default handler
  98     ;; `copy-directory' performed by default handler
  99     (copy-file . tramp-imap-handle-copy-file)
 100     (delete-directory . ignore) ;; tramp-imap-handle-delete-directory)
 101     (delete-file . tramp-imap-handle-delete-file)
 102     ;; `diff-latest-backup-file' performed by default handler
 103     (directory-file-name . tramp-handle-directory-file-name)
 104     (directory-files . tramp-handle-directory-files)
 105     (directory-files-and-attributes
 106      . tramp-imap-handle-directory-files-and-attributes)
 107     (dired-call-process . ignore)
 108     ;; `dired-compress-file' performed by default handler
 109     ;; `dired-uncache' performed by default handler
 110     (expand-file-name . tramp-imap-handle-expand-file-name)
 111     ;; `file-accessible-directory-p' performed by default handler
 112     (file-attributes . tramp-imap-handle-file-attributes)
 113     (file-directory-p .  tramp-imap-handle-file-directory-p)
 114     (file-executable-p . tramp-imap-handle-file-executable-p)
 115     (file-exists-p . tramp-imap-handle-file-exists-p)
 116     (file-local-copy . tramp-imap-handle-file-local-copy)
 117     (file-remote-p . tramp-handle-file-remote-p)
 118     (file-modes . tramp-handle-file-modes)
 119     (file-name-all-completions . tramp-imap-handle-file-name-all-completions)
 120     (file-name-as-directory . tramp-handle-file-name-as-directory)
 121     (file-name-completion . tramp-handle-file-name-completion)
 122     (file-name-directory . tramp-handle-file-name-directory)
 123     (file-name-nondirectory . tramp-handle-file-name-nondirectory)
 124     ;; `file-name-sans-versions' performed by default handler
 125     (file-newer-than-file-p . tramp-imap-handle-file-newer-than-file-p)
 126     (file-ownership-preserved-p . ignore)
 127     (file-readable-p . tramp-imap-handle-file-readable-p)
 128     (file-regular-p . tramp-handle-file-regular-p)
 129     (file-symlink-p . tramp-handle-file-symlink-p)
 130     ;; `file-truename' performed by default handler
 131     (file-writable-p . tramp-imap-handle-file-writable-p)
 132     (find-backup-file-name . tramp-handle-find-backup-file-name)
 133     ;; `find-file-noselect' performed by default handler
 134     ;; `get-file-buffer' performed by default handler
 135     (insert-directory . tramp-imap-handle-insert-directory)
 136     (insert-file-contents . tramp-imap-handle-insert-file-contents)
 137     (load . tramp-handle-load)
 138     (make-directory . ignore) ;; tramp-imap-handle-make-directory)
 139     (make-directory-internal . ignore) ;; tramp-imap-handle-make-directory-internal)
 140     (make-symbolic-link . ignore)
 141     (rename-file . tramp-imap-handle-rename-file)
 142     (set-file-modes . ignore)
 143     (set-file-times . ignore) ;; tramp-imap-handle-set-file-times)
 144     (set-visited-file-modtime . ignore)
 145     (shell-command . ignore)
 146     (substitute-in-file-name . tramp-handle-substitute-in-file-name)
 147     (unhandled-file-name-directory . tramp-handle-unhandled-file-name-directory)
 148     (vc-registered . ignore)
 149     (verify-visited-file-modtime . ignore)
 150     (write-region . tramp-imap-handle-write-region)
 151     (executable-find . ignore)
 152     (start-file-process . ignore)
 153     (process-file . ignore)
 154 )
 155   "Alist of handler functions for Tramp IMAP method.
 156 Operations not mentioned here will be handled by the default Emacs primitives.")
 157
 158 (defgroup tramp-imap nil
 159   "Tramp over IMAP configuration."
 160   :version "23.2"
 161   :group 'applications)
 162
 163 (defcustom tramp-imap-subject-marker "tramp-imap-subject-marker"
 164   "The subject marker that Tramp-IMAP will use."
 165   :type 'string
 166   :version "23.2"
 167   :group 'tramp-imap)
 168
 169 ;; TODO: these will be defcustoms later.
 170 (defvar tramp-imap-passphrase-cache nil) ;; can be t or 'never
 171 (defvar tramp-imap-passphrase nil)
 172
 173 (defun tramp-imap-file-name-p (filename)
 174   "Check if it's a filename for IMAP protocol."
 175   (let ((v (tramp-dissect-file-name filename)))
 176     (or
 177      (string= (tramp-file-name-method v) tramp-imap-method)
 178      (string= (tramp-file-name-method v) tramp-imaps-method))))
 179
 180 (defun tramp-imap-file-name-handler (operation &rest args)
 181   "Invoke the IMAP related OPERATION.
 182 First arg specifies the OPERATION, second arg is a list of arguments to
 183 pass to the OPERATION."
 184   (let ((fn (assoc operation tramp-imap-file-name-handler-alist)))
 185     (if fn
 186         (save-match-data (apply (cdr fn) args))
 187       (tramp-run-real-handler operation args))))
 188
 189 (add-to-list 'tramp-foreign-file-name-handler-alist
 190              (cons 'tramp-imap-file-name-p 'tramp-imap-file-name-handler))
 191
 192 (defun tramp-imap-handle-copy-file
 193   (filename newname &optional ok-if-already-exists keep-date preserve-uid-gid)
 194   "Like `copy-file' for Tramp files."
 195   (tramp-imap-do-copy-or-rename-file
 196    'copy filename newname ok-if-already-exists keep-date preserve-uid-gid))
 197
 198 (defun tramp-imap-handle-rename-file
 199   (filename newname &optional ok-if-already-exists)
 200   "Like `rename-file' for Tramp files."
 201   (tramp-imap-do-copy-or-rename-file
 202    'rename filename newname ok-if-already-exists t t))
 203
 204 (defun tramp-imap-do-copy-or-rename-file
 205   (op filename newname &optional ok-if-already-exists keep-date preserve-uid-gid)
 206   "Copy or rename a remote file.
 207 OP must be `copy' or `rename' and indicates the operation to perform.
 208 FILENAME specifies the file to copy or rename, NEWNAME is the name of
 209 the new file (for copy) or the new name of the file (for rename).
 210 OK-IF-ALREADY-EXISTS means don't barf if NEWNAME exists already.
 211 KEEP-DATE means to make sure that NEWNAME has the same timestamp
 212 as FILENAME.  PRESERVE-UID-GID, when non-nil, instructs to keep
 213 the uid and gid if both files are on the same host.
 214
 215 This function is invoked by `tramp-imap-handle-copy-file' and
 216 `tramp-imap-handle-rename-file'.  It is an error if OP is neither
 217 of `copy' and `rename'."
 218   (unless (memq op '(copy rename))
 219     (error "Unknown operation `%s', must be `copy' or `rename'" op))
 220   (setq filename (expand-file-name filename))
 221   (setq newname (expand-file-name newname))
 222   (when (file-directory-p newname)
 223     (setq newname (expand-file-name (file-name-nondirectory filename) newname)))
 224
 225   (let ((t1 (and (tramp-tramp-file-p filename)
 226                  (tramp-imap-file-name-p filename)))
 227         (t2 (and (tramp-tramp-file-p newname)
 228                  (tramp-imap-file-name-p newname))))
 229
 230     (when (and (not ok-if-already-exists) (file-exists-p newname))
 231       (with-parsed-tramp-file-name (if t1 filename newname) nil
 232         (tramp-error
 233          v 'file-already-exists "File %s already exists" newname)))
 234
 235     (with-parsed-tramp-file-name (if t1 filename newname) nil
 236       (tramp-message v 0 "Transferring %s to %s..." filename newname))
 237
 238     ;; We just make a local copy of FILENAME, and write it then to
 239     ;; NEWNAME.  This must be optimized, when both files are located
 240     ;; on the same IMAP server.
 241     (with-temp-buffer
 242       (if (and t1 t2)
 243           ;; We don't encrypt.
 244           (with-parsed-tramp-file-name newname nil
 245             (insert (tramp-imap-get-file filename nil))
 246             (tramp-imap-put-file
 247              v (current-buffer)
 248              (tramp-imap-file-name-name v)
 249              nil nil (nth 7 (file-attributes filename))))
 250         ;; One of them is not located on a IMAP mailbox.
 251         (insert-file-contents filename)
 252         (write-region (point-min) (point-max) newname)))
 253
 254     (with-parsed-tramp-file-name (if t1 filename newname) nil
 255       (tramp-message v 0 "Transferring %s to %s...done" filename newname))
 256
 257     (when (eq op 'rename)
 258       (delete-file filename))))
 259
 260 ;; TODO: revise this much
 261 (defun tramp-imap-handle-expand-file-name (name &optional dir)
 262   "Like `expand-file-name' for Tramp files."
 263   ;; If DIR is not given, use DEFAULT-DIRECTORY or "/".
 264   (setq dir (or dir default-directory "/"))
 265   ;; Unless NAME is absolute, concat DIR and NAME.
 266   (unless (file-name-absolute-p name)
 267     (setq name (concat (file-name-as-directory dir) name)))
 268   ;; If NAME is not a Tramp file, run the real handler.
 269   (if (or (tramp-completion-mode-p) (not (tramp-tramp-file-p name)))
 270       (tramp-drop-volume-letter
 271        (tramp-run-real-handler 'expand-file-name (list name nil)))
 272     ;; Dissect NAME.
 273     (with-parsed-tramp-file-name name nil
 274       (unless (tramp-run-real-handler 'file-name-absolute-p (list localname))
 275         (setq localname (concat "/" localname)))
 276       ;; There might be a double slash, for example when "~/"
 277       ;; expands to "/".  Remove this.
 278       (while (string-match "//" localname)
 279         (setq localname (replace-match "/" t t localname)))
 280       ;; Do normal `expand-file-name' (this does "/./" and "/../").
 281       ;; We bind `directory-sep-char' here for XEmacs on Windows,
 282       ;; which would otherwise use backslash.  `default-directory' is
 283       ;; bound, because on Windows there would be problems with UNC
 284       ;; shares or Cygwin mounts.
 285       (let ((default-directory (tramp-compat-temporary-file-directory)))
 286         (tramp-make-tramp-file-name
 287          method user host
 288          (tramp-drop-volume-letter
 289           (tramp-run-real-handler
 290            'expand-file-name (list localname))))))))
 291
 292 ;; This function should return "foo/" for directories and "bar" for
 293 ;; files.
 294 (defun tramp-imap-handle-file-name-all-completions (filename directory)
 295   "Like `file-name-all-completions' for Tramp files."
 296   (all-completions
 297    filename
 298    (with-parsed-tramp-file-name (expand-file-name directory) nil
 299      (save-match-data
 300        (let ((entries
 301               (tramp-imap-get-file-entries v localname)))
 302          (mapcar
 303           (lambda (x)
 304             (list
 305              (if (string-match "d" (nth 9 x))
 306                  (file-name-as-directory (nth 0 x))
 307                (nth 0 x))))
 308           entries))))))
 309
 310 (defun tramp-imap-get-file-entries (vec localname &optional exact)
 311   "Read entries returned by IMAP server. EXACT limits to exact matches.
 312 Result is a list of (LOCALNAME LINK COUNT UID GID ATIME MTIME CTIME
 313 SIZE MODE WEIRD INODE DEVICE)."
 314   (tramp-message vec 5 "working on %s" localname)
 315   (let* ((name (tramp-imap-file-name-name vec))
 316          (search-name (or name ""))
 317          (search-name (if exact (concat search-name "$") search-name))
 318          (iht (tramp-imap-make-iht vec search-name)))
 319 ;; TODO: catch errors
 320     ;; (tramp-error vec 'none "bad name %s or mailbox %s" name mbox))
 321     (imap-hash-map (lambda (uid headers body)
 322                      (let ((subject (substring
 323                                      (aget headers 'Subject "")
 324                                      (length tramp-imap-subject-marker)))
 325                            (from (aget headers 'From ""))
 326                            (date (date-to-time (aget headers 'Date "")))
 327                            (size (string-to-number
 328                                   (or (aget headers 'X-Size "0") "0"))))
 329                        (setq from
 330                              (if (string-match "<\\([^@]+\\)@" from)
 331                                  (match-string 1 from)
 332                                "nobody"))
 333                        (list
 334                         subject
 335                         nil
 336                         -1
 337                         from
 338                         "nogroup"
 339                         date
 340                         date
 341                         date
 342                         size
 343                         "-rw-rw-rw-"
 344                         nil
 345                         uid
 346                         (tramp-get-device vec))))
 347                    iht t)))
 348
 349 (defun tramp-imap-handle-write-region (start end filename &optional append visit lockname confirm)
 350   "Like `write-region' for Tramp files."
 351   (setq filename (expand-file-name filename))
 352   (with-parsed-tramp-file-name filename nil
 353     ;; XEmacs takes a coding system as the seventh argument, not `confirm'.
 354     (when (and (not (featurep 'xemacs))
 355                confirm (file-exists-p filename))
 356       (unless (y-or-n-p (format "File %s exists; overwrite anyway? "
 357                                 filename))
 358         (tramp-error v 'file-error "File not overwritten")))
 359     (tramp-flush-file-property v localname)
 360     (let* ((old-buffer (current-buffer))
 361            (inode (tramp-imap-get-file-inode filename))
 362            (min 1)
 363            (max (point-max))
 364            ;; Make sure we have good start and end values.
 365            (start (or start min))
 366            (end (or end max))
 367            temp-buffer)
 368       (with-temp-buffer
 369         (setq temp-buffer (if (and (eq start min) (eq end max))
 370                               old-buffer
 371                             ;; If this is a region write, insert the substring.
 372                             (insert
 373                              (with-current-buffer old-buffer
 374                                (buffer-substring-no-properties start end)))
 375                             (current-buffer)))
 376         (tramp-imap-put-file v
 377                              temp-buffer
 378                              (tramp-imap-file-name-name v)
 379                              inode
 380                              t)))
 381     (when (eq visit t)
 382       (set-visited-file-modtime))))
 383
 384 (defun tramp-imap-handle-insert-directory
 385   (filename switches &optional wildcard full-directory-p)
 386   "Like `insert-directory' for Tramp files."
 387   (setq filename (expand-file-name filename))
 388   (when full-directory-p
 389     ;; Called from `dired-add-entry'.
 390     (setq filename (file-name-as-directory filename)))
 391   (with-parsed-tramp-file-name filename nil
 392     (save-match-data
 393       (let ((base (file-name-nondirectory localname))
 394             (entries (copy-sequence
 395                       (tramp-imap-get-file-entries
 396                        v (file-name-directory localname)))))
 397
 398         (when wildcard
 399           (when (string-match "\\." base)
 400             (setq base (replace-match "\\\\." nil nil base)))
 401           (when (string-match "\\*" base)
 402             (setq base (replace-match ".*" nil nil base)))
 403           (when (string-match "\\?" base)
 404             (setq base (replace-match ".?" nil nil base))))
 405
 406         ;; Filter entries.
 407         (setq entries
 408               (delq
 409                nil
 410                (if (or wildcard (zerop (length base)))
 411                    ;; Check for matching entries.
 412                    (mapcar
 413                     (lambda (x)
 414                       (when (string-match
 415                              (format "^%s" base) (nth 0 x))
 416                         x))
 417                     entries)
 418                  ;; We just need the only and only entry FILENAME.
 419                  (list (assoc base entries)))))
 420
 421         ;; Sort entries.
 422         (setq entries
 423               (sort
 424                entries
 425                (lambda (x y)
 426                  (if (string-match "t" switches)
 427                      ;; Sort by date.
 428                      (tramp-time-less-p (nth 6 y) (nth 6 x))
 429                    ;; Sort by name.
 430                    (string-lessp (nth 0 x) (nth 0 y))))))
 431
 432         ;; Handle "-F" switch.
 433         (when (string-match "F" switches)
 434           (mapc
 435            (lambda (x)
 436              (when (not (zerop (length (car x))))
 437                (cond
 438                 ((char-equal ?d (string-to-char (nth 9 x)))
 439                  (setcar x (concat (car x) "/")))
 440                 ((char-equal ?x (string-to-char (nth 9 x)))
 441                  (setcar x (concat (car x) "*"))))))
 442            entries))
 443
 444         ;; Print entries.
 445         (mapcar
 446          (lambda (x)
 447            (when (not (zerop (length (nth 0 x))))
 448              (insert
 449               (format
 450                "%10s %3d %-8s %-8s %8s %s "
 451                (nth 9 x) ; mode
 452                (nth 11 x) ; inode
 453                (nth 3 x) ; uid
 454                (nth 4 x) ; gid
 455                (nth 8 x) ; size
 456                (format-time-string
 457                 (if (tramp-time-less-p
 458                      (tramp-time-subtract (current-time) (nth 6 x))
 459                      tramp-half-a-year)
 460                     "%b %e %R"
 461                   "%b %e  %Y")
 462                 (nth 6 x)))) ; date
 463              ;; For the file name, we set the `dired-filename'
 464              ;; property.  This allows to handle file names with
 465              ;; leading or trailing spaces as well.
 466              (let ((pos (point)))
 467                (insert (format "%s" (nth 0 x))) ; file name
 468                (put-text-property pos (point) 'dired-filename t))
 469              (insert "\n")
 470              (forward-line)
 471              (beginning-of-line)))
 472            entries)))))
 473
 474 (defun tramp-imap-handle-insert-file-contents
 475   (filename &optional visit beg end replace)
 476   "Like `insert-file-contents' for Tramp files."
 477   (barf-if-buffer-read-only)
 478   (when visit
 479     (setq buffer-file-name (expand-file-name filename))
 480     (set-visited-file-modtime)
 481     (set-buffer-modified-p nil))
 482   (with-parsed-tramp-file-name filename nil
 483     (if (not (file-exists-p filename))
 484         (tramp-error
 485          v 'file-error "File `%s' not found on remote host" filename)
 486       (let ((point (point))
 487             size data)
 488         (tramp-message v 4 "Fetching file %s..." filename)
 489         (insert (tramp-imap-get-file filename t))
 490         (setq size (- (point) point))
 491 ;;; TODO: handle ranges.
 492 ;;;            (let ((beg (or beg (point-min)))
 493 ;;;                (end (min (or end (point-max)) (point-max))))
 494 ;;;              (setq size (- end beg))
 495 ;;;            (buffer-substring beg end))
 496         (goto-char point)
 497         (tramp-message v 4 "Fetching file %s...done" filename)
 498         (list (expand-file-name filename) size)))))
 499
 500 (defun tramp-imap-handle-file-exists-p (filename)
 501   "Like `file-exists-p' for Tramp files."
 502   (and (file-attributes filename) t))
 503
 504 (defun tramp-imap-handle-file-directory-p (filename)
 505   "Like `file-directory-p' for Tramp-IMAP files."
 506   ;; We allow only mailboxes to be a directory.
 507   (with-parsed-tramp-file-name (expand-file-name filename default-directory) nil
 508     (and (string-match "^/[^/]*$" (directory-file-name localname)) t)))
 509
 510 (defun tramp-imap-handle-file-attributes (filename &optional id-format)
 511   "Like `file-attributes' for Tramp-IMAP FILENAME."
 512   (with-parsed-tramp-file-name (expand-file-name filename) nil
 513     (let ((res (cdr-safe (nth 0 (tramp-imap-get-file-entries v localname)))))
 514       (unless (or (null res) (eq id-format 'string))
 515         (setcar (nthcdr 2 res) 1)
 516         (setcar (nthcdr 3 res) 1))
 517       res)))
 518
 519 (defun tramp-imap-get-file-inode (filename &optional id-format)
 520   "Get inode equivalent \(actually the UID) for Tramp-IMAP FILENAME."
 521   (nth 10 (tramp-compat-file-attributes filename id-format)))
 522
 523 (defun tramp-imap-handle-file-executable-p (filename)
 524   "Like `file-executable-p' for Tramp files.  False for IMAP."
 525   nil)
 526
 527 (defun tramp-imap-handle-file-readable-p (filename)
 528   "Like `file-readable-p' for Tramp files.  True for IMAP."
 529   (file-exists-p filename))
 530
 531 (defun tramp-imap-handle-file-writable-p (filename)
 532   "Like `file-writable-p' for Tramp files.  True for IMAP."
 533   ;; `file-exists-p' does not work yet for directories.
 534   ;; (file-exists-p (file-name-directory filename)))
 535   (file-directory-p (file-name-directory filename)))
 536
 537 (defun tramp-imap-handle-delete-file (filename)
 538   "Like `delete-file' for Tramp files."
 539   (cond
 540    ((not (file-exists-p filename)) nil)
 541    (t (with-parsed-tramp-file-name (expand-file-name filename) nil
 542         (let ((iht (tramp-imap-make-iht v)))
 543           (imap-hash-rem (tramp-imap-get-file-inode filename) iht))))))
 544
 545 (defun tramp-imap-handle-directory-files-and-attributes
 546   (directory &optional full match nosort id-format)
 547   "Like `directory-files-and-attributes' for Tramp files."
 548   (mapcar
 549    (lambda (x)
 550      (cons x (tramp-compat-file-attributes
 551               (if full x (expand-file-name x directory)) id-format)))
 552    (directory-files directory full match nosort)))
 553
 554 ;; TODO: fix this in tramp-imap-get-file-entries.
 555 (defun tramp-imap-handle-file-newer-than-file-p (file1 file2)
 556   "Like `file-newer-than-file-p' for Tramp files."
 557   (cond
 558    ((not (file-exists-p file1)) nil)
 559    ((not (file-exists-p file2)) t)
 560    (t (tramp-time-less-p (nth 5 (file-attributes file2))
 561                          (nth 5 (file-attributes file1))))))
 562
 563 (defun tramp-imap-handle-file-local-copy (filename)
 564   "Like `file-local-copy' for Tramp files."
 565   (with-parsed-tramp-file-name (expand-file-name filename) nil
 566     (unless (file-exists-p filename)
 567       (tramp-error
 568        v 'file-error
 569        "Cannot make local copy of non-existing file `%s'" filename))
 570     (let ((tmpfile (tramp-compat-make-temp-file filename)))
 571       (tramp-message v 4 "Fetching %s to tmp file %s..." filename tmpfile)
 572       (with-temp-buffer
 573         (insert-file-contents filename)
 574         (write-region (point-min) (point-max) tmpfile)
 575         (tramp-message v 4 "Fetching %s to tmp file %s...done" filename tmpfile)
 576         tmpfile))))
 577
 578 (defun tramp-imap-put-file
 579   (vec filename-or-buffer &optional subject inode encode size)
 580   "Write contents of FILENAME-OR-BUFFER to Tramp-IMAP file VEC with name SUBJECT.
 581 When INODE is given, delete that old remote file after writing the new one
 582 \(normally this is the old file with the same name).  A non-nil ENCODE
 583 forces the encoding of the buffer or file.  SIZE, when available, indicates
 584 the file size; this is needed, if the file or buffer is already encoded."
 585   ;; `tramp-current-host' is used in `tramp-imap-passphrase-callback-function'.
 586   (let ((tramp-current-host (tramp-file-name-real-host vec))
 587         (iht (tramp-imap-make-iht vec)))
 588     (imap-hash-put (list
 589                     (list (cons
 590                            'Subject
 591                            (format
 592                             "%s%s"
 593                             tramp-imap-subject-marker
 594                             (or subject "no subject")))
 595                           (cons
 596                            'X-Size
 597                            (number-to-string
 598                             (cond
 599                              ((numberp size) size)
 600                              ((bufferp filename-or-buffer)
 601                               (buffer-size filename-or-buffer))
 602                              ((stringp filename-or-buffer)
 603                               (nth 7 (file-attributes filename-or-buffer)))
 604                              ;; We don't know the size.
 605                              (t -1)))))
 606                     (cond ((bufferp filename-or-buffer)
 607                            (with-current-buffer filename-or-buffer
 608                              (if encode
 609                                  (tramp-imap-encode-buffer)
 610                                (buffer-string))))
 611                           ;; TODO: allow file names.
 612                           (t "No body available")))
 613                    iht
 614                    inode)))
 615
 616 (defun tramp-imap-get-file (filename &optional decode)
 617   ;; (debug (tramp-imap-get-file-inode filename))
 618   (with-parsed-tramp-file-name (expand-file-name filename) nil
 619     (condition-case ()
 620         ;; `tramp-current-host' is used in
 621         ;; `tramp-imap-passphrase-callback-function'.
 622         (let* ((tramp-current-host (tramp-file-name-real-host v))
 623                (iht (tramp-imap-make-iht v))
 624                (inode (tramp-imap-get-file-inode filename))
 625                (data (imap-hash-get inode iht t)))
 626           (if decode
 627               (with-temp-buffer
 628                 (insert (nth 1 data))
 629                 ;;(debug inode (buffer-string))
 630                 (tramp-imap-decode-buffer))
 631             (nth 1 data)))
 632       (error (tramp-error
 633               v 'file-error "File `%s' could not be read" filename)))))
 634
 635 (defun tramp-imap-passphrase-callback-function (context key-id handback)
 636   "Called by EPG to get a passphrase for Tramp-IMAP.
 637 CONTEXT is the encryption/decryption EPG context.
 638 HANDBACK is just carried through.
 639 KEY-ID can be 'SYM or 'PIN among others."
 640   (let* ((server tramp-current-host)
 641          (port "tramp-imap")            ; this is NOT the server password!
 642          (auth-passwd
 643           (auth-source-user-or-password "password" server port)))
 644     (or
 645      (copy-sequence auth-passwd)
 646      ;; If we cache the passphrase and we have one.
 647      (if (and (eq tramp-imap-passphrase-cache t)
 648               tramp-imap-passphrase)
 649          ;; Do we reuse it?
 650          (if (y-or-n-p "Reuse the passphrase? ")
 651              (copy-sequence tramp-imap-passphrase)
 652            ;; Don't reuse: revert caching behavior to nil, erase passphrase,
 653            ;; call ourselves again.
 654            (setq tramp-imap-passphrase-cache nil)
 655            (setq tramp-imap-passphrase nil)
 656            (tramp-imap-passphrase-callback-function context key-id handback))
 657        (let ((p (if (eq key-id 'SYM)
 658                     (read-passwd
 659                      "Tramp-IMAP passphrase for symmetric encryption: "
 660                      (eq (epg-context-operation context) 'encrypt)
 661                      tramp-imap-passphrase)
 662                   (read-passwd
 663                    (if (eq key-id 'PIN)
 664                        "Tramp-IMAP passphrase for PIN: "
 665                      (let ((entry (assoc key-id epg-user-id-alist)))
 666                        (if entry
 667                            (format "Tramp-IMAP passphrase for %s %s: "
 668                                    key-id (cdr entry))
 669                          (format "Tramp-IMAP passphrase for %s: " key-id))))
 670                    nil
 671                    tramp-imap-passphrase))))
 672
 673          ;; If we have an answer, the passphrase has changed,
 674          ;; the user hasn't declined keeping the passphrase,
 675          ;; and they answer yes to keep it now...
 676          (when (and
 677                 p
 678                 (not (equal tramp-imap-passphrase p))
 679                 (not (eq tramp-imap-passphrase-cache 'never))
 680                 (y-or-n-p "Keep the passphrase? "))
 681            (setq tramp-imap-passphrase (copy-sequence p))
 682            (setq tramp-imap-passphrase-cache t))
 683
 684          ;; If we still don't have a passphrase, the user didn't want
 685          ;; to keep it.
 686          (when (and
 687                 p
 688                 (not tramp-imap-passphrase))
 689            (setq tramp-imap-passphrase-cache 'never))
 690
 691          p)))))
 692
 693 (defun tramp-imap-encode-buffer ()
 694   (let ((context (epg-make-context 'OpenPGP))
 695         cipher)
 696     (epg-context-set-armor context t)
 697     (epg-context-set-passphrase-callback context
 698                                          #'tramp-imap-passphrase-callback-function)
 699     (epg-context-set-progress-callback context
 700                                        (cons #'epa-progress-callback-function
 701                                              "Encrypting..."))
 702     (message "Encrypting...")
 703     (setq cipher (epg-encrypt-string
 704                   context
 705                   (encode-coding-string (buffer-string) 'utf-8)
 706                   nil))
 707     (message "Encrypting...done")
 708     cipher))
 709
 710 (defun tramp-imap-decode-buffer ()
 711   (let ((context (epg-make-context 'OpenPGP))
 712         plain)
 713     (epg-context-set-passphrase-callback context
 714                                          #'tramp-imap-passphrase-callback-function)
 715     (epg-context-set-progress-callback context
 716                                        (cons #'epa-progress-callback-function
 717                                              "Decrypting..."))
 718     (message "Decrypting...")
 719     (setq plain (decode-coding-string
 720                  (epg-decrypt-string context (buffer-string))
 721                  'utf-8))
 722     (message "Decrypting...done")
 723     plain))
 724
 725 (defun tramp-imap-file-name-mailbox (vec)
 726   (nth 0 (tramp-imap-file-name-parse vec)))
 727
 728 (defun tramp-imap-file-name-name (vec)
 729   (nth 1 (tramp-imap-file-name-parse vec)))
 730
 731 (defun tramp-imap-file-name-localname (vec)
 732   (nth 1 (tramp-imap-file-name-parse vec)))
 733
 734 (defun tramp-imap-file-name-parse (vec)
 735   (let ((name (substring-no-properties (tramp-file-name-localname vec))))
 736     (if (string-match "^/\\([^/]+\\)/?\\(.*\\)$" name)
 737         (list (match-string 1 name)
 738               (match-string 2 name))
 739       nil)))
 740
 741 (defun tramp-imap-make-iht (vec &optional needed-subject)
 742   "Translate the Tramp vector VEC to the imap-hash structure.
 743 With NEEDED-SUBJECT, alters the imap-hash test accordingly."
 744   (let* ((mbox (tramp-imap-file-name-mailbox vec))
 745          (server (tramp-file-name-real-host vec))
 746          (method (tramp-file-name-method vec))
 747          (user (tramp-file-name-user vec))
 748          (ssl (string-equal method tramp-imaps-method))
 749          (port (or (tramp-file-name-port vec)
 750                    (tramp-get-method-parameter method 'tramp-default-port)))
 751          (result (imap-hash-make server port mbox user nil ssl)))
 752     ;; Return the IHT with a test override to look for the subject
 753     ;; marker.
 754     (plist-put
 755      result
 756      :test (format "^%s%s"
 757                    tramp-imap-subject-marker
 758                    (if needed-subject needed-subject "")))))
 759
 760 ;;; TODO:
 761
 762 ;; * Implement `tramp-imap-handle-delete-directory',
 763 ;;   `tramp-imap-handle-make-directory',
 764 ;;   `tramp-imap-handle-make-directory-internal',
 765 ;;   `tramp-imap-handle-set-file-times'.
 766
 767 ;; * Encode the subject.  If the filename has trailing spaces (like
 768 ;;   "test   "), those characters get lost, for example in dired listings.
 769
 770 ;; * When opening a dired buffer, like "/imap::INBOX.test", there are
 771 ;;   several error messages:
 772 ;;   "Buffer has a running process; kill it? (yes or no) "
 773 ;;   "error in process filter: Internal error, tag 6 status BAD code nil text No mailbox selected."
 774 ;;   Afterwards, everything seems to be fine.
 775
 776 ;; * imaps works for local IMAP servers.  Accessing
 777 ;;   "/imaps:imap.gmail.com:/INBOX.test/" results in error
 778 ;;   "error in process filter: Internal error, tag 5 status BAD code nil text UNSELECT not allowed now."
 779
 780 ;; * Improve `tramp-imap-handle-file-attributes' for directories.
 781
 782 ;; * Saving a file creates a second one, instead of overwriting.
 783
 784 ;; * Backup files: just *one* is kept.
 785
 786 ;; * Password requests shall have a descriptive prompt.
 787
 788 ;; * Exiting Emacs, there are running IMAP processes.  Make them quiet
 789 ;;   by `set-process-query-on-exit-flag'.
 790
 791 (provide 'tramp-imap)
 792 ;;; tramp-imap.el ends here
 793
 794 ;; Ignore, for testing only.
 795
 796 ;;; (setq tramp-imap-subject-marker "T")
 797 ;;; (tramp-imap-get-file-entries (tramp-dissect-file-name "/imap:yourhosthere.com:/INBOX.test/4") t)
 798 ;;; (tramp-imap-get-file-entries (tramp-dissect-file-name "/imap:yourhosthere.com:/INBOX.test/") t)
 799 ;;; (tramp-imap-get-file-entries (tramp-dissect-file-name "/imap:yourhosthere.com:/test/4") t)
 800 ;;; (tramp-imap-get-file-entries (tramp-dissect-file-name "/imap:yourhosthere.com:/test/") t)
 801 ;;; (tramp-imap-get-file-entries (tramp-dissect-file-name "/imap:yourhosthere.com:/test/welcommen") t)
 802 ;;; (tramp-imap-get-file-entries (tramp-dissect-file-name "/imap:yourhosthere.com:/test/welcommen") t t)
 803 ;;;(tramp-imap-get-file-inode "/imap:yourhosthere.com:/test/welcome")
 804 ;;; (dired-copy-file "/etc/fstab" "/imap:yourhosthere.com:/test/welcome" t)
 805 ;;; (write-region 1 100 "/imap:yourhosthere.com:/test/welcome")
 806 ;;; (tramp-imap-get-file "/imap:yourhosthere.com:/test/welcome" t)
 807 ;;(with-temp-buffer (insert "hello") (write-file "/imap:yourhosthere.com:/test/welcome"))
 808 ;;(with-temp-buffer (insert "hello") (write-file "/imap:yourhosthere.com:/test/welcome2"))
 809 ;;(file-writable-p "/imap:yourhosthere.com:/test/welcome2")
 810 ;;(file-name-directory "/imap:yourhosthere.com:/test/welcome2")
 811 ;;(with-temp-buffer (insert "hello") (delete-file "/tmp/hellotest") (write-file "/tmp/hellotest") (write-file "/imap:yourhosthere.com:/test/welcome2"))
 812 ;;;(file-exists-p "/imap:yourhosthere.com:/INBOX.test/4")
 813 ;;;(file-attributes "/imap:yourhosthere.com:/INBOX.test/4")
 814 ;;;(setq vec (tramp-dissect-file-name "/imap:yourhosthere.com:/INBOX.test/4"))
 815 ;;;(tramp-imap-handle-file-attributes "/imap:yourhosthere.com:/INBOX.test/4")
 816 ;;; (tramp-imap-handle-insert-file-contents "/imap:user@yourhosthere.com:/INBOX.test/4" nil nil nil nil)
 817 ;;;(insert-file-contents "/imap:yourhosthere.com:/INBOX.test/4")
 818 ;;;(file-attributes "/imap:yourhosthere.com:/test/welcommen")
 819 ;;;(insert-file-contents "/imap:yourhosthere.com:/test/welcome")
 820 ;;;(file-exists-p "/imap:yourhosthere.com:/test/welcome2")
 821 ;;;(tramp-imap-handle-file-attributes "/imap:yourhosthere.com:/test/welcome")
 822 ;;;(tramp-imap-get-file-inode "/imap:yourhosthere.com:/test/welcommen")
 823 ;;;(tramp-imap-get-file-inode "/imap:yourhosthere.com:/test/welcome")
 824 ;;;(file-writable-p "/imap:yourhosthere.com:/test/welcome2")
 825 ;;; (delete-file "/imap:yourhosthere.com:/test/welcome")
 826 ;;; (tramp-imap-get-file "/imap:yourhosthere.com:/test/welcommen" t)
 827 ;;; (tramp-imap-get-file "/imap:yourhosthere.com:/test/welcome" t)
 828 ;;;(tramp-imap-file-name-mailbox (tramp-dissect-file-name "/imap:yourhosthere.com:/INBOX.test"))
 829 ;;;(tramp-imap-file-name-mailbox (tramp-dissect-file-name "/imap:yourhosthere.com:/INBOX.test/new/old"))
 830 ;;;(tramp-imap-file-name-mailbox (tramp-dissect-file-name "/imap:yourhosthere.com:/INBOX.test/new"))
 831 ;;;(tramp-imap-file-name-parse (tramp-dissect-file-name "/imap:yourhosthere.com:/INBOX.test/new/two"))
 832 ;;;(tramp-imap-file-name-parse (tramp-dissect-file-name "/imap:yourhosthere.com:/INBOX.test/new/one"))
 833 ;;;(tramp-imap-file-name-parse (tramp-dissect-file-name "/imap:yourhosthere.com:/INBOX.test"))
 834 ;;; (tramp-imap-file-name-parse (tramp-dissect-file-name "/imap:yourhosthere.com:/test/4"))
 835 ;;; (tramp-imap-file-name-parse (tramp-dissect-file-name "/imap:yourhosthere.com:/test/"))
 836 ;;; (tramp-imap-file-name-parse (tramp-dissect-file-name "/imap:yourhosthere.com:/test/welcommen"))
 837 ;;; (tramp-imap-file-name-parse (tramp-dissect-file-name "/imap:yourhosthere.com:/test/welcommen"))
 838 ;;; (tramp-imap-make-iht (tramp-dissect-file-name "/imap:yourhosthere.com:/test/welcommen"))
 839 ;;; (tramp-imap-make-iht (tramp-dissect-file-name "/imap:yourhosthere.com:/INBOX.test/4"))
 840 ;;; (tramp-imap-make-iht (tramp-dissect-file-name "/imap:yourhosthere.com:/INBOX.test/4") "extra")
 841
 842 ;; arch-tag: f2723749-58fb-4f29-894e-39708096e850