;; Author: Kai Großjohann <kai.grossjohann@gmx.net>
;; Michael Albinus <michael.albinus@gmx.de>
;; Keywords: comm, processes
+;; Package: tramp
;; This file is part of GNU Emacs.
(when (and load-in-progress (null (current-message)))
(message "Loading tramp..."))
-;; 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))))
-
(require 'tramp-compat)
-(add-hook 'tramp-unload-hook
- (lambda ()
- (when (featurep 'tramp-compat)
- (unload-feature 'tramp-compat 'force))))
(require 'format-spec)
;; As long as password.el is not part of (X)Emacs, it shouldn't
(load "auth-source" 'noerror)
(require 'auth-source nil 'noerror)))
-;; Requiring 'tramp-cache results in an endless loop.
-(autoload 'tramp-get-file-property "tramp-cache")
-(autoload 'tramp-set-file-property "tramp-cache")
-(autoload 'tramp-flush-file-property "tramp-cache")
-(autoload 'tramp-flush-directory-property "tramp-cache")
-(autoload 'tramp-get-connection-property "tramp-cache")
-(autoload 'tramp-set-connection-property "tramp-cache")
-(autoload 'tramp-flush-connection-property "tramp-cache")
-(autoload 'tramp-parse-connection-properties "tramp-cache")
-(add-hook 'tramp-unload-hook
- (lambda ()
- (when (featurep 'tramp-cache)
- (unload-feature 'tramp-cache 'force))))
-
-(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))))
-
(autoload 'uudecode-decode-region "uudecode")
-;; The following Tramp packages must be loaded after tramp.el, because
-;; they require it as well.
-(eval-after-load "tramp"
- '(dolist
- (feature
- (list
-
- ;; Tramp interactive commands.
- 'tramp-cmds
-
- ;; Load foreign FTP method.
- (if (featurep 'xemacs) 'tramp-efs 'tramp-ftp)
-
- ;; tramp-smb uses "smbclient" from Samba. Not available
- ;; under Cygwin and Windows, because they don't offer
- ;; "smbclient". And even not necessary there, because Emacs
- ;; supports UNC file names like "//host/share/localname".
- (unless (memq system-type '(cygwin windows-nt)) 'tramp-smb)
-
- ;; Load foreign FISH method.
- 'tramp-fish
-
- ;; tramp-gvfs needs D-Bus messages. Available since Emacs 23
- ;; on some system types. We don't call `dbus-ping', because
- ;; this would load dbus.el.
- (when (and (featurep 'dbusbind)
- (condition-case nil
- (tramp-compat-funcall 'dbus-get-unique-name :session)
- (error nil))
- (tramp-compat-process-running-p "gvfs-fuse-daemon"))
- 'tramp-gvfs)
-
- ;; Load gateways. It needs `make-network-process' from Emacs 22.
- (when (functionp 'make-network-process) 'tramp-gw)
-
- ;; tramp-imap needs both epa (from Emacs 23.1) and imap-hash
- ;; (from Emacs 23.2).
- (when (and (locate-library "epa") (locate-library "imap-hash"))
- 'tramp-imap)))
-
- (when feature
- ;; We have used just some basic tests, whether a package shall
- ;; be added. There might still be other errors during loading,
- ;; which we will catch here.
- (catch 'tramp-loading
- (require feature)
- (add-hook 'tramp-unload-hook
- `(lambda ()
- (when (featurep (quote ,feature))
- (unload-feature (quote ,feature) 'force)))))
- (unless (featurep feature)
- (message "Loading %s failed, ignoring this package" feature)))))
-
;;; User Customizable Internal Variables:
(defgroup tramp nil
6 sent and received strings
7 file caching
8 connection properties
+ 9 test commands
10 traces (huge)."
:group 'tramp
:type 'integer)
:group 'tramp
:type '(choice (const nil) integer))
+;;;###tramp-autoload
(defcustom tramp-terminal-type "dumb"
"*Value of TERM environment variable for logging in to remote host.
Because Tramp wants to parse the output of the remote shell, it is easily
The '$' character at the end is quoted; the string cannot be
detected as prompt when being sent on echoing hosts, therefore.")
+;;;###tramp-autoload
(defconst tramp-initial-end-of-output "#$ "
"Prompt when establishing a connection.")
+;;;###tramp-autoload
(defvar tramp-methods
`(("rcp" (tramp-login-program "rsh")
(tramp-login-args (("%h") ("-l" "%u")))
(tramp-copy-recursive t)
(tramp-password-end-of-line nil))
("scp" (tramp-login-program "ssh")
- (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p")
- ("-e" "none")))
+ (tramp-login-args (("-l" "%u") ("-p" "%p")
+ ("-e" "none") ("%h")))
+ (tramp-async-args (("-q")))
(tramp-remote-sh "/bin/sh")
(tramp-copy-program "scp")
(tramp-copy-args (("-P" "%p") ("-p" "%k")
("-o" "StrictHostKeyChecking=no")))
(tramp-default-port 22))
("scp1" (tramp-login-program "ssh")
- (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p")
- ("-1" "-e" "none")))
+ (tramp-login-args (("-l" "%u") ("-p" "%p")
+ ("-1") ("-e" "none") ("%h")))
+ (tramp-async-args (("-q")))
(tramp-remote-sh "/bin/sh")
(tramp-copy-program "scp")
(tramp-copy-args (("-1") ("-P" "%p") ("-p" "%k")
("-o" "StrictHostKeyChecking=no")))
(tramp-default-port 22))
("scp2" (tramp-login-program "ssh")
- (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p")
- ("-2" "-e" "none")))
+ (tramp-login-args (("-l" "%u") ("-p" "%p")
+ ("-2") ("-e" "none") ("%h")))
+ (tramp-async-args (("-q")))
(tramp-remote-sh "/bin/sh")
(tramp-copy-program "scp")
(tramp-copy-args (("-2") ("-P" "%p") ("-p" "%k")
(tramp-copy-recursive t)
(tramp-password-end-of-line nil))
("sftp" (tramp-login-program "ssh")
- (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p")
- ("-e" "none")))
+ (tramp-login-args (("-l" "%u") ("-p" "%p")
+ ("-e" "none") ("%h")))
+ (tramp-async-args (("-q")))
(tramp-remote-sh "/bin/sh")
(tramp-copy-program "sftp")
(tramp-copy-args nil)
(tramp-copy-keep-date nil)
(tramp-password-end-of-line nil))
("rsync" (tramp-login-program "ssh")
- (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p")
- ("-e" "none")))
+ (tramp-login-args (("-l" "%u") ("-p" "%p")
+ ("-e" "none") ("%h")))
+ (tramp-async-args (("-q")))
(tramp-remote-sh "/bin/sh")
(tramp-copy-program "rsync")
(tramp-copy-args (("-e" "ssh") ("-t" "%k") ("-r")))
(tramp-password-end-of-line nil))
("rsyncc"
(tramp-login-program "ssh")
- (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p")
+ (tramp-login-args (("-l" "%u") ("-p" "%p")
("-o" "ControlPath=%t.%%r@%%h:%%p")
("-o" "ControlMaster=yes")
- ("-e" "none")))
+ ("-e" "none") ("%h")))
+ (tramp-async-args (("-q")))
(tramp-remote-sh "/bin/sh")
(tramp-copy-program "rsync")
(tramp-copy-args (("-t" "%k") ("-r")))
(tramp-copy-keep-date nil)
(tramp-password-end-of-line nil))
("ssh" (tramp-login-program "ssh")
- (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p")
- ("-e" "none")))
+ (tramp-login-args (("-l" "%u") ("-p" "%p")
+ ("-e" "none") ("%h")))
+ (tramp-async-args (("-q")))
(tramp-remote-sh "/bin/sh")
(tramp-copy-program nil)
(tramp-copy-args nil)
("-o" "StrictHostKeyChecking=no")))
(tramp-default-port 22))
("ssh1" (tramp-login-program "ssh")
- (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p")
- ("-1" "-e" "none")))
+ (tramp-login-args (("-l" "%u") ("-p" "%p")
+ ("-1") ("-e" "none") ("%h")))
+ (tramp-async-args (("-q")))
(tramp-remote-sh "/bin/sh")
(tramp-copy-program nil)
(tramp-copy-args nil)
("-o" "StrictHostKeyChecking=no")))
(tramp-default-port 22))
("ssh2" (tramp-login-program "ssh")
- (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p")
- ("-2" "-e" "none")))
+ (tramp-login-args (("-l" "%u") ("-p" "%p")
+ ("-2") ("-e" "none") ("%h")))
+ (tramp-async-args (("-q")))
(tramp-remote-sh "/bin/sh")
(tramp-copy-program nil)
(tramp-copy-args nil)
(tramp-login-program "ssh1")
(tramp-login-args (("%h") ("-l" "%u") ("-p" "%p")
("-e" "none")))
+ (tramp-async-args (("-q")))
(tramp-remote-sh "/bin/sh")
(tramp-copy-program nil)
(tramp-copy-args nil)
(tramp-copy-keep-date nil)
(tramp-password-end-of-line nil))
("scpc" (tramp-login-program "ssh")
- (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p")
+ (tramp-login-args (("-l" "%u") ("-p" "%p")
("-o" "ControlPath=%t.%%r@%%h:%%p")
("-o" "ControlMaster=yes")
- ("-e" "none")))
+ ("-e" "none") ("%h")))
+ (tramp-async-args (("-q")))
(tramp-remote-sh "/bin/sh")
(tramp-copy-program "scp")
(tramp-copy-args (("-P" "%p") ("-p" "%k") ("-q")
("-o" "StrictHostKeyChecking=no")))
(tramp-default-port 22))
("scpx" (tramp-login-program "ssh")
- (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p")
- ("-e" "none" "-t" "-t" "/bin/sh")))
+ (tramp-login-args (("-l" "%u") ("-p" "%p")
+ ("-e" "none") ("-t" "-t")
+ ("%h") ("/bin/sh")))
+ (tramp-async-args (("-q")))
(tramp-remote-sh "/bin/sh")
(tramp-copy-program "scp")
(tramp-copy-args (("-p" "%k")))
("-o" "StrictHostKeyChecking=no")))
(tramp-default-port 22))
("sshx" (tramp-login-program "ssh")
- (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p")
- ("-e" "none" "-t" "-t" "/bin/sh")))
+ (tramp-login-args (("-l" "%u") ("-p" "%p")
+ ("-e" "none") ("-t" "-t")
+ ("%h") ("/bin/sh")))
+ (tramp-async-args (("-q")))
(tramp-remote-sh "/bin/sh")
(tramp-copy-program nil)
(tramp-copy-args nil)
(tramp-copy-keep-date nil)
(tramp-password-end-of-line nil))
("plink" (tramp-login-program "plink")
- (tramp-login-args (("%h") ("-l" "%u") ("-P" "%p")
- ("-ssh")))
+ (tramp-login-args (("-l" "%u") ("-P" "%p")
+ ("-ssh") ("%h")))
(tramp-remote-sh "/bin/sh")
(tramp-copy-program nil)
(tramp-copy-args nil)
(tramp-default-port 22))
("plink1"
(tramp-login-program "plink")
- (tramp-login-args (("%h") ("-l" "%u") ("-P" "%p")
- ("-1" "-ssh")))
+ (tramp-login-args (("-l" "%u") ("-P" "%p")
+ ("-1" "-ssh") ("%h")))
(tramp-remote-sh "/bin/sh")
(tramp-copy-program nil)
(tramp-copy-args nil)
(tramp-copy-keep-date nil)
(tramp-password-end-of-line nil))
("pscp" (tramp-login-program "plink")
- (tramp-login-args (("%h") ("-l" "%u") ("-P" "%p")
- ("-ssh")))
+ (tramp-login-args (("-l" "%u") ("-P" "%p")
+ ("-ssh") ("%h")))
(tramp-remote-sh "/bin/sh")
(tramp-copy-program "pscp")
(tramp-copy-args (("-P" "%p") ("-scp") ("-p" "%k")))
(tramp-password-end-of-line "xy") ;see docstring for "xy"
(tramp-default-port 22))
("psftp" (tramp-login-program "plink")
- (tramp-login-args (("%h") ("-l" "%u") ("-P" "%p")
- ("-ssh")))
+ (tramp-login-args (("-l" "%u") ("-P" "%p")
+ ("-ssh") ("%h")))
(tramp-remote-sh "/bin/sh")
(tramp-copy-program "pscp")
(tramp-copy-args (("-P" "%p") ("-sftp") ("-p" "%k")))
\"%t\" is replaced by the temporary file name produced with
`tramp-make-tramp-temp-file'. \"%k\" indicates the keep-date
parameter of a program, if exists.
+ * `tramp-async-args'
+ When an asynchronous process is started, we know already that
+ the connection works. Therefore, we can pass additional
+ parameters to suppress diagnostic messages, in order not to
+ tamper the process output.
* `tramp-copy-program'
This specifies the name of the program to use for remotely copying
the file; this might be the absolute filename of rcp or the name of
;; Solaris: /usr/xpg4/bin:/usr/ccs/bin:/usr/bin:/opt/SUNWspro/bin
;; GNU/Linux (Debian, Suse): /bin:/usr/bin
;; FreeBSD: /usr/bin:/bin:/usr/sbin:/sbin: - beware trailing ":"!
+;; IRIX64: /usr/bin
(defcustom tramp-remote-path
'(tramp-default-remote-path "/usr/sbin" "/usr/local/bin"
"/local/bin" "/local/freeware/bin" "/local/gnu/bin"
`("HISTFILE=$HOME/.tramp_history" "HISTSIZE=1" "LC_ALL=C"
,(format "TERM=%s" tramp-terminal-type)
"EMACS=t" ;; Deprecated.
- ,(format "INSIDE_EMACS=%s,tramp:%s" emacs-version tramp-version)
+ ,(format "INSIDE_EMACS='%s,tramp:%s'" emacs-version tramp-version)
"CDPATH=" "HISTORY=" "MAIL=" "MAILCHECK=" "MAILPATH="
"autocorrect=" "correct=")
(defcustom tramp-shell-prompt-pattern
;; Allow a prompt to start right after a ^M since it indeed would be
- ;; displayed at the beginning of the line (and Zsh uses it).
- "\\(?:^\\|\r\\)[^#$%>\n]*#?[#$%>] *\\(\e\\[[0-9;]*[a-zA-Z] *\\)*"
+ ;; displayed at the beginning of the line (and Zsh uses it). This
+ ;; regexp works only for GNU Emacs.
+ (concat (if (featurep 'xemacs) "" "\\(?:^\\|\r\\)")
+ "[^#$%>\n]*#?[#$%>] *\\(\e\\[[0-9;]*[a-zA-Z] *\\)*")
"Regexp to match prompts from remote shell.
Normally, Tramp expects you to configure `shell-prompt-pattern'
correctly, but sometimes it happens that you are connecting to a
;;;###autoload
(defconst tramp-file-name-regexp-unified
- "\\`/\\([^[/:]+\\|[^/]+]\\):"
+ (if (memq system-type '(cygwin windows-nt))
+ "\\`/\\([^[/:]\\{2,\\}\\|[^/]\\{2,\\}]\\):"
+ "\\`/\\([^[/:]+\\|[^/]+]\\):")
"Value for `tramp-file-name-regexp' for unified remoting.
Emacs (not XEmacs) uses a unified filename syntax for Ange-FTP and
-Tramp. See `tramp-file-name-structure' for more explanations.")
+Tramp. See `tramp-file-name-structure' for more explanations.
+
+On W32 systems, the volume letter must be ignored.")
;;;###autoload
(defconst tramp-file-name-regexp-separate
;;;###autoload
(defconst tramp-completion-file-name-regexp-unified
- (concat tramp-root-regexp "[^/]*\\'")
+ (if (memq system-type '(cygwin windows-nt))
+ (concat tramp-root-regexp "[^/]\\{2,\\}\\'")
+ (concat tramp-root-regexp "[^/]*\\'"))
"Value for `tramp-completion-file-name-regexp' for unified remoting.
GNU Emacs uses a unified filename syntax for Tramp and Ange-FTP.
-See `tramp-file-name-structure' for more explanations.")
+See `tramp-file-name-structure' for more explanations.
+
+On W32 systems, the volume letter must be ignored.")
;;;###autoload
(defconst tramp-completion-file-name-regexp-separate
$stat[2],
$stat[1] >> 16 & 0xffff,
$stat[1] & 0xffff
-);' \"$1\" \"$2\" \"$3\" 2>/dev/null"
+);' \"$1\" \"$2\" 2>/dev/null"
"Perl script to produce output suitable for use with `file-attributes'
on the remote file system.
Escape sequence %s is replaced with name of Perl binary.
$stat[0] >> 16 & 0xffff,
$stat[0] & 0xffff);
}
-printf(\")\\n\");' \"$1\" \"$2\" \"$3\" 2>/dev/null"
+printf(\")\\n\");' \"$1\" \"$2\" 2>/dev/null"
"Perl script implementing `directory-files-attributes' as Lisp `read'able
output.
Escape sequence %s is replaced with name of Perl binary.
(defconst tramp-vc-registered-read-file-names
"echo \"(\"
-for file in \"$@\"; do
- if %s $file; then
+while read file; do
+ if %s \"$file\"; then
echo \"(\\\"$file\\\" \\\"file-exists-p\\\" t)\"
else
echo \"(\\\"$file\\\" \\\"file-exists-p\\\" nil)\"
fi
- if %s $file; then
+ if %s \"$file\"; then
echo \"(\\\"$file\\\" \\\"file-readable-p\\\" t)\"
else
echo \"(\\\"$file\\\" \\\"file-readable-p\\\" nil)\"
echo \")\""
"Script to check existence of VC related files.
It must be send formatted with two strings; the tests for file
-existence, and file readability.")
+existence, and file readability. Input shall be read via
+here-document, otherwise the command could exceed maximum length
+of command line.")
(defconst tramp-file-mode-type-map
'((0 . "-") ; Normal file (SVID-v2 and XPG2)
normal Emacs functions.")
;; Handlers for foreign methods, like FTP or SMB, shall be plugged here.
+;;;###tramp-autoload
(defvar tramp-foreign-file-name-handler-alist
;; (identity . tramp-sh-file-name-handler) should always be the last
;; entry, because `identity' always matches.
;;; Internal functions which must come first:
-(defsubst tramp-debug-message (vec fmt-string &rest args)
- "Append message to debug buffer.
-Message is formatted with FMT-STRING as control string and the remaining
-ARGS to actually emit the message (if applicable)."
- (when (get-buffer (tramp-buffer-name vec))
- (with-current-buffer (tramp-get-debug-buffer vec)
- (goto-char (point-max))
- ;; Headline.
- (when (bobp)
- (insert
- (format
- ";; %sEmacs: %s Tramp: %s -*- mode: outline; -*-"
- (if (featurep 'sxemacs) "SX" (if (featurep 'xemacs) "X" "GNU "))
- emacs-version tramp-version)))
- (unless (bolp)
- (insert "\n"))
- ;; Timestamp.
- (let ((now (current-time)))
- (insert (format-time-string "%T." now))
- (insert (format "%06d " (nth 2 now))))
- ;; Calling function.
- (let ((btn 1) btf fn)
- (while (not fn)
- (setq btf (nth 1 (backtrace-frame btn)))
- (if (not btf)
- (setq fn "")
- (when (symbolp btf)
- (setq fn (symbol-name btf))
- (unless (and (string-match "^tramp" fn)
- (not (string-match
- "^tramp\\(-debug\\)?\\(-message\\|-error\\)$"
- fn)))
- (setq fn nil)))
- (setq btn (1+ btn))))
- ;; The following code inserts filename and line number.
- ;; Should be deactivated by default, because it is time
- ;; consuming.
-; (let ((ffn (find-function-noselect (intern fn))))
-; (insert
-; (format
-; "%s:%d: "
-; (file-name-nondirectory (buffer-file-name (car ffn)))
-; (with-current-buffer (car ffn)
-; (1+ (count-lines (point-min) (cdr ffn)))))))
- (insert (format "%s " fn)))
- ;; The message.
- (insert (apply 'format fmt-string args)))))
-
-(defvar tramp-message-show-message t
- "Show Tramp message in the minibuffer.
-This variable is used to disable messages from `tramp-error'.
-The messages are visible anyway, because an error is raised.")
-(defsubst tramp-message (vec-or-proc level fmt-string &rest args)
- "Emit a message depending on verbosity level.
-VEC-OR-PROC identifies the Tramp buffer to use. It can be either a
-vector or a process. LEVEL says to be quiet if `tramp-verbose' is
-less than LEVEL. The message is emitted only if `tramp-verbose' is
-greater than or equal to LEVEL.
+;; ------------------------------------------------------------
+;; -- Tramp file names --
+;; ------------------------------------------------------------
+;; Conversion functions between external representation and
+;; internal data structure. Convenience functions for internal
+;; data structure.
-The message is also logged into the debug buffer when `tramp-verbose'
-is greater than or equal 4.
+(defun tramp-file-name-p (vec)
+ "Check, whether VEC is a Tramp object."
+ (and (vectorp vec) (= 4 (length vec))))
-Calls functions `message' and `tramp-debug-message' with FMT-STRING as
-control string and the remaining ARGS to actually emit the message (if
-applicable)."
- (condition-case nil
- (when (<= level tramp-verbose)
- ;; Match data must be preserved!
- (save-match-data
- ;; Display only when there is a minimum level.
- (when (and tramp-message-show-message (<= level 3))
- (apply 'message
- (concat
- (cond
- ((= level 0) "")
- ((= level 1) "")
- ((= level 2) "Warning: ")
- (t "Tramp: "))
- fmt-string)
- args))
- ;; Log only when there is a minimum level.
- (when (>= tramp-verbose 4)
- (when (and vec-or-proc
- (processp vec-or-proc)
- (buffer-name (process-buffer vec-or-proc)))
- (with-current-buffer (process-buffer vec-or-proc)
- ;; Translate proc to vec.
- (setq vec-or-proc (tramp-dissect-file-name default-directory))))
- (when (and vec-or-proc (vectorp vec-or-proc))
- (apply 'tramp-debug-message
- vec-or-proc
- (concat (format "(%d) # " level) fmt-string)
- args)))))
- ;; Suppress all errors.
- (error nil)))
+(defun tramp-file-name-method (vec)
+ "Return method component of VEC."
+ (and (tramp-file-name-p vec) (aref vec 0)))
-(defsubst tramp-error (vec-or-proc signal fmt-string &rest args)
- "Emit an error.
-VEC-OR-PROC identifies the connection to use, SIGNAL is the
-signal identifier to be raised, remaining args passed to
-`tramp-message'. Finally, signal SIGNAL is raised."
- (let (tramp-message-show-message)
- (tramp-message
- vec-or-proc 1 "%s"
- (error-message-string
- (list signal
- (get signal 'error-message)
- (apply 'format fmt-string args))))
- (signal signal (list (apply 'format fmt-string args)))))
+(defun tramp-file-name-user (vec)
+ "Return user component of VEC."
+ (and (tramp-file-name-p vec) (aref vec 1)))
-(defsubst tramp-error-with-buffer
- (buffer vec-or-proc signal fmt-string &rest args)
- "Emit an error, and show BUFFER.
-If BUFFER is nil, show the connection buffer. Wait for 30\", or until
-an input event arrives. The other arguments are passed to `tramp-error'."
- (save-window-excursion
- (unwind-protect
- (apply 'tramp-error vec-or-proc signal fmt-string args)
- (when (and vec-or-proc
- (not (zerop tramp-verbose))
- (not (tramp-completion-mode-p)))
- (let ((enable-recursive-minibuffers t))
- (pop-to-buffer
- (or (and (bufferp buffer) buffer)
- (and (processp vec-or-proc) (process-buffer vec-or-proc))
- (tramp-get-buffer vec-or-proc)))
- (sit-for 30))))))
+(defun tramp-file-name-host (vec)
+ "Return host component of VEC."
+ (and (tramp-file-name-p vec) (aref vec 2)))
-(defmacro with-parsed-tramp-file-name (filename var &rest body)
- "Parse a Tramp filename and make components available in the body.
+(defun tramp-file-name-localname (vec)
+ "Return localname component of VEC."
+ (and (tramp-file-name-p vec) (aref vec 3)))
-First arg FILENAME is evaluated and dissected into its components.
-Second arg VAR is a symbol. It is used as a variable name to hold
-the filename structure. It is also used as a prefix for the variables
-holding the components. For example, if VAR is the symbol `foo', then
-`foo' will be bound to the whole structure, `foo-method' will be bound to
-the method component, and so on for `foo-user', `foo-host', `foo-localname'.
+;; The user part of a Tramp file name vector can be of kind
+;; "user%domain". Sometimes, we must extract these parts.
+(defun tramp-file-name-real-user (vec)
+ "Return the user name of VEC without domain."
+ (save-match-data
+ (let ((user (tramp-file-name-user vec)))
+ (if (and (stringp user)
+ (string-match tramp-user-with-domain-regexp user))
+ (match-string 1 user)
+ user))))
-Remaining args are Lisp expressions to be evaluated (inside an implicit
-`progn').
+(defun tramp-file-name-domain (vec)
+ "Return the domain name of VEC."
+ (save-match-data
+ (let ((user (tramp-file-name-user vec)))
+ (and (stringp user)
+ (string-match tramp-user-with-domain-regexp user)
+ (match-string 2 user)))))
-If VAR is nil, then we bind `v' to the structure and `method', `user',
-`host', `localname' to the components."
- `(let* ((,(or var 'v) (tramp-dissect-file-name ,filename))
- (,(if var (intern (concat (symbol-name var) "-method")) 'method)
- (tramp-file-name-method ,(or var 'v)))
- (,(if var (intern (concat (symbol-name var) "-user")) 'user)
- (tramp-file-name-user ,(or var 'v)))
- (,(if var (intern (concat (symbol-name var) "-host")) 'host)
- (tramp-file-name-host ,(or var 'v)))
- (,(if var (intern (concat (symbol-name var) "-localname")) 'localname)
- (tramp-file-name-localname ,(or var 'v))))
- ,@body))
+;; The host part of a Tramp file name vector can be of kind
+;; "host#port". Sometimes, we must extract these parts.
+(defun tramp-file-name-real-host (vec)
+ "Return the host name of VEC without port."
+ (save-match-data
+ (let ((host (tramp-file-name-host vec)))
+ (if (and (stringp host)
+ (string-match tramp-host-with-port-regexp host))
+ (match-string 1 host)
+ host))))
-(put 'with-parsed-tramp-file-name 'lisp-indent-function 2)
-(put 'with-parsed-tramp-file-name 'edebug-form-spec '(form symbolp body))
-(font-lock-add-keywords 'emacs-lisp-mode '("\\<with-parsed-tramp-file-name\\>"))
+(defun tramp-file-name-port (vec)
+ "Return the port number of VEC."
+ (save-match-data
+ (let ((host (tramp-file-name-host vec)))
+ (and (stringp host)
+ (string-match tramp-host-with-port-regexp host)
+ (string-to-number (match-string 2 host))))))
-(defmacro with-file-property (vec file property &rest body)
- "Check in Tramp cache for PROPERTY, otherwise execute BODY and set cache.
-FILE must be a local file name on a connection identified via VEC."
- `(if (file-name-absolute-p ,file)
- (let ((value (tramp-get-file-property ,vec ,file ,property 'undef)))
- (when (eq value 'undef)
- ;; We cannot pass @body as parameter to
- ;; `tramp-set-file-property' because it mangles our
- ;; debug messages.
- (setq value (progn ,@body))
- (tramp-set-file-property ,vec ,file ,property value))
- value)
- ,@body))
+;;;###tramp-autoload
+(defun tramp-tramp-file-p (name)
+ "Return t if NAME is a string with Tramp file name syntax."
+ (save-match-data
+ (and (stringp name) (string-match tramp-file-name-regexp name))))
-(put 'with-file-property 'lisp-indent-function 3)
-(put 'with-file-property 'edebug-form-spec t)
-(font-lock-add-keywords 'emacs-lisp-mode '("\\<with-file-property\\>"))
-
-(defmacro with-connection-property (key property &rest body)
- "Check in Tramp for property PROPERTY, otherwise executes BODY and set."
- `(let ((value (tramp-get-connection-property ,key ,property 'undef)))
- (when (eq value 'undef)
- ;; We cannot pass ,@body as parameter to
- ;; `tramp-set-connection-property' because it mangles our debug
- ;; messages.
- (setq value (progn ,@body))
- (tramp-set-connection-property ,key ,property value))
- value))
-
-(put 'with-connection-property 'lisp-indent-function 2)
-(put 'with-connection-property 'edebug-form-spec t)
-(font-lock-add-keywords 'emacs-lisp-mode '("\\<with-connection-property\\>"))
+(defun tramp-find-method (method user host)
+ "Return the right method string to use.
+This is METHOD, if non-nil. Otherwise, do a lookup in
+`tramp-default-method-alist'."
+ (or method
+ (let ((choices tramp-default-method-alist)
+ lmethod item)
+ (while choices
+ (setq item (pop choices))
+ (when (and (string-match (or (nth 0 item) "") (or host ""))
+ (string-match (or (nth 1 item) "") (or user "")))
+ (setq lmethod (nth 2 item))
+ (setq choices nil)))
+ lmethod)
+ tramp-default-method))
-(defmacro with-progress-reporter (vec level message &rest body)
- "Executes BODY, spinning a progress reporter with MESSAGE."
- `(let (pr tm)
- (tramp-message ,vec ,level "%s..." ,message)
- ;; We start a pulsing progress reporter after 3 seconds. Feature
- ;; introduced in Emacs 24.1.
- (when (and tramp-message-show-message
- ;; Display only when there is a minimum level.
- (<= ,level (min tramp-verbose 3)))
- (condition-case nil
- (setq pr (tramp-compat-funcall 'make-progress-reporter ,message)
- tm (if pr (run-at-time 3 0.1 'progress-reporter-update pr)))
+(defun tramp-find-user (method user host)
+ "Return the right user string to use.
+This is USER, if non-nil. Otherwise, do a lookup in
+`tramp-default-user-alist'."
+ (or user
+ (let ((choices tramp-default-user-alist)
+ luser item)
+ (while choices
+ (setq item (pop choices))
+ (when (and (string-match (or (nth 0 item) "") (or method ""))
+ (string-match (or (nth 1 item) "") (or host "")))
+ (setq luser (nth 2 item))
+ (setq choices nil)))
+ luser)
+ tramp-default-user))
+
+(defun tramp-find-host (method user host)
+ "Return the right host string to use.
+This is HOST, if non-nil. Otherwise, it is `tramp-default-host'."
+ (or (and (> (length host) 0) host)
+ tramp-default-host))
+
+(defun tramp-dissect-file-name (name &optional nodefault)
+ "Return a `tramp-file-name' structure.
+The structure consists of remote method, remote user, remote host
+and localname (file name on remote host). If NODEFAULT is
+non-nil, the file name parts are not expanded to their default
+values."
+ (save-match-data
+ (let ((match (string-match (nth 0 tramp-file-name-structure) name)))
+ (unless match (error "Not a Tramp file name: %s" name))
+ (let ((method (match-string (nth 1 tramp-file-name-structure) name))
+ (user (match-string (nth 2 tramp-file-name-structure) name))
+ (host (match-string (nth 3 tramp-file-name-structure) name))
+ (localname (match-string (nth 4 tramp-file-name-structure) name)))
+ (when (member method '("multi" "multiu"))
+ (error
+ "`%s' method is no longer supported, see (info \"(tramp)Multi-hops\")"
+ method))
+ (when host
+ (when (string-match tramp-prefix-ipv6-regexp host)
+ (setq host (replace-match "" nil t host)))
+ (when (string-match tramp-postfix-ipv6-regexp host)
+ (setq host (replace-match "" nil t host))))
+ (if nodefault
+ (vector method user host localname)
+ (vector
+ (tramp-find-method method user host)
+ (tramp-find-user method user host)
+ (tramp-find-host method user host)
+ localname))))))
+
+(defun tramp-buffer-name (vec)
+ "A name for the connection buffer VEC."
+ ;; We must use `tramp-file-name-real-host', because for gateway
+ ;; methods the default port will be expanded later on, which would
+ ;; tamper the name.
+ (let ((method (tramp-file-name-method vec))
+ (user (tramp-file-name-user vec))
+ (host (tramp-file-name-real-host vec)))
+ (if (not (zerop (length user)))
+ (format "*tramp/%s %s@%s*" method user host)
+ (format "*tramp/%s %s*" method host))))
+
+(defun tramp-make-tramp-file-name (method user host localname)
+ "Constructs a Tramp file name from METHOD, USER, HOST and LOCALNAME."
+ (concat tramp-prefix-format
+ (when (not (zerop (length method)))
+ (concat method tramp-postfix-method-format))
+ (when (not (zerop (length user)))
+ (concat user tramp-postfix-user-format))
+ (when host
+ (if (string-match tramp-ipv6-regexp host)
+ (concat tramp-prefix-ipv6-format host tramp-postfix-ipv6-format)
+ host))
+ tramp-postfix-host-format
+ (when localname localname)))
+
+(defun tramp-completion-make-tramp-file-name (method user host localname)
+ "Constructs a Tramp file name from METHOD, USER, HOST and LOCALNAME.
+It must not be a complete Tramp file name, but as long as there are
+necessary only. This function will be used in file name completion."
+ (concat tramp-prefix-format
+ (when (not (zerop (length method)))
+ (concat method tramp-postfix-method-format))
+ (when (not (zerop (length user)))
+ (concat user tramp-postfix-user-format))
+ (when (not (zerop (length host)))
+ (concat
+ (if (string-match tramp-ipv6-regexp host)
+ (concat tramp-prefix-ipv6-format host tramp-postfix-ipv6-format)
+ host)
+ tramp-postfix-host-format))
+ (when localname localname)))
+
+(defun tramp-get-buffer (vec)
+ "Get the connection buffer to be used for VEC."
+ (or (get-buffer (tramp-buffer-name vec))
+ (with-current-buffer (get-buffer-create (tramp-buffer-name vec))
+ (setq buffer-undo-list t)
+ (setq default-directory
+ (tramp-make-tramp-file-name
+ (tramp-file-name-method vec)
+ (tramp-file-name-user vec)
+ (tramp-file-name-host vec)
+ "/"))
+ (current-buffer))))
+
+(defun tramp-get-connection-buffer (vec)
+ "Get the connection buffer to be used for VEC.
+In case a second asynchronous communication has been started, it is different
+from `tramp-get-buffer'."
+ (or (tramp-get-connection-property vec "process-buffer" nil)
+ (tramp-get-buffer vec)))
+
+(defun tramp-get-connection-process (vec)
+ "Get the connection process to be used for VEC.
+In case a second asynchronous communication has been started, it is different
+from the default one."
+ (get-process
+ (or (tramp-get-connection-property vec "process-name" nil)
+ (tramp-buffer-name vec))))
+
+(defun tramp-debug-buffer-name (vec)
+ "A name for the debug buffer for VEC."
+ ;; We must use `tramp-file-name-real-host', because for gateway
+ ;; methods the default port will be expanded later on, which would
+ ;; tamper the name.
+ (let ((method (tramp-file-name-method vec))
+ (user (tramp-file-name-user vec))
+ (host (tramp-file-name-real-host vec)))
+ (if (not (zerop (length user)))
+ (format "*debug tramp/%s %s@%s*" method user host)
+ (format "*debug tramp/%s %s*" method host))))
+
+(defconst tramp-debug-outline-regexp
+ "[0-9]+:[0-9]+:[0-9]+\\.[0-9]+ [a-z0-9-]+ (\\([0-9]+\\)) #")
+
+(defun tramp-get-debug-buffer (vec)
+ "Get the debug buffer for VEC."
+ (with-current-buffer
+ (get-buffer-create (tramp-debug-buffer-name vec))
+ (when (bobp)
+ (setq buffer-undo-list t)
+ ;; Activate `outline-mode'. This runs `text-mode-hook' and
+ ;; `outline-mode-hook'. We must prevent that local processes
+ ;; die. Yes: I've seen `flyspell-mode', which starts "ispell".
+ ;; Furthermore, `outline-regexp' must have the correct value
+ ;; already, because it is used by `font-lock-compile-keywords'.
+ (let ((default-directory (tramp-compat-temporary-file-directory))
+ (outline-regexp tramp-debug-outline-regexp))
+ (outline-mode))
+ (set (make-local-variable 'outline-regexp) tramp-debug-outline-regexp)
+ (set (make-local-variable 'outline-level) 'tramp-outline-level))
+ (current-buffer)))
+
+(defun tramp-outline-level ()
+ "Return the depth to which a statement is nested in the outline.
+Point must be at the beginning of a header line.
+
+The outline level is equal to the verbosity of the Tramp message."
+ (1+ (string-to-number (match-string 1))))
+
+(defsubst tramp-debug-message (vec fmt-string &rest args)
+ "Append message to debug buffer.
+Message is formatted with FMT-STRING as control string and the remaining
+ARGS to actually emit the message (if applicable)."
+ (when (get-buffer (tramp-buffer-name vec))
+ (with-current-buffer (tramp-get-debug-buffer vec)
+ (goto-char (point-max))
+ ;; Headline.
+ (when (bobp)
+ (insert
+ (format
+ ";; %sEmacs: %s Tramp: %s -*- mode: outline; -*-"
+ (if (featurep 'sxemacs) "SX" (if (featurep 'xemacs) "X" "GNU "))
+ emacs-version tramp-version)))
+ (unless (bolp)
+ (insert "\n"))
+ ;; Timestamp.
+ (let ((now (current-time)))
+ (insert (format-time-string "%T." now))
+ (insert (format "%06d " (nth 2 now))))
+ ;; Calling function.
+ (let ((btn 1) btf fn)
+ (while (not fn)
+ (setq btf (nth 1 (backtrace-frame btn)))
+ (if (not btf)
+ (setq fn "")
+ (when (symbolp btf)
+ (setq fn (symbol-name btf))
+ (unless (and (string-match "^tramp" fn)
+ (not (string-match
+ "^tramp\\(-debug\\)?\\(-message\\|-error\\|-compat-funcall\\)$"
+ fn)))
+ (setq fn nil)))
+ (setq btn (1+ btn))))
+ ;; The following code inserts filename and line number.
+ ;; Should be deactivated by default, because it is time
+ ;; consuming.
+; (let ((ffn (find-function-noselect (intern fn))))
+; (insert
+; (format
+; "%s:%d: "
+; (file-name-nondirectory (buffer-file-name (car ffn)))
+; (with-current-buffer (car ffn)
+; (1+ (count-lines (point-min) (cdr ffn)))))))
+ (insert (format "%s " fn)))
+ ;; The message.
+ (insert (apply 'format fmt-string args)))))
+
+(defvar tramp-message-show-message t
+ "Show Tramp message in the minibuffer.
+This variable is used to disable messages from `tramp-error'.
+The messages are visible anyway, because an error is raised.")
+
+(defsubst tramp-message (vec-or-proc level fmt-string &rest args)
+ "Emit a message depending on verbosity level.
+VEC-OR-PROC identifies the Tramp buffer to use. It can be either a
+vector or a process. LEVEL says to be quiet if `tramp-verbose' is
+less than LEVEL. The message is emitted only if `tramp-verbose' is
+greater than or equal to LEVEL.
+
+The message is also logged into the debug buffer when `tramp-verbose'
+is greater than or equal 4.
+
+Calls functions `message' and `tramp-debug-message' with FMT-STRING as
+control string and the remaining ARGS to actually emit the message (if
+applicable)."
+ (condition-case nil
+ (when (<= level tramp-verbose)
+ ;; Match data must be preserved!
+ (save-match-data
+ ;; Display only when there is a minimum level.
+ (when (and tramp-message-show-message (<= level 3))
+ (apply 'message
+ (concat
+ (cond
+ ((= level 0) "")
+ ((= level 1) "")
+ ((= level 2) "Warning: ")
+ (t "Tramp: "))
+ fmt-string)
+ args))
+ ;; Log only when there is a minimum level.
+ (when (>= tramp-verbose 4)
+ (when (and vec-or-proc
+ (processp vec-or-proc)
+ (buffer-name (process-buffer vec-or-proc)))
+ (with-current-buffer (process-buffer vec-or-proc)
+ ;; Translate proc to vec.
+ (setq vec-or-proc (tramp-dissect-file-name default-directory))))
+ (when (and vec-or-proc (vectorp vec-or-proc))
+ (apply 'tramp-debug-message
+ vec-or-proc
+ (concat (format "(%d) # " level) fmt-string)
+ args)))))
+ ;; Suppress all errors.
+ (error nil)))
+
+(defsubst tramp-error (vec-or-proc signal fmt-string &rest args)
+ "Emit an error.
+VEC-OR-PROC identifies the connection to use, SIGNAL is the
+signal identifier to be raised, remaining args passed to
+`tramp-message'. Finally, signal SIGNAL is raised."
+ (let (tramp-message-show-message)
+ (tramp-message
+ vec-or-proc 1 "%s"
+ (error-message-string
+ (list signal
+ (get signal 'error-message)
+ (apply 'format fmt-string args))))
+ (signal signal (list (apply 'format fmt-string args)))))
+
+(defsubst tramp-error-with-buffer
+ (buffer vec-or-proc signal fmt-string &rest args)
+ "Emit an error, and show BUFFER.
+If BUFFER is nil, show the connection buffer. Wait for 30\", or until
+an input event arrives. The other arguments are passed to `tramp-error'."
+ (save-window-excursion
+ (unwind-protect
+ (apply 'tramp-error vec-or-proc signal fmt-string args)
+ (when (and vec-or-proc
+ (not (zerop tramp-verbose))
+ (not (tramp-completion-mode-p)))
+ (let ((enable-recursive-minibuffers t))
+ (pop-to-buffer
+ (or (and (bufferp buffer) buffer)
+ (and (processp vec-or-proc) (process-buffer vec-or-proc))
+ (tramp-get-buffer vec-or-proc)))
+ (sit-for 30))))))
+
+(defmacro with-parsed-tramp-file-name (filename var &rest body)
+ "Parse a Tramp filename and make components available in the body.
+
+First arg FILENAME is evaluated and dissected into its components.
+Second arg VAR is a symbol. It is used as a variable name to hold
+the filename structure. It is also used as a prefix for the variables
+holding the components. For example, if VAR is the symbol `foo', then
+`foo' will be bound to the whole structure, `foo-method' will be bound to
+the method component, and so on for `foo-user', `foo-host', `foo-localname'.
+
+Remaining args are Lisp expressions to be evaluated (inside an implicit
+`progn').
+
+If VAR is nil, then we bind `v' to the structure and `method', `user',
+`host', `localname' to the components."
+ `(let* ((,(or var 'v) (tramp-dissect-file-name ,filename))
+ (,(if var (intern (concat (symbol-name var) "-method")) 'method)
+ (tramp-file-name-method ,(or var 'v)))
+ (,(if var (intern (concat (symbol-name var) "-user")) 'user)
+ (tramp-file-name-user ,(or var 'v)))
+ (,(if var (intern (concat (symbol-name var) "-host")) 'host)
+ (tramp-file-name-host ,(or var 'v)))
+ (,(if var (intern (concat (symbol-name var) "-localname")) 'localname)
+ (tramp-file-name-localname ,(or var 'v))))
+ ,@body))
+
+(put 'with-parsed-tramp-file-name 'lisp-indent-function 2)
+(put 'with-parsed-tramp-file-name 'edebug-form-spec '(form symbolp body))
+(font-lock-add-keywords 'emacs-lisp-mode '("\\<with-parsed-tramp-file-name\\>"))
+
+(defun tramp-progress-reporter-update (reporter &optional value)
+ (let* ((parameters (cdr reporter))
+ (message (aref parameters 3)))
+ (when (string-match message (or (current-message) ""))
+ (funcall 'progress-reporter-update reporter value))))
+
+(defmacro with-progress-reporter (vec level message &rest body)
+ "Executes BODY, spinning a progress reporter with MESSAGE.
+If LEVEL does not fit for visible messages, or if this is a
+nested call of the macro, there are only traces without a visible
+progress reporter."
+ `(let (pr tm)
+ (tramp-message ,vec ,level "%s..." ,message)
+ ;; We start a pulsing progress reporter after 3 seconds. Feature
+ ;; introduced in Emacs 24.1.
+ (when (and tramp-message-show-message
+ ;; Display only when there is a minimum level.
+ (<= ,level (min tramp-verbose 3)))
+ (condition-case nil
+ (setq pr (tramp-compat-funcall 'make-progress-reporter ,message)
+ tm (when pr
+ (run-at-time 3 0.1 'tramp-progress-reporter-update pr)))
(error nil)))
(unwind-protect
- ;; Execute the body.
+ ;; Execute the body. Unset `tramp-message-show-message' when
+ ;; the timer object is created, in order to suppress
+ ;; concurrent timers.
(let ((tramp-message-show-message
(and tramp-message-show-message (not tm))))
,@body)
(setq result nil)
;; This creates the file by side effect.
(set-file-times result)
- (set-file-modes result (tramp-octal-to-decimal "0700"))))
+ (set-file-modes result (tramp-compat-octal-to-decimal "0700"))))
;; Return the local part.
(with-parsed-tramp-file-name result nil localname)))
;; Windows registry.
(and (memq system-type '(cygwin windows-nt))
(zerop
- (tramp-local-call-process
+ (tramp-compat-call-process
"reg" nil nil nil "query" (nth 1 (car v)))))
;; Configuration file.
(file-exists-p (nth 1 (car v)))))
(unless ln
(tramp-error
l 'file-error
- "Making a symbolic link. ln(1) does not exist on the remote host."))
+ "Making a symbolic link. ln(1) does not exist on the remote host."))
;; Do the 'confirm if exists' thing.
(when (file-exists-p linkname)
l-localname)))))
(tramp-error
l 'file-already-exists "File %s already exists" l-localname)
- (tramp-compat-delete-file linkname 'force)))
+ (delete-file linkname)))
;; If FILENAME is a Tramp name, use just the localname component.
(when (tramp-tramp-file-p filename)
(tramp-file-name-localname
(tramp-dissect-file-name (expand-file-name filename)))))
+ (tramp-flush-file-property l (file-name-directory l-localname))
+ (tramp-flush-file-property l l-localname)
+
;; Right, they are on the same host, regardless of user, method, etc.
;; We now make the link on the remote machine. This will occur as the user
;; that FILENAME belongs to.
;; MUST-SUFFIX doesn't exist on XEmacs, so let it default to nil.
(unwind-protect
(load local-copy noerror t t)
- (tramp-compat-delete-file local-copy 'force)))))
+ (delete-file local-copy)))))
t)))
;; Localname manipulation functions that grok Tramp localnames...
(unless (zerop (tramp-send-command-and-check
v
(format "chmod %s %s"
- (tramp-decimal-to-octal mode)
+ (tramp-compat-decimal-to-octal mode)
(tramp-shell-quote-argument localname))))
;; FIXME: extract the proper text from chmod's stderr.
(tramp-error
;; We handle also the local part, because in older Emacsen,
;; without `set-file-times', this function is an alias for this.
;; We are local, so we don't need the UTC settings.
- (tramp-local-call-process
+ (tramp-compat-call-process
"touch" nil nil nil "-t"
(format-time-string "%Y%m%d%H%M.%S" time)
(tramp-shell-quote-argument filename)))))
;; `set-file-uid-gid'. On W32 "chown" might not work.
(let ((uid (or (and (integerp uid) uid) (tramp-get-local-uid 'integer)))
(gid (or (and (integerp gid) gid) (tramp-get-local-gid 'integer))))
- (tramp-local-call-process
+ (tramp-compat-call-process
"chown" nil nil nil
(format "%d:%d" uid gid) (tramp-shell-quote-argument filename))))))
If the file modes of FILENAME cannot be determined, return the
value of `default-file-modes', without execute permissions."
(or (file-modes filename)
- (logand (default-file-modes) (tramp-octal-to-decimal "0666"))))
+ (logand (default-file-modes) (tramp-compat-octal-to-decimal "0666"))))
(defun tramp-handle-file-directory-p (filename)
"Like `file-directory-p' for Tramp files."
(apply 'file-selinux-context (list filename))))
pr tm)
- (when (and (not ok-if-already-exists) (file-exists-p newname))
- (with-parsed-tramp-file-name (if t1 filename newname) nil
+ (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)))
+ v 'file-already-exists "File %s already exists" newname))
- (with-parsed-tramp-file-name (if t1 filename newname) nil
(with-progress-reporter
- v 0 (format "Transferring %s to %s" filename newname)
+ v 0 (format "%s %s to %s"
+ (if (eq op 'copy) "Copying" "Renaming")
+ filename newname)
- (cond
- ;; Both are Tramp files.
- ((and t1 t2)
- (with-parsed-tramp-file-name filename v1
- (with-parsed-tramp-file-name newname v2
- (cond
- ;; Shortcut: if method, host, user are the same for both
- ;; files, we invoke `cp' or `mv' on the remote host
- ;; directly.
- ((tramp-equal-remote filename newname)
- (tramp-do-copy-or-rename-file-directly
- op filename newname
- ok-if-already-exists keep-date preserve-uid-gid))
-
- ;; Try out-of-band operation.
- ((tramp-method-out-of-band-p
- v1 (nth 7 (file-attributes filename)))
- (tramp-do-copy-or-rename-file-out-of-band
- op filename newname keep-date))
-
- ;; No shortcut was possible. So we copy the
- ;; file first. If the operation was `rename', we go
- ;; back and delete the original file (if the copy was
- ;; successful). The approach is simple-minded: we
- ;; create a new buffer, insert the contents of the
- ;; source file into it, then write out the buffer to
- ;; the target file. The advantage is that it doesn't
- ;; matter which filename handlers are used for the
- ;; source and target file.
- (t
- (tramp-do-copy-or-rename-file-via-buffer
- op filename newname keep-date))))))
+ (cond
+ ;; Both are Tramp files.
+ ((and t1 t2)
+ (with-parsed-tramp-file-name filename v1
+ (with-parsed-tramp-file-name newname v2
+ (cond
+ ;; Shortcut: if method, host, user are the same for
+ ;; both files, we invoke `cp' or `mv' on the remote
+ ;; host directly.
+ ((tramp-equal-remote filename newname)
+ (tramp-do-copy-or-rename-file-directly
+ op filename newname
+ ok-if-already-exists keep-date preserve-uid-gid))
+
+ ;; Try out-of-band operation.
+ ((tramp-method-out-of-band-p
+ v1 (nth 7 (file-attributes filename)))
+ (tramp-do-copy-or-rename-file-out-of-band
+ op filename newname keep-date))
+
+ ;; No shortcut was possible. So we copy the file
+ ;; first. If the operation was `rename', we go back
+ ;; and delete the original file (if the copy was
+ ;; successful). The approach is simple-minded: we
+ ;; create a new buffer, insert the contents of the
+ ;; source file into it, then write out the buffer to
+ ;; the target file. The advantage is that it doesn't
+ ;; matter which filename handlers are used for the
+ ;; source and target file.
+ (t
+ (tramp-do-copy-or-rename-file-via-buffer
+ op filename newname keep-date))))))
+
+ ;; One file is a Tramp file, the other one is local.
+ ((or t1 t2)
+ (cond
+ ;; Fast track on local machine.
+ ((tramp-local-host-p v)
+ (tramp-do-copy-or-rename-file-directly
+ op filename newname
+ ok-if-already-exists keep-date preserve-uid-gid))
- ;; One file is a Tramp file, the other one is local.
- ((or t1 t2)
- (cond
- ;; Fast track on local machine.
- ((tramp-local-host-p v)
- (tramp-do-copy-or-rename-file-directly
- op filename newname
- ok-if-already-exists keep-date preserve-uid-gid))
-
- ;; If the Tramp file has an out-of-band method, the corresponding
- ;; copy-program can be invoked.
- ((tramp-method-out-of-band-p v (nth 7 (file-attributes filename)))
- (tramp-do-copy-or-rename-file-out-of-band
- op filename newname keep-date))
-
- ;; Use the inline method via a Tramp buffer.
- (t (tramp-do-copy-or-rename-file-via-buffer
- op filename newname keep-date))))
-
- (t
- ;; One of them must be a Tramp file.
- (error "Tramp implementation says this cannot happen")))
-
- ;; Handle `preserve-selinux-context'.
- (when context (apply 'set-file-selinux-context (list newname context)))
-
- ;; In case of `rename', we must flush the cache of the source file.
- (when (and t1 (eq op 'rename))
- (with-parsed-tramp-file-name filename v1
- (tramp-flush-file-property v1 (file-name-directory localname))
- (tramp-flush-file-property v1 localname)))
-
- ;; When newname did exist, we have wrong cached values.
- (when t2
- (with-parsed-tramp-file-name newname v2
- (tramp-flush-file-property v2 (file-name-directory localname))
- (tramp-flush-file-property v2 localname)))))))
+ ;; If the Tramp file has an out-of-band method, the
+ ;; corresponding copy-program can be invoked.
+ ((tramp-method-out-of-band-p v (nth 7 (file-attributes filename)))
+ (tramp-do-copy-or-rename-file-out-of-band
+ op filename newname keep-date))
+
+ ;; Use the inline method via a Tramp buffer.
+ (t (tramp-do-copy-or-rename-file-via-buffer
+ op filename newname keep-date))))
+
+ (t
+ ;; One of them must be a Tramp file.
+ (error "Tramp implementation says this cannot happen")))
+
+ ;; Handle `preserve-selinux-context'.
+ (when context (apply 'set-file-selinux-context (list newname context)))
+
+ ;; In case of `rename', we must flush the cache of the source file.
+ (when (and t1 (eq op 'rename))
+ (with-parsed-tramp-file-name filename v1
+ (tramp-flush-file-property v1 (file-name-directory localname))
+ (tramp-flush-file-property v1 localname)))
+
+ ;; When newname did exist, we have wrong cached values.
+ (when t2
+ (with-parsed-tramp-file-name newname v2
+ (tramp-flush-file-property v2 (file-name-directory localname))
+ (tramp-flush-file-property v2 localname)))))))
(defun tramp-do-copy-or-rename-file-via-buffer (op filename newname keep-date)
"Use an Emacs buffer to copy or rename a file.
;; Set the mode.
(set-file-modes newname (tramp-default-file-modes filename))
;; If the operation was `rename', delete the original file.
- (unless (eq op 'copy) (tramp-compat-delete-file filename 'force)))
+ (unless (eq op 'copy) (delete-file filename)))
(defun tramp-do-copy-or-rename-file-directly
(op filename newname ok-if-already-exists keep-date preserve-uid-gid)
;; Since this does not work reliable, we also
;; give read permissions.
(set-file-modes
- (concat prefix tmpfile) (tramp-octal-to-decimal "0777"))
+ (concat prefix tmpfile)
+ (tramp-compat-octal-to-decimal "0777"))
(tramp-set-file-uid-gid
(concat prefix tmpfile)
(tramp-get-local-uid 'integer)
;; We must change the ownership as local user.
;; Since this does not work reliable, we also
;; give read permissions.
- (set-file-modes tmpfile (tramp-octal-to-decimal "0777"))
+ (set-file-modes
+ tmpfile (tramp-compat-octal-to-decimal "0777"))
(tramp-set-file-uid-gid
tmpfile
(tramp-get-remote-uid v 'integer)
;; Save exit.
(condition-case nil
- (tramp-compat-delete-file tmpfile 'force)
+ (delete-file tmpfile)
(error)))))))))
;; Set the time and mode. Mask possible errors.
(if dir-flag
(tramp-compat-delete-directory
(expand-file-name ".." tmpfile) 'recursive)
- (tramp-compat-delete-file tmpfile 'force))
+ (delete-file tmpfile))
(error))))
;; Expand hops. Might be necessary for gateway methods.
;; If the operation was `rename', delete the original file.
(unless (eq op 'copy)
(if (file-regular-p filename)
- (tramp-compat-delete-file filename 'force)
+ (delete-file filename)
(tramp-compat-delete-directory filename 'recursive))))))
(defun tramp-handle-make-directory (dir &optional parents)
(tramp-shell-quote-argument localname))))
(tramp-error v 'file-error "Couldn't delete %s" directory))))
-(defun tramp-handle-delete-file (filename &optional force)
+(defun tramp-handle-delete-file (filename &optional trash)
"Like `delete-file' for Tramp files."
(setq filename (expand-file-name filename))
(with-parsed-tramp-file-name filename nil
(tramp-flush-file-property v (file-name-directory localname))
(tramp-flush-file-property v localname)
- (unless (zerop (tramp-send-command-and-check
- v
- (format "rm -f %s"
- (tramp-shell-quote-argument localname))))
+ (unless
+ (zerop
+ (tramp-send-command-and-check
+ v (format "%s %s"
+ (or (and trash (tramp-get-remote-trash v)) "rm -f")
+ (tramp-shell-quote-argument localname))))
(tramp-error v 'file-error "Couldn't delete %s" filename))))
;; Dired.
;; DIR-P is valid for XEmacs only.
(with-parsed-tramp-file-name
(if (or dir-p (file-directory-p dir)) dir (file-name-directory dir)) nil
- (tramp-flush-file-property v localname)))
+ (tramp-flush-directory-property v localname)))
;; Pacify byte-compiler. The function is needed on XEmacs only. I'm
;; not sure at all that this is the right way to do it, but let's hope
(forward-line -2)
(when (looking-at "//SUBDIRED//")
(forward-line -1))
- (when (looking-at "//DIRED//")
- (let ((end (tramp-compat-line-end-position))
- (linebeg (point)))
+ (when (looking-at "//DIRED//\\s-+")
+ (let ((databeg (match-end 0))
+ (end (tramp-compat-line-end-position)))
;; Now read the numeric positions of file names.
- (goto-char linebeg)
- (forward-word 1)
- (forward-char 3)
+ (goto-char databeg)
(while (< (point) end)
(let ((start (+ beg (read (current-buffer))))
(end (+ beg (read (current-buffer)))))
(with-parsed-tramp-file-name default-directory nil
(tramp-find-executable v command (tramp-get-remote-path v) t)))
+(defun tramp-process-sentinel (proc event)
+ "Flush file caches."
+ (unless (memq (process-status proc) '(run open))
+ (let ((vec (tramp-get-connection-property proc "vector" nil)))
+ (when vec
+ (tramp-message vec 5 "Sentinel called: `%s' `%s'" proc event)
+ (tramp-flush-directory-property vec "")))))
+
;; We use BUFFER also as connection buffer during setup. Because of
;; this, its original contents must be saved, and restored once
;; connection has been setup.
(defun tramp-handle-start-file-process (name buffer program &rest args)
"Like `start-file-process' for Tramp files."
(with-parsed-tramp-file-name default-directory nil
- (unless (stringp program)
- (tramp-error
- v 'file-error "pty association is not supported for `%s'" name))
(unwind-protect
- (let ((command (format "cd %s; exec %s"
- (tramp-shell-quote-argument localname)
- (mapconcat 'tramp-shell-quote-argument
- (cons program args) " ")))
+ ;; When PROGRAM is nil, we just provide a tty.
+ (let ((command
+ (when (stringp program)
+ (format "cd %s; exec %s"
+ (tramp-shell-quote-argument localname)
+ (mapconcat 'tramp-shell-quote-argument
+ (cons program args) " "))))
+ (tramp-process-connection-type
+ (or (null program) tramp-process-connection-type))
(name1 name)
(i 0))
(unless buffer
(with-current-buffer (tramp-get-connection-buffer v)
(clear-visited-file-modtime)
(narrow-to-region (point-max) (point-max)))
- ;; Send the command. `tramp-send-command' opens a new
- ;; connection.
- (tramp-send-command v command nil t) ; nooutput
- ;; Set query flag for this process.
- (tramp-set-process-query-on-exit-flag
- (tramp-get-connection-process v) t)
- ;; Return process.
- (tramp-get-connection-process v))
+ (if command
+ ;; Send the command.
+ (tramp-send-command v command nil t) ; nooutput
+ ;; Check, whether a pty is associated.
+ (tramp-maybe-open-connection v)
+ (unless (process-get (tramp-get-connection-process v) 'remote-tty)
+ (tramp-error
+ v 'file-error "pty association is not supported for `%s'" name)))
+ (let ((p (tramp-get-connection-process v)))
+ ;; Set sentinel and query flag for this process.
+ (tramp-set-connection-property p "vector" v)
+ (set-process-sentinel p 'tramp-process-sentinel)
+ (tramp-set-process-query-on-exit-flag p t)
+ ;; Return process.
+ p))
;; Save exit.
(with-current-buffer (tramp-get-connection-buffer v)
(if (string-match tramp-temp-buffer-name (buffer-name))
(setq outbuf (current-buffer))))
(when stderr (setq command (format "%s 2>%s" command stderr)))
- ;; Send the command. It might not return in time, so we protect it.
+ ;; Send the command. It might not return in time, so we protect
+ ;; it. Call it in a subshell, in order to preserve working
+ ;; directory.
(condition-case nil
(unwind-protect
(setq ret
v (format "\\cd %s; %s"
(tramp-shell-quote-argument localname)
command)
- nil t))
+ t t))
;; We should show the output anyway.
(when outbuf
(with-current-buffer outbuf
;; Cleanup. We remove all file cache values for the connection,
;; because the remote process could have changed them.
- (when tmpinput (tramp-compat-delete-file tmpinput 'force))
+ (when tmpinput (delete-file tmpinput))
;; `process-file-side-effects' has been introduced with GNU
;; Emacs 23.2. If set to `nil', no remote file will be changed
(keyboard-quit)
ret))))
-(defun tramp-local-call-process
- (program &optional infile destination display &rest args)
- "Calls `call-process' on the local host.
-This is needed because for some Emacs flavors Tramp has
-defadviced `call-process' to behave like `process-file'. The
-Lisp error raised when PROGRAM is nil is trapped also, returning 1."
- (let ((default-directory
- (if (file-remote-p default-directory)
- (tramp-compat-temporary-file-directory)
- default-directory)))
- (if (executable-find program)
- (apply 'call-process program infile destination display args)
- 1)))
-
(defun tramp-handle-call-process-region
(start end program &optional delete buffer display &rest args)
"Like `call-process-region' for Tramp files."
(when delete (delete-region start end))
(unwind-protect
(apply 'call-process program tmpfile buffer display args)
- (tramp-compat-delete-file tmpfile 'force))))
+ (delete-file tmpfile))))
(defun tramp-handle-shell-command
(command &optional output-buffer error-buffer)
(let* ((asynchronous (string-match "[ \t]*&[ \t]*\\'" command))
;; We cannot use `shell-file-name' and `shell-command-switch',
;; they are variables of the local host.
- (args (list "/bin/sh" "-c" (substring command 0 asynchronous)))
+ (args (list
+ (tramp-get-method-parameter
+ (tramp-file-name-method
+ (tramp-dissect-file-name default-directory))
+ 'tramp-remote-sh)
+ "-c" (substring command 0 asynchronous)))
current-buffer-p
(output-buffer
(cond
;; Display output.
(pop-to-buffer output-buffer)
(setq mode-line-process '(":%s"))
- (require 'shell) (shell-mode))
+ (shell-mode))
(prog1
;; Run the process.
(when (listp buffer)
(with-current-buffer error-buffer
(insert-file-contents (cadr buffer)))
- (tramp-compat-delete-file (cadr buffer) 'force))
+ (delete-file (cadr buffer)))
(if current-buffer-p
;; This is like exchange-point-and-mark, but doesn't
;; activate the mark. It is cleaner to avoid activation,
(rem-enc
(save-excursion
(with-progress-reporter
- v 5 (format "Encoding remote file %s" filename)
+ v 3 (format "Encoding remote file %s" filename)
(tramp-barf-unless-okay
v (format rem-enc (tramp-shell-quote-argument localname))
"Encoding remote file failed"))
(unwind-protect
(tramp-call-local-coding-command
loc-dec tmpfile2 tmpfile)
- (tramp-compat-delete-file tmpfile2 'force)))))
+ (delete-file tmpfile2)))))
;; Set proper permissions.
(set-file-modes tmpfile (tramp-default-file-modes filename))
;; Error handling.
((error quit)
- (tramp-compat-delete-file tmpfile 'force)
+ (delete-file tmpfile)
(signal (car err) (cdr err))))
(run-hooks 'tramp-handle-file-local-copy-hook)
;; When the file is not readable for the owner, it
;; cannot be inserted, even it is redable for the group
;; or for everybody.
- (set-file-modes local-copy (tramp-octal-to-decimal "0600"))
+ (set-file-modes local-copy (tramp-compat-octal-to-decimal "0600"))
(when (and (null remote-copy)
(tramp-get-method-parameter
(set-buffer-modified-p nil))
(when (and (stringp local-copy)
(or remote-copy (null tramp-temp-buffer-file-name)))
- (tramp-compat-delete-file local-copy 'force))
+ (delete-file local-copy))
(when (stringp remote-copy)
- (tramp-compat-delete-file
- (tramp-make-tramp-file-name method user host remote-copy)
- 'force)))))
+ (delete-file
+ (tramp-make-tramp-file-name method user host remote-copy))))))
;; Result.
(list (expand-file-name filename)
(list start end tmpfile append 'no-message lockname confirm))
((error quit)
(setq tramp-temp-buffer-file-name nil)
- (tramp-compat-delete-file tmpfile 'force)
+ (delete-file tmpfile)
(signal (car err) (cdr err))))
;; Now, `last-coding-system-used' has the right value. Remember it.
;; Ensure, that it is still readable.
(when modes
(set-file-modes
- tmpfile (logior (or modes 0) (tramp-octal-to-decimal "0400"))))
+ tmpfile
+ (logior (or modes 0) (tramp-compat-octal-to-decimal "0400"))))
;; This is a bit lengthy due to the different methods
;; possible for file transfer. First, we check whether the
(copy-file tmpfile filename t)
((error quit)
(setq tramp-temp-buffer-file-name nil)
- (tramp-compat-delete-file tmpfile 'force)
+ (delete-file tmpfile)
(signal (car err) (cdr err)))))
(setq tramp-temp-buffer-file-name nil)
;; Don't rename, in order to keep context in SELinux.
(unwind-protect
(copy-file tmpfile filename t)
- (tramp-compat-delete-file tmpfile 'force))))
+ (delete-file tmpfile))))
;; Use inline file transfer.
(rem-dec
(erase-buffer)
(and
;; cksum runs locally, if possible.
- (zerop (tramp-local-call-process "cksum" tmpfile t))
+ (zerop (tramp-compat-call-process "cksum" tmpfile t))
;; cksum runs remotely.
(zerop
(tramp-send-command-and-check
filename rem-dec)))))
;; Save exit.
- (tramp-compat-delete-file tmpfile 'force)))
+ (delete-file tmpfile)))
;; That's not expected.
(t
;; any other remote command.
(defun tramp-handle-vc-registered (file)
"Like `vc-registered' for Tramp files."
- (with-parsed-tramp-file-name file nil
-
- ;; There could be new files, created by the vc backend. We cannot
- ;; reuse the old cache entries, therefore.
- (let (tramp-vc-registered-file-names
- (tramp-cache-inhibit-cache (current-time))
- (file-name-handler-alist
- `((,tramp-file-name-regexp . tramp-vc-file-name-handler))))
-
- ;; Here we collect only file names, which need an operation.
- (tramp-run-real-handler 'vc-registered (list file))
- (tramp-message v 10 "\n%s" tramp-vc-registered-file-names)
-
- ;; Send just one command, in order to fill the cache.
- (when tramp-vc-registered-file-names
- (tramp-maybe-send-script
- v
- (format tramp-vc-registered-read-file-names
- (tramp-get-file-exists-command v)
- (format "%s -r" (tramp-get-test-command v)))
- "tramp_vc_registered_read_file_names")
-
- (dolist
- (elt
- (tramp-send-command-and-read
- v
- (format
- "tramp_vc_registered_read_file_names %s"
- (mapconcat 'tramp-shell-quote-argument
- tramp-vc-registered-file-names
- " "))))
-
- (tramp-set-file-property v (car elt) (cadr elt) (cadr (cdr elt))))))
-
- ;; Second run. Now all `file-exists-p' or `file-readable-p' calls
- ;; shall be answered from the file cache.
- ;; We unset `process-file-side-effects' in order to keep the cache
- ;; when `process-file' calls appear.
- (let (process-file-side-effects)
- (tramp-run-real-handler 'vc-registered (list file)))))
+ (with-temp-message ""
+ (with-parsed-tramp-file-name file nil
+ (with-progress-reporter
+ v 3 (format "Checking `vc-registered' for %s" file)
+
+ ;; There could be new files, created by the vc backend. We
+ ;; cannot reuse the old cache entries, therefore.
+ (let (tramp-vc-registered-file-names
+ (tramp-cache-inhibit-cache (current-time))
+ (file-name-handler-alist
+ `((,tramp-file-name-regexp . tramp-vc-file-name-handler))))
+
+ ;; Here we collect only file names, which need an operation.
+ (tramp-run-real-handler 'vc-registered (list file))
+ (tramp-message v 10 "\n%s" tramp-vc-registered-file-names)
+
+ ;; Send just one command, in order to fill the cache.
+ (when tramp-vc-registered-file-names
+ (tramp-maybe-send-script
+ v
+ (format tramp-vc-registered-read-file-names
+ (tramp-get-file-exists-command v)
+ (format "%s -r" (tramp-get-test-command v)))
+ "tramp_vc_registered_read_file_names")
+
+ (dolist
+ (elt
+ (tramp-send-command-and-read
+ v
+ (format
+ "tramp_vc_registered_read_file_names <<'EOF'\n%s\nEOF\n"
+ (mapconcat 'tramp-shell-quote-argument
+ tramp-vc-registered-file-names
+ "\n"))))
+
+ (tramp-set-file-property
+ v (car elt) (cadr elt) (cadr (cdr elt))))))
+
+ ;; Second run. Now all `file-exists-p' or `file-readable-p'
+ ;; calls shall be answered from the file cache. We unset
+ ;; `process-file-side-effects' in order to keep the cache when
+ ;; `process-file' calls appear.
+ (let (process-file-side-effects)
+ (tramp-run-real-handler 'vc-registered (list file)))))))
;;;###autoload
(progn (defun tramp-run-real-handler (operation args)
;; XEmacs only.
'dired-print-file 'dired-shell-call-process
;; nowhere yet.
- 'executable-find 'start-process 'call-process))
+ 'executable-find 'start-process
+ 'call-process 'call-process-region))
default-directory)
;; Unknown file primitive.
(t (error "unknown file I/O primitive: %s" operation))))
(if foreign
(condition-case err
(apply foreign operation args)
+
+ ;; Trace that somebody has interrupted the
+ ;; operation.
+ (quit
+ (let (tramp-message-show-message)
+ (tramp-message
+ v 1 "Interrupt received in operation %s"
+ (append (list operation) args)))
+ ;; Propagate the quit signal.
+ (signal (car err) (cdr err)))
+
+ ;; When we are in completion mode, some failed
+ ;; operations shall return at least a default value
+ ;; in order to give the user a chance to correct the
+ ;; file name in the minibuffer.
(error
(cond
- ;; When we are in completion mode, some failed
- ;; operations shall return at least a default
- ;; value in order to give the user a chance to
- ;; correct the file name in the minibuffer.
((and completion (zerop (length localname))
(memq operation '(file-exists-p file-directory-p)))
t)
filename)
;; Propagate the error.
(t (signal (car err) (cdr err))))))
+
;; Nothing to do for us.
(tramp-run-real-handler operation args)))))
;; Tramp file name syntax. Maybe another variable should be introduced
;; overwriting this check in such cases. Or we change Tramp file name
;; syntax in order to avoid ambiguities, like in XEmacs ...
+;;;###tramp-autoload
(defun tramp-completion-mode-p ()
"Check, whether method / user name / host name completion is active."
(or
(let ((default-directory (tramp-compat-temporary-file-directory))
res)
(with-temp-buffer
- (when (zerop (tramp-local-call-process "reg" nil t nil "query" registry))
+ (when (zerop (tramp-compat-call-process "reg" nil t nil "query" registry))
(goto-char (point-min))
(while (not (eobp))
(push (tramp-parse-putty-group registry) res))))
"Run `test' on the remote system, given a SWITCH and a FILENAME.
Returns the exit code of the `test' program."
(with-parsed-tramp-file-name filename nil
- (tramp-send-command-and-check
- v
- (format
- "%s %s %s"
- (tramp-get-test-command v)
- switch
- (tramp-shell-quote-argument localname)))))
-
-(defun tramp-run-test2 (format-string file1 file2)
- "Run `test'-like program on the remote system, given FILE1, FILE2.
-FORMAT-STRING contains the program name, switches, and place holders.
-Returns the exit code of the `test' program. Barfs if the methods,
-hosts, or files, disagree."
- (unless (tramp-equal-remote file1 file2)
- (with-parsed-tramp-file-name (if (tramp-tramp-file-p file1) file1 file2) nil
- (tramp-error
- v 'file-error
- "tramp-run-test2 only implemented for same method, user, host")))
- (with-parsed-tramp-file-name file1 v1
- (with-parsed-tramp-file-name file1 v2
- (tramp-send-command-and-check
- v1
- (format format-string
- (tramp-shell-quote-argument v1-localname)
- (tramp-shell-quote-argument v2-localname))))))
-
-(defun tramp-buffer-name (vec)
- "A name for the connection buffer VEC."
- ;; We must use `tramp-file-name-real-host', because for gateway
- ;; methods the default port will be expanded later on, which would
- ;; tamper the name.
- (let ((method (tramp-file-name-method vec))
- (user (tramp-file-name-user vec))
- (host (tramp-file-name-real-host vec)))
- (if (not (zerop (length user)))
- (format "*tramp/%s %s@%s*" method user host)
- (format "*tramp/%s %s*" method host))))
-
-(defun tramp-delete-temp-file-function ()
- "Remove temporary files related to current buffer."
- (when (stringp tramp-temp-buffer-file-name)
- (condition-case nil
- (tramp-compat-delete-file tramp-temp-buffer-file-name 'force)
- (error nil))))
-
-(add-hook 'kill-buffer-hook 'tramp-delete-temp-file-function)
-(add-hook 'tramp-cache-unload-hook
- (lambda ()
- (remove-hook 'kill-buffer-hook
- 'tramp-delete-temp-file-function)))
-
-(defun tramp-get-buffer (vec)
- "Get the connection buffer to be used for VEC."
- (or (get-buffer (tramp-buffer-name vec))
- (with-current-buffer (get-buffer-create (tramp-buffer-name vec))
- (setq buffer-undo-list t)
- (setq default-directory
- (tramp-make-tramp-file-name
- (tramp-file-name-method vec)
- (tramp-file-name-user vec)
- (tramp-file-name-host vec)
- "/"))
- (current-buffer))))
-
-(defun tramp-get-connection-buffer (vec)
- "Get the connection buffer to be used for VEC.
-In case a second asynchronous communication has been started, it is different
-from `tramp-get-buffer'."
- (or (tramp-get-connection-property vec "process-buffer" nil)
- (tramp-get-buffer vec)))
-
-(defun tramp-get-connection-process (vec)
- "Get the connection process to be used for VEC.
-In case a second asynchronous communication has been started, it is different
-from the default one."
- (get-process
- (or (tramp-get-connection-property vec "process-name" nil)
- (tramp-buffer-name vec))))
-
-(defun tramp-debug-buffer-name (vec)
- "A name for the debug buffer for VEC."
- ;; We must use `tramp-file-name-real-host', because for gateway
- ;; methods the default port will be expanded later on, which would
- ;; tamper the name.
- (let ((method (tramp-file-name-method vec))
- (user (tramp-file-name-user vec))
- (host (tramp-file-name-real-host vec)))
- (if (not (zerop (length user)))
- (format "*debug tramp/%s %s@%s*" method user host)
- (format "*debug tramp/%s %s*" method host))))
-
-(defconst tramp-debug-outline-regexp
- "[0-9]+:[0-9]+:[0-9]+\\.[0-9]+ [a-z0-9-]+ (\\([0-9]+\\)) #")
+ (tramp-send-command-and-check
+ v
+ (format
+ "%s %s %s"
+ (tramp-get-test-command v)
+ switch
+ (tramp-shell-quote-argument localname)))))
-(defun tramp-get-debug-buffer (vec)
- "Get the debug buffer for VEC."
- (with-current-buffer
- (get-buffer-create (tramp-debug-buffer-name vec))
- (when (bobp)
- (setq buffer-undo-list t)
- ;; Activate `outline-mode'. This runs `text-mode-hook' and
- ;; `outline-mode-hook'. We must prevent that local processes
- ;; die. Yes: I've seen `flyspell-mode', which starts "ispell".
- ;; Furthermore, `outline-regexp' must have the correct value
- ;; already, because it is used by `font-lock-compile-keywords'.
- (let ((default-directory (tramp-compat-temporary-file-directory))
- (outline-regexp tramp-debug-outline-regexp))
- (outline-mode))
- (set (make-local-variable 'outline-regexp) tramp-debug-outline-regexp)
- (set (make-local-variable 'outline-level) 'tramp-outline-level))
- (current-buffer)))
+(defun tramp-run-test2 (format-string file1 file2)
+ "Run `test'-like program on the remote system, given FILE1, FILE2.
+FORMAT-STRING contains the program name, switches, and place holders.
+Returns the exit code of the `test' program. Barfs if the methods,
+hosts, or files, disagree."
+ (unless (tramp-equal-remote file1 file2)
+ (with-parsed-tramp-file-name (if (tramp-tramp-file-p file1) file1 file2) nil
+ (tramp-error
+ v 'file-error
+ "tramp-run-test2 only implemented for same method, user, host")))
+ (with-parsed-tramp-file-name file1 v1
+ (with-parsed-tramp-file-name file1 v2
+ (tramp-send-command-and-check
+ v1
+ (format format-string
+ (tramp-shell-quote-argument v1-localname)
+ (tramp-shell-quote-argument v2-localname))))))
-(defun tramp-outline-level ()
- "Return the depth to which a statement is nested in the outline.
-Point must be at the beginning of a header line.
+(defun tramp-delete-temp-file-function ()
+ "Remove temporary files related to current buffer."
+ (when (stringp tramp-temp-buffer-file-name)
+ (condition-case nil
+ (delete-file tramp-temp-buffer-file-name)
+ (error nil))))
-The outline level is equal to the verbosity of the Tramp message."
- (1+ (string-to-number (match-string 1))))
+(add-hook 'kill-buffer-hook 'tramp-delete-temp-file-function)
+(add-hook 'tramp-cache-unload-hook
+ (lambda ()
+ (remove-hook 'kill-buffer-hook
+ 'tramp-delete-temp-file-function)))
(defun tramp-find-executable
(vec progname dirlist &optional ignore-tilde ignore-path)
vec 'file-error "Couldn't find command to check if file exists"))
result))
-;; CCC test ksh or bash found for tilde expansion?
+(defun tramp-open-shell (vec shell)
+ "Opens shell SHELL."
+ (with-progress-reporter vec 5 (format "Opening remote shell `%s'" shell)
+ ;; Find arguments for this shell.
+ (let ((tramp-end-of-output tramp-initial-end-of-output)
+ (alist tramp-sh-extra-args)
+ item extra-args)
+ (while (and alist (null extra-args))
+ (setq item (pop alist))
+ (when (string-match (car item) shell)
+ (setq extra-args (cdr item))))
+ (when extra-args (setq shell (concat shell " " extra-args)))
+ (tramp-send-command
+ vec (format "exec env ENV='' PROMPT_COMMAND='' PS1=%s PS2='' PS3='' %s"
+ (shell-quote-argument tramp-end-of-output) shell)
+ t))
+ ;; Setting prompts.
+ (tramp-send-command
+ vec (format "PS1=%s" (shell-quote-argument tramp-end-of-output)) t)
+ (tramp-send-command vec "PS2=''" t)
+ (tramp-send-command vec "PS3=''" t)
+ (tramp-send-command vec "PROMPT_COMMAND=''" t)))
+
(defun tramp-find-shell (vec)
"Opens a shell on the remote host which groks tilde expansion."
(unless (tramp-get-connection-property vec "remote-shell" nil)
(tramp-error
vec 'file-error
"Couldn't find a shell which groks tilde expansion"))
- ;; Find arguments for this shell.
- (let ((alist tramp-sh-extra-args)
- item extra-args)
- (while (and alist (null extra-args))
- (setq item (pop alist))
- (when (string-match (car item) shell)
- (setq extra-args (cdr item))))
- (when extra-args (setq shell (concat shell " " extra-args))))
(tramp-message
vec 5 "Starting remote shell `%s' for tilde expansion" shell)
- (let ((tramp-end-of-output tramp-initial-end-of-output))
- (tramp-send-command
- vec
- (format "PROMPT_COMMAND='' PS1=%s PS2='' PS3='' exec %s"
- (shell-quote-argument tramp-end-of-output) shell)
- t))
- ;; Setting prompts.
- (with-progress-reporter vec 5 (format "Setting remote shell prompt")
- (tramp-send-command
- vec (format "PS1=%s" (shell-quote-argument tramp-end-of-output)) t)
- (tramp-send-command vec "PS2=''" t)
- (tramp-send-command vec "PS3=''" t)
- (tramp-send-command vec "PROMPT_COMMAND=''" t)))
+ (tramp-open-shell vec shell))
(t (tramp-message
vec 5 "Remote `%s' groks tilde expansion, good"
- (tramp-get-method-parameter
- (tramp-file-name-method vec) 'tramp-remote-sh))
- (tramp-set-connection-property
- vec "remote-shell"
- (tramp-get-method-parameter
- (tramp-file-name-method vec) 'tramp-remote-sh))))))))
+ (tramp-set-connection-property
+ vec "remote-shell"
+ (tramp-get-method-parameter
+ (tramp-file-name-method vec) 'tramp-remote-sh)))))))))
;; ------------------------------------------------------------
;; -- Functions for establishing connection --
"Query the user for a password."
(with-current-buffer (process-buffer proc)
(tramp-check-for-regexp proc tramp-password-prompt-regexp)
- (tramp-message vec 3 "Sending %s" (match-string 1)))
- (tramp-enter-password proc))
+ (tramp-message vec 3 "Sending %s" (match-string 1))
+ (tramp-enter-password proc)
+ ;; Hide password prompt.
+ (narrow-to-region (point-max) (point-max))))
(defun tramp-action-succeed (proc vec)
"Signal success in finding shell prompt."
(defun tramp-process-actions (proc vec actions &optional timeout)
"Perform actions until success or TIMEOUT."
- ;; Enable auth-source and password-cache.
- (tramp-set-connection-property vec "first-password-request" t)
- (let (exit)
- (while (not exit)
- (tramp-message proc 3 "Waiting for prompts from remote shell")
- (setq exit
- (catch 'tramp-action
- (if timeout
- (with-timeout (timeout)
- (tramp-process-one-action proc vec actions))
- (tramp-process-one-action proc vec actions)))))
- (with-current-buffer (tramp-get-connection-buffer vec)
- (tramp-message vec 6 "\n%s" (buffer-string)))
- (unless (eq exit 'ok)
- (tramp-clear-passwd vec)
- (tramp-error-with-buffer
- nil vec 'file-error
- (cond
- ((eq exit 'permission-denied) "Permission denied")
- ((eq exit 'process-died) "Process died")
- (t "Login failed"))))))
+ ;; Preserve message for `progress-reporter'.
+ (with-temp-message ""
+ ;; Enable auth-source and password-cache.
+ (tramp-set-connection-property vec "first-password-request" t)
+ (let (exit)
+ (while (not exit)
+ (tramp-message proc 3 "Waiting for prompts from remote shell")
+ (setq exit
+ (catch 'tramp-action
+ (if timeout
+ (with-timeout (timeout)
+ (tramp-process-one-action proc vec actions))
+ (tramp-process-one-action proc vec actions)))))
+ (with-current-buffer (tramp-get-connection-buffer vec)
+ (widen)
+ (tramp-message vec 6 "\n%s" (buffer-string)))
+ (unless (eq exit 'ok)
+ (tramp-clear-passwd vec)
+ (tramp-error-with-buffer
+ nil vec 'file-error
+ (cond
+ ((eq exit 'permission-denied) "Permission denied")
+ ((eq exit 'process-died) "Process died")
+ (t "Login failed")))))))
;; Utility functions.
;; way, we avoid the startup file clobbering $PS1. $PROMP_COMMAND
;; is another way to set the prompt in /bin/bash, it must be
;; discarded as well.
- (tramp-send-command
+ (tramp-open-shell
vec
- (format
- "exec env ENV='' PROMPT_COMMAND='' PS1=%s PS2='' PS3='' %s"
- (shell-quote-argument tramp-end-of-output)
- (tramp-get-method-parameter
- (tramp-file-name-method vec) 'tramp-remote-sh))
- t)
+ (tramp-get-method-parameter (tramp-file-name-method vec) 'tramp-remote-sh))
;; Disable echo.
(tramp-message vec 5 "Setting up remote shell environment")
;; stty, instead.
(tramp-send-command vec "stty -onlcr" t))))
;; Dump stty settings in the traces.
- (when (>= tramp-verbose 10)
+ (when (>= tramp-verbose 9)
(tramp-send-command vec "stty -a" t))
(tramp-send-command vec "set +o vi +o emacs" t)
;; "echo $?" part if the "test" part has an error. In particular,
;; the OpenSolaris /bin/sh is a problem. There are also other
;; problems with /bin/sh of OpenSolaris, like redirection of stderr
- ;; in in function declarations, or changing HISTFILE in place.
+ ;; in function declarations, or changing HISTFILE in place.
;; Therefore, OpenSolaris' /bin/sh is replaced by bash, when
;; detected.
(tramp-find-shell vec)
;; Disable unexpected output.
(tramp-send-command vec "mesg n; biff n" t)
+ ;; IRIX64 bash expands "!" even when in single quotes. This
+ ;; destroys our shell functions, we must disable it. See
+ ;; <http://stackoverflow.com/questions/3291692/irix-bash-shell-expands-expression-in-single-quotes-yet-shouldnt>.
+ (when (string-match "^IRIX64" (tramp-get-connection-property vec "uname" ""))
+ (tramp-send-command vec "set +H" t))
+
+ ;; Set `remote-tty' process property.
+ (ignore-errors
+ (let ((tty (tramp-send-command-and-read vec "echo \\\"`tty`\\\"")))
+ (unless (zerop (length tty)) (process-put proc 'remote-tty tty))))
+
;; Set the environment.
(tramp-message vec 5 "Setting default environment")
(setq env (cdr env)))
(when unset
(tramp-send-command
- vec (format "unset %s" (mapconcat 'identity unset " "))))) t)
+ vec (format "unset %s" (mapconcat 'identity unset " ")) t))))
;; CCC: We should either implement a Perl version of base64 encoding
;; and decoding. Then we just use that in the last item. The other
OUTPUT can be a string (which specifies a filename), or t (which
means standard output and thus the current buffer), or nil (which
means discard it)."
- (tramp-local-call-process
+ (tramp-compat-call-process
tramp-encoding-shell
(when (and input (not (string-match "%s" cmd))) input)
(if (eq output t) t nil)
(setq choices tramp-default-proxies-alist)))))
;; Handle gateways.
- (when (and (boundp 'tramp-gw-tunnel-method)
- (string-match (format
- "^\\(%s\\|%s\\)$"
- (symbol-value 'tramp-gw-tunnel-method)
- (symbol-value 'tramp-gw-socks-method))
- (tramp-file-name-method (car target-alist))))
+ (when (string-match
+ (format
+ "^\\(%s\\|%s\\)$" tramp-gw-tunnel-method tramp-gw-socks-method)
+ (tramp-file-name-method (car target-alist)))
(let ((gw (pop target-alist))
(hop (pop target-alist)))
;; Is the method prepared for gateways?
connection if a previous connection has died for some reason."
(catch 'uname-changed
(let ((p (tramp-get-connection-process vec))
+ (process-name (tramp-get-connection-property vec "process-name" nil))
(process-environment (copy-sequence process-environment)))
;; If too much time has passed since last command was sent, look
;; We call `tramp-get-buffer' in order to get a debug buffer for
;; messages from the beginning.
(tramp-get-buffer vec)
- (if (zerop (length (tramp-file-name-user vec)))
- (tramp-message
- vec 3 "Opening connection for %s using %s"
- (tramp-file-name-host vec)
- (tramp-file-name-method vec))
- (tramp-message
- vec 3 "Opening connection for %s@%s using %s"
- (tramp-file-name-user vec)
- (tramp-file-name-host vec)
- (tramp-file-name-method vec)))
-
- ;; Start new process.
- (when (and p (processp p))
- (delete-process p))
- (setenv "TERM" tramp-terminal-type)
- (setenv "LC_ALL" "C")
- (setenv "PROMPT_COMMAND")
- (setenv "PS1" tramp-initial-end-of-output)
- (let* ((target-alist (tramp-compute-multi-hops vec))
- (process-connection-type tramp-process-connection-type)
- (process-adaptive-read-buffering nil)
- (coding-system-for-read nil)
- ;; This must be done in order to avoid our file name handler.
- (p (let ((default-directory
- (tramp-compat-temporary-file-directory)))
- (start-process
- (or (tramp-get-connection-property vec "process-name" nil)
- (tramp-buffer-name vec))
- (tramp-get-connection-buffer vec)
- tramp-encoding-shell))))
+ (with-progress-reporter
+ vec 3
+ (if (zerop (length (tramp-file-name-user vec)))
+ (format "Opening connection for %s using %s"
+ (tramp-file-name-host vec)
+ (tramp-file-name-method vec))
+ (format "Opening connection for %s@%s using %s"
+ (tramp-file-name-user vec)
+ (tramp-file-name-host vec)
+ (tramp-file-name-method vec)))
+
+ ;; Start new process.
+ (when (and p (processp p))
+ (delete-process p))
+ (setenv "TERM" tramp-terminal-type)
+ (setenv "LC_ALL" "C")
+ (setenv "PROMPT_COMMAND")
+ (setenv "PS1" tramp-initial-end-of-output)
+ (let* ((target-alist (tramp-compute-multi-hops vec))
+ (process-connection-type tramp-process-connection-type)
+ (process-adaptive-read-buffering nil)
+ (coding-system-for-read nil)
+ ;; This must be done in order to avoid our file name handler.
+ (p (let ((default-directory
+ (tramp-compat-temporary-file-directory)))
+ (start-process
+ (or process-name (tramp-buffer-name vec))
+ (tramp-get-connection-buffer vec)
+ tramp-encoding-shell))))
- (tramp-message
- vec 6 "%s" (mapconcat 'identity (process-command p) " "))
+ (tramp-message
+ vec 6 "%s" (mapconcat 'identity (process-command p) " "))
- ;; Check whether process is alive.
- (tramp-set-process-query-on-exit-flag p nil)
- (with-progress-reporter vec 3 "Waiting 60s for local shell to come up"
+ ;; Check whether process is alive.
+ (tramp-set-process-query-on-exit-flag p nil)
(tramp-barf-if-no-shell-prompt
- p 60 "Couldn't find local shell prompt %s" tramp-encoding-shell))
-
- ;; Now do all the connections as specified.
- (while target-alist
- (let* ((hop (car target-alist))
- (l-method (tramp-file-name-method hop))
- (l-user (tramp-file-name-user hop))
- (l-host (tramp-file-name-host hop))
- (l-port nil)
- (login-program
- (tramp-get-method-parameter l-method 'tramp-login-program))
- (login-args
- (tramp-get-method-parameter l-method 'tramp-login-args))
- (gw-args
- (tramp-get-method-parameter l-method 'tramp-gw-args))
- (gw (tramp-get-file-property hop "" "gateway" nil))
- (g-method (and gw (tramp-file-name-method gw)))
- (g-user (and gw (tramp-file-name-user gw)))
- (g-host (and gw (tramp-file-name-host gw)))
- (command login-program)
- ;; We don't create the temporary file. In fact, it
- ;; is just a prefix for the ControlPath option of
- ;; ssh; the real temporary file has another name, and
- ;; it is created and protected by ssh. It is also
- ;; removed by ssh, when the connection is closed.
- (tmpfile
- (tramp-set-connection-property
- p "temp-file"
- (make-temp-name
- (expand-file-name
- tramp-temp-name-prefix
- (tramp-compat-temporary-file-directory)))))
- spec)
-
- ;; Add gateway arguments if necessary.
- (when (and gw gw-args)
- (setq login-args (append login-args gw-args)))
-
- ;; Check for port number. Until now, there's no need
- ;; for handling like method, user, host.
- (when (string-match tramp-host-with-port-regexp l-host)
+ p 60 "Couldn't find local shell prompt %s" tramp-encoding-shell)
+
+ ;; Now do all the connections as specified.
+ (while target-alist
+ (let* ((hop (car target-alist))
+ (l-method (tramp-file-name-method hop))
+ (l-user (tramp-file-name-user hop))
+ (l-host (tramp-file-name-host hop))
+ (l-port nil)
+ (login-program
+ (tramp-get-method-parameter
+ l-method 'tramp-login-program))
+ (login-args
+ (tramp-get-method-parameter l-method 'tramp-login-args))
+ (async-args
+ (tramp-get-method-parameter l-method 'tramp-async-args))
+ (gw-args
+ (tramp-get-method-parameter l-method 'tramp-gw-args))
+ (gw (tramp-get-file-property hop "" "gateway" nil))
+ (g-method (and gw (tramp-file-name-method gw)))
+ (g-user (and gw (tramp-file-name-user gw)))
+ (g-host (and gw (tramp-file-name-host gw)))
+ (command login-program)
+ ;; We don't create the temporary file. In fact,
+ ;; it is just a prefix for the ControlPath option
+ ;; of ssh; the real temporary file has another
+ ;; name, and it is created and protected by ssh.
+ ;; It is also removed by ssh, when the connection
+ ;; is closed.
+ (tmpfile
+ (tramp-set-connection-property
+ p "temp-file"
+ (make-temp-name
+ (expand-file-name
+ tramp-temp-name-prefix
+ (tramp-compat-temporary-file-directory)))))
+ spec)
+
+ ;; Add arguments for asynchrononous processes.
+ (when (and process-name async-args)
+ (setq login-args (append async-args login-args)))
+
+ ;; Add gateway arguments if necessary.
+ (when (and gw gw-args)
+ (setq login-args (append gw-args login-args)))
+
+ ;; Check for port number. Until now, there's no need
+ ;; for handling like method, user, host.
+ (when (string-match tramp-host-with-port-regexp l-host)
(setq l-port (match-string 2 l-host)
l-host (match-string 1 l-host)))
- ;; Set variables for computing the prompt for reading
- ;; password. They can also be derived from a gateway.
- (setq tramp-current-method (or g-method l-method)
- tramp-current-user (or g-user l-user)
- tramp-current-host (or g-host l-host))
-
- ;; Replace login-args place holders.
- (setq
- l-host (or l-host "")
- l-user (or l-user "")
- l-port (or l-port "")
- spec (format-spec-make ?h l-host ?u l-user ?p l-port ?t tmpfile)
- command
- (concat
- ;; We do not want to see the trailing local prompt in
- ;; `start-file-process'.
- (unless (memq system-type '(windows-nt)) "exec ")
- command " "
- (mapconcat
- (lambda (x)
- (setq x (mapcar (lambda (y) (format-spec y spec)) x))
- (unless (member "" x) (mapconcat 'identity x " ")))
- login-args " ")
- ;; Local shell could be a Windows COMSPEC. It doesn't
- ;; know the ";" syntax, but we must exit always for
- ;; `start-file-process'. "exec" does not work either.
- (if (memq system-type '(windows-nt)) " && exit || exit")))
-
- ;; Send the command.
- (tramp-message vec 3 "Sending command `%s'" command)
- (tramp-send-command vec command t t)
- (tramp-process-actions p vec tramp-actions-before-shell 60)
- (tramp-message vec 3 "Found remote shell prompt on `%s'" l-host))
- ;; Next hop.
- (setq target-alist (cdr target-alist)))
+ ;; Set variables for computing the prompt for reading
+ ;; password. They can also be derived from a gateway.
+ (setq tramp-current-method (or g-method l-method)
+ tramp-current-user (or g-user l-user)
+ tramp-current-host (or g-host l-host))
+
+ ;; Replace login-args place holders.
+ (setq
+ l-host (or l-host "")
+ l-user (or l-user "")
+ l-port (or l-port "")
+ spec (format-spec-make
+ ?h l-host ?u l-user ?p l-port ?t tmpfile)
+ command
+ (concat
+ ;; We do not want to see the trailing local prompt in
+ ;; `start-file-process'.
+ (unless (memq system-type '(windows-nt)) "exec ")
+ command " "
+ (mapconcat
+ (lambda (x)
+ (setq x (mapcar (lambda (y) (format-spec y spec)) x))
+ (unless (member "" x) (mapconcat 'identity x " ")))
+ login-args " ")
+ ;; Local shell could be a Windows COMSPEC. It
+ ;; doesn't know the ";" syntax, but we must exit
+ ;; always for `start-file-process'. "exec" does not
+ ;; work either.
+ (if (memq system-type '(windows-nt)) " && exit || exit")))
+
+ ;; Send the command.
+ (tramp-message vec 3 "Sending command `%s'" command)
+ (tramp-send-command vec command t t)
+ (tramp-process-actions p vec tramp-actions-before-shell 60)
+ (tramp-message
+ vec 3 "Found remote shell prompt on `%s'" l-host))
+ ;; Next hop.
+ (setq target-alist (cdr target-alist)))
- ;; Make initial shell settings.
- (tramp-open-connection-setup-interactive-shell p vec))))))
+ ;; Make initial shell settings.
+ (tramp-open-connection-setup-interactive-shell p vec)))))))
(defun tramp-send-command (vec command &optional neveropen nooutput)
"Send the COMMAND to connection VEC.
;; Return value is whether end-of-output sentinel was found.
found)))
+;;;###tramp-autoload
(defun tramp-send-command-and-check
(vec command &optional subshell dont-suppress-err)
"Run COMMAND and check its exit status.
(save-match-data
(logior
(cond
- ((char-equal owner-read ?r) (tramp-octal-to-decimal "00400"))
+ ((char-equal owner-read ?r) (tramp-compat-octal-to-decimal "00400"))
((char-equal owner-read ?-) 0)
(t (error "Second char `%c' must be one of `r-'" owner-read)))
(cond
- ((char-equal owner-write ?w) (tramp-octal-to-decimal "00200"))
+ ((char-equal owner-write ?w) (tramp-compat-octal-to-decimal "00200"))
((char-equal owner-write ?-) 0)
(t (error "Third char `%c' must be one of `w-'" owner-write)))
(cond
((char-equal owner-execute-or-setid ?x)
- (tramp-octal-to-decimal "00100"))
+ (tramp-compat-octal-to-decimal "00100"))
((char-equal owner-execute-or-setid ?S)
- (tramp-octal-to-decimal "04000"))
+ (tramp-compat-octal-to-decimal "04000"))
((char-equal owner-execute-or-setid ?s)
- (tramp-octal-to-decimal "04100"))
+ (tramp-compat-octal-to-decimal "04100"))
((char-equal owner-execute-or-setid ?-) 0)
(t (error "Fourth char `%c' must be one of `xsS-'"
owner-execute-or-setid)))
(cond
- ((char-equal group-read ?r) (tramp-octal-to-decimal "00040"))
+ ((char-equal group-read ?r) (tramp-compat-octal-to-decimal "00040"))
((char-equal group-read ?-) 0)
(t (error "Fifth char `%c' must be one of `r-'" group-read)))
(cond
- ((char-equal group-write ?w) (tramp-octal-to-decimal "00020"))
+ ((char-equal group-write ?w) (tramp-compat-octal-to-decimal "00020"))
((char-equal group-write ?-) 0)
(t (error "Sixth char `%c' must be one of `w-'" group-write)))
(cond
((char-equal group-execute-or-setid ?x)
- (tramp-octal-to-decimal "00010"))
+ (tramp-compat-octal-to-decimal "00010"))
((char-equal group-execute-or-setid ?S)
- (tramp-octal-to-decimal "02000"))
+ (tramp-compat-octal-to-decimal "02000"))
((char-equal group-execute-or-setid ?s)
- (tramp-octal-to-decimal "02010"))
+ (tramp-compat-octal-to-decimal "02010"))
((char-equal group-execute-or-setid ?-) 0)
(t (error "Seventh char `%c' must be one of `xsS-'"
group-execute-or-setid)))
(cond
((char-equal other-read ?r)
- (tramp-octal-to-decimal "00004"))
+ (tramp-compat-octal-to-decimal "00004"))
((char-equal other-read ?-) 0)
(t (error "Eighth char `%c' must be one of `r-'" other-read)))
(cond
- ((char-equal other-write ?w) (tramp-octal-to-decimal "00002"))
+ ((char-equal other-write ?w) (tramp-compat-octal-to-decimal "00002"))
((char-equal other-write ?-) 0)
(t (error "Nineth char `%c' must be one of `w-'" other-write)))
(cond
((char-equal other-execute-or-sticky ?x)
- (tramp-octal-to-decimal "00001"))
+ (tramp-compat-octal-to-decimal "00001"))
((char-equal other-execute-or-sticky ?T)
- (tramp-octal-to-decimal "01000"))
+ (tramp-compat-octal-to-decimal "01000"))
((char-equal other-execute-or-sticky ?t)
- (tramp-octal-to-decimal "01001"))
+ (tramp-compat-octal-to-decimal "01001"))
((char-equal other-execute-or-sticky ?-) 0)
(t (error "Tenth char `%c' must be one of `xtT-'"
other-execute-or-sticky)))))))
(and suid (upcase suid-text)) ; suid, !execute
(and x "x") "-")))) ; !suid
-(defun tramp-decimal-to-octal (i)
- "Return a string consisting of the octal digits of I.
-Not actually used. Use `(format \"%o\" i)' instead?"
- (cond ((< i 0) (error "Cannot convert negative number to octal"))
- ((not (integerp i)) (error "Cannot convert non-integer to octal"))
- ((zerop i) "0")
- (t (concat (tramp-decimal-to-octal (/ i 8))
- (number-to-string (% i 8))))))
-
-;; Kudos to Gerd Moellmann for this suggestion.
-(defun tramp-octal-to-decimal (ostr)
- "Given a string of octal digits, return a decimal number."
- (let ((x (or ostr "")))
- ;; `save-match' is in `tramp-mode-string-to-int' which calls this.
- (unless (string-match "\\`[0-7]*\\'" x)
- (error "Non-octal junk in string `%s'" x))
- (string-to-number ostr 8)))
-
(defun tramp-shell-case-fold (string)
"Converts STRING to shell glob pattern which ignores case."
(mapconcat
string
""))
-
-;; ------------------------------------------------------------
-;; -- Tramp file names --
-;; ------------------------------------------------------------
-;; Conversion functions between external representation and
-;; internal data structure. Convenience functions for internal
-;; data structure.
-
-(defun tramp-file-name-p (vec)
- "Check, whether VEC is a Tramp object."
- (and (vectorp vec) (= 4 (length vec))))
-
-(defun tramp-file-name-method (vec)
- "Return method component of VEC."
- (and (tramp-file-name-p vec) (aref vec 0)))
-
-(defun tramp-file-name-user (vec)
- "Return user component of VEC."
- (and (tramp-file-name-p vec) (aref vec 1)))
-
-(defun tramp-file-name-host (vec)
- "Return host component of VEC."
- (and (tramp-file-name-p vec) (aref vec 2)))
-
-(defun tramp-file-name-localname (vec)
- "Return localname component of VEC."
- (and (tramp-file-name-p vec) (aref vec 3)))
-
-;; The user part of a Tramp file name vector can be of kind
-;; "user%domain". Sometimes, we must extract these parts.
-(defun tramp-file-name-real-user (vec)
- "Return the user name of VEC without domain."
- (save-match-data
- (let ((user (tramp-file-name-user vec)))
- (if (and (stringp user)
- (string-match tramp-user-with-domain-regexp user))
- (match-string 1 user)
- user))))
-
-(defun tramp-file-name-domain (vec)
- "Return the domain name of VEC."
- (save-match-data
- (let ((user (tramp-file-name-user vec)))
- (and (stringp user)
- (string-match tramp-user-with-domain-regexp user)
- (match-string 2 user)))))
-
-;; The host part of a Tramp file name vector can be of kind
-;; "host#port". Sometimes, we must extract these parts.
-(defun tramp-file-name-real-host (vec)
- "Return the host name of VEC without port."
- (save-match-data
- (let ((host (tramp-file-name-host vec)))
- (if (and (stringp host)
- (string-match tramp-host-with-port-regexp host))
- (match-string 1 host)
- host))))
-
-(defun tramp-file-name-port (vec)
- "Return the port number of VEC."
- (save-match-data
- (let ((host (tramp-file-name-host vec)))
- (and (stringp host)
- (string-match tramp-host-with-port-regexp host)
- (string-to-number (match-string 2 host))))))
-
-(defun tramp-tramp-file-p (name)
- "Return t if NAME is a string with Tramp file name syntax."
- (save-match-data
- (and (stringp name) (string-match tramp-file-name-regexp name))))
-
-(defun tramp-find-method (method user host)
- "Return the right method string to use.
-This is METHOD, if non-nil. Otherwise, do a lookup in
-`tramp-default-method-alist'."
- (or method
- (let ((choices tramp-default-method-alist)
- lmethod item)
- (while choices
- (setq item (pop choices))
- (when (and (string-match (or (nth 0 item) "") (or host ""))
- (string-match (or (nth 1 item) "") (or user "")))
- (setq lmethod (nth 2 item))
- (setq choices nil)))
- lmethod)
- tramp-default-method))
-
-(defun tramp-find-user (method user host)
- "Return the right user string to use.
-This is USER, if non-nil. Otherwise, do a lookup in
-`tramp-default-user-alist'."
- (or user
- (let ((choices tramp-default-user-alist)
- luser item)
- (while choices
- (setq item (pop choices))
- (when (and (string-match (or (nth 0 item) "") (or method ""))
- (string-match (or (nth 1 item) "") (or host "")))
- (setq luser (nth 2 item))
- (setq choices nil)))
- luser)
- tramp-default-user))
-
-(defun tramp-find-host (method user host)
- "Return the right host string to use.
-This is HOST, if non-nil. Otherwise, it is `tramp-default-host'."
- (or (and (> (length host) 0) host)
- tramp-default-host))
-
-(defun tramp-dissect-file-name (name &optional nodefault)
- "Return a `tramp-file-name' structure.
-The structure consists of remote method, remote user, remote host
-and localname (file name on remote host). If NODEFAULT is
-non-nil, the file name parts are not expanded to their default
-values."
- (save-match-data
- (let ((match (string-match (nth 0 tramp-file-name-structure) name)))
- (unless match (error "Not a Tramp file name: %s" name))
- (let ((method (match-string (nth 1 tramp-file-name-structure) name))
- (user (match-string (nth 2 tramp-file-name-structure) name))
- (host (match-string (nth 3 tramp-file-name-structure) name))
- (localname (match-string (nth 4 tramp-file-name-structure) name)))
- (when (member method '("multi" "multiu"))
- (error
- "`%s' method is no longer supported, see (info \"(tramp)Multi-hops\")"
- method))
- (when host
- (when (string-match tramp-prefix-ipv6-regexp host)
- (setq host (replace-match "" nil t host)))
- (when (string-match tramp-postfix-ipv6-regexp host)
- (setq host (replace-match "" nil t host))))
- (if nodefault
- (vector method user host localname)
- (vector
- (tramp-find-method method user host)
- (tramp-find-user method user host)
- (tramp-find-host method user host)
- localname))))))
-
(defun tramp-equal-remote (file1 file2)
"Check, whether the remote parts of FILE1 and FILE2 are identical.
The check depends on method, user and host name of the files. If
(stringp (file-remote-p file2))
(string-equal (file-remote-p file1) (file-remote-p file2))))
-(defun tramp-make-tramp-file-name (method user host localname)
- "Constructs a Tramp file name from METHOD, USER, HOST and LOCALNAME."
- (concat tramp-prefix-format
- (when (not (zerop (length method)))
- (concat method tramp-postfix-method-format))
- (when (not (zerop (length user)))
- (concat user tramp-postfix-user-format))
- (when host
- (if (string-match tramp-ipv6-regexp host)
- (concat tramp-prefix-ipv6-format host tramp-postfix-ipv6-format)
- host))
- tramp-postfix-host-format
- (when localname localname)))
-
-(defun tramp-completion-make-tramp-file-name (method user host localname)
- "Constructs a Tramp file name from METHOD, USER, HOST and LOCALNAME.
-It must not be a complete Tramp file name, but as long as there are
-necessary only. This function will be used in file name completion."
- (concat tramp-prefix-format
- (when (not (zerop (length method)))
- (concat method tramp-postfix-method-format))
- (when (not (zerop (length user)))
- (concat user tramp-postfix-user-format))
- (when (not (zerop (length host)))
- (concat
- (if (string-match tramp-ipv6-regexp host)
- (concat tramp-prefix-ipv6-format host tramp-postfix-ipv6-format)
- host)
- tramp-postfix-host-format))
- (when localname localname)))
-
(defun tramp-make-copy-program-file-name (vec)
"Create a file name suitable to be passed to `rcp' and workalikes."
(let ((user (tramp-file-name-user vec))
;; Variables local to connection.
+;;;###tramp-autoload
(defun tramp-get-remote-path (vec)
(with-connection-property
;; When `tramp-own-remote-path' is in `tramp-remote-path', we
x))
remote-path)))))
+;;;###tramp-autoload
(defun tramp-get-remote-tmpdir (vec)
(with-connection-property vec "tmp-directory"
(let ((dir (tramp-shell-quote-argument "/tmp")))
;; Check parameters. On busybox, "ls" output coloring is
;; enabled by default sometimes. So we try to disable it
;; when possible. $LS_COLORING is not supported there.
+ ;; Some "ls" versions are sensible wrt the order of
+ ;; arguments, they fail when "-al" is after the
+ ;; "--color=never" argument (for example on FreeBSD).
(when (zerop (tramp-send-command-and-check
vec (format "%s -lnd /" result)))
(when (zerop (tramp-send-command-and-check
- vec (format "%s --color=never /" result)))
+ vec (format
+ "%s --color=never -al /dev/null" result)))
(setq result (concat result " --color=never")))
(throw 'ls-found result))
(setq dl (cdr dl))))))
(save-match-data
(with-connection-property vec "ls-dired"
(tramp-message vec 5 "Checking, whether `ls --dired' works")
+ ;; Some "ls" versions are sensible wrt the order of arguments,
+ ;; they fail when "-al" is after the "--dired" argument (for
+ ;; example on FreeBSD).
(zerop (tramp-send-command-and-check
- vec (format "%s --dired /" (tramp-get-ls-command vec)))))))
+ vec (format "%s --dired -al /dev/null"
+ (tramp-get-ls-command vec)))))))
(defun tramp-get-test-command (vec)
(with-connection-property vec "test"
(tramp-message vec 5 "Finding command to check if file exists")
(tramp-find-file-exists-command vec)))
+;;;###tramp-autoload
(defun tramp-get-remote-ln (vec)
(with-connection-property vec "ln"
(tramp-message vec 5 "Finding a suitable `ln' command")
(error nil))))
result))))
+(defun tramp-get-remote-trash (vec)
+ (with-connection-property vec "trash"
+ (tramp-message vec 5 "Finding a suitable `trash' command")
+ (tramp-find-executable vec "trash" (tramp-get-remote-path vec))))
+
(defun tramp-get-remote-id (vec)
(with-connection-property vec "id"
(tramp-message vec 5 "Finding POSIX `id' command")
;; Permissions should be set always, because there might be an old
;; 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) (tramp-octal-to-decimal "0600"))))))
+ (set-file-modes
+ buffer-auto-save-file-name
+ (or (file-modes bfn) (tramp-compat-octal-to-decimal "0600"))))))
(unless (and (featurep 'xemacs)
(= emacs-major-version 21)
(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)."
- ;; Pacify byte-compiler with `symbol-function'.
(cond ((and (fboundp 'subtract-time)
(fboundp 'float-time))
(tramp-compat-funcall
exiting if process is running."
(if (fboundp 'set-process-query-on-exit-flag)
(tramp-compat-funcall 'set-process-query-on-exit-flag process flag)
- (tramp-compat-funcall 'process-kill-without-query) process flag))
+ (tramp-compat-funcall 'process-kill-without-query process flag)))
;; ------------------------------------------------------------
;; CCC: This function should be rewritten so that
;; `shell-quote-argument' is not used. This way, we are safe from
;; changes in `shell-quote-argument'.
+;;;###tramp-autoload
(defun tramp-shell-quote-argument (s)
"Similar to `shell-quote-argument', but groks newlines.
Only works for Bourne-like shells."
(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.
(tramp-compat-funcall 'tramp-ftp-enable-ange-ftp)
- ;; Maybe its not loaded yet.
+ ;; Maybe it's not loaded yet.
(condition-case nil
(unload-feature 'tramp 'force)
(error nil)))
;; by the files in that directory. Add this here.
;; * Avoid screen blanking when hitting `g' in dired. (Eli Tziperman)
;; * Make ffap.el grok Tramp filenames. (Eli Tziperman)
-;; * Case-insensitive filename completion. (Norbert Goevert.)
;; * Don't use globbing for directories with many files, as this is
;; likely to produce long command lines, and some shells choke on
;; long command lines.
;; * How to deal with MULE in `insert-file-contents' and `write-region'?
-;; * Test remote ksh or bash for tilde expansion in `tramp-find-shell'?
;; * abbreviate-file-name
;; * Better error checking. At least whenever we see something
;; strange when doing zerop, we should kill the process and start
;; rsync).
;; * Keep a second connection open for out-of-band methods like scp or
;; rsync.
-;; * Support ptys in `tramp-handle-start-file-process'. (Bug#4604)
;; * IMHO, it's a drawback that currently Tramp doesn't support
;; Unicode in Dired file names by default. Is it possible to
;; improve Tramp to set LC_ALL to "C" only for commands where Tramp
;; expects English? Or just to set LC_MESSAGES to "C" if Tramp
;; expects only English messages? (Juri Linkov)
;; * Make shadowfile.el grok Tramp filenames. (Bug#4526, Bug#4846)
-;; * Do not handle files with drive letter as remote. (Bug#5447)
-;; * Load Tramp subpackages only when needed. (Bug#1529, Bug#5448, Bug#5705)
;; * Try telnet+curl as new method. It might be useful for busybox,
;; without built-in uuencode/uudecode.
-;; * Let `shell-dynamic-complete-*' and `comint-dynamic-complete' work
-;; on remote hosts.
-;; * Use secrets.el for password handling.
;; * Load ~/.emacs_SHELLNAME on the remote host for `shell'.
+;; * I was wondering it it would be possible to use tramp even if I'm
+;; actually using sshfs. But when I launch a command I would like
+;; to get it executed on the remote machine where the files really
+;; are. (Andrea Crotti)
+;; * Run emerge on two remote files. Bug is described here:
+;; <http://www.mail-archive.com/tramp-devel@nongnu.org/msg01041.html>.
+;; (Bug#6850)
;; Functions for file-name-handler-alist:
;; diff-latest-backup-file -- in diff.el