[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] /srv/bzr/emacs/trunk r103254: * Makefile.in (TRAMP_SRC): R
|
From: |
Michael Albinus |
|
Subject: |
[Emacs-diffs] /srv/bzr/emacs/trunk r103254: * Makefile.in (TRAMP_SRC): Remove tramp-imap.el. |
|
Date: |
Sun, 13 Feb 2011 13:25:45 +0100 |
|
User-agent: |
Bazaar (2.0.3) |
------------------------------------------------------------
revno: 103254
committer: Michael Albinus <address@hidden>
branch nick: trunk
timestamp: Sun 2011-02-13 13:25:45 +0100
message:
* 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.
removed:
lisp/net/tramp-imap.el
modified:
lisp/ChangeLog
lisp/Makefile.in
lisp/net/tramp.el
=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog 2011-02-13 03:07:53 +0000
+++ b/lisp/ChangeLog 2011-02-13 12:25:45 +0000
@@ -1,3 +1,12 @@
+2011-02-13 Michael Albinus <address@hidden>
+
+ * 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.
+
2011-02-13 Chong Yidong <address@hidden>
* vc/vc.el (vc-print-log-setup-buttons): Instead of using the
=== modified file 'lisp/Makefile.in'
--- a/lisp/Makefile.in 2011-01-25 04:08:28 +0000
+++ b/lisp/Makefile.in 2011-02-13 12:25:45 +0000
@@ -329,16 +329,16 @@
--eval "(setq make-backup-files nil)" \
-f batch-update-autoloads $(MH_E_DIR)
-# Update TRAMP internal autoloads. Maybe we could move trmp*.el into
+# Update TRAMP internal autoloads. Maybe we could move tramp*.el into
# an own subdirectory. OTOH, it does not hurt to keep them in
# lisp/net.
TRAMP_DIR = $(lisp)/net
TRAMP_SRC = $(TRAMP_DIR)/tramp.el $(TRAMP_DIR)/tramp-cache.el \
$(TRAMP_DIR)/tramp-cmds.el $(TRAMP_DIR)/tramp-compat.el \
$(TRAMP_DIR)/tramp-ftp.el $(TRAMP_DIR)/tramp-gvfs.el \
- $(TRAMP_DIR)/tramp-gw.el $(TRAMP_DIR)/tramp-imap.el \
- $(TRAMP_DIR)/tramp-sh.el $(TRAMP_DIR)/tramp-smb.el \
- $(TRAMP_DIR)/tramp-uu.el $(TRAMP_DIR)/trampver.el
+ $(TRAMP_DIR)/tramp-gw.el $(TRAMP_DIR)/tramp-sh.el \
+ $(TRAMP_DIR)/tramp-smb.el $(TRAMP_DIR)/tramp-uu.el \
+ $(TRAMP_DIR)/trampver.el
$(TRAMP_DIR)/tramp-loaddefs.el: $(TRAMP_SRC)
$(emacs) -l autoload \
=== removed file 'lisp/net/tramp-imap.el'
--- a/lisp/net/tramp-imap.el 2011-02-12 17:51:02 +0000
+++ b/lisp/net/tramp-imap.el 1970-01-01 00:00:00 +0000
@@ -1,850 +0,0 @@
-;;; tramp-imap.el --- Tramp interface to IMAP through imap.el
-
-;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
-
-;; Author: Teodor Zlatanov <address@hidden>
-;; Keywords: mail, comm
-;; Package: tramp
-
-;; 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)
-
-(autoload 'auth-source-search "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 ...
-;;;###tramp-autoload
-(defconst tramp-imap-method "imap"
- "*Method to connect via IMAP protocol.")
-
-;;;###tramp-autoload
-(when (and (locate-library "epa") (locate-library "imap-hash"))
- (add-to-list 'tramp-methods
- (list tramp-imap-method '(tramp-default-port 143))))
-
-;; Define Tramp IMAPS method ...
-;;;###tramp-autoload
-(defconst tramp-imaps-method "imaps"
- "*Method to connect via secure IMAP protocol.")
-
-;; ... and add it to the method list.
-;;;###tramp-autoload
-(when (and (locate-library "epa") (locate-library "imap-hash"))
- (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.
-;;;###tramp-autoload
-(add-to-list
- 'tramp-default-user-alist
- (list (concat "\\`"
- (regexp-opt (list tramp-imap-method 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-directory' 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-handle-directory-files-and-attributes)
- (dired-call-process . ignore)
- ;; `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 . ignore)
- (file-exists-p . tramp-handle-file-exists-p)
- (file-local-copy . tramp-imap-handle-file-local-copy)
- (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-handle-file-newer-than-file-p)
- (file-ownership-preserved-p . ignore)
- (file-readable-p . tramp-handle-file-exists-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)
- (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-selinux-context' performed by default handler.
- (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 'tramp)
-
-(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)
-
-;;;###tramp-autoload
-(defsubst 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))))
-
-;;;###tramp-autoload
-(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))))
-
-;;;###tramp-autoload
-(when (and (locate-library "epa") (locate-library "imap-hash"))
- (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 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))
-
-(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))))
-
- (with-parsed-tramp-file-name (if t1 filename newname) nil
- (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)
- "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)))
- (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 "<\\(address@hidden)@" from)
- (match-string 1 from)
- "nobody"))
- (list
- subject
- nil
- -1
- from
- "nogroup"
- date
- date
- date
- size
- "-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))
- (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))
- (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
- (nth 3 x) ; uid
- (nth 4 x) ; gid
- (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. The inserted name
- ;; could be from somewhere else, so we use the relative
- ;; file name of `default-directory'.
- (let ((pos (point)))
- (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)))))
-
-(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)
- (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)
- (list (expand-file-name filename) size))))))
-
-(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
- (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."
- (nth 10 (tramp-compat-file-attributes filename id-format)))
-
-(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 &optional trash)
- "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-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)))
- (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). 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)))
- (imap-hash-put (list
- (list (cons
- 'Subject
- (format
- "%s%s"
- tramp-imap-subject-marker
- (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
- (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 (plist-get
- (nth 0 (auth-source-search :max 1
- :host server
- :port port))
- :secret))
- (auth-passwd (if (functionp auth-passwd)
- (funcall auth-passwd)
- auth-passwd)))
- (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
- (symbol-value '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 (tramp-file-name-port vec))
- (result (imap-hash-make server port mbox user nil ssl)))
- ;; Return the IHT with a test override to look for the subject
- ;; marker.
- (plist-put
- result
- :test (format "^%s%s"
- tramp-imap-subject-marker
- (if needed-subject needed-subject "")))))
-
-(add-hook 'tramp-unload-hook
- (lambda ()
- (unload-feature 'tramp-imap 'force)))
-
-;;; 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."
-
-;; * Improve `tramp-imap-handle-file-attributes' for directories.
-
-;; * Saving a file creates a second one, instead of overwriting.
-
-;; * Backup files: just *one* is kept.
-
-;; * Password requests shall have a descriptive prompt.
-
-;; * Exiting Emacs, there are running IMAP processes. Make them quiet
-;; by `set-process-query-on-exit-flag'.
-
-(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")
=== modified file 'lisp/net/tramp.el'
--- a/lisp/net/tramp.el 2011-02-12 17:51:02 +0000
+++ b/lisp/net/tramp.el 2011-02-13 12:25:45 +0000
@@ -3526,23 +3526,24 @@
(with-parsed-tramp-file-name key nil
(prog1
(or
- ;; See if auth-sources contains something useful, if it's bound.
+ ;; See if auth-sources contains something useful, if it's
+ ;; bound. `auth-source-user-or-password' is an obsoleted
+ ;; function, it has been replaced by `auth-source-search'.
(and (boundp 'auth-sources)
(tramp-get-connection-property v "first-password-request" nil)
;; Try with Tramp's current method.
(if (fboundp 'auth-source-search)
- (progn
- (setq auth-info
+ (setq auth-info
(tramp-compat-funcall
'auth-source-search
:max 1
:user (or tramp-current-user t)
:host tramp-current-host
- :port tramp-current-method))
- (setq auth-passwd (plist-get (nth 0 auth-info) :secret))
- (setq auth-passwd (if (functionp auth-passwd)
+ :port tramp-current-method)
+ auth-passwd (plist-get (nth 0 auth-info) :secret)
+ auth-passwd (if (functionp auth-passwd)
(funcall auth-passwd)
- auth-passwd)))
+ auth-passwd))
(tramp-compat-funcall
'auth-source-user-or-password
"password" tramp-current-host tramp-current-method)))
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] /srv/bzr/emacs/trunk r103254: * Makefile.in (TRAMP_SRC): Remove tramp-imap.el.,
Michael Albinus <=