master a1e2a68: Finish implementation of set-file-times FLAG arg in Tramp

[Michael Albinus]

branch: master
commit a1e2a6847007f56d96d0122e493d5228e5c4d08b
Author: Michael Albinus <address@hidden>
Commit: Michael Albinus <address@hidden>

    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.
---
 lisp/net/tramp-adb.el        | 16 ++++++++--------
 lisp/net/tramp-compat.el     |  9 ++++++++-
 lisp/net/tramp-gvfs.el       | 21 +++++++++------------
 lisp/net/tramp-sh.el         | 37 +++++++++++++++++++++----------------
 lisp/net/tramp-smb.el        |  7 ++++---
 lisp/net/tramp-sudoedit.el   |  5 +++--
 test/lisp/net/tramp-tests.el | 15 ++++++++++++---
 7 files changed, 65 insertions(+), 45 deletions(-)

diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index 7ee740f..bfeaeba 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 8f85550..f0131d5 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 1ad57c5..85f2807 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 560941c..eaf6055 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 d91362c8..effac33 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 c054f40..b6861ba 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 dcf376e..e220420 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