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