Preserve backward compatibility in Tramp

* lisp/net/tramp-crypt.el (tramp-crypt-handle-lock-file)
(tramp-crypt-handle-unlock-file): Preserve backward compatibility.

* lisp/net/tramp-sh.el (tramp-sh-handle-write-region): Do not
create lock file twice.

* lisp/net/tramp.el (tramp-handle-make-lock-file-name): Move lock
file security check ...
(tramp-handle-lock-file): ... here.
(tramp-handle-unlock-file): Preserve backward compatibility.

* test/lisp/net/tramp-tests.el (lock-file-name-transforms)
(remote-file-name-inhibit-locks): Declare.
(tramp-allow-unsafe-temporary-files): Set to t.
(tramp-test37-make-auto-save-file-name)
(tramp-test38-find-backup-file-name): Move binding of
`tramp-allow-unsafe-temporary-files' up.
(tramp-test39-lock-file): Bind `tramp-allow-unsafe-temporary-files'.
Preserve backward compatibility.  Extend test.

diff --git a/lisp/net/tramp-crypt.el b/lisp/net/tramp-crypt.el
index 109db3b1d7b26a05f0db127eda4f819f858472f8..fdb2907ec3243bdc8983830a7c6673c95fef2d40 100644 (file)
--- a/lisp/net/tramp-crypt.el
+++ b/lisp/net/tramp-crypt.el
@@ -809,7 +809,9 @@ WILDCARD is not supported."
 (defun tramp-crypt-handle-lock-file (filename)
   "Like `lock-file' for Tramp files."
   (let (tramp-crypt-enabled)
-    (lock-file (tramp-crypt-encrypt-file-name filename))))
+    ;; `lock-file' exists since Emacs 28.1.
+    (tramp-compat-funcall
+     'lock-file (tramp-crypt-encrypt-file-name filename))))
 
 (defun tramp-crypt-handle-make-directory (dir &optional parents)
   "Like `make-directory' for Tramp files."
@@ -865,7 +867,9 @@ WILDCARD is not supported."
 (defun tramp-crypt-handle-unlock-file (filename)
   "Like `unlock-file' for Tramp files."
   (let (tramp-crypt-enabled)
-    (unlock-file (tramp-crypt-encrypt-file-name filename))))
+    ;; `unlock-file' exists since Emacs 28.1.
+    (tramp-compat-funcall
+     'unlock-file (tramp-crypt-encrypt-file-name filename))))
 
 (add-hook 'tramp-unload-hook
          (lambda ()

diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 760320d7ed4307f0c89c8c3bd6f56ced73738019..e6bd42a83ae9837fac70ad7ca2d4d21087ce0c36 100644 (file)
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -3272,7 +3272,8 @@ implementation will be used."
               (or (file-directory-p localname)
                   (file-writable-p localname)))
          ;; Short track: if we are on the local host, we can run directly.
-         (write-region start end localname append 'no-message lockname)
+         (let ((create-lockfiles (not file-locked)))
+           (write-region start end localname append 'no-message lockname))
 
        (let* ((modes (tramp-default-file-modes
                       filename (and (eq mustbenew 'excl) 'nofollow)))

diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 3f586c621701e33d719b6edee373057e6d537f85..736c7efd242d5859443bf68a06d1a91908600d21 100644 (file)
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -3873,43 +3873,44 @@ Return nil when there is no lockfile."
                  (format
                   "%s@%s.%s" (user-login-name) (system-name)
                   (tramp-get-lock-pid file))))
+
+       ;; Protect against security hole.
+       (with-parsed-tramp-file-name file nil
+         (when (and (not tramp-allow-unsafe-temporary-files)
+                    (file-in-directory-p lockname temporary-file-directory)
+                    (zerop (or (tramp-compat-file-attribute-user-id
+                                (file-attributes file 'integer))
+                               tramp-unknown-id-integer))
+                    (not (with-tramp-connection-property
+                             (tramp-get-process v) "unsafe-temporary-file"
+                           (yes-or-no-p
+                            (concat
+                             "Lock file on local temporary directory, "
+                             "do you want to continue? ")))))
+           (tramp-error v 'file-error "Unsafe lock file name")))
+
+       ;; Do the lock.
         (let (create-lockfiles signal-hook-function)
          (condition-case nil
              (make-symbolic-link info lockname 'ok-if-already-exists)
            (error
-             (write-region info nil lockname)
-             (set-file-modes lockname #o0644))))))))
+            (with-file-modes #o0644
+               (write-region info nil lockname)))))))))
 
 (defun tramp-handle-make-lock-file-name (file)
   "Like `make-lock-file-name' for Tramp files."
-  (when (and create-lockfiles
-            ;; This variable has been introduced with Emacs 28.1.
-            (not (bound-and-true-p remote-file-name-inhibit-locks)))
-    (with-parsed-tramp-file-name file nil
-      (let ((result
-            ;; Run plain `make-lock-file-name'.
-            (tramp-run-real-handler #'make-lock-file-name (list file))))
-       ;; Protect against security hole.
-       (when (and (not tramp-allow-unsafe-temporary-files)
-                  (file-in-directory-p result temporary-file-directory)
-                  (zerop (or (tramp-compat-file-attribute-user-id
-                              (file-attributes file 'integer))
-                             tramp-unknown-id-integer))
-                  (not (with-tramp-connection-property
-                           (tramp-get-process v) "unsafe-temporary-file"
-                         (yes-or-no-p
-                          (concat
-                           "Lock file on local temporary directory, "
-                           "do you want to continue? ")))))
-         (tramp-error v 'file-error "Unsafe lock file name"))
-       result))))
+  (and create-lockfiles
+       ;; This variable has been introduced with Emacs 28.1.
+       (not (bound-and-true-p remote-file-name-inhibit-locks))
+       (tramp-run-real-handler 'make-lock-file-name (list file))))
 
 (defun tramp-handle-unlock-file (file)
   "Like `unlock-file' for Tramp files."
   (when-let ((lockname (tramp-compat-make-lock-file-name file)))
     (condition-case err
         (delete-file lockname)
-      (error (userlock--handle-unlock-error err)))))
+      ;; `userlock--handle-unlock-error' exists since Emacs 28.1.
+      (error (tramp-compat-funcall 'userlock--handle-unlock-error err)))))
 
 (defun tramp-handle-load (file &optional noerror nomessage nosuffix must-suffix)
   "Like `load' for Tramp files."

diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index bc05db8095b11b7fef1b0437cf3ba1cf3a88a921..3dd22acea513f980875f6fd3dda97082da912710 100644 (file)
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -63,6 +63,8 @@
 (declare-function tramp-smb-get-localname "tramp-smb")
 (defvar ange-ftp-make-backup-files)
 (defvar auto-save-file-name-transforms)
+(defvar lock-file-name-transforms)
+(defvar remote-file-name-inhibit-locks)
 (defvar tramp-connection-properties)
 (defvar tramp-copy-size-limit)
 (defvar tramp-display-escape-sequence-regexp)
@@ -122,6 +124,7 @@
 (setq auth-source-save-behavior nil
       password-cache-expiry nil
       remote-file-name-inhibit-cache nil
+      tramp-allow-unsafe-temporary-files t
       tramp-cache-read-persistent-data t ;; For auth-sources.
       tramp-copy-size-limit nil
       tramp-persistency-file-name nil
@@ -5481,7 +5484,8 @@ Use direct async.")
 
   (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
     (let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
-         (tmp-name2 (tramp--test-make-temp-name nil quoted)))
+         (tmp-name2 (tramp--test-make-temp-name nil quoted))
+         tramp-allow-unsafe-temporary-files)
 
       (unwind-protect
          (progn
@@ -5569,8 +5573,7 @@ Use direct async.")
 
            ;; Create temporary file.  This shall check for sensible
            ;; files, owned by root.
-           (let ((tramp-auto-save-directory temporary-file-directory)
-                 tramp-allow-unsafe-temporary-files)
+           (let ((tramp-auto-save-directory temporary-file-directory))
              (write-region "foo" nil tmp-name1)
              (when (zerop (or (tramp-compat-file-attribute-user-id
                                (file-attributes tmp-name1))
@@ -5606,6 +5609,7 @@ Use direct async.")
     (let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
          (tmp-name2 (tramp--test-make-temp-name nil quoted))
          (ange-ftp-make-backup-files t)
+         tramp-allow-unsafe-temporary-files
          ;; These settings are not used by Tramp, so we ignore them.
          version-control delete-old-versions
          (kept-old-versions (default-toplevel-value 'kept-old-versions))
@@ -5716,7 +5720,6 @@ Use direct async.")
          ;; Create temporary file.  This shall check for sensible
          ;; files, owned by root.
          (let ((backup-directory-alist `(("." . ,temporary-file-directory)))
-               tramp-allow-unsafe-temporary-files
                tramp-backup-directory-alist)
            (write-region "foo" nil tmp-name1)
            (when (zerop (or (tramp-compat-file-attribute-user-id
@@ -5749,13 +5752,18 @@ Use direct async.")
   (skip-unless (not (tramp--test-ange-ftp-p)))
   ;; Since Emacs 28.1.
   (skip-unless (and (fboundp 'lock-file) (fboundp 'unlock-file)))
+  (skip-unless (and (fboundp 'file-locked-p) (fboundp 'make-lock-file-name)))
 
+  ;; `lock-file', `unlock-file', `file-locked-p' and
+  ;; `make-lock-file-name' exists since Emacs 28.1.  We don't want to
+  ;; see compiler warnings for older Emacsen.
   (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
     (let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
          (tmp-name2 (tramp--test-make-temp-name nil quoted))
          (remote-file-name-inhibit-cache t)
          (remote-file-name-inhibit-locks nil)
          (create-lockfiles t)
+         tramp-allow-unsafe-temporary-files
           (inhibit-message t)
          ;; tramp-rclone.el and tramp-sshfs.el cache the mounted files.
          (tramp-cleanup-connection-hook
@@ -5767,24 +5775,24 @@ Use direct async.")
       (unwind-protect
          (progn
            ;; A simple file lock.
-           (should-not (file-locked-p tmp-name1))
-           (lock-file tmp-name1)
-           (should (eq (file-locked-p tmp-name1) t))
+           (should-not (with-no-warnings (file-locked-p tmp-name1)))
+           (with-no-warnings (lock-file tmp-name1))
+           (should (eq (with-no-warnings (file-locked-p tmp-name1)) t))
 
            ;; If it is locked already, nothing changes.
-           (lock-file tmp-name1)
-           (should (eq (file-locked-p tmp-name1) t))
+           (with-no-warnings (lock-file tmp-name1))
+           (should (eq (with-no-warnings (file-locked-p tmp-name1)) t))
 
            ;; A new connection changes process id, and also the
            ;; lockname contents.
            (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
-           (should (stringp (file-locked-p tmp-name1)))
+           (should (stringp (with-no-warnings (file-locked-p tmp-name1))))
 
            ;; When `remote-file-name-inhibit-locks' is set, nothing happens.
            (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
            (let ((remote-file-name-inhibit-locks t))
-             (lock-file tmp-name1)
-             (should-not (file-locked-p tmp-name1)))
+             (with-no-warnings (lock-file tmp-name1))
+             (should-not (with-no-warnings (file-locked-p tmp-name1))))
 
            ;; When `lock-file-name-transforms' is set, another lock
            ;; file is used.
@@ -5792,48 +5800,77 @@ Use direct async.")
            (let ((lock-file-name-transforms `((".*" ,tmp-name2))))
              (should
               (string-equal
-               (make-lock-file-name tmp-name1)
-               (make-lock-file-name tmp-name2)))
-             (lock-file tmp-name1)
-             (should (eq (file-locked-p tmp-name1) t))
-             (unlock-file tmp-name1)
-             (should-not (file-locked-p tmp-name1)))
+               (with-no-warnings (make-lock-file-name tmp-name1))
+               (with-no-warnings (make-lock-file-name tmp-name2))))
+             (with-no-warnings (lock-file tmp-name1))
+             (should (eq (with-no-warnings (file-locked-p tmp-name1)) t))
+             (with-no-warnings (unlock-file tmp-name1))
+             (should-not (with-no-warnings (file-locked-p tmp-name1))))
 
            ;; Steal the file lock.
            (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
            (cl-letf (((symbol-function #'read-char) (lambda (&rest _args) ?s)))
-             (lock-file tmp-name1))
-           (should (eq (file-locked-p tmp-name1) t))
+             (with-no-warnings (lock-file tmp-name1)))
+           (should (eq (with-no-warnings (file-locked-p tmp-name1)) t))
 
            ;; Ignore the file lock.
            (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
            (cl-letf (((symbol-function #'read-char) (lambda (&rest _args) ?p)))
-             (lock-file tmp-name1))
-           (should (stringp (file-locked-p tmp-name1)))
+             (with-no-warnings (lock-file tmp-name1)))
+           (should (stringp (with-no-warnings (file-locked-p tmp-name1))))
 
            ;; Quit the file lock machinery.
            (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
            (cl-letf (((symbol-function #'read-char) (lambda (&rest _args) ?q)))
-             (should-error (lock-file tmp-name1) :type 'file-locked)
+             (with-no-warnings
+               (should-error
+                (lock-file tmp-name1)
+                :type 'file-locked))
              ;; The same for `write-region'.
              (should-error
-              (write-region "foo" nil tmp-name1) :type 'file-locked)
+              (write-region "foo" nil tmp-name1)
+              :type 'file-locked)
              (should-error
               (write-region "foo" nil tmp-name1 nil nil tmp-name1)
                :type 'file-locked)
              ;; The same for `set-visited-file-name'.
               (with-temp-buffer
                (should-error
-                 (set-visited-file-name tmp-name1) :type 'file-locked)))
-           (should (stringp (file-locked-p tmp-name1)))
+                 (set-visited-file-name tmp-name1)
+                :type 'file-locked)))
+           (should (stringp (with-no-warnings (file-locked-p tmp-name1))))
            (should-not (file-exists-p tmp-name1)))
 
        ;; Cleanup.
        (ignore-errors (delete-file tmp-name1))
-       (unlock-file tmp-name1)
-       (unlock-file tmp-name2)
-       (should-not (file-locked-p tmp-name1))
-       (should-not (file-locked-p tmp-name2))))))
+       (with-no-warnings (unlock-file tmp-name1))
+       (with-no-warnings (unlock-file tmp-name2))
+       (should-not (with-no-warnings (file-locked-p tmp-name1)))
+       (should-not (with-no-warnings (file-locked-p tmp-name2))))
+
+      (unwind-protect
+         ;; Create temporary file.  This shall check for sensible
+         ;; files, owned by root.
+         (let ((lock-file-name-transforms auto-save-file-name-transforms))
+           (write-region "foo" nil tmp-name1)
+           (when (zerop (or (tramp-compat-file-attribute-user-id
+                             (file-attributes tmp-name1))
+                            tramp-unknown-id-integer))
+             (tramp-cleanup-connection
+              tramp-test-vec 'keep-debug 'keep-password)
+             (cl-letf (((symbol-function #'yes-or-no-p) #'ignore))
+               (should-error
+                (write-region "foo" nil tmp-name1)
+                :type 'file-error))
+             (tramp-cleanup-connection
+              tramp-test-vec 'keep-debug 'keep-password)
+             (cl-letf (((symbol-function #'yes-or-no-p)
+                        #'tramp--test-always))
+               (write-region "foo" nil tmp-name1))))
+
+       ;; Cleanup.
+       (ignore-errors (delete-file tmp-name1))
+       (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)))))
 
 ;; The functions were introduced in Emacs 26.1.
 (ert-deftest tramp-test40-make-nearby-temp-file ()