X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/36f1267e808dcc3ff406da564a29c0b7180315d9..158d59456887041e74cf0d8e0fa19bc65e6e4b1f:/lisp/net/tramp-imap.el

diff --git a/lisp/net/tramp-imap.el b/lisp/net/tramp-imap.el
index 65024b8b39..3e8883d2e0 100644
--- a/lisp/net/tramp-imap.el
+++ b/lisp/net/tramp-imap.el
@@ -1,6 +1,6 @@
 ;;; 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
@@ -55,10 +55,24 @@
 (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 'epg-make-context "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"
@@ -111,7 +125,6 @@
     (file-executable-p . tramp-imap-handle-file-executable-p)
     (file-exists-p . tramp-imap-handle-file-exists-p)
     (file-local-copy . tramp-imap-handle-file-local-copy)
-    (file-remote-p . tramp-handle-file-remote-p)
     (file-modes . tramp-handle-file-modes)
     (file-name-all-completions . tramp-imap-handle-file-name-all-completions)
     (file-name-as-directory . tramp-handle-file-name-as-directory)
@@ -123,6 +136,8 @@
     (file-ownership-preserved-p . ignore)
     (file-readable-p . tramp-imap-handle-file-readable-p)
     (file-regular-p . tramp-handle-file-regular-p)
+    (file-remote-p . tramp-handle-file-remote-p)
+    ;; `file-selinux-context' performed by default handler.
     (file-symlink-p . tramp-handle-file-symlink-p)
     ;; `file-truename' performed by default handler
     (file-writable-p . tramp-imap-handle-file-writable-p)
@@ -137,6 +152,7 @@
     (make-symbolic-link . ignore)
     (rename-file . tramp-imap-handle-rename-file)
     (set-file-modes . ignore)
+    ;; `set-file-selinux-context' performed by default handler.
     (set-file-times . ignore) ;; tramp-imap-handle-set-file-times)
     (set-visited-file-modtime . ignore)
     (shell-command . ignore)
@@ -155,7 +171,7 @@ Operations not mentioned here will be handled by the default Emacs primitives.")
 (defgroup tramp-imap nil
   "Tramp over IMAP configuration."
   :version "23.2"
-  :group 'applications)
+  :group 'tramp)
 
 (defcustom tramp-imap-subject-marker "tramp-imap-subject-marker"
   "The subject marker that Tramp-IMAP will use."
@@ -187,7 +203,8 @@ pass to the OPERATION."
 	     (cons 'tramp-imap-file-name-p 'tramp-imap-file-name-handler))
 
 (defun tramp-imap-handle-copy-file
-  (filename newname &optional ok-if-already-exists keep-date preserve-uid-gid)
+  (filename newname &optional ok-if-already-exists keep-date
+	    preserve-uid-gid preserve-selinux-context)
   "Like `copy-file' for Tramp files."
   (tramp-imap-do-copy-or-rename-file
    'copy filename newname ok-if-already-exists keep-date preserve-uid-gid))
@@ -224,36 +241,33 @@ of `copy' and `rename'."
 	(t2 (and (tramp-tramp-file-p newname)
 		 (tramp-imap-file-name-p newname))))
 
-    (when (and (not ok-if-already-exists) (file-exists-p newname))
-      (with-parsed-tramp-file-name (if t1 filename newname) nil
-	(tramp-error
-	 v 'file-already-exists "File %s already exists" newname)))
-
     (with-parsed-tramp-file-name (if t1 filename newname) nil
-      (tramp-message v 0 "Transferring %s to %s..." filename newname))
-
-    ;; We just make a local copy of FILENAME, and write it then to
-    ;; NEWNAME.  This must be optimized, when both files are located
-    ;; on the same IMAP server.
-    (with-temp-buffer
-      (if (and t1 t2)
-	  ;; We don't encrypt.
-	  (with-parsed-tramp-file-name newname nil
-	    (insert (tramp-imap-get-file filename nil))
-	    (tramp-imap-put-file
-	     v (current-buffer)
-	     (tramp-imap-file-name-name v)
-	     (tramp-imap-get-file-inode newname)
-	     nil))
-	;; One of them is not located on a IMAP mailbox.
-	(insert-file-contents filename)
-	(write-region (point-min) (point-max) newname)))
-
-    (with-parsed-tramp-file-name (if t1 filename newname) nil
-      (tramp-message v 0 "Transferring %s to %s...done" filename newname))
-
-    (when (eq op 'rename)
-      (delete-file filename))))
+      (when (and (not ok-if-already-exists) (file-exists-p newname))
+	(tramp-error
+	 v 'file-already-exists "File %s already exists" newname))
+
+      (with-progress-reporter
+	  v 0 (format "%s %s to %s"
+		      (if (eq op 'copy) "Copying" "Renaming")
+		      filename newname)
+
+	;; We just make a local copy of FILENAME, and write it then to
+	;; NEWNAME.  This must be optimized, when both files are
+	;; located on the same IMAP server.
+	(with-temp-buffer
+	  (if (and t1 t2)
+	      ;; We don't encrypt.
+	      (with-parsed-tramp-file-name newname v1
+		(insert (tramp-imap-get-file filename nil))
+		(tramp-imap-put-file
+		 v1 (current-buffer)
+		 (tramp-imap-file-name-name v1)
+		 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)))))
+
+    (when (eq op 'rename) (delete-file filename))))
 
 ;; TODO: revise this much
 (defun tramp-imap-handle-expand-file-name (name &optional dir)
@@ -319,17 +333,25 @@ SIZE MODE WEIRD INODE DEVICE)."
     (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
@@ -375,9 +397,10 @@ SIZE MODE WEIRD INODE DEVICE)."
   (filename switches &optional wildcard full-directory-p)
   "Like `insert-directory' for Tramp files."
   (setq filename (expand-file-name filename))
-  (when full-directory-p
-    ;; Called from `dired-add-entry'.
-    (setq filename (file-name-as-directory filename)))
+  (if full-directory-p
+      ;; Called from `dired-add-entry'.
+      (setq filename (file-name-as-directory filename))
+    (setq filename (directory-file-name filename)))
   (with-parsed-tramp-file-name filename nil
     (save-match-data
       (let ((base (file-name-nondirectory localname))
@@ -440,7 +463,8 @@ SIZE MODE WEIRD INODE DEVICE)."
 	       "%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
@@ -451,14 +475,19 @@ SIZE MODE WEIRD INODE DEVICE)."
 		(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) (file-name-directory 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)
@@ -474,17 +503,16 @@ SIZE MODE WEIRD INODE DEVICE)."
 	 v 'file-error "File `%s' not found on remote host" filename)
       (let ((point (point))
 	    size data)
-	(tramp-message v 4 "Fetching file %s..." filename)
-	(insert (tramp-imap-get-file filename t))
-	(setq size (- (point) point))
+	(with-progress-reporter v 3 (format "Fetching file %s" filename)
+	  (insert (tramp-imap-get-file filename t))
+	  (setq size (- (point) point))
 ;;; TODO: handle ranges.
 ;;; 	       (let ((beg (or beg (point-min)))
 ;;; 		   (end (min (or end (point-max)) (point-max))))
 ;;; 		 (setq size (- end beg))
 ;;; 	       (buffer-substring beg end))
-	(goto-char point)
-	(tramp-message v 4 "Fetching file %s...done" filename)
-	(list (expand-file-name filename) size)))))
+	  (goto-char point)
+	  (list (expand-file-name filename) size))))))
 
 (defun tramp-imap-handle-file-exists-p (filename)
   "Like `file-exists-p' for Tramp files."
@@ -499,7 +527,11 @@ SIZE MODE WEIRD INODE DEVICE)."
 (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."
@@ -519,7 +551,7 @@ SIZE MODE WEIRD INODE DEVICE)."
   ;; (file-exists-p (file-name-directory filename)))
   (file-directory-p (file-name-directory filename)))
 
-(defun tramp-imap-handle-delete-file (filename)
+(defun tramp-imap-handle-delete-file (filename &optional trash)
   "Like `delete-file' for Tramp files."
   (cond
    ((not (file-exists-p filename)) nil)
@@ -553,17 +585,20 @@ SIZE MODE WEIRD INODE DEVICE)."
        v 'file-error
        "Cannot make local copy of non-existing file `%s'" filename))
     (let ((tmpfile (tramp-compat-make-temp-file filename)))
-      (tramp-message v 4 "Fetching %s to tmp file %s..." filename tmpfile)
-      (with-temp-buffer
-	(insert-file-contents filename)
- 	(write-region (point-min) (point-max) tmpfile)
- 	(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)
+      (with-progress-reporter
+	  v 3 (format "Fetching %s to tmp file %s" filename tmpfile)
+	(with-temp-buffer
+	  (insert-file-contents filename)
+	  (write-region (point-min) (point-max) tmpfile)
+	  tmpfile)))))
+
+(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)))
@@ -573,7 +608,18 @@ When INODE is given, delete that old remote file after writing the new one
 			   (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
@@ -633,7 +679,8 @@ KEY-ID can be 'SYM or 'PIN among others."
 		  (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))
@@ -748,11 +795,7 @@ With NEEDED-SUBJECT, alters the imap-hash test accordingly."
 ;;   "/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.