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.
author: Michael Albinus <michael.albinus@gmx.de> 2021-07-14 18:36:14 +0200
committer: Michael Albinus <michael.albinus@gmx.de> 2021-07-14 18:36:14 +0200
commit: 525d5cab36fe7e719ecc49b88a1ac68abbe7924c (patch)
tree: d5735304483b2bb668946aa0ee4ed2d860716c3b
parent: f45710e1ddf0f3a1470f6bc3a1116afd841de41a (diff)
download: emacs-525d5cab36fe7e719ecc49b88a1ac68abbe7924c.tar.gz
emacs-525d5cab36fe7e719ecc49b88a1ac68abbe7924c.tar.bz2
emacs-525d5cab36fe7e719ecc49b88a1ac68abbe7924c.zip
4 files changed, 100 insertions, 57 deletions
diff --git a/lisp/net/tramp-crypt.el b/lisp/net/tramp-crypt.el
index 109db3b1d7b..fdb2907ec32 100644
--- 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 760320d7ed4..e6bd42a83ae 100644
--- 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 3f586c62170..736c7efd242 100644
--- 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 bc05db8095b..3dd22acea51 100644
--- 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 ()
author	Michael Albinus <michael.albinus@gmx.de>	2021-07-14 18:36:14 +0200
committer	Michael Albinus <michael.albinus@gmx.de>	2021-07-14 18:36:14 +0200
commit	525d5cab36fe7e719ecc49b88a1ac68abbe7924c (patch)
tree	d5735304483b2bb668946aa0ee4ed2d860716c3b
parent	f45710e1ddf0f3a1470f6bc3a1116afd841de41a (diff)
download	emacs-525d5cab36fe7e719ecc49b88a1ac68abbe7924c.tar.gz emacs-525d5cab36fe7e719ecc49b88a1ac68abbe7924c.tar.bz2 emacs-525d5cab36fe7e719ecc49b88a1ac68abbe7924c.zip