[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] emacs/lisp/net tramp-imap.el
|
From: |
Michael Albinus |
|
Subject: |
[Emacs-diffs] emacs/lisp/net tramp-imap.el |
|
Date: |
Mon, 28 Sep 2009 11:59:22 +0000 |
CVSROOT: /sources/emacs
Module name: emacs
Changes by: Michael Albinus <albinus> 09/09/28 11:59:22
Added files:
lisp/net : tramp-imap.el
Log message:
* net/tramp-imap.el: New package.
CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/emacs/lisp/net/tramp-imap.el?cvsroot=emacs&rev=1.1
Patches:
Index: tramp-imap.el
===================================================================
RCS file: tramp-imap.el
diff -N tramp-imap.el
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tramp-imap.el 28 Sep 2009 11:59:22 -0000 1.1
@@ -0,0 +1,801 @@
+;;; tramp-imap.el --- Tramp interface to IMAP through imap.el
+
+;; Copyright (C) 2009 Free Software Foundation, Inc.
+
+;; Author: Teodor Zlatanov <address@hidden>
+;; Keywords: mail, comm
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Package to provide Tramp over IMAP
+
+;;; Setup:
+
+;; just load and open files, e.g.
+;; /imaps:address@hidden:/INBOX.test/1
+;; or
+;; /imap:address@hidden:/INBOX.test/1
+
+;; where `imap' goes over IMAP, while `imaps' goes over IMAP+SSL
+
+;; This module will use imap-hash.el to access the IMAP mailbox.
+
+;; This module will use auth-source.el to authenticate against the
+;; IMAP server, PLUS it will use auth-source.el to get your passphrase
+;; for the symmetrically encrypted messages. For the former, use the
+;; usual IMAP ports. For the latter, use the port "tramp-imap".
+
+;; example .authinfo / .netrc file:
+
+;; machine yourhosthere.com port tramp-imap login USER password
SYMMETRIC-PASSPHRASE
+
+;; note above is the symmetric encryption passphrase for GPG
+;; below is the regular password for IMAP itself and other things on that host
+
+;; machine yourhosthere.com login USER password NORMAL-PASSWORD
+
+
+;;; Code:
+
+(require 'assoc)
+(require 'tramp)
+(require 'tramp-compat)
+(require 'message)
+(require 'imap-hash)
+(require 'epa)
+(autoload 'auth-source-user-or-password "auth-source")
+
+;; Define Tramp IMAP method ...
+(defconst tramp-imap-method "imap"
+ "*Method to connect via IMAP protocol.")
+
+(add-to-list 'tramp-methods (list tramp-imap-method '(tramp-default-port 143)))
+
+;; Add a default for `tramp-default-user-alist'. Default is the local user.
+(add-to-list 'tramp-default-user-alist
+ `(,tramp-imap-method nil ,(user-login-name)))
+
+;; Define Tramp IMAPS method ...
+(defconst tramp-imaps-method "imaps"
+ "*Method to connect via secure IMAP protocol.")
+
+;; ... and add it to the method list.
+(add-to-list 'tramp-methods (list tramp-imaps-method '(tramp-default-port
993)))
+
+;; Add a default for `tramp-default-user-alist'. Default is the local user.
+(add-to-list 'tramp-default-user-alist
+ `(,tramp-imaps-method nil ,(user-login-name)))
+
+;; Add completion function for IMAP method.
+;; (tramp-set-completion-function
+;; tramp-imap-method tramp-completion-function-alist-ssh) ; TODO: test this
+;; tramp-imaps-method tramp-completion-function-alist-ssh) ; TODO: test this
+
+;; New handlers should be added here.
+(defconst tramp-imap-file-name-handler-alist
+ '(
+ ;; `access-file' performed by default handler
+ (add-name-to-file . ignore)
+ ;; `byte-compiler-base-file-name' performed by default handler
+ (copy-file . tramp-imap-handle-copy-file)
+ (delete-directory . ignore) ;; tramp-imap-handle-delete-directory)
+ (delete-file . tramp-imap-handle-delete-file)
+ ;; `diff-latest-backup-file' performed by default handler
+ (directory-file-name . tramp-handle-directory-file-name)
+ (directory-files . tramp-handle-directory-files)
+ (directory-files-and-attributes
+ . tramp-imap-handle-directory-files-and-attributes)
+ ;; `dired-call-process' performed by default handler
+ ;; `dired-compress-file' performed by default handler
+ ;; `dired-uncache' performed by default handler
+ (expand-file-name . tramp-imap-handle-expand-file-name)
+ ;; `file-accessible-directory-p' performed by default handler
+ (file-attributes . tramp-imap-handle-file-attributes)
+ (file-directory-p . tramp-imap-handle-file-directory-p)
+ (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)
+ (file-name-completion . tramp-handle-file-name-completion)
+ (file-name-directory . tramp-handle-file-name-directory)
+ (file-name-nondirectory . tramp-handle-file-name-nondirectory)
+ ;; `file-name-sans-versions' performed by default handler
+ (file-newer-than-file-p . tramp-imap-handle-file-newer-than-file-p)
+ (file-ownership-preserved-p . ignore)
+ (file-readable-p . tramp-imap-handle-file-readable-p)
+ (file-regular-p . tramp-handle-file-regular-p)
+ (file-symlink-p . tramp-handle-file-symlink-p)
+ ;; `file-truename' performed by default handler
+ (file-writable-p . tramp-imap-handle-file-writable-p)
+ (find-backup-file-name . tramp-handle-find-backup-file-name)
+ ;; `find-file-noselect' performed by default handler
+ ;; `get-file-buffer' performed by default handler
+ (insert-directory . tramp-imap-handle-insert-directory)
+ (insert-file-contents . tramp-imap-handle-insert-file-contents)
+ (load . tramp-handle-load)
+ (make-directory . ignore) ;; tramp-imap-handle-make-directory)
+ (make-directory-internal . ignore) ;;
tramp-imap-handle-make-directory-internal)
+ (make-symbolic-link . ignore)
+ (rename-file . tramp-imap-handle-rename-file)
+ (set-file-modes . ignore)
+ (set-file-times . ignore) ;; tramp-imap-handle-set-file-times)
+ (set-visited-file-modtime . ignore)
+ (shell-command . ignore)
+ (substitute-in-file-name . tramp-handle-substitute-in-file-name)
+ (unhandled-file-name-directory .
tramp-handle-unhandled-file-name-directory)
+ (vc-registered . ignore)
+ (verify-visited-file-modtime . ignore)
+ (write-region . tramp-imap-handle-write-region)
+ (executable-find . ignore)
+ (start-file-process . ignore)
+ (process-file . ignore)
+)
+ "Alist of handler functions for Tramp IMAP method.
+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)
+
+(defcustom tramp-imap-subject-marker "tramp-imap-subject-marker"
+ "The subject marker that Tramp-IMAP will use."
+ :type 'string
+ :version "23.2"
+ :group 'tramp-imap)
+
+;; TODO: these will be defcustoms later.
+(defvar tramp-imap-passphrase-cache nil) ;; can be t or 'never
+(defvar tramp-imap-passphrase nil)
+
+(defun tramp-imap-file-name-p (filename)
+ "Check if it's a filename for IMAP protocol."
+ (let ((v (tramp-dissect-file-name filename)))
+ (or
+ (string= (tramp-file-name-method v) tramp-imap-method)
+ (string= (tramp-file-name-method v) tramp-imaps-method))))
+
+(defun tramp-imap-file-name-handler (operation &rest args)
+ "Invoke the IMAP related OPERATION.
+First arg specifies the OPERATION, second arg is a list of arguments to
+pass to the OPERATION."
+ (let ((fn (assoc operation tramp-imap-file-name-handler-alist)))
+ (if fn
+ (save-match-data (apply (cdr fn) args))
+ (tramp-run-real-handler operation args))))
+
+(add-to-list 'tramp-foreign-file-name-handler-alist
+ (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)
+ "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))
+
+(defun tramp-imap-handle-rename-file
+ (filename newname &optional ok-if-already-exists)
+ "Like `rename-file' for Tramp files."
+ (tramp-imap-do-copy-or-rename-file
+ 'rename filename newname ok-if-already-exists t t))
+
+(defun tramp-imap-do-copy-or-rename-file
+ (op filename newname &optional ok-if-already-exists keep-date
preserve-uid-gid)
+ "Copy or rename a remote file.
+OP must be `copy' or `rename' and indicates the operation to perform.
+FILENAME specifies the file to copy or rename, NEWNAME is the name of
+the new file (for copy) or the new name of the file (for rename).
+OK-IF-ALREADY-EXISTS means don't barf if NEWNAME exists already.
+KEEP-DATE means to make sure that NEWNAME has the same timestamp
+as FILENAME. PRESERVE-UID-GID, when non-nil, instructs to keep
+the uid and gid if both files are on the same host.
+
+This function is invoked by `tramp-imap-handle-copy-file' and
+`tramp-imap-handle-rename-file'. It is an error if OP is neither
+of `copy' and `rename'."
+ (unless (memq op '(copy rename))
+ (error "Unknown operation `%s', must be `copy' or `rename'" op))
+ (setq filename (expand-file-name filename))
+ (setq newname (expand-file-name newname))
+ (when (file-directory-p newname)
+ (setq newname (expand-file-name (file-name-nondirectory filename)
newname)))
+
+ (let ((t1 (and (tramp-tramp-file-p filename)
+ (tramp-imap-file-name-p filename)))
+ (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))))
+
+;; TODO: revise this much
+(defun tramp-imap-handle-expand-file-name (name &optional dir)
+ "Like `expand-file-name' for Tramp files."
+ ;; If DIR is not given, use DEFAULT-DIRECTORY or "/".
+ (setq dir (or dir default-directory "/"))
+ ;; Unless NAME is absolute, concat DIR and NAME.
+ (unless (file-name-absolute-p name)
+ (setq name (concat (file-name-as-directory dir) name)))
+ ;; If NAME is not a Tramp file, run the real handler.
+ (if (or (tramp-completion-mode-p) (not (tramp-tramp-file-p name)))
+ (tramp-drop-volume-letter
+ (tramp-run-real-handler 'expand-file-name (list name nil)))
+ ;; Dissect NAME.
+ (with-parsed-tramp-file-name name nil
+ (unless (tramp-run-real-handler 'file-name-absolute-p (list localname))
+ (setq localname (concat "/" localname)))
+ ;; There might be a double slash, for example when "~/"
+ ;; expands to "/". Remove this.
+ (while (string-match "//" localname)
+ (setq localname (replace-match "/" t t localname)))
+ ;; Do normal `expand-file-name' (this does "/./" and "/../").
+ ;; We bind `directory-sep-char' here for XEmacs on Windows,
+ ;; which would otherwise use backslash. `default-directory' is
+ ;; bound, because on Windows there would be problems with UNC
+ ;; shares or Cygwin mounts.
+ (let ((default-directory (tramp-compat-temporary-file-directory)))
+ (tramp-make-tramp-file-name
+ method user host
+ (tramp-drop-volume-letter
+ (tramp-run-real-handler
+ 'expand-file-name (list localname))))))))
+
+;; This function should return "foo/" for directories and "bar" for
+;; files.
+(defun tramp-imap-handle-file-name-all-completions (filename directory)
+ "Like `file-name-all-completions' for Tramp files."
+ (all-completions
+ filename
+ (with-parsed-tramp-file-name (expand-file-name directory) nil
+ (save-match-data
+ (let ((entries
+ (tramp-imap-get-file-entries v localname)))
+ (mapcar
+ (lambda (x)
+ (list
+ (if (string-match "d" (nth 9 x))
+ (file-name-as-directory (nth 0 x))
+ (nth 0 x))))
+ entries))))))
+
+(defun tramp-imap-get-file-entries (vec localname &optional exact)
+ "Read entries returned by IMAP server. EXACT limits to exact matches.
+Result is a list of (LOCALNAME LINK COUNT UID GID ATIME MTIME CTIME
+SIZE MODE WEIRD INODE DEVICE)."
+ (tramp-message vec 5 "working on %s" localname)
+ (let* ((name (tramp-imap-file-name-name vec))
+ (search-name (or name ""))
+ (search-name (if exact (concat search-name "$") search-name))
+ (iht (tramp-imap-make-iht vec search-name)))
+;; TODO: catch errors
+ ;; (tramp-error vec 'none "bad name %s or mailbox %s" name mbox))
+ (imap-hash-map (lambda (uid headers body)
+ (let ((subject (substring
+ (aget headers 'Subject "")
+ (length tramp-imap-subject-marker))))
+ (list
+ subject
+ nil
+ -1
+ 1
+ 1
+ '(0 0)
+ '(0 0)
+ '(0 0)
+ 1
+ "-rw-rw-rw-"
+ nil
+ uid
+ (tramp-get-device vec))))
+ iht t)))
+
+(defun tramp-imap-handle-write-region (start end filename &optional append
visit lockname confirm)
+ "Like `write-region' for Tramp files."
+ (setq filename (expand-file-name filename))
+ (with-parsed-tramp-file-name filename nil
+ ;; XEmacs takes a coding system as the seventh argument, not `confirm'.
+ (when (and (not (featurep 'xemacs))
+ confirm (file-exists-p filename))
+ (unless (y-or-n-p (format "File %s exists; overwrite anyway? "
+ filename))
+ (tramp-error v 'file-error "File not overwritten")))
+ (tramp-flush-file-property v localname)
+ (let* ((old-buffer (current-buffer))
+ (inode (tramp-imap-get-file-inode filename))
+ (min 1)
+ (max (point-max))
+ ;; Make sure we have good start and end values.
+ (start (or start min))
+ (end (or end max))
+ temp-buffer)
+ (with-temp-buffer
+ (setq temp-buffer (if (and (eq start min) (eq end max))
+ old-buffer
+ ;; If this is a region write, insert the substring.
+ (insert
+ (with-current-buffer old-buffer
+ (buffer-substring-no-properties start end)))
+ (current-buffer)))
+ (tramp-imap-put-file v
+ temp-buffer
+ (tramp-imap-file-name-name v)
+ inode
+ t)))
+ (when (eq visit t)
+ (set-visited-file-modtime))))
+
+(defun tramp-imap-handle-insert-directory
+ (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)))
+ (with-parsed-tramp-file-name filename nil
+ (save-match-data
+ (let ((base (file-name-nondirectory localname))
+ (entries (copy-sequence
+ (tramp-imap-get-file-entries
+ v (file-name-directory localname)))))
+
+ (when wildcard
+ (when (string-match "\\." base)
+ (setq base (replace-match "\\\\." nil nil base)))
+ (when (string-match "\\*" base)
+ (setq base (replace-match ".*" nil nil base)))
+ (when (string-match "\\?" base)
+ (setq base (replace-match ".?" nil nil base))))
+
+ ;; Filter entries.
+ (setq entries
+ (delq
+ nil
+ (if (or wildcard (zerop (length base)))
+ ;; Check for matching entries.
+ (mapcar
+ (lambda (x)
+ (when (string-match
+ (format "^%s" base) (nth 0 x))
+ x))
+ entries)
+ ;; We just need the only and only entry FILENAME.
+ (list (assoc base entries)))))
+
+ ;; Sort entries.
+ (setq entries
+ (sort
+ entries
+ (lambda (x y)
+ (if (string-match "t" switches)
+ ;; Sort by date.
+ (tramp-time-less-p (nth 6 y) (nth 6 x))
+ ;; Sort by name.
+ (string-lessp (nth 0 x) (nth 0 y))))))
+
+ ;; Handle "-F" switch.
+ (when (string-match "F" switches)
+ (mapc
+ (lambda (x)
+ (when (not (zerop (length (car x))))
+ (cond
+ ((char-equal ?d (string-to-char (nth 9 x)))
+ (setcar x (concat (car x) "/")))
+ ((char-equal ?x (string-to-char (nth 9 x)))
+ (setcar x (concat (car x) "*"))))))
+ entries))
+
+ ;; Print entries.
+ (mapcar
+ (lambda (x)
+ (when (not (zerop (length (nth 0 x))))
+ (insert
+ (format
+ "%10s %3d %-8s %-8s %8s %s "
+ (nth 9 x) ; mode
+ (nth 11 x) ; inode
+ "nobody" "nogroup"
+ (nth 8 x) ; size
+ (format-time-string
+ (if (tramp-time-less-p
+ (tramp-time-subtract (current-time) (nth 6 x))
+ tramp-half-a-year)
+ "%b %e %R"
+ "%b %e %Y")
+ (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.
+ (let ((pos (point)))
+ (insert (format "%s" (nth 0 x))) ; file name
+ (put-text-property pos (point) 'dired-filename t))
+ (insert "\n")
+ (forward-line)
+ (beginning-of-line)))
+ entries)))))
+
+(defun tramp-imap-handle-insert-file-contents
+ (filename &optional visit beg end replace)
+ "Like `insert-file-contents' for Tramp files."
+ (barf-if-buffer-read-only)
+ (when visit
+ (setq buffer-file-name (expand-file-name filename))
+ (set-visited-file-modtime)
+ (set-buffer-modified-p nil))
+ (with-parsed-tramp-file-name filename nil
+ (if (not (file-exists-p filename))
+ (tramp-error
+ 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))
+;;; 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)))))
+
+(defun tramp-imap-handle-file-exists-p (filename)
+ "Like `file-exists-p' for Tramp files."
+ (and (file-attributes filename) t))
+
+(defun tramp-imap-handle-file-directory-p (filename)
+ "Like `file-directory-p' for Tramp-IMAP files."
+ ;; We allow only mailboxes to be a directory.
+ (with-parsed-tramp-file-name (expand-file-name filename default-directory)
nil
+ (and (string-match "^/[^/]*$" (directory-file-name localname)) t)))
+
+(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)))))
+
+(defun tramp-imap-get-file-inode (filename &optional id-format)
+ "Get inode equivalent \(actually the UID) for Tramp-IMAP FILENAME."
+ (nth 10 (tramp-compat-file-attributes filename id-format)))
+
+(defun tramp-imap-handle-file-executable-p (filename)
+ "Like `file-executable-p' for Tramp files. False for IMAP."
+ nil)
+
+(defun tramp-imap-handle-file-readable-p (filename)
+ "Like `file-readable-p' for Tramp files. True for IMAP."
+ (file-exists-p filename))
+
+(defun tramp-imap-handle-file-writable-p (filename)
+ "Like `file-writable-p' for Tramp files. True for IMAP."
+ ;; `file-exists-p' does not work yet for directories.
+ ;; (file-exists-p (file-name-directory filename)))
+ (file-directory-p (file-name-directory filename)))
+
+(defun tramp-imap-handle-delete-file (filename)
+ "Like `delete-file' for Tramp files."
+ (cond
+ ((not (file-exists-p filename)) nil)
+ (t (with-parsed-tramp-file-name (expand-file-name filename) nil
+ (let ((iht (tramp-imap-make-iht v)))
+ (imap-hash-rem (tramp-imap-get-file-inode filename) iht))))))
+
+(defun tramp-imap-handle-directory-files-and-attributes
+ (directory &optional full match nosort id-format)
+ "Like `directory-files-and-attributes' for Tramp files."
+ (mapcar
+ (lambda (x)
+ (cons x (tramp-compat-file-attributes
+ (if full x (expand-file-name x directory)) id-format)))
+ (directory-files directory full match nosort)))
+
+;; TODO: fix this in tramp-imap-get-file-entries.
+(defun tramp-imap-handle-file-newer-than-file-p (file1 file2)
+ "Like `file-newer-than-file-p' for Tramp files."
+ (cond
+ ((not (file-exists-p file1)) nil)
+ ((not (file-exists-p file2)) t)
+ (t (tramp-time-less-p (nth 5 (file-attributes file2))
+ (nth 5 (file-attributes file1))))))
+
+(defun tramp-imap-handle-file-local-copy (filename)
+ "Like `file-local-copy' for Tramp files."
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
+ (unless (file-exists-p filename)
+ (tramp-error
+ 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)
+ "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)."
+ ;; `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)))
+ (imap-hash-put (list
+ (list (cons
+ 'Subject
+ (format
+ "%s%s"
+ tramp-imap-subject-marker
+ (or subject "no subject"))))
+ (cond ((bufferp filename-or-buffer)
+ (with-current-buffer filename-or-buffer
+ (if encode
+ (tramp-imap-encode-buffer)
+ (buffer-string))))
+ ;; TODO: allow file names.
+ (t "No body available")))
+ iht
+ inode)))
+
+(defun tramp-imap-get-file (filename &optional decode)
+ ;; (debug (tramp-imap-get-file-inode filename))
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
+ (condition-case ()
+ ;; `tramp-current-host' is used in
+ ;; `tramp-imap-passphrase-callback-function'.
+ (let* ((tramp-current-host (tramp-file-name-real-host v))
+ (iht (tramp-imap-make-iht v))
+ (inode (tramp-imap-get-file-inode filename))
+ (data (imap-hash-get inode iht t)))
+ (if decode
+ (with-temp-buffer
+ (insert (nth 1 data))
+ ;;(debug inode (buffer-string))
+ (tramp-imap-decode-buffer))
+ (nth 1 data)))
+ (error (tramp-error
+ v 'file-error "File `%s' could not be read" filename)))))
+
+(defun tramp-imap-passphrase-callback-function (context key-id handback)
+ "Called by EPG to get a passphrase for Tramp-IMAP.
+CONTEXT is the encryption/decryption EPG context.
+HANDBACK is just carried through.
+KEY-ID can be 'SYM or 'PIN among others."
+ (let* ((server tramp-current-host)
+ (port "tramp-imap") ; this is NOT the server password!
+ (auth-passwd
+ (auth-source-user-or-password "password" server port)))
+ (or
+ (copy-sequence auth-passwd)
+ ;; If we cache the passphrase and we have one.
+ (if (and (eq tramp-imap-passphrase-cache t)
+ tramp-imap-passphrase)
+ ;; Do we reuse it?
+ (if (y-or-n-p "Reuse the passphrase? ")
+ (copy-sequence tramp-imap-passphrase)
+ ;; Don't reuse: revert caching behavior to nil, erase passphrase,
+ ;; call ourselves again.
+ (setq tramp-imap-passphrase-cache nil)
+ (setq tramp-imap-passphrase nil)
+ (tramp-imap-passphrase-callback-function context key-id handback))
+ (let ((p (if (eq key-id 'SYM)
+ (read-passwd
+ "Tramp-IMAP passphrase for symmetric encryption: "
+ (eq (epg-context-operation context) 'encrypt)
+ tramp-imap-passphrase)
+ (read-passwd
+ (if (eq key-id 'PIN)
+ "Tramp-IMAP passphrase for PIN: "
+ (let ((entry (assoc key-id epg-user-id-alist)))
+ (if entry
+ (format "Tramp-IMAP passphrase for %s %s: "
+ key-id (cdr entry))
+ (format "Tramp-IMAP passphrase for %s: " key-id))))
+ nil
+ tramp-imap-passphrase))))
+
+ ;; If we have an answer, the passphrase has changed,
+ ;; the user hasn't declined keeping the passphrase,
+ ;; and they answer yes to keep it now...
+ (when (and
+ p
+ (not (equal tramp-imap-passphrase p))
+ (not (eq tramp-imap-passphrase-cache 'never))
+ (y-or-n-p "Keep the passphrase? "))
+ (setq tramp-imap-passphrase (copy-sequence p))
+ (setq tramp-imap-passphrase-cache t))
+
+ ;; If we still don't have a passphrase, the user didn't want
+ ;; to keep it.
+ (when (and
+ p
+ (not tramp-imap-passphrase))
+ (setq tramp-imap-passphrase-cache 'never))
+
+ p)))))
+
+(defun tramp-imap-encode-buffer ()
+ (let ((context (epg-make-context 'OpenPGP))
+ cipher)
+ (epg-context-set-armor context t)
+ (epg-context-set-passphrase-callback context
+
#'tramp-imap-passphrase-callback-function)
+ (epg-context-set-progress-callback context
+ (cons #'epa-progress-callback-function
+ "Encrypting..."))
+ (message "Encrypting...")
+ (setq cipher (epg-encrypt-string
+ context
+ (encode-coding-string (buffer-string) 'utf-8)
+ nil))
+ (message "Encrypting...done")
+ cipher))
+
+(defun tramp-imap-decode-buffer ()
+ (let ((context (epg-make-context 'OpenPGP))
+ plain)
+ (epg-context-set-passphrase-callback context
+
#'tramp-imap-passphrase-callback-function)
+ (epg-context-set-progress-callback context
+ (cons #'epa-progress-callback-function
+ "Decrypting..."))
+ (message "Decrypting...")
+ (setq plain (decode-coding-string
+ (epg-decrypt-string context (buffer-string))
+ 'utf-8))
+ (message "Decrypting...done")
+ plain))
+
+(defun tramp-imap-file-name-mailbox (vec)
+ (nth 0 (tramp-imap-file-name-parse vec)))
+
+(defun tramp-imap-file-name-name (vec)
+ (nth 1 (tramp-imap-file-name-parse vec)))
+
+(defun tramp-imap-file-name-localname (vec)
+ (nth 1 (tramp-imap-file-name-parse vec)))
+
+(defun tramp-imap-file-name-parse (vec)
+ (let ((name (substring-no-properties (tramp-file-name-localname vec))))
+ (if (string-match "^/\\([^/]+\\)/?\\(.*\\)$" name)
+ (list (match-string 1 name)
+ (match-string 2 name))
+ nil)))
+
+(defun tramp-imap-make-iht (vec &optional needed-subject)
+ "Translate the Tramp vector VEC to the imap-hash structure.
+With NEEDED-SUBJECT, alters the imap-hash test accordingly."
+ (let* ((mbox (tramp-imap-file-name-mailbox vec))
+ (server (tramp-file-name-real-host vec))
+ (method (tramp-file-name-method vec))
+ (user (tramp-file-name-user vec))
+ (ssl (string-equal method tramp-imaps-method))
+ (port (or (tramp-file-name-port vec)
+ (tramp-get-method-parameter method 'tramp-default-port)))
+ (result (imap-hash-make server port mbox)))
+ ;; Return the IHT with a test override to look for the subject
+ ;; marker. Set also user and ssl tags.
+ (setq result (plist-put result :user user)
+ result (plist-put result :ssl ssl)
+ result (plist-put
+ result
+ :test (format "^%s%s"
+ tramp-imap-subject-marker
+ (if needed-subject needed-subject ""))))))
+
+;;; TODO:
+
+;; * Implement `tramp-imap-handle-delete-directory',
+;; `tramp-imap-handle-make-directory',
+;; `tramp-imap-handle-make-directory-internal',
+;; `tramp-imap-handle-set-file-times'.
+
+;; * Encode the subject. If the filename has trailing spaces (like
+;; "test "), those characters get lost, for example in dired listings.
+
+;; * When opening a dired buffer, like "/imap::INBOX.test", there are
+;; several error messages:
+;; "Buffer has a running process; kill it? (yes or no) "
+;; "error in process filter: Internal error, tag 6 status BAD code nil text
No mailbox selected."
+;; Afterwards, everything seems to be fine.
+
+;; * imaps works for local IMAP servers. Accessing
+;; "/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.
+
+(provide 'tramp-imap)
+;;; tramp-imap.el ends here
+
+;; Ignore, for testing only.
+
+;;; (setq tramp-imap-subject-marker "T")
+;;; (tramp-imap-get-file-entries (tramp-dissect-file-name
"/imap:yourhosthere.com:/INBOX.test/4") t)
+;;; (tramp-imap-get-file-entries (tramp-dissect-file-name
"/imap:yourhosthere.com:/INBOX.test/") t)
+;;; (tramp-imap-get-file-entries (tramp-dissect-file-name
"/imap:yourhosthere.com:/test/4") t)
+;;; (tramp-imap-get-file-entries (tramp-dissect-file-name
"/imap:yourhosthere.com:/test/") t)
+;;; (tramp-imap-get-file-entries (tramp-dissect-file-name
"/imap:yourhosthere.com:/test/welcommen") t)
+;;; (tramp-imap-get-file-entries (tramp-dissect-file-name
"/imap:yourhosthere.com:/test/welcommen") t t)
+;;;(tramp-imap-get-file-inode "/imap:yourhosthere.com:/test/welcome")
+;;; (dired-copy-file "/etc/fstab" "/imap:yourhosthere.com:/test/welcome" t)
+;;; (write-region 1 100 "/imap:yourhosthere.com:/test/welcome")
+;;; (tramp-imap-get-file "/imap:yourhosthere.com:/test/welcome" t)
+;;(with-temp-buffer (insert "hello") (write-file
"/imap:yourhosthere.com:/test/welcome"))
+;;(with-temp-buffer (insert "hello") (write-file
"/imap:yourhosthere.com:/test/welcome2"))
+;;(file-writable-p "/imap:yourhosthere.com:/test/welcome2")
+;;(file-name-directory "/imap:yourhosthere.com:/test/welcome2")
+;;(with-temp-buffer (insert "hello") (delete-file "/tmp/hellotest")
(write-file "/tmp/hellotest") (write-file
"/imap:yourhosthere.com:/test/welcome2"))
+;;;(file-exists-p "/imap:yourhosthere.com:/INBOX.test/4")
+;;;(file-attributes "/imap:yourhosthere.com:/INBOX.test/4")
+;;;(setq vec (tramp-dissect-file-name "/imap:yourhosthere.com:/INBOX.test/4"))
+;;;(tramp-imap-handle-file-attributes "/imap:yourhosthere.com:/INBOX.test/4")
+;;; (tramp-imap-handle-insert-file-contents
"/imap:address@hidden:/INBOX.test/4" nil nil nil nil)
+;;;(insert-file-contents "/imap:yourhosthere.com:/INBOX.test/4")
+;;;(file-attributes "/imap:yourhosthere.com:/test/welcommen")
+;;;(insert-file-contents "/imap:yourhosthere.com:/test/welcome")
+;;;(file-exists-p "/imap:yourhosthere.com:/test/welcome2")
+;;;(tramp-imap-handle-file-attributes "/imap:yourhosthere.com:/test/welcome")
+;;;(tramp-imap-get-file-inode "/imap:yourhosthere.com:/test/welcommen")
+;;;(tramp-imap-get-file-inode "/imap:yourhosthere.com:/test/welcome")
+;;;(file-writable-p "/imap:yourhosthere.com:/test/welcome2")
+;;; (delete-file "/imap:yourhosthere.com:/test/welcome")
+;;; (tramp-imap-get-file "/imap:yourhosthere.com:/test/welcommen" t)
+;;; (tramp-imap-get-file "/imap:yourhosthere.com:/test/welcome" t)
+;;;(tramp-imap-file-name-mailbox (tramp-dissect-file-name
"/imap:yourhosthere.com:/INBOX.test"))
+;;;(tramp-imap-file-name-mailbox (tramp-dissect-file-name
"/imap:yourhosthere.com:/INBOX.test/new/old"))
+;;;(tramp-imap-file-name-mailbox (tramp-dissect-file-name
"/imap:yourhosthere.com:/INBOX.test/new"))
+;;;(tramp-imap-file-name-parse (tramp-dissect-file-name
"/imap:yourhosthere.com:/INBOX.test/new/two"))
+;;;(tramp-imap-file-name-parse (tramp-dissect-file-name
"/imap:yourhosthere.com:/INBOX.test/new/one"))
+;;;(tramp-imap-file-name-parse (tramp-dissect-file-name
"/imap:yourhosthere.com:/INBOX.test"))
+;;; (tramp-imap-file-name-parse (tramp-dissect-file-name
"/imap:yourhosthere.com:/test/4"))
+;;; (tramp-imap-file-name-parse (tramp-dissect-file-name
"/imap:yourhosthere.com:/test/"))
+;;; (tramp-imap-file-name-parse (tramp-dissect-file-name
"/imap:yourhosthere.com:/test/welcommen"))
+;;; (tramp-imap-file-name-parse (tramp-dissect-file-name
"/imap:yourhosthere.com:/test/welcommen"))
+;;; (tramp-imap-make-iht (tramp-dissect-file-name
"/imap:yourhosthere.com:/test/welcommen"))
+;;; (tramp-imap-make-iht (tramp-dissect-file-name
"/imap:yourhosthere.com:/INBOX.test/4"))
+;;; (tramp-imap-make-iht (tramp-dissect-file-name
"/imap:yourhosthere.com:/INBOX.test/4") "extra")
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] emacs/lisp/net tramp-imap.el,
Michael Albinus <=