aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorMichael Albinus2011-02-13 13:25:45 +0100
committerMichael Albinus2011-02-13 13:25:45 +0100
commit7a6ebb1a7bb8bd87e26990aa91bf4797f7de79e9 (patch)
tree67a203ef61851ec360643cb28362aa23159e4e76
parent14029d4b8ae27a74959b5b959060930d36fd09c9 (diff)
downloademacs-7a6ebb1a7bb8bd87e26990aa91bf4797f7de79e9.tar.gz
emacs-7a6ebb1a7bb8bd87e26990aa91bf4797f7de79e9.zip
* Makefile.in (TRAMP_SRC): Remove tramp-imap.el.
* net/tramp.el (tramp-read-passwd): Simplify `auth-source-search' call. * net/tramp-imap.el: Remove file.
Diffstat
-rw-r--r--lisp/ChangeLog9
-rw-r--r--lisp/Makefile.in8
-rw-r--r--lisp/net/tramp-imap.el850
-rw-r--r--lisp/net/tramp.el15
4 files changed, 21 insertions, 861 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 97937defc3a..689b1737f1c 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,12 @@
12011-02-13 Michael Albinus <michael.albinus@gmx.de>
2
3 * Makefile.in (TRAMP_SRC): Remove tramp-imap.el.
4
5 * net/tramp.el (tramp-read-passwd): Simplify `auth-source-search'
6 call.
7
8 * net/tramp-imap.el: Remove file.
9
12011-02-13 Chong Yidong <cyd@stupidchicken.com> 102011-02-13 Chong Yidong <cyd@stupidchicken.com>
2 11
3 * vc/vc.el (vc-print-log-setup-buttons): Instead of using the 12 * vc/vc.el (vc-print-log-setup-buttons): Instead of using the
diff --git a/lisp/Makefile.in b/lisp/Makefile.in
index 2f92578b516..d99622944a3 100644
--- a/lisp/Makefile.in
+++ b/lisp/Makefile.in
@@ -329,16 +329,16 @@ $(MH_E_DIR)/mh-loaddefs.el: $(MH_E_SRC)
329 --eval "(setq make-backup-files nil)" \ 329 --eval "(setq make-backup-files nil)" \
330 -f batch-update-autoloads $(MH_E_DIR) 330 -f batch-update-autoloads $(MH_E_DIR)
331 331
332# Update TRAMP internal autoloads. Maybe we could move trmp*.el into 332# Update TRAMP internal autoloads. Maybe we could move tramp*.el into
333# an own subdirectory. OTOH, it does not hurt to keep them in 333# an own subdirectory. OTOH, it does not hurt to keep them in
334# lisp/net. 334# lisp/net.
335TRAMP_DIR = $(lisp)/net 335TRAMP_DIR = $(lisp)/net
336TRAMP_SRC = $(TRAMP_DIR)/tramp.el $(TRAMP_DIR)/tramp-cache.el \ 336TRAMP_SRC = $(TRAMP_DIR)/tramp.el $(TRAMP_DIR)/tramp-cache.el \
337 $(TRAMP_DIR)/tramp-cmds.el $(TRAMP_DIR)/tramp-compat.el \ 337 $(TRAMP_DIR)/tramp-cmds.el $(TRAMP_DIR)/tramp-compat.el \
338 $(TRAMP_DIR)/tramp-ftp.el $(TRAMP_DIR)/tramp-gvfs.el \ 338 $(TRAMP_DIR)/tramp-ftp.el $(TRAMP_DIR)/tramp-gvfs.el \
339 $(TRAMP_DIR)/tramp-gw.el $(TRAMP_DIR)/tramp-imap.el \ 339 $(TRAMP_DIR)/tramp-gw.el $(TRAMP_DIR)/tramp-sh.el \
340 $(TRAMP_DIR)/tramp-sh.el $(TRAMP_DIR)/tramp-smb.el \ 340 $(TRAMP_DIR)/tramp-smb.el $(TRAMP_DIR)/tramp-uu.el \
341 $(TRAMP_DIR)/tramp-uu.el $(TRAMP_DIR)/trampver.el 341 $(TRAMP_DIR)/trampver.el
342 342
343$(TRAMP_DIR)/tramp-loaddefs.el: $(TRAMP_SRC) 343$(TRAMP_DIR)/tramp-loaddefs.el: $(TRAMP_SRC)
344 $(emacs) -l autoload \ 344 $(emacs) -l autoload \
diff --git a/lisp/net/tramp-imap.el b/lisp/net/tramp-imap.el
deleted file mode 100644
index 4157265b0e1..00000000000
--- a/lisp/net/tramp-imap.el
+++ /dev/null
@@ -1,850 +0,0 @@
1;;; tramp-imap.el --- Tramp interface to IMAP through imap.el
2
3;; Copyright (C) 2009-2011 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-search "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;; Define Tramp IMAPS method ...
88;;;###tramp-autoload
89(defconst tramp-imaps-method "imaps"
90 "*Method to connect via secure IMAP protocol.")
91
92;; ... and add it to the method list.
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))))
97
98;; Add a default for `tramp-default-user-alist'. Default is the local user.
99;;;###tramp-autoload
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)))
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
118 ;; `copy-directory' performed by default handler
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
126 . tramp-handle-directory-files-and-attributes)
127 (dired-call-process . ignore)
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)
134 (file-executable-p . ignore)
135 (file-exists-p . tramp-handle-file-exists-p)
136 (file-local-copy . tramp-imap-handle-file-local-copy)
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
144 (file-newer-than-file-p . tramp-handle-file-newer-than-file-p)
145 (file-ownership-preserved-p . ignore)
146 (file-readable-p . tramp-handle-file-exists-p)
147 (file-regular-p . tramp-handle-file-regular-p)
148 (file-remote-p . tramp-handle-file-remote-p)
149 ;; `file-selinux-context' performed by default handler.
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)
164 ;; `set-file-selinux-context' performed by default handler.
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.
178Operations 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"
183 :group 'tramp)
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
195;;;###tramp-autoload
196(defsubst tramp-imap-file-name-p (filename)
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
203;;;###tramp-autoload
204(defun tramp-imap-file-name-handler (operation &rest args)
205 "Invoke the IMAP related OPERATION.
206First arg specifies the OPERATION, second arg is a list of arguments to
207pass 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
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)))
217
218(defun tramp-imap-handle-copy-file
219 (filename newname &optional ok-if-already-exists keep-date
220 preserve-uid-gid preserve-selinux-context)
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.
234OP must be `copy' or `rename' and indicates the operation to perform.
235FILENAME specifies the file to copy or rename, NEWNAME is the name of
236the new file (for copy) or the new name of the file (for rename).
237OK-IF-ALREADY-EXISTS means don't barf if NEWNAME exists already.
238KEEP-DATE means to make sure that NEWNAME has the same timestamp
239as FILENAME. PRESERVE-UID-GID, when non-nil, instructs to keep
240the uid and gid if both files are on the same host.
241
242This function is invoked by `tramp-imap-handle-copy-file' and
243`tramp-imap-handle-rename-file'. It is an error if OP is neither
244of `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
257 (with-parsed-tramp-file-name (if t1 filename newname) nil
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)))))
282
283 (when (eq op 'rename) (delete-file filename))))
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.
337Result is a list of (LOCALNAME LINK COUNT UID GID ATIME MTIME CTIME
338SIZE 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 "")
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"))
358 (list
359 subject
360 nil
361 -1
362 from
363 "nogroup"
364 date
365 date
366 date
367 size
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))
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)))
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
479 (nth 3 x) ; uid
480 (nth 4 x) ; gid
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
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'.
494 (let ((pos (point)))
495 (insert
496 (format
497 "%s\n"
498 (file-relative-name
499 (expand-file-name (nth 0 x) (file-name-directory filename)))))
500 (put-text-property pos (1- (point)) 'dired-filename t))
501 (forward-line)
502 (beginning-of-line)))
503 entries)))))
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)
519 (with-progress-reporter v 3 (format "Fetching file %s" filename)
520 (insert (tramp-imap-get-file filename t))
521 (setq size (- (point) point))
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))
527 (goto-char point)
528 (list (expand-file-name filename) size))))))
529
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
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)))
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
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
555(defun tramp-imap-handle-delete-file (filename &optional trash)
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
563(defun tramp-imap-handle-file-local-copy (filename)
564 "Like `file-local-copy' for Tramp files."
565 (with-parsed-tramp-file-name (expand-file-name filename) nil
566 (unless (file-exists-p filename)
567 (tramp-error
568 v 'file-error
569 "Cannot make local copy of non-existing file `%s'" filename))
570 (let ((tmpfile (tramp-compat-make-temp-file filename)))
571 (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)))))
577
578(defun tramp-imap-put-file
579 (vec filename-or-buffer &optional subject inode encode size)
580 "Write contents of FILENAME-OR-BUFFER to Tramp-IMAP file VEC with name SUBJECT.
581When INODE is given, delete that old remote file after writing the new one
582\(normally this is the old file with the same name). A non-nil ENCODE
583forces the encoding of the buffer or file. SIZE, when available, indicates
584the file size; this is needed, if the file or buffer is already encoded."
585 ;; `tramp-current-host' is used in `tramp-imap-passphrase-callback-function'.
586 (let ((tramp-current-host (tramp-file-name-real-host vec))
587 (iht (tramp-imap-make-iht vec)))
588 (imap-hash-put (list
589 (list (cons
590 'Subject
591 (format
592 "%s%s"
593 tramp-imap-subject-marker
594 (or subject "no subject")))
595 (cons
596 'X-Size
597 (number-to-string
598 (cond
599 ((numberp size) size)
600 ((bufferp filename-or-buffer)
601 (buffer-size filename-or-buffer))
602 ((stringp filename-or-buffer)
603 (nth 7 (file-attributes filename-or-buffer)))
604 ;; We don't know the size.
605 (t -1)))))
606 (cond ((bufferp filename-or-buffer)
607 (with-current-buffer filename-or-buffer
608 (if encode
609 (tramp-imap-encode-buffer)
610 (buffer-string))))
611 ;; TODO: allow file names.
612 (t "No body available")))
613 iht
614 inode)))
615
616(defun tramp-imap-get-file (filename &optional decode)
617 ;; (debug (tramp-imap-get-file-inode filename))
618 (with-parsed-tramp-file-name (expand-file-name filename) nil
619 (condition-case ()
620 ;; `tramp-current-host' is used in
621 ;; `tramp-imap-passphrase-callback-function'.
622 (let* ((tramp-current-host (tramp-file-name-real-host v))
623 (iht (tramp-imap-make-iht v))
624 (inode (tramp-imap-get-file-inode filename))
625 (data (imap-hash-get inode iht t)))
626 (if decode
627 (with-temp-buffer
628 (insert (nth 1 data))
629 ;;(debug inode (buffer-string))
630 (tramp-imap-decode-buffer))
631 (nth 1 data)))
632 (error (tramp-error
633 v 'file-error "File `%s' could not be read" filename)))))
634
635(defun tramp-imap-passphrase-callback-function (context key-id handback)
636 "Called by EPG to get a passphrase for Tramp-IMAP.
637CONTEXT is the encryption/decryption EPG context.
638HANDBACK is just carried through.
639KEY-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 (plist-get
643 (nth 0 (auth-source-search :max 1
644 :host server
645 :port port))
646 :secret))
647 (auth-passwd (if (functionp auth-passwd)
648 (funcall auth-passwd)
649 auth-passwd)))
650 (or
651 (copy-sequence auth-passwd)
652 ;; If we cache the passphrase and we have one.
653 (if (and (eq tramp-imap-passphrase-cache t)
654 tramp-imap-passphrase)
655 ;; Do we reuse it?
656 (if (y-or-n-p "Reuse the passphrase? ")
657 (copy-sequence tramp-imap-passphrase)
658 ;; Don't reuse: revert caching behavior to nil, erase passphrase,
659 ;; call ourselves again.
660 (setq tramp-imap-passphrase-cache nil)
661 (setq tramp-imap-passphrase nil)
662 (tramp-imap-passphrase-callback-function context key-id handback))
663 (let ((p (if (eq key-id 'SYM)
664 (read-passwd
665 "Tramp-IMAP passphrase for symmetric encryption: "
666 (eq (epg-context-operation context) 'encrypt)
667 tramp-imap-passphrase)
668 (read-passwd
669 (if (eq key-id 'PIN)
670 "Tramp-IMAP passphrase for PIN: "
671 (let ((entry (assoc key-id
672 (symbol-value 'epg-user-id-alist))))
673 (if entry
674 (format "Tramp-IMAP passphrase for %s %s: "
675 key-id (cdr entry))
676 (format "Tramp-IMAP passphrase for %s: " key-id))))
677 nil
678 tramp-imap-passphrase))))
679
680 ;; If we have an answer, the passphrase has changed,
681 ;; the user hasn't declined keeping the passphrase,
682 ;; and they answer yes to keep it now...
683 (when (and
684 p
685 (not (equal tramp-imap-passphrase p))
686 (not (eq tramp-imap-passphrase-cache 'never))
687 (y-or-n-p "Keep the passphrase? "))
688 (setq tramp-imap-passphrase (copy-sequence p))
689 (setq tramp-imap-passphrase-cache t))
690
691 ;; If we still don't have a passphrase, the user didn't want
692 ;; to keep it.
693 (when (and
694 p
695 (not tramp-imap-passphrase))
696 (setq tramp-imap-passphrase-cache 'never))
697
698 p)))))
699
700(defun tramp-imap-encode-buffer ()
701 (let ((context (epg-make-context 'OpenPGP))
702 cipher)
703 (epg-context-set-armor context t)
704 (epg-context-set-passphrase-callback context
705 #'tramp-imap-passphrase-callback-function)
706 (epg-context-set-progress-callback context
707 (cons #'epa-progress-callback-function
708 "Encrypting..."))
709 (message "Encrypting...")
710 (setq cipher (epg-encrypt-string
711 context
712 (encode-coding-string (buffer-string) 'utf-8)
713 nil))
714 (message "Encrypting...done")
715 cipher))
716
717(defun tramp-imap-decode-buffer ()
718 (let ((context (epg-make-context 'OpenPGP))
719 plain)
720 (epg-context-set-passphrase-callback context
721 #'tramp-imap-passphrase-callback-function)
722 (epg-context-set-progress-callback context
723 (cons #'epa-progress-callback-function
724 "Decrypting..."))
725 (message "Decrypting...")
726 (setq plain (decode-coding-string
727 (epg-decrypt-string context (buffer-string))
728 'utf-8))
729 (message "Decrypting...done")
730 plain))
731
732(defun tramp-imap-file-name-mailbox (vec)
733 (nth 0 (tramp-imap-file-name-parse vec)))
734
735(defun tramp-imap-file-name-name (vec)
736 (nth 1 (tramp-imap-file-name-parse vec)))
737
738(defun tramp-imap-file-name-localname (vec)
739 (nth 1 (tramp-imap-file-name-parse vec)))
740
741(defun tramp-imap-file-name-parse (vec)
742 (let ((name (substring-no-properties (tramp-file-name-localname vec))))
743 (if (string-match "^/\\([^/]+\\)/?\\(.*\\)$" name)
744 (list (match-string 1 name)
745 (match-string 2 name))
746 nil)))
747
748(defun tramp-imap-make-iht (vec &optional needed-subject)
749 "Translate the Tramp vector VEC to the imap-hash structure.
750With NEEDED-SUBJECT, alters the imap-hash test accordingly."
751 (let* ((mbox (tramp-imap-file-name-mailbox vec))
752 (server (tramp-file-name-real-host vec))
753 (method (tramp-file-name-method vec))
754 (user (tramp-file-name-user vec))
755 (ssl (string-equal method tramp-imaps-method))
756 (port (tramp-file-name-port vec))
757 (result (imap-hash-make server port mbox user nil ssl)))
758 ;; Return the IHT with a test override to look for the subject
759 ;; marker.
760 (plist-put
761 result
762 :test (format "^%s%s"
763 tramp-imap-subject-marker
764 (if needed-subject needed-subject "")))))
765
766(add-hook 'tramp-unload-hook
767 (lambda ()
768 (unload-feature 'tramp-imap 'force)))
769
770;;; TODO:
771
772;; * Implement `tramp-imap-handle-delete-directory',
773;; `tramp-imap-handle-make-directory',
774;; `tramp-imap-handle-make-directory-internal',
775;; `tramp-imap-handle-set-file-times'.
776
777;; * Encode the subject. If the filename has trailing spaces (like
778;; "test "), those characters get lost, for example in dired listings.
779
780;; * When opening a dired buffer, like "/imap::INBOX.test", there are
781;; several error messages:
782;; "Buffer has a running process; kill it? (yes or no) "
783;; "error in process filter: Internal error, tag 6 status BAD code nil text No mailbox selected."
784;; Afterwards, everything seems to be fine.
785
786;; * imaps works for local IMAP servers. Accessing
787;; "/imaps:imap.gmail.com:/INBOX.test/" results in error
788;; "error in process filter: Internal error, tag 5 status BAD code nil text UNSELECT not allowed now."
789
790;; * Improve `tramp-imap-handle-file-attributes' for directories.
791
792;; * Saving a file creates a second one, instead of overwriting.
793
794;; * Backup files: just *one* is kept.
795
796;; * Password requests shall have a descriptive prompt.
797
798;; * Exiting Emacs, there are running IMAP processes. Make them quiet
799;; by `set-process-query-on-exit-flag'.
800
801(provide 'tramp-imap)
802;;; tramp-imap.el ends here
803
804;; Ignore, for testing only.
805
806;;; (setq tramp-imap-subject-marker "T")
807;;; (tramp-imap-get-file-entries (tramp-dissect-file-name "/imap:yourhosthere.com:/INBOX.test/4") t)
808;;; (tramp-imap-get-file-entries (tramp-dissect-file-name "/imap:yourhosthere.com:/INBOX.test/") t)
809;;; (tramp-imap-get-file-entries (tramp-dissect-file-name "/imap:yourhosthere.com:/test/4") t)
810;;; (tramp-imap-get-file-entries (tramp-dissect-file-name "/imap:yourhosthere.com:/test/") t)
811;;; (tramp-imap-get-file-entries (tramp-dissect-file-name "/imap:yourhosthere.com:/test/welcommen") t)
812;;; (tramp-imap-get-file-entries (tramp-dissect-file-name "/imap:yourhosthere.com:/test/welcommen") t t)
813;;;(tramp-imap-get-file-inode "/imap:yourhosthere.com:/test/welcome")
814;;; (dired-copy-file "/etc/fstab" "/imap:yourhosthere.com:/test/welcome" t)
815;;; (write-region 1 100 "/imap:yourhosthere.com:/test/welcome")
816;;; (tramp-imap-get-file "/imap:yourhosthere.com:/test/welcome" t)
817;;(with-temp-buffer (insert "hello") (write-file "/imap:yourhosthere.com:/test/welcome"))
818;;(with-temp-buffer (insert "hello") (write-file "/imap:yourhosthere.com:/test/welcome2"))
819;;(file-writable-p "/imap:yourhosthere.com:/test/welcome2")
820;;(file-name-directory "/imap:yourhosthere.com:/test/welcome2")
821;;(with-temp-buffer (insert "hello") (delete-file "/tmp/hellotest") (write-file "/tmp/hellotest") (write-file "/imap:yourhosthere.com:/test/welcome2"))
822;;;(file-exists-p "/imap:yourhosthere.com:/INBOX.test/4")
823;;;(file-attributes "/imap:yourhosthere.com:/INBOX.test/4")
824;;;(setq vec (tramp-dissect-file-name "/imap:yourhosthere.com:/INBOX.test/4"))
825;;;(tramp-imap-handle-file-attributes "/imap:yourhosthere.com:/INBOX.test/4")
826;;; (tramp-imap-handle-insert-file-contents "/imap:user@yourhosthere.com:/INBOX.test/4" nil nil nil nil)
827;;;(insert-file-contents "/imap:yourhosthere.com:/INBOX.test/4")
828;;;(file-attributes "/imap:yourhosthere.com:/test/welcommen")
829;;;(insert-file-contents "/imap:yourhosthere.com:/test/welcome")
830;;;(file-exists-p "/imap:yourhosthere.com:/test/welcome2")
831;;;(tramp-imap-handle-file-attributes "/imap:yourhosthere.com:/test/welcome")
832;;;(tramp-imap-get-file-inode "/imap:yourhosthere.com:/test/welcommen")
833;;;(tramp-imap-get-file-inode "/imap:yourhosthere.com:/test/welcome")
834;;;(file-writable-p "/imap:yourhosthere.com:/test/welcome2")
835;;; (delete-file "/imap:yourhosthere.com:/test/welcome")
836;;; (tramp-imap-get-file "/imap:yourhosthere.com:/test/welcommen" t)
837;;; (tramp-imap-get-file "/imap:yourhosthere.com:/test/welcome" t)
838;;;(tramp-imap-file-name-mailbox (tramp-dissect-file-name "/imap:yourhosthere.com:/INBOX.test"))
839;;;(tramp-imap-file-name-mailbox (tramp-dissect-file-name "/imap:yourhosthere.com:/INBOX.test/new/old"))
840;;;(tramp-imap-file-name-mailbox (tramp-dissect-file-name "/imap:yourhosthere.com:/INBOX.test/new"))
841;;;(tramp-imap-file-name-parse (tramp-dissect-file-name "/imap:yourhosthere.com:/INBOX.test/new/two"))
842;;;(tramp-imap-file-name-parse (tramp-dissect-file-name "/imap:yourhosthere.com:/INBOX.test/new/one"))
843;;;(tramp-imap-file-name-parse (tramp-dissect-file-name "/imap:yourhosthere.com:/INBOX.test"))
844;;; (tramp-imap-file-name-parse (tramp-dissect-file-name "/imap:yourhosthere.com:/test/4"))
845;;; (tramp-imap-file-name-parse (tramp-dissect-file-name "/imap:yourhosthere.com:/test/"))
846;;; (tramp-imap-file-name-parse (tramp-dissect-file-name "/imap:yourhosthere.com:/test/welcommen"))
847;;; (tramp-imap-file-name-parse (tramp-dissect-file-name "/imap:yourhosthere.com:/test/welcommen"))
848;;; (tramp-imap-make-iht (tramp-dissect-file-name "/imap:yourhosthere.com:/test/welcommen"))
849;;; (tramp-imap-make-iht (tramp-dissect-file-name "/imap:yourhosthere.com:/INBOX.test/4"))
850;;; (tramp-imap-make-iht (tramp-dissect-file-name "/imap:yourhosthere.com:/INBOX.test/4") "extra")
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 5d0f3935884..9be093743b5 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -3526,23 +3526,24 @@ Invokes `password-read' if available, `read-passwd' else."
3526 (with-parsed-tramp-file-name key nil 3526 (with-parsed-tramp-file-name key nil
3527 (prog1 3527 (prog1
3528 (or 3528 (or
3529 ;; See if auth-sources contains something useful, if it's bound. 3529 ;; See if auth-sources contains something useful, if it's
3530 ;; bound. `auth-source-user-or-password' is an obsoleted
3531 ;; function, it has been replaced by `auth-source-search'.
3530 (and (boundp 'auth-sources) 3532 (and (boundp 'auth-sources)
3531 (tramp-get-connection-property v "first-password-request" nil) 3533 (tramp-get-connection-property v "first-password-request" nil)
3532 ;; Try with Tramp's current method. 3534 ;; Try with Tramp's current method.
3533 (if (fboundp 'auth-source-search) 3535 (if (fboundp 'auth-source-search)
3534 (progn 3536 (setq auth-info
3535 (setq auth-info
3536 (tramp-compat-funcall 3537 (tramp-compat-funcall
3537 'auth-source-search 3538 'auth-source-search
3538 :max 1 3539 :max 1
3539 :user (or tramp-current-user t) 3540 :user (or tramp-current-user t)
3540 :host tramp-current-host 3541 :host tramp-current-host
3541 :port tramp-current-method)) 3542 :port tramp-current-method)
3542 (setq auth-passwd (plist-get (nth 0 auth-info) :secret)) 3543 auth-passwd (plist-get (nth 0 auth-info) :secret)
3543 (setq auth-passwd (if (functionp auth-passwd) 3544 auth-passwd (if (functionp auth-passwd)
3544 (funcall auth-passwd) 3545 (funcall auth-passwd)
3545 auth-passwd))) 3546 auth-passwd))
3546 (tramp-compat-funcall 3547 (tramp-compat-funcall
3547 'auth-source-user-or-password 3548 'auth-source-user-or-password
3548 "password" tramp-current-host tramp-current-method))) 3549 "password" tramp-current-host tramp-current-method)))
generated by cgit v1.2.1 (git 2.18.0) at 2026-01-20 03:44:15 +0000