X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/d8fb8cce84b923a3289b69549e30958710ac3ebb..0877d0dc24ee792b9b14592869ea1aa0934aee58:/lisp/net/tramp-sh.el diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 10665352c6..58ad7a6661 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.") @@ -1529,10 +1532,49 @@ and gid of the corresponding user is taken. Both parameters must be 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 -acs %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)) + (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 filename nil + (when (tramp-remote-acl-p v) + (condition-case nil + (when (stringp acl-string) + (tramp-set-file-property v localname "file-acl" acl-string) + (dolist (line (split-string acl-string nil t) t) + (unless (tramp-send-command-and-check + v (format + "setfacl -m %s %s" + line (tramp-shell-quote-argument localname))) + (error nil)))) + ;; In case of errors, we return `nil'. + (error + (tramp-set-file-property v localname "file-acl" 'undef) + nil))))) ;; Simple functions using the `test' command. @@ -1618,7 +1660,7 @@ and gid of the corresponding user is taken. Both parameters must be 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" @@ -1626,7 +1668,10 @@ and gid of the corresponding user is taken. Both parameters must be 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. @@ -1882,7 +1927,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)) @@ -1892,13 +1937,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 @@ -1961,7 +2006,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 @@ -1970,7 +2015,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 @@ -1981,8 +2026,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 @@ -2052,8 +2097,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)) @@ -2381,17 +2429,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)) @@ -2913,16 +2982,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 @@ -5012,7 +5071,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)