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