;;; tramp-sh.el --- Tramp access functions for (s)sh-like connections
-;; Copyright (C) 1998-2012 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2013 Free Software Foundation, Inc.
;; (copyright statements below in code to be updated with the above notice)
(defconst tramp-perl-encode
"%s -e '
# This script contributed by Juanma Barranquero <lektu@terra.es>.
-# Copyright (C) 2002-2012 Free Software Foundation, Inc.
+# Copyright (C) 2002-2013 Free Software Foundation, Inc.
use strict;
my %%trans = do {
map {(substr(unpack(q(B8), chr $i++), 2, 6), $_)}
split //, q(ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/);
};
-
-binmode(\\*STDIN);
+my $data;
# We read in chunks of 54 bytes, to generate output lines
# of 72 chars (plus end of line)
-$/ = \\54;
-
-while (my $data = <STDIN>) {
+while (read STDIN, $data, 54) {
my $pad = q();
# Only for the last chunk, and only if did not fill the last three-byte packet
(defconst tramp-perl-decode
"%s -e '
# This script contributed by Juanma Barranquero <lektu@terra.es>.
-# Copyright (C) 2002-2012 Free Software Foundation, Inc.
+# Copyright (C) 2002-2013 Free Software Foundation, Inc.
use strict;
my %%trans = do {
(file-name-nondirectory . tramp-handle-file-name-nondirectory)
(file-truename . tramp-sh-handle-file-truename)
(file-exists-p . tramp-sh-handle-file-exists-p)
+ (file-accessible-directory-p . tramp-handle-file-accessible-directory-p)
(file-directory-p . tramp-sh-handle-file-directory-p)
(file-executable-p . tramp-sh-handle-file-executable-p)
(file-readable-p . tramp-sh-handle-file-readable-p)
(verify-visited-file-modtime . tramp-sh-handle-verify-visited-file-modtime)
(file-selinux-context . tramp-sh-handle-file-selinux-context)
(set-file-selinux-context . tramp-sh-handle-set-file-selinux-context)
+ (file-acl . tramp-sh-handle-file-acl)
+ (set-file-acl . tramp-sh-handle-set-file-acl)
(vc-registered . tramp-sh-handle-vc-registered))
"Alist of handler functions.
Operations not mentioned here will be handled by the normal Emacs functions.")
res-uid
;; 3. File gid.
res-gid
- ;; 4. Last access time, as a list of two integers. First
- ;; integer has high-order 16 bits of time, second has low 16
- ;; bits.
+ ;; 4. Last access time, as a list of integers. Normally this
+ ;; would be in the same format as `current-time', but the
+ ;; subseconds part is not currently implemented, and (0 0)
+ ;; denotes an unknown time.
;; 5. Last modification time, likewise.
;; 6. Last status change time, likewise.
'(0 0) '(0 0) '(0 0) ;CCC how to find out?
(let ((f (buffer-file-name))
coding-system-used)
(with-parsed-tramp-file-name f nil
- (let* ((attr (file-attributes f))
+ (let* ((remote-file-name-inhibit-cache t)
+ (attr (file-attributes f))
;; '(-1 65535) means file doesn't exists yet.
(modtime (or (nth 5 attr) '(-1 65535))))
(when (boundp 'last-coding-system-used)
(defun tramp-set-file-uid-gid (filename &optional uid gid)
"Set the ownership for FILENAME.
If UID and GID are provided, these values are used; otherwise uid
-and gid of the corresponding user is taken. Both parameters must be integers."
+and gid of the corresponding user is taken. Both parameters must
+be non-negative integers."
;; Modern Unices allow chown only for root. So we might need
;; another implementation, see `dired-do-chown'. OTOH, it is mostly
;; working with su(do)? when it is needed, so it shall succeed in
(if (and (zerop (user-uid)) (tramp-local-host-p v))
;; If we are root on the local host, we can do it directly.
(tramp-set-file-uid-gid localname uid gid)
- (let ((uid (or (and (integerp uid) uid)
+ (let ((uid (or (and (natnump uid) uid)
(tramp-get-remote-uid v 'integer)))
- (gid (or (and (integerp gid) gid)
+ (gid (or (and (natnump gid) gid)
(tramp-get-remote-gid v 'integer))))
(tramp-send-command
v (format
;; We handle also the local part, because there doesn't exist
;; `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))))
+ (let ((uid (or (and (natnump uid) uid) (tramp-get-local-uid 'integer)))
+ (gid (or (and (natnump gid) gid) (tramp-get-local-gid 'integer))))
(tramp-compat-call-process
"chown" nil nil nil
(format "%d:%d" uid gid) (tramp-shell-quote-argument filename))))))
(if (stringp (nth 3 context))
(format "--range=%s" (nth 3 context)) "")
(tramp-shell-quote-argument localname))))
- (tramp-set-file-property v localname "file-selinux-context" context)
- (tramp-set-file-property v localname "file-selinux-context" 'undef)))
- ;; We always return nil.
- nil)
+ (progn
+ (tramp-set-file-property v localname "file-selinux-context" context)
+ t)
+ (tramp-set-file-property v localname "file-selinux-context" 'undef)
+ nil)))
+
+(defun tramp-remote-acl-p (vec)
+ "Check, whether ACL is enabled on the remote host."
+ (with-tramp-connection-property (tramp-get-connection-process vec) "acl-p"
+ (tramp-send-command-and-check vec "getfacl /")))
+
+(defun tramp-sh-handle-file-acl (filename)
+ "Like `file-acl' for Tramp files."
+ (with-parsed-tramp-file-name filename nil
+ (with-tramp-file-property v localname "file-acl"
+ (when (and (tramp-remote-acl-p v)
+ (tramp-send-command-and-check
+ v (format
+ "getfacl -ac %s 2>/dev/null"
+ (tramp-shell-quote-argument localname))))
+ (with-current-buffer (tramp-get-connection-buffer v)
+ (goto-char (point-max))
+ (delete-blank-lines)
+ (when (> (point-max) (point-min))
+ (tramp-compat-funcall
+ 'substring-no-properties (buffer-string))))))))
+
+(defun tramp-sh-handle-set-file-acl (filename acl-string)
+ "Like `set-file-acl' for Tramp files."
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
+ (if (and (stringp acl-string) (tramp-remote-acl-p v)
+ (progn
+ (tramp-send-command
+ v (format "setfacl --set-file=- %s <<'EOF'\n%s\nEOF\n"
+ (tramp-shell-quote-argument localname) acl-string))
+ (tramp-send-command-and-check v nil)))
+ ;; Success.
+ (progn
+ (tramp-set-file-property v localname "file-acl" acl-string)
+ t)
+ ;; In case of errors, we return `nil'.
+ (tramp-set-file-property v localname "file-acl-string" 'undef)
+ nil)))
;; Simple functions using the `test' command.
(and (tramp-run-test "-d" (file-name-directory filename))
(tramp-run-test "-w" (file-name-directory filename)))))))
-(defun tramp-sh-handle-file-ownership-preserved-p (filename)
+(defun tramp-sh-handle-file-ownership-preserved-p (filename &optional group)
"Like `file-ownership-preserved-p' for Tramp files."
(with-parsed-tramp-file-name filename nil
(with-tramp-file-property v localname "file-ownership-preserved-p"
;; Return t if the file doesn't exist, since it's true that no
;; information would be lost by an (attempted) delete and create.
(or (null attributes)
- (= (nth 2 attributes) (tramp-get-remote-uid v 'integer)))))))
+ (and
+ (= (nth 2 attributes) (tramp-get-remote-uid v 'integer))
+ (or (not group)
+ (= (nth 3 attributes) (tramp-get-remote-gid v 'integer)))))))))
;; Directory listings.
(defun tramp-sh-handle-copy-file
(filename newname &optional ok-if-already-exists keep-date
- preserve-uid-gid preserve-selinux-context)
+ preserve-uid-gid preserve-extended-attributes)
"Like `copy-file' for Tramp files."
(setq filename (expand-file-name filename))
(setq newname (expand-file-name newname))
(tramp-tramp-file-p newname))
(tramp-do-copy-or-rename-file
'copy filename newname ok-if-already-exists keep-date
- preserve-uid-gid preserve-selinux-context))
+ preserve-uid-gid preserve-extended-attributes))
;; Compat section.
- (preserve-selinux-context
+ (preserve-extended-attributes
(tramp-run-real-handler
'copy-file
(list filename newname ok-if-already-exists keep-date
- preserve-uid-gid preserve-selinux-context)))
+ preserve-uid-gid preserve-extended-attributes)))
(preserve-uid-gid
(tramp-run-real-handler
'copy-file
(defun tramp-do-copy-or-rename-file
(op filename newname &optional ok-if-already-exists keep-date
- preserve-uid-gid preserve-selinux-context)
+ preserve-uid-gid preserve-extended-attributes)
"Copy or rename a remote file.
OP must be `copy' or `rename' and indicates the operation to perform.
FILENAME specifies the file to copy or rename, NEWNAME is the name of
KEEP-DATE means to make sure that NEWNAME has the same timestamp
as FILENAME. PRESERVE-UID-GID, when non-nil, instructs to keep
the uid and gid if both files are on the same host.
-PRESERVE-SELINUX-CONTEXT activates selinux commands.
+PRESERVE-EXTENDED-ATTRIBUTES activates selinux and acl commands.
This function is invoked by `tramp-sh-handle-copy-file' and
`tramp-sh-handle-rename-file'. It is an error if OP is neither
(error "Unknown operation `%s', must be `copy' or `rename'" op))
(let ((t1 (tramp-tramp-file-p filename))
(t2 (tramp-tramp-file-p newname))
- (context (and preserve-selinux-context
- (apply 'file-selinux-context (list filename))))
+ (length (nth 7 (file-attributes (file-truename filename))))
+ (attributes (and preserve-extended-attributes
+ (apply 'file-extended-attributes (list filename))))
pr tm)
(with-parsed-tramp-file-name (if t1 filename newname) nil
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 (file-truename filename))))
+ ((and
+ (tramp-method-out-of-band-p v1 length)
+ (tramp-method-out-of-band-p v2 length))
(tramp-do-copy-or-rename-file-out-of-band
op filename newname keep-date))
;; 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 (file-truename filename))))
+ ((tramp-method-out-of-band-p v length)
(tramp-do-copy-or-rename-file-out-of-band
op filename newname keep-date))
;; 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)))
+ ;; Handle `preserve-extended-attributes'. We ignore possible
+ ;; errors, because ACL strings could be incompatible.
+ (when attributes
+ (ignore-errors
+ (apply 'set-file-extended-attributes (list newname attributes))))
;; In case of `rename', we must flush the cache of the source file.
(when (and t1 (eq op 'rename))
;; last longer than 60 secs.
(let ((p (let ((default-directory
(tramp-compat-temporary-file-directory)))
- (apply 'start-process
+ (apply 'start-process-shell-command
(tramp-get-connection-name v)
(tramp-get-connection-buffer v)
copy-program
- (append copy-args (list source target))))))
+ (append
+ copy-args
+ (list
+ (shell-quote-argument source)
+ (shell-quote-argument target)
+ "&&" "echo" "tramp_exit_status" "0"
+ "||" "echo" "tramp_exit_status" "1"))))))
(tramp-message
orig-vec 6 "%s"
(mapconcat 'identity (process-command p) " "))
(tramp-compat-set-process-query-on-exit-flag p nil)
(tramp-process-actions
- p v nil tramp-actions-copy-out-of-band)))
+ p v nil tramp-actions-copy-out-of-band)
+
+ ;; Check the return code.
+ (goto-char (point-max))
+ (unless
+ (re-search-backward "tramp_exit_status [0-9]+" nil t)
+ (tramp-error
+ orig-vec 'file-error
+ "Couldn't find exit status of `%s'" (process-command p)))
+ (skip-chars-forward "^ ")
+ (unless (zerop (read (current-buffer)))
+ (forward-line -1)
+ (tramp-error
+ orig-vec 'file-error
+ "Error copying: `%s'"
+ (buffer-substring (point-min) (point-at-eol))))))
;; Reset the transfer process properties.
(tramp-message orig-vec 6 "\n%s" (buffer-string))
(with-current-buffer (tramp-get-connection-buffer v)
(unwind-protect
+ ;; We catch this event. Otherwise, `start-process' could
+ ;; be called on the local host.
(save-excursion
(save-restriction
;; Activate narrowing in order to save BUFFER
(narrow-to-region (point-max) (point-max))
;; We call `tramp-maybe-open-connection', in order
;; to cleanup the prompt afterwards.
- (tramp-maybe-open-connection v)
- (widen)
- (delete-region mark (point))
- (narrow-to-region (point-max) (point-max))
- ;; Now do it.
- (if command
- ;; Send the command.
- (tramp-send-command v command nil t) ; nooutput
- ;; Check, whether a pty is associated.
- (unless (tramp-compat-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 query flag for this process. We ignore errors,
- ;; because the process could have finished already.
- (ignore-errors
- (tramp-compat-set-process-query-on-exit-flag p t))
- ;; Return process.
- p)))
+ (catch 'suppress
+ (tramp-maybe-open-connection v)
+ (widen)
+ (delete-region mark (point))
+ (narrow-to-region (point-max) (point-max))
+ ;; Now do it.
+ (if command
+ ;; Send the command.
+ (tramp-send-command v command nil t) ; nooutput
+ ;; Check, whether a pty is associated.
+ (unless (tramp-compat-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 query flag and process marker for this
+ ;; process. We ignore errors, because the process
+ ;; could have finished already.
+ (ignore-errors
+ (tramp-compat-set-process-query-on-exit-flag p t)
+ (set-marker (process-mark p) (point)))
+ ;; Return process.
+ p))))
;; Save exit.
(if (string-match tramp-temp-buffer-name (buffer-name))
- (progn
+ (ignore-errors
(set-process-buffer (tramp-get-connection-process v) nil)
(kill-buffer (current-buffer)))
(set-buffer-modified-p bmp))
(keyboard-quit)
ret))))
-(defun tramp-sh-handle-call-process-region
- (start end program &optional delete buffer display &rest args)
- "Like `call-process-region' for Tramp files."
- (let ((tmpfile (tramp-compat-make-temp-file "")))
- (write-region start end tmpfile)
- (when delete (delete-region start end))
- (unwind-protect
- (apply 'call-process program tmpfile buffer display args)
- (delete-file tmpfile))))
-
(defun tramp-sh-handle-file-local-copy (filename)
"Like `file-local-copy' for Tramp files."
(with-parsed-tramp-file-name filename nil
(tramp-message
vec 2 "Couldn't find an inline transfer compress command")))))
+(defvar tramp-gw-tunnel-method)
+(defvar tramp-gw-socks-method)
+
(defun tramp-compute-multi-hops (vec)
"Expands VEC according to `tramp-default-proxies-alist'.
Gateway hops are already opened."
(setq choices tramp-default-proxies-alist)))))
;; Handle gateways.
- (when (string-match
- (format
- "^\\(%s\\|%s\\)$" tramp-gw-tunnel-method tramp-gw-socks-method)
- (tramp-file-name-method (car target-alist)))
+ (when (and (boundp 'tramp-gw-tunnel-method) (boundp 'tramp-gw-socks-method)
+ (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?
(car tramp-current-connection)))
(> (tramp-time-diff
(current-time) (cdr tramp-current-connection))
- 5))
+ (or tramp-connection-min-time-diff 0)))
(throw 'suppress 'suppress))
;; If too much time has passed since last command was sent, look
command (buffer-string))))))))
(defun tramp-convert-file-attributes (vec attr)
- "Convert file-attributes ATTR generated by perl script, stat or ls.
+ "Convert `file-attributes' ATTR generated by perl script, stat or ls.
Convert file mode bits to string and set virtual device number.
Return ATTR."
(when attr
(when (stringp (car attr))
(while (string-match tramp-color-escape-sequence-regexp (car attr))
(setcar attr (replace-match "" nil nil (car attr)))))
+ ;; Convert uid and gid. Use -1 as indication of unusable value.
+ (when (and (numberp (nth 2 attr)) (< (nth 2 attr) 0))
+ (setcar (nthcdr 2 attr) -1))
+ (when (and (floatp (nth 2 attr))
+ (<= (nth 2 attr) (tramp-compat-most-positive-fixnum)))
+ (setcar (nthcdr 2 attr) (round (nth 2 attr))))
+ (when (and (numberp (nth 3 attr)) (< (nth 3 attr) 0))
+ (setcar (nthcdr 3 attr) -1))
+ (when (and (floatp (nth 3 attr))
+ (<= (nth 3 attr) (tramp-compat-most-positive-fixnum)))
+ (setcar (nthcdr 3 attr) (round (nth 3 attr))))
;; Convert last access time.
(unless (listp (nth 4 attr))
(setcar (nthcdr 4 attr)
(if (equal id-format 'integer) (user-uid) (user-login-name)))
(defun tramp-get-local-gid (id-format)
- (nth 3 (tramp-compat-file-attributes "~/" id-format)))
+ (if (and (fboundp 'group-gid) (equal id-format 'integer))
+ (tramp-compat-funcall 'group-gid)
+ (nth 3 (tramp-compat-file-attributes "~/" id-format))))
;; Some predefined connection properties.
(defun tramp-get-inline-compress (vec prop size)
(t
(format "%s <%%s" coding)))))))
-;;; Integration of eshell.el:
-
-(eval-when-compile
- (defvar eshell-path-env))
-
-;; eshell.el keeps the path in `eshell-path-env'. We must change it
-;; when `default-directory' points to another host.
-(defun tramp-eshell-directory-change ()
- "Set `eshell-path-env' to $PATH of the host related to `default-directory'."
- (setq eshell-path-env
- (if (file-remote-p default-directory)
- (with-parsed-tramp-file-name default-directory nil
- (mapconcat
- 'identity
- (tramp-get-remote-path v)
- ":"))
- (getenv "PATH"))))
-
-(eval-after-load "esh-util"
- '(progn
- (tramp-eshell-directory-change)
- (add-hook 'eshell-directory-change-hook
- 'tramp-eshell-directory-change)
- (add-hook 'tramp-unload-hook
- (lambda ()
- (remove-hook 'eshell-directory-change-hook
- 'tramp-eshell-directory-change)))))
-
(add-hook 'tramp-unload-hook
(lambda ()
(unload-feature 'tramp-sh 'force)))