mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2025-01-07 12:59:26 +00:00
Code Issues Releases Activity

Finish implementation of set-file-times FLAG arg in Tramp

Browse Source 
* 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.
This commit is contained in:
Michael Albinus 2020-03-09 16:05:21 +01:00
parent a461baae79
commit a1e2a68470
7 changed files with 65 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
lisp/net/tramp-adb.el
View File

@ -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))

9
lisp/net/tramp-compat.el
View File

@ -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)

21
lisp/net/tramp-gvfs.el
View File

@ -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)))))

37
lisp/net/tramp-sh.el
View File

@ -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)

7
lisp/net/tramp-smb.el
View File

@ -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))

5
lisp/net/tramp-sudoedit.el
View File

@ -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)

15
test/lisp/net/tramp-tests.el
View File

@ -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