diff options
Diffstat (limited to 'lisp/net/tramp-sh.el')
| -rw-r--r-- | lisp/net/tramp-sh.el | 208 |
1 files changed, 124 insertions, 84 deletions
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 2152ba1e270..63e966b91b2 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -935,6 +935,7 @@ This is used to map a mode number to a permission string.") (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) @@ -985,6 +986,8 @@ This is used to map a mode number to a permission string.") (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.") @@ -1528,10 +1531,49 @@ be non-negative integers." (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. @@ -1617,7 +1659,7 @@ be non-negative integers." (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" @@ -1625,7 +1667,10 @@ be non-negative integers." ;; 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. @@ -1881,7 +1926,7 @@ tramp-sh-handle-file-name-all-completions: internal error accessing `%s': `%s'" (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)) @@ -1891,13 +1936,13 @@ tramp-sh-handle-file-name-all-completions: internal error accessing `%s': `%s'" (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 @@ -1960,7 +2005,7 @@ tramp-sh-handle-file-name-all-completions: internal error accessing `%s': `%s'" (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 @@ -1969,7 +2014,7 @@ OK-IF-ALREADY-EXISTS means don't barf if NEWNAME exists already. KEEP-DATE means to make sure that NEWNAME has the same timestamp as FILENAME. PRESERVE-UID-GID, when non-nil, instructs to keep the uid and gid if both files are on the same host. -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 @@ -1980,8 +2025,8 @@ file names." (let ((t1 (tramp-tramp-file-p filename)) (t2 (tramp-tramp-file-p newname)) (length (nth 7 (file-attributes (file-truename filename)))) - (context (and preserve-selinux-context - (apply 'file-selinux-context (list filename)))) + (attributes (and preserve-extended-attributes + (apply 'file-extended-attributes (list filename)))) pr tm) (with-parsed-tramp-file-name (if t1 filename newname) nil @@ -2051,8 +2096,11 @@ file names." ;; 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)) @@ -2380,17 +2428,38 @@ The method used must be an out-of-band method." ;; 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)) @@ -2755,6 +2824,8 @@ the result will be a local, non-Tramp, filename." (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 @@ -2768,31 +2839,32 @@ the result will be a local, non-Tramp, filename." (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 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)))) ;; 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)) @@ -2912,16 +2984,6 @@ the result will be a local, non-Tramp, filename." (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 @@ -4147,6 +4209,9 @@ Goes through the list `tramp-inline-compress-commands'." (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." @@ -4207,10 +4272,11 @@ 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 tramp-gw-tunnel-method 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? @@ -5022,7 +5088,9 @@ This is used internally by `tramp-file-mode-from-int'." (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) @@ -5120,34 +5188,6 @@ function cell is returned to be applied on a buffer." (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))) |