From: Michael Albinus Date: Mon, 9 Mar 2020 15:05:21 +0000 (+0100) Subject: Finish implementation of set-file-times FLAG arg in Tramp X-Git-Tag: emacs-28.0.90~7781 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=a1e2a6847007f56d96d0122e493d5228e5c4d08b;p=emacs.git Finish implementation of set-file-times FLAG arg in Tramp * lisp/net/tramp-adb.el (tramp-adb-handle-set-file-times): Implement FLAG. (tramp-adb-handle-copy-file): Adapt `set-file-times' call. * lisp/net/tramp-compat.el (tramp-compat-set-file-times): New defalias. * lisp/net/tramp-gvfs.el (tramp-gvfs-handle-set-file-modes) (tramp-gvfs-handle-set-file-times, tramp-gvfs-set-file-uid-gid): Simplify `tramp-gvfs-url-file-name' call. * lisp/net/tramp-sh.el (tramp-sh-handle-set-file-times): Implement FLAG. (tramp-do-copy-or-rename-file-via-buffer) (tramp-do-copy-or-rename-file-out-of-band): Add optional argument OK-IF-ALREADY-EXISTS. Adapt callees. (tramp-do-copy-or-rename-file-via-buffer) (tramp-do-copy-or-rename-file-directly) (tramp-do-copy-or-rename-file-out-of-band): Adapt `set-file-times' call. * lisp/net/tramp-smb.el (tramp-smb-handle-copy-directory) (tramp-smb-handle-copy-file): Adapt `set-file-times' call. * lisp/net/tramp-sudoedit.el (tramp-sudoedit-do-copy-or-rename-file): Adapt `set-file-times' call. (tramp-sudoedit-handle-set-file-times): Implement FLAG. * test/lisp/net/tramp-tests.el (tramp-test22-file-times): Extend test. --- diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 7ee740f93cb..bfeaebac2cd 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -676,7 +676,6 @@ But handle the case, if the \"test\" command is not available." (defun tramp-adb-handle-set-file-times (filename &optional time flag) "Like `set-file-times' for Tramp files." - flag ;; FIXME: Support 'nofollow'. (with-parsed-tramp-file-name filename nil (tramp-flush-file-properties v localname) (let ((time (if (or (null time) @@ -684,21 +683,22 @@ But handle the case, if the \"test\" command is not available." (tramp-compat-time-equal-p time tramp-time-dont-know)) (current-time) time)) + (nofollow (if (eq flag 'nofollow) "-h" "")) (quoted-name (tramp-shell-quote-argument localname))) ;; Older versions of toybox 'touch' mishandle nanoseconds and/or ;; trailing "Z", so fall back on plain seconds if nanoseconds+Z ;; fails. Also, fall back on old POSIX 'touch -t' if 'touch -d' ;; (introduced in POSIX.1-2008) fails. (tramp-adb-send-command-and-check - v (format (concat "touch -d %s %s 2>/dev/null || " - "touch -d %s %s 2>/dev/null || " - "touch -t %s %s") + v (format (concat "touch -d %s %s %s 2>/dev/null || " + "touch -d %s %s %s 2>/dev/null || " + "touch -t %s %s %s") (format-time-string "%Y-%m-%dT%H:%M:%S.%NZ" time t) - quoted-name + nofollow quoted-name (format-time-string "%Y-%m-%dT%H:%M:%S" time t) - quoted-name + nofollow quoted-name (format-time-string "%Y%m%d%H%M.%S" time t) - quoted-name))))) + nofollow quoted-name))))) (defun tramp-adb-handle-copy-file (filename newname &optional ok-if-already-exists keep-date @@ -775,7 +775,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." ;; KEEP-DATE handling. (when keep-date - (set-file-times + (tramp-compat-set-file-times newname (tramp-compat-file-attribute-modification-time (file-attributes filename)) diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index 8f85550bca0..f0131d59852 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -276,7 +276,8 @@ A nil value for either argument stands for the current time." (lambda (reporter &optional value _suffix) (progress-reporter-update reporter value)))) -;; `file-modes' and `set-file-modes' got argument FLAG in Emacs 28.1. +;; `file-modes', `set-file-modes' and `set-file-times' got argument +;; FLAG in Emacs 28.1. (defalias 'tramp-compat-file-modes (if (equal (tramp-compat-funcall 'func-arity #'file-modes) '(1 . 2)) #'file-modes @@ -289,6 +290,12 @@ A nil value for either argument stands for the current time." (lambda (filename mode &optional _flag) (set-file-modes filename mode)))) +(defalias 'tramp-compat-set-file-times + (if (equal (tramp-compat-funcall 'func-arity #'set-file-times) '(1 . 3)) + #'set-file-times + (lambda (filename &optional timestamp _flag) + (set-file-times filename timestamp)))) + (add-hook 'tramp-unload-hook (lambda () (unload-feature 'tramp-loaddefs 'force) diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 1ad57c59a5b..85f28076168 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -1568,23 +1568,21 @@ If FILE-SYSTEM is non-nil, return file system attributes." (tramp-flush-file-properties v localname) (tramp-gvfs-send-command v "gvfs-set-attribute" (if (eq flag 'nofollow) "-nt" "-t") "uint32" - (tramp-gvfs-url-file-name (tramp-make-tramp-file-name v)) - "unix::mode" (number-to-string mode)))) + (tramp-gvfs-url-file-name filename) "unix::mode" (number-to-string mode)))) (defun tramp-gvfs-handle-set-file-times (filename &optional time flag) "Like `set-file-times' for Tramp files." (with-parsed-tramp-file-name filename nil (tramp-flush-file-properties v localname) - (let ((time - (if (or (null time) + (tramp-gvfs-send-command + v "gvfs-set-attribute" (if (eq flag 'nofollow) "-nt" "-t") "uint64" + (tramp-gvfs-url-file-name filename) "time::modified" + (format-time-string + "%s" (if (or (null time) (tramp-compat-time-equal-p time tramp-time-doesnt-exist) (tramp-compat-time-equal-p time tramp-time-dont-know)) (current-time) - time))) - (tramp-gvfs-send-command - v "gvfs-set-attribute" (if flag "-nt" "-t") "uint64" - (tramp-gvfs-url-file-name (tramp-make-tramp-file-name v)) - "time::modified" (format-time-string "%s" time))))) + time))))) (defun tramp-gvfs-set-file-uid-gid (filename &optional uid gid) "Like `tramp-set-file-uid-gid' for Tramp files." @@ -1593,12 +1591,11 @@ If FILE-SYSTEM is non-nil, return file system attributes." (when (natnump uid) (tramp-gvfs-send-command v "gvfs-set-attribute" "-t" "uint32" - (tramp-gvfs-url-file-name (tramp-make-tramp-file-name v)) - "unix::uid" (number-to-string uid))) + (tramp-gvfs-url-file-name filename) "unix::uid" (number-to-string uid))) (when (natnump gid) (tramp-gvfs-send-command v "gvfs-set-attribute" "-t" "uint32" - (tramp-gvfs-url-file-name (tramp-make-tramp-file-name v)) + (tramp-gvfs-url-file-name filename) "unix::gid" (number-to-string gid))))) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 560941c4d5b..eaf60554402 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -1500,7 +1500,6 @@ of." (with-parsed-tramp-file-name filename nil (when (tramp-get-remote-touch v) (tramp-flush-file-properties v localname) - flag ;; FIXME: Support 'nofollow'. (let ((time (if (or (null time) (tramp-compat-time-equal-p time tramp-time-doesnt-exist) @@ -1509,11 +1508,12 @@ of." time))) (tramp-send-command-and-check v (format - "env TZ=UTC %s %s %s" + "env TZ=UTC %s %s %s %s" (tramp-get-remote-touch v) (if (tramp-get-connection-property v "touch-t" nil) (format "-t %s" (format-time-string "%Y%m%d%H%M.%S" time t)) "") + (if (eq flag 'nofollow) "-h" "") (tramp-shell-quote-argument localname))))))) (defun tramp-sh-handle-set-file-uid-gid (filename &optional uid gid) @@ -1979,7 +1979,7 @@ tramp-sh-handle-file-name-all-completions: internal error accessing `%s': `%s'" (unless (file-directory-p (file-name-directory newname)) (make-directory (file-name-directory newname) parents)) (tramp-do-copy-or-rename-file-out-of-band - 'copy dirname newname keep-date)) + 'copy dirname newname 'ok-if-already-exists keep-date)) ;; We must do it file-wise. (tramp-run-real-handler @@ -2075,7 +2075,7 @@ file names." (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)) + op filename newname ok-if-already-exists keep-date)) ;; No shortcut was possible. So we copy the file ;; first. If the operation was `rename', we go back @@ -2088,7 +2088,7 @@ file names." ;; source and target file. (t (tramp-do-copy-or-rename-file-via-buffer - op filename newname keep-date)))))) + op filename newname ok-if-already-exists keep-date)))))) ;; One file is a Tramp file, the other one is local. ((or t1 t2) @@ -2103,11 +2103,11 @@ file names." ;; corresponding copy-program can be invoked. ((tramp-method-out-of-band-p v length) (tramp-do-copy-or-rename-file-out-of-band - op filename newname keep-date)) + op filename newname ok-if-already-exists keep-date)) ;; Use the inline method via a Tramp buffer. (t (tramp-do-copy-or-rename-file-via-buffer - op filename newname keep-date)))) + op filename newname ok-if-already-exists keep-date)))) (t ;; One of them must be a Tramp file. @@ -2129,7 +2129,8 @@ file names." (with-parsed-tramp-file-name newname v2 (tramp-flush-file-properties v2 v2-localname)))))))) -(defun tramp-do-copy-or-rename-file-via-buffer (op filename newname keep-date) +(defun tramp-do-copy-or-rename-file-via-buffer + (op filename newname ok-if-already-exists keep-date) "Use an Emacs buffer to copy or rename a file. First arg OP is either `copy' or `rename' and indicates the operation. FILENAME is the source file, NEWNAME the target file. @@ -2157,10 +2158,11 @@ KEEP-DATE is non-nil if NEWNAME should have the same timestamp as FILENAME." (insert-file-contents-literally filename))) ;; KEEP-DATE handling. (when keep-date - (set-file-times + (tramp-compat-set-file-times newname (tramp-compat-file-attribute-modification-time - (file-attributes filename)))) + (file-attributes filename)) + (unless ok-if-already-exists 'nofollow))) ;; Set the mode. (set-file-modes newname (tramp-default-file-modes filename)) ;; If the operation was `rename', delete the original file. @@ -2314,10 +2316,12 @@ the uid and gid from FILENAME." ;; Set the time and mode. Mask possible errors. (ignore-errors (when keep-date - (set-file-times newname file-times) + (tramp-compat-set-file-times + newname file-times (unless ok-if-already-exists 'nofollow)) (set-file-modes newname file-modes)))))) -(defun tramp-do-copy-or-rename-file-out-of-band (op filename newname keep-date) +(defun tramp-do-copy-or-rename-file-out-of-band + (op filename newname ok-if-already-exists keep-date) "Invoke `scp' program to copy. The method used must be an out-of-band method." (let* ((t1 (tramp-tramp-file-p filename)) @@ -2340,9 +2344,9 @@ The method used must be an out-of-band method." (unwind-protect (progn (tramp-do-copy-or-rename-file-out-of-band - op filename tmpfile keep-date) + op filename tmpfile ok-if-already-exists keep-date) (tramp-do-copy-or-rename-file-out-of-band - 'rename tmpfile newname keep-date)) + 'rename tmpfile newname ok-if-already-exists keep-date)) ;; Save exit. (ignore-errors (if dir-flag @@ -2516,10 +2520,11 @@ The method used must be an out-of-band method." ;; Handle KEEP-DATE argument. (when (and keep-date (not copy-keep-date)) - (set-file-times + (tramp-compat-set-file-times newname (tramp-compat-file-attribute-modification-time - (file-attributes filename)))) + (file-attributes filename)) + (unless ok-if-already-exists 'nofollow))) ;; Set the mode. (unless (and keep-date copy-keep-date) diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index d91362c879c..effac333dad 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -538,10 +538,11 @@ pass to the OPERATION." ;; Handle KEEP-DATE argument. (when keep-date - (set-file-times + (tramp-compat-set-file-times newname (tramp-compat-file-attribute-modification-time - (file-attributes dirname)))) + (file-attributes dirname)) + (unless ok-if-already-exists 'nofollow))) ;; Set the mode. (unless keep-date @@ -616,7 +617,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." ;; KEEP-DATE handling. (when keep-date - (set-file-times + (tramp-compat-set-file-times newname (tramp-compat-file-attribute-modification-time (file-attributes filename)) diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el index c054f405e3d..b6861ba7882 100644 --- a/lisp/net/tramp-sudoedit.el +++ b/lisp/net/tramp-sudoedit.el @@ -281,7 +281,8 @@ absolute file names." ;; Set the time and mode. Mask possible errors. (when keep-date (ignore-errors - (set-file-times newname file-times) + (tramp-compat-set-file-times + newname file-times (unless ok-if-already-exists 'nofollow)) (set-file-modes newname file-modes))) ;; Handle `preserve-extended-attributes'. We ignore possible @@ -527,7 +528,6 @@ the result will be a local, non-Tramp, file name." "Like `set-file-times' for Tramp files." (with-parsed-tramp-file-name filename nil (tramp-flush-file-properties v localname) - flag ;; FIXME: Support 'nofollow'. (let ((time (if (or (null time) (tramp-compat-time-equal-p time tramp-time-doesnt-exist) @@ -537,6 +537,7 @@ the result will be a local, non-Tramp, file name." (tramp-sudoedit-send-command v "env" "TZ=UTC" "touch" "-t" (format-time-string "%Y%m%d%H%M.%S" time t) + (if (eq flag 'nofollow) "-h" "") (tramp-compat-file-name-unquote localname))))) (defun tramp-sudoedit-handle-file-truename (filename) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index dcf376e70b4..e220420d8cf 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -3743,8 +3743,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (file-attributes tmp-name1)))) ;; Skip the test, if the remote handler is not able to set ;; the correct time. - (skip-unless (set-file-times tmp-name1 (seconds-to-time 1) - 'nofollow)) + (skip-unless (set-file-times tmp-name1 (seconds-to-time 1))) ;; Dumb remote shells without perl(1) or stat(1) are not ;; able to return the date correctly. They say "don't know". (unless (tramp-compat-time-equal-p @@ -3761,7 +3760,17 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (should (file-newer-than-file-p tmp-name2 tmp-name1)) ;; `tmp-name3' does not exist. (should (file-newer-than-file-p tmp-name2 tmp-name3)) - (should-not (file-newer-than-file-p tmp-name3 tmp-name1)))) + (should-not (file-newer-than-file-p tmp-name3 tmp-name1)) + ;; Check the NOFOLLOW arg. It exists since Emacs 28. For + ;; regular files, there shouldn't be a difference. + (when (tramp--test-emacs28-p) + (with-no-warnings + (set-file-times tmp-name1 (seconds-to-time 1) 'nofollow) + (should + (tramp-compat-time-equal-p + (tramp-compat-file-attribute-modification-time + (file-attributes tmp-name1)) + (seconds-to-time 1))))))) ;; Cleanup. (ignore-errors