;;; tramp-imap.el --- Tramp interface to IMAP through imap.el
-;; Copyright (C) 2009 Free Software Foundation, Inc.
+;; Copyright (C) 2009, 2010 Free Software Foundation, Inc.
;; Author: Teodor Zlatanov <tzz@lifelogs.com>
;; Keywords: mail, comm
(require 'assoc)
(require 'tramp)
(require 'tramp-compat)
-(require 'message)
-(require 'imap-hash)
-(require 'epa)
+
(autoload 'auth-source-user-or-password "auth-source")
+(autoload 'epg-context-operation "epg")
+(autoload 'epg-context-set-armor "epg")
+(autoload 'epg-context-set-passphrase-callback "epg")
+(autoload 'epg-context-set-progress-callback "epg")
+(autoload 'epg-decrypt-string "epg")
+(autoload 'epg-encrypt-string "epg")
+(autoload 'imap-hash-get "imap-hash")
+(autoload 'imap-hash-make "imap-hash")
+(autoload 'imap-hash-map "imap-hash")
+(autoload 'imap-hash-put "imap-hash")
+(autoload 'imap-hash-rem "imap-hash")
+
+;; We use the additional header "X-Size" for encoding the size of a file.
+(eval-after-load "imap-hash"
+ '(add-to-list 'imap-hash-headers 'X-Size 'append))
;; Define Tramp IMAP method ...
(defconst tramp-imap-method "imap"
(tramp-imap-put-file
v (current-buffer)
(tramp-imap-file-name-name v)
- (tramp-imap-get-file-inode newname)
- nil))
+ nil nil (nth 7 (file-attributes filename))))
;; One of them is not located on a IMAP mailbox.
(insert-file-contents filename)
(write-region (point-min) (point-max) newname)))
(imap-hash-map (lambda (uid headers body)
(let ((subject (substring
(aget headers 'Subject "")
- (length tramp-imap-subject-marker))))
+ (length tramp-imap-subject-marker)))
+ (from (aget headers 'From ""))
+ (date (date-to-time (aget headers 'Date "")))
+ (size (string-to-number
+ (or (aget headers 'X-Size "0") "0"))))
+ (setq from
+ (if (string-match "<\\([^@]+\\)@" from)
+ (match-string 1 from)
+ "nobody"))
(list
subject
nil
-1
- 1
- 1
- '(0 0)
- '(0 0)
- '(0 0)
- 1
+ from
+ "nogroup"
+ date
+ date
+ date
+ size
"-rw-rw-rw-"
nil
uid
"%10s %3d %-8s %-8s %8s %s "
(nth 9 x) ; mode
(nth 11 x) ; inode
- "nobody" "nogroup"
+ (nth 3 x) ; uid
+ (nth 4 x) ; gid
(nth 8 x) ; size
(format-time-string
(if (tramp-time-less-p
(nth 6 x)))) ; date
;; For the file name, we set the `dired-filename'
;; property. This allows to handle file names with
- ;; leading or trailing spaces as well.
+ ;; leading or trailing spaces as well. The inserted name
+ ;; could be from somewhere else, so we use the relative
+ ;; file name of `default-directory'.
(let ((pos (point)))
- (insert (format "%s" (nth 0 x))) ; file name
- (put-text-property pos (point) 'dired-filename t))
- (insert "\n")
+ (insert
+ (format
+ "%s\n"
+ (file-relative-name (expand-file-name (nth 0 x) filename))))
+ (put-text-property pos (1- (point)) 'dired-filename t))
(forward-line)
(beginning-of-line)))
- entries)))))
+ entries)))))
(defun tramp-imap-handle-insert-file-contents
(filename &optional visit beg end replace)
(defun tramp-imap-handle-file-attributes (filename &optional id-format)
"Like `file-attributes' for Tramp-IMAP FILENAME."
(with-parsed-tramp-file-name (expand-file-name filename) nil
- (cdr-safe (nth 0 (tramp-imap-get-file-entries v localname)))))
+ (let ((res (cdr-safe (nth 0 (tramp-imap-get-file-entries v localname)))))
+ (unless (or (null res) (eq id-format 'string))
+ (setcar (nthcdr 2 res) 1)
+ (setcar (nthcdr 3 res) 1))
+ res)))
(defun tramp-imap-get-file-inode (filename &optional id-format)
"Get inode equivalent \(actually the UID) for Tramp-IMAP FILENAME."
(tramp-message v 4 "Fetching %s to tmp file %s...done" filename tmpfile)
tmpfile))))
-(defun tramp-imap-put-file (vec filename-or-buffer &optional subject inode encode)
+(defun tramp-imap-put-file
+ (vec filename-or-buffer &optional subject inode encode size)
"Write contents of FILENAME-OR-BUFFER to Tramp-IMAP file VEC with name SUBJECT.
When INODE is given, delete that old remote file after writing the new one
-\(normally this is the old file with the same name)."
+\(normally this is the old file with the same name). A non-nil ENCODE
+forces the encoding of the buffer or file. SIZE, when available, indicates
+the file size; this is needed, if the file or buffer is already encoded."
;; `tramp-current-host' is used in `tramp-imap-passphrase-callback-function'.
(let ((tramp-current-host (tramp-file-name-real-host vec))
(iht (tramp-imap-make-iht vec)))
(format
"%s%s"
tramp-imap-subject-marker
- (or subject "no subject"))))
+ (or subject "no subject")))
+ (cons
+ 'X-Size
+ (number-to-string
+ (cond
+ ((numberp size) size)
+ ((bufferp filename-or-buffer)
+ (buffer-size filename-or-buffer))
+ ((stringp filename-or-buffer)
+ (nth 7 (file-attributes filename-or-buffer)))
+ ;; We don't know the size.
+ (t -1)))))
(cond ((bufferp filename-or-buffer)
(with-current-buffer filename-or-buffer
(if encode
(read-passwd
(if (eq key-id 'PIN)
"Tramp-IMAP passphrase for PIN: "
- (let ((entry (assoc key-id epg-user-id-alist)))
+ (let ((entry (assoc key-id
+ (symbol-value 'epg-user-id-alist))))
(if entry
(format "Tramp-IMAP passphrase for %s %s: "
key-id (cdr entry))
;; "/imaps:imap.gmail.com:/INBOX.test/" results in error
;; "error in process filter: Internal error, tag 5 status BAD code nil text UNSELECT not allowed now."
-;; * Improve `tramp-imap-handle-file-attributes'
-;; - size
-;; - modification time
-;; - user
-;; - Return info for directories.
+;; * Improve `tramp-imap-handle-file-attributes' for directories.
;; * Saving a file creates a second one, instead of overwriting.
HCoop / bpt / emacs.git / blobdiff