master 2261f89: Finish Tramp's implementation of 'nofollow

[Michael Albinus]

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

    Finish Tramp's implementation of 'nofollow
    
    * lisp/net/tramp-adb.el (tramp-adb-handle-file-local-copy):
    Do not use 'nofollow.
    (tramp-adb-handle-set-file-modes):
    * lisp/net/tramp-smb.el (tramp-smb-handle-set-file-modes):
    * lisp/net/tramp-sudoedit.el (tramp-sudoedit-handle-set-file-modes):
    * lisp/net/tramp-sh.el (tramp-sh-handle-set-file-modes):
    Handle FLAG properly.
    (tramp-get-remote-chmod-h): Adapt implementation.
    
    * test/lisp/net/tramp-tests.el (tramp-get-remote-chmod-h): Declare.
    (tramp--test-ignore-make-symbolic-link-error): Revert last change.
    (tramp-test20-file-modes): Adapt test.
---
 lisp/net/tramp-adb.el        | 13 ++++++-------
 lisp/net/tramp-sh.el         | 30 ++++++++++++++++--------------
 lisp/net/tramp-smb.el        | 16 ++++++++--------
 lisp/net/tramp-sudoedit.el   | 16 ++++++++--------
 test/lisp/net/tramp-tests.el | 28 ++++++++++++++++++----------
 5 files changed, 56 insertions(+), 47 deletions(-)

diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index a118e7d..2c9674f 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -591,9 +591,7 @@ Emacs dired can't find files."
          (ignore-errors (delete-file tmpfile))
          (tramp-error
           v 'file-error "Cannot make local copy of file `%s'" filename))
-       (set-file-modes
-        tmpfile
-        (logior (or (tramp-compat-file-modes filename 'nofollow) 0) #o0400)))
+       (set-file-modes tmpfile (logior (or (file-modes filename) 0) #o0400)))
       tmpfile)))
 
 (defun tramp-adb-handle-file-writable-p (filename)
@@ -670,10 +668,11 @@ But handle the case, if the \"test\" command is not 
available."
 (defun tramp-adb-handle-set-file-modes (filename mode &optional flag)
   "Like `set-file-modes' for Tramp files."
   (with-parsed-tramp-file-name filename nil
-    (when (and (eq flag 'nofollow) (file-symlink-p filename))
-      (tramp-error v 'file-error "Cannot chmod %s with %s flag" filename flag))
-    (tramp-flush-file-properties v localname)
-    (tramp-adb-send-command-and-check v (format "chmod %o %s" mode 
localname))))
+    ;; ADB shell does not support "chmod -h".
+    (unless (and (eq flag 'nofollow) (file-symlink-p filename))
+      (tramp-flush-file-properties v localname)
+      (tramp-adb-send-command-and-check
+       v (format "chmod %o %s" mode localname)))))
 
 (defun tramp-adb-handle-set-file-times (filename &optional time)
   "Like `set-file-times' for Tramp files."
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 761f594..84b8191 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -1481,16 +1481,18 @@ of."
 (defun tramp-sh-handle-set-file-modes (filename mode &optional flag)
   "Like `set-file-modes' for Tramp files."
   (with-parsed-tramp-file-name filename nil
-    (let ((chmod "chmod"))
-      (when (and (eq flag 'nofollow) (file-symlink-p filename))
-       (or (setq chmod (tramp-get-remote-chmod-h v))
-           (tramp-error
-            v 'file-error "Cannot chmod %s with %s flag" filename flag)))
+    ;; We need "chmod -h" when the flag is set.
+    (when (or (not (eq flag 'nofollow))
+             (not (file-symlink-p filename))
+             (tramp-get-remote-chmod-h v))
       (tramp-flush-file-properties v localname)
       ;; FIXME: extract the proper text from chmod's stderr.
       (tramp-barf-unless-okay
        v
-       (format "%s %o %s" chmod mode (tramp-shell-quote-argument localname))
+       (format
+       "chmod %s %o %s"
+       (if (and (eq flag 'nofollow) (tramp-get-remote-chmod-h v)) "-h" "")
+       mode (tramp-shell-quote-argument localname))
        "Error while changing file's mode %s" filename))))
 
 (defun tramp-sh-handle-set-file-times (filename &optional time)
@@ -5902,20 +5904,20 @@ ID-FORMAT valid values are `string' and `integer'."
               command)))))
 
 (defun tramp-get-remote-chmod-h (vec)
-  "Determine remote `chmod' command which supports nofollow argument."
+  "Check whether remote `chmod' supports nofollow argument."
   (with-tramp-connection-property vec "chmod-h"
     (tramp-message vec 5 "Finding a suitable `chmod' command with nofollow")
     (let ((tmpfile
           (make-temp-name
            (expand-file-name
             tramp-temp-name-prefix (tramp-get-remote-tmpdir vec)))))
-      (when (tramp-send-command-and-check
-            vec
-            (format
-             "ln -s foo %s && chmod -h %s 0777"
-             (tramp-file-local-name tmpfile) (tramp-file-local-name tmpfile)))
-       (delete-file tmpfile)
-       "chmod -h"))))
+      (prog1
+         (tramp-send-command-and-check
+          vec
+          (format
+           "ln -s foo %s && chmod -h %s 0777"
+           (tramp-file-local-name tmpfile) (tramp-file-local-name tmpfile)))
+       (delete-file tmpfile)))))
 
 (defun tramp-get-env-with-u-option (vec)
   "Check, whether the remote `env' command supports the -u option."
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index abd369f..42954cb 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -1467,14 +1467,14 @@ component is used as the target of the symlink."
 (defun tramp-smb-handle-set-file-modes (filename mode &optional flag)
   "Like `set-file-modes' for Tramp files."
   (with-parsed-tramp-file-name filename nil
-    (when (and (eq flag 'nofollow) (file-symlink-p filename))
-      (tramp-error v 'file-error "Cannot chmod %s with %s flag" filename flag))
-    (when (tramp-smb-get-cifs-capabilities v)
-      (tramp-flush-file-properties v localname)
-      (unless (tramp-smb-send-command
-              v (format "chmod \"%s\" %o" (tramp-smb-get-localname v) mode))
-       (tramp-error
-        v 'file-error "Error while changing file's mode %s" filename)))))
+    ;; smbclient chmod does not support nofollow.
+    (unless (and (eq flag 'nofollow) (file-symlink-p filename))
+      (when (tramp-smb-get-cifs-capabilities v)
+       (tramp-flush-file-properties v localname)
+       (unless (tramp-smb-send-command
+                v (format "chmod \"%s\" %o" (tramp-smb-get-localname v) mode))
+         (tramp-error
+          v 'file-error "Error while changing file's mode %s" filename))))))
 
 ;; We use BUFFER also as connection buffer during setup. Because of
 ;; this, its original contents must be saved, and restored once
diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el
index e70ee4e..7d8c8a9 100644
--- a/lisp/net/tramp-sudoedit.el
+++ b/lisp/net/tramp-sudoedit.el
@@ -466,14 +466,14 @@ the result will be a local, non-Tramp, file name."
 (defun tramp-sudoedit-handle-set-file-modes (filename mode &optional flag)
   "Like `set-file-modes' for Tramp files."
   (with-parsed-tramp-file-name filename nil
-    (when (and (eq flag 'nofollow) (file-symlink-p filename))
-      (tramp-error v 'file-error "Cannot chmod %s with %s flag" filename flag))
-    (tramp-flush-file-properties v localname)
-    (unless (tramp-sudoedit-send-command
-            v "chmod" (format "%o" mode)
-            (tramp-compat-file-name-unquote localname))
-      (tramp-error
-       v 'file-error "Error while changing file's mode %s" filename))))
+    ;; It is unlikely that "chmod -h" works.
+    (unless (and (eq flag 'nofollow) (file-symlink-p filename))
+      (tramp-flush-file-properties v localname)
+      (unless (tramp-sudoedit-send-command
+              v "chmod" (format "%o" mode)
+              (tramp-compat-file-name-unquote localname))
+       (tramp-error
+        v 'file-error "Error while changing file's mode %s" filename)))))
 
 (defun tramp-sudoedit-remote-selinux-p (vec)
   "Check, whether SELINUX is enabled on the remote host."
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 7b43d6f..be0f418 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -50,6 +50,7 @@
 (require 'vc-hg)
 
 (declare-function tramp-find-executable "tramp-sh")
+(declare-function tramp-get-remote-chmod-h "tramp-sh")
 (declare-function tramp-get-remote-gid "tramp-sh")
 (declare-function tramp-get-remote-path "tramp-sh")
 (declare-function tramp-get-remote-perl "tramp-sh")
@@ -3082,18 +3083,14 @@ This tests also `file-directory-p' and 
`file-accessible-directory-p'."
 ;; Method "smb" supports `make-symbolic-link' only if the remote host
 ;; has CIFS capabilities.  tramp-adb.el, tramp-gvfs.el and
 ;; tramp-rclone.el do not support symbolic links at all.
-;; We check also `set-file-modes' with nofollow flag.
 (defmacro tramp--test-ignore-make-symbolic-link-error (&rest body)
   "Run BODY, ignoring \"make-symbolic-link not supported\" file error."
   (declare (indent defun) (debug (body)))
   `(condition-case err
        (progn ,@body)
      (file-error
-      (unless (string-match-p
-              (concat
-               "^\\(make-symbolic-link not supported"
-               "\\|Cannot chmod .* with nofollow flag\\)$")
-              (error-message-string err))
+      (unless (string-equal (error-message-string err)
+                           "make-symbolic-link not supported")
        (signal (car err) (cdr err))))))
 
 (ert-deftest tramp-test18-file-attributes ()
@@ -3385,15 +3382,26 @@ This tests also `file-executable-p', `file-writable-p' 
and `set-file-modes'."
            ;; A file is always writable for user "root".
            (unless (zerop (tramp-compat-file-attribute-user-id
                            (file-attributes tmp-name1)))
-             (should-not (file-writable-p tmp-name1))))
+             (should-not (file-writable-p 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-modes tmp-name1 #o222 'nofollow)
+               (should (= (file-modes tmp-name1 'nofollow) #o222)))))
 
        ;; Cleanup.
        (ignore-errors (delete-file tmp-name1)))
 
-      ;; Check the NOFOLLOW arg.  It exists since Emacs 28.
-      (when (tramp--test-emacs28-p)
+      ;; Check the NOFOLLOW arg.  It exists since Emacs 28.  It is
+      ;; implemented for tramp-gvfs.el and tramp-sh.el.  However,
+      ;; tramp-gvfs,el does not support creating symbolic links.  And
+      ;; in tramp-sh.el, we must ensure that the remote chmod command
+      ;; supports the "-h" argument.
+      (when (and (tramp--test-emacs28-p) (tramp--test-sh-p)
+                (tramp-get-remote-chmod-h (tramp-dissect-file-name tmp-name1)))
        (unwind-protect
-           (tramp--test-ignore-make-symbolic-link-error
+           (with-no-warnings
              (write-region "foo" nil tmp-name1)
              (should (file-exists-p tmp-name1))
              (make-symbolic-link tmp-name1 tmp-name2)