;;; -*- mode: Emacs-Lisp; coding: iso-2022-7bit; -*-
;;; tramp.el --- Transparent Remote Access, Multiple Protocol
-;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2005 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
+;; 2005, 2006 Free Software Foundation, Inc.
-;; Author: kai.grossjohann@gmx.net
+;; Author: Kai Gro\e,A_\e(Bjohann <kai.grossjohann@gmx.net>
+;; Michael Albinus <michael.albinus@gmx.de>
;; Keywords: comm, processes
;; This file is part of GNU Emacs.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; The Tramp version number and bug report address, as prepared by configure.
(require 'trampver)
+(add-hook 'tramp-unload-hook
+ '(lambda ()
+ (when (featurep 'trampver)
+ (unload-feature 'trampver 'force))))
+
+(if (featurep 'xemacs)
+ (require 'timer-funcs)
+ (require 'timer))
-(require 'timer)
(require 'format-spec) ;from Gnus 5.8, also in tar ball
;; As long as password.el is not part of (X)Emacs, it shouldn't
;; be mandatory
(autoload 'tramp-uuencode-region "tramp-uu"
"Implementation of `uuencode' in Lisp.")
+(add-hook 'tramp-unload-hook
+ '(lambda ()
+ (when (featurep 'tramp-uu)
+ (unload-feature 'tramp-uu 'force))))
(unless (fboundp 'uudecode-decode-region)
(autoload 'uudecode-decode-region "uudecode"))
;;;###autoload
(defvar tramp-unified-filenames (not (featurep 'xemacs))
"Non-nil means to use unified Ange-FTP/Tramp filename syntax.
-Nil means to use a separate filename syntax for Tramp.")
+Otherwise, use a separate filename syntax for Tramp.")
;; Load foreign methods. Because they do require Tramp internally, this
;; must be done with the `eval-after-load' trick.
;; tramp-ftp supports Ange-FTP only. Not suited for XEmacs therefore.
(unless (featurep 'xemacs)
(eval-after-load "tramp"
- '(require 'tramp-ftp)))
+ '(progn
+ (require 'tramp-ftp)
+ (add-hook 'tramp-unload-hook
+ '(lambda ()
+ (when (featurep 'tramp-ftp)
+ (unload-feature 'tramp-ftp 'force)))))))
(when (and tramp-unified-filenames (featurep 'xemacs))
(eval-after-load "tramp"
- '(require 'tramp-efs)))
+ '(progn
+ (require 'tramp-efs)
+ (add-hook 'tramp-unload-hook
+ '(lambda ()
+ (when (featurep 'tramp-efs)
+ (unload-feature 'tramp-efs 'force)))))))
;; tramp-smb uses "smbclient" from Samba.
;; Not available under Cygwin and Windows, because they don't offer
;; UNC file names like "//host/share/localname".
(unless (memq system-type '(cygwin windows-nt))
(eval-after-load "tramp"
- '(require 'tramp-smb)))
+ '(progn
+ (require 'tramp-smb)
+ (add-hook 'tramp-unload-hook
+ '(lambda ()
+ (when (featurep 'tramp-smb)
+ (unload-feature 'tramp-smb 'force)))))))
(eval-when-compile
(require 'cl)
;; Avoid byte-compiler warnings if the byte-compiler supports this.
;; Currently, XEmacs supports this.
(eval-when-compile
- (when (fboundp 'byte-compiler-options)
+ (when (featurep 'xemacs)
(let (unused-vars) ; Pacify Emacs byte-compiler
(defalias 'warnings 'identity) ; Pacify Emacs byte-compiler
(byte-compiler-options (warnings (- unused-vars))))))
(when (boundp 'byte-compile-not-obsolete-var)
(setq byte-compile-not-obsolete-var 'directory-sep-char)))
-;; XEmacs byte-compiler raises warning abouts `last-coding-system-used'.
-(eval-when-compile
- (unless (boundp 'last-coding-system-used)
- (defvar last-coding-system-used nil)))
-
;;; User Customizable Internal Variables:
(defgroup tramp nil
(if (and (fboundp 'executable-find)
(executable-find "plink"))
"plink"
- "ssh")
+ "scp")
"*Default method to use for transferring files.
See `tramp-methods' for possibilities.
Also see `tramp-default-method-alist'."
:type 'string)
(defcustom tramp-remote-path
- '("/bin" "/usr/bin" "/usr/sbin" "/usr/local/bin" "/usr/ccs/bin"
- "/local/bin" "/local/freeware/bin" "/local/gnu/bin"
+ ;; "/usr/xpg4/bin" has been placed first, because on Solaris a POSIX
+ ;; compatible "id" is needed.
+ '("/usr/xpg4/bin" "/bin" "/usr/bin" "/usr/sbin" "/usr/local/bin"
+ "/usr/ccs/bin" "/local/bin" "/local/freeware/bin" "/local/gnu/bin"
"/usr/freeware/bin" "/usr/pkg/bin" "/usr/contrib/bin")
"*List of directories to search for executables on remote host.
Please notify me about other semi-standard directories to include here.
:type '(repeat string))
(defcustom tramp-login-prompt-regexp
- ".*ogin: *"
+ ".*ogin\\( .*\\)?: *"
"*Regexp matching login-like prompts.
-The regexp should match at end of buffer."
+The regexp should match at end of buffer.
+
+Sometimes the prompt is reported to look like \"login as:\"."
:group 'tramp
:type 'regexp)
:type 'regexp)
(defcustom tramp-password-prompt-regexp
- "^.*\\([pP]assword\\|passphrase.*\\):\^@? *"
+ "^.*\\([pP]assword\\|passphrase\\).*:\^@? *"
"*Regexp matching password-like prompts.
The regexp should match at end of buffer.
:type 'regexp)
(defcustom tramp-user-regexp
- "[^:@/ \t]*"
+ "[^:/ \t]*"
"*Regexp matching user names."
:group 'tramp
:type 'regexp)
(when (and (not (featurep 'xemacs))
(memq system-type '(hpux)))
500)
+;; Parentheses in docstring starting at beginning of line are escaped.
+;; Fontification is messed up when
+;; `open-paren-in-column-0-is-defun-start' set to t.
"*If non-nil, chunksize for sending input to local process.
It is necessary only on systems which have a buggy `process-send-string'
implementation. The necessity, whether this variable must be set, can be
checked via the following code:
(with-temp-buffer
- (let ((bytes 1000)
- (proc (start-process (buffer-name) (current-buffer) \"wc\" \"-c\")))
- (process-send-string proc (make-string bytes ?x))
- (process-send-eof proc)
- (process-send-eof proc)
- (accept-process-output proc 1)
- (goto-char (point-min))
- (re-search-forward \"\\\\w+\")
- (message \"Bytes sent: %s\\tBytes received: %s\" bytes (match-string 0))))
-
-In the Emacs normally running Tramp, evaluate the above code.
-You can do this, for example, by pasting it into the `*scratch*'
-buffer and then hitting C-j with the cursor after the last
-closing parenthesis.
-
-If your Emacs is buggy, the sent and received numbers will be
-different. In that case, you'll want to set this variable to
-some number. For those people who have needed it, the value 500
-seems to have worked well. There is no way to predict what value
-you need; maybe you could just experiment a bit.
+ (let* ((user \"xxx\") (host \"yyy\")
+ (init 0) (step 50)
+ (sent init) (received init))
+ (while (= sent received)
+ (setq sent (+ sent step))
+ (erase-buffer)
+ (let ((proc (start-process (buffer-name) (current-buffer)
+ \"ssh\" \"-l\" user host \"wc\" \"-c\")))
+ (when (memq (process-status proc) '(run open))
+ (process-send-string proc (make-string sent ?\\ ))
+ (process-send-eof proc)
+ (process-send-eof proc))
+ (while (not (progn (goto-char (point-min))
+ (re-search-forward \"\\\\w+\" (point-max) t)))
+ (accept-process-output proc 1))
+ (when (memq (process-status proc) '(run open))
+ (setq received (string-to-number (match-string 0)))
+ (delete-process proc)
+ (message \"Bytes sent: %s\\tBytes received: %s\" sent received)
+ (sit-for 0))))
+ (if (> sent (+ init step))
+ (message \"You should set `tramp-chunksize' to a maximum of %s\"
+ (- sent step))
+ (message \"Test does not work\")
+ (display-buffer (current-buffer))
+ (sit-for 30))))
+
+In the Emacs normally running Tramp, evaluate the above code
+\(replace \"xxx\" and \"yyy\" by the remote user and host name,
+respectively). You can do this, for example, by pasting it into
+the `*scratch*' buffer and then hitting C-j with the cursor after the
+last closing parenthesis. Note that it works only if you have configured
+\"ssh\" to run without password query, see ssh-agent(1).
+
+You will see the number of bytes sent successfully to the remote host.
+If that number exceeds 1000, you can stop the execution by hitting
+C-g, because your Emacs is likely clean.
+
+If your Emacs is buggy, the code stops and gives you an indication
+about the value `tramp-chunksize' should be set. Maybe you could just
+experiment a bit, e.g. changing the values of `init' and `step'
+in the third line of the code.
+
+When it is necessary to set `tramp-chunksize', you might consider to
+use an out-of-the-band method (like \"scp\") instead of an internal one
+\(like \"ssh\"), because setting `tramp-chunksize' to non-nil decreases
+performance.
Please raise a bug report via \"M-x tramp-bug\" if your system needs
this variable to be set as well."
((fboundp 'md5-encode)
(lambda (x) (base64-encode-string
(funcall (symbol-function 'md5-encode) x))))
- (t (error "Coulnd't find an `md5' function")))
+ (t (error "Couldn't find an `md5' function")))
"Function to call for running the MD5 algorithm.")
(defvar tramp-end-of-output
on the remote file system.")
(defconst tramp-perl-directory-files-and-attributes "\
-chdir($ARGV[0]);
-opendir(DIR,\".\");
+chdir($ARGV[0]) or printf(\"\\\"Cannot change to $ARGV[0]: $''!''\\\"\\n\"), exit();
+opendir(DIR,\".\") or printf(\"\\\"Cannot open directory $ARGV[0]: $''!''\\\"\\n\"), exit();
@list = readdir(DIR);
closedir(DIR);
$n = scalar(@list);
(defvar tramp-perl-encode
"%s -e '
# This script contributed by Juanma Barranquero <lektu@terra.es>.
-# Copyright (C) 2002 Free Software Foundation, Inc.
+# Copyright (C) 2002, 2006 Free Software Foundation, Inc.
use strict;
my %%trans = do {
(defvar tramp-perl-decode
"%s -e '
# This script contributed by Juanma Barranquero <lektu@terra.es>.
-# Copyright (C) 2002 Free Software Foundation, Inc.
+# Copyright (C) 2002, 2006 Free Software Foundation, Inc.
use strict;
my %%trans = do {
Escape sequence %s is replaced with name of Perl binary.
This string is passed to `format', so percent characters need to be doubled.")
-; These values conform to `file-attributes' from XEmacs 21.2.
-; GNU Emacs and other tools not checked.
(defconst tramp-file-mode-type-map '((0 . "-") ; Normal file (SVID-v2 and XPG2)
(1 . "p") ; fifo
(2 . "c") ; character device
(insert-file-contents . tramp-handle-insert-file-contents)
(write-region . tramp-handle-write-region)
(find-backup-file-name . tramp-handle-find-backup-file-name)
+ (make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
(unhandled-file-name-directory . tramp-handle-unhandled-file-name-directory)
(dired-compress-file . tramp-handle-dired-compress-file)
(dired-call-process . tramp-handle-dired-call-process)
. tramp-handle-dired-recursive-delete-directory)
(set-visited-file-modtime . tramp-handle-set-visited-file-modtime)
(verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime))
- "Alist of handler functions.
+ "Alist of handler functions.
Operations not mentioned here will be handled by the normal Emacs functions.")
-;; Handlers for partial tramp file names. For GNU Emacs just
-;; `file-name-all-completions' is needed. The other ones are necessary
-;; for XEmacs.
+;; Handlers for partial tramp file names. For Emacs just
+;; `file-name-all-completions' is needed.
+;;;###autoload
(defconst tramp-completion-file-name-handler-alist
- '(
- (file-name-directory . tramp-completion-handle-file-name-directory)
- (file-name-nondirectory . tramp-completion-handle-file-name-nondirectory)
- (file-exists-p . tramp-completion-handle-file-exists-p)
- (file-name-all-completions . tramp-completion-handle-file-name-all-completions)
- (file-name-completion . tramp-completion-handle-file-name-completion)
- (expand-file-name . tramp-completion-handle-expand-file-name))
+ '((file-name-all-completions . tramp-completion-handle-file-name-all-completions)
+ (file-name-completion . tramp-completion-handle-file-name-completion))
"Alist of completion handler functions.
Used for file names matching `tramp-file-name-regexp'. Operations not
mentioned here will be handled by `tramp-file-name-handler-alist' or the
tramp-current-multi-method tramp-current-method
tramp-current-user tramp-current-host))
(goto-char (point-max))
- (tramp-insert-with-face
+ (unless (bolp)
+ (insert "\n"))
+ (tramp-insert-with-face
'italic
(concat "# " (apply #'format fmt-string args) "\n"))))))
,@body))
(put 'with-parsed-tramp-file-name 'lisp-indent-function 2)
-;; To be activated for debugging containing this macro
-;; It works only when VAR is nil. Otherwise, it can be deactivated by
-;; (put 'with-parsed-tramp-file-name 'edebug-form-spec 0)
-;; I'm too stupid to write a precise SPEC for it.
-(put 'with-parsed-tramp-file-name 'edebug-form-spec t)
+;; Enable debugging.
+(def-edebug-spec with-parsed-tramp-file-name (form symbolp body))
+;; Highlight as keyword.
+(font-lock-add-keywords 'emacs-lisp-mode '("\\<with-parsed-tramp-file-name\\>"))
(defmacro tramp-let-maybe (variable value &rest body)
"Let-bind VARIABLE to VALUE in BODY, but only if VARIABLE is not obsolete.
(let ((,variable ,value))
,@body)))
(put 'tramp-let-maybe 'lisp-indent-function 2)
+(put 'tramp-let-maybe 'edebug-form-spec t)
;;; Config Manipulation Functions:
file)))
(unless noerror
(when (not (file-exists-p file))
- (error "Cannot load nonexistant file `%s'" file)))
+ (error "Cannot load nonexistent file `%s'" file)))
(if (not (file-exists-p file))
nil
(unless nomessage
;; Localname manipulation functions that grok TRAMP localnames...
(defun tramp-handle-file-name-directory (file)
"Like `file-name-directory' but aware of TRAMP files."
- ;; everything except the last filename thing is the directory
+ ;; Everything except the last filename thing is the directory.
(with-parsed-tramp-file-name file nil
- ;; For the following condition, two possibilities should be tried:
- ;; (1) (string= localname "")
- ;; (2) (or (string= localname "") (string= localname "/"))
- ;; The second variant fails when completing a "/" directory on
- ;; the remote host, that is a filename which looks like
- ;; "/user@host:/". But maybe wildcards fail with the first variant.
- ;; We should do some investigation.
- (if (string= localname "")
- ;; For a filename like "/[foo]", we return "/". The `else'
- ;; case would return "/[foo]" unchanged. But if we do that,
- ;; then `file-expand-wildcards' ceases to work. It's not
- ;; quite clear to me what's the intuition that tells that this
- ;; behavior is the right behavior, but oh, well.
- "/"
- ;; run the command on the localname portion only
- ;; CCC: This should take into account the remote machine type, no?
- ;; --daniel <daniel@danann.net>
- (tramp-make-tramp-file-name multi-method method user host
- ;; This will not recurse...
- (or (file-name-directory localname) "")))))
+ ;; Run the command on the localname portion only.
+ (tramp-make-tramp-file-name
+ multi-method method user host (file-name-directory (or localname "")))))
(defun tramp-handle-file-name-nondirectory (file)
"Like `file-name-nondirectory' but aware of TRAMP files."
;; 8. File modes, as a string of ten letters or dashes as in ls -l.
res-filemodes
;; 9. t iff file's gid would change if file were deleted and
- ;; recreated.
- nil ;hm?
+ ;; recreated. Will be set in `tramp-convert-file-attributes'
+ t
;; 10. inode number.
res-inode
;; 11. Device number. Will be replaced by a virtual device number.
(if time-list
(tramp-run-real-handler 'set-visited-file-modtime (list time-list))
(let ((f (buffer-file-name))
- (coding-system-used nil))
+ coding-system-used)
(with-parsed-tramp-file-name f nil
(let* ((attr (file-attributes f))
;; '(-1 65535) means file doesn't exists yet.
(modtime (or (nth 5 attr) '(-1 65535))))
+ (when (boundp 'last-coding-system-used)
+ (setq coding-system-used (symbol-value 'last-coding-system-used)))
;; We use '(0 0) as a don't-know value. See also
;; `tramp-handle-file-attributes-with-ls'.
- (when (boundp 'last-coding-system-used)
- (setq coding-system-used last-coding-system-used))
(if (not (equal modtime '(0 0)))
(tramp-run-real-handler 'set-visited-file-modtime (list modtime))
(save-excursion
(progn (end-of-line) (point)))))
(setq tramp-buffer-file-attributes attr))
(when (boundp 'last-coding-system-used)
- (setq last-coding-system-used coding-system-used))
- nil)))))
+ (set 'last-coding-system-used coding-system-used))
+ nil)))))
;; CCC continue here
;; recorded last modification time.
(if (or (not (buffer-file-name))
(eq (visited-file-modtime) 0))
- t
+ t
(let ((f (buffer-file-name)))
(with-parsed-tramp-file-name f nil
(let* ((attr (file-attributes f))
;; if and only if that agrees with the buffer's record.
(t (equal mt '(-1 65535))))))))))
-(defadvice clear-visited-file-modtime (after tramp activate)
- "Set `tramp-buffer-file-attributes' back to nil.
-Tramp uses this variable as an emulation for the actual modtime of the file,
-if the remote host can't provide the modtime."
- (setq tramp-buffer-file-attributes nil))
-
(defun tramp-handle-set-file-modes (filename mode)
"Like `set-file-modes' for tramp files."
(with-parsed-tramp-file-name filename nil
(defun tramp-handle-file-ownership-preserved-p (filename)
"Like `file-ownership-preserved-p' for tramp files."
(with-parsed-tramp-file-name filename nil
- (or (not (file-exists-p filename))
- ;; Existing files must be writable.
- (zerop (tramp-run-test "-O" filename)))))
+ (let ((attributes (file-attributes filename)))
+ ;; Return t if the file doesn't exist, since it's true that no
+ ;; information would be lost by an (attempted) delete and create.
+ (or (null attributes)
+ (= (nth 2 attributes)
+ (tramp-get-remote-uid multi-method method user host))))))
;; Other file name ops.
(tramp-shell-quote-argument localname)
(or id-format 'integer)))
(tramp-wait-for-output)
- (let* ((root (cons nil (read (current-buffer))))
+ (let* ((root (cons nil (let ((object (read (current-buffer))))
+ (when (stringp object)
+ (error object))
+ object)))
(cell root))
(while (cdr cell)
(if (and match (not (string-match match (caadr cell))))
(unless ok-if-already-exists
(when (file-exists-p newname)
(signal 'file-already-exists
- (list newname))))
+ (list "File already exists" newname))))
(let ((t1 (tramp-tramp-file-p filename))
(t2 (tramp-tramp-file-p newname))
v1-multi-method v1-method v1-user v1-host v1-localname
;; copy-program can be invoked.
(if (and (not v1-multi-method)
(not v2-multi-method)
- (or (tramp-method-out-of-band-p
- v1-multi-method v1-method v1-user v1-host)
- (tramp-method-out-of-band-p
- v2-multi-method v2-method v2-user v2-host)))
+ (or (and t1 (tramp-method-out-of-band-p
+ v1-multi-method v1-method v1-user v1-host))
+ (and t2 (tramp-method-out-of-band-p
+ v2-multi-method v2-method v2-user v2-host))))
(tramp-do-copy-or-rename-file-out-of-band
op filename newname keep-date)
;; Use the generic method via a Tramp buffer.
tramp-current-method method
tramp-current-user user
tramp-current-host host)
- (tramp-message
- 5 "Transferring %s to file %s..." filename newname)
+ (message "Transferring %s to %s..." filename newname)
;; Use rcp-like program for file transfer.
(let ((p (apply 'start-process (buffer-name trampbuf) trampbuf
(tramp-process-actions p multi-method method user host
tramp-actions-copy-out-of-band))
(kill-buffer trampbuf)
- (tramp-message
- 5 "Transferring %s to file %s...done" filename newname)
+ (message "Transferring %s to %s...done" filename newname)
;; Set the mode.
(unless keep-date
(filename switches &optional wildcard full-directory-p)
"Like `insert-directory' for tramp files."
(if (and (boundp 'ls-lisp-use-insert-directory-program)
- (not ls-lisp-use-insert-directory-program))
+ (not (symbol-value 'ls-lisp-use-insert-directory-program)))
(tramp-run-real-handler 'insert-directory
(list filename switches wildcard full-directory-p))
;; For the moment, we assume that the remote "ls" program does not
(when (string-match "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname)
(let ((uname (match-string 1 localname))
(fname (match-string 2 localname)))
+ ;; We cannot simply apply "~/", because under sudo "~/" is
+ ;; expanded to the local user home directory but to the
+ ;; root home directory. On the other hand, using always
+ ;; the default user name for tilde expansion is not
+ ;; appropriate either, because ssh and companions might
+ ;; use a user name from the config file.
+ (when (and (string-equal uname "~")
+ (string-match
+ "\\`su\\(do\\)?\\'"
+ (tramp-find-method multi-method method user host)))
+ (setq uname (concat uname (or user "root"))))
;; CCC fanatic error checking?
(set-buffer (tramp-get-buffer multi-method method user host))
(erase-buffer)
(setq uname (buffer-substring (point) (tramp-line-end-position)))
(setq localname (concat uname fname))
(erase-buffer)))
+ ;; There might be a double slash, for example when "~/"
+ ;; expands to "/". Remove this.
+ (while (string-match "//" localname)
+ (setq localname (replace-match "/" t t localname)))
;; No tilde characters in file name, do normal
;; expand-file-name (this does "/./" and "/../"). We bind
- ;; directory-sep-char here for XEmacs on Windows, which
- ;; would otherwise use backslash.
+ ;; directory-sep-char here for XEmacs on Windows, which would
+ ;; otherwise use backslash. `default-directory' is bound to
+ ;; "/", because on Windows there would be problems with UNC
+ ;; shares or Cygwin mounts.
(tramp-let-maybe directory-sep-char ?/
- (tramp-make-tramp-file-name
- multi-method (or method (tramp-find-default-method user host))
- user host
- (tramp-drop-volume-letter
- (tramp-run-real-handler 'expand-file-name
- (list localname)))))))))
+ (let ((default-directory "/"))
+ (tramp-make-tramp-file-name
+ multi-method (or method (tramp-find-default-method user host))
+ user host
+ (tramp-drop-volume-letter
+ (tramp-run-real-handler 'expand-file-name
+ (list localname))))))))))
;; old version follows. it uses ".." to cross file handler
;; boundaries.
;; Remote commands.
(defvar tramp-async-proc nil
- "Global variable keeping asyncronous process object.
+ "Global variable keeping asynchronous process object.
Used in `tramp-handle-shell-command'")
+(defvar tramp-display-shell-command-buffer t
+ "Whether to display output buffer of `shell-command'.
+This is necessary for handling DISPLAY of `process-file'.")
+
(defun tramp-handle-shell-command (command &optional output-buffer error-buffer)
"Like `shell-command' for tramp files.
This will break if COMMAND prints a newline, followed by the value of
;; for `find-grep-dired' and `find-name-dired' in Emacs 22.
(if (tramp-tramp-file-p default-directory)
(with-parsed-tramp-file-name default-directory nil
- (let ((asynchronous (string-match "[ \t]*&[ \t]*\\'" command))
+ (let ((curbuf (current-buffer))
+ (asynchronous (string-match "[ \t]*&[ \t]*\\'" command))
status)
(unless output-buffer
(setq output-buffer
(skip-chars-forward "^ ")
(setq status (read (current-buffer)))))
(unless (zerop (buffer-size))
- (display-buffer output-buffer))
+ (when tramp-display-shell-command-buffer
+ (display-buffer output-buffer)))
+ (set-buffer curbuf)
status))
;; The following is only executed if something strange was
;; happening. Emit a helpful message and do it anyway.
(when (and (numberp buffer) (zerop buffer))
(error "Implementation does not handle immediate return"))
(when (consp buffer) (error "Implementation does not handle error files"))
- (shell-command
- (mapconcat 'tramp-shell-quote-argument
- (cons program args)
- " ")
- buffer))
+ (let ((tramp-display-shell-command-buffer display))
+ (shell-command
+ (mapconcat 'tramp-shell-quote-argument (cons program args) " ")
+ buffer)))
;; File Editing.
(let ((tmpbuf (get-buffer-create " *tramp tmp*")))
(set-buffer tmpbuf)
(erase-buffer)
- (insert-buffer tramp-buf)
+ (insert-buffer-substring tramp-buf)
(tramp-message-for-buffer
multi-method method user host
6 "Decoding remote file %s with function %s..."
'insert-file-contents)
'file-local-copy)))
(file-local-copy filename)))
- (coding-system-used nil)
- (result nil))
+ coding-system-used result)
(when visit
(setq buffer-file-name filename)
(set-visited-file-modtime)
(setq result (insert-file-contents local-copy nil beg end replace))
;; Now `last-coding-system-used' has right value. Remember it.
(when (boundp 'last-coding-system-used)
- (setq coding-system-used last-coding-system-used))
+ (setq coding-system-used (symbol-value 'last-coding-system-used)))
(tramp-message-for-buffer
multi-method method user host
9 "Inserting local temp file `%s'...done" local-copy)
(delete-file local-copy)
(when (boundp 'last-coding-system-used)
- (setq last-coding-system-used coding-system-used))
+ (set 'last-coding-system-used coding-system-used))
(list (expand-file-name filename)
(second result))))))
(tramp-run-real-handler 'find-backup-file-name (list filename)))))
+(defun tramp-handle-make-auto-save-file-name ()
+ "Like `make-auto-save-file-name' for tramp files.
+Returns a file name in `tramp-auto-save-directory' for autosaving this file."
+ (let ((tramp-auto-save-directory tramp-auto-save-directory))
+ ;; File name must be unique. This is ensured with Emacs 22 (see
+ ;; UNIQUIFY element of `auto-save-file-name-transforms'); but for
+ ;; all other cases we must do it ourselves.
+ (when (boundp 'auto-save-file-name-transforms)
+ (mapcar
+ '(lambda (x)
+ (when (and (string-match (car x) buffer-file-name)
+ (not (car (cddr x))))
+ (setq tramp-auto-save-directory
+ (or tramp-auto-save-directory temporary-file-directory))))
+ (symbol-value 'auto-save-file-name-transforms)))
+ ;; Create directory.
+ (when tramp-auto-save-directory
+ (unless (file-exists-p tramp-auto-save-directory)
+ (make-directory tramp-auto-save-directory t)))
+ ;; jka-compr doesn't like auto-saving, so by appending "~" to the
+ ;; file name we make sure that jka-compr isn't used for the
+ ;; auto-save file.
+ (let ((buffer-file-name
+ (if tramp-auto-save-directory
+ (expand-file-name
+ (tramp-subst-strs-in-string
+ '(("_" . "|")
+ ("/" . "_a")
+ (":" . "_b")
+ ("|" . "__")
+ ("[" . "_l")
+ ("]" . "_r"))
+ (buffer-file-name))
+ tramp-auto-save-directory)
+ (buffer-file-name))))
+ ;; Run plain `make-auto-save-file-name'. There might be an advice when
+ ;; it is not a magic file name operation (since Emacs 22).
+ ;; We must deactivate it temporarily.
+ (if (not (ad-is-active 'make-auto-save-file-name))
+ (tramp-run-real-handler
+ 'make-auto-save-file-name nil)
+ ;; else
+ (ad-deactivate 'make-auto-save-file-name)
+ (prog1
+ (tramp-run-real-handler
+ 'make-auto-save-file-name nil)
+ (ad-activate 'make-auto-save-file-name))))))
+
;; CCC grok APPEND, LOCKNAME, CONFIRM
(defun tramp-handle-write-region
;; (string= lockname filename))
;; (error
;; "tramp-handle-write-region: LOCKNAME must be nil or equal FILENAME"))
- ;; XEmacs takes a coding system as the sevent argument, not `confirm'
+ ;; 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? "
(if confirm ; don't pass this arg unless defined for backward compat.
(list start end tmpfil append 'no-message lockname confirm)
(list start end tmpfil append 'no-message lockname)))
+ ;; Now, `last-coding-system-used' has the right value. Remember it.
+ (when (boundp 'last-coding-system-used)
+ (setq coding-system-used (symbol-value 'last-coding-system-used)))
;; The permissions of the temporary file should be set. If
;; filename does not exist (eq modes nil) it has been renamed to
;; the backup file. This case `save-buffer' handles
;; permissions.
(when modes (set-file-modes tmpfil modes))
- ;; Now, `last-coding-system-used' has the right value. Remember it.
- (when (boundp 'last-coding-system-used)
- (setq coding-system-used last-coding-system-used))
;; This is a bit lengthy due to the different methods possible for
;; file transfer. First, we check whether the method uses an rcp
;; program. If so, we call it. Otherwise, both encoding and
(nth 5 (file-attributes filename))))
;; Make `last-coding-system-used' have the right value.
(when (boundp 'last-coding-system-used)
- (setq last-coding-system-used coding-system-used))
+ (set 'last-coding-system-used coding-system-used))
(when (or (eq visit t)
(eq visit nil)
(stringp visit))
;; (inhibit-file-name-operation operation))
;; (apply operation args)))
-(defun tramp-run-real-handler (operation args)
+;;;###autoload
+(progn (defun tramp-run-real-handler (operation args)
"Invoke normal file name handler for OPERATION.
First arg specifies the OPERATION, second arg is a list of arguments to
pass to the OPERATION."
,(and (eq inhibit-file-name-operation operation)
inhibit-file-name-handlers)))
(inhibit-file-name-operation operation))
- (apply operation args)))
+ (apply operation args))))
;; This function is used from `tramp-completion-file-name-handler' functions
;; only, if `tramp-completion-mode' is true. But this cannot be checked here
;; because the check is based on a full filename, not available for all
;; basic I/O operations.
-(defun tramp-completion-run-real-handler (operation args)
+;;;###autoload
+(progn (defun tramp-completion-run-real-handler (operation args)
"Invoke `tramp-file-name-handler' for OPERATION.
First arg specifies the OPERATION, second arg is a list of arguments to
pass to the OPERATION."
,(and (eq inhibit-file-name-operation operation)
inhibit-file-name-handlers)))
(inhibit-file-name-operation operation))
- (apply operation args)))
+ (apply operation args))))
;; We handle here all file primitives. Most of them have the file
;; name as first parameter; nevertheless we check for them explicitly
(nth 2 args))
; BUF
((member operation
- (list 'set-visited-file-modtime 'verify-visited-file-modtime
- ; XEmacs only
+ (list 'make-auto-save-file-name
+ 'set-visited-file-modtime 'verify-visited-file-modtime
+ ; XEmacs only
'backup-buffer))
(buffer-file-name
(if (bufferp (nth 0 args)) (nth 0 args) (current-buffer))))
(defun tramp-file-name-handler (operation &rest args)
"Invoke Tramp file name handler.
Falls back to normal file name handler if no tramp file name handler exists."
+;; (setq edebug-trace t)
+;; (edebug-trace "%s" (with-output-to-string (backtrace)))
(save-match-data
(let* ((filename (apply 'tramp-file-name-for-operation operation args))
+ (completion (tramp-completion-mode filename))
(foreign (tramp-find-foreign-file-name-handler filename)))
- (cond
- (foreign (apply foreign operation args))
- (t (tramp-run-real-handler operation args))))))
+ (with-parsed-tramp-file-name filename nil
+ (cond
+ ;; When we are in completion mode, some operations shouldn' be
+ ;; handled by backend.
+ ((and completion (memq operation '(expand-file-name)))
+ (tramp-run-real-handler operation args))
+ ((and completion (zerop (length localname))
+ (memq operation '(file-exists-p file-directory-p)))
+ t)
+ ;; Call the backend function.
+ (foreign (apply foreign operation args))
+ ;; Nothing to do for us.
+ (t (tramp-run-real-handler operation args)))))))
;; In Emacs, there is some concurrency due to timers. If a timer
(setq tramp-locked tl))))
;;;###autoload
-(defun tramp-completion-file-name-handler (operation &rest args)
+(progn (defun tramp-completion-file-name-handler (operation &rest args)
"Invoke tramp file name completion handler.
Falls back to normal file name handler if no tramp file name handler exists."
-;; (setq tramp-debug-buffer t)
-;; (tramp-message 1 "%s %s" operation args)
-;; (tramp-message 1 "%s %s\n%s"
-;; operation args (with-output-to-string (backtrace)))
+;; (setq edebug-trace t)
+;; (edebug-trace "%s" (with-output-to-string (backtrace)))
(let ((fn (assoc operation tramp-completion-file-name-handler-alist)))
(if fn
(save-match-data (apply (cdr fn) args))
- (tramp-completion-run-real-handler operation args))))
-
-;;;###autoload
-(put 'tramp-completion-file-name-handler 'safe-magic t)
+ (tramp-completion-run-real-handler operation args)))))
-;; Register in file name handler alist
;;;###autoload
-(add-to-list 'file-name-handler-alist
- (cons tramp-file-name-regexp 'tramp-file-name-handler))
-(add-to-list 'file-name-handler-alist
- (cons tramp-completion-file-name-regexp
- 'tramp-completion-file-name-handler))
-
-(defun tramp-repair-jka-compr ()
- "If jka-compr is already loaded, move it to the front of
-`file-name-handler-alist'. On Emacs 22 or so this will not be
-necessary anymore."
+(defsubst tramp-register-file-name-handlers ()
+ "Add tramp file name handlers to `file-name-handler-alist'."
+ (add-to-list 'file-name-handler-alist
+ (cons tramp-file-name-regexp 'tramp-file-name-handler))
+ ;; `partial-completion-mode' is unknown in XEmacs. So we should
+ ;; load it unconditionally there. In the GNU Emacs case, method/
+ ;; user/host name completion shall be bound to `partial-completion-mode'.
+ (when (or (not (boundp 'partial-completion-mode))
+ (symbol-value 'partial-completion-mode)
+ (featurep 'ido))
+ (add-to-list 'file-name-handler-alist
+ (cons tramp-completion-file-name-regexp
+ 'tramp-completion-file-name-handler))
+ (put 'tramp-completion-file-name-handler 'safe-magic t))
+ ;; If jka-compr is already loaded, move it to the front of
+ ;; `file-name-handler-alist'.
(let ((jka (rassoc 'jka-compr-handler file-name-handler-alist)))
(when jka
(setq file-name-handler-alist
(cons jka (delete jka file-name-handler-alist))))))
-(tramp-repair-jka-compr)
+
+;; During autoload, it shall be checked whether
+;; `partial-completion-mode' is active. Therefore registering will be
+;; delayed.
+;;;###autoload(add-hook
+;;;###autoload 'after-init-hook
+;;;###autoload '(lambda () (tramp-register-file-name-handlers)))
+(tramp-register-file-name-handlers)
+
+;;;###autoload
+(defun tramp-unload-file-name-handlers ()
+ (setq file-name-handler-alist
+ (delete (rassoc 'tramp-file-name-handler
+ file-name-handler-alist)
+ (delete (rassoc 'tramp-completion-file-name-handler
+ file-name-handler-alist)
+ file-name-handler-alist))))
+
+(add-hook 'tramp-unload-hook 'tramp-unload-file-name-handlers)
;;; Interactions with other packages:
(read (current-buffer))))))
(list (expand-file-name name))))))
-;; Check for complete.el and override PC-expand-many-files if appropriate.
-(eval-and-compile
- (defun tramp-save-PC-expand-many-files (name))); avoid compiler warning
-
-(defun tramp-setup-complete ()
- (fset 'tramp-save-PC-expand-many-files
- (symbol-function 'PC-expand-many-files))
- (defun PC-expand-many-files (name)
- (if (tramp-tramp-file-p name)
- (expand-many-files name)
- (tramp-save-PC-expand-many-files name))))
-
-;; Why isn't eval-after-load sufficient?
-(if (fboundp 'PC-expand-many-files)
- (tramp-setup-complete)
- (eval-after-load "complete" '(tramp-setup-complete)))
+(eval-after-load "complete"
+ '(progn
+ (defadvice PC-expand-many-files
+ (around tramp-advice-PC-expand-many-files (name) activate)
+ "Invoke `tramp-handle-expand-many-files' for tramp files."
+ (if (tramp-tramp-file-p name)
+ (setq ad-return-value (tramp-handle-expand-many-files name))
+ ad-do-it))
+ (add-hook 'tramp-unload-hook
+ '(lambda () (ad-unadvise 'PC-expand-many-files)))))
;;; File name handler functions for completion mode
+(defvar tramp-completion-mode nil
+ "If non-nil, we are in file name completion mode.")
+
;; Necessary because `tramp-file-name-regexp-unified' and
;; `tramp-completion-file-name-regexp-unified' aren't different.
;; If nil, `tramp-completion-run-real-handler' is called (i.e. forwarding to
(defun tramp-completion-mode (file)
"Checks whether method / user name / host name completion is active."
(cond
+ (tramp-completion-mode t)
((not tramp-unified-filenames) t)
((string-match "^/.*:.*:$" file) nil)
((string-match
file)
(member (match-string 1 file) (mapcar 'car tramp-methods)))
((or (equal last-input-event 'tab)
- ;; Emacs
- (and (integerp last-input-event)
- (not (event-modifiers last-input-event))
- (or (char-equal last-input-event ?\?)
- (char-equal last-input-event ?\t) ; handled by 'tab already?
- (char-equal last-input-event ?\ )))
+ ;; Emacs
+ (and (integerp last-input-event)
+ (or
+ ;; ?\t has event-modifier 'control
+ (char-equal last-input-event ?\t)
+ (and (not (event-modifiers last-input-event))
+ (or (char-equal last-input-event ?\?)
+ (char-equal last-input-event ?\ )))))
;; XEmacs
(and (featurep 'xemacs)
- (not (event-modifiers last-input-event))
- (or (char-equal
- (funcall (symbol-function 'event-to-character)
- last-input-event) ?\?)
- (char-equal
- (funcall (symbol-function 'event-to-character)
- last-input-event) ?\t)
- (char-equal
- (funcall (symbol-function 'event-to-character)
- last-input-event) ?\ ))))
+ (or
+ ;; ?\t has event-modifier 'control
+ (char-equal
+ (funcall (symbol-function 'event-to-character)
+ last-input-event) ?\t)
+ (and (not (event-modifiers last-input-event))
+ (or (char-equal
+ (funcall (symbol-function 'event-to-character)
+ last-input-event) ?\?)
+ (char-equal
+ (funcall (symbol-function 'event-to-character)
+ last-input-event) ?\ ))))))
t)))
-(defun tramp-completion-handle-file-exists-p (filename)
- "Like `file-exists-p' for tramp files."
- (if (tramp-completion-mode filename)
- (tramp-run-real-handler
- 'file-exists-p (list filename))
- (tramp-completion-run-real-handler
- 'file-exists-p (list filename))))
-
-;; Localname manipulation in case of partial TRAMP file names.
-(defun tramp-completion-handle-file-name-directory (file)
- "Like `file-name-directory' but aware of TRAMP files."
- (if (tramp-completion-mode file)
- "/"
- (tramp-completion-run-real-handler
- 'file-name-directory (list file))))
-
-;; Localname manipulation in case of partial TRAMP file names.
-(defun tramp-completion-handle-file-name-nondirectory (file)
- "Like `file-name-nondirectory' but aware of TRAMP files."
- (substring
- file (length (tramp-completion-handle-file-name-directory file))))
-
;; Method, host name and user name completion.
;; `tramp-completion-dissect-file-name' returns a list of
;; tramp-file-name structures. For all of them we return possible completions.
+;;;###autoload
(defun tramp-completion-handle-file-name-all-completions (filename directory)
"Like `file-name-all-completions' for partial tramp files."
- (let*
- ((fullname (concat directory filename))
- ;; local files
- (result
- (if (tramp-completion-mode fullname)
- (tramp-run-real-handler
- 'file-name-all-completions (list filename directory))
- (tramp-completion-run-real-handler
- 'file-name-all-completions (list filename directory))))
- ;; possible completion structures
- (v (tramp-completion-dissect-file-name fullname)))
-
- (while v
- (let* ((car (car v))
- (multi-method (tramp-file-name-multi-method car))
- (method (tramp-file-name-method car))
- (user (tramp-file-name-user car))
- (host (tramp-file-name-host car))
- (localname (tramp-file-name-localname car))
- (m (tramp-find-method multi-method method user host))
- (tramp-current-user user) ; see `tramp-parse-passwd'
- all-user-hosts)
-
- (unless (or multi-method ;; Not handled (yet).
- localname) ;; Nothing to complete
-
- (if (or user host)
-
- ;; Method dependent user / host combinations
- (progn
- (mapcar
- (lambda (x)
- (setq all-user-hosts
- (append all-user-hosts
- (funcall (nth 0 x) (nth 1 x)))))
- (tramp-get-completion-function m))
-
- (setq result (append result
- (mapcar
- (lambda (x)
- (tramp-get-completion-user-host
- method user host (nth 0 x) (nth 1 x)))
- (delq nil all-user-hosts)))))
-
- ;; Possible methods
- (setq result
- (append result (tramp-get-completion-methods m)))))
-
- (setq v (delq car v))))
-
- ;;; unify list, remove nil elements
- (let (result1)
- (while result
- (let ((car (car result)))
- (when car (add-to-list 'result1 car))
- (setq result (delq car result))))
-
- result1)))
+ (unwind-protect
+ ;; We need to reset `tramp-completion-mode'.
+ (progn
+ (setq tramp-completion-mode t)
+ (let*
+ ((fullname (concat directory filename))
+ ;; possible completion structures
+ (v (tramp-completion-dissect-file-name fullname))
+ result result1)
+
+ (while v
+ (let* ((car (car v))
+ (multi-method (tramp-file-name-multi-method car))
+ (method (tramp-file-name-method car))
+ (user (tramp-file-name-user car))
+ (host (tramp-file-name-host car))
+ (localname (tramp-file-name-localname car))
+ (m (tramp-find-method multi-method method user host))
+ (tramp-current-user user) ; see `tramp-parse-passwd'
+ all-user-hosts)
+
+ (unless (or multi-method ;; Not handled (yet).
+ localname) ;; Nothing to complete
+
+ (if (or user host)
+
+ ;; Method dependent user / host combinations
+ (progn
+ (mapcar
+ (lambda (x)
+ (setq all-user-hosts
+ (append all-user-hosts
+ (funcall (nth 0 x) (nth 1 x)))))
+ (tramp-get-completion-function m))
+
+ (setq result (append result
+ (mapcar
+ (lambda (x)
+ (tramp-get-completion-user-host
+ method user host (nth 0 x) (nth 1 x)))
+ (delq nil all-user-hosts)))))
+
+ ;; Possible methods
+ (setq result
+ (append result (tramp-get-completion-methods m)))))
+
+ (setq v (cdr v))))
+
+ ;; unify list, remove nil elements
+ (while result
+ (let ((car (car result)))
+ (when car (add-to-list
+ 'result1 (substring car (length directory))))
+ (setq result (cdr result))))
+
+ ;; Complete local parts
+ (append
+ result1
+ (condition-case nil
+ (if result1
+ ;; "/ssh:" does not need to be expanded as hostname.
+ (tramp-run-real-handler
+ 'file-name-all-completions (list filename directory))
+ ;; No method/user/host found to be expanded.
+ (tramp-completion-run-real-handler
+ 'file-name-all-completions (list filename directory)))
+ (error nil)))))
+ ;; unwindform
+ (setq tramp-completion-mode nil)))
;; Method, host name and user name completion for a file.
+;;;###autoload
(defun tramp-completion-handle-file-name-completion (filename directory)
"Like `file-name-completion' for tramp files."
(try-completion filename
(lambda (method)
(and method
(string-match (concat "^" (regexp-quote partial-method)) method)
- ;; we must remove leading "/".
- (substring (tramp-make-tramp-file-name nil method nil nil nil) 1)))
+ (tramp-make-tramp-file-name nil method nil nil nil)))
(delete "multi" (mapcar 'car tramp-methods))))
;; Compares partial user and host names with possible completions.
host nil)))
(unless (zerop (+ (length user) (length host)))
- ;; we must remove leading "/".
- (substring (tramp-make-tramp-file-name nil method user host nil) 1)))
+ (tramp-make-tramp-file-name nil method user host nil)))
(defun tramp-parse-rhosts (filename)
"Return a list of (user host) tuples allowed to access.
(forward-line 1)
result))
-(defun tramp-completion-handle-expand-file-name (name &optional dir)
- "Like `expand-file-name' for tramp files."
- (let ((fullname (concat (or dir default-directory) name)))
- (tramp-drop-volume-letter
- (if (tramp-completion-mode fullname)
- (tramp-run-real-handler
- 'expand-file-name (list name dir))
- (tramp-completion-run-real-handler
- 'expand-file-name (list name dir))))))
-
;;; Internal Functions:
(defun tramp-maybe-send-perl-script (multi-method method user host script name)
auto-save-default)
(auto-save-mode 1)))
(add-hook 'find-file-hooks 'tramp-set-auto-save t)
+(add-hook 'tramp-unload-hook
+ '(lambda ()
+ (remove-hook 'find-file-hooks 'tramp-set-auto-save)))
(defun tramp-run-test (switch filename)
"Run `test' on the remote system, given a SWITCH and a FILENAME.
(defun tramp-touch (file time)
"Set the last-modified timestamp of the given file.
TIME is an Emacs internal time value as returned by `current-time'."
- (let ((touch-time (format-time-string "%Y%m%d%H%M.%S" time)))
+ (let ((touch-time (format-time-string "%Y%m%d%H%M.%S" time t)))
(if (tramp-tramp-file-p file)
(with-parsed-tramp-file-name file nil
(let ((buf (tramp-get-buffer multi-method method user host)))
(unless (zerop (tramp-send-command-and-check
multi-method method user host
- (format "touch -t %s %s"
+ (format "TZ=UTC; export TZ; touch -t %s %s"
touch-time
- localname)))
+ (tramp-shell-quote-argument localname))
+ t))
(pop-to-buffer buf)
(error "tramp-touch: touch failed, see buffer `%s' for details"
buf))))
(and (setq tramp-file-exists-command "ls -d %s")
(file-exists-p existing)
(not (file-exists-p nonexisting))))
- (error "Couldn't find command to check if file exists."))))
+ (error "Couldn't find command to check if file exists"))))
;; CCC test ksh or bash found for tilde expansion?
(tramp-send-command
multi-method method user host
(concat "PS1='$ ' exec " shell)) ;
- (unless (tramp-wait-for-regexp
- (get-buffer-process (current-buffer))
- 60 (format "\\(\\(%s\\)\\|\\(%s\\)\\)\\'"
- tramp-shell-prompt-pattern shell-prompt-pattern))
- (pop-to-buffer (buffer-name))
- (error "Couldn't find remote `%s' prompt." shell))
+ (tramp-barf-if-no-shell-prompt
+ (get-buffer-process (current-buffer))
+ 60 "Couldn't find remote `%s' prompt" shell)
(tramp-message
9 "Setting remote shell prompt...")
;; Douglas Gray Stephens <DGrayStephens@slb.com> says that we
(defun tramp-action-password (p multi-method method user host)
"Query the user for a password."
- (let ((pw-prompt (match-string 0)))
+ (let ((pw-prompt
+ (format "Password for %s "
+ (tramp-make-tramp-file-name
+ nil method user host ""))))
(tramp-message 9 "Sending password")
(tramp-enter-password p pw-prompt user host)))
(tramp-message 10 "'set mode' error ignored.")
(tramp-message 9 "Process has finished.")
(throw 'tramp-action 'ok))
+ (goto-char (point-min))
+ (when (re-search-forward "^.cp.?: \\(.+: Permission denied.?\\)$" nil t)
+ (error "Remote host: %s" (match-string 1)))
(tramp-message 9 "Process has died.")
(throw 'tramp-action 'process-died)))
(t nil)))
(defun tramp-multi-action-password (p method user host)
"Query the user for a password."
- (tramp-message 9 "Sending password")
- (tramp-enter-password p (match-string 0) user host))
+ (let ((pw-prompt
+ (format "Password for %s "
+ (tramp-make-tramp-file-name
+ nil method user host ""))))
+ (tramp-message 9 "Sending password")
+ (tramp-enter-password p pw-prompt user host)))
(defun tramp-multi-action-succeed (p method user host)
"Signal success in finding shell prompt."
(tramp-message 9 "Waiting 60s for prompt from remote shell")
(with-timeout (60 (throw 'tramp-action 'timeout))
(while (not found)
- (accept-process-output p 1)
+ (tramp-accept-process-output p 1)
(goto-char (point-min))
(setq todo actions)
(while todo
(tramp-message 9 "Waiting 60s for prompt from remote shell")
(with-timeout (60 (throw 'tramp-action 'timeout))
(while (not found)
- (accept-process-output p 1)
+ (tramp-accept-process-output p 1)
(setq todo actions)
(goto-char (point-min))
(while todo
(or user (user-login-name)) host method)
(let ((process-environment (copy-sequence process-environment)))
(setenv "TERM" tramp-terminal-type)
+ (setenv "PS1" "$ ")
(let* ((default-directory (tramp-temporary-file-directory))
;; If we omit the conditional here, then we would use
;; `undecided-dos' in some cases. With the conditional,
(setq login-args (cons "-p" (cons (match-string 2 host) login-args)))
(setq real-host (match-string 1 host)))
(setenv "TERM" tramp-terminal-type)
+ (setenv "PS1" "$ ")
(let* ((default-directory (tramp-temporary-file-directory))
;; If we omit the conditional, we would use
;; `undecided-dos' in some cases. With the conditional,
(or user "<root>") method)
(let ((process-environment (copy-sequence process-environment)))
(setenv "TERM" tramp-terminal-type)
+ (setenv "PS1" "$ ")
(let* ((default-directory (tramp-temporary-file-directory))
;; If we omit the conditional, we use `undecided-dos' in
;; some cases. With the conditional, we use nil in these
(tramp-message 7 "Opening `%s' connection..." multi-method)
(let ((process-environment (copy-sequence process-environment)))
(setenv "TERM" tramp-terminal-type)
+ (setenv "PS1" "$ ")
(let* ((default-directory (tramp-temporary-file-directory))
;; If we omit the conditional, we use `undecided-dos' in
;; some cases. With the conditional, we use nil in these
;; Utility functions.
+(defun tramp-accept-process-output
+ (&optional process timeout timeout-msecs)
+ "Like `accept-process-output' for Tramp processes.
+This is needed in order to hide `last-coding-system-used', which is set
+for process communication also."
+ (let (last-coding-system-used)
+ (accept-process-output process timeout timeout-msecs)))
+
(defun tramp-wait-for-regexp (proc timeout regexp)
"Wait for a REGEXP to appear from process PROC within TIMEOUT seconds.
Expects the output of PROC to be sent to the current buffer. Returns
timeout))
(with-timeout (timeout)
(while (not found)
- (accept-process-output proc 1)
+ (tramp-accept-process-output proc 1)
(unless (memq (process-status proc) '(run open))
(error "Process has died"))
(goto-char (point-min))
- (setq found (when (re-search-forward regexp nil t)
- (tramp-match-string-list)))))))
+ (setq found (re-search-forward regexp nil t))))))
(t
(while (not found)
- (accept-process-output proc 1)
+ (tramp-accept-process-output proc 1)
(unless (memq (process-status proc) '(run open))
(error "Process has died"))
(goto-char (point-min))
- (setq found (when (re-search-forward regexp nil t)
- (tramp-match-string-list))))))
+ (setq found (re-search-forward regexp nil t)))))
(when tramp-debug-buffer
(append-to-buffer
(tramp-get-debug-buffer tramp-current-multi-method tramp-current-method
"ln" tramp-remote-path nil)))
(when ln
(tramp-set-connection-property "ln" ln multi-method method user host)))
+ ;; Set uid and gid.
(erase-buffer)
+ (tramp-send-command multi-method method user host "id -u; id -g")
+ (tramp-wait-for-output)
+ (goto-char (point-min))
+ (tramp-set-connection-property
+ "uid" (read (current-buffer)) multi-method method user host)
+ (tramp-set-connection-property
+ "gid" (read (current-buffer)) multi-method method user host)
;; Find the right encoding/decoding commands to use.
+ (erase-buffer)
(unless (tramp-method-out-of-band-p multi-method method user host)
(tramp-find-inline-encoding multi-method method user host))
;; If encoding/decoding command are given, test to see if they work.
p (processp p) (memq (process-status p) '(run open)))
(tramp-send-command
multi-method method user host "echo are you awake" nil t)
- (unless (tramp-wait-for-output 10)
+ (unless (and (memq (process-status p) '(run open))
+ (tramp-wait-for-output 10))
(delete-process p)
(setq p nil))
(erase-buffer)))
timeout))
(with-timeout (timeout)
(while (not found)
- (accept-process-output proc 1)
+ (tramp-accept-process-output proc 1)
(unless (memq (process-status proc) '(run open))
(error "Process has died"))
(goto-char (point-max))
(setq found (looking-at end-of-output))))))
(t
(while (not found)
- (accept-process-output proc 1)
+ (tramp-accept-process-output proc 1)
(unless (memq (process-status proc) '(run open))
(error "Process has died"))
(goto-char (point-max))
;; Return value is whether end-of-output sentinel was found.
found))
-(defun tramp-match-string-list (&optional string)
- "Returns list of all match strings.
-That is, (list (match-string 0) (match-string 1) ...), according to the
-number of matches."
- (let* ((nmatches (/ (length (match-data)) 2))
- (i (- nmatches 1))
- (res nil))
- (while (>= i 0)
- (setq res (cons (match-string i string) res))
- (setq i (- i 1)))
- res))
-
(defun tramp-send-command-and-check (multi-method method user host command
&optional subshell)
"Run COMMAND and check its exit status.
If `tramp-discard-garbage' is nil, just erase buffer."
(if (not tramp-discard-garbage)
(erase-buffer)
- (while (prog1 (erase-buffer) (accept-process-output p 0.25))
+ (while (prog1 (erase-buffer) (tramp-accept-process-output p 0.25))
(when tramp-debug-buffer
(save-excursion
(set-buffer (tramp-get-debug-buffer multi-method method user host))
"Convert file-attributes ATTR generated by perl script or ls.
Convert file mode bits to string and set virtual device number.
Return ATTR."
+ ;; Convert file mode bits to string.
(unless (stringp (nth 8 attr))
- ;; Convert file mode bits to string.
(setcar (nthcdr 8 attr) (tramp-file-mode-from-int (nth 8 attr))))
+ ;; Set file's gid change bit. Possible only when id-format is 'integer.
+ (when (numberp (nth 3 attr))
+ (setcar (nthcdr 9 attr)
+ (not (eql (nth 3 attr)
+ (tramp-get-remote-gid multi-method method user host)))))
;; Set virtual device number.
(setcar (nthcdr 11 attr)
(tramp-get-device multi-method method user host))
(defun tramp-get-remote-ln (multi-method method user host)
(tramp-get-connection-property "ln" nil multi-method method user host))
+(defun tramp-get-remote-uid (multi-method method user host)
+ (tramp-get-connection-property "uid" nil multi-method method user host))
+
+(defun tramp-get-remote-gid (multi-method method user host)
+ (tramp-get-connection-property "gid" nil multi-method method user host))
+
;; Get a property of a TRAMP connection.
(defun tramp-get-connection-property
(property default multi-method method user host)
(let (error)
(condition-case nil
(symbol-value (intern (concat "tramp-connection-property-" property)))
- (error default)))))
+ (error default)))))
;; Set a property of a TRAMP connection.
(defun tramp-set-connection-property
;; Auto saving to a special directory.
-(defun tramp-make-auto-save-file-name (fn)
- "Returns a file name in `tramp-auto-save-directory' for autosaving this file."
- (when tramp-auto-save-directory
- (unless (file-exists-p tramp-auto-save-directory)
- (make-directory tramp-auto-save-directory t)))
- ;; jka-compr doesn't like auto-saving, so by appending "~" to the
- ;; file name we make sure that jka-compr isn't used for the
- ;; auto-save file.
- (let ((buffer-file-name (expand-file-name
- (tramp-subst-strs-in-string '(("_" . "|")
- ("/" . "_a")
- (":" . "_b")
- ("|" . "__")
- ("[" . "_l")
- ("]" . "_r"))
- fn)
- tramp-auto-save-directory)))
- (make-auto-save-file-name)))
-
-(defadvice make-auto-save-file-name
- (around tramp-advice-make-auto-save-file-name () activate)
- "Invoke `tramp-make-auto-save-file-name' for tramp files."
- (if (and (buffer-file-name) (tramp-tramp-file-p (buffer-file-name))
- tramp-auto-save-directory)
- (setq ad-return-value
- (tramp-make-auto-save-file-name (buffer-file-name)))
- ad-do-it))
+(defun tramp-exists-file-name-handler (operation &rest args)
+ (let ((buffer-file-name "/")
+ (fnha file-name-handler-alist)
+ (check-file-name-operation operation)
+ (file-name-handler-alist
+ (list
+ (cons "/"
+ '(lambda (operation &rest args)
+ "Returns OPERATION if it is the one to be checked"
+ (if (equal check-file-name-operation operation)
+ operation
+ (let ((file-name-handler-alist fnha))
+ (apply operation args))))))))
+ (eq (apply operation args) operation)))
+
+(unless (tramp-exists-file-name-handler 'make-auto-save-file-name)
+ (defadvice make-auto-save-file-name
+ (around tramp-advice-make-auto-save-file-name () activate)
+ "Invoke `tramp-handle-make-auto-save-file-name' for tramp files."
+ (if (and (buffer-file-name) (tramp-tramp-file-p (buffer-file-name)))
+ (setq ad-return-value (tramp-handle-make-auto-save-file-name))
+ ad-do-it))
+ (add-hook 'tramp-unload-hook
+ '(lambda () (ad-unadvise 'make-auto-save-file-name))))
;; In Emacs < 22 and XEmacs < 21.5 autosaved remote files have
;; permission 0666 minus umask. This is a security threat.
;; auto-saved file belonging to another original file. This could
;; be a security threat.
(set-file-modes buffer-auto-save-file-name
- (or (file-modes bfn) ?\600)))))
+ (or (file-modes bfn) (tramp-octal-to-decimal "0600"))))))
(unless (or (> emacs-major-version 21)
(and (featurep 'xemacs)
(= emacs-major-version 21)
(> emacs-minor-version 4)))
- (add-hook 'auto-save-hook 'tramp-set-auto-save-file-modes))
+ (add-hook 'auto-save-hook 'tramp-set-auto-save-file-modes)
+ (add-hook 'tramp-unload-hook
+ '(lambda ()
+ (remove-hook 'auto-save-hook 'tramp-set-auto-save-file-modes))))
(defun tramp-subst-strs-in-string (alist string)
"Replace all occurrences of the string FROM with TO in STRING.
(defun tramp-time-diff (t1 t2)
"Return the difference between the two times, in seconds.
-T1 and T2 are time values (as returned by `current-time' for example).
-
-NOTE: This function will fail if the time difference is too large to
-fit in an integer."
+T1 and T2 are time values (as returned by `current-time' for example)."
;; Pacify byte-compiler with `symbol-function'.
(cond ((and (fboundp 'subtract-time)
(fboundp 'float-time))
(funcall (symbol-function 'time-to-seconds)
(funcall (symbol-function 'subtract-time) t1 t2)))
((fboundp 'itimer-time-difference)
- (floor (funcall
- (symbol-function 'itimer-time-difference)
- (if (< (length t1) 3) (append t1 '(0)) t1)
- (if (< (length t2) 3) (append t2 '(0)) t2))))
+ (funcall (symbol-function 'itimer-time-difference)
+ (if (< (length t1) 3) (append t1 '(0)) t1)
+ (if (< (length t2) 3) (append t2 '(0)) t2)))
(t
;; snarfed from Emacs 21 time-date.el; combining
;; time-to-seconds and subtract-time
"Specify if query is needed for process when Emacs is exited.
If the second argument flag is non-nil, Emacs will query the user before
exiting if process is running."
+ (funcall
(if (fboundp 'set-process-query-on-exit-flag)
- (set-process-query-on-exit-flag process flag)
- (funcall (symbol-function 'process-kill-without-query)
- process flag)))
+ (symbol-function 'set-process-query-on-exit-flag)
+ (symbol-function 'process-kill-without-query))
+ process flag))
;; ------------------------------------------------------------
;; CCC: This check is now also really awful; we should search all
;; of the filename format, not just the prefix.
(when (string-match "\\[" tramp-prefix-format)
-(defadvice file-expand-wildcards (around tramp-fix activate)
- (let ((name (ad-get-arg 0)))
- (if (tramp-tramp-file-p name)
- ;; If it's a Tramp file, dissect it and look if wildcards
- ;; need to be expanded at all.
- (let ((v (tramp-dissect-file-name name)))
- (if (string-match "[[*?]" (tramp-file-name-localname v))
- (let ((res ad-do-it))
- (setq ad-return-value (or res (list name))))
- (setq ad-return-value (list name))))
- ;; If it is not a Tramp file, just run the original function.
- (let ((res ad-do-it))
- (setq ad-return-value (or res (list name)))))))
-)
+ (defadvice file-expand-wildcards (around tramp-fix activate)
+ (let ((name (ad-get-arg 0)))
+ (if (tramp-tramp-file-p name)
+ ;; If it's a Tramp file, dissect it and look if wildcards
+ ;; need to be expanded at all.
+ (let ((v (tramp-dissect-file-name name)))
+ (if (string-match "[[*?]" (tramp-file-name-localname v))
+ (let ((res ad-do-it))
+ (setq ad-return-value (or res (list name))))
+ (setq ad-return-value (list name))))
+ ;; If it is not a Tramp file, just run the original function.
+ (let ((res ad-do-it))
+ (setq ad-return-value (or res (list name)))))))
+ (add-hook 'tramp-unload-hook
+ '(lambda () (ad-unadvise 'file-expand-wildcards))))
;; Tramp version is useful in a number of situations.
(interactive)
(require 'reporter)
(catch 'dont-send
- (let ((reporter-prompt-for-summary-p t))
+ (let ((reporter-prompt-for-summary-p t))
(reporter-submit-bug-report
tramp-bug-report-address ; to-address
(format "tramp (%s)" tramp-version) ; package name and version
- `(;; Current state
- tramp-ls-command
- tramp-test-groks-nt
- tramp-file-exists-command
- tramp-current-multi-method
- tramp-current-method
- tramp-current-user
- tramp-current-host
-
- ;; System defaults
- tramp-auto-save-directory ; vars to dump
- tramp-default-method
- tramp-rsh-end-of-line
- tramp-default-password-end-of-line
- tramp-remote-path
- tramp-login-prompt-regexp
- tramp-password-prompt-regexp
- tramp-wrong-passwd-regexp
- tramp-yesno-prompt-regexp
- tramp-yn-prompt-regexp
- tramp-terminal-prompt-regexp
- tramp-temp-name-prefix
- tramp-file-name-structure
- tramp-file-name-regexp
- tramp-multi-file-name-structure
- tramp-multi-file-name-hop-structure
- tramp-multi-methods
- tramp-multi-connection-function-alist
- tramp-methods
- tramp-end-of-output
- tramp-coding-commands
- tramp-actions-before-shell
- tramp-actions-copy-out-of-band
- tramp-multi-actions
- tramp-terminal-type
- tramp-shell-prompt-pattern
- tramp-chunksize
- ,(when (boundp 'tramp-backup-directory-alist)
- 'tramp-backup-directory-alist)
- ,(when (boundp 'tramp-bkup-backup-directory-info)
- 'tramp-bkup-backup-directory-info)
-
- ;; Non-tramp variables of interest
- shell-prompt-pattern
- backup-by-copying
- backup-by-copying-when-linked
- backup-by-copying-when-mismatch
- ,(when (boundp 'backup-by-copying-when-privileged-mismatch)
- 'backup-by-copying-when-privileged-mismatch)
- ,(when (boundp 'password-cache)
- 'password-cache)
- ,(when (boundp 'password-cache-expiry)
- 'password-cache-expiry)
- ,(when (boundp 'backup-directory-alist)
- 'backup-directory-alist)
- ,(when (boundp 'bkup-backup-directory-info)
- 'bkup-backup-directory-info)
- file-name-handler-alist)
- nil ; pre-hook
+ (delq nil
+ `(;; Current state
+ tramp-ls-command
+ tramp-test-groks-nt
+ tramp-file-exists-command
+ tramp-current-multi-method
+ tramp-current-method
+ tramp-current-user
+ tramp-current-host
+
+ ;; System defaults
+ tramp-auto-save-directory ; vars to dump
+ tramp-default-method
+ tramp-rsh-end-of-line
+ tramp-default-password-end-of-line
+ tramp-remote-path
+ tramp-login-prompt-regexp
+ ;; Mask non-7bit characters
+ (tramp-password-prompt-regexp . tramp-reporter-dump-variable)
+ tramp-wrong-passwd-regexp
+ tramp-yesno-prompt-regexp
+ tramp-yn-prompt-regexp
+ tramp-terminal-prompt-regexp
+ tramp-temp-name-prefix
+ tramp-file-name-structure
+ tramp-file-name-regexp
+ tramp-multi-file-name-structure
+ tramp-multi-file-name-hop-structure
+ tramp-multi-methods
+ tramp-multi-connection-function-alist
+ tramp-methods
+ tramp-end-of-output
+ tramp-coding-commands
+ tramp-actions-before-shell
+ tramp-actions-copy-out-of-band
+ tramp-multi-actions
+ tramp-terminal-type
+ ;; Mask non-7bit characters
+ (tramp-shell-prompt-pattern . tramp-reporter-dump-variable)
+ tramp-chunksize
+ ,(when (boundp 'tramp-backup-directory-alist)
+ 'tramp-backup-directory-alist)
+ ,(when (boundp 'tramp-bkup-backup-directory-info)
+ 'tramp-bkup-backup-directory-info)
+
+ ;; Non-tramp variables of interest
+ ;; Mask non-7bit characters
+ (shell-prompt-pattern . tramp-reporter-dump-variable)
+ backup-by-copying
+ backup-by-copying-when-linked
+ backup-by-copying-when-mismatch
+ ,(when (boundp 'backup-by-copying-when-privileged-mismatch)
+ 'backup-by-copying-when-privileged-mismatch)
+ ,(when (boundp 'password-cache)
+ 'password-cache)
+ ,(when (boundp 'password-cache-expiry)
+ 'password-cache-expiry)
+ ,(when (boundp 'backup-directory-alist)
+ 'backup-directory-alist)
+ ,(when (boundp 'bkup-backup-directory-info)
+ 'bkup-backup-directory-info)
+ file-name-handler-alist))
+
+ 'tramp-load-report-modules ; pre-hook
'tramp-append-tramp-buffers ; post-hook
"\
Enter your bug report in this message, including as much detail as you
--bug report follows this line--
"))))
-(defun tramp-append-tramp-buffers ()
- "Append Tramp buffers into the bug report."
+(defun tramp-reporter-dump-variable (varsym mailbuf)
+ "Pretty-print the value of the variable in symbol VARSYM.
+Used for non-7bit chars in strings."
+ (let* ((reporter-eval-buffer (symbol-value 'reporter-eval-buffer))
+ (val (with-current-buffer reporter-eval-buffer
+ (symbol-value varsym))))
+
+ ;; There are characters to be masked.
+ (when (and (boundp 'mm-7bit-chars)
+ (string-match
+ (concat "[^" (symbol-value 'mm-7bit-chars) "]") val))
+ (with-current-buffer reporter-eval-buffer
+ (set varsym (concat "(base64-decode-string \""
+ (base64-encode-string val)
+ "\")"))))
+
+ ;; Dump variable.
+ (funcall (symbol-function 'reporter-dump-variable) varsym mailbuf)
+
+ ;; Remove string quotation.
+ (forward-line -1)
+ (when (looking-at
+ (concat "\\(^.*\\)" "\"" ;; \1 "
+ "\\((base64-decode-string \\)" "\\\\" ;; \2 \
+ "\\(\".*\\)" "\\\\" ;; \3 \
+ "\\(\")\\)" "\"$")) ;; \4 "
+ (replace-match "\\1\\2\\3\\4")
+ (beginning-of-line)
+ (insert " ;; variable encoded due to non-printable characters\n"))
+ (forward-line 1)
+
+ ;; Reset VARSYM to old value.
+ (with-current-buffer reporter-eval-buffer
+ (set varsym val))))
+
+(defun tramp-load-report-modules ()
+ "Load needed modules for reporting."
;; We load message.el and mml.el from Gnus.
(if (featurep 'xemacs)
(require 'message nil 'noerror)
(require 'mml nil 'noerror))
(when (functionp 'message-mode)
- (funcall 'message-mode))
+ (funcall (symbol-function 'message-mode)))
(when (functionp 'mml-mode)
- (funcall 'mml-mode t))
+ (funcall (symbol-function 'mml-mode) t)))
+
+(defun tramp-append-tramp-buffers ()
+ "Append Tramp buffers into the bug report."
(when (and
(eq major-mode 'message-mode)
(goto-char (point-max))
(insert "\n\n")
(dolist (buffer buffer-list)
- (mml-insert-empty-tag
- 'part 'type "text/plain" 'encoding "base64"
- 'disposition "attachment" 'buffer (buffer-name buffer)
- 'description (buffer-name buffer)))
+ (funcall (symbol-function 'mml-insert-empty-tag)
+ 'part 'type "text/plain" 'encoding "base64"
+ 'disposition "attachment" 'buffer (buffer-name buffer)
+ 'description (buffer-name buffer)))
(set-buffer-modified-p nil))
;; Don't send. Delete the message buffer.
(defalias 'tramp-submit-bug 'tramp-bug)
+;; Checklist for `tramp-unload-hook'
+;; - Unload all `tramp-*' packages
+;; - Reset `file-name-handler-alist'
+;; - Cleanup hooks where Tramp functions are in
+;; - Cleanup advised functions
+;; - Cleanup autoloads
+;;;###autoload
+(defun tramp-unload-tramp ()
+ "Discard Tramp from loading remote files."
+ (interactive)
+ ;; When Tramp is not loaded yet, its autoloads are still active.
+ (tramp-unload-file-name-handlers)
+ ;; ange-ftp settings must be enabled.
+ (when (functionp 'tramp-ftp-enable-ange-ftp)
+ (funcall (symbol-function 'tramp-ftp-enable-ange-ftp)))
+ ;; `tramp-util' unloads also `tramp'.
+ (condition-case nil ;; maybe its not loaded yet.
+ (unload-feature (if (featurep 'tramp-util) 'tramp-util 'tramp) 'force)
+ (error nil)))
+
(provide 'tramp)
;; Make sure that we get integration with the VC package.
;; This must come after (provide 'tramp) because tramp-vc.el
;; requires tramp.
(eval-after-load "vc"
- '(require 'tramp-vc))
+ '(progn
+ (require 'tramp-vc)
+ (add-hook 'tramp-unload-hook
+ '(lambda ()
+ (when (featurep 'tramp-vc)
+ (unload-feature 'tramp-vc 'force))))))
;;; TODO: