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